proc elidify w { set from 1.0 set id 0 #-- remove previous elidify buttons (if you have no other embedded widgets) foreach i [winfo children $w] { $w tag config $i -elide 0 $w tag delete $i destroy $i } while 1 { set here [$w search -regexp {\{$} $from end] if {$here eq ""} break set n 1 while {![info complete [$w get $here "$here + $n chars"]]} { if {[incr n]>65536} break ;#-- avoid runanway loops on unbalanced braces } set there [$w index "$here + $n chars"] set b $w.[incr id] button $b -text - -command "eliToggle $b" -pady 0 $w window create $here -window $b $w tag config $b -elide 0 $w tag add $b "$here + 1 char" "$there + 1 char" set from [$w index "$there + 2 chars"] } set id ;# returns the number of elidable sections }# This procedure is called whenever a "folding" button is clicked
proc eliToggle w { if {[$w cget -text] eq "-"} { $w config -text + [winfo parent $w] tag config $w -elide 1 } else { $w config -text - [winfo parent $w] tag config $w -elide 0 } }if 0 {Let's now test the whole thing on its own source code:}
pack [text .t -wrap word] -fill both -expand 1 set fp [open [info script]] .t insert end [read $fp] close $fp elidify .t
sbron 14 Sept 2005: Now what if you want to extract the text as shown at a certain point, for instance for printing it. You can't use [.t get 1.0 end] because that will include the elide text.In the Tcl Chatroom Pat Thoyts mentioned a quick and dirty method:
.t tag add sel 1.0 end set text [selection get] .t tag remove sel 1.0 endBut this has the sometimes unwanted side effect of changing the clipboard contents.Here's a method that doesn't have that disadvantage:
proc gettext {w {start 1.0} {end end}} { $w tag add gettext $start $end foreach n [$w tag names] { set elide [$w tag cget $n -elide] if {$elide eq ""} continue foreach {n1 n2} [$w tag ranges $n] { if {$elide} { $w tag remove gettext $n1 $n2 } else { $w tag add gettext $n1 $n2 } } } $w tag remove gettext 1.0 $start $end end set rc "" foreach {n1 n2} [$w tag ranges gettext] { append rc [$w get $n1 $n2] } $w tag delete gettext return $rc }
Arts and crafts of Tcl-Tk programming Category Widget