Proof of concept - embed blockqoute in text widget

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
    $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
    set en [font measure [.t cget -font] n]
    set ewidth [expr {[winfo width .t] / $en - 4}]
    if {$ewidth <= 0} {
	set ewidth 5
    }
    foreach q $quotes($t) {
	$q configure -width $ewidth
    }
    
}

proc adjustquote {w insync} {
    if {!$insync} return
    set ft [$w cget -font]
    set ls [font metrics $ft -linespace]
    set ph [$w count -ypixels 1.0 end-1l]
    set lc [expr {$ph / $ls}] 
    $w configure -height $lc
}

font create quotefont -family Helvetica -size 12

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 insert "   -- Robertson Davies\n"