tkgoodstuff/tcl/Jots.tcl

1428 lines
40 KiB
Tcl
Raw Normal View History

# Jots Client Tcl code for tkgoodstuff
proc JotsDeclare {} {
set Prefs_taborder(:Clients,Jots) "Misc Geometry Button Colors"
set Prefs_taborder(:Clients,Jots,Button) "Misc Colors"
TKGDeclare Jots(dir) {$env(HOME)/.tkgjots} -typelist [list Clients Jots Misc]\
-label "Your Jots Directory"
TKGDeclare Jots(startwithnew) 0 -typelist [list Clients Jots Misc]\
-label "Create new item when opening a folder"\
-vartype boolean
TKGDeclare Jots(lines) 20 -typelist [list Clients Jots Geometry]\
-label "Height of text screen (lines)"
TKGDeclare Jots(columns) 60 -typelist [list Clients Jots Geometry]\
-label "Width of text screen (characters)"
TKGDeclare Jots(showfindtool) 0 -typelist [list Clients Jots Misc]\
-label "Show Find tool at startup"\
-vartype boolean
TKGDeclare Jots(showhotlist) 1 -typelist [list Clients Jots Misc]\
-label "Show HotList at startup"\
-vartype boolean
TKGColorDeclare Jots(hots_cur_bg) \#87ceff [list Clients Jots Colors]\
"HotList button background for current folder"
TKGColorDeclare Jots(hots_cur_fg) {} [list Clients Jots Colors]\
"HotList button foreground for current folder" $TKG(foreground)
TKGDeclare Jots(makebutton) 1 -typelist [list Clients Jots Button Misc]\
-label "Produce a button"\
-vartype boolean
TKGDeclare Jots(text) Jots -typelist [list Clients Jots Button Misc]\
-label "Label text"
TKGDeclare Jots(imagefile) %jots\
-typelist [list Clients Jots Button Misc] -label "Icon file"
ConfigDeclare Jots ClientButton1 Jots [list Clients Jots Button]
ConfigDeclare Jots ClientButton3 Jots [list Clients Jots Button]
}
proc JotsCreateWindow {} {
if [TKGReGrid JotsButton] return
uplevel {
set Jots(hotfile) "$Jots(dir)/.hotjots"
set Jots(hots_cur_abg) $Jots(hots_cur_bg)
set Jots(hots_cur_afg) $Jots(hots_cur_fg)
}
global Jots
if $Jots(makebutton) {
lappend c TKGMakeButton JotsButton -balloon {Jots notecard manager}
foreach switch {
iconside ignore font imagefile text foreground background
activeforeground activebackground relief
} {
lappend c -$switch $Jots($switch)
}
set w [eval $c]
bind $w <1> +JotsPopup
} else {
TKGAddToHook TKG_clientwindowscreated_hook \
{if { [lsearch $TKG(clients) Clock ] != -1 } {
RecursiveBind [set Clock_window] <3> {JotsPopup}
}}
}
}
proc JotsPopup {} {
global Jots env
if $Jots(makebutton) {
upvar #0 JotsButton-params P
if ![string match [$P(pathname) cget -relief] sunken] {
$P(pathname) configure -relief sunken
}
}
set Jots(index) 0
set Jots(selectfolders) 1
set Jots(edited) -1
set Jots(openfolders) ""
set w .jots
if [winfo exists $w] {
wm deiconify $w
focus $w
raise $w
return
}
toplevel $w
wm withdraw $w
wm title $w "Jots"
wm iconname $w "Jots"
wm protocol $w WM_DELETE_WINDOW JotsFinalExit
frame $w.menu -relief raised -bd 2
grid columnconfigure $w 0 -weight 1
grid $w.menu -sticky ew -row 0 -column 0
# pack $w.menu -side top -fill x
set m $w.menu.file.m
menubutton $w.menu.file -text "File" -menu $m
menu $m
$m add command -label "Open folder" -command JotsOpen
$m add command -label "New folder" -command JotsNew
$m add command -label "Merge into current folder" -command JotsMerge
$m add cascade -label "Go to open folder" -menu .jots.menu.file.m.openfolders
menu .jots.menu.file.m.openfolders
$m add separator
$m add command -label "Save current folder" -command JotsSave
$m add command -label "Save current folder as ..." -command JotsSaveAs
$m add command -label "Save to ascii file ..." -command JotsSaveAscii
$m add separator
$m add command -label "Close current folder ..." -command JotsClose
$m add command -label "Delete current folder ..." -command JotsDeleteFolder
$m add separator
$m add command -label "Exit ..." -command "JotsExit"
set m $w.menu.hotlist.m
menubutton $w.menu.hotlist -text "Hotlist" -menu $m
menu $m
$m add command -label "Add folder to hot list" -command JotsAddHot
$m add command -label "Remove folder from hot list" -command JotsRemoveHot
$m add separator
set m $w.menu.edit.m
menubutton $w.menu.edit -text "Edit" -menu $m
menu $m
$m add command -label "Cut Entry" -command JotsCut
$m add command -label "Copy Entry" -command JotsCopy
$m add command -label "Paste" -command JotsPaste
set m $w.menu.find.m
menubutton $w.menu.find -text "Find" -menu $m
menu $m
$m add checkbutton -label "Show Find Tool" -variable Jots(showfindtool)
trace variable Jots(showfindtool) w JotsPackFind
$m add separator
pack $w.menu.file $w.menu.edit $w.menu.find $w.menu.hotlist -side left
set m $w.menu.help.m
menubutton $w.menu.help -text "Help" -menu $m
menu $m
$m add command -label "About Jots" -command JotsAbout
$m add separator
$m add command -label "Help" -command JotsHelp
pack $w.menu.help -side right
frame $w.hots
# pack $w.hots -side top -fill x -padx .1c -pady .1c -expand n
grid $w.hots -row 1 -column 0 -sticky ew -padx .1c -pady .1c
set Jots(hotswindow) $w.hots
grid rowconfigure $w 2 -weight 1
frame $w.middle
grid rowconfigure $w.middle 0 -weight 1
grid columnconfigure $w.middle 0 -weight 1
set ww $w.middle.jotsentry
frame $ww -relief sunken -bd 3
grid columnconfigure $ww 0 -weight 1
grid rowconfigure $ww 0 -weight 1
frame $ww.view
grid columnconfigure $ww.view 0 -weight 1
grid rowconfigure $ww.view 0 -weight 1
text $ww.view.text -width $Jots(columns) -height $Jots(lines)\
-takefocus 0 -yscrollcommand "$ww.view.scrollbar set" \
-relief sunken -borderwidth 2 -state disabled -wrap word
set Jots(textwindow) $ww.view.text
grid $ww.view.text -row 0 -column 0 -sticky nsew
scrollbar $ww.view.scrollbar -command "$ww.view.text yview"
grid $ww.view.scrollbar -row 0 -column 1 -sticky nsew -padx 2
$ww.view.text configure -state normal
grid $ww.view -row 0 -column 0 -sticky nsew -pady .3c -padx .3c
frame $ww.indices
foreach i {0 1 2} {
grid columnconfigure $ww.indices $i -weight 1
}
frame $ww.indices.jots_folder
grid columnconfigure $ww.indices.jots_folder 1 -weight 1
label $ww.indices.jots_folder.jots_folderlabel -text Folder:
grid $ww.indices.jots_folder.jots_folderlabel -row 0 -column 0
entry $ww.indices.jots_folder.jots_folderentry \
-textvariable Jots(folder) -takefocus 0 -state disabled -relief flat
grid $ww.indices.jots_folder.jots_folderentry -row 0 -column 1 -sticky ew
frame $ww.indices.jots_date
grid columnconfigure $ww.indices.jots_date 1 -weight 1
label $ww.indices.jots_date.jots_datelabel -text Date:
grid $ww.indices.jots_date.jots_datelabel -row 0 -column 0
entry $ww.indices.jots_date.jots_dateentry\
-textvariable Jots(date) -width 18 -takefocus 0 -state disabled -relief flat
grid $ww.indices.jots_date.jots_dateentry -row 0 -column 1 -sticky ew
frame $ww.indices.jots_time
grid columnconfigure $ww.indices.jots_time 1 -weight 1
label $ww.indices.jots_time.jots_timelabel -text Time:
grid $ww.indices.jots_time.jots_timelabel -row 0 -column 0
entry $ww.indices.jots_time.jots_timeentry \
-textvariable Jots(time) -width 5 -takefocus 0 -state disabled -relief flat
grid $ww.indices.jots_time.jots_timeentry -row 0 -column 1 -sticky ew
$ww.indices.jots_folder.jots_folderentry configure -background [$ww.view cget -background]
$ww.indices.jots_date.jots_dateentry configure -background [$ww.view cget -background]
$ww.indices.jots_time.jots_timeentry configure -background [$ww.view cget -background]
grid $ww.indices.jots_folder $ww.indices.jots_date $ww.indices.jots_time\
-row 0 -sticky ew -padx .2c -pady .1c
grid $ww.indices -row 1 -column 0 -sticky ew
grid $ww -row 0 -column 0 -sticky nsew
grid $w.middle -row 2 -column 0 -sticky nsew -padx .3c -pady .2c
scrollbar $w.scroll -orient horizontal -command "JotsScroll" \
-width .7c
grid $w.scroll -row 3 -column 0 -sticky ew -pady .3c -padx .3c
set Jots(SB) $w.scroll
trace variable Jots(index) w JotsSUpdate
frame $w.buttons
button $w.buttons.new -command JotsNewEntry -text "New\nEntry"
pack $w.buttons.new -side left -expand y -fill y -padx .4c -pady .4c
button $w.buttons.del -command JotsCut -text "Delete\nEntry"
pack $w.buttons.del -side left -expand y -fill y -padx .4c -pady .4c
button $w.buttons.prev -command JotsPrev -text "Previous\nEntry"
pack $w.buttons.prev -side left -expand y -fill y -padx .4c -pady .4c
button $w.buttons.next -command JotsNext -text "Next\nEntry"
pack $w.buttons.next -side left -expand y -fill y -padx .4c -pady .4c
button $w.buttons.dismiss -text "Save All\nand Exit"\
-command JotsDismiss
pack $w.buttons.dismiss -side left -expand y -fill y -padx .4c -pady .4c
grid $w.buttons -row 5 -sticky ew
bind $Jots(textwindow) <Key> {set Jots(edited) $Jots(index)}
bind $Jots(textwindow) <Button> {set Jots(edited) $Jots(index)}
RecursiveBind $w <Meta-s> {JotsSave;break}
RecursiveBind $w <Meta-q> {JotsDismiss;break}
RecursiveBind $w <Meta-x> {JotsDismiss;break}
RecursiveBind $w <Shift-Right> {JotsNext;break}
RecursiveBind $w <Shift-Left> {JotsPrev;break}
RecursiveBind $w <Shift-Meta-D> {JotsCut;break}
RecursiveBind $w <Shift-Meta-N> {JotsNewEntry;break}
JotsDirInit
}
######################################
# File handling routines
######################################
proc JotsDirInit {} {
global Jots
set Jots(oldcwd) [pwd]
if [file exists $Jots(dir)] {
if ![file isdirectory $Jots(dir)] {
TKGError "$Jots(dir) (selected as your Jots directory) is not a directory"
JotsExit
return
}
if { ![file readable $Jots(dir)] ||
![file writable $Jots(dir)] ||
![file executable $Jots(dir)] } {
if [file owned $Jots(dir)] {
if [catch "exec chmod u+rwx $Jots(dir)" err ] {
TKGError "Can't set permissions on \"$Jots(dir)\" (selected\
as your Jots directory): $err"
JotsExit
return
}
JotsDirOpen
} else {
TKGError "You have inadequate permissions for\
directory \"$Jots(dir)\" (selected as your Jots directory), and you don't own it."
JotsExit
return
}
}
JotsDirOpen
return
}
TKGDialog jotspop\
-title "Jots:"\
-message "Directory \"$Jots(dir)\", needed for Jots, does not exist." \
-nodismiss \
-buttons {
{ create "Create it" {
if [catch "exec mkdir $Jots(dir)" text] {
error $text
}
if [catch "exec chmod 750 $Jots(dir)" err] {
error $err
}
destroy .jotspop
JotsDirOpen
}
}
{ exit "Exit Jots" {
destroy .jotspop
JotsExit
}
}
}
}
proc JotsDirOpen {} {
global Jots
cd $Jots(dir)
if [catch "set filelist \"[exec /bin/ls $Jots(dir)]\"" err] {
TKGError $err
return
}
set Jots(folderlist) ""
set Jots(hotlist) ""
if {"$filelist" != ""} {
foreach f $filelist {
if [Jotsisfolder $f] {
lappend Jots(folderlist) $f
}
}
}
if {$Jots(folderlist) == ""} {
JotsCreateFolder Notes
set Jots(folder) Notes
set Jots(folderlist) [list Notes]
}
JotsGetHots
}
proc JotsGetHots {} {
global Jots
if ![file exists $Jots(hotfile)] {
set Jots(hotlist) ""
if {[lsearch $Jots(folderlist) $Jots(folder)] == -1 } {
if {$Jots(folder) == "" } {
set Jots(folder) [lindex $Jots(folderlist) 0]
}
}
} else {
source $Jots(hotfile)
set sanelist ""
foreach folder $Jots(hotlist) {
if {[lsearch $Jots(folderlist) $folder] != -1} {
lappend sanelist $folder
}
}
set Jots(hotlist) $sanelist
if {[lsearch $Jots(folderlist) $Jots(folder)] == -1 } {
if {[set Jots(folder) [lindex $Jots(hotlist) 0]] == ""} {
set Jots(folder) [lindex $Jots(folderlist) 0]
}
}
}
if {[llength $Jots(hotlist)] > 0} { setifunset Jots(showhotlist) 1 }
.jots.menu.hotlist.m add checkbutton -label "Show hot list" -variable Jots(showhotlist)
trace variable Jots(showhotlist) w JotsUpdateHots
JotsFinishInit
}
proc JotsFinishInit {} {
global Jots
set JotsGoto ""
trace variable Jots(Goto) w JotsGotoInvoke
trace variable Jots(folder) w JotsGotoUpdate
JotsPackFind
set f $Jots(folder)
set Jots(folder) ""
JotsGotoFolder $f
if $Jots(startwithnew) {
JotsNewEntry
}
TKGCenter .jots
}
proc JotsGotoUpdate args {
global Jots
set Jots(Goto) $Jots(folder)
}
proc JotsGotoInvoke args {
global Jots
if {$Jots(Goto) != $Jots(folder)} {
JotsGotoFolder $Jots(Goto)
}
}
proc JotsSaveHots {} {
global Jots
if [catch "set id [ open $Jots(hotfile) w ]" err] {
error $err
return 0
}
puts $id "set Jots(hotlist) \{$Jots(hotlist)\}"
puts $id "setifunset Jots(folder) $Jots(folder)"
close $id
return 1
}
proc Jotsisfolder {f} {
if ![file readable $f] {
TKGError "Error: $f isn't readable."
return
}
if ![file writable $f] {
TKGError "Error: $f isn't writable."
return
}
set id [open $f]
gets $id s
close $id
if {$s != "\#Jots Folder"} {
return 0
} else {
return 1
}
}
proc JotsCreateFolder {f} {
global Jots
if [file exists $f] {
TKGError "can't create $f: folder exists"
return
}
if [catch "exec touch $f"] {
TKGError "can't create $f."
return
}
set id [ open $f w ]
puts $id "\#Jots Folder"
puts $id "set JotsList \{\}"
close $id
lappend Jots(folderlist) $f
JotsGotoFolder $f
}
proc JotsOpen {} {
global Jots
if ![select f "Open folder:"] {
return
}
if ![file exists $f] {
TKGDialog jotsopen \
-image question\
-title Jots: \
-message "Folder \"$f\" doesn't exist."\
-buttons [subst {
{ create "Create it" {JotsCreateFolder $f;destroy .jotsopen} }
}]
return
}
if ![file readable $f] {
TKGError "$f isn't readable."
return
}
JotsGotoFolder $f
}
proc JotsMerge {} {
global Jots
global $Jots(folder)-jf
JotsUpdateList
if ![select f "Merge from folder:"] {
return
}
if ![file exists $f] {
TKGDialog jotsmerge \
-image question\
-title Jots: \
-message "Folder \"$f\" doesn't exist."\
-buttons [subst {
{ create "Create it" {JotsCreateFolder $f;destroy .jotsmerge} }
}]
return
}
if ![file readable $f] {
TKGError "$f isn't readable."
return
}
if {[lsearch $Jots(openfolders) $f] == -1 } {JotsGet $f}
global $f-jf
set l [lsort [concat [set $Jots(folder)-jf(list)] [set $f-jf(list)]]]
set $Jots(folder)-jf(list) ""
for {set i 0} {$i < [llength $l]} {incr i} {
lappend $Jots(folder)-jf(list) [lindex $l $i]
if {[lindex $l $i] == [lindex $l [expr $i + 1]]} {incr i}
}
if {[lsearch $Jots(openfolders) $f] == -1 } { unset $f-jf }
set Jots(index) [expr [llength [set $Jots(folder)-jf(list)]] - 1]
JotsDisplay
}
proc JotsNew {} {
if ![select f "New folder name:"] {
return
}
JotsCreateFolder $f
}
proc JotsDeleteFolder {} {
global Jots
TKGDialog jotsdf \
-title Jots:\
-image question\
-message "Delete folder \"$Jots(folder)\"?"\
-nodismiss \
-buttons {
{ yes Yes {
if {[set i [lsearch $Jots(hotlist) $Jots(folder)]] != -1} {
set Jots(hotlist) [lreplace $Jots(hotlist) $i $i]
}
exec /bin/rm $Jots(folder)
JotsCloseFolder
destroy .jotsdf
} }
{ no Cancel {
destroy .jotsdf
} }
}
}
proc JotsClose {} {
global Jots
global $Jots(folder)-jf
JotsUpdateList
set templist [set $Jots(folder)-jf(list)]
JotsGet $Jots(folder)
if {[set $Jots(folder)-jf(list)] != $templist} {
TKGDialog jotsclose \
-title "Jots: folder has changed"\
-image question\
-message "Save folder \"$Jots(folder)\" before closing?"\
-nodismiss \
-buttons {
{ yes Yes {
JotsSaveFolder $Jots(folder)
JotsCloseFolder
destroy .jotsclose
} }
{ no No {
JotsCloseFolder
destroy .jotsclose
} }
{ cancel Cancel {
destroy .jotsclose
} }
}
} else {
JotsCloseFolder
}
}
proc JotsCloseFolder {} {
global Jots
global $Jots(folder)-jf
.jots.menu.file.m.openfolders delete $Jots(folder)
unset $Jots(folder)-jf
if {[set i [lsearch $Jots(folderlist) $Jots(folder)]] != -1} {
set Jots(folderlist) [lreplace $Jots(folderlist) $i $i]
}
if {[set i [lsearch $Jots(openfolders) $Jots(folder)]] != -1} {
set Jots(openfolders) [lreplace $Jots(openfolders) $i $i]
}
set Jots(folder) ""
if {[llength $Jots(hotlist)] != 0} {
JotsGotoFolder [lindex $Jots(hotlist) 0]
} elseif {[llength $Jots(folderlist)] != 0} {
JotsGotoFolder [lindex $Jots(folderlist) 0]
} else {
JotsDirOpen
}
}
proc JotsSave {} {
global Jots
JotsSaveFolder $Jots(folder)
}
proc JotsSaveFolder {f} {
global $f-jf
set id [ open $f w ]
puts $id "\#Jots Folder"
JotsUpdateList
puts $id "set JotsList \{[set $f-jf(list)]\}"
close $id
return 1
}
proc JotsSaveAs {} {
global Jots
if ![select f "Folder name:"] {
return 0
}
if [file exists $f] {
TKGError "can't create $f: folder exists"
return 0
}
if [catch "exec touch $f"] {
TKGError "can't create $f."
return 0
}
global $f-jf $Jots(folder)-jf
set $f-jf [set $Jots(folder)-jf]
JotsSaveFolder $f
JotsGotoFolder $f
return 1
}
proc JotsSaveAscii {} {
global Jots
global $Jots(folder)-jf
JotsUpdateList
cd $Jots(oldcwd)
set Jots(selectfolders) 0
if ![select f "Name for Ascii File:"] {
return 0
}
if [file exists $f] {
TKGError "can't create $f: file exists"
return 0
}
if [catch "exec touch $f"] {
TKGError "can't create $f."
return 0
}
set id [ open $f w ]
puts $id "Jots Folder \"$Jots(folder)\" as of [clock format [clock seconds]]\n"
foreach entry [set $Jots(folder)-jf(list)] {
puts $id "\n-------\n\nDATE: [lindex $entry 0] TIME: [lindex $entry 1]"
puts $id [JotsWrap [lindex $entry 2]]
}
close $id
cd $Jots(dir)
return 1
}
proc JotsWrap {text} {
global Jots
set linelist [split $text "\n"]
set outtext ""
foreach line $linelist {
set s ""
set wordlist [split $line]
foreach word $wordlist {
if {$s == ""} {
set s $word
} elseif {[string length "$s $word"] <= $Jots(columns)} {
set s "$s $word"
} else {
set outtext "$outtext\n$s"
set s $word
}
}
if {$s != ""} { set outtext "$outtext\n$s" }
}
return $outtext
}
proc JotsGet {f} {
global $f-jf Jots
source $f
set $f-jf(list) $JotsList
if {([set $f-jf(list)] != "") && ([llength [lindex [set $f-jf(list)] 0]] == 3) } {
JotsReformatOldstyleList $f
}
set $f-jf(index) [expr [llength [set $f-jf(list)]] - 1]
set Jots(index) [set $f-jf(index)]
}
proc JotsReformatOldstyleList {f} {
global $f-jf
set months [list Zero Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec]
set weekdays [list Sun Mon Tue Wed Thu Fri Sat]
set newlist {}
foreach entry [set $f-jf(list)] {
set olddate [split [lindex $entry 0] ,]
set oldtime [split [lindex $entry 1] :]
set weekday [lsearch $weekdays [string trim [lindex $olddate 0]]]
set month [format %02d [lsearch $months [string trim [lindex [lindex $olddate 1] 0]]]]
set date [format %02d [string trim [lindex [lindex $olddate 1] 1]]]
set year [format %04d [string trim [lindex $olddate 2]]]
set hour [format %02d [TKGZeroTrim [string trim [lindex $oldtime 0]]]]
set minute [format %02d [TKGZeroTrim [string trim [lindex $oldtime 1]]]]
set seconds "00"
set datelist [list $year $month $date $hour $minute $seconds $weekday]
lappend newlist [list $datelist [lindex $entry 2]]
}
set $f-jf(list) $newlist
}
##########################
# General display, maneuvering, and deleting routines
#
proc JotsScroll {cmd {num ""} {unit ""}} {
global Jots
global $Jots(folder)-jf
switch -- $cmd {
moveto {
if {$num > 1} {set num .999}
if {$num < 0} {set num 0}
set di [expr int( ([llength [set $Jots(folder)-jf(list)]] * $num)) ]
if {$di != $Jots(index)} {
set Jots(index) $di
JotsUpdateList
JotsDisplay
}
} scroll {
switch -- $num {
-1 {
JotsPrev
} 1 {
JotsNext
}
}
} default {
return
}
}
}
proc JotsSUpdate args {
global Jots
global $Jots(folder)-jf
if [info exists $Jots(folder)-jf(list)] {
set w [expr 1/([llength [set $Jots(folder)-jf(list)]] + 0.00001)]
$Jots(SB) set [expr $w * $Jots(index)] [expr $w * ($Jots(index) + 1)]
}
}
proc JotsUpdateList {} {
global Jots
global $Jots(folder)-jf
set Jots(findmessage) ""
if {([set $Jots(folder)-jf(list)] != {}) && ($Jots(edited) != -1)} {
set text [$Jots(textwindow) get 1.0 {end - 1 chars}]
set $Jots(folder)-jf(list) [lreplace [set $Jots(folder)-jf(list)] $Jots(edited) $Jots(edited) \
[list $Jots(datelist) \
$text ]]
}
}
proc JotsDisplay args {
global Jots
global $Jots(folder)-jf
set months [list Zero Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec]
set weekdays [list Sun Mon Tue Wed Thu Fri Sat]
set Jots(date) ""
set Jots(time) ""
set text ""
$Jots(textwindow) configure -state normal
$Jots(textwindow) delete 1.0 end
if { [set $Jots(folder)-jf(list)] != "" } {
set entry [lindex [set $Jots(folder)-jf(list)] $Jots(index)]
set Jots(datelist) [lindex $entry 0]
set weekday [lindex $weekdays [TKGZeroTrim [lindex $Jots(datelist) 6]]]
set month [lindex $months [TKGZeroTrim [lindex $Jots(datelist) 1]]]
set date [TKGZeroTrim [lindex $Jots(datelist) 2]]
set year [lindex $Jots(datelist) 0]
set Jots(date) "$weekday, $month $date, $year"
set Jots(time) "[lindex $Jots(datelist) 3]:[lindex $Jots(datelist) 4]"
set text [lindex $entry 1]
set state normal
} else {
set text "\n\n\n\n\n (No entries in folder.)"
set state disabled
}
$Jots(textwindow) insert 1.0 $text
$Jots(textwindow) configure -state $state
set Jots(edited) -1
}
proc JotsNewEntry {} {
global Jots
global $Jots(folder)-jf
JotsUpdateList
set datestr [clock format [clock seconds] -format "%Y %m %d %H %M %S %w"]
lappend $Jots(folder)-jf(list) [ list $datestr ""]
set Jots(index) [expr [llength [set $Jots(folder)-jf(list)]] - 1]
JotsDisplay
focus $Jots(textwindow)
}
proc JotsCopy {} {
global Jots
global $Jots(folder)-jf
if {[lindex [lindex [set $Jots(folder)-jf(list)] $Jots(index)] 1] == ""} {
set Jots(cutbuffer) ""
} else {
set Jots(cutbuffer) [$Jots(textwindow) get 1.0 {end - 1 chars}]
}
selection handle .jots JotsSelectionHandler
selection own .jots
}
proc JotsCut {} {
global Jots
global $Jots(folder)-jf
JotsUpdateList
JotsCopy
if {[set $Jots(folder)-jf(list)] == ""} { return 1 }
set $Jots(folder)-jf(list) [lreplace [set $Jots(folder)-jf(list)] $Jots(index) $Jots(index)]
if {[llength [set $Jots(folder)-jf(list)]] == 0} {
set Jots(index) -1
} elseif {$Jots(index) == [llength [set $Jots(folder)-jf(list)]]} {
incr Jots(index) -1
}
JotsDisplay
JotsSUpdate
}
proc JotsPaste {} {
global Jots
$Jots(textwindow) insert insert $Jots(cutbuffer)
set Jots(edited) $Jots(index)
}
proc JotsSelectionHandler {offset maxbytes} {
global Jots
return [string range $Jots(cutbuffer) $offset [expr $offset + $maxbytes]]
}
proc JotsPackFind args {
global Jots
set w .jots
switch $Jots(showfindtool) {
0 {
catch "destroy $w.find"
} 1 {
if [winfo exists $w.find] return
frame $w.find
button $w.find.find -command JotsFind -text "Find"
pack $w.find.find -side left -expand y -fill y -padx .4c
entry $w.find.entry -textvariable Jots(find) -width 30
pack $w.find.entry -side left -fill x -padx .3c
bind $w.find.entry <Key-Return> JotsFind
label $w.find.label -textvariable Jots(findmessage) -width 15
pack $w.find.label -side left -fill x -padx .3c
grid $w.find -row 4
focus $w.find.entry
}
}
}
proc JotsFind {} {
global Jots
global $Jots(folder)-jf
JotsUpdateList
if {$Jots(find) == ""} return
set l ""
for {set i 0} {$i < [llength [set $Jots(folder)-jf(list)]]} {incr i} {
lappend l [lindex [lindex [set $Jots(folder)-jf(list)] $i] 1]
}
if {[set i [expr ($Jots(index) + 1 + \
[lsearch [lrange $l [expr $Jots(index) + 1] end]\
*$Jots(find)*])]] == $Jots(index)} {
if {[set i [lsearch $l *$Jots(find)* ]] == -1} {
set Jots(findmessage) "Not found."
return
}
}
set Jots(index) $i
JotsDisplay
set Jots(findmessage) "Found."
}
proc JotsPrev {} {
global Jots
JotsUpdateList
if { $Jots(index) == 0 } {return 1}
incr Jots(index) -1
JotsDisplay
focus $Jots(textwindow)
}
proc JotsNext {} {
global Jots
global $Jots(folder)-jf
JotsUpdateList
if { $Jots(index) == ([llength [set $Jots(folder)-jf(list)]] - 1 )} {return 1}
incr Jots(index)
JotsDisplay
focus $Jots(textwindow)
}
proc JotsDismiss {} {
global Jots
JotsUpdateList
foreach f $Jots(openfolders) {
JotsSaveFolder $f
}
JotsSaveHots
JotsFinalExit
}
proc JotsExit {} {
global Jots
TKGDialog jots_exit \
-wmtitle "Jots Exit" \
-image question\
-title "Jots: save selected folders before exiting?" \
-nodismiss \
-buttons {
{
ok
OK
{
foreach folder $Jots(openfolders) {
if [set Jots($folder,save)] {JotsSaveFolder $folder}
}
destroy .jots_exit
JotsFinalExit
}
} {
cancel
"Cancel"
{
destroy .jots_exit
}
} {
nosave
"Exit without\nsaving"
{
destroy .jots_exit
JotsFinalExit
}
}
}
frame .jots_exit.folders -relief ridge -borderwidth 3
set i 0
foreach folder $Jots(openfolders) {
set f [string tolower $folder]
set icalitem$i 0
checkbutton .jots_exit.folders.$f -text $folder \
-variable Jots($folder,save)
set Jots($folder,save) 1
pack .jots_exit.folders.$f -side top -anchor w -padx 20
}
grid .jots_exit.folders -row 1 -sticky ew -padx 3 -pady 3
}
proc JotsFinalExit {} {
global Jots
cd $Jots(oldcwd)
trace vdelete Jots(showfindtool) w JotsPackFind
trace vdelete Jots(index) w JotsSUpdate
trace vdelete Jots(showhotlist) w JotsUpdateHots
trace vdelete Jots(folder) w JotsUpdateHots
foreach f $Jots(openfolders) {
global $f-jf
unset $f-jf
}
foreach v { Jots(folder) Jots(textwindow) Jots(oldcwd) Jots(openfolders)
Jots(hotswindow) Jots(hotlist) Jots(time) Jots(date) Jots(index)
Jots(edited) Jots(SB) Jots(selectfolders)
fileselect selection} {
global $v
catch "unset $v"
}
if $Jots(makebutton) {
upvar #0 JotsButton-params P
catch {$P(pathname) configure -relief $P(relief)}
}
destroy .jots
}
#########################
# Folder Management Stuff
#
proc JotsUpdateHots args {
global Jots
global $Jots(folder)-jf
set Jots(findmessage) ""
pack forget $Jots(hotswindow)
$Jots(hotswindow) configure
if !$Jots(showhotlist) {return}
foreach w [winfo children $Jots(hotswindow)] {destroy $w}
frame $Jots(hotswindow).pad -height 1 -width 1
pack $Jots(hotswindow).pad -side left -expand y -fill x
foreach folder $Jots(hotlist) {
set w $Jots(hotswindow).[string tolower $folder]
button $w -text $folder -command "JotsGotoFolder $folder"
if {$folder == $Jots(folder)} {
$w configure -background $Jots(hots_cur_bg) -foreground $Jots(hots_cur_fg)\
-activebackground $Jots(hots_cur_abg) -activeforeground $Jots(hots_cur_afg)\
-command {}
}
pack $w -side left -expand n
}
grid $Jots(hotswindow) -row 1 -column 0 -padx .3c -pady .1c -sticky ew
}
proc JotsGotoFolder {folder} {
global Jots
global $Jots(folder)-jf
global $folder-jf
if {$Jots(folder) != ""} {
JotsUpdateList
set $Jots(folder)-jf(index) $Jots(index)
}
set Jots(folder) $folder
if {[lsearch $Jots(openfolders) $folder] != -1 } {
set Jots(index) [set $folder-jf(index)]
} else {
JotsGet $Jots(folder)
lappend Jots(openfolders) $folder
set m .jots.menu.file.m.openfolders
$m add radiobutton -label $folder -variable Jots(Goto) -value $folder
}
JotsDisplay
JotsUpdateHots
focus $Jots(textwindow)
}
proc JotsAddHot {} {
global Jots
if {[lsearch $Jots(hotlist) $Jots(folder)] != -1} return
lappend Jots(hotlist) $Jots(folder)
set Jots(hotlist) [lsort $Jots(hotlist)]
JotsUpdateHots
}
proc JotsRemoveHot {} {
global Jots
if {[set i [lsearch $Jots(hotlist) $Jots(folder)]] == -1} return
set Jots(hotlist) [lreplace $Jots(hotlist) $i $i]
JotsUpdateHots
}
#########################
# Help menu stuff
#
proc JotsAbout {} {
set text "
Jots, by Mark Crimmins (markcrim@umich.edu), copyright 1995.\n\
Look for the latest version in the tkgoodstuff distribution at:\n\
\ \ \ ftp://merv.philosophy.lsa.umich.edu/pub
"
set w .about
catch {destroy $w}
toplevel $w
wm title $w "About Jots"
wm iconname $w "About Jots"
label $w.title -text "About Jots"
pack $w.title -pady .3c -fill x -expand y
frame $w.view -relief groove -borderwidth 5
message $w.view.text -width 18c -text $text
pack $w.view.text -side left -fill both -expand 1
pack $w.view -side top -fill both -expand 1 -padx .3c
frame $w.buttons
button $w.buttons.dismiss -text Dismiss -command "destroy $w"
pack $w.buttons.dismiss -side left -expand y -fill y -padx .4c -pady .4c
pack $w.buttons -side bottom -fill x -expand y
}
proc JotsHelp {} {
set text "
Jots looks for jots folders in the directory specified in your\
preferences (by default, the directory \".tkgjots\" in the user's home\
directory). It also looks there for the file \".hotjots\" which\
contains the \"hotlist\" and the last-visited folder name. The first\
time the user runs Jots, this directory and file (and an intial\
folder called \"Notes\") are created.
The first folder visited is also specified in the preferences, and\
by default is the folder last visited (according to the .hotjots file), or\
if there is no .hotjots file the alphabetically first folder in the\
directory.
At a given time there is one entry of the current folder on the\
screen. Scroll through it with the vertical scrollbar, or scroll\
through the entries in the folder with the large, horizontal\
scrollbar.
The hotlist consists of buttons in the upper right of the Jots window\
for visiting folders. Click a hotlist button to visit the corresponding\
folder, opening it if it is not already open. By default, the hotlist is\
displayed when Jots is started if the hotlist contains any folders.\
Otherwise, one can display it manually with a command under the\
\"Hotlist\" menu. When visiting a folder you want in the hotlist,\
other command under the \"Hotlist\" menu will add and delete that\
folder from the hotlist.
Under the \"File\" menu there are commands for creating, opening,\
visiting, merging, saving, and deleting folders, as well as the Exit\
command. Merging adds the entries of a folder you choose to the\
current folder, which then is re-sorted by date and time, and\
any redundant entries are removed.\
To search for an expression in a folder, use the command under the\
\"Find\" menu to display the Find tool, type in the phrase and press\
the Enter key or the \"Find:\" button. Searching is case-sensitive,\
and the search\
string may use \"glob\" devices (see the tcl documentation for\
\"string match\" (under \"man -n string\") for more. There is no\
provision for searching multiple folders at once.
The following keyboard shortcuts are defined:
<Alt-q> or <Alt-x> Save and Exit
<Shift-LeftArrow> Previous Entry
<Shift-RightArrow> Next Entry
<Shift-Alt-d> Delete Entry
<Shift-Alt-n> New Entry
The rest should be self-explanatory. See the tkgoodstuff\
documentation for information about customization.
"
set w .loginscripthelp
catch {destroy $w}
toplevel $w
wm title $w "Jots Help"
wm iconname $w "Jots Help"
label $w.title -text "JOTS HELP"
pack $w.title -pady .3c -fill x -expand y
frame $w.view
text $w.view.text -width 65 -height 20 \
-takefocus 0 -yscrollcommand "$w.view.scrollbar set" \
-relief sunken -borderwidth 2 -state disabled \
-wrap word
pack $w.view.text -side left -fill both -expand 1
scrollbar $w.view.scrollbar -command "$w.view.text yview"
pack $w.view.scrollbar -side left -fill y -padx 3
pack $w.view -side top -fill both -expand 1 -padx .3c
$w.view.text configure -state normal
$w.view.text insert end "$text"
$w.view.text configure -state disabled
frame $w.buttons
button $w.buttons.dismiss -text Dismiss -command "destroy $w"
pack $w.buttons.dismiss -side left -expand y -fill y -padx .4c -pady .4c
pack $w.buttons -side bottom -fill x -expand y
}
# File selection stuff
proc select {var {message "Open File"}} {
global selection
set selection ""
fileselect selectdone $message
tkwait window .fileSelectWindow
uplevel "set $var \"$selection\""
if { $selection == "" } {
return 0
} else {
return 1
}
}
proc selectdone {f} {
global selection
set selection $f
}
#
# fileselect.tcl --
# simple file selector.
#
# Mario Jorge Silva msilva@cs.Berkeley.EDU
# University of California Berkeley Ph: +1(510)642-8248
# Computer Science Division, 571 Evans Hall Fax: +1(510)642-5775
# Berkeley CA 94720
#
# Layout:
#
# file: +----+
# ____________________ | OK |
# +----+
#
# +------------------+ Cancel
# | .. |S
# | file1 |c
# | file2 |r
# | |b
# | filen |a
# | |r
# +------------------+
# currrent-directory
#
# Copyright 1993 Regents of the University of California
# Permission to use, copy, modify, and distribute this
# software and its documentation for any purpose and without
# fee is hereby granted, provided that this copyright
# notice appears in all copies. The University of California
# makes no representations about the suitability of this
# software for any purpose. It is provided "as is" without
# express or implied warranty.
#
# names starting with "fileselect" are reserved by this module
# no other names used.
# use the "option" command for further configuration
# this is the default proc called when "OK" is pressed
# to indicate yours, give it as the first arg to "fileselect"
proc fileselect.default.cmd {f} {
puts stderr "selected file $f"
}
# this is the default proc called when error is detected
# indicate your own pro as an argument to fileselect
proc fileselect.default.errorHandler {errorMessage} {
puts stdout "error: $errorMessage"
catch { cd ~ }
}
# this is the proc that creates the file selector box
proc fileselect {
{cmd fileselect.default.cmd}
{purpose "Open file:"}
{w .fileSelectWindow}
{errorHandler fileselect.default.errorHandler}} {
catch {destroy $w}
toplevel $w
wm withdraw $w
grab $w
wm title $w "Select File"
# path independent names for the widgets
global fileselect
set fileselect(entry) $w.file.eframe.entry
set fileselect(list) $w.file.sframe.list
set fileselect(scroll) $w.file.sframe.scroll
set fileselect(ok) $w.bframe.okframe.ok
set fileselect(cancel) $w.bframe.cancel
set fileselect(dirlabel) $w.file.dir.dirlabel
# widgets
frame $w.file -bd 10
frame $w.bframe -bd 10
pack append $w \
$w.file {left filly} \
$w.bframe {left expand frame n}
frame $w.file.eframe
frame $w.file.sframe
frame $w.file.dir
label $w.file.dir.dir -anchor e -width 6 -text "Dir:"
label $w.file.dir.dirlabel -anchor e -width 24 -text [pwd]
pack $w.file.dir.dir $w.file.dir.dirlabel -side left
pack append $w.file \
$w.file.eframe {top frame w} \
$w.file.sframe {top fillx} \
$w.file.dir {top frame w}
label $w.file.eframe.label -anchor w -width 24 -text $purpose
entry $w.file.eframe.entry -relief sunken
pack append $w.file.eframe \
$w.file.eframe.label {top expand frame w} \
$w.file.eframe.entry {top fillx frame w}
scrollbar $w.file.sframe.yscroll -relief sunken \
-command "$w.file.sframe.list yview"
listbox $w.file.sframe.list -relief sunken \
-yscroll "$w.file.sframe.yscroll set"
pack append $w.file.sframe \
$w.file.sframe.yscroll {right filly} \
$w.file.sframe.list {left expand fill}
# buttons
frame $w.bframe.okframe -borderwidth 2 -relief sunken
button $w.bframe.okframe.ok -text OK -relief raised -padx .3c \
-command "fileselect.ok.cmd $w $cmd $errorHandler"
button $w.bframe.cancel -text cancel -relief raised -padx .3c \
-command "fileselect.cancel.cmd $w"
pack append $w.bframe.okframe $w.bframe.okframe.ok {padx .3c pady .3c}
pack append $w.bframe $w.bframe.okframe {expand padx 20 pady 20}\
$w.bframe.cancel {top}
# Fill the listbox with a list of the files in the directory (run
# the "/bin/ls" command to get that information).
# to not display the "." files, remove the -a option and fileselect
# will still work
global Jots
if $Jots(selectfolders) {
foreach i [exec /bin/ls [pwd]] {
if {[string compare $i "."] != 0 && \
[string compare $i ".."] != 0 } {
$fileselect(list) insert end $i
}
}
} else {
$fileselect(list) insert end ".."
foreach i [exec /bin/ls -a [pwd]] {
if {[string compare $i "."] != 0 && \
[string compare $i ".."] != 0 } {
$fileselect(list) insert end $i
}
}
}
# Set up bindings for the browser.
bind $fileselect(entry) <Return> {eval $fileselect(ok) invoke; break}
bind $fileselect(entry) <Control-c> {eval $fileselect(cancel) invoke; break}
bind $w <Control-c> {eval $fileselect(cancel) invoke;break}
bind $w <Return> {eval $fileselect(ok) invoke;break}
# tk_listboxSingleSelect $fileselect(list)
bind $fileselect(list) <Button-1> {
# puts stderr "button 1 release"
%W selection set [%W nearest %y]
$fileselect(entry) delete 0 end
$fileselect(entry) insert 0 [%W get [%W nearest %y]]
break
}
bind $fileselect(list) <Key> {
%W selection set [%W nearest %y]
$fileselect(entry) delete 0 end
$fileselect(entry) insert 0 [%W get [%W nearest %y]]
break
}
bind $fileselect(list) <Double-ButtonPress-1> {
# puts stderr "double button 1"
%W selection set [%W nearest %y]
$fileselect(entry) delete 0 end
$fileselect(entry) insert 0 [%W get [%W nearest %y]]
$fileselect(ok) invoke
break
}
bind $fileselect(list) <Return> {
%W selection set [%W nearest %y]
$fileselect(entry) delete 0 end
$fileselect(entry) insert 0 [%W get [%W nearest %y]]
$fileselect(ok) invoke
break
}
# set kbd focus to entry widget
focus $fileselect(entry)
#center window
TKGCenter $w
}
# auxiliary button procedures
proc fileselect.cancel.cmd {w} {
# puts stderr "Cancel"
destroy $w
}
proc fileselect.ok.cmd {w cmd errorHandler} {
global fileselect Jots
set selected [$fileselect(entry) get]
# some nasty file names may cause "file isdirectory" to return an error
set sts [catch {
file isdirectory $selected
} errorMessage ]
if { $sts != 0 } then {
$errorHandler $errorMessage
destroy $w
return
}
# clean the text entry and prepare the list
$fileselect(entry) delete 0 end
$fileselect(list) delete 0 end
if !$Jots(selectfolders) {$fileselect(list) insert end ".."}
# selection may be a directory. Expand it.
if {[file isdirectory $selected] != 0} {
if !$Jots(selectfolders) {
cd $selected
set dir [pwd]
$fileselect(dirlabel) configure -text $dir
foreach i [exec /bin/ls -a $dir] {
if {[string compare $i "."] != 0 && \
[string compare $i ".."] != 0} {
$fileselect(list) insert end $i
}
}
}
return
}
destroy $w
$cmd $selected
}
##### end of fileselect code
DEBUG "Loaded Jots.tcl"