mirror of
https://salsa.debian.org/dskoll/remind.git
synced 2026-04-16 22:38:37 +02:00
7aa483e201
I have a "REM Mon SPECIAL WEEK (W[weekno()])" in my reminders file. With tkremind -m the week number is displayed on the 2nd column which is Tuesday and the date of this Tuesday is taken from the monday of the next week, sometimes of Monday the same week.
3629 lines
110 KiB
Tcl
Executable File
3629 lines
110 KiB
Tcl
Executable File
#!/bin/sh
|
|
# -*-Mode: TCL;-*-
|
|
|
|
#--------------------------------------------------------------
|
|
# TKREMIND
|
|
#
|
|
# A cheesy graphical front/back end for Remind using Tcl/Tk
|
|
#
|
|
# This file is part of REMIND.
|
|
# Copyright (C) 1992-2020 Dianne Skoll
|
|
#
|
|
#--------------------------------------------------------------
|
|
|
|
# the next line restarts using wish \
|
|
exec wish "$0" "$@"
|
|
|
|
wm withdraw .
|
|
|
|
set Hostname [exec hostname]
|
|
|
|
# Our icon photo
|
|
catch {
|
|
image create photo rpicon -data {
|
|
R0lGODlhFwAgAOecABUTERYTERYUERcVEhgWExkXFBkXFRoXFRsZFhwZFxwa
|
|
GB0bGR4cGR4cGh8dGiAeHCEfHCEfHSIgHSIgHiQiHyYkISknJCooJispJywq
|
|
Jy4sKTIwLjUzMDUzMTo4Njs5Nzs5ODw7ODw7OT07OT48OkE/PUJAPkNBP0RC
|
|
QEVDQUVEQkdFQ0lIRkpJR01LSU5MSlBPTVFQTlNSUFRSUFRSUVVTUlVUUllY
|
|
VltZV1xaWF1cWmBfXmJgX2RiYGZlY2dmZGppZ2tqaG1ram9tbHFwb3Jwb3Rz
|
|
cXV0c3Z0c3Z1c3Z1dHd1dHh2dXh3dnt5eHx7eXx7en18en59e4B/foGAf4KB
|
|
f4SDgYWEgoWEg4eGhIiHhouKiI2Mio6Ni46NjJCQj5KRkJSTkZeWlpiXlpmY
|
|
l5qZmJybmp6dnKCfnqGgoKKhoKOioaSjoqinp6qpqKurqq+urbCvrrCwr7Gw
|
|
r7OysbW1tLi3tri3t7u6ur28vMTDw8TEw8XFxMbFxcfGxsfHxsrJycrKyczM
|
|
y83My83MzM3NzdDQz9LR0dPS0tPT09fX19jY19ra2dvb29zc29zc3Ojn5+jo
|
|
6Orq6uzs7O/v7/T09PX19fb29vf39/r6+vv7+/7+/v//////////////////
|
|
////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////
|
|
////////////////////////////////////////////////////////////
|
|
/////////////////////yH5BAEKAP8ALAAAAAAXACAAAAj+AP8JHEiwoMGD
|
|
CAcusRAAQEKDBQIcEBAAwUODAQJAsBGAwsWCBzJuUBLgI0ENGVM2dACg5UWV
|
|
KU+Y/JfRQBknPoq8ATQz4wxOQIFa6vMx5ZSgQetczJDSClKgcF6mFDEnE9I2
|
|
D0fADOChUdA1D7dmTBEUTditDQRQAnomIQaxICpoAmomoUoAGS2YIBIUDEIu
|
|
YndI8FAJaBaEMlIuSEkloxugUBBOSLkh44AvGfkAPYJQpYqMLIQEILB205DO
|
|
KW9kJHMhQAmgkaKgzsgjggM5GbEAxaNmdoAPOoz8CCAgEVAtg3wPEPMnQQAU
|
|
QWsg5AAzDZSMbIBeaoHwAUwSDAI2XMAENA8ThAPEBvAStEkc3yonrOW0aUMk
|
|
+BkBVAlaKATC8Fsp8Igid5ABgxMHtaTgggy6ZFBAADs= }
|
|
|
|
wm iconphoto . -default rpicon
|
|
}
|
|
|
|
# Left and right arrows
|
|
image create photo leftarrow -data {
|
|
iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMCAYAAABWdVznAAAC3XpUWHRSYXcgcHJvZmlsZSB0eXBl
|
|
IGV4aWYAAHja7ZdRkuMoDIbfOcUeAUkIieNgA1Vzgz3+/mDa6aR7pmpn52EfYioGK+IX6BNOd+h/
|
|
/xjhL1xUJIak5rnkHHGlkgpXDDxe19VTTOt+Xefu6dke7i8YJkEv12Pu27/Cro8Jlrb9eLYH20Ls
|
|
W+gj8haUGZkfK/EtJHzZaT+HsufV9Gk7+3O0bdOre31OhmQ0hZ5w4C4kEXefUQQrkCIVd8ZdZDnB
|
|
WiUtC4l+n7twD1+Sd49echfrtstzKkLM2yG/5GjbSb/P3crQ5xXRI/LTFyZ3iC+5G6P5GP3aXU0Z
|
|
mcphb+pjK2sExwOplDUtoxk+irGtVtAcWzxBrIHmgXYGKsTI9qBEjSoN6qs/6cQSE3c29Mwny7K5
|
|
GBc+F5Q0Gw024GlBHDROUJPJ5V4LrbhlxTvJEbkRPJkgNol+aeE74++0W2iMWbpE0e9cYV08axrL
|
|
mOTmHV4AQmPnVFd+Vwuf6iZ+AisgqCvNjg3WeFwSh9KjtmRxFvhpTCFeR4OsbQGkCLEViyEBgZhR
|
|
zJQpGrMRIY8OPhUrZ0l8gACpcqMwwEYkA47zjI05RsuXlS8zXi0AoZLFgAYHCLBSUtSPJUcNVRVN
|
|
QVWzmroWrVlyyppztjzfUdXEkqllM3MrVl08uXp2c/fitXARvMK05GKheCmlVgStkK6YXeFR68GH
|
|
HOnQIx92+FGOeqJ8znTqmU87/Sxnbdyk4fi33Cw0b6XVTh2l1FPXnrt176XXgVobMtLQkYcNH2XU
|
|
m9qm+kyNXsj9mhptapNYWn72oAaz2YcEzdeJTmYgxolA3CYBFDRPZtEpJZ7kJrNYGIdCGdRIJ5xG
|
|
kxgIpk6sg252D3K/5BY0/Stu/DNyYaL7E+TCRLfJfeX2DbVW1y+KLEDzFM6cRhl4scGhe2Wv8zfp
|
|
t/vwXwXeQm+ht9Bb6C30FnoL/X+EBv54wL+a4R9jg5HlHbplXQAAAAZiS0dEAP8A/wD/oL2nkwAA
|
|
AAlwSFlzAAAOxAAADsQBlSsOGwAAAAd0SU1FB+MMHwEqD2+Y0soAAABKSURBVCjPY2DADuoZSAC1
|
|
DAwM/0lVjFMDI5riJiR+Gz71yCYTwgx1JCj+z8TAwPCRgQyQT6wNjGiaJqDx8QUShk0kO48kUIhL
|
|
AgCfBSz4satMtQAAAABJRU5ErkJggg==
|
|
}
|
|
|
|
image create photo rightarrow -data {
|
|
iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMCAYAAABWdVznAAAC3HpUWHRSYXcgcHJvZmlsZSB0eXBl
|
|
IGV4aWYAAHja7ZdRkuMoDIbfOcUeAUkIieNgA1Vzgz3+/mDa6aR7pmpn52EfYipgK7IE/ydId+h/
|
|
/xjhL1xUJIak5rnkHHGlkgpX3Hi8rmukmFZ/Xece6dke7i8YJsEo12Pu27/Cro8XLG378WwPtgOx
|
|
70AfmXdAmZn5MRPfgYQvO+3nUPZ7NX1azv4cbdv0Gl6fk0GMpognHLgLSUTvM4tgBlKkomf0IssJ
|
|
1ippW+R77cJ9+yLeffeiXazbLs9ShJi3Q37RaNtJv9duKfR5RvTI/PSFyZ3ii3ZjNB+jX6urKUOp
|
|
HPaiPpay7uB4QMpLjYxm+CjubbWC5ljiCWINNA+0M1AhhtqDEjWqNKiv8aQTU0zc2TAynyzL5mJc
|
|
+FxQ0mw02ICnBXHQOEFNJpd7LrTylpXvJEfmRvBkQrBJ9EsL3xl/p92BxpilSxT91grz4lnTmMYk
|
|
N3t4AQiNrakufVcLn+omfgIrIKhLZscCazyuEIfSo7ZkcRb4aUwhXluDrO0AkAi5FZMhAYGYSZQy
|
|
RWM2Iujo4FMxc5bEBwiQKjcKA2xEMuA4z9x4x2j5svJlxtECECpZDGiwgQArJUX9WHLUUFXRFFQ1
|
|
q6lr0Zolp6w5Z8vzjKomlkwtm5lbseriydWzm7sXr4WL4AjTkouF4qWUWpG0InTF2xUetR58yJEO
|
|
PfJhhx/lqCfK50ynnvm0089y1sZNGrZ/y81C81Za7dRRSj117blb9156Hai1ISMNHXnY8FFGvalt
|
|
qs/U6IXcr6nRpjaJpeVnD2owm32EoHmc6GQGYpwIxG0SQEHzZBadUuJJbjKLhbEplEGNdMJpNImB
|
|
YOrEOuhm9yD3S25B07/ixj8jFya6P0EuTHSb3Fdu31Brdf2iyAI0d+HUNMrAwQaH7pW9zt+k3x7D
|
|
fw3wDvQO9A70DvQO9A70DvT/CTTwxwP+1Qz/AGOHkeWpKJljAAAABmJLR0QA/wD/AP+gvaeTAAAA
|
|
CXBIWXMAAA7EAAAOxAGVKw4bAAAAB3RJTUUH4wwfASohs07fBQAAAFhJREFUKM9jYMAN6hlIBP8Z
|
|
GBhqSdWAoYmFgYGhDSqBCzRB6WZ0kwjhWpgNxIImBgYGRiYSA+IjKU7KZ2BgYGCEMrB5eiISuwCN
|
|
jzdY80mJh3xSPFiITRAA3qskpC7RIkIAAAAASUVORK5CYII=
|
|
}
|
|
proc missing_tcllib { pkg } {
|
|
catch { puts stderr "Could not find the '$pkg' package -- you must install tcllib.\nPlease see http://tcllib.sourceforge.net/" }
|
|
tk_dialog .err "Error: tcllib not installed" "Could not find the '$pkg' package -- you must install tcllib. Please see http://tcllib.sourceforge.net/" error 0 OK
|
|
exit 1
|
|
}
|
|
if {[catch {package require mime}]} {
|
|
missing_tcllib mime
|
|
}
|
|
|
|
if {[catch {package require smtp}]} {
|
|
missing_tcllib smtp
|
|
}
|
|
if {[catch {package require json}]} {
|
|
missing_tcllib json
|
|
}
|
|
|
|
|
|
# Check that we have the right version of wish
|
|
if {$tcl_version < 8.0} {
|
|
tk_dialog .error Error "You need wish version 8.0 or higher to run TkRemind; you have $tcl_version" error 0 OK
|
|
exit 1
|
|
}
|
|
|
|
if {$tcl_platform(platform) == "windows"} {
|
|
tk_dialog .error Error "Please do not port Remind to Windows" error 0 OK
|
|
exit 1
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# GLOBAL VARIABLES
|
|
#---------------------------------------------------------------------------
|
|
|
|
set Option(ConfirmQuit) 0
|
|
set OptDescr(ConfirmQuit) "(0/1) If 1, TkRemind prompts you to confirm 'Quit' operation"
|
|
set Option(AutoClose) 1
|
|
set OptDescr(AutoClose) "(0/1) If 1, TkRemind automatically closes pop-up reminders after a minute"
|
|
set Option(RingBell) 0
|
|
set OptDescr(RingBell) "(0/1) If 1, TkRemind beeps the terminal when a pop-up reminder appears"
|
|
|
|
set Option(StartIconified) 0
|
|
set OptDescr(StartIconified) "(0/1) If 1, TkRemind starts up in the iconified state"
|
|
|
|
set Option(Deiconify) 0
|
|
set OptDescr(Deiconify) "(0/1) If 1, TkRemind deiconifies the calendar window when a reminder pops up"
|
|
|
|
set Option(ShowTodaysReminders) 1
|
|
set OptDescr(ShowTodaysReminders) "(0/1) If 1, TkRemind shows all of today's non-timed reminders in a window at startup and when the date changes"
|
|
|
|
set Option(RunCmd) ""
|
|
set OptDescr(RunCmd) "(String) If non-blank, run specified command when a pop-up reminder appears"
|
|
set Option(FeedReminder) 0
|
|
set OptDescr(FeedReminder) "(0/1) If 1, feed the reminder to RunCmd on standard input (see RunCmd option)"
|
|
|
|
set Option(Editor) "emacs +%d %s"
|
|
set OptDescr(Editor) "(String) Specify command to edit a file. %d is replaced with line number and %s with filename"
|
|
|
|
set Option(MailAddr) ""
|
|
set OptDescr(MailAddr) "(String) Specify an e-mail address to which reminders should be sent if the popup window is not manually dismissed"
|
|
|
|
set Option(SMTPServer) "127.0.0.1"
|
|
set OptDescr(SMTPServer) "(String) IP address or host name of SMTP server to use for sending e-mail"
|
|
|
|
set Option(ExtraRemindArgs) ""
|
|
set OptDescr(ExtraRemindArgs) "(String) Extra arguments when invoking remind"
|
|
|
|
# Remind program to execute -- supply full path if you want
|
|
set Remind "remind"
|
|
#set Remind "/home/dfs/Remind/src/remind"
|
|
|
|
# Rem2PS program to execute -- supply full path if you want
|
|
set Rem2PS "rem2ps"
|
|
|
|
# Reminder file to source -- default
|
|
set ReminderFile {NOSUCHFILE}
|
|
set ReminderFile [file nativename "~/.reminders"]
|
|
|
|
set EditorPid -1
|
|
|
|
# Reminder file to append to -- default
|
|
set AppendFile {NOSUCHFILE}
|
|
catch {set AppendFile $ReminderFile}
|
|
|
|
# Array of tags -> JSON dicts
|
|
array unset TagToObj
|
|
|
|
set SetFontsWorked 0
|
|
#---------------- DON'T CHANGE STUFF BELOW HERE ------------------
|
|
|
|
# 24-hour clock mode
|
|
set TwentyFourHourMode 0
|
|
|
|
# Is Monday in first column?
|
|
set MondayFirst 0
|
|
|
|
# Month names in English
|
|
set MonthNames {January February March April May June July August September October November December}
|
|
|
|
# Day names in Remind's pre-selected language
|
|
set DayNames {}
|
|
|
|
# Day name in English
|
|
set EnglishDayNames {Sunday Monday Tuesday Wednesday Thursday Friday Saturday}
|
|
|
|
# Current month and year -- will be set by Initialize procedure
|
|
set CurMonth -1
|
|
set CurYear -1
|
|
|
|
# Background reminder counter
|
|
set BgCounter 0
|
|
|
|
# Absolutely today -- unlike the CurMonth and CurYear, these won't change
|
|
set TodayMonth -1
|
|
set TodayYear -1
|
|
set TodayDay -1
|
|
|
|
# Reminder option types and skip types
|
|
set OptionType 1
|
|
set SkipType 1
|
|
# Remind command line
|
|
set CommandLine {}
|
|
set PSCmd {}
|
|
|
|
# Print options -- destination file; letter-size; landscape; fill page; default
|
|
# encoding; 36pt margins; print small calendars
|
|
set PrintDest file
|
|
set PrintSize letter
|
|
set PrintOrient landscape
|
|
set PrintFill 1
|
|
set PrintEncoding 0
|
|
set PrintMargins 36pt
|
|
set PrintSmallCalendars 1
|
|
|
|
set WarningHeaders [list "# Lines staring with REM TAG TKTAGnnn ... were created by tkremind" "# Do not edit them by hand or results may be unpredictable."]
|
|
|
|
# Highest tag seen so far. Array of tags is stored in ReminderTags()
|
|
set HighestTagSoFar 0
|
|
|
|
proc get_weekday { yyyymmdd } {
|
|
global EnglishDayNames
|
|
return [lindex $EnglishDayNames [clock format [clock scan $yyyymmdd] -format %w -locale C]]
|
|
}
|
|
|
|
proc write_warning_headers { out } {
|
|
global WarningHeaders
|
|
foreach h $WarningHeaders {
|
|
puts $out $h
|
|
}
|
|
}
|
|
|
|
proc is_warning_header { line } {
|
|
global WarningHeaders
|
|
foreach h $WarningHeaders {
|
|
if {"$line" == "$h"} {
|
|
return 1
|
|
}
|
|
}
|
|
return 0
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: Initialize
|
|
# %ARGUMENTS:
|
|
# None
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Initializes TkRemind -- sets day names, Remind command line,
|
|
# MondayFirst flag, current date, etc.
|
|
#***********************************************************************
|
|
proc Initialize {} {
|
|
|
|
global DayNames argc argv CommandLine ReminderFile AppendFile Remind PSCmd
|
|
global MondayFirst TwentyFourHourMode ReminderFileModTime
|
|
global Option
|
|
set CommandLine "|$Remind -itkremind=1 -pp -y -l EXTRA"
|
|
set PSCmd "$Remind -pp -l EXTRA"
|
|
set i 0
|
|
while {$i < $argc} {
|
|
if {[regexp -- {-[bgxim].*} [lindex $argv $i]]} {
|
|
append CommandLine " [lindex $argv $i]"
|
|
append PSCmd " [lindex $argv $i]"
|
|
if {[regexp -- {m} [lindex $argv $i]]} {
|
|
set MondayFirst 1
|
|
}
|
|
if {"[lindex $argv $i]" == "-b1"} {
|
|
set TwentyFourHourMode 1
|
|
}
|
|
} else {
|
|
break
|
|
}
|
|
incr i
|
|
}
|
|
if {$i < $argc} {
|
|
set ReminderFile [lindex $argv $i]
|
|
set AppendFile $ReminderFile
|
|
incr i
|
|
if {$i < $argc} {
|
|
set AppendFile [lindex $argv $i]
|
|
incr i
|
|
}
|
|
}
|
|
|
|
# If reminder file is a directory and appendfile is the same as
|
|
# reminder file, choose append file to be $ReminderFile/100-tkremind.rem
|
|
if {[file isdirectory $ReminderFile]} {
|
|
if {"$ReminderFile" == "$AppendFile"} {
|
|
set AppendFile [file join $ReminderFile "100-tkremind.rem"]
|
|
}
|
|
}
|
|
|
|
# Check system sanity
|
|
if {! [file readable $ReminderFile]} {
|
|
set ans [tk_dialog .error "TkRemind: Warning" "Can't read reminder file `$ReminderFile'" warning 0 "Create it and continue" "Exit"]
|
|
if {$ans != 0} {
|
|
exit 1
|
|
}
|
|
catch {
|
|
set out [open $ReminderFile w]
|
|
write_warning_headers $out
|
|
puts $out ""
|
|
close $out
|
|
}
|
|
}
|
|
if {! [file readable $ReminderFile]} {
|
|
tk_dialog .error "TkRemind: Error" "Could not create reminder file `$ReminderFile'" error 0 "Exit"
|
|
exit 1
|
|
}
|
|
|
|
if {[file isdirectory $ReminderFile] && ! [file exists $AppendFile]} {
|
|
if {![catch {
|
|
set out [open $AppendFile "a"]
|
|
write_warning_headers $out
|
|
puts $out ""
|
|
close $out}]} {
|
|
tk_dialog .error "Created File" "Created blank file `$AppendFile'" info 0 "OK"
|
|
}
|
|
}
|
|
|
|
if {! [file writable $AppendFile]} {
|
|
tk_dialog .error Error "Can't write reminder file `$AppendFile'" error 0 Ok
|
|
exit 1
|
|
}
|
|
|
|
append CommandLine " $ReminderFile"
|
|
append PSCmd " $ReminderFile"
|
|
set DayNames [GetWeekdayNames]
|
|
|
|
# Get modification time of ReminderFile
|
|
set ReminderFileModTime -1
|
|
catch {
|
|
set ReminderFileModTime [file mtime $ReminderFile]
|
|
}
|
|
|
|
MonitorReminderFile
|
|
|
|
# puts "CommandLine: $CommandLine"
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# MonitorReminderFile
|
|
# If Reminder File modtime changes, restart daemon
|
|
#---------------------------------------------------------------------------
|
|
proc MonitorReminderFile {} {
|
|
global ReminderFileModTime ReminderFile
|
|
|
|
if {$ReminderFileModTime < 0} {
|
|
# Could not stat file
|
|
return
|
|
}
|
|
|
|
set mtime -1
|
|
catch {
|
|
set mtime [file mtime $ReminderFile]
|
|
}
|
|
if {$mtime < 0} {
|
|
# Doh!
|
|
return
|
|
}
|
|
|
|
# Run ourselves again
|
|
after 60000 MonitorReminderFile
|
|
|
|
# Redraw calendar and restart daemon if needed
|
|
if {$ReminderFileModTime < $mtime} {
|
|
set ReminderFileModTime $mtime
|
|
FillCalWindow
|
|
RestartBackgroundRemindDaemon
|
|
}
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
# GetWeekdayNames - Spawn a remind process and get the names of the weekdays
|
|
# Also sets CurMonth and CurYear.
|
|
#---------------------------------------------------------------------------
|
|
proc GetWeekdayNames {} {
|
|
global CurMonth CurYear TodayYear TodayMonth TodayDay Remind
|
|
set f [open "|$Remind - 2>/dev/null" r+]
|
|
puts $f "banner %"
|
|
set i 0
|
|
while { $i < 7 } {
|
|
puts $f "msg \[wkday($i)\]%"
|
|
incr i
|
|
}
|
|
|
|
# Get current month and year as long as we're running Remind
|
|
puts $f "msg %n%"
|
|
puts $f "msg %y%"
|
|
puts $f "msg %d%"
|
|
puts $f "FLUSH"
|
|
flush $f
|
|
set ans {}
|
|
set i 0
|
|
while { $i < 7 } {
|
|
lappend ans [gets $f]
|
|
incr i
|
|
}
|
|
set CurMonth [expr [gets $f] - 1]
|
|
set CurYear [gets $f]
|
|
set TodayDay [gets $f]
|
|
set TodayMonth $CurMonth
|
|
set TodayYear $CurYear
|
|
close $f
|
|
return $ans
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: CalEntryOffset
|
|
# %ARGUMENTS:
|
|
# firstDay -- first day of month (0=Sunday, 6=Saturday)
|
|
# %RETURNS:
|
|
# Offset mapping day numbers (1-31) to window numbers (0-41)
|
|
# %DESCRIPTION:
|
|
# Computes offset from day number to window number
|
|
#***********************************************************************
|
|
proc CalEntryOffset { firstDay } {
|
|
global MondayFirst
|
|
if {$MondayFirst} {
|
|
incr firstDay -1
|
|
if {$firstDay < 0} {
|
|
set firstDay 6
|
|
}
|
|
}
|
|
return [expr $firstDay-1]
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: CreateCalFrame
|
|
# %ARGUMENTS:
|
|
# w -- name of frame window
|
|
# dayNames -- names of weekdays
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Creates a frame holding a grid of labels and a grid of text entries
|
|
#***********************************************************************
|
|
proc CreateCalFrame { w dayNames } {
|
|
# Figure out reasonable height for text frames
|
|
global SetFontsWorked
|
|
set h [winfo screenheight .]
|
|
if {$h <= 480} {
|
|
if {$SetFontsWorked} {
|
|
set h 3
|
|
} else {
|
|
set h 2
|
|
}
|
|
} elseif {$h <= 600} {
|
|
set h 4
|
|
} else {
|
|
set h 5
|
|
}
|
|
|
|
global MondayFirst
|
|
frame $w
|
|
for {set i 0} {$i < 7} {incr i} {
|
|
if {$MondayFirst} {
|
|
set index [expr ($i+1)%7]
|
|
} else {
|
|
set index $i
|
|
}
|
|
|
|
label $w.day$i -border 1 -text [lindex $dayNames $index] -justify center
|
|
grid configure $w.day$i -row 0 -column $i -sticky ew
|
|
}
|
|
for {set i 0} {$i < 6} {incr i} {
|
|
set n [expr $i*7]
|
|
for {set j 0} {$j < 7} {incr j} {
|
|
set f [expr $n+$j]
|
|
button $w.l$f -text "" -justify center -command "" \
|
|
-state disabled -relief flat -border 0 -padx 0 -pady 0
|
|
text $w.t$f -width 12 -height $h -border 1 -spacing3 3 -wrap word -relief flat \
|
|
-state disabled -takefocus 0 -cursor {}
|
|
$w.t$f tag bind TAGGED <ButtonPress-1> "EditTaggedReminder $w.t$f"
|
|
$w.t$f tag bind REM <ButtonPress-3> "FireEditor $w.t$f"
|
|
|
|
grid configure $w.l$f -row [expr $i*2+1] -column $j -sticky ew
|
|
grid configure $w.t$f -row [expr $i*2+2] -column $j -sticky nsew
|
|
}
|
|
}
|
|
|
|
for {set i 0} {$i < 7} {incr i} {
|
|
grid columnconfigure $w $i -weight 1
|
|
}
|
|
for {set i 2} {$i < 14} {incr i 2} {
|
|
grid rowconfigure $w $i -weight 1
|
|
}
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: ConfigureCalFrame
|
|
# %ARGUMENTS:
|
|
# w -- window name of calendar frame
|
|
# firstDay -- first weekday of month
|
|
# numDays -- number of days in month
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Sets up button labels; configures text justification
|
|
#***********************************************************************
|
|
proc ConfigureCalFrame { w firstDay numDays } {
|
|
global CurMonth CurYear TodayMonth TodayYear TodayDay
|
|
global tk_version
|
|
set offset [CalEntryOffset $firstDay]
|
|
set first [expr $offset+1]
|
|
set last [expr $offset+$numDays]
|
|
|
|
set bg [lindex [. configure -background] 3]
|
|
|
|
for {set i 0} {$i < $first} {incr i} {
|
|
grid $w.l$i $w.t$i
|
|
$w.l$i configure -text "" -command "" -state disabled -relief flat
|
|
balloon_add_help $w.l$i ""
|
|
$w.t$i configure -relief flat -takefocus 0 -state normal
|
|
$w.t$i delete 1.0 end
|
|
foreach t [$w.t$i tag names] {
|
|
$w.t$i tag delete $t
|
|
}
|
|
$w.t$i tag bind TAGGED <ButtonPress-1> "EditTaggedReminder $w.t$i"
|
|
$w.t$i tag bind REM <ButtonPress-3> "FireEditor $w.t$i"
|
|
$w.t$i configure -state disabled
|
|
$w.t$i configure -background $bg
|
|
$w.l$i configure -background $bg
|
|
}
|
|
for {set i $first} {$i <= $last} {incr i} {
|
|
grid $w.l$i $w.t$i
|
|
set d [expr $i-$first+1]
|
|
$w.l$i configure -text $d -state normal -relief flat \
|
|
-command "ModifyDay $d $firstDay"
|
|
balloon_add_help $w.l$i "Add a reminder..."
|
|
$w.t$i configure -relief sunken -takefocus 1 -state normal
|
|
$w.t$i delete 1.0 end
|
|
foreach t [$w.t$i tag names] {
|
|
$w.t$i tag delete $t
|
|
}
|
|
$w.t$i tag bind TAGGED <ButtonPress-1> "EditTaggedReminder $w.t$i"
|
|
$w.t$i tag bind REM <ButtonPress-3> "FireEditor $w.t$i"
|
|
$w.t$i configure -state disabled
|
|
$w.t$i configure -background $bg
|
|
$w.l$i configure -background $bg
|
|
}
|
|
set forgetIt 0
|
|
for {set i [expr $last+1]} {$i < 42} {incr i} {
|
|
if {$i%7 == 0} {
|
|
set forgetIt 1
|
|
}
|
|
set row [expr ($i/7)*2+1]
|
|
if {$forgetIt} {
|
|
grid remove $w.l$i $w.t$i
|
|
grid rowconfigure $w $row -weight 0
|
|
grid rowconfigure $w [expr $row+1] -weight 0
|
|
} else {
|
|
grid rowconfigure $w [expr $row+1] -weight 1
|
|
}
|
|
$w.l$i configure -text "" -command "" -state disabled -relief flat
|
|
balloon_add_help $w.l$i ""
|
|
$w.t$i configure -relief flat -takefocus 0 -state normal
|
|
$w.t$i delete 1.0 end
|
|
foreach t [$w.t$i tag names] {
|
|
$w.t$i tag delete $t
|
|
}
|
|
$w.t$i tag bind TAGGED <ButtonPress-1> "EditTaggedReminder $w.t$i"
|
|
$w.t$i tag bind REM <ButtonPress-3> "FireEditor $w.t$i"
|
|
$w.t$i configure -state disabled
|
|
$w.t$i configure -background $bg
|
|
$w.l$i configure -background $bg
|
|
}
|
|
if { $CurMonth == $TodayMonth && $CurYear == $TodayYear } {
|
|
set n [expr $TodayDay + $offset]
|
|
$w.l$n configure -background "#00c0c0"
|
|
}
|
|
}
|
|
|
|
proc DoQueue {} {
|
|
global DaemonFile
|
|
puts $DaemonFile "JSONQUEUE"
|
|
flush $DaemonFile
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateCalWindow -- create the calendar window.
|
|
# Arguments:
|
|
# dayNames -- names of weekdays in current language {Sun .. Sat}
|
|
#---------------------------------------------------------------------------
|
|
proc CreateCalWindow { dayNames } {
|
|
global Option
|
|
frame .h
|
|
label .h.title -text "" -justify center -pady 1 -border 1 -relief raised
|
|
pack .h.title -side top -fill x
|
|
pack .h -side top -expand 0 -fill x
|
|
|
|
CreateCalFrame .cal $dayNames
|
|
|
|
frame .b
|
|
button .b.prev -image leftarrow -width 24 -command {MoveMonth -1} -border 1
|
|
balloon_add_help .b.prev "Go to previous month"
|
|
button .b.this -text {Today} -command {ThisMonth} -border 1
|
|
balloon_add_help .b.this "Go to this month"
|
|
button .b.next -image rightarrow -width 24 -command {MoveMonth 1} -border 1
|
|
balloon_add_help .b.next "Go to next month"
|
|
button .b.goto -text {Go To Date...} -command {GotoDialog} -border 1
|
|
balloon_add_help .b.goto "Go to a specific date"
|
|
button .b.print -text {Print...} -command {DoPrint} -border 1
|
|
balloon_add_help .b.print "Print a PostScript calendar"
|
|
button .b.queue -text {Queue...} -command {DoQueue} -border 1
|
|
balloon_add_help .b.queue "See the queue of pending reminders (debugging purposes only)"
|
|
button .b.quit -text {Quit} -command {Quit} -border 1
|
|
balloon_add_help .b.quit "Quit TkRemind"
|
|
button .b.options -text {Options...} -command EditOptions -border 1
|
|
balloon_add_help .b.options "Set TkRemind options"
|
|
label .b.status -text "" -width 25 -relief sunken -border 1
|
|
label .b.nqueued -text "" -width 20 -relief sunken -border 1
|
|
pack .b.prev .b.this .b.next .b.goto .b.print .b.options .b.queue .b.quit -side left -fill both
|
|
pack .b.status -side left -fill x -expand 1
|
|
pack .b.nqueued -side left -fill x
|
|
pack .b -side bottom -fill x -expand 0
|
|
pack .cal -side top -fill both -expand 1
|
|
wm title . "TkRemind"
|
|
wm iconname . ""
|
|
wm protocol . WM_DELETE_WINDOW Quit
|
|
wm deiconify .
|
|
bind . <Control-KeyPress-q> Quit
|
|
bind . <KeyPress-Left> ".b.prev flash; .b.prev invoke"
|
|
bind . <KeyPress-Right> ".b.next flash; .b.next invoke"
|
|
bind . <KeyPress-Prior> ".b.prev flash; .b.prev invoke"
|
|
bind . <KeyPress-Next> ".b.next flash; .b.next invoke"
|
|
bind . <KeyPress-Home> ".b.this flash; .b.this invoke"
|
|
|
|
if {$Option(StartIconified)} {
|
|
wm iconify .
|
|
}
|
|
update
|
|
grid propagate .cal 0
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: EditOptions
|
|
# %ARGUMENTS:
|
|
# None
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Lets user edit options
|
|
#***********************************************************************
|
|
proc EditOptions {} {
|
|
global Option tmpOpt
|
|
|
|
# Make a working copy of current option set
|
|
foreach name [array names Option] {
|
|
set tmpOpt($name) $Option($name)
|
|
}
|
|
|
|
set w .opt
|
|
catch { destroy $w }
|
|
toplevel $w
|
|
wm title $w "TkRemind Options"
|
|
wm iconname $w "Options"
|
|
frame $w.f
|
|
frame $w.b
|
|
pack $w.f -side top -expand 1 -fill both
|
|
pack $w.b -side top -expand 0 -fill x
|
|
|
|
# Start iconified
|
|
checkbutton $w.startIconified -text "Start up Iconified" \
|
|
-anchor w -justify left \
|
|
-variable tmpOpt(StartIconified)
|
|
|
|
# Show today's reminders on startup
|
|
checkbutton $w.showTodays -text "Show Today's Reminders on Startup" \
|
|
-anchor w -justify left \
|
|
-variable tmpOpt(ShowTodaysReminders)
|
|
|
|
# Confirm quit
|
|
checkbutton $w.confirmQuit -text "Confirm Quit" -anchor w -justify left \
|
|
-variable tmpOpt(ConfirmQuit)
|
|
|
|
# Bring down reminder windows after one minute
|
|
checkbutton $w.bringDown \
|
|
-text "Automatically close pop-up reminders after a minute" \
|
|
-anchor w -justify left -variable tmpOpt(AutoClose)
|
|
|
|
# Ring bell when popping up reminder
|
|
checkbutton $w.ring -text "Beep terminal when popping up a reminder" \
|
|
-anchor w -justify left -variable tmpOpt(RingBell)
|
|
|
|
checkbutton $w.deic -text "Deiconify calendar window when popping up a reminder" \
|
|
-anchor w -justify left -variable tmpOpt(Deiconify)
|
|
|
|
# Run command when popping up reminder
|
|
frame $w.rf
|
|
label $w.rl -text "Run command when popping up reminder:" -anchor w \
|
|
-justify left
|
|
entry $w.cmd -width 30
|
|
pack $w.rl -in $w.rf -side left -expand 0 -fill none
|
|
pack $w.cmd -in $w.rf -side left -expand 1 -fill x
|
|
$w.cmd insert 0 $tmpOpt(RunCmd)
|
|
|
|
frame $w.sep3 -border 1 -relief sunken
|
|
# E-mail reminder if popup not dismissed
|
|
frame $w.eml
|
|
label $w.lab_email_address -text "E-mail reminders here if popup not dismissed:" -anchor w -justify left
|
|
entry $w.email_address -width 30
|
|
pack $w.lab_email_address -in $w.eml -side left -expand 0 -fill none
|
|
pack $w.email_address -in $w.eml -side left -expand 1 -fill x
|
|
$w.email_address insert 0 $tmpOpt(MailAddr)
|
|
|
|
frame $w.fsmtp
|
|
label $w.lab_smtp -text "Name or IP address of SMTP server:" -anchor w -justify left
|
|
entry $w.smtp -width 30
|
|
pack $w.lab_smtp -in $w.fsmtp -side left -expand 0 -fill none
|
|
pack $w.smtp -in $w.fsmtp -side left -expand 1 -fill x
|
|
$w.smtp insert 0 $tmpOpt(SMTPServer)
|
|
|
|
# Editor
|
|
frame $w.ef
|
|
label $w.el -text "Text Editor:" -anchor w -justify left
|
|
entry $w.editor -width 30
|
|
pack $w.el -in $w.ef -side left -expand 0 -fill none
|
|
pack $w.editor -in $w.ef -side left -expand 1 -fill x
|
|
$w.editor insert 0 $tmpOpt(Editor)
|
|
|
|
# extra args
|
|
frame $w.eaf
|
|
label $w.eal -text "Extra Arguments for Remind:" -anchor w -justify left
|
|
entry $w.extraargs -width 30
|
|
pack $w.eal -in $w.eaf -side left -expand 0 -fill none
|
|
pack $w.extraargs -in $w.eaf -side left -expand 1 -fill x
|
|
$w.extraargs insert 0 $tmpOpt(ExtraRemindArgs)
|
|
|
|
frame $w.sep1 -border 1 -relief sunken
|
|
frame $w.sep2 -border 1 -relief sunken
|
|
|
|
checkbutton $w.feed \
|
|
-text "Feed popped-up reminder to command's standard input" \
|
|
-variable tmpOpt(FeedReminder) -anchor w -justify left
|
|
|
|
pack $w.startIconified -in $w.f -side top -expand 0 -fill x
|
|
pack $w.showTodays -in $w.f -side top -expand 0 -fill x
|
|
pack $w.confirmQuit -in $w.f -side top -expand 0 -fill x
|
|
pack $w.bringDown -in $w.f -side top -expand 0 -fill x
|
|
pack $w.ring -in $w.f -side top -expand 0 -fill x
|
|
pack $w.deic -in $w.f -side top -expand 0 -fill x
|
|
pack $w.sep1 -in $w.f -side top -expand 0 -fill x -ipady 1
|
|
pack $w.rf -in $w.f -side top -expand 0 -fill x
|
|
pack $w.feed -in $w.f -side top -expand 0 -fill x
|
|
pack $w.sep3 -in $w.f -side top -expand 0 -fill x -ipady 1
|
|
pack $w.eml -in $w.f -side top -expand 0 -fill x
|
|
pack $w.fsmtp -in $w.f -side top -expand 0 -fill x
|
|
pack $w.ef -in $w.f -side top -expand 0 -fill x
|
|
pack $w.eaf -in $w.f -side top -expand 0 -fill x
|
|
pack $w.sep2 -in $w.f -side top -expand 0 -fill x -ipady 1
|
|
|
|
button $w.apply -text "Apply Options" -command "ApplyOptions $w; destroy $w"
|
|
button $w.save -text "Save Options" -command "SaveOptions $w; destroy $w"
|
|
button $w.cancel -text "Cancel" -command "destroy $w"
|
|
|
|
pack $w.apply $w.save $w.cancel -in $w.b -side left -expand 0 -fill x
|
|
CenterWindow $w .
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: ApplyOptions
|
|
# %ARGUMENTS:
|
|
# w -- edit options window path
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Applies options set in the edit options box.
|
|
#***********************************************************************
|
|
proc ApplyOptions { w } {
|
|
global Option tmpOpt
|
|
|
|
set tmpOpt(RunCmd) [$w.cmd get]
|
|
set tmpOpt(Editor) [$w.editor get]
|
|
set tmpOpt(ExtraRemindArgs) [$w.extraargs get]
|
|
set tmpOpt(MailAddr) [$w.email_address get]
|
|
set tmpOpt(SMTPServer) [$w.smtp get]
|
|
|
|
set need_restart 0
|
|
if {"$tmpOpt(ExtraRemindArgs)" != "$Option(ExtraRemindArgs)"} {
|
|
set need_restart 1
|
|
}
|
|
# Copy working copy to real option set
|
|
foreach name [array names tmpOpt] {
|
|
set Option($name) $tmpOpt($name)
|
|
}
|
|
if {$need_restart != 0} {
|
|
FillCalWindow
|
|
StopBackgroundRemindDaemon
|
|
StartBackgroundRemindDaemon
|
|
}
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: SaveOptions
|
|
# %ARGUMENTS:
|
|
# w -- edit options window path
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Saves options in $HOME/.tkremindrc
|
|
#***********************************************************************
|
|
proc SaveOptions { w } {
|
|
global Option OptDescr
|
|
ApplyOptions $w
|
|
|
|
set problem [catch {set f [open ~/.tkremindrc "w"]} err]
|
|
if {$problem} {
|
|
tk_dialog .error Error "Can't write ~/.tkremindrc: $err" 0 OK
|
|
return
|
|
}
|
|
|
|
puts $f "# TkRemind option file -- created automatically"
|
|
puts $f "# [clock format [clock seconds]]"
|
|
puts $f "# Format of each line is 'key value' where 'key'"
|
|
puts $f "# specifies the option name, and 'value' is a"
|
|
puts $f "# *legal Tcl list element* specifying the option value."
|
|
foreach name [lsort [array names Option]] {
|
|
puts $f ""
|
|
puts $f "# $OptDescr($name)"
|
|
puts $f [list $name $Option($name)]
|
|
}
|
|
puts $f ""
|
|
close $f
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: LoadOptions
|
|
# %ARGUMENTS:
|
|
# None
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Loads options from ~/.tkremindrc
|
|
#***********************************************************************
|
|
proc LoadOptions {} {
|
|
global Option
|
|
set problem [catch {set f [open "~/.tkremindrc" "r"]}]
|
|
if {$problem} {
|
|
return
|
|
}
|
|
while {[gets $f line] >= 0} {
|
|
if {[string match "#*" $line]} { continue }
|
|
if {$line == ""} { continue }
|
|
foreach {key val} $line {}
|
|
if {![info exists Option($key)]} {
|
|
puts "Unknown option in ~/.tkremindrc: $key"
|
|
continue
|
|
}
|
|
set Option($key) $val
|
|
}
|
|
close $f
|
|
}
|
|
|
|
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: ConfigureCalWindow
|
|
# %ARGUMENTS:
|
|
# month -- month name
|
|
# year -- the year
|
|
# firstDay -- first day in month
|
|
# numDays -- number of days in month
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Configures the calendar window for a month and year
|
|
# %PRECONDITIONS:
|
|
# Any preconditions
|
|
# %POSTCONDITIONS:
|
|
# Any postconditions
|
|
# %SIDE EFFECTS:
|
|
# Any side effects
|
|
#***********************************************************************
|
|
proc ConfigureCalWindow { month year firstDay numDays } {
|
|
global Hostname
|
|
.h.title configure -text "$month $year"
|
|
wm title . "$month $year - TkRemind on $Hostname"
|
|
wm iconname . "$month $year"
|
|
ConfigureCalFrame .cal $firstDay $numDays
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# FillCalWindow -- Fill in the calendar for global CurMonth and CurYear.
|
|
#---------------------------------------------------------------------------
|
|
proc FillCalWindow {} {
|
|
set FileName ""
|
|
set LineNo 0
|
|
global DayNames CurYear CurMonth MonthNames CommandLine Option TagToObj
|
|
|
|
array unset TagToObj
|
|
|
|
Status "Firing off Remind..."
|
|
set month [lindex $MonthNames $CurMonth]
|
|
|
|
set cmd [regsub EXTRA $CommandLine $Option(ExtraRemindArgs)]
|
|
set file [open "$cmd $month $CurYear" r]
|
|
# Look for # rem2ps2 begin line
|
|
while { [gets $file line] >= 0 } {
|
|
if { [string compare "$line" "# rem2ps2 begin"] == 0 } { break }
|
|
}
|
|
|
|
if { [string compare "$line" "# rem2ps2 begin"] != 0 } {
|
|
Status "Problem reading results from Remind!"
|
|
after 5000 DisplayTime
|
|
catch { close $file }
|
|
return 0
|
|
}
|
|
|
|
# Read month name, year, number of days in month, first weekday, Mon flag
|
|
gets $file line
|
|
regexp {^([^ ]*) ([0-9][0-9][0-9][0-9]) ([0-9][0-9]?) ([0-9]) ([0-9])} $line dummy monthName year daysInMonth firstWkday mondayFirst
|
|
|
|
# Skip day names -- we already have them
|
|
gets $file line
|
|
ConfigureCalWindow $monthName $year $firstWkday $daysInMonth
|
|
set offset [CalEntryOffset $firstWkday]
|
|
|
|
set fntag "x"
|
|
while { [gets $file line] >= 0 } {
|
|
# Ignore unless begins with left brace
|
|
if { ! [string match "\{*" $line]} {
|
|
continue
|
|
}
|
|
|
|
if {[catch {set obj [::json::json2dict $line]}]} {
|
|
continue
|
|
}
|
|
|
|
if {[dict exists $obj filename]} {
|
|
set fntag [string cat "FILE_" [dict get $obj lineno] "_" [dict get $obj filename]]
|
|
}
|
|
|
|
set date [dict get $obj date]
|
|
regexp {^([0-9][0-9][0-9][0-9]).([0-9][0-9]).([0-9][0-9])} $date all year month day
|
|
if {[dict exists $obj passthru]} {
|
|
set type [dict get $obj passthru]
|
|
} else {
|
|
set type "*"
|
|
}
|
|
if {[dict exist $obj tags]} {
|
|
set tag [dict get $obj tags]
|
|
} else {
|
|
set tag "*"
|
|
}
|
|
set stuff [dict get $obj body]
|
|
|
|
set day [string trimleft $day 0]
|
|
set n [expr $day+$offset]
|
|
set month [string trimleft $month 0]
|
|
set extratags ""
|
|
switch -nocase -- $type {
|
|
"WEEK" {
|
|
set stuff [string trimleft $stuff]
|
|
set stuff [string trimright $stuff]
|
|
set offset [CalEntryOffset $firstWkday]
|
|
set label [expr $offset + $day]
|
|
.cal.l$label configure -text "$day $stuff"
|
|
continue
|
|
}
|
|
"SHADE" {
|
|
DoShadeSpecial $n [dict get $obj r] [dict get $obj g] [dict get $obj b]
|
|
continue
|
|
}
|
|
"MOON" {
|
|
DoMoonSpecial $n $stuff
|
|
continue
|
|
}
|
|
"COLOUR" -
|
|
"COLOR" {
|
|
if {[regexp {^ *([0-9]+) +([0-9]+) +([0-9]+) +(.*)$} $stuff all r g b rest]} {
|
|
if {$r > 255} {
|
|
set r 255
|
|
} elseif {$r < 0} {
|
|
set r 0
|
|
}
|
|
if {$g > 255} {
|
|
set g 255
|
|
} elseif {$g < 0} {
|
|
set g 0
|
|
}
|
|
if {$b > 255} {
|
|
set b 255
|
|
} elseif {$b < 0} {
|
|
set b 0
|
|
}
|
|
set color [format "%02X%02X%02X" $r $g $b]
|
|
set extratags "clr$color"
|
|
.cal.t$n configure -state normal
|
|
.cal.t$n tag configure $extratags -foreground "#$color"
|
|
.cal.t$n configure -state disabled
|
|
set stuff $rest
|
|
set type "COLOR"
|
|
}
|
|
}
|
|
}
|
|
if { $type != "*" && $type != "COLOR" && $type != "COLOUR"} {
|
|
continue
|
|
}
|
|
.cal.t$n configure -state normal
|
|
if {[regexp {TKTAG([0-9]+)} $tag all tagno]} {
|
|
.cal.t$n insert end [string trim $stuff] [list REM TAGGED "TKTAG$tagno" "date_$date" $extratags $fntag]
|
|
.cal.t$n tag bind "TKTAG$tagno" <Enter> "TaggedEnter .cal.t$n"
|
|
.cal.t$n tag bind "TKTAG$tagno" <Leave> "TaggedLeave .cal.t$n"
|
|
set TagToObj(TKTAG$tagno) $obj
|
|
} else {
|
|
.cal.t$n insert end [string trim $stuff] [list REM $extratags $fntag]
|
|
}
|
|
.cal.t$n insert end "\n"
|
|
.cal.t$n configure -state disabled
|
|
|
|
}
|
|
set problem [catch { close $file } errmsg]
|
|
if {$problem} {
|
|
tk_dialog .error Error "There was a problem running Remind: $errmsg" error 0 OK
|
|
}
|
|
DisplayTime
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# MoveMonth -- move by +1 or -1 months
|
|
# Arguments:
|
|
# delta -- +1 or -1 -- months to move.
|
|
#---------------------------------------------------------------------------
|
|
proc MoveMonth {delta} {
|
|
global CurMonth CurYear
|
|
set CurMonth [expr $CurMonth + $delta]
|
|
if {$CurMonth < 0} {
|
|
set CurMonth 11
|
|
set CurYear [expr $CurYear-1]
|
|
}
|
|
|
|
if {$CurMonth > 11} {
|
|
set CurMonth 0
|
|
incr CurYear
|
|
}
|
|
|
|
FillCalWindow
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# ThisMonth -- move to current month
|
|
#---------------------------------------------------------------------------
|
|
proc ThisMonth {} {
|
|
global CurMonth CurYear TodayMonth TodayYear
|
|
|
|
# Do nothing if already there
|
|
if { $CurMonth == $TodayMonth && $CurYear == $TodayYear } {
|
|
return 0;
|
|
}
|
|
set CurMonth $TodayMonth
|
|
set CurYear $TodayYear
|
|
FillCalWindow
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# Status -- set status string
|
|
# Arguments:
|
|
# stuff -- what to set string to.
|
|
#---------------------------------------------------------------------------
|
|
proc Status { stuff } {
|
|
catch { .b.status configure -text $stuff }
|
|
update idletasks
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# DoPrint -- print a calendar
|
|
# Arguments:
|
|
# None
|
|
#---------------------------------------------------------------------------
|
|
proc DoPrint {} {
|
|
global PrintDest PrintSize PrintMargins PrintOrient PrintFill PrintEncoding PrintSmallCalendars PrintStatus Rem2PS PSCmd Option
|
|
global CurMonth CurYear MonthNames
|
|
catch {destroy .p}
|
|
toplevel .p
|
|
wm title .p "TkRemind Print..."
|
|
wm iconname .p "Print..."
|
|
frame .p.f1 -relief sunken -border 2
|
|
frame .p.f11
|
|
frame .p.f12
|
|
frame .p.f2 -relief sunken -border 2
|
|
frame .p.f2a -relief sunken -border 2
|
|
frame .p.f3 -relief sunken -border 2
|
|
frame .p.f3a -relief sunken -border 2
|
|
frame .p.f4
|
|
|
|
radiobutton .p.tofile -text "To file: " -variable PrintDest -value file
|
|
entry .p.filename
|
|
button .p.browse -text "Browse..." -command PrintFileBrowse
|
|
radiobutton .p.tocmd -text "To command: " -variable PrintDest -value command
|
|
entry .p.command
|
|
.p.command insert end "lpr"
|
|
|
|
label .p.size -text "Paper Size:"
|
|
radiobutton .p.letter -text "Letter" -variable PrintSize -value letter
|
|
radiobutton .p.a4 -text "A4" -variable PrintSize -value a4
|
|
|
|
label .p.margin -text "Margins:"
|
|
radiobutton .p.24pt -text "24pt margins" -variable PrintMargins -value 24pt
|
|
radiobutton .p.36pt -text "36pt margins" -variable PrintMargins -value 36pt
|
|
radiobutton .p.48pt -text "48pt margins" -variable PrintMargins -value 48pt
|
|
|
|
label .p.orient -text "Orientation:"
|
|
radiobutton .p.landscape -text "Landscape" -variable PrintOrient -value landscape
|
|
radiobutton .p.portrait -text "Portrait" -variable PrintOrient -value portrait
|
|
|
|
checkbutton .p.fill -text "Fill page" -variable PrintFill
|
|
checkbutton .p.encoding -text "ISO 8859-1 PostScript encoding" -variable PrintEncoding
|
|
checkbutton .p.calendars -text "Print small calendars" -variable PrintSmallCalendars
|
|
|
|
button .p.print -text "Print" -command {set PrintStatus print}
|
|
button .p.cancel -text "Cancel" -command {set PrintStatus cancel}
|
|
|
|
pack .p.f1 .p.f2 .p.f2a .p.f3 .p.f3a \
|
|
-side top -fill both -expand 1 -anchor w
|
|
pack .p.fill .p.encoding .p.calendars -in .p.f3a \
|
|
-side top -anchor w -fill none -expand 0
|
|
pack .p.f4 -side top -fill both -expand 1 -anchor w
|
|
pack .p.f11 .p.f12 -in .p.f1 -side top -fill none -expand 0 -anchor w
|
|
pack .p.tofile .p.filename .p.browse -in .p.f11 -side left -fill none -expand 0 -anchor w
|
|
pack .p.tocmd .p.command -in .p.f12 -side left -fill none -expand 0 -anchor w
|
|
pack .p.size .p.letter .p.a4 -in .p.f2 -side top -fill none -expand 0 -anchor w
|
|
pack .p.margin .p.24pt .p.36pt .p.48pt -in .p.f2a -side top -anchor w -fill none -expand 0
|
|
pack .p.orient .p.landscape .p.portrait -in .p.f3 -side top -fill none -expand 0 -anchor w
|
|
pack .p.print .p.cancel -in .p.f4 -side left -fill none -expand 0
|
|
|
|
bind .p <KeyPress-Escape> ".p.cancel flash; .p.cancel invoke"
|
|
bind .p <KeyPress-Return> ".p.print flash; .p.print invoke"
|
|
set PrintStatus 2
|
|
CenterWindow .p .
|
|
tkwait visibility .p
|
|
set oldFocus [focus]
|
|
focus .p.filename
|
|
grab .p
|
|
tkwait variable PrintStatus
|
|
catch {focus $oldFocus}
|
|
set fname [.p.filename get]
|
|
set cmd [.p.command get]
|
|
destroy .p
|
|
if {$PrintStatus == "cancel"} {
|
|
return
|
|
}
|
|
if {$PrintDest == "file"} {
|
|
if {$fname == ""} {
|
|
tk_dialog .error Error "No filename specified" error 0 Ok
|
|
return
|
|
}
|
|
if {[file isdirectory $fname]} {
|
|
tk_dialog .error Error "$fname is a directory" error 0 Ok
|
|
return
|
|
}
|
|
if {[file readable $fname]} {
|
|
set ans [tk_dialog .error Overwrite? "Overwrite $fname?" question 0 No Yes]
|
|
if {$ans == 0} {
|
|
return
|
|
}
|
|
}
|
|
set fname "> $fname"
|
|
} else {
|
|
set fname "| $cmd"
|
|
}
|
|
|
|
# Build the command line
|
|
set p [regsub EXTRA $PSCmd $Option(ExtraRemindArgs)]
|
|
set cmd "$p 1 [lindex $MonthNames $CurMonth] $CurYear | $Rem2PS"
|
|
if {$PrintSize == "letter"} {
|
|
append cmd " -m Letter"
|
|
} else {
|
|
append cmd " -m A4"
|
|
}
|
|
|
|
if {$PrintMargins == "24pt"} {
|
|
append cmd " -or 24 -ol 24 -ot 24 -ob 24"
|
|
} elseif {$PrintMargins == "36pt"} {
|
|
append cmd " -or 36 -ol 36 -ot 36 -ob 36"
|
|
} else {
|
|
append cmd " -or 48 -ol 48 -ot 48 -ob 48"
|
|
}
|
|
|
|
if {$PrintOrient == "landscape"} {
|
|
append cmd " -l"
|
|
}
|
|
|
|
if {$PrintFill} {
|
|
append cmd " -e"
|
|
}
|
|
|
|
if {$PrintEncoding} {
|
|
append cmd " -i"
|
|
}
|
|
|
|
if {$PrintSmallCalendars} {
|
|
append cmd " -c3"
|
|
} else {
|
|
append cmd " -c0"
|
|
}
|
|
|
|
append cmd " $fname"
|
|
Status "Printing..."
|
|
if {[catch {eval "exec $cmd"} err]} {
|
|
tk_dialog .error Error "Error during printing: $err" error 0 Ok
|
|
}
|
|
DisplayTime
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# PrintFileBrowse -- browse for a filename for Print dialog
|
|
# Arguments: none
|
|
#---------------------------------------------------------------------------
|
|
proc PrintFileBrowse {} {
|
|
set ans [BrowseForFile .filebrowse "Print to file..." "Ok" 0 "*.ps"]
|
|
if {$ans != ""} {
|
|
.p.filename delete 0 end
|
|
.p.filename insert end $ans
|
|
.p.filename icursor end
|
|
.p.filename xview end
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# GotoDialog -- Do the "Goto..." dialog
|
|
#---------------------------------------------------------------------------
|
|
proc GotoDialog {} {
|
|
global CurMonth MonthNames CurYear
|
|
catch { destroy .g }
|
|
|
|
set month [lindex $MonthNames $CurMonth]
|
|
toplevel .g
|
|
wm title .g "Go To Date"
|
|
menubutton .g.mon -text "$month" -menu .g.mon.menu -relief raised
|
|
balloon_add_help .g.mon "Select a month"
|
|
menu .g.mon.menu -tearoff 0
|
|
|
|
foreach m $MonthNames {
|
|
.g.mon.menu add command -label $m -command ".g.mon configure -text $m"
|
|
}
|
|
|
|
frame .g.y
|
|
label .g.y.lab -text "Year: "
|
|
entry .g.y.e -width 4
|
|
balloon_add_help .g.y.e "Enter a year"
|
|
.g.y.e insert end $CurYear
|
|
bind .g.y.e <Return> ".g.b.go flash; .g.b.go invoke"
|
|
frame .g.b
|
|
button .g.b.go -text "Go" -command {DoGoto}
|
|
balloon_add_help .g.b.go "Go to specified month and year"
|
|
button .g.b.cancel -text "Cancel" -command { destroy .g }
|
|
pack .g.b.go .g.b.cancel -expand 1 -fill x -side left
|
|
pack .g.mon -fill x -expand 1
|
|
|
|
pack .g.y.lab -side left
|
|
pack .g.y.e -side left -fill x -expand 1
|
|
pack .g.y -expand 1 -fill x
|
|
pack .g.b -expand 1 -fill x
|
|
bind .g <KeyPress-Escape> ".g.b.cancel flash; .g.b.cancel invoke"
|
|
CenterWindow .g .
|
|
set oldFocus [focus]
|
|
grab .g
|
|
focus .g.y.e
|
|
tkwait window .g
|
|
catch {focus $oldFocus}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# DoGoto -- go to specified date
|
|
#---------------------------------------------------------------------------
|
|
proc DoGoto {} {
|
|
global CurYear CurMonth MonthNames
|
|
set year [.g.y.e get]
|
|
if { ! [regexp {^[0-9]+$} $year] } {
|
|
tk_dialog .error Error {Illegal year specified (1990-5990)} error 0 Ok
|
|
return
|
|
}
|
|
if { $year < 1990 || $year > 5990 } {
|
|
tk_dialog .error Error {Illegal year specified (1990-5990)} error 0 Ok
|
|
return
|
|
}
|
|
set month [lsearch -exact $MonthNames [.g.mon cget -text]]
|
|
set CurMonth $month
|
|
set CurYear $year
|
|
destroy .g
|
|
FillCalWindow
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# Quit -- handle the Quit button
|
|
#---------------------------------------------------------------------------
|
|
proc Quit {} {
|
|
global Option
|
|
if { !$Option(ConfirmQuit) } {
|
|
destroy .
|
|
StopBackgroundRemindDaemon
|
|
exit
|
|
}
|
|
if { [tk_dialog .question "Confirm..." {Really quit?} question 0 No Yes] } {
|
|
destroy .
|
|
StopBackgroundRemindDaemon
|
|
exit
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateModifyDialog -- create dialog for adding a reminder
|
|
# Arguments:
|
|
# w -- path of parent window
|
|
# day -- day number of month
|
|
# firstDay -- day number of first day of month
|
|
# args -- buttons to add to bottom frame. First sets result to 1, next
|
|
# to 2, and so on. FIRST BUTTON MUST BE "Cancel"
|
|
#---------------------------------------------------------------------------
|
|
proc CreateModifyDialog {w day firstDay args} {
|
|
|
|
# Set up: Year, Month, Day, WeekdayName
|
|
global CurYear CurMonth EnglishDayNames MonthNames OptionType SkipType
|
|
global ModifyDialogResult TwentyFourHourMode
|
|
|
|
set OptionType 1
|
|
set SkipType 1
|
|
|
|
set year $CurYear
|
|
set month [lindex $MonthNames $CurMonth]
|
|
set wkday [lindex $EnglishDayNames [expr ($day+$firstDay-1) % 7]]
|
|
|
|
frame $w.o -border 4 -relief ridge
|
|
frame $w.o1 -border 4
|
|
frame $w.o2 -border 4
|
|
frame $w.o3 -border 4
|
|
frame $w.exp -border 4
|
|
frame $w.adv -border 4
|
|
frame $w.weekend -border 4
|
|
frame $w.durationbox -border 4
|
|
frame $w.time -border 4
|
|
frame $w.hol -border 4
|
|
frame $w.msg
|
|
frame $w.buttons
|
|
pack $w.o1 $w.o2 $w.o3 -side top -anchor w -in $w.o
|
|
pack $w.o $w.exp $w.adv $w.weekend $w.time $w.durationbox $w.hol $w.msg -side top -anchor w -pady 4 -expand 1 -fill both
|
|
pack $w.buttons -side top -anchor w -pady 4 -expand 1 -fill x
|
|
|
|
# TYPE 1 REMINDER
|
|
radiobutton $w.type1 -variable OptionType -value 1
|
|
menubutton $w.day1 -text $day -relief raised -menu $w.day1.menu
|
|
balloon_add_help $w.day1 "Select a day"
|
|
CreateDayMenu $w.day1
|
|
menubutton $w.mon1 -text $month -relief raised -menu $w.mon1.menu
|
|
balloon_add_help $w.mon1 "Select a month"
|
|
CreateMonthMenu $w.mon1
|
|
menubutton $w.year1 -text $year -relief raised -menu $w.year1.menu
|
|
balloon_add_help $w.year1 "Select a year"
|
|
CreateYearMenu $w.year1
|
|
checkbutton $w.repbut -text "and repeating every"
|
|
balloon_add_help $w.repbut "Select to enable a recurring reminder"
|
|
$w.repbut deselect
|
|
menubutton $w.repdays -text 1 -relief raised -menu $w.repdays.menu
|
|
balloon_add_help $w.repdays "Select the repeat interval in days"
|
|
CreateDayMenu $w.repdays 1 28 0
|
|
label $w.label1a -text "day(s) thereafter"
|
|
pack $w.type1 $w.day1 $w.mon1 $w.year1 $w.repbut $w.repbut $w.repdays $w.label1a -side left -anchor w -in $w.o1
|
|
|
|
# TYPE 2 REMINDER
|
|
radiobutton $w.type2 -variable OptionType -value 2
|
|
label $w.label2a -text First
|
|
menubutton $w.wkday2 -text $wkday -relief raised -menu $w.wkday2.menu
|
|
balloon_add_help $w.wkday2 "Select a day of the week"
|
|
CreateWeekdayMenu $w.wkday2
|
|
label $w.label2b -text "on or after"
|
|
menubutton $w.day2 -text $day -relief raised -menu $w.day2.menu
|
|
balloon_add_help $w.day2 "Select a day"
|
|
CreateDayMenu $w.day2 1 31 0
|
|
menubutton $w.mon2 -text $month -relief raised -menu $w.mon2.menu
|
|
balloon_add_help $w.mon2 "Select a month"
|
|
CreateMonthMenu $w.mon2
|
|
menubutton $w.year2 -text $year -relief raised -menu $w.year2.menu
|
|
balloon_add_help $w.year2 "Select a year"
|
|
CreateYearMenu $w.year2
|
|
pack $w.type2 $w.label2a $w.wkday2 $w.label2b $w.day2 $w.mon2 $w.year2 -side left -anchor w -in $w.o2
|
|
|
|
# TYPE 3 REMINDER
|
|
if { $day <= 7 } {
|
|
set which "First"
|
|
} elseif {$day <= 14} {
|
|
set which "Second"
|
|
} elseif {$day <= 21} {
|
|
set which "Third"
|
|
} elseif {$day <= 28} {
|
|
set which "Fourth"
|
|
} else {
|
|
set which "Last"
|
|
}
|
|
radiobutton $w.type3 -variable OptionType -value 3
|
|
menubutton $w.ordinal -text $which -relief raised -menu $w.ordinal.menu
|
|
balloon_add_help $w.ordinal "Select the first, second, etc. weekday in a month"
|
|
menu $w.ordinal.menu -tearoff 0
|
|
$w.ordinal.menu add command -label "First" -command "$w.ordinal configure -text First"
|
|
$w.ordinal.menu add command -label "Second" -command "$w.ordinal configure -text Second"
|
|
$w.ordinal.menu add command -label "Third" -command "$w.ordinal configure -text Third"
|
|
$w.ordinal.menu add command -label "Fourth" -command "$w.ordinal configure -text Fourth"
|
|
$w.ordinal.menu add command -label "Last" -command "$w.ordinal configure -text Last"
|
|
$w.ordinal.menu add command -label "Every" -command "$w.ordinal configure -text Every"
|
|
menubutton $w.wkday3 -text $wkday -relief raised -menu $w.wkday3.menu
|
|
balloon_add_help $w.wkday3 "Select a day of the week"
|
|
CreateWeekdayMenu $w.wkday3
|
|
label $w.label3 -text "in"
|
|
menubutton $w.mon3 -text $month -relief raised -menu $w.mon3.menu
|
|
balloon_add_help $w.mon3 "Select a month"
|
|
CreateMonthMenu $w.mon3
|
|
menubutton $w.year3 -text $year -relief raised -menu $w.year3.menu
|
|
balloon_add_help $w.year3 "Select a year"
|
|
CreateYearMenu $w.year3
|
|
pack $w.type3 $w.ordinal $w.wkday3 $w.label3 $w.mon3 $w.year3 -side left -anchor w -in $w.o3
|
|
|
|
# EXPIRY DATE
|
|
checkbutton $w.expbut -text "Expire after"
|
|
balloon_add_help $w.expbut "Select to enable an expiry date"
|
|
$w.expbut deselect
|
|
menubutton $w.expday -text $day -relief raised -menu $w.expday.menu
|
|
balloon_add_help $w.expday "Select expiry day"
|
|
CreateDayMenu $w.expday 1 31 0
|
|
menubutton $w.expmon -text $month -relief raised -menu $w.expmon.menu
|
|
balloon_add_help $w.expmon "Select expiry month"
|
|
CreateMonthMenu $w.expmon 0
|
|
menubutton $w.expyear -text $year -relief raised -menu $w.expyear.menu
|
|
balloon_add_help $w.expyear "Select expiry year"
|
|
CreateYearMenu $w.expyear 0
|
|
|
|
pack $w.expbut $w.expday $w.expmon $w.expyear -side left -anchor w -in $w.exp
|
|
|
|
# ADVANCE NOTICE
|
|
checkbutton $w.advbut -text "Issue"
|
|
balloon_add_help $w.advbut "Select to enable advance notification"
|
|
$w.advbut deselect
|
|
menubutton $w.advdays -text 3 -menu $w.advdays.menu -relief raised
|
|
balloon_add_help $w.advdays "Select number of days of advance warning"
|
|
CreateDayMenu $w.advdays 1 10 0
|
|
label $w.advlab -text "day(s) in advance"
|
|
checkbutton $w.advcount -text "not counting holidays/weekend"
|
|
balloon_add_help $w.advcount "Select to avoid counting holidays/weekend as in advance warning days"
|
|
$w.advcount select
|
|
pack $w.advbut $w.advdays $w.advlab $w.advcount -side left -anchor w -in $w.adv
|
|
|
|
# WEEKEND
|
|
label $w.weeklab -text "Weekend is: "
|
|
pack $w.weeklab -side left -anchor w -in $w.weekend
|
|
foreach d $EnglishDayNames {
|
|
checkbutton $w.d$d -text $d
|
|
balloon_add_help $w.d$d "Select to include $d in the definition of \"Weekend\""
|
|
$w.d$d deselect
|
|
pack $w.d$d -side left -anchor w -in $w.weekend
|
|
}
|
|
$w.dSaturday select
|
|
$w.dSunday select
|
|
|
|
# TIMED REMINDER
|
|
checkbutton $w.timebut -text "Timed reminder at"
|
|
balloon_add_help $w.timebut "Select if this event starts at a specific time"
|
|
$w.timebut deselect
|
|
menubutton $w.timehour -text "12" -menu $w.timehour.menu -relief raised
|
|
balloon_add_help $w.timehour "Select the starting time's hour"
|
|
if {$TwentyFourHourMode} {
|
|
CreateDayMenu $w.timehour 0 23 0
|
|
} else {
|
|
CreateDayMenu $w.timehour 1 12 0
|
|
}
|
|
menubutton $w.timemin -text "00" -menu $w.timemin.menu -relief raised
|
|
balloon_add_help $w.timemin "Select the starting time's minute"
|
|
menu $w.timemin.menu -tearoff 0
|
|
foreach i {00 05 10 15 20 25 30 35 40 45 50 55} {
|
|
$w.timemin.menu add command -label $i \
|
|
-command "$w.timemin configure -text $i"
|
|
}
|
|
|
|
if {!$TwentyFourHourMode} {
|
|
menubutton $w.ampm -text "PM" -menu $w.ampm.menu -relief raised
|
|
balloon_add_help $w.ampm "Select whether the time is AM or PM"
|
|
menu $w.ampm.menu -tearoff 0
|
|
$w.ampm.menu add command -label "AM" -command "$w.ampm configure -text {AM}"
|
|
$w.ampm.menu add command -label "PM" -command "$w.ampm configure -text {PM}"
|
|
}
|
|
|
|
checkbutton $w.timeadvbut -text "with"
|
|
balloon_add_help $w.timeadvbut "Select to be given advance warning prior to the start time"
|
|
$w.timeadvbut deselect
|
|
menubutton $w.timeadv -text "15" -menu $w.timeadv.menu -relief raised
|
|
balloon_add_help $w.timeadv "Select the number of minutes of advance warning"
|
|
menu $w.timeadv.menu -tearoff 0
|
|
foreach i {5 10 15 30 45 60} {
|
|
$w.timeadv.menu add command -label $i -command "$w.timeadv configure -text $i"
|
|
}
|
|
label $w.timelab1 -text "minutes advance notice"
|
|
|
|
checkbutton $w.timerepbut -text "repeated every"
|
|
balloon_add_help $w.timerepbut "Select to repeat the advance notice"
|
|
$w.timerepbut deselect
|
|
menubutton $w.timerep -text "5" -menu $w.timerep.menu -relief raised
|
|
balloon_add_help $w.timerep "Select how often to repeat the advance notice"
|
|
menu $w.timerep.menu -tearoff 0
|
|
foreach i {3 5 10 15 30} {
|
|
$w.timerep.menu add command -label $i -command "$w.timerep configure -text $i"
|
|
}
|
|
label $w.timelab2 -text "minutes"
|
|
if {$TwentyFourHourMode} {
|
|
pack $w.timebut $w.timehour $w.timemin $w.timeadvbut $w.timeadv $w.timelab1 $w.timerepbut $w.timerep $w.timelab2 -side left -anchor w -in $w.time
|
|
} else {
|
|
pack $w.timebut $w.timehour $w.timemin $w.ampm $w.timeadvbut $w.timeadv $w.timelab1 $w.timerepbut $w.timerep $w.timelab2 -side left -anchor w -in $w.time
|
|
}
|
|
|
|
# DURATION
|
|
checkbutton $w.durationbut -text "Duration"
|
|
balloon_add_help $w.durationbut "Select if this event has a specific duration"
|
|
$w.durationbut deselect
|
|
menubutton $w.durationh -text "1" -menu $w.durationh.menu -relief raised
|
|
balloon_add_help $w.durationh "Select how many hours the event lasts"
|
|
menu $w.durationh.menu -tearoff 0
|
|
foreach i {0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24} {
|
|
$w.durationh.menu add command -label $i -command "$w.durationh configure -text $i"
|
|
}
|
|
label $w.durationcolon -text ":"
|
|
menubutton $w.durationm -text "00" -menu $w.durationm.menu -relief raised
|
|
balloon_add_help $w.durationm "Select how many minutes the event lasts (in addition to the hours)"
|
|
menu $w.durationm.menu -tearoff 0
|
|
foreach i {00 15 30 45} {
|
|
$w.durationm.menu add command -label $i -command "$w.durationm configure -text $i"
|
|
}
|
|
pack $w.durationbut $w.durationh $w.durationcolon $w.durationm -side left -anchor w -in $w.durationbox
|
|
|
|
# SKIP TYPE
|
|
label $w.labhol -text "On holidays or weekends:"
|
|
radiobutton $w.issue -variable SkipType -value 1 -text "Issue reminder as usual"
|
|
radiobutton $w.skip -variable SkipType -value 2 -text "Skip reminder"
|
|
radiobutton $w.before -variable SkipType -value 3 -text "Move reminder before holiday or weekend"
|
|
radiobutton $w.after -variable SkipType -value 4 -text "Move reminder after holiday or weekend"
|
|
pack $w.labhol $w.issue $w.skip $w.before $w.after -side top -anchor w -in $w.hol
|
|
|
|
# TEXT ENTRY
|
|
label $w.msglab -text "Body:"
|
|
entry $w.entry
|
|
balloon_add_help $w.entry "Enter the text of the reminder"
|
|
pack $w.msglab -side left -anchor w -in $w.msg
|
|
pack $w.entry -side left -anchor w -expand 1 -fill x -in $w.msg
|
|
|
|
# BUTTONS
|
|
set nbut 0
|
|
foreach but $args {
|
|
incr nbut
|
|
button $w.but$nbut -text $but -command "set ModifyDialogResult $nbut"
|
|
pack $w.but$nbut -side left -anchor w -in $w.buttons -expand 1 -fill x
|
|
}
|
|
|
|
bind $w <KeyPress-Escape> "$w.but1 flash; $w.but1 invoke"
|
|
if {$nbut >= 2} {
|
|
bind $w.entry <KeyPress-Return> "$w.but2 flash; $w.but2 invoke"
|
|
}
|
|
set ModifyDialogResult 0
|
|
|
|
# Center the window on the root
|
|
CenterWindow $w .
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: RemindDialogToOptions
|
|
# %ARGUMENTS:
|
|
# w -- dialog window
|
|
# %RETURNS:
|
|
# A list of flag/value pairs representing the current state of
|
|
# the "create reminder" dialog.
|
|
#***********************************************************************
|
|
proc RemindDialogToOptions { w } {
|
|
global OptionType SkipType repbut expbut advbut advcount
|
|
global timebut timeadvbut timerepbut durationbut
|
|
global dSaturday dSunday dMonday dTuesday dWednesday dThursday dFriday
|
|
set ans {}
|
|
lappend ans "-global-OptionType" $OptionType
|
|
lappend ans "-global-SkipType" $SkipType
|
|
foreach win [winfo children $w] {
|
|
set winstem [winfo name $win]
|
|
switch -exact -- [winfo class $win] {
|
|
"Menubutton" {
|
|
lappend ans "-text-$winstem" [$win cget -text]
|
|
}
|
|
"Checkbutton" {
|
|
lappend ans "-global-$winstem" [eval set $winstem]
|
|
}
|
|
"Entry" {
|
|
lappend ans "-entry-$winstem" [string map -nocase {"\n" " "} [$win get]]
|
|
}
|
|
}
|
|
}
|
|
return $ans
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: OptionsToRemindDialog
|
|
# %ARGUMENTS:
|
|
# w -- Remind dialog window
|
|
# opts -- option list set by RemindDialogToOptions
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Sets parameters in the dialog box according to saved options.
|
|
#***********************************************************************
|
|
proc OptionsToRemindDialog { w opts } {
|
|
global OptionType SkipType repbut expbut advbut advcount
|
|
global timebut timeadvbut timerepbut TwentyFourHourMode durationbut
|
|
global dSaturday dSunday dMonday dTuesday dWednesday dThursday dFriday
|
|
set hour ""
|
|
set ampm ""
|
|
foreach {flag value} $opts {
|
|
switch -glob -- $flag {
|
|
"-text-*" {
|
|
set win [string range $flag 6 end]
|
|
catch { $w.$win configure -text $value }
|
|
if {"$flag" == "-text-ampm"} {
|
|
set ampm $value
|
|
} elseif {"$flag" == "-text-timehour"} {
|
|
set hour $value
|
|
}
|
|
}
|
|
"-global-*" {
|
|
set win [string range $flag 8 end]
|
|
set $win $value
|
|
}
|
|
"-entry-*" {
|
|
set win [string range $flag 7 end]
|
|
$w.$win delete 0 end
|
|
$w.$win insert end $value
|
|
}
|
|
}
|
|
}
|
|
if {"$hour" != ""} {
|
|
if {$TwentyFourHourMode} {
|
|
if {"$ampm" != ""} {
|
|
if {"$ampm" == "PM" && $hour < 12} {
|
|
incr hour 12
|
|
$w.timehour configure -text $hour
|
|
}
|
|
}
|
|
} else {
|
|
if {$hour > 12} {
|
|
incr hour -12
|
|
$w.timehour configure -text $hour
|
|
$w.ampm configure -text "PM"
|
|
} else {
|
|
if {"$ampm" == ""} {
|
|
$w.ampm configure -text "AM"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateMonthMenu -- create a menu with all the months of the year
|
|
# Arguments:
|
|
# w -- menu button -- becomes parent of menu
|
|
# every -- if true, include an "every month" entry
|
|
#---------------------------------------------------------------------------
|
|
proc CreateMonthMenu {w {every 1}} {
|
|
global MonthNames
|
|
menu $w.menu -tearoff 0
|
|
|
|
if {$every} {
|
|
$w.menu add command -label "every month" -command "$w configure -text {every month}"
|
|
}
|
|
|
|
foreach month $MonthNames {
|
|
$w.menu add command -label $month -command "$w configure -text $month"
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateWeekdayMenu -- create a menu with all the weekdays
|
|
# Arguments:
|
|
# w -- menu button -- becomes parent of menu
|
|
#---------------------------------------------------------------------------
|
|
proc CreateWeekdayMenu {w} {
|
|
global EnglishDayNames
|
|
menu $w.menu -tearoff 0
|
|
|
|
foreach d $EnglishDayNames {
|
|
$w.menu add command -label $d -command "$w configure -text $d"
|
|
}
|
|
$w.menu add command -label "weekday" -command "$w configure -text weekday"
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateDayMenu -- create a menu with entries 1-31 and possibly "every day"
|
|
# Arguments:
|
|
# w -- menu button -- becomes parent of menu
|
|
# min -- minimum day to start from.
|
|
# max -- maximum day to go up to
|
|
# every -- if true, include an "every day" entry
|
|
#---------------------------------------------------------------------------
|
|
proc CreateDayMenu {w {min 1} {max 31} {every 1}} {
|
|
menu $w.menu -tearoff 0
|
|
if {$every} {
|
|
$w.menu add command -label "every day" -command "$w configure -text {every day}"
|
|
}
|
|
set d $min
|
|
while { $d <= $max } {
|
|
$w.menu add command -label $d -command "$w configure -text $d"
|
|
incr d
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateYearMenu -- create a menu with entries from this year to this year+10
|
|
# and possibly "every year"
|
|
# Arguments:
|
|
# w -- menu button -- becomes parent of menu
|
|
# every -- if true, include an "every year" entry
|
|
#---------------------------------------------------------------------------
|
|
proc CreateYearMenu {w {every 1}} {
|
|
menu $w.menu -tearoff 0
|
|
if {$every} {
|
|
$w.menu add command -label "every year" -command "$w configure -text {every year}"
|
|
}
|
|
global CurYear
|
|
set d $CurYear
|
|
while { $d < [expr $CurYear + 11] } {
|
|
$w.menu add command -label $d -command "$w configure -text $d"
|
|
incr d
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# ModifyDay -- bring up dialog for adding reminder.
|
|
# Arguments:
|
|
# d -- which day to modify
|
|
# firstDay -- first weekday in month (0-6)
|
|
#---------------------------------------------------------------------------
|
|
proc ModifyDay {d firstDay} {
|
|
global ModifyDialogResult AppendFile HighestTagSoFar ReminderTags
|
|
catch {destroy .mod}
|
|
toplevel .mod
|
|
CreateModifyDialog .mod $d $firstDay "Cancel" "Add to reminder file" "Preview reminder"
|
|
wm title .mod "TkRemind Add Reminder..."
|
|
wm iconname .mod "Add Reminder"
|
|
tkwait visibility .mod
|
|
set oldFocus [focus]
|
|
while {1} {
|
|
grab .mod
|
|
focus .mod.entry
|
|
set ModifyDialogResult -1
|
|
tkwait variable ModifyDialogResult
|
|
if {$ModifyDialogResult == 1} {
|
|
catch {focus $oldFocus}
|
|
destroy .mod
|
|
return 0
|
|
}
|
|
set problem [catch {set rem [CreateReminder .mod]} err]
|
|
if {$problem} {
|
|
tk_dialog .error Error "$err" error 0 Ok
|
|
} else {
|
|
if {$ModifyDialogResult == 3} {
|
|
set rem [EditReminder $rem Cancel "Add reminder"]
|
|
if {$ModifyDialogResult == 1} {
|
|
continue
|
|
}
|
|
}
|
|
set opts [RemindDialogToOptions .mod]
|
|
catch {focus $oldFocus}
|
|
destroy .mod
|
|
Status "Writing reminder..."
|
|
set f [open $AppendFile a]
|
|
incr HighestTagSoFar
|
|
set ReminderTags($HighestTagSoFar) 1
|
|
|
|
WriteReminder $f TKTAG$HighestTagSoFar $rem $opts
|
|
close $f
|
|
|
|
FillCalWindow
|
|
RestartBackgroundRemindDaemon
|
|
return 0
|
|
}
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CenterWindow -- center a window on the screen or over a parent.
|
|
# Stolen from tk_dialog code
|
|
# Arguments:
|
|
# w -- window to center
|
|
# parent -- window over which to center. Defaults to screen if not supplied.
|
|
#---------------------------------------------------------------------------
|
|
proc CenterWindow {w {parent {}}} {
|
|
wm withdraw $w
|
|
update idletasks
|
|
if {"$parent" == ""} {
|
|
set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
|
|
- [winfo vrootx [winfo parent $w]]]
|
|
set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
|
|
- [winfo vrooty [winfo parent $w]]]
|
|
} else {
|
|
set x [expr [winfo rootx $parent] + [winfo width $parent]/2 - [winfo reqwidth $w]/2]
|
|
set y [expr [winfo rooty $parent] + [winfo height $parent]/2 - [winfo reqheight $w]/2]
|
|
}
|
|
wm geom $w +$x+$y
|
|
wm deiconify $w
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateReminder -- create the reminder
|
|
# Arguments:
|
|
# w -- the window containing the add reminder dialog box.
|
|
# Returns:
|
|
# The reminder as a string.
|
|
#---------------------------------------------------------------------------
|
|
proc CreateReminder {w} {
|
|
global DidOmit TwentyFourHourMode
|
|
|
|
set body [string trim [$w.entry get]]
|
|
|
|
if {"$body" == ""} {
|
|
error "Blank body in reminder"
|
|
}
|
|
|
|
set DidOmit 0
|
|
set needOmit 0
|
|
# Delegate the first part to CreateReminder1, CreateReminder2, or
|
|
# CreateReminder3
|
|
global OptionType SkipType repbut expbut advbut advcount
|
|
global timebut timeadvbut timerepbut durationbut
|
|
|
|
set rem [CreateReminder$OptionType $w]
|
|
|
|
# Do the "until" part
|
|
if {$expbut} {
|
|
append rem " UNTIL "
|
|
append rem [consolidate [$w.expyear cget -text] [$w.expmon cget -text] [$w.expday cget -text]]
|
|
}
|
|
|
|
# Advance warning
|
|
if {$advbut} {
|
|
append rem " +"
|
|
if {!$advcount} {
|
|
append rem "+"
|
|
} else {
|
|
set needOmit 1
|
|
}
|
|
append rem [$w.advdays cget -text]
|
|
}
|
|
|
|
# Timed reminder
|
|
if {$timebut} {
|
|
set hour [$w.timehour cget -text]
|
|
set min [$w.timemin cget -text]
|
|
if {!$TwentyFourHourMode} {
|
|
if {[$w.ampm cget -text] == "PM"} {
|
|
if {$hour < 12} {
|
|
incr hour 12
|
|
}
|
|
} else {
|
|
if {$hour == 12} {
|
|
set hour 0
|
|
}
|
|
}
|
|
}
|
|
append rem " AT $hour:$min"
|
|
if {$timeadvbut} {
|
|
append rem " +[$w.timeadv cget -text]"
|
|
}
|
|
if {$timerepbut} {
|
|
append rem " *[$w.timerep cget -text]"
|
|
}
|
|
if {$durationbut} {
|
|
append rem " DURATION [$w.durationh cget -text]:[$w.durationm cget -text]"
|
|
}
|
|
}
|
|
|
|
global SkipType
|
|
if {$SkipType == 2} {
|
|
append rem " SKIP"
|
|
set needOmit 1
|
|
} elseif {$SkipType == 3} {
|
|
append rem " BEFORE"
|
|
set needOmit 1
|
|
} elseif {$SkipType == 4} {
|
|
append rem " AFTER"
|
|
set needOmit 1
|
|
}
|
|
|
|
if {$needOmit && !$DidOmit} {
|
|
append rem " OMIT [GetWeekend $w 1]"
|
|
}
|
|
|
|
|
|
# Check it out!
|
|
global Remind
|
|
set f [open "|$Remind -arq -e -" r+]
|
|
puts $f "BANNER %"
|
|
puts $f "$rem MSG %"
|
|
puts $f "MSG %_%_%_%_"
|
|
puts $f "FLUSH"
|
|
flush $f
|
|
set err {}
|
|
catch {set err [gets $f]}
|
|
catch {close $f}
|
|
if {"$err" != ""} {
|
|
# Clean up the message a bit
|
|
regsub -- {^-stdin-\([0-9]*\): } $err {} err
|
|
error "Error from Remind: $err"
|
|
}
|
|
append rem " MSG " [string map -nocase {"\n" " "} $body]
|
|
return $rem
|
|
}
|
|
|
|
proc consolidate {y m d} {
|
|
global MonthNames
|
|
if {![regexp {^[0-9]+$} $m]} {
|
|
set m [lsearch -exact $MonthNames $m]
|
|
incr m
|
|
}
|
|
return [format "%04d-%02d-%02d" $y $m $d]
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateReminder1 -- Create the first part of a type-1 reminder
|
|
# Arguments:
|
|
# w -- add reminder dialog window
|
|
# Returns: first part of reminder
|
|
#---------------------------------------------------------------------------
|
|
proc CreateReminder1 {w} {
|
|
|
|
global repbut
|
|
|
|
set rem "REM"
|
|
set gotDay 0
|
|
set gotMon 0
|
|
set gotYear 0
|
|
set d [$w.day1 cget -text]
|
|
set m [$w.mon1 cget -text]
|
|
set y [$w.year1 cget -text]
|
|
if {"$d" != "every day" && "$m" != "every month" && $y != "every year"} {
|
|
set gotDay 1
|
|
set gotMon 1
|
|
set gotYear 1
|
|
append rem " "
|
|
append rem [consolidate $y $m $d]
|
|
} else {
|
|
if {"$d" != "every day"} {
|
|
append rem " $d"
|
|
set gotDay 1
|
|
}
|
|
if {"$m" != "every month"} {
|
|
append rem " $m"
|
|
set gotMon 1
|
|
}
|
|
if {"$y" != "every year"} {
|
|
append rem " $y"
|
|
set gotYear 1
|
|
}
|
|
}
|
|
|
|
# Check for repetition
|
|
if {$repbut} {
|
|
if {!$gotDay || !$gotMon || !$gotYear} {
|
|
error "All components of a date must be specified if you wish to use the repeat feature."
|
|
}
|
|
append rem " *[$w.repdays cget -text]"
|
|
}
|
|
|
|
return $rem
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateReminder2 -- Create the first part of a type-2 reminder
|
|
# Arguments:
|
|
# w -- add reminder dialog window
|
|
# Returns: first part of reminder
|
|
#---------------------------------------------------------------------------
|
|
proc CreateReminder2 {w} {
|
|
set wkday [$w.wkday2 cget -text]
|
|
if {"$wkday" == "weekday"} {
|
|
set wkday [GetWeekend $w 0]
|
|
}
|
|
set day [$w.day2 cget -text]
|
|
set mon [$w.mon2 cget -text]
|
|
set year [$w.year2 cget -text]
|
|
if {$mon != "every month" && $year != "every year"} {
|
|
set rem "REM $wkday "
|
|
append rem [consolidate $year $mon $day]
|
|
} else {
|
|
set rem "REM $wkday $day"
|
|
if {$mon != "every month"} {
|
|
append rem " $mon"
|
|
}
|
|
if {$year != "every year"} {
|
|
append rem " $year"
|
|
}
|
|
}
|
|
return $rem
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# CreateReminder3 -- Create the first part of a type-3 reminder
|
|
# Arguments:
|
|
# w -- add reminder dialog window
|
|
# Returns: first part of reminder
|
|
#---------------------------------------------------------------------------
|
|
proc CreateReminder3 {w} {
|
|
global MonthNames DidOmit
|
|
set which [$w.ordinal cget -text]
|
|
set day [$w.wkday3 cget -text]
|
|
set mon [$w.mon3 cget -text]
|
|
set year [$w.year3 cget -text]
|
|
set rem "REM"
|
|
if {$which != "Last"} {
|
|
if {$which == "First"} {
|
|
append rem " 1"
|
|
} elseif {$which == "Second"} {
|
|
append rem " 8"
|
|
} elseif {$which == "Third"} {
|
|
append rem " 15"
|
|
} elseif {$which == "Fourth"} {
|
|
append rem " 22"
|
|
}
|
|
if {$day != "weekday"} {
|
|
append rem " $day"
|
|
} else {
|
|
append rem " [GetWeekend $w 0]"
|
|
}
|
|
if {$mon != "every month"} {
|
|
append rem " $mon"
|
|
}
|
|
if {$year != "every year"} {
|
|
append rem " $year"
|
|
}
|
|
} else {
|
|
if {$day != "weekday"} {
|
|
append rem " $day 1 --7"
|
|
} else {
|
|
append rem " 1 -1 OMIT [GetWeekend $w 1]"
|
|
set DidOmit 1
|
|
}
|
|
if {$mon != "every month"} {
|
|
set i [lsearch -exact $MonthNames $mon]
|
|
if {$i == 11} {
|
|
set i 0
|
|
} else {
|
|
incr i
|
|
}
|
|
append rem " [lindex $MonthNames $i]"
|
|
}
|
|
if {$year != "every year"} {
|
|
if {$mon == "December"} {
|
|
incr year
|
|
}
|
|
append rem " $year"
|
|
}
|
|
}
|
|
return $rem
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# GetWeekend -- returns a list of weekdays or weekend days
|
|
# Arguments:
|
|
# w -- add reminder dialog window
|
|
# wkend -- if 1, we want weekend. If 0, we want weekdays.
|
|
# Returns:
|
|
# list of weekdays or weekend-days
|
|
#---------------------------------------------------------------------------
|
|
proc GetWeekend {w wkend} {
|
|
global dSaturday dSunday dMonday dTuesday dWednesday dThursday dFriday
|
|
global EnglishDayNames
|
|
set ret {}
|
|
foreach d $EnglishDayNames {
|
|
set v [set d$d]
|
|
if {$v == $wkend} {
|
|
lappend ret $d
|
|
}
|
|
}
|
|
return $ret
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# EditReminder -- allow user to edit what gets put in reminder file
|
|
# Arguments:
|
|
# rem -- current reminder
|
|
# args -- buttons to add to bottom
|
|
# Returns:
|
|
# edited version of rem
|
|
#---------------------------------------------------------------------------
|
|
proc EditReminder {rem args} {
|
|
catch {destroy .edit}
|
|
global ModifyDialogResult
|
|
toplevel .edit
|
|
wm title .edit "TkRemind Preview reminder"
|
|
wm iconname .edit "Preview reminder"
|
|
text .edit.t -width 80 -height 5 -relief sunken
|
|
.edit.t insert end $rem
|
|
frame .edit.f
|
|
set n 0
|
|
foreach but $args {
|
|
incr n
|
|
button .edit.but$n -text $but -command "set ModifyDialogResult $n"
|
|
pack .edit.but$n -in .edit.f -side left -fill x -expand 1
|
|
}
|
|
pack .edit.t -side top -fill both -expand 1
|
|
pack .edit.f -side top -fill x -expand 1
|
|
bind .edit <KeyPress-Escape> ".edit.but1 flash; .edit.but1 invoke"
|
|
set ModifyDialogResult 0
|
|
CenterWindow .edit .
|
|
tkwait visibility .edit
|
|
set oldFocus [focus]
|
|
focus .edit.t
|
|
grab .edit
|
|
tkwait variable ModifyDialogResult
|
|
catch {focus $oldFocus}
|
|
set rem [.edit.t get 1.0 end]
|
|
catch {destroy .edit}
|
|
return $rem
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# SetWinAttr -- sets an attribute for a window
|
|
# Arguments:
|
|
# w -- window name
|
|
# attr -- attribute name
|
|
# val -- value to set it to
|
|
# Returns:
|
|
# $val
|
|
#---------------------------------------------------------------------------
|
|
proc SetWinAttr {w attr val} {
|
|
global attrPriv
|
|
set attrPriv($w-$attr) $val
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# GetWinAttr -- gets an attribute for a window
|
|
# Arguments:
|
|
# w -- window name
|
|
# attr -- attribute name
|
|
# Returns:
|
|
# Value of attribute
|
|
#---------------------------------------------------------------------------
|
|
proc GetWinAttr {w attr} {
|
|
global attrPriv
|
|
return $attrPriv($w-$attr)
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# WaitWinAttr -- wait for a window attribute to change
|
|
# Arguments:
|
|
# w -- window name
|
|
# attr -- attribute name
|
|
# Returns:
|
|
# Value of attribute
|
|
#---------------------------------------------------------------------------
|
|
proc WaitWinAttr {w attr} {
|
|
global attrPriv
|
|
tkwait variable attrPriv($w-$attr)
|
|
return $attrPriv($w-$attr)
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# BrowseForFile -- creates and operates a file browser dialog.
|
|
# Arguments:
|
|
# w -- dialog window.
|
|
# title -- dialog title
|
|
# oktext -- text for "OK" button
|
|
# showdots -- if non-zero, shows "dot" files as well.
|
|
# Returns:
|
|
# complete path of filename chosen, or "" if Cancel pressed.
|
|
#---------------------------------------------------------------------------
|
|
proc BrowseForFile {w title {oktext "OK"} {showdots 0} {filter "*"}} {
|
|
catch {destroy $w}
|
|
toplevel $w
|
|
wm title $w $title
|
|
|
|
# Global array to hold window attributes
|
|
global a${w}
|
|
|
|
SetWinAttr $w status busy
|
|
SetWinAttr $w showdots $showdots
|
|
|
|
frame $w.fileframe
|
|
frame $w.butframe
|
|
label $w.cwd -text [pwd]
|
|
entry $w.entry
|
|
label $w.masklab -text "Match: "
|
|
listbox $w.list -yscrollcommand "$w.scroll set"
|
|
scrollbar $w.scroll -command "$w.list yview"
|
|
button $w.ok -text $oktext -command "BrowseForFileOK $w"
|
|
button $w.cancel -text "Cancel" -command "BrowseForFileCancel $w"
|
|
entry $w.filter -width 7
|
|
$w.filter insert end $filter
|
|
|
|
pack $w.cwd $w.entry -side top -expand 0 -fill x
|
|
pack $w.fileframe -side top -expand 1 -fill both
|
|
pack $w.butframe -side top -expand 0 -fill x
|
|
pack $w.list -in $w.fileframe -side left -expand 1 -fill both
|
|
pack $w.scroll -in $w.fileframe -side left -expand 0 -fill y
|
|
pack $w.ok -in $w.butframe -side left -expand 1 -fill x
|
|
pack $w.cancel -in $w.butframe -side left -expand 1 -fill x
|
|
pack $w.masklab -in $w.butframe -side left -expand 0
|
|
pack $w.filter -in $w.butframe -side left -expand 1 -fill x
|
|
|
|
# Fill in the box and wait for status to change
|
|
BrowseForFileRead $w [pwd]
|
|
|
|
bind $w <KeyPress-Escape> "$w.cancel flash; $w.cancel invoke"
|
|
bind $w.list <Button-1> "$w.entry delete 0 end; $w.entry insert 0 \[selection get\]"
|
|
bind $w.list <Double-Button-1> "$w.ok flash; $w.ok invoke"
|
|
bind $w.list <Return> "$w.entry delete 0 end; $w.entry insert 0 \[selection get\]; $w.ok flash; $w.ok invoke"
|
|
bind $w.entry <Return> "$w.ok flash; $w.ok invoke"
|
|
bind $w.filter <Return> "BrowseForFileRead $w"
|
|
bind $w.entry <KeyPress> "CompleteFile $w"
|
|
bind $w.entry <KeyPress-space> "ExpandFile $w"
|
|
bindtags $w.entry "Entry $w.entry $w all"
|
|
|
|
bindtags $w.list "Listbox $w.list $w all"
|
|
CenterWindow $w .
|
|
set oldFocus [focus]
|
|
tkwait visibility $w
|
|
focus $w.entry
|
|
set oldGrab [grab current $w]
|
|
grab set $w
|
|
WaitWinAttr $w status
|
|
catch {focus $oldFocus}
|
|
catch {grab set $oldGrab}
|
|
set ans [GetWinAttr $w status]
|
|
destroy $w
|
|
return $ans
|
|
}
|
|
|
|
proc CompleteFile {w} {
|
|
set index [lsearch [$w.list get 0 end] [$w.entry get]* ]
|
|
if {$index > -1} {
|
|
$w.list see $index
|
|
$w.list selection clear 0 end
|
|
$w.list selection set $index
|
|
}
|
|
}
|
|
|
|
proc ExpandFile {w} {
|
|
set stuff [$w.list curselection]
|
|
if {[string compare $stuff ""]} {
|
|
$w.entry delete 0 end
|
|
$w.entry insert end [$w.list get $stuff]
|
|
}
|
|
}
|
|
|
|
proc BrowseForFileCancel {w} {
|
|
SetWinAttr $w status {}
|
|
}
|
|
|
|
proc BrowseForFileOK {w} {
|
|
set fname [$w.entry get]
|
|
if {[string compare $fname ""]} {
|
|
# If it starts with a slash, handle it specially.
|
|
if {[string match "/*" $fname]} {
|
|
if {[file isdirectory $fname]} {
|
|
BrowseForFileRead $w $fname
|
|
return
|
|
} else {
|
|
SetWinAttr $w status $fname
|
|
return
|
|
}
|
|
}
|
|
if {[string match */ $fname]} {
|
|
set fname [string trimright $fname /]
|
|
}
|
|
if {[$w.cwd cget -text] == "/"} {
|
|
set fname "/$fname"
|
|
} else {
|
|
set fname "[$w.cwd cget -text]/$fname"
|
|
}
|
|
# If it's a directory, change directories
|
|
if {[file isdirectory $fname]} {
|
|
BrowseForFileRead $w $fname
|
|
} else {
|
|
SetWinAttr $w status $fname
|
|
}
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# BrowseForFileRead -- read the current directory into the file browser
|
|
# Arguments:
|
|
# w -- window name
|
|
# dir -- directory
|
|
# Returns:
|
|
# nothing
|
|
#---------------------------------------------------------------------------
|
|
proc BrowseForFileRead {w {dir ""}} {
|
|
# Save working dir
|
|
set cwd [pwd]
|
|
if {$dir == ""} {
|
|
set dir [$w.cwd cget -text]
|
|
}
|
|
if {[catch "cd $dir" err]} {
|
|
tk_dialog .error Error "$err" error 0 Ok
|
|
return
|
|
}
|
|
$w.cwd configure -text [pwd]
|
|
if {[GetWinAttr $w showdots]} {
|
|
set flist [glob -nocomplain .* *]
|
|
} else {
|
|
set flist [glob -nocomplain *]
|
|
}
|
|
set flist [lsort $flist]
|
|
set filter [$w.filter get]
|
|
if {$filter == ""} {
|
|
set filter "*"
|
|
}
|
|
$w.list delete 0 end
|
|
foreach item $flist {
|
|
if {$item != "." && $item != ".."} {
|
|
if {[file isdirectory $item]} {
|
|
$w.list insert end "$item/"
|
|
} else {
|
|
if {[string match $filter $item]} {
|
|
$w.list insert end $item
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if {[pwd] != "/"} {
|
|
$w.list insert 0 "../"
|
|
}
|
|
cd $cwd
|
|
$w.entry delete 0 end
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# StartBackgroundRemindDaemon
|
|
# Arguments:
|
|
# none
|
|
# Returns:
|
|
# nothing
|
|
# Description:
|
|
# Starts a background Remind daemon to handle timed reminders
|
|
#---------------------------------------------------------------------------
|
|
proc StartBackgroundRemindDaemon {} {
|
|
global Remind DaemonFile ReminderFile Option
|
|
set problem [catch { set DaemonFile [open "|$Remind -z0 $Option(ExtraRemindArgs) $ReminderFile" "r+"] } err]
|
|
if {$problem} {
|
|
tk_dialog .error Error "Can't start Remind daemon in background: $err" error 0 OK
|
|
} else {
|
|
fileevent $DaemonFile readable "DaemonReadable $DaemonFile"
|
|
puts $DaemonFile "STATUS"
|
|
flush $DaemonFile
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# StopBackgroundRemindDaemon
|
|
# Arguments:
|
|
# none
|
|
# Returns:
|
|
# nothing
|
|
# Description:
|
|
# Stops the background Remind daemon
|
|
#---------------------------------------------------------------------------
|
|
proc StopBackgroundRemindDaemon {} {
|
|
global DaemonFile
|
|
catch {
|
|
puts $DaemonFile "EXIT"
|
|
flush $DaemonFile
|
|
close $DaemonFile
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# RestartBackgroundRemindDaemon
|
|
# Arguments:
|
|
# none
|
|
# Returns:
|
|
# nothing
|
|
# Description:
|
|
# Restarts the background Remind daemon
|
|
#---------------------------------------------------------------------------
|
|
proc RestartBackgroundRemindDaemon {} {
|
|
global DaemonFile ReminderFile ReminderFileModTime
|
|
|
|
# Don't let the background handler trigger another reread
|
|
catch {
|
|
set mtime [file mtime $ReminderFile]
|
|
set ReminderFileModTime $mtime
|
|
}
|
|
|
|
catch {
|
|
puts $DaemonFile "REREAD"
|
|
flush $DaemonFile
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# ShowQueue
|
|
# Arguments:
|
|
# file -- file channel that is readable
|
|
# Returns:
|
|
# nothing
|
|
# Description:
|
|
# Dumps the debugging queue listing
|
|
#---------------------------------------------------------------------------
|
|
proc ShowQueue { file } {
|
|
set w .queuedbg
|
|
catch { destroy $w }
|
|
toplevel $w
|
|
wm title $w "Queue (Debugging Output)"
|
|
wm iconname $w "Queue Dbg"
|
|
text $w.t -width 80 -height 30 -wrap word -yscrollcommand "$w.sb set"
|
|
scrollbar $w.sb -orient vertical -command "$w.text yview"
|
|
button $w.ok -text "OK" -command "destroy $w"
|
|
grid $w.t -row 0 -column 0 -sticky nsew
|
|
grid $w.sb -row 0 -column 1 -sticky ns
|
|
grid $w.ok -row 1 -column 0 -sticky w
|
|
grid columnconfigure $w 0 -weight 1
|
|
grid columnconfigure $w 1 -weight 0
|
|
grid rowconfigure $w 0 -weight 1
|
|
grid rowconfigure $w 1 -weight 0
|
|
CenterWindow $w .
|
|
while (1) {
|
|
# We should only get one line
|
|
gets $file line
|
|
if {$line == "NOTE ENDJSONQUEUE"} {
|
|
break
|
|
}
|
|
if {[catch {set obj [::json::json2dict $line]}]} {
|
|
continue;
|
|
}
|
|
foreach q $obj {
|
|
$w.t insert end "$q\n"
|
|
}
|
|
}
|
|
$w.t configure -state disabled
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# DaemonReadable
|
|
# Arguments:
|
|
# file -- file channel that is readable
|
|
# Returns:
|
|
# nothing
|
|
# Description:
|
|
# Reads data from the Remind daemon and handles it appropriately
|
|
#---------------------------------------------------------------------------
|
|
proc DaemonReadable { file } {
|
|
global Ignore
|
|
set line ""
|
|
catch { set num [gets $file line] }
|
|
if {$num < 0} {
|
|
catch { close $file }
|
|
return
|
|
}
|
|
switch -glob -- $line {
|
|
"NOTE reminder*" {
|
|
scan $line "NOTE reminder %s %s %s" time now tag
|
|
IssueBackgroundReminder $file $time $now $tag
|
|
}
|
|
"NOTE JSONQUEUE" {
|
|
ShowQueue $file
|
|
}
|
|
"NOTE newdate" {
|
|
# Date has rolled over -- clear "ignore" list
|
|
catch { unset Ignore}
|
|
Initialize
|
|
FillCalWindow
|
|
ShowTodaysReminders
|
|
}
|
|
"NOTE reread" {
|
|
puts $file "STATUS"
|
|
flush $file
|
|
}
|
|
"NOTE queued*" {
|
|
scan $line "NOTE queued %d" n
|
|
if {$n == 1} {
|
|
.b.nqueued configure -text "1 reminder queued"
|
|
} else {
|
|
.b.nqueued configure -text "$n reminders queued"
|
|
}
|
|
}
|
|
default {
|
|
puts "Unknown message from daemon: $line\n"
|
|
}
|
|
}
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
# IssueBackgroundReminder
|
|
# Arguments:
|
|
# file -- file channel that is readable
|
|
# time -- time of reminder
|
|
# now -- current time according to Remind daemon
|
|
# tag -- tag for reminder, or "*" if no tag
|
|
# Returns:
|
|
# nothing
|
|
# Description:
|
|
# Reads a background reminder from daemon and pops up window.
|
|
#---------------------------------------------------------------------------
|
|
proc IssueBackgroundReminder { file time now tag } {
|
|
global BgCounter Option Ignore
|
|
if {$Option(Deiconify)} {
|
|
wm deiconify .
|
|
}
|
|
|
|
set msg ""
|
|
set line ""
|
|
while (1) {
|
|
gets $file line
|
|
if {$line == "NOTE endreminder"} {
|
|
break
|
|
}
|
|
if {$msg != ""} {
|
|
append msg "\n";
|
|
}
|
|
append msg $line
|
|
}
|
|
# Do nothing if it's blank -- was probably a RUN-type reminder.
|
|
if {$msg == ""} {
|
|
return
|
|
}
|
|
|
|
# Do nothing if user told us to ignore this reminder
|
|
if {[info exists Ignore($tag)]} {
|
|
return
|
|
}
|
|
|
|
incr BgCounter
|
|
set w .bg$BgCounter
|
|
toplevel $w
|
|
wm iconname $w "Reminder"
|
|
wm title $w "Timed reminder ($time)"
|
|
label $w.l -text "Reminder for $time issued at $now"
|
|
message $w.msg -width 6i -text $msg
|
|
frame $w.b
|
|
|
|
# Automatically shut down window after a minute if option says so
|
|
set after_token [after 60000 [list ClosePopup $w "" $Option(MailAddr) $Option(AutoClose) "" $tag $msg $time]]
|
|
|
|
wm protocol $w WM_DELETE_WINDOW [list ClosePopup $w $after_token "" 1 "" $tag $msg $time]
|
|
button $w.ok -text "OK" -command [list ClosePopup $w $after_token "" 1 "" $tag $msg $time]
|
|
if {$tag != "*"} {
|
|
button $w.nomore -text "Don't remind me again today" -command [list ClosePopup $w $after_token "" 1 "ignore" $tag $msg $time]
|
|
button $w.kill -text "Delete this reminder completely" -command [list ClosePopup $w $after_token "" 1 "kill" $tag $msg $time]
|
|
}
|
|
pack $w.l -side top
|
|
pack $w.msg -side top -expand 1 -fill both
|
|
pack $w.b -side top
|
|
pack $w.ok -in $w.b -side left
|
|
if {$tag != "*"} {
|
|
pack $w.nomore $w.kill -in $w.b -side left
|
|
}
|
|
|
|
CenterWindow $w .
|
|
|
|
update
|
|
if {$Option(RingBell)} {
|
|
bell
|
|
}
|
|
if {$Option(RunCmd) != ""} {
|
|
if {$Option(FeedReminder)} {
|
|
FeedReminderToCommand $Option(RunCmd) $msg
|
|
} else {
|
|
exec "/bin/sh" "-c" $Option(RunCmd) "&"
|
|
}
|
|
}
|
|
|
|
# reread status
|
|
if {$file != "stdin"} {
|
|
puts $file "STATUS"
|
|
flush $file
|
|
}
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: FeedReminderToCommand
|
|
# %ARGUMENTS:
|
|
# cmd -- command to execute
|
|
# msg -- what to feed it
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Feeds "$msg" to a command.
|
|
#***********************************************************************
|
|
proc FeedReminderToCommand { cmd msg } {
|
|
catch {
|
|
set f [open "|$cmd" "w"]
|
|
fconfigure $f -blocking 0
|
|
fileevent $f writable [list CommandWritable $f $msg]
|
|
}
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: CommandWritable
|
|
# %ARGUMENTS:
|
|
# f -- file which is writable
|
|
# msg -- message to write
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Writes $msg to $f; closes $f.
|
|
#***********************************************************************
|
|
proc CommandWritable { f msg } {
|
|
puts $f $msg
|
|
flush $f
|
|
close $f
|
|
}
|
|
|
|
|
|
proc main {} {
|
|
# If no ~/.tkremindrc file, create an empty one
|
|
if {![file exists ~/.tkremindrc]} {
|
|
catch {
|
|
set f [open ~/.tkremindrc "w"]
|
|
close $f
|
|
}
|
|
}
|
|
|
|
global AppendFile HighestTagSoFar DayNames
|
|
catch {
|
|
puts "\nTkRemind Copyright (C) 1996-2020 Dianne Skoll"
|
|
}
|
|
catch { SetFonts }
|
|
LoadOptions
|
|
CreateMoonImages
|
|
Initialize
|
|
ShowTodaysReminders
|
|
ScanForTags $AppendFile
|
|
CreateCalWindow $DayNames
|
|
FillCalWindow
|
|
StartBackgroundRemindDaemon
|
|
DisplayTimeContinuously
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: ScanForTags
|
|
# %ARGUMENTS:
|
|
# fname -- name of file to scan
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Scans the file for all tags of the form "TKTAGnnnn" and builds
|
|
# the tag array. Also adjusts HighestTagSoFar
|
|
#***********************************************************************
|
|
proc ScanForTags { fname } {
|
|
global HighestTagSoFar ReminderTags
|
|
if {[catch { set f [open $fname "r"]}]} {
|
|
return
|
|
}
|
|
while {[gets $f line] >= 0} {
|
|
switch -regexp -- $line {
|
|
{^REM TAG TKTAG[0-9]+} {
|
|
regexp {^REM TAG TKTAG([0-9]+)} $line dummy tagno
|
|
if {$tagno > $HighestTagSoFar} {
|
|
set HighestTagSoFar $tagno
|
|
}
|
|
set ReminderTags($tagno) 1
|
|
}
|
|
}
|
|
}
|
|
close $f
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: ReadTaggedOptions
|
|
# %ARGUMENTS:
|
|
# tag -- tag to match
|
|
# date -- today's date
|
|
# %RETURNS:
|
|
# A list of options for the dialog box for the tagged reminder
|
|
# %DESCRIPTION:
|
|
# Converts the JSON dictionary to a list of options for dialog box
|
|
#***********************************************************************
|
|
proc ReadTaggedOptions { tag date } {
|
|
global TagToObj MonthNames EnglishDayNames TwentyFourHourMode
|
|
if {![info exists TagToObj($tag)]} {
|
|
return ""
|
|
}
|
|
set obj $TagToObj($tag)
|
|
set ans ""
|
|
regexp {^([0-9][0-9][0-9][0-9]).([0-9][0-9]).([0-9][0-9])} $date all y m d
|
|
set m [string trimleft $m 0]
|
|
set d [string trimleft $d 0]
|
|
set y [string trimleft $y 0]
|
|
if {![dict exists $obj skip]} {
|
|
lappend ans -global-SkipType 1
|
|
} else {
|
|
set s [dict get $obj skip]
|
|
if {"$s" == "SKIP"} {
|
|
lappend ans -global-SkipType 2
|
|
} elseif {"$s" == "BEFORE"} {
|
|
lappend ans -global-SkipType 3
|
|
} elseif {"$s" == "AFTER"} {
|
|
lappend ans -global-SkipType 4
|
|
} else {
|
|
lappend ans -global-SkipType 1
|
|
}
|
|
}
|
|
|
|
if {[dict exists $obj d]} {
|
|
lappend ans -text-day1 [dict get $obj d]
|
|
lappend ans -text-day2 [dict get $obj d]
|
|
} else {
|
|
lappend ans -text-day1 {every day}
|
|
lappend ans -text-day2 $d
|
|
}
|
|
if {[dict exists $obj m]} {
|
|
lappend ans -text-mon1 [lindex $MonthNames [expr [dict get $obj m] -1]]
|
|
lappend ans -text-mon2 [lindex $MonthNames [expr [dict get $obj m] -1]]
|
|
lappend ans -text-mon3 [lindex $MonthNames [expr [dict get $obj m] -1]]
|
|
} else {
|
|
lappend ans -text-mon1 {every month}
|
|
lappend ans -text-mon2 {every month}
|
|
lappend ans -text-mon3 {every month}
|
|
}
|
|
if {[dict exists $obj y]} {
|
|
lappend ans -text-year1 [dict get $obj y]
|
|
lappend ans -text-year2 [dict get $obj y]
|
|
lappend ans -text-year3 [dict get $obj y]
|
|
} else {
|
|
lappend ans -text-year1 {every year}
|
|
lappend ans -text-year2 {every year}
|
|
lappend ans -text-year3 {every year}
|
|
}
|
|
|
|
set wd {}
|
|
if {[dict exists $obj wd]} {
|
|
set wd [dict get $obj wd]
|
|
if {[llength $wd] == 1} {
|
|
lappend ans -text-wkday2 [lindex $wd 0]
|
|
lappend ans -text-wkday3 [lindex $wd 0]
|
|
} elseif {"$wd" == "Monday Tuesday Wednesday Thursday Friday"} {
|
|
lappend ans -text-wkday2 weekday
|
|
lappend ans -text-wkday3 weekday
|
|
}
|
|
} else {
|
|
lappend ans -text-wkday2 [get_weekday $date]
|
|
lappend ans -text-wkday3 [get_weekday $date]
|
|
}
|
|
|
|
if {[llength $wd] > 0} {
|
|
if {[dict exists $obj d]} {
|
|
set day [dict get $obj d]
|
|
if {$day < 8} {
|
|
if {[dict exists $obj back]} {
|
|
lappend ans -text-ordinal Last
|
|
# Adjust month down and possibly year?
|
|
if {[dict exists $obj m]} {
|
|
set idx [expr [dict get $obj m] -1]
|
|
if {$idx <= 0} {
|
|
set idx 12
|
|
}
|
|
lappend ans -text-mon1 [lindex $MonthNames [expr $idx -1]]
|
|
lappend ans -text-mon2 [lindex $MonthNames [expr $idx -1]]
|
|
lappend ans -text-mon3 [lindex $MonthNames [expr $idx -1]]
|
|
if {[dict exists $obj y]} {
|
|
set year [dict get $obj y]
|
|
if {$idx == 12} {
|
|
lappend ans -text-year1 [expr $year - 1]
|
|
lappend ans -text-year2 [expr $year - 1]
|
|
lappend ans -text-year3 [expr $year - 1]
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
lappend ans -text-ordinal First
|
|
}
|
|
} elseif {$day < 15} {
|
|
lappend ans -text-ordinal Second
|
|
} elseif {$day < 22} {
|
|
lappend ans -text-ordinal Third
|
|
} else {
|
|
lappend ans -text-ordinal Fourth
|
|
}
|
|
} else {
|
|
lappend ans -text-ordinal Every
|
|
}
|
|
} else {
|
|
if {$d < 8} {
|
|
lappend ans -text-ordinal First
|
|
} elseif {$d < 15} {
|
|
lappend ans -text-ordinal Second
|
|
} elseif {$d < 22} {
|
|
lappend ans -text-ordinal Third
|
|
} elseif {$d < 29} {
|
|
lappend ans -text-ordinal Fourth
|
|
} else {
|
|
lappend ans -text-ordinal Last
|
|
}
|
|
}
|
|
|
|
if {[dict exists $obj until]} {
|
|
set u [dict get $obj until]
|
|
regexp {^([0-9][0-9][0-9][0-9]).([0-9][0-9]).([0-9][0-9])} $u all yu mu du
|
|
lappend ans -global-expbut 1
|
|
lappend ans -text-expday $du
|
|
lappend ans -text-expmon [lindex $MonthNames [expr $mu-1]]
|
|
lappend ans -text-expyear $yu
|
|
|
|
} else {
|
|
lappend ans -global-expbut 0
|
|
lappend ans -text-expday $d
|
|
lappend ans -text-expmon [lindex $MonthNames [expr $m-1]]
|
|
lappend ans -text-expyear $y
|
|
}
|
|
|
|
if {[dict exists $obj delta]} {
|
|
set delta [dict get $obj delta]
|
|
if {$delta == 0} {
|
|
lappend ans -global-advbut 0
|
|
lappend ans -text-advdays 3
|
|
lappend ans -global-advcount 1
|
|
} elseif {$delta < 0} {
|
|
set delta [expr abs($delta)]
|
|
lappend ans -global-advbut 1
|
|
lappend ans -text-advdays $delta
|
|
lappend ans -global-advcount 0
|
|
} else {
|
|
lappend ans -global-advbut 1
|
|
lappend ans -text-advdays $delta
|
|
lappend ans -global-advcount 1
|
|
}
|
|
} else {
|
|
lappend ans -global-advbut 0
|
|
lappend ans -text-advdays 3
|
|
lappend ans -global-advcount 1
|
|
}
|
|
|
|
if {[dict exists $obj localomit]} {
|
|
set lo [dict get $obj localomit]
|
|
foreach w $EnglishDayNames {
|
|
if {[lsearch -exact $lo $w] >= 0} {
|
|
lappend ans "-global-d$w" 1
|
|
} else {
|
|
lappend ans "-global-d$w" 0
|
|
}
|
|
}
|
|
} else {
|
|
lappend ans -global-dSunday 1
|
|
lappend ans -global-dMonday 0
|
|
lappend ans -global-dTuesday 0
|
|
lappend ans -global-dWednesday 0
|
|
lappend ans -global-dThursday 0
|
|
lappend ans -global-dFriday 0
|
|
lappend ans -global-dSaturday 1
|
|
}
|
|
if {[dict exists $obj rep]} {
|
|
lappend ans -global-repbut 1
|
|
lappend ans -text-repdays [dict get $obj rep]
|
|
} else {
|
|
lappend ans -global-repbut 0
|
|
lappend ans -text-repdays 1
|
|
}
|
|
|
|
if {[dict exists $obj time]} {
|
|
set t [dict get $obj time]
|
|
lappend ans -global-timebut 1
|
|
set hour [expr $t / 60]
|
|
set minute [format %02d [expr $t % 60]]
|
|
if {$hour == 0 && !$TwentyFourHourMode} {
|
|
lappend ans -text-timehour 12
|
|
lappend ans -text-ampm AM
|
|
} else {
|
|
if {$TwentyFourHourMode} {
|
|
lappend ans -text-timehour $hour
|
|
} else {
|
|
if {$hour >= 12} {
|
|
incr $hour -12
|
|
lappend ans -text-timehour $hour
|
|
lappend ans -text-ampm PM
|
|
} else {
|
|
lappend ans -text-timehour $hour
|
|
lappend ans -text-ampm AM
|
|
}
|
|
}
|
|
}
|
|
lappend ans -text-timemin $minute
|
|
if {[dict exists $obj tdelta]} {
|
|
lappend ans -global-timeadvbut 1
|
|
lappend ans -text-timeadv [dict get $obj tdelta]
|
|
} else {
|
|
lappend ans -global-timeadvbut 0
|
|
lappend ans -text-timeadv 15
|
|
}
|
|
if {[dict exists $obj trep]} {
|
|
lappend ans -global-timerepbut 1
|
|
lappend ans -text-timerep [dict get $obj trep]
|
|
} else {
|
|
lappend ans -global-timerepbut 0
|
|
lappend ans -text-timerep 5
|
|
}
|
|
if {[dict exists $obj duration]} {
|
|
lappend ans -global-durationbut 1
|
|
set dur [dict get $obj duration]
|
|
lappend ans -text-durationh [expr $dur / 60]
|
|
lappend ans -text-durationm [format %02d [expr $dur % 60]]
|
|
} else {
|
|
lappend ans -global-durationbut 0
|
|
lappend ans -text-durationh 1
|
|
lappend ans -text-durationm 00
|
|
}
|
|
} else {
|
|
lappend ans -global-timebut 0
|
|
lappend ans -text-timehour 12
|
|
lappend ans -text-timemin 00
|
|
lappend ans -text-timeadv 15
|
|
lappend ans -global-timerepbut 0
|
|
lappend ans -text-timerep 5
|
|
lappend ans -global-durationbut 0
|
|
lappend ans -text-durationh 1
|
|
lappend ans -text-durationm 00
|
|
}
|
|
if {[dict exists $obj rawbody]} {
|
|
lappend ans -entry-entry [dict get $obj rawbody]
|
|
} else {
|
|
lappend ans -entry-entry [dict get $obj body]
|
|
}
|
|
|
|
# Figure out the reminder type
|
|
if {[dict exists $obj rep]} {
|
|
# Repeat must be type 1
|
|
lappend ans -global-OptionType 1
|
|
lappend ans -text-day2 $d
|
|
lappend ans -text-mon2 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-mon3 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-year2 $y
|
|
lappend ans -text-year3 $y
|
|
} elseif {![dict exists $obj wd]} {
|
|
# No weekdays - must be type 1
|
|
lappend ans -global-OptionType 1
|
|
lappend ans -text-day2 $d
|
|
lappend ans -text-mon2 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-mon3 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-year2 $y
|
|
lappend ans -text-year3 $y
|
|
} elseif {![dict exists $obj d]} {
|
|
# No day... must be "every wkday in ..."
|
|
lappend ans -global-OptionType 3
|
|
lappend ans -text-day1 $d
|
|
lappend ans -text-mon1 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-year1 $y
|
|
lappend ans -text-day2 $d
|
|
lappend ans -text-mon2 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-year2 $y
|
|
} else {
|
|
set day [dict get $obj d]
|
|
# Take a guess based on day
|
|
if {$day == 1 || $day == 8 || $day == 15 || $day == 22} {
|
|
lappend ans -global-OptionType 3
|
|
lappend ans -text-day1 $d
|
|
lappend ans -text-mon1 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-year1 $y
|
|
lappend ans -text-day2 $d
|
|
lappend ans -text-mon2 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-year2 $y
|
|
} else {
|
|
lappend ans -global-OptionType 2
|
|
lappend ans -text-day1 $d
|
|
lappend ans -text-mon1 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-year1 $y
|
|
lappend ans -text-mon3 [lindex $MonthNames [expr $m - 1]]
|
|
lappend ans -text-year3 $y
|
|
}
|
|
}
|
|
return $ans
|
|
}
|
|
proc FireEditor { w } {
|
|
global Option
|
|
global EditorPid
|
|
set tags [$w tag names current]
|
|
set index [lsearch -glob $tags "FILE_*"]
|
|
if {$index < 0} {
|
|
return
|
|
}
|
|
set tag [lindex $tags $index]
|
|
if {![regexp {^FILE_([0-9]+)_(.*)} $tag all line file]} {
|
|
return
|
|
}
|
|
set editor $Option(Editor)
|
|
regsub -all "%s" $editor $file editor
|
|
regsub -all "%d" $editor $line editor
|
|
|
|
# Don't fire up a second editor if first is running
|
|
if {$EditorPid >= 0} {
|
|
if {![catch {exec kill -0 $EditorPid}]} {
|
|
Status "Editor already active!"
|
|
after 2500 DisplayTime
|
|
bell
|
|
return
|
|
}
|
|
}
|
|
Status "Firing up editor..."
|
|
after 1500 DisplayTime
|
|
set EditorPid [exec sh -c $editor &]
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: GetCurrentReminder
|
|
# %ARGUMENTS:
|
|
# w -- text window
|
|
# %RETURNS:
|
|
# The tag (TKTAGnnnn) for current editable reminder, or "" if no
|
|
# current editable reminder.
|
|
#***********************************************************************
|
|
proc GetCurrentReminder { w } {
|
|
set tags [$w tag names current]
|
|
set index [lsearch -glob $tags "TKTAG*"]
|
|
if {$index < 0} {
|
|
return ""
|
|
}
|
|
set tag [lindex $tags $index]
|
|
return $tag
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: TaggedEnter
|
|
# %ARGUMENTS:
|
|
# w -- text window
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Highlights an "editable" reminder as mouse moves into it
|
|
#***********************************************************************
|
|
proc TaggedEnter { w } {
|
|
set tag [GetCurrentReminder $w]
|
|
if {$tag != ""} {
|
|
$w tag configure $tag -foreground #FF0000
|
|
}
|
|
}
|
|
#***********************************************************************
|
|
# %PROCEDURE: TaggedLeave
|
|
# %ARGUMENTS:
|
|
# w -- text window
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Removes highlight from an "editable" reminder as mouse leaves it
|
|
#***********************************************************************
|
|
proc TaggedLeave { w } {
|
|
set tag [GetCurrentReminder $w]
|
|
if {$tag != ""} {
|
|
set tags [$w tag names current]
|
|
set index [lsearch -glob $tags "clr*"]
|
|
if {$index < 0} {
|
|
set fg "#000000"
|
|
} else {
|
|
set fg [string range [lindex $tags $index] 3 end]
|
|
set fg "#$fg"
|
|
}
|
|
$w tag configure $tag -foreground $fg
|
|
}
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: EditTaggedReminder
|
|
# %ARGUMENTS:
|
|
# w -- text window
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Opens a dialog box to edit the current editable reminder
|
|
#***********************************************************************
|
|
proc EditTaggedReminder { w } {
|
|
global ModifyDialogResult
|
|
set tag [GetCurrentReminder $w]
|
|
if {$tag == ""} {
|
|
return
|
|
}
|
|
|
|
# Get the date
|
|
set index [lsearch -glob [$w tag names current] "date_*"]
|
|
if {$index < 0} {
|
|
return
|
|
}
|
|
set date [string range [lindex [$w tag names current] $index] 5 end]
|
|
# Read in options
|
|
set opts [ReadTaggedOptions $tag $date]
|
|
if {$opts == ""} {
|
|
return
|
|
}
|
|
|
|
toplevel .mod
|
|
CreateModifyDialog .mod 1 0 "Cancel" "Replace reminder" "Delete reminder" "Preview reminder"
|
|
wm title .mod "TkRemind Edit Reminder..."
|
|
wm iconname .mod "Edit Reminder"
|
|
OptionsToRemindDialog .mod $opts
|
|
|
|
tkwait visibility .mod
|
|
set oldFocus [focus]
|
|
while {1} {
|
|
grab .mod
|
|
focus .mod.entry
|
|
set ModifyDialogResult -1
|
|
tkwait variable ModifyDialogResult
|
|
if {$ModifyDialogResult == 1} {
|
|
catch {focus $oldFocus}
|
|
destroy .mod
|
|
return 0
|
|
}
|
|
set problem [catch {set rem [CreateReminder .mod]} err]
|
|
if {$problem} {
|
|
tk_dialog .error Error "$err" error 0 Ok
|
|
continue
|
|
}
|
|
if {$ModifyDialogResult == 4} {
|
|
set rem [EditReminder $rem "Cancel" "Replace reminder"]
|
|
if {$ModifyDialogResult == 1} {
|
|
continue
|
|
}
|
|
}
|
|
set opts [RemindDialogToOptions .mod]
|
|
catch {focus $oldFocus}
|
|
destroy .mod
|
|
set problem [catch {
|
|
if {$ModifyDialogResult == 2} {
|
|
ReplaceTaggedReminder $tag $rem $opts
|
|
} else {
|
|
DeleteTaggedReminder $tag
|
|
}
|
|
} err]
|
|
if {$problem} {
|
|
tk_dialog .error Error "Error: $err" error 0 Ok
|
|
return 1
|
|
}
|
|
|
|
FillCalWindow
|
|
RestartBackgroundRemindDaemon
|
|
return 0
|
|
}
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: UniqueFileName
|
|
# %ARGUMENTS:
|
|
# stem -- base name of file
|
|
# %RETURNS:
|
|
# A filename of the form "stem.xxx" which does not exist
|
|
#***********************************************************************
|
|
proc UniqueFileName { stem } {
|
|
set n 1
|
|
while {[file exists $stem.$n]} {
|
|
incr n
|
|
}
|
|
return $stem.$n
|
|
}
|
|
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: DeleteTaggedReminder
|
|
# %ARGUMENTS:
|
|
# tag -- tag of reminder to delete
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Deletes tagged reminder from reminder file
|
|
#***********************************************************************
|
|
proc DeleteTaggedReminder { tag } {
|
|
global AppendFile
|
|
global HighestTagSoFar
|
|
|
|
set tmpfile [UniqueFileName $AppendFile]
|
|
set out [open $tmpfile "w"]
|
|
write_warning_headers $out
|
|
set in [open $AppendFile "r"]
|
|
|
|
set found 0
|
|
|
|
set tagno 0
|
|
while {[gets $in line] >= 0} {
|
|
if {[is_warning_header $line]} {
|
|
continue
|
|
}
|
|
if {[string match "REM TAG $tag *" $line]} {
|
|
set found 1
|
|
continue
|
|
}
|
|
# Delete the old comment lines
|
|
if {[string match "# TKTAG*" $line]} {
|
|
continue
|
|
}
|
|
if {[string match "# -global-OptionType *" $line]} {
|
|
continue
|
|
}
|
|
if {[string match "# TKEND" $line]} {
|
|
continue
|
|
}
|
|
|
|
# Renumber tags
|
|
if {[regexp {^REM TAG TKTAG([0-9]+) (.*)$} $line all oldtag rest]} {
|
|
incr tagno
|
|
puts $out "REM TAG TKTAG$tagno $rest"
|
|
} else {
|
|
puts $out $line
|
|
}
|
|
}
|
|
|
|
if {! $found } {
|
|
close $in
|
|
close $out
|
|
file delete $tmpfile
|
|
error "Did not find reminder with tag $tag"
|
|
}
|
|
|
|
set HighestTagSoFar $tagno
|
|
close $in
|
|
close $out
|
|
file rename -force -- $tmpfile $AppendFile
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: ReplaceTaggedReminder
|
|
# %ARGUMENTS:
|
|
# tag -- tag of reminder to replace
|
|
# rem -- text to replace it with
|
|
# opts -- edit options
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Replaces a tagged reminder in the reminder file
|
|
#***********************************************************************
|
|
proc ReplaceTaggedReminder { tag rem opts } {
|
|
global AppendFile
|
|
|
|
set tmpfile [UniqueFileName $AppendFile]
|
|
set out [open $tmpfile "w"]
|
|
write_warning_headers $out
|
|
set in [open $AppendFile "r"]
|
|
|
|
set found 0
|
|
|
|
while {[gets $in line] >= 0} {
|
|
if {[is_warning_header $line]} {
|
|
continue
|
|
}
|
|
if {[string match "REM TAG $tag *" $line]} {
|
|
# Write the new reminder
|
|
WriteReminder $out $tag $rem $opts
|
|
set found 1
|
|
} else {
|
|
# Delete the old comment lines
|
|
if {[string match "# TKTAG*" $line]} {
|
|
continue
|
|
}
|
|
if {[string match "# -global-OptionType *" $line]} {
|
|
continue
|
|
}
|
|
if {[string match "# TKEND" $line]} {
|
|
continue
|
|
}
|
|
puts $out $line
|
|
}
|
|
}
|
|
|
|
if {! $found} {
|
|
close $in
|
|
close $out
|
|
file delete $tmpfile
|
|
error "Did not find reminder with tag $tag"
|
|
}
|
|
|
|
close $in
|
|
close $out
|
|
file rename -force -- $tmpfile $AppendFile
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: WriteReminder
|
|
# %ARGUMENTS:
|
|
# out -- file to write to
|
|
# tag -- reminder tag
|
|
# rem -- reminder body
|
|
# opts -- edit options
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Writes a reminder to a file
|
|
#***********************************************************************
|
|
proc WriteReminder { out tag rem opts } {
|
|
#puts $out "# $tag Next reminder was created with TkRemind. DO NOT EDIT"
|
|
#puts $out "# $opts"
|
|
if {[string range $rem 0 3] == "REM "} {
|
|
puts $out "REM TAG $tag [string range $rem 4 end]"
|
|
} else {
|
|
puts $out $rem
|
|
}
|
|
#puts $out "# TKEND"
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: DoShadeSpecial
|
|
# %ARGUMENTS:
|
|
# n -- calendar box to shade
|
|
# r, g, b -- colour components
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Handles the "SHADE" special -- shades a box.
|
|
#***********************************************************************
|
|
proc DoShadeSpecial { n r g b } {
|
|
if {$r < 0 || $r > 255 || $g < 0 || $g > 255 || $b < 0 || $b > 255} {
|
|
return
|
|
}
|
|
set bg [format "#%02x%02x%02x" $r $g $b]
|
|
.cal.t$n configure -background $bg
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: DoMoonSpecial
|
|
# %ARGUMENTS:
|
|
# n -- calendar box for moon
|
|
# stuff -- Remind command line
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Handles the "MOON" special -- draws a moon symbol
|
|
#***********************************************************************
|
|
proc DoMoonSpecial { n stuff } {
|
|
set msg ""
|
|
set num [scan $stuff "%d %d %d %s" phase junk1 junk2 msg]
|
|
if {$num < 1} {
|
|
return
|
|
}
|
|
if {$phase < 0 || $phase > 3} {
|
|
return
|
|
}
|
|
switch -exact -- $phase {
|
|
0 { set image new }
|
|
1 { set image first }
|
|
2 { set image full }
|
|
3 { set image last }
|
|
}
|
|
.cal.t$n configure -state normal
|
|
.cal.t$n image create 1.0 -image $image
|
|
|
|
if {$msg != ""} {
|
|
.cal.t$n insert 1.1 " $msg\n"
|
|
} else {
|
|
.cal.t$n insert 1.1 "\n"
|
|
}
|
|
.cal.t$n configure -state disabled
|
|
}
|
|
#***********************************************************************
|
|
# %PROCEDURE: DisplayTime
|
|
# %ARGUMENTS:
|
|
# None
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Displays current date and time in status window
|
|
#***********************************************************************
|
|
proc DisplayTime {} {
|
|
global TwentyFourHourMode
|
|
if {$TwentyFourHourMode} {
|
|
set msg [clock format [clock seconds] -format "%e %b %Y %H:%M"]
|
|
} else {
|
|
set msg [clock format [clock seconds] -format "%e %b %Y %I:%M%p"]
|
|
}
|
|
Status $msg
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: CreateMoonImages
|
|
# %ARGUMENTS:
|
|
# None
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Creates the moon images "new", "first", "full" and "last"
|
|
#***********************************************************************
|
|
proc CreateMoonImages {} {
|
|
image create photo full -data "iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAAAlwSFlzAAAGQAAABkABchkaRQAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAADlSURBVDiNrdNBUsJAEAXQlyw4hq4hwWPqTixET6ELkZ16CcAq7oFLqXExjaYgQVNlV/Viev7/6XT/4TjGuME7PiLXUatb8N8xwB12SFjiIXIZtU/MAntEfgvQE4YtHxhiHpjXQ5H7uLhEcaLLAleBvd0Xx9Ha/BdyU+Q5OBV5OKmj7a4YBWdSyNPe4aKHAHkzqcQZNj3JgnNexqE8heyIAulffuFF3kTfIVbBVeu/xoXGGsn2TLJJ/mqkafNiINszySYZdbS90GHlvcgsWktY4TFy7ecxTdvIzahxHQLbyFXUqkPwF2ASRNYgB/PXAAAAAElFTkSuQmCC"
|
|
image create photo first -data "iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAAAlwSFlzAAAGQAAABkABchkaRQAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAADfSURBVDiNndM9TsNAFATgzy5yjZSAE85JBygETgENUPF3iBCitHAFQkcIhZ/Ryn9gRlrZmp2Z3ef3TBOHOMULPrDBMrhpi/4HI5xjix2+4nmJRbx/Yh7ahvkpRPVV4QDXwT3UQy46zGkAZDgK/iytefvHgCrkJsqZUH6cLnNbABSxd5Jhhf1IbkMXv8Qux7hH1Ic1xvk/jBWy6gavumvtwx7ectwZXkKh7MA95XgObeOtpI2U4zl0kGbpxgiPvwQUcXLrKFchc82f6Ur0PK49azOnmOI4TBu84zm4SV38DeIVYkrYJyNbAAAAAElFTkSuQmCC"
|
|
image create photo new -data "iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAAAlwSFlzAAAGQAAABkABchkaRQAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAAC6SURBVDiNpdNNbsIwFATgL0HKolchHKBX6yFaBOEyoPYUabvOIVKJRaCL2JX5TRNGGvnJ8ozGz89cYoElPvET+BX2yivn/1Bggw5HHMKa1h2qcPZC/JEIhvh+brIZIY6sorhMYo9hh3KGFzzfa84NZNjDt9OG/ZcH1BlaPE1IAG0+URhxzNGESKPFaHJs9Q0Ziww7HnvGeXSrJhis0jiFfjwnj3I0WRv+TKtr4hQl3lDrZ6QN9Wt654hfWfGDmBpUwDkAAAAASUVORK5CYII="
|
|
image create photo last -data "iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAABHNCSVQICAgIfAhkiAAAAAlwSFlzAAAGQAAABkABchkaRQAAABl0RVh0U29mdHdhcmUAd3d3Lmlua3NjYXBlLm9yZ5vuPBoAAADmSURBVDiNndMxTsNAEIXhzy5yCyQ6FAgcE7oQheQWUAAl5BIkREoZrgB0GFNkHBl7bURGsryaee/3jHeXdpxjghU+8InXyI0S+n0MMEeBEi+4jfV3vAvMQtsyL0J0j2GtViaeRRMyj8IlsgY8BSijE2Kur/hy09wHKMJrEolhwtwHKDHOsI4OLnoAXfl1jiNsOkR9keE4P8D4q4scbzg5xIxtjie709f1E7siC+9+Gx/8fxvPKtEsklcJSBdgWhcN8ByFR5z+AWgd5QpyE+OUWOJO+zJNU+Z6jHAdgHe7K73CuD5zFT9nCmRDIssCaAAAAABJRU5ErkJggg=="
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: DisplayTimeContinuously
|
|
# %ARGUMENTS:
|
|
# None
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Continuously displays current date and time in status window,
|
|
# updating once a minute
|
|
#***********************************************************************
|
|
proc DisplayTimeContinuously {} {
|
|
DisplayTime
|
|
set secs [clock format [clock seconds] -format "%S"]
|
|
# Doh -- don't interpret as an octal number if leading zero
|
|
scan $secs "%d" decSecs
|
|
set decSecs [expr 60 - $decSecs]
|
|
after [expr $decSecs * 1000] DisplayTimeContinuously
|
|
}
|
|
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: ShowTodaysReminders
|
|
# %ARGUMENTS:
|
|
# None
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Shows all of today's non-timed reminders in a window
|
|
#***********************************************************************
|
|
proc ShowTodaysReminders {} {
|
|
global Option
|
|
global Remind
|
|
global ReminderFile
|
|
if {!$Option(ShowTodaysReminders)} {
|
|
return
|
|
}
|
|
|
|
set w .today
|
|
catch { destroy $w }
|
|
toplevel $w
|
|
wm title $w "Today's Reminders"
|
|
wm iconname $w "Reminders"
|
|
text $w.text -width 80 -height 20 -wrap word -yscrollcommand "$w.sb set"
|
|
scrollbar $w.sb -orient vertical -command "$w.text yview"
|
|
button $w.ok -text "OK" -command "destroy $w"
|
|
|
|
grid $w.text -row 0 -column 0 -sticky nsew
|
|
grid $w.sb -row 0 -column 1 -sticky ns
|
|
grid $w.ok -row 1 -column 0 -sticky w
|
|
|
|
CenterWindow $w .
|
|
|
|
# Grab the reminders
|
|
set stuff ""
|
|
set cmdline "|$Remind -g -q -r "
|
|
append cmdline $Option(ExtraRemindArgs);
|
|
append cmdline " $ReminderFile 2>/dev/null"
|
|
set f [open $cmdline r]
|
|
while {[gets $f line] >= 0} {
|
|
append stuff "$line\n"
|
|
}
|
|
close $f
|
|
$w.text insert end $stuff
|
|
$w.text configure -state disabled
|
|
}
|
|
|
|
#***********************************************************************
|
|
# %PROCEDURE: InteractiveDeleteReminder
|
|
# %ARGUMENTS:
|
|
# tag -- tag of reminder to delete
|
|
# %RETURNS:
|
|
# Nothing
|
|
# %DESCRIPTION:
|
|
# Prompts for confirmation; then deletes reminder
|
|
#***********************************************************************
|
|
proc InteractiveDeleteReminder { tag } {
|
|
set ans [tk_dialog .error "Really Delete" "Really delete reminder?" warning 0 No Yes]
|
|
if {$ans == 1} {
|
|
DeleteTaggedReminder $tag
|
|
FillCalWindow
|
|
RestartBackgroundRemindDaemon
|
|
}
|
|
}
|
|
|
|
proc SendMail { recipient subject body } {
|
|
global Option
|
|
|
|
if {"$Option(MailAddr)" == ""} {
|
|
return
|
|
}
|
|
if {[catch {set token [mime::initialize -canonical text/plain -string $body]
|
|
mime::setheader $token Subject $subject
|
|
mime::setheader $token From "Reminder Service <>"
|
|
mime::setheader $token To "<$recipient>"
|
|
mime::setheader $token Auto-Submitted "auto-generated"
|
|
smtp::sendmessage $token -originator "" -servers $Option(SMTPServer) -recipients $Option(MailAddr)} err]} {
|
|
puts stderr "ERROR sending mail: $err"
|
|
}
|
|
}
|
|
|
|
proc ClosePopup { w after_token mail_addr close_win ignore_or_kill tag reminder rem_time } {
|
|
global Ignore
|
|
if {"$after_token" != ""} {
|
|
catch { after cancel $after_token }
|
|
}
|
|
|
|
if {$close_win} {
|
|
catch { destroy $w }
|
|
}
|
|
|
|
if {"$mail_addr" != ""} {
|
|
SendMail $mail_addr "Reminder for $rem_time" "Hello,\n\nThe following reminder is scheduled for $rem_time:\n\n$reminder\nRegards,\n\nTkRemind\n"
|
|
}
|
|
if {"$ignore_or_kill" == "ignore"} {
|
|
set Ignore($tag) 1
|
|
}
|
|
if {"$ignore_or_kill" == "kill"} {
|
|
InteractiveDeleteReminder $tag
|
|
}
|
|
}
|
|
|
|
# Adjust font defaults for screen size
|
|
proc SetFonts {} {
|
|
global SetFontsWorked
|
|
set h [winfo screenheight .]
|
|
if {$h <= 480} {
|
|
# Small screen (maybe eeepc?)
|
|
font configure TkDefaultFont -size 6
|
|
font configure TkFixedFont -size 6
|
|
}
|
|
set SetFontsWorked 1
|
|
}
|
|
|
|
### Balloon help
|
|
set Balloon(HelpTime) 400
|
|
set Balloon(StayTime) 3500
|
|
set Balloon(Font) fixed
|
|
|
|
proc balloon_reset_timer { w } {
|
|
balloon_destroy_help_window
|
|
balloon_cancel_timer
|
|
balloon_schedule_help $w
|
|
}
|
|
|
|
proc balloon_destroy_help_window {} {
|
|
catch { destroy .balloonhelp }
|
|
}
|
|
|
|
proc balloon_cancel_timer {} {
|
|
global Balloon
|
|
catch { after cancel $Balloon(HelpId) }
|
|
}
|
|
|
|
proc balloon_schedule_help { w } {
|
|
global Balloon
|
|
if { $Balloon(MustLeave) } {
|
|
return
|
|
}
|
|
set Balloon(HelpId) [ after $Balloon(HelpTime) "balloon_popup_help $w" ]
|
|
}
|
|
|
|
proc balloon_popup_help { w } {
|
|
global Balloon
|
|
if {![info exists Balloon(helptext$w)]} {
|
|
return
|
|
}
|
|
|
|
if {[string compare [winfo containing [winfo pointerx .] [winfo pointery .]] $w]} {
|
|
return
|
|
}
|
|
set h .balloonhelp
|
|
toplevel $h -bg #000000
|
|
label $h.l -text $Balloon(helptext$w) -wraplength 200 -justify left -bg #FFFFC0 -bd 0
|
|
pack $h.l -padx 1 -pady 1 -ipadx 2 -ipady 1
|
|
wm overrideredirect $h 1
|
|
set geom [balloon_calculate_geometry $h]
|
|
wm geometry $h $geom
|
|
set Balloon(HelpId) [after $Balloon(StayTime) "catch { destroy $h }"]
|
|
set Balloon(MustLeave) 1
|
|
}
|
|
|
|
bind Balloon <Leave> {
|
|
set Balloon(MustLeave) 0
|
|
balloon_destroy_help_window
|
|
balloon_cancel_timer
|
|
}
|
|
|
|
bind Balloon <Enter> {
|
|
set Balloon(MustLeave) 0
|
|
balloon_reset_timer %W
|
|
}
|
|
|
|
bind Balloon <Any-Motion> "balloon_reset_timer %W"
|
|
bind Balloon <Any-ButtonPress> {
|
|
set Balloon(MustLeave) 1
|
|
balloon_reset_timer %W
|
|
}
|
|
|
|
bind Balloon <Destroy> {
|
|
balloon_destroy_help_window
|
|
balloon_cancel_timer
|
|
catch { unset Balloon(helptext%W) }
|
|
}
|
|
|
|
proc balloon_add_help { w txt } {
|
|
global Balloon
|
|
if {"$txt" == ""} {
|
|
catch { unset Balloon(helptext$w) }
|
|
return
|
|
}
|
|
set Balloon(helptext$w) $txt
|
|
bindtags $w "Balloon [bindtags $w]"
|
|
}
|
|
|
|
proc balloon_calculate_geometry { w } {
|
|
set x [winfo pointerx $w]
|
|
set y [winfo pointery $w]
|
|
set mx [winfo screenwidth $w]
|
|
set my [winfo screenheight $w]
|
|
# Adjust for padding
|
|
set wid [expr [winfo reqwidth $w.l] + 6]
|
|
set h [expr [winfo reqheight $w.l] + 4]
|
|
|
|
# Try above-right of pointer
|
|
set tx [expr $x+3]
|
|
set ty [expr $y-3-$h]
|
|
if {$ty >= 0 && ($tx+$wid) <= $mx} {
|
|
return "+$tx+$ty"
|
|
}
|
|
|
|
# Try above-left of pointer
|
|
set tx [expr $x-3-$wid]
|
|
set ty [expr $y-3-$h]
|
|
if {$ty >= 0 && $tx >= 0} {
|
|
return "+$tx+$ty"
|
|
}
|
|
|
|
# Try below-right of pointer
|
|
set tx [expr $x+3]
|
|
set ty [expr $y+3]
|
|
if {$ty+$h <= $my && ($tx+$wid) <= $mx} {
|
|
return "+$tx+$ty"
|
|
}
|
|
|
|
# Darn... must be below-left
|
|
set tx [expr $x-3-$wid]
|
|
set ty [expr $y+3]
|
|
return "+$tx+$ty"
|
|
}
|
|
|
|
main
|