#----------------------------------------------------------------
 # 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!
 #----------------------------------------------------------------
 demo

 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)
 }

 if 0 {
        bind $path.$tag <Destroy> {$path] tag delete $tag}
 }

1. If you select a region that include the end of a list (but not the whole line) you get a button that disappears when clicked, so you can not get it back to click it again.
2. On Microsoft Windows (at least) there are no scroll bars, but the underlying widget does honor scroll-mouse events.
3. It would be nice if it did have scroll bars.
4. It would be nice if there was a binding to restore all collapsed text. (Right button on the collapse icon maybe.)

 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)
 }

 if 0 {
        bind $path.$tag <Destroy> {$path} tag delete $tag}
 has become
        bind $path.$tag <Destroy> [list $path tag delete $tag]
 }

 if 0 {
        $path tag add $tag {sel.first lineend} sel.last
 to
        $path tag add $tag sel.first {sel.last lineend}
 }

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References