Postits -Providing Embedded Annotation Functionality to TK Text Widgets

WJG (20/Feb/06) When reading through a physical piece of writing sometimes it's necessary to add a little note to the text. Some simple comment as an aide memoir. When using a WP package one is always tempted to make changes to the text itself that are often for the worse It's always much better to add one of those little bits of sticky paper to the book, journal or draft, which can be read before any drastic changes are made. Perhaps the stickies contain some other useful info, such as a further references, comments or alternative readings. So, here's an IT equivalent. We have lots of stickies apps. that allow notes to be pasted to the desktop as an extension to putting them on the monitor frame, but here's a version for the text editor itself.


rdt and, of course _everybody_ knows just where to get ttd.tcl, its only the stupid ones like me that don't know where it is or who Bryan Oakley happens to be! :). APN See the ttd page for a copy.

Bryan Oakley wow, I had no idea anybody used that ttd stuff. I did that years ago. Glad it's useful for something...

WJG ttd? yep. Use it every day. "Wouldn't leave home without it!"


 #---------------
 # postit.tcl
 #---------------
 # Created by William J Giddings, 2006
 #
 # Purpose:
 # -------
 # Provide a simple package to enable the creation 
 # of embedded postits within a Tk text widget. 
 # Included within the package is load/save via 
 # Brian Oakley's ttd package. A data file is created
 # as a list two entries. The first is the ttd dump of
 # the text including tags, the second a list of postits
 # including individual configurations and text.
 #
 # Notes:
 # -----
 # The array ::postits::postits contains the postit
 # window parameters.
 #
 # Usage:
 # -----
 # * Ctrl-B1 will cause postit window to open.
 # * Hovering mouse pointer over tag for more than 1sec
 #   will cause rollover display of postit content.
 #
 # Acknowledgments:
 # ---------------
 # Bryan Oakley: ttd package. https://wiki.tcl-lang.org/5790
 #---------------
 set DEMO(postit) yes
 set DEBUG(postit) yes

 #---------------
 # initislise namespace to hold postit variables
 #---------------
 namespace eval postit {
  # always use ttd
  source ttd.tcl
  # binding to activate postit edit window
        set bindings <Control-Button-1>
        # set available colours
        set magenta \#fd0ae51effff  
        set yellow  \#f3bfffff90a3 
        set blue    \#d851d8b7ffff         
        set cyan    \#deb7feffffff   
        set green   \#d851ffffd8b7 
        set orange  \#ffffd5b568f5  
        # set rollover colour
        set rollover #ffffdd
  # set available fonts -the old way
        set small   -Adobe-Helvetica-Medium-R-Normal-*-*-100-*-*-*-*-*-*
        set medium  -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-*
        set large   -Adobe-Helvetica-Medium-R-Normal-*-*-140-*-*-*-*-*-*
        # posit window size
        set width 250
        set height 150
  # set transparency for Windows only
  if {$tcl_platform(platform)=="windows"} { set trans 0.97 }
  # set default postit settings
  set default "$::postit::medium  $::postit::magenta"
  # index of active postit
  variable active
 }

 #----------------------------------------------------------------------
 # posit popup menus 
 #----------------------------------------------------------------------
 menu .pipopup  -tearoff 0
 #
 # Lock/Unlock *
 # ----------- *
 # Undo *
 # Redo *
 # -----------
 # Delete
 # -----------
 # Textsize > S M L
 # Colors > Magenta Yellow Blue Cyan Green Orange
 #
 .pipopup add command -label Lock \
    -command {
      if { [.pipopup entrycget 0 -label] == "Unlock" } {
        .postit.txt configure -state normal
        .pipopup entryconfigure 0 -label "Lock"
            } else {    
        .postit.txt configure -state disabled
        .pipopup entryconfigure 0 -label "Unlock"
      } } 
 #---
        .pipopup add separator
        .pipopup add command -label "Undo" \
                -command {.postit.txt edit undo} ;# -accelerator "Ctrl-z"
        .pipopup add command -label "Redo" \
                -command { .postit.txt edit redo} ;# -accelerator "Ctrl-Z"
        .pipopup add separator
        .pipopup add command -label "Delete" -command { postit:delete }
 #---
        .pipopup add separator
        .pipopup add cascade -label "Text" -menu .pipopup.cas1    
        menu .pipopup.cas1 -tearoff 0
        .pipopup.cas1 add radiobutton -label "Small" -variable ::postit::font -value $::postit::small -command {
                .postit.txt config -font $::postit::font
                }
        .pipopup.cas1 add radiobutton -label "Medium" -variable ::postit::font -value $::postit::medium -command {
                .postit.txt config -font $::postit::font
                }
        .pipopup.cas1 add radiobutton -label "Large" -variable ::postit::font -value $::postit::large -command {
                .postit.txt config -font $::postit::font
                }     
 #---
        .pipopup add cascade -label "Colors" -menu .pipopup.cas2
        menu .pipopup.cas2 -tearoff 0
        foreach i { Magenta Yellow Blue Cyan Green Orange } {
            switch $i {
                         Magenta { set tmp $::postit::magenta }
                         Yellow  { set tmp $::postit::yellow }
                         Blue    { set tmp $::postit::blue }
                         Cyan    { set tmp $::postit::cyan }
                         Green   { set tmp $::postit::green }
                         Orange  { set tmp $::postit::orange }
                        } 
                  .pipopup.cas2 add command -label $i \
        -background $tmp \
        -command "catch { .postit.txt config -background $tmp }"
  }

 #---------------
 # display popup menu
 #---------------
 proc postit:showPopup {w x y m} {
  # popup-menu bindings
  # get global X/Y position of app
        set gx [winfo rootx $w]
        set gy [winfo rooty $w]
  # add to local mouse position
        set mx [expr $gx + $x]
        set my [expr $gy + $y]
  # display popup menu
        tk_popup $m $mx $my
 }


 #---------------
 # add new postit tag to selected text
 #---------------
 proc postit:add {} {
  # some entries may become delete, 
  # NEED TO MODIFY THIS SECTION
  set a [array size ::postit::postit]
  set ::postit::postit([incr a]) {}
  # tag the text    
  [focus] tag add postit_$a sel.first sel.last
  [focus] tag configure postit_$a -foreground red
  # set some default values for the new array entry
  set ::postit::postit_$a "normal $::postit::medium $::postit::magenta \{<emtpy>\}"
  # add binding
  postit:setBindings [focus] $a
  # check the text for any deletions
  bind [focus] <Key> {puts %K}
 }

 #---------------
 # accessed from postit popup menu
 # delete tags and associated data
 #---------------
 proc postit:delete {} {
  puts $::postit::active
  .txt tag delete postit_$::postit::active
  array unset ::postit::postit $::postit::active
  if {[winfo exists .postit]} { destroy .postit }
 }

 #----------------
 # list tags within text object
 #----------------
 proc postit:listall { {pref postit_}} {
  global fruit
  set taglist {}
  foreach {a tag c} [.txt dump -tag 1.0 end] {
    # trim out tag prefix
    set tag [string trimleft $tag $pref ]
    # add new tags to a list
    if {[lsearch $taglist $tag]=="-1"} {
      # sort the list
      set taglist [lsort [lappend taglist $tag]]
      #puts $taglist
    }
  } 
  return  [lsort $taglist]
 }

 #---------------
 # dump text tags to console
 #---------------
 proc postit:dump {} {
  puts [[focus] dump -tag 1.0 end-1c]
 }

 #---------------
 # show postit window with text
 #---------------
 proc postit:show {w a} {
  global tcl_platform
  # keep track of active postit
  set ::postit::active $a
  # determine window position        
        scan [ postit:tagScreenPos $w postit_$a ] "%s %s" x y
  puts "Tag No: $a $x $y"
  # destroy any rollover window
  if {[winfo exists .rollover]} {destroy .rollover}
  # create new postit window
        if {[winfo exists .postit]} {destroy .postit}
  toplevel .postit
  wm withdraw .postit
  # set transparency for Windows only
  if {$tcl_platform(platform)=="windows"} {  
    wm attributes .postit -alpha $::postit::trans
  }
  wm geometry .postit "${::postit::width}x${::postit::height}+$x+$y"
        #wm transient .postit [winfo toplevel $w]
        wm overrideredirect .postit 1        ;# borderless
        wm deiconify .postit
        # add widgets
        text .postit.txt \
                -background $::postit::magenta \
                -font $::postit::medium  \
                -borderwidth 2 -relief groove -wrap word -width 24  -height 40  -undo 1
        pack .postit.txt -anchor center -expand 1 -fill both -side right
  # show window and set focus
        focus .postit.txt
        # modify bindings -this works!!!
  bind .postit.txt <FocusOut> "postit:save $a ; postit:check $w ::postit::postit postit_"
  # initialize popumenus
        bind .postit.txt <Button-3> {
                postit:showPopup %W %x %y .pipopup
                }
  # change note display settings
        foreach {state font bgclr txt} $::postit::postit($a) {}
        .postit.txt configure -state $state -font $font -background $bgclr
        .postit.txt insert end        $txt            
 }

 #---------------
 # display postit contents as a rollover effect
 # this is just to provide a quick indicator
 #---------------
 proc postit:rollover {w a} {
  # don't obscure any postit window
  if {[winfo exists .postit]} {return}
  # create new rollover every time
  if {[winfo exists .rollover]} {destroy .rollover}
  toplevel .rollover
  scan [ postit:tagScreenPos $w postit_$a ] "%s %s" x y
  wm geometry .rollover "200x50+$x+$y"
        #wm transient .rollover [winfo toplevel $w]
        wm overrideredirect .rollover 1        ;# borderless
        # add widgets
        text .rollover.txt \
                -background $::postit::rollover\
                -font $::postit::medium  \
                -borderwidth 1 -relief solid -wrap word -width 24  -height 40
        pack .rollover.txt -anchor center -expand 1 -fill both -side right 
  # insert text
  # change note display settings
  set txt <Empty>
        foreach {state font bgclr txt} $::postit::postit($a) {}
  .rollover.txt insert end $txt
  .rollover.txt configure -state disabled
 }

 #---------------
 # copy postit to internal buffer
 #---------------
 proc postit:save {a} {
                # keep settings
                set ::postit::postit($a) \
                "[.postit.txt cget -state] \{[.postit.txt cget -font]\} [.postit.txt cget -background] \{[.postit.txt get 1.0 end-1c]\}"
                # remove the postit window
                puts $::postit::postit($a)
                destroy .postit
 } 

 #---------------
 # determine screen position of tag
 #---------------
 proc postit:tagScreenPos {widget tag {side SW}} {
 # this will only work with tags that occur only once in a text widget.
        scan [$widget tag ranges $tag] "%s %s" start end ;# get the range in line.col coordinates
        scan [$widget bbox $start] "%s %s %s %s" xpos1 ypos1 width1 height1 ;# get bounds of **start** index
        scan [$widget bbox $end] "%s %s %s %s" xpos2 ypos2 width2 height2                 ;# get bounds of the **end** index
 #
 #
 #     NWx,NWy = (xpos1,ypos1)  **NW**-N----NE     
 #                                    |         |
 #                                    |         |
 #                                    W    C    E
 #                                    |         |
 #                                    |         |        
 #                                SW---S--**SE**  SEx,SEy = (xpos2 + $width2),(ypos2+height2) 
 #
 #     
 #    NWx,NWy = (xpos1,ypos1)         Nx,Ny   = ((NWx+SEx)/2,NWy)     NEx,NEy = (SEx,NWy)
 #    Wx,Wy   = (NWx,(NWy+SEy)/2)     Cx,Cy   = (Nx.Wy)               Ex,Ey   = (SEx,Wy)
 #    SWx,SWy = (NWx,SEy)             Sx,Sy   = (Nx,SEy)              SEx,SEy = ((xpos2 + $width2),(ypos2+height2)) 

 # get position of the widget on the root screen
        set rx [winfo rootx $widget]
        set ry [winfo rooty $widget]

 # create variables, could these be simplified?
        set NWx [expr $rx + $xpos1] ; set NWy [expr $ry + $ypos1]
        set SEx [expr $rx + $xpos2 + $width2] ; set SEy [expr $ry + $ypos2 + $height2]
 #--
        set Nx  [expr $NWx + ($SEx / 2)] ; set Ny $NWy
        set NEx $SEx ;        set NEy $NWy
 #--        
        set Wx $NWx ; set Wy [expr ($NWy + $SEy) / 2]
        set Cx $Nx ;        set Cy $Wy
        set Ex $SEx ;         set Ey $Wy
 #--
        set SWx $NWx ;         set SWy $SEy        
        set Sx $Nx ;        set Sy $SEy
 # decide how to handle the data
        switch $side {
                N  { return "$Nx $Ny"}
          NE { return "$NEx $NEy"}
                E  { return "$Ex $Ey"}
                SE { return "$SEx $SEy"}
                S  { return "$Sx $Sy"}
                SW { return "$SWx $SWy"}
                W  { return "$Wx $Wy"}
                NW { return "$NWx $NWy"}
                }
 }

 #---------------
 # read in dump of postits
 #---------------
 proc postit:write { {fname tmp.txt} } {
  set fp [open $fname w]
  foreach i [array names ::postit::postit] {
    puts $fp "\{$i\} \{$::postit::postit($i)\}"
    }
  close $fp
 }

 #---------------
 # read in dump of postits
 #---------------
 proc postit:read { {fname tmp.txt} } {
  set fp [open $fname r]
  catch {unset ::postit::postit}
  array set ::postit::postit [read $fp]
  close $fp
 }

 #---------------
 # the ubiquitous demo
 # the load/save functions merely load/save the file demo.txt
 #
 # To add a postit, select a block of text and click 'Add' button.
 # The selectio will be tagged. To edit, Ctrl-B1 over the tag. An
 # edit window will appear, which will have input focus. When the
 # focus is lost, the window will be destroyed after its content
 # had been store in the array ::postit::postit.
 #---------------
 proc postit:demo {} {
        console show
        wm title . "Postits V0.1a:"
        pack [frame .fr1] -side top -anchor nw
        button .fr1.but0 -text New -command {.txt delete 1.0 end ; array unset ::postit::postit} -width 10
        button .fr1.but1 -text Add -command {postit:add} -width 10
        button .fr1.but2 -text Dump -command {puts [postit:dump] } -width 10
        button .fr1.but3 -text Load -command {load} -width 10
  button .fr1.but4 -text Save -command {save} -width 10        
  pack .fr1.but0 .fr1.but1 .fr1.but2 .fr1.but3 .fr1.but4 -fill both -anchor nw -side left

        text .txt -width 50
        pack .txt -fill both -expand 1

        postit:init .txt
 }

 #---------------
 # save text file with embedded postits
 #---------------
 proc save {{w .txt} {fname demo.txt}} {
  set ttdData [ttd::get $w]
  set fp [open $fname w]

  # create file which is a list with 2 blocks
  # 1) text, in ttd format
  # 2) postits

  # write text block
  puts -nonewline $fp "\{$ttdData\}"

  # write postits block
  puts -nonewline $fp " \{"
  foreach i [array names ::postit::postit] {
    puts $fp "\{$i\} \{$::postit::postit($i)\}"
  }
  puts -nonewline $fp "\}"
  close $fp
 }


 #---------------
 # load text file with embedded posits
 #---------------
 proc load {{w .txt} {fname demo.txt}} {
  set fp [open $fname r]
  # read data, a list with two entries, text and postits
  set data [read $fp]  
  $w delete 1.0 end
  ttd::insert $w [lindex $data 0]
  array unset ::postit::postit
  foreach {a b} [lindex $data 1] {
    set ::postit::postit($a) $b
    # add binding s
    postit:setBindings $w $a
  }
  close $fp 
 }

 #---------------
 # initialise postit package
 #---------------
 proc postit:init {w} {
    # add bindings
    bind $w <Key> {
      switch %K {
        BackSpace -
        Delete {
          puts %K
          if {[info exists ::postit::postit]} { postit:check %W ::postit::postit postit_}
          }
      }
    }
 }

 #---------------
 # set bindings for the tagged text block
 #---------------
 proc postit:setBindings {w a} {
    # add binding s
    $w tag bind postit_$a $::postit::bindings "postit:show $w $a"  
    $w tag bind postit_$a <Enter> "
      set ::postit::lastcursor [$w cget -cursor]
      $w config -cursor arrow
      after 1000 postit:rollover $w $a
      "
    $w tag bind postit_$a <Leave> {
      %W config -cursor $::postit::lastcursor
      if {[winfo exists .rollover]} {destroy .rollover}
      }  
 }


 #----------------
 # compare tags and array, delete the differences
 # w text widget pathname
 # a data array
 # p prefix used for tags
 #----------------
 proc postit:check {w a p} {
  if {$::DEBUG(postit)} {
    puts $p
    puts $a
    puts Before:
    parray $a
    }
  # compare the two lists
  set i [array names $a]
  set j [postit:listall $w $p]
  set d [postit:listcomp $i $j ]
  # delete differences
  foreach i $d {
    $w tag delete $p$i
    array unset $a $i
    }
  if {$::DEBUG(postit)} {
    puts After:
    parray $a
    }  
 }

 #----------------
 # create a list of tags with specified prefix
 # w text widget pathname
 # p prefix used for tags
 #----------------
 proc postit:listall { w p} {
  set taglist {}
  foreach {a tag c} [$w dump -tag 1.0 end] {
    # trim out tag prefix to obtain the prefix
    set tag [string trimleft $tag $p]
    # add index to the list
    if {[lsearch $taglist $tag]=="-1"} {
      # sort the list
      set taglist [lsort [lappend taglist $tag]]
    }
  }
  return  [lsort $taglist]
 }

 #----------------
 # compare list a with b, return the difference
 #----------------
 proc postit:listcomp {a b} {
  set diff {}
  foreach i $a {
    if {[lsearch -exact $b $i]==-1} {
      lappend diff $i
    }
  }
  return $diff
 }

 if {$DEMO(postit)} {
  catch {console show} 
  postit:demo
 }