Version 5 of Text Collapser

Updated 2005-08-25 17:18:16 by lwv

WJG (25th August, 2005) I thought that it would be useful to 'collapse' or 'fold' text widget. So this is snippet I've come 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
        $path tag add $tag {sel.first lineend} sel.last
        $path tag configure $tag -foreground red 

        # create block toggle button
        button $path.$tag \
    -borderwidth 0 \
    -text {-} \
    -image collapser::downarrow \
    -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> {$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

See also Text widget elision


Category Widget