Posted to tcl by kbk at Tue Aug 13 21:56:44 GMT 2019view pretty
package require Tk 8.6 set quote {I don't really care how time is reckoned so long as there is some agreement about it, but I object to being told that I am saving daylight when my reason tells me that I am doing nothing of the kind. I even object to the implication that I am wasting something valuable if I stay in bed after the sun has risen. As an admirer of moonlight I resent the bossy insistence of those who want to reduce my time for enjoying it. At the back of the Daylight Saving scheme I detect the bony, blue-fingered hand of Puritanism, eager to push people into bed earlier, and get them up earlier, to make them healthy, wealthy and wise in spite of themselves.} proc makequote {t quote} { variable quoteseq variable quotes set f .t.f[incr quoteseq($t)] set bg [.t cget -background] frame $f -background $bg -borderwidth 0 -relief flat grid [frame $f.bar -width 2 -background black] \ -row 0 -column 0 -sticky ns -padx {5 10} set t2 $f.t text $t2 -background $bg -font quotefont \ -relief flat -borderwidth 0 -highlightthickness 0 -wrap word bind $t2 <<WidgetViewSync>> "adjustquote %W %d" grid $t2 -row 0 -column 1 -sticky nsew grid rowconfigure $f 0 -weight 1 grid columnconfigure $f 1 -weight 1 grid propagate $f 0 $t2 insert 1.0 $quote\n lappend quotes($t) $t2 set inspt [.t index insert] .t insert $inspt \n blockquote .t window create $inspt -window $f } proc configuretext {t w} { variable quotes if {$t ne $w} return foreach q $quotes($t) { [winfo parent $q] configure -width [expr {[winfo width $t] - 25}] } } proc adjustquote {q insync} { if {!$insync} return set ph [$q count -ypixels 1.0 end-1l] [winfo parent $q] configure -height [expr {$ph + 5}] } font create quotefont -family Helvetica -size 10 -slant italic grid [text .t -width 80 -height 25 -background white -font {Helvetica 12}\ -yscrollcommand [list .y set]] \ -row 0 -column 0 -sticky nsew set quotes(.t) {} bind .t <Configure> "configuretext .t %W" grid [scrollbar .y -orient vertical -command [list .t yview]] \ -row 0 -column 1 -sticky nsew grid rowconfigure . 0 -weight 1 grid columnconfigure . 0 -weight 1 .t insert insert "Here is an interesting quote:\n" makequote .t $quote .t insert end " -- Robertson Davies\n" grid [ttk::sizegrip .grip] -row 1 -column 0 -columnspan 2 -sticky se