WJG (25th August, 2005) I thought that it would be useful to 'collapse' or 'fold' a selected range of content in a text widget. So, this is snippet I came up with.
#----------------------------------------------------------------
# TextCollapser.tcl
#----------------------------------------------------------------
# Create by William J Giddings, 2005
#
# Notes:
# Blocks can be nested.
#----------------------------------------------------------------
#----------------------------------------------------------------
# application namespace
#----------------------------------------------------------------
namespace eval collapser {
# tag base name
set tagbase cb_
# button data
image create photo collapser::downarrow -data R0lGODlhDAAMAJEAAP///9TQyAAAAAAAACwAAAAADAAMAAACEIyPqcudAqNQcq7orNu8qwIAOw==
image create photo collapser::uparrow -data R0lGODlhDAAMAJEAAP///9TQyAAAAAAAACwAAAAADAAMAAACEoyPqcsobcRrcq5qU6VZdQgmBQA7
image create photo collapser::button -data R0lGODlhDAAMAJEAAP////4AAAAAAAAAACwAAAAADAAMAAACGoSPJ8ttDUWaJ9iLDd5B8+t9HTVFDmAyZFIAADs=
}
#----------------------------------------------------------------
# obtain a unique name for a new block of text
#----------------------------------------------------------------
proc collapser::name {path} {
# get a sorted list of the current windows
set windowlist ""
foreach {a b c} [$path dump -window 1.0 end] {
if { [string first $path.$collapser::tagbase $b 0 ] != "-1" } {
lappend windowlist $b
}
}
set windowlist [lsort $windowlist]
# get the last one the list
set next [lindex $windowlist end]
# increment the number and return the new tag name
set j [string trimleft $next $path.${collapser::tagbase}]
if {$j == "" } {set j 0}
return ${collapser::tagbase}[incr j]
}
#----------------------------------------------------------------
# add a toolbar button
#----------------------------------------------------------------
proc collapser::addbutton {path} {
button $path -text Block -borderwidth 0 -command collapser::block -image collapser::button
pack $path -side left
}
#----------------------------------------------------------------
# create a new collapable text block
#----------------------------------------------------------------
proc collapser::block {} {
# get path to active widget
set path [focus]
# only works on text widgets
if {[winfo class $path]!="Text"} {return}
# get tag name for the new block
set tag [collapser::name $path]
# create and configure new tag
if { [catch { $path tag add $tag sel.first {sel.last lineend} }] } {return;}
$path tag configure $tag -foreground red
# create block toggle button
button $path.$tag \
-borderwidth 0 \
-text {-} \
-image collapser::downarrow \
-cursor hand2 \
-command "collapser::toggle $path $tag"
# add the button to the text
$path window create {insert linestart} -window $path.$tag
# remove text tagging if the button is deleted
bind $path.$tag <Destroy> [list $path tag delete $tag]
}
#----------------------------------------------------------------
# toggle tag settings
#----------------------------------------------------------------
proc collapser::toggle {path tag} {
if {[$path tag cget $tag -elide] == 1} {
$path tag configure $tag -elide 0
$path.$tag configure -text - -image collapser::downarrow
} else {
$path tag configure $tag -elide 1
$path.$tag configure -text + -image collapser::uparrow
}
}
#----------------------------------------------------------------
# demo code to test the package
#----------------------------------------------------------------
proc demo {} {
console show
frame .fr
pack .fr -fill x
text .txt -font {Ariel 12}
pack .txt -fill both -expand 1
focus .txt
collapser::addbutton .fr.b_1
}
#----------------------------------------------------------------
# the ubiquitious demo!
#----------------------------------------------------------------
demoescargo 26 Aug 2005 - I got this message deleting a tag:
if 0 {
can't read "path": no such variable
can't read "path": no such variable
while executing
"$path] tag delete $tag"
(command bound to event)
}I deleted the tag by selecting it and typing control-x on Windows XP Pro. When a tag is deleted, it appears that the text associated with the tag is also deleted.
It would be nice if the cursor shape could change over the tag.
LV on line 97 of this file, it looks like this bind is wrong
if 0 {
bind $path.$tag <Destroy> {$path] tag delete $tag}
}I don't see a reason for that ] in the command.
WJG (27 August,2005) Thanks for testing the code and giving the feedback. LV, fair comment on the stray ']' in the code. I've removed it. Escargo, the cursor, well, I've given it the finger. It now uses the Hand2 cursor.
escargo 29 Aug 2005 - I tried the new version, and found some interesting features that I don't think are intended.
There is still a problem deleting tags; I got this message deleting a tag:
if 0 {
can't read "path": no such variable
can't read "path": no such variable
while executing
"$path tag delete $tag"
(command bound to event)
}I deleted the tag by selecting it and typing control-x on Windows XP Pro.
MG I've made a couple of small changes to the code above, to make it work for me:
if 0 {
bind $path.$tag <Destroy> {$path} tag delete $tag}
has become
bind $path.$tag <Destroy> [list $path tag delete $tag]
}which fixes the error message above and removes an extra } in the code.
I also changed the range elided, from
if 0 {
$path tag add $tag {sel.first lineend} sel.last
to
$path tag add $tag sel.first {sel.last lineend}
}as before, the start index was greater than the end index, so it did nothing and nothing was elided. It might be better as just sel.first sel.last but I left the lineend in as I assume that's what the original author intended. I've also put an if / catch / return block around that line, so that if there is no selection, it just returns gracefully, instead of raising an error. Also fixed a typo of Ariel/Arial as the font in the demo.
See also Text widget elision