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

