WJG (15/Feb/06) When reading through a physcial piece of writing sometimes its 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. Its 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. which allow notes to be pasted to the desktop as an extention to putting them on the monitor frame but here's a version for the text editor itself.

Popups and roll-over 'tooltips' modifications to the package are coming follow soon.

 #---------------
 # 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 congigurations 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 Xms
 #   will cause tooltip to dislay postit content.
 #
 # Acknowledgments:
 # ---------------
 # Brian Oakey: ttd package.
 # XXX: window transparency.
 #
 #--------------- 

 set DEMO(postit) yes
 set DEBUG(postit) yes 

 namespace eval postit {

  # always use ttd
  source ttd.tcl

        set bindings <Control-Button-1> ;# <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 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-*-*-*-*-*-*

  # the new way
        set small  {{Arial 8}}
        set medium {{Arial 10}}
        set large  {{Arial 12}}

  # set default postit settings
  set default "$::postit::medium  $::postit::magenta"
 }

 #---------------
 # overload widget
 #---------------
 proc postit::add {args} {
  # tag the text

  set a [array size ::postit::postit]
  puts $a
  set ::postit::postit([incr a]) aaaa
  [focus] tag add postit($a) sel.first sel.last
  [focus] tag configure postit($a) -foreground red

  # add binding
  [focus] tag bind postit($a) $::postit::bindings "postit:show %W $a"

  # set some default values for the new array entry
  set ::postit::postit($a) "normal  $::postit::medium  $::postit::magenta"
 }

 #---------------
 # 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} {

  # determine window position        
        scan [ postit:tagScreenPos $w postit($a) ] "%s %s" x y
  puts "Tag No: $a $x $y"

  # create new posit window
        if {[winfo exists .postit]} {
    destroy .postit
  }
  toplevel .postit
        wm geometry .postit "300x200+$x+$y"
        #wm transient .postit [winfo toplevel $w]
        wm overrideredirect .postit 1        ;# borderless

        # add widgets
        text .postit.txt \
                -background $::postit::magenta \
                -font $::postit::medium  \
                -borderwidth 4 -relief ridge -wrap word -width 24  -height 40  -undo 1
        pack .postit.txt -in .postit -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"

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

 #---------------
 # 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"}
                } ;# end switch

 } ;# end proc


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

 #---------------
 # 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
    $w tag bind postit($a) $::postit::bindings "postit:show $w $a"    
  }

  close $fp
 }

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