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
}