[WJG] (15/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. Known problems: Using the popup menus will delete a note from the postit array and its tag from the text. Deleting a tag does not automatically remove the array element. [WJG] (15/Feb/06) Popups now working and transparency for windows, value of 0.97 works fine. [WJG] (16/Feb/06) Roll-over, 'tooltips' modifications to the package are coming follow soon. Should have delete fixed by the weekend... #--------------- # 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. # #--------------- set DEMO(postit) yes namespace eval postit { # always use ttd source ttd.tcl set bindings ;# # set available colours set magenta \#fd0ae51effff set yellow \#f3bfffff90a3 set blue \#d851d8b7ffff set cyan \#deb7feffffff set green \#d851ffffd8b7 set orange \#ffffd5b568f5 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-*-*-*-*-*-* # the new way set small {{Arial 8}} set medium {{Arial 10}} set large {{Arial 12}} # 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 } #--------------- # #--------------- namespace eval postit { # declare package variables set tagno 0 # intialiase variables set base .postit # set version set version 1.0 # tag index set activeTag 0 set activeText 0 # set available colours set magenta \#fd0ae51effff set yellow \#f3bfffff90a3 set blue \#d851d8b7ffff set cyan \#deb7feffffff set green \#d851ffffd8b7 set orange \#ffffd5b568f5 # set available fonts set small -Adobe-Helvetica-Medium-R-Normal-*-*-100-*-*-*-*-*-* set medium -Adobe-Helvetica-Medium-R-Normal-*-*-120-*-*-*-*-*-* set large -Adobe-Helvetica-Medium-R-Normal-*-*-140-*-*-*-*-*-* # set default value for popupmenu set font $medium # default parameters for tags set fg red set ul 1 set bindings ;# } #---------------------------------------------------------------------- # 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 } #--------------- # #--------------- 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 \{\}" # add binding postit:setBindings [focus] $a } #--------------- # 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 "300x200+$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 "postit:save $a ; postit:check" # initialize popumenus bind .postit.txt { 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 } #--------------- # perform routine ballancing # up between text tags and array #--------------- proc postit:check {} { } #--------------- # 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 foreach {state font bgclr txt} $::postit::postit($a) {} .rollover.txt insert end $txt .rollover.txt configure -state disabled } #---------------- # compare list a with b #---------------- proc listcomp {a b} { set diff {} foreach i $a { if {[lsearch -exact $b $i]==-1} { lappend diff $i } } return $diff } #--------------- # 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 s postit:setBindings $w $a } close $fp } #--------------- # #--------------- proc postit:setBindings {w a} { # add binding s $w tag bind postit_$a $::postit::bindings "postit:show $w $a" $w tag bind postit_$a " set ::postit::lastcursor [$w cget -cursor] $w config -cursor arrow after 1000 postit:rollover $w $a " $w tag bind postit_$a { %W config -cursor $::postit::lastcursor if {[winfo exists .rollover]} {destroy .rollover} } } if {$DEMO(postit)} { catch {console show} postit:demo } ---- [Category Application]