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 (15/Feb/06) 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.
#
#---------------
set DEMO(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 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 <Control-Button-1> ;# <Control-Button-1>
}
#----------------------------------------------------------------------
# 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 \{<emtpy>\}"
# 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 <FocusOut> "postit:save $a ; postit:check"
# 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
}
#---------------
# 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 <Empty>
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 <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}
}
}
if {$DEMO(postit)} {
catch {console show}
postit:demo
}