(FILECREATED " 4-Apr-86 13:27:25" {ERIS}<LISPUSERS>KOTO>CALENDAR.;1 59819
changes to: (FNS CALUPDATEFILE)
previous date: "28-Feb-86 15:38:20" {ERIS}<LISP>KOTO>LISPUSERS>CALENDAR.;1)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT CALENDARCOMS)
(RPAQQ CALENDARCOMS
((VARS (CALCHECKEARLYTIME 800)
(CALCIRCLEDAY)
(CALCIRCLEMONTH)
(CALCURDAY)
(CALCURMONTH)
(CALCURYEAR)
(CALDAYDEFAULTXLOC 32)
(CALDAYDEFAULTYLOC 600)
(CALDAYMENU)
(CALDAYSTREAM)
(CALDAYWINDOW)
(CALDISPMENU)
(CALMAINMENU)
(CALMONTHMENU)
(CALMONTHSTREAM)
(CALMONTHWINDOW)
(CALREMINDERS)
(CALYEARMENU)
(CALYEARSTREAM)
(CALYEARWINDOW))
(INITVARS (CALDEFAULTHOST&DIR)
(CALHASH (HARRAY 200))
(CALFONT)
(CALKEEPEXPIREDREMSFLG)
(CALNEEDSUPDATE)
(CALUPDATEONSHRINKFLG)
(CALDUMMYPROC)
(PBIGFONT)
(PCALFONT)
(PLITTLEFONT))
(FNS CALADDEVENT CALDISPEVENT CALDUMMYFN CALENDAR CALEXTENDSEL CALMAKEKEY CALMONTHBEF
CALMONTHRBF CALPRINTREM CALREMDEF CALTEST CALUNIQUEGENSYM CALUPDATEFILE CALYEARINRANGE
CIRCLETODAY DAYNAME DAYOF DAYSIN LISPDATEDAY LISPDATEMONTH LISPDATEYEAR MAKEDAYTITLE
MDMENUITEMREGION MONTHABBR MONTHNAME MONTHNUM MONTHPLUS MONTHYEARPLUS PACKDATE PARSETIME
POM POMDAYS PRINTMONTH REMDT REMINDERDAYLT REMINDERSOF REMINDERTIME REMINDERTIMELT
REMSINMONTH REPAINTMONTH REPAINTYEAR SAMEDAYAS SAMEMONTHAS SHOWDAY SHOWMONTH
SHOWMONTHSMALL SHOWMOON SHOWREMSINDAY SHOWREMSINMONTH SHOWYEAR SHRINKMONTH SHRINKYEAR
STOREREMS YEAROF)
(BITMAPS CALDAYICON CALMONTHICON CALYEARICON FQMAP FMMAP LQMAP NMMAP)
(FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
PROMPTREMINDERS)
(ADVISE ALTO.TO.LISP.DATE)))
(RPAQQ CALCHECKEARLYTIME 800)
(RPAQQ CALCIRCLEDAY NIL)
(RPAQQ CALCIRCLEMONTH NIL)
(RPAQQ CALCURDAY NIL)
(RPAQQ CALCURMONTH NIL)
(RPAQQ CALCURYEAR NIL)
(RPAQQ CALDAYDEFAULTXLOC 32)
(RPAQQ CALDAYDEFAULTYLOC 600)
(RPAQQ CALDAYMENU NIL)
(RPAQQ CALDAYSTREAM NIL)
(RPAQQ CALDAYWINDOW NIL)
(RPAQQ CALDISPMENU NIL)
(RPAQQ CALMAINMENU NIL)
(RPAQQ CALMONTHMENU NIL)
(RPAQQ CALMONTHSTREAM NIL)
(RPAQQ CALMONTHWINDOW NIL)
(RPAQQ CALREMINDERS NIL)
(RPAQQ CALYEARMENU NIL)
(RPAQQ CALYEARSTREAM NIL)
(RPAQQ CALYEARWINDOW NIL)
(RPAQ? CALDEFAULTHOST&DIR )
(RPAQ? CALHASH (HARRAY 200))
(RPAQ? CALFONT )
(RPAQ? CALKEEPEXPIREDREMSFLG )
(RPAQ? CALNEEDSUPDATE )
(RPAQ? CALUPDATEONSHRINKFLG )
(RPAQ? CALDUMMYPROC )
(RPAQ? PBIGFONT )
(RPAQ? PCALFONT )
(RPAQ? PLITTLEFONT )
(DEFINEQ
(CALADDEVENT
[LAMBDA (M D YR) (* MJD "28-Feb-86 12:40")
(* There are 3 types of reminders: timed-save, timed-delete, and untimed. They have the following propreties:
(NR = REMINDER.NEXTREMINDDATE, XD = REMINDER.EXPIRATIONDATE) %
Timed-save: NR = "D-M-YR firing-time" XD = "D-M-2034 12:01:00" %
Timed-delete: NR = "D-M-YR firing-time" XD = "now" (not given an XD) %
Untimed: NR = "D-M-2034 00:00:00" XD = "D-M-2034 12:01:00")
(PROG (ANS REMDATE REMTIME R)
(TERPRI PROMPTWINDOW)
(SETQ REMDATE (PACKDATE [SETQ REMTIME (PARSETIME (PROMPTFORWORD
(PROGN (TERPRI
PROMPTWINDOW)
"Time:")
NIL NIL PROMPTWINDOW NIL NIL
(CHARCODE EOL]
M D YR))
(TERPRI PROMPTWINDOW)
[COND
((NULL REMTIME)
(printout PROMPTWINDOW T "Sorry - I couldn't parse that time.")
(CALADDEVENT M D YR)
(RETURN T))
((IGREATERP REMTIME 2359)
(printout PROMPTWINDOW T "Illegal time: must be <= 23:59")
(CALADDEVENT M D YR)
(RETURN T))
((ILEQ (IDATE REMDATE)
(IDATE))
(PRINTOUT PROMPTWINDOW T
"You can't add timed reminders with a time that has already passed.")
(RETURN NIL))
((AND (IGREATERP REMTIME 0)
(ILESSP REMTIME CALCHECKEARLYTIME))
[SETQ ANS (CHARACTER (CHCON1 (PROMPTFORWORD (PROGN (TERPRI PROMPTWINDOW)
"Do you *really* mean A.M.?")
NIL
[FUNCTION (LAMBDA NIL
(QUOTE (Y N]
PROMPTWINDOW NIL NIL]
(TERPRI PROMPTWINDOW)
(if (AND (NEQ ANS (QUOTE y))
(NEQ ANS (QUOTE Y)))
then (SETQ REMDATE (PACKDATE (add REMTIME 1200)
M D YR]
[pushnew CALREMINDERS (SETREMINDER (SETQ R (CALUNIQUEGENSYM))
NIL
(PROMPTFORWORD "Message:" NIL NIL PROMPTWINDOW
NIL NIL (CHARCODE EOL))
REMDATE
(if (OR CALKEEPEXPIREDREMSFLG
(NEQ (LISPDATEYEAR REMDATE)
YR))
then (PACKDATE (if CALKEEPEXPIREDREMSFLG
then REMTIME
else "12:01:00")
M D 2034]
(* actual firing time for timed-saved reminders will
be saved under EXPIRATIONDATE, since PROMTPREMINDERS
seems to zap NEXTREMINDDATE)
(* Timed-saves and untimed's need an EXPIRATIONDATE:
actual time means this is a timed-save, 12:01:00 means
this is an untimed)
(PUTHASH (CALMAKEKEY (LISPDATEMONTH (REMINDER.NEXTREMINDDATE R))
(LISPDATEDAY (REMINDER.NEXTREMINDDATE R)))
(SORT (NCONC1 (GETHASH (CALMAKEKEY (LISPDATEMONTH (
REMINDER.NEXTREMINDDATE
R))
(LISPDATEDAY (
REMINDER.NEXTREMINDDATE
R)))
CALHASH)
R)
(QUOTE REMINDERTIMELT))
CALHASH)
(UNMARKASCHANGED R (QUOTE REMINDER))
(SETQ CALNEEDSUPDATE T)
(if (NOT CALUPDATEONSHRINKFLG)
then (CALUPDATEFILE))
(SHOWDAY (LIST D M YR])
(CALDISPEVENT
[LAMBDA (ITEM) (* MD "23-May-85 17:06")
(PROG [(M (CADR ITEM))
(D (CADDR ITEM))
(YR (CAR (LAST ITEM]
(COND
((EQ (CAR ITEM)
(QUOTE ADD))
(CALADDEVENT M D YR))
(T (SELECTQ [MENU (COND
((type? MENU CALDISPMENU)
CALDISPMENU)
(T (SETQ CALDISPMENU (create MENU
ITEMS ←(QUOTE ((Flash (QUOTE CALFLASH)
"The message will flash here.")
(Beep (QUOTE CALBEEP)
"The message will print here and beep.")
(SendMail (QUOTE CALMAIL)
"The message will be mailed to the recipients of your choice.")
(Delete (QUOTE CALDELETE)
"The message will be deleted immediately."]
(CALFLASH (PRINTOUT PROMPTWINDOW T "This is the default action."))
(CALBEEP (SETREMINDER (CADR ITEM)
NIL
[BQUOTE (PROGN (BEEPON 100)
(PRINTOUT PROMPTWINDOW T ,
(CADDR (GETDEF (CADR ITEM)
(QUOTE REMINDER]
(REMINDER.NEXTREMINDDATE (CADR ITEM)))
(PRINTOUT PROMPTWINDOW T "The message will print here and beep."))
(CALMAIL (SETREMINDER (CADR ITEM)
NIL
[BQUOTE
(PROGN (LAFITE.SENDMESSAGE
,
(CONCAT "Subject: A CALENDAR Message"
(CHARACTER 13)
"To: "
(PROMPTFORWORD (PROGN (TERPRI
PROMPTWINDOW)
"Send message to: ")
NIL NIL PROMPTWINDOW
NIL NIL (CHARCODE
EOL))
(CHARACTER 13)
(CHARACTER 13)
(CADDR (GETDEF (CADR ITEM)
(QUOTE REMINDER]
(REMINDER.NEXTREMINDDATE (CADR ITEM)))
(PRINTOUT PROMPTWINDOW T
"The message will be mailed when its time arrives."))
(CALDELETE (SETCURSOR WAITINGCURSOR)
[SHOWDAY (PROG1 [LIST (LISPDATEDAY (REMINDER.NEXTREMINDDATE
(CADR ITEM)))
(LISPDATEMONTH (REMINDER.NEXTREMINDDATE
(CADR ITEM)))
(if (EQ (LISPDATEYEAR (
REMINDER.NEXTREMINDDATE (CADR ITEM)))
2034)
then (YEAROF CALMONTHWINDOW)
else (LISPDATEYEAR (REMINDER.NEXTREMINDDATE
(CADR ITEM]
(DELDEF (CADR ITEM)
(QUOTE REMINDER]
(CURSOR T))
(PROGN NIL])
(CALDUMMYFN
[LAMBDA NIL (* MJD "29-Jan-86 12:49")
(do (BLOCK])
(CALENDAR
[LAMBDA (M D YR) (* MJD "28-Feb-86 14:57")
(SETQ CALENDARVERSION (CONCAT "Calendar Version " "1.85"))
(AND CALDEFAULTHOST&DIR (INFILEP (PACKFILENAME (QUOTE NAME)
(QUOTE CALREMINDERS)
(QUOTE DIRECTORY)
CALDEFAULTHOST&DIR))
(LOAD? (PACKFILENAME (QUOTE NAME)
(QUOTE CALREMINDERS)
(QUOTE DIRECTORY)
CALDEFAULTHOST&DIR)))
[COND
((NOT (FIND.PROCESS CALDUMMYPROC))
(SETQ CALDUMMYPROC (ADD.PROCESS (QUOTE (CALDUMMYFN]
(* This is to keep top-level from covering Month
window.)
(COND
((type? MENU CALMAINMENU)
(DELETEMENU CALMAINMENU)))
(SETQ CALMAINMENU (create MENU
ITEMS ←[APPEND (for YR from (IDIFFERENCE (LISPDATEYEAR
(DATE))
1)
to (IPLUS (LISPDATEYEAR (DATE))
3)
collect (LIST YR YR
"Will make a calendar for this year."))
(LIST (QUOTE (Other (QUOTE OTHER)
"Lets you choose another year"]
TITLE ← "Year"
CENTERFLG ← T
CHANGEOFFSETFLG ← T
WHENSELECTEDFN ←(QUOTE SHOWYEAR)))
(COND
((EQ CALFONT NIL)
(if (AND (NOT M)
(NOT D)
(NOT YR))
then (printout PROMPTWINDOW T "Looking for font - one moment please ...")
(SETCURSOR WAITINGCURSOR))
(SETQ CALFONT (FONTCREATE (QUOTE TIMESROMAN)
36))
(CURSOR T)))
(COND
((AND (NOT M)
(NOT D)
(NOT YR))
(printout T CALENDARVERSION T)
(printout T "See the Prompt Window for Calendar messages." T)
(printout PROMPTWINDOW T "Select a year for calendar.")
(MENU CALMAINMENU))
[(EQ M (QUOTE TODAY))
(SHOWDAY (LIST (LISPDATEDAY (DATE))
(LISPDATEMONTH (DATE))
(LISPDATEYEAR (DATE]
[(EQ M (QUOTE THISMONTH))
(SHOWMONTH (LIST NIL (LISPDATEMONTH (DATE))
(LISPDATEYEAR (DATE]
[(EQ M (QUOTE THISYEAR))
(SHOWYEAR (LIST (LISPDATEYEAR (DATE]
((AND M D YR)
(SHOWDAY (LIST D M YR)))
((AND M YR)
(SHOWMONTH (LIST NIL M YR)))
((AND (NOT M)
YR)
(SHOWYEAR (LIST YR)))
(T NIL])
(CALEXTENDSEL
[LAMBDA (X) (* MD "24-May-85 11:15")
(printout PROMPTWINDOW T "Coming soon to this button - day group selection.")
(GETMOUSESTATE)
(while (MOUSESTATE (ONLY RIGHT))
do (BITBLT NIL NIL NIL CALMONTHWINDOW (IPLUS (CAR (MDMENUITEMREGION D CALMONTHMENU))
37)
(CADR (MDMENUITEMREGION D CALMONTHMENU))
81 98 (QUOTE TEXTURE)
(QUOTE INVERT)
WHITESHADE)
(GETMOUSESTATE])
(CALMAKEKEY
[LAMBDA (M D) (* edited: "19-Feb-86 16:45")
(IPLUS (ITIMES M 100)
D])
(CALMONTHBEF
[LAMBDA (W) (* MJD "28-Feb-86 12:50")
(if (AND (WINDOWP CALDAYWINDOW)
(NOT (MOUSESTATE UP)))
then (CLOSEW CALDAYWINDOW))
(MENUBUTTONFN W])
(CALMONTHRBF
[LAMBDA NIL (* MD "24-May-85 13:53")
(if (INSIDEP (CREATEREGION 0 0 (WINDOWPROP CALMONTHWINDOW (QUOTE WIDTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE HEIGHT)))
(LASTMOUSEX CALMONTHSTREAM)
(LASTMOUSEY CALMONTHSTREAM))
then (MENUBUTTONFN CALMONTHWINDOW)
else (DOWINDOWCOM CALMONTHWINDOW])
(CALPRINTREM
[LAMBDA (REMINDER STREAM) (* MJD "12-Feb-86 15:33")
(* Prints reminder in day box of month window.
Caller must set x,y position in STREAM)
(if (NEQ (REMINDERTIME REMINDER)
0)
then (PRIN1 (REMINDERTIME REMINDER)
STREAM))
(SPACES 1 STREAM)
(PRIN1 (CALREMDEF REMINDER)
STREAM)
(TERPRI STREAM])
(CALREMDEF
[LAMBDA (REMINDER) (* MJD "22-Oct-85 10:40")
(* Return reminder message text, normally the CADDR,
but note special case for reminders to be MAILed
(they are PROGN's))
(PROG (STR)
[SETQ STR (if [STRINGP (CADDR (GETDEF REMINDER (QUOTE REMINDERS]
then (CADDR (GETDEF REMINDER (QUOTE REMINDERS)))
else (MKSTRING (PACK (LDIFFERENCE [UNPACK (CADADR (CADDR (GETDEF REMINDER
(QUOTE
REMINDERS]
(LIST (CHARACTER 13]
(RETURN (SUBSTRING STR 1 (MIN (LENGTH (UNPACK STR))
40])
(CALTEST
[LAMBDA NIL (* MJD "28-Feb-86 15:37")
(PRINTOUT T T "CALENDAR Test Suite" T)
(PRINTOUT T "Testing low-level functions:" T T)
(PRINTOUT T "CALYEARINRANGE...")
(if (OR (NOT (CALYEARINRANGE 1701))
(NOT (CALYEARINRANGE 2099))
(CALYEARINRANGE 2304))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "DAYNAME...")
(if (OR (NEQ (DAYNAME 0)
(QUOTE Sunday))
(NEQ (DAYNAME 6)
(QUOTE Saturday)))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "DAYOF...")
(if (OR (NEQ (DAYOF 2 11 1986)
2)
(NEQ (DAYOF 10 21 1985)
1))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "DAYSIN...")
(if (OR (NEQ (DAYSIN 1 1986)
31)
(NEQ (DAYSIN 9 1985)
30))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "LISPDATEDAY...")
(if (OR (NEQ (LISPDATEDAY "28-Feb-86 13:41:18")
28)
(NEQ (LISPDATEDAY "28-Feb-2034 13:41:18")
28))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "LISPDATEMONTH...")
(if (OR (NEQ (LISPDATEMONTH "28-Feb-86 13:41:18")
2)
(NEQ (LISPDATEMONTH "28-Dec-2034 13:41:18")
12))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "LISPDATEYEAR...")
(if (OR (NEQ (LISPDATEYEAR "28-Feb-86 13:41:18")
1986)
(NEQ (LISPDATEYEAR "28-Dec-2034 13:41:18")
2034))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "MONTHABBR...")
(if (OR (NEQ (MONTHABBR 1)
(QUOTE Jan))
(NEQ (MONTHABBR 12)
(QUOTE Dec)))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "MONTHNAME...")
(if (OR (NEQ (MONTHNAME 1)
(QUOTE % January))
(NEQ (MONTHNAME 12)
(QUOTE December)))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "MONTHNUM...")
(if (OR (NEQ (MONTHNUM (QUOTE Jan))
1)
(NEQ (MONTHNUM (QUOTE Dec))
12))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "MONTHPLUS...")
(if (OR (NEQ (MONTHPLUS 1 1)
2)
(NEQ (MONTHPLUS 12 1)
1)
(NEQ (MONTHPLUS 1 -1)
12))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "MONTHYEARPLUS...")
(if (OR (NEQ (MONTHYEARPLUS 1 1986 1)
1986)
(NEQ (MONTHYEARPLUS 12 1986 1)
1987)
(NEQ (MONTHYEARPLUS 1 1986 -1)
1985))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "PACKDATE...")
(if (OR (NOT (EQUAL (PACKDATE 1500 1 1 1986)
" 1-Jan-86 1500"))
(NOT (EQUAL (PACKDATE 0 1 1 1986)
" 1-Jan-2034 12:01:00"))
(NOT (EQUAL (PACKDATE 800 12 31 1985)
"31-Dec-85 800")))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T "PARSETIME...")
(if (OR (NEQ (PARSETIME "1500")
1500)
(NEQ (PARSETIME "3 PM")
1500)
(NEQ (PARSETIME "3 P.M.")
1500)
(NEQ (PARSETIME "3 pm")
1500)
(NEQ (PARSETIME "3:00 p.m.")
1500)
(NEQ (PARSETIME "8:00")
800)
(NEQ (PARSETIME "8")
800)
(NEQ (PARSETIME "800")
800)
(NEQ (PARSETIME "1200")
1200))
then (PRINTOUT T "fail")
else (PRINTOUT T "pass"))
(PRINTOUT T T T "Done." T])
(CALUNIQUEGENSYM
[LAMBDA NIL (* MJD "17-Jan-86 14:37")
(PROG (REMNAME)
(repeatwhile (MEMBER REMNAME (ACTIVEREMINDERNAMES)) do (SETQ REMNAME (GENSYM))
)
(RETURN REMNAME])
(CALUPDATEFILE
[LAMBDA NIL (* lmm " 4-Apr-86 13:26")
(RESETLST (PROG (FILE)
[RESETSAVE (OUTPUT (SETQ FILE
(OPENSTREAM [PACKFILENAME.STRING (QUOTE NAME)
(QUOTE CALREMINDERS)
(QUOTE DIRECTORY)
(OR CALDEFAULTHOST&DIR
(SETQ CALDEFAULTHOST&DIR
(PROMPTFORWORD
"Please enter a host & directory for the reminders file:"
NIL NIL PROMPTWINDOW NIL NIL
(CHARCODE EOL]
(QUOTE OUTPUT)
(QUOTE OLD/NEW]
(printout PROMPTWINDOW T "Updating reminder file " FILE)
(STOREREMS)
(for X in (ACTIVEREMINDERNAMES)
do (PRINT [BQUOTE (PUTDEF (QUOTE , X)
(QUOTE REMINDERS)
(QUOTE , (GETDEF X (QUOTE REMINDERS]
FILE) finally (PRINT (BQUOTE (RPAQQ CALREMINDERS , (
ACTIVEREMINDERNAMES
)))
FILE))
(PRINT (QUOTE STOP)
FILE)
(CLOSEF FILE)
(SETQ CALNEEDSUPDATE NIL)
(printout PROMPTWINDOW " ... done."])
(CALYEARINRANGE
[LAMBDA (YR) (* MJD " 7-Jan-86 12:33"
"Actual range is 3/1/1700 - 2/28/2100")
(AND YR (ILESSP YR 2100)
(IGREATERP YR 1700])
(CIRCLETODAY
[LAMBDA (M YR) (* MD "12-Nov-84 11:50")
(COND
([AND (EQ M (LISPDATEMONTH (DATE)))
(EQ YR (LISPDATEYEAR (DATE)))
(NEQ CALCIRCLEDAY (LISPDATEDAY (DATE]
(DSPOPERATION (QUOTE INVERT)
CALMONTHSTREAM)
(AND CALCIRCLEDAY (EQ CALCIRCLEMONTH (LISPDATEMONTH (DATE)))
(DRAWCIRCLE (IPLUS (CAR (MDMENUITEMREGION CALCIRCLEDAY CALMONTHMENU))
18)
(IPLUS (CADR (MDMENUITEMREGION CALCIRCLEDAY CALMONTHMENU))
20)
24 1 NIL CALMONTHSTREAM))
(DRAWCIRCLE (IPLUS (CAR (MDMENUITEMREGION (LISPDATEDAY (DATE))
CALMONTHMENU))
18)
(IPLUS (CADR (MDMENUITEMREGION (LISPDATEDAY (DATE))
CALMONTHMENU))
20)
24 1 NIL CALMONTHSTREAM)
(DSPOPERATION (QUOTE REPLACE)
CALMONTHSTREAM)
(SETQ CALCIRCLEDAY (LISPDATEDAY (DATE)))
(SETQ CALCIRCLEMONTH (LISPDATEMONTH (DATE])
(DAYNAME
[LAMBDA (D) (* MD " 2-Feb-84 17:15")
(CAR (NTH (QUOTE (Sunday Monday Tuesday Wednesday Thursday Friday Saturday % ))
(ADD1 D])
(DAYOF
[LAMBDA (M D Y) (* MD " 2-Feb-84 15:39")
(PROG (N)
(SETQ N (FQUOTIENT (IDIFFERENCE (IPLUS [FIX (FTIMES 365.25 (COND
((IGREATERP M 2)
Y)
(T (SUB1 Y]
[FIX (FTIMES 30.6 (COND
((IGREATERP M 2)
(ADD1 M))
(T (IPLUS M 13]
D)
621049)
7))
(RETURN (FIX (FPLUS (FTIMES (FDIFFERENCE N (FIX N))
7)
.5])
(DAYSIN
[LAMBDA (M Y) (* MD " 2-Feb-84 17:03")
(COND
((EQ M 2)
(COND
((EQ (IREMAINDER Y 4)
0)
29)
(T 28)))
(T (CAR (NTH (QUOTE (31 NIL 31 30 31 30 31 31 30 31 30 31))
M])
(LISPDATEDAY
[LAMBDA (LD) (* MD " 5-Mar-84 13:54")
(SUBATOM LD (COND
((STREQUAL (SUBSTRING LD 1 1)
" ")
2)
(T 1))
2])
(LISPDATEMONTH
[LAMBDA (LD) (* MD "14-Feb-84 15:56")
(MONTHNUM (SUBATOM LD 4 6])
(LISPDATEYEAR
[LAMBDA (LD) (* MD "12-Oct-84 14:18")
(if (EQ (SUBATOM LD 10 10)
(QUOTE % ))
then (IPLUS 1900 (SUBATOM LD 8 9))
else (SUBATOM LD 8 11])
(MAKEDAYTITLE
[LAMBDA (M D YR) (* MD " 6-Feb-85 11:26")
(MOVETOUPPERLEFT CALDAYSTREAM)
(DSPYPOSITION (IDIFFERENCE (DSPYPOSITION NIL CALDAYSTREAM)
3)
CALDAYSTREAM)
(printout CALDAYSTREAM .FONT BIGFONT (DAYNAME (DAYOF M D YR))
", "
(MONTHNAME M)
, D ", " YR .FONT DEFAULTFONT T T)
(DSPYPOSITION (IPLUS (DSPYPOSITION NIL CALDAYSTREAM)
1)
CALDAYSTREAM])
(MDMENUITEMREGION
[LAMBDA (ITEM MNAME SCALE) (* MJD "12-Feb-86 16:00")
(for I in (fetch ITEMS of MNAME) until (EQ ITEM (CAR I)) do NIL
finally (RETURN (if SCALE
then (for J in (MENUITEMREGION I MNAME)
collect (TIMES J SCALE))
else (MENUITEMREGION I MNAME])
(MONTHABBR
[LAMBDA (M) (* MD "15-Feb-84 12:19")
(CAR (NTH (QUOTE (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))
M])
(MONTHNAME
[LAMBDA (M) (* MD " 6-Feb-84 15:25")
(CAR (NTH (QUOTE (% January February % % March % % April % % % May % % June % % July % August
September % October November December))
M])
(MONTHNUM
[LAMBDA (MNAME) (* MD "14-Feb-84 16:01")
(LISTGET (QUOTE (Jan 1 Feb 2 Mar 3 Apr 4 May 5 Jun 6 Jul 7 Aug 8 Sep 9 Oct 10 Nov 11 Dec 12))
MNAME])
(MONTHPLUS
[LAMBDA (M N) (* MD "19-Oct-84 13:57")
(COND
((ILEQ (IPLUS M N)
0)
(IPLUS M N 12))
((AND (EQ M 12)
(IGREATERP N 0))
1)
(T (IREMAINDER (IPLUS M N)
13])
(MONTHYEARPLUS
[LAMBDA (M YR N) (* MD " 5-Nov-84 14:48")
(IPLUS YR (IQUOTIENT (IPLUS M N)
13)
(if (ILEQ (IPLUS M N)
0)
then -1
else 0])
(PACKDATE
[LAMBDA (MTIME M D YR) (* MJD " 6-Feb-86 17:49")
(* Takes a time, M, D, and YR, and packs them into a
formatted date which is returned.)
(*
"If MTIME = 0, this is an untimed, so change its time to 12:01:00 and its year to 2034.")
(if (EQ MTIME 0)
then (CONCAT (if (IGEQ D 10)
then D
else (CONCAT " " D))
"-"
(MONTHABBR M)
"-" "2034 12:01:00")
else (CONCAT (if (IGEQ D 10)
then D
else (CONCAT " " D))
"-"
(MONTHABBR M)
"-"
(if (IGREATERP YR 1999)
then YR
else (IDIFFERENCE YR 1900))
" " MTIME])
(PARSETIME
[LAMBDA (TSTRING) (* MJD "22-Oct-85 12:06")
(COND
([AND TSTRING
(NOT (NUMBERP (PACK (LDIFFERENCE (UNPACK TSTRING)
(QUOTE (%. : - % A P M a p m]
NIL)
[TSTRING (IPLUS (ITIMES [PACK (LDIFFERENCE (UNPACK TSTRING)
(QUOTE (%. : - % A P M a p m]
(COND
([OR (AND (NUMBERP (MKATOM TSTRING))
(ILEQ (MKATOM TSTRING)
24))
(AND (NOT (NUMBERP (MKATOM TSTRING)))
(NOT (MEMBER (QUOTE :)
(UNPACK TSTRING]
100)
(T 1)))
(COND
((STRPOS "P" TSTRING 1)
1200)
((STRPOS "p" TSTRING 1)
1200)
(T 0]
(T 0])
(POM
[LAMBDA (M D YR) (* MD " 4-Apr-84 13:38")
(PROG [GOLDEN CENTURY GREGCORRECTION CLAVCORRECTION EXTRADAYS EPACT SECSFROMNEWTHISYEAR
SECSTHISMOON DAYINYEAR (SECSPERMIN 60)
SECSPERHR SECSPERDAY SECSPERMOON
(MONTHTABLE (QUOTE (0 31 60 91 121 152 182 213 244 274 305 335 366]
(SETQ SECSPERHR (ITIMES SECSPERMIN 60))
(SETQ SECSPERDAY (ITIMES SECSPERHR 24))
(SETQ SECSPERMOON (IPLUS (ITIMES SECSPERDAY 29)
(ITIMES SECSPERHR 12)
(ITIMES SECSPERMIN 44)
3))
(SETQ GOLDEN (ADD1 (IREMAINDER YR 19)))
(SETQ CENTURY (ADD1 (IQUOTIENT YR 100)))
(SETQ GREGCORRECTION (IDIFFERENCE (IQUOTIENT (ITIMES 3 CENTURY)
4)
12))
(SETQ CLAVCORRECTION (IQUOTIENT (IDIFFERENCE (IDIFFERENCE CENTURY 16)
(IQUOTIENT (IDIFFERENCE CENTURY 18)
25))
3))
(SETQ EXTRADAYS (IDIFFERENCE (IDIFFERENCE (IQUOTIENT (ITIMES 5 YR)
4)
GREGCORRECTION)
10))
(SETQ EPACT (ADD1 (IREMAINDER (IPLUS (ITIMES 11 GOLDEN)
19 CLAVCORRECTION (IMINUS GREGCORRECTION))
30)))
(COND
((OR (AND (EQ EPACT 25)
(IGREATERP GOLDEN 11))
(EQ EPACT 24))
(add EPACT 1)))
(SETQ DAYINYEAR (IPLUS (CAR (NTH MONTHTABLE M))
D))
[COND
((IGREATERP M 2)
(COND
((EQ (IREMAINDER YR 4)
0)
(COND
[(NEQ (IREMAINDER YR 100)
0)
(COND
((EQ (IREMAINDER YR 400)
0)
(add DAYINYEAR 1]
(T (add DAYINYEAR 1]
(SETQ SECSFROMNEWTHISYEAR (IPLUS (ITIMES DAYINYEAR SECSPERDAY)
(ITIMES EPACT SECSPERDAY)))
(SETQ SECSTHISMOON (IREMAINDER SECSFROMNEWTHISYEAR SECSPERMOON))
(RETURN (IQUOTIENT SECSTHISMOON (IQUOTIENT SECSPERMOON 8])
(POMDAYS
[LAMBDA (M YR) (* MD " 4-Apr-84 15:34")
(* PLIST is list of phase of each day.
Then return list of first days of phases NM, FQ, Full,
LQ in that order.)
(PROG (PLIST)
(SETQ PLIST (for D from 1 to (DAYSIN M YR) collect (POM M D YR)))
(RETURN (for D in (QUOTE (0 2 4 6))
collect (COND
[(EQ D (CAR PLIST))
(ADD1 (IDIFFERENCE (DAYSIN M YR)
(COUNT (MEMBER (CAR PLIST)
(NLEFT PLIST 15]
(T (ADD1 (IDIFFERENCE (DAYSIN M YR)
(COUNT (MEMBER D PLIST])
(PRINTMONTH
[LAMBDA NIL (* MJD "12-Feb-86 17:42")
(PROG ((CALPSCALE 190)
(M CALCURMONTH)
(YR CALCURYEAR)
SAVEBIGFONT SAVECALFONT)
(SETCURSOR WAITINGCURSOR)
(PRINTOUT PROMPTWINDOW T "Formatting for print...")
[SETQ CALPRINTSTREAM (OPENIMAGESTREAM (QUOTE {LPT}.CAL)
(QUOTE INTERPRESS)
(QUOTE (LANDSCAPE T]
[OR PBIGFONT (SETQ PBIGFONT (FONTCREATE (QUOTE HELVETICA)
14 NIL 90 (QUOTE INTERPRESS]
[OR PCALFONT (SETQ PCALFONT (FONTCREATE (QUOTE TIMESROMAN)
24 NIL 90 (QUOTE INTERPRESS]
[OR PLITTLEFONT (SETQ PLITTLEFONT (FONTCREATE (QUOTE HELVETICA)
8 NIL 90 (QUOTE INTERPRESS]
(DSPFONT PCALFONT CALPRINTSTREAM)
[PROG (X Y CT)
(SETQ CT 0)
(DSPRESET CALPRINTSTREAM)
(MOVETO 9500 20400 CALPRINTSTREAM)
(PRIN1 (MONTHNAME M)
CALPRINTSTREAM)
(PRIN1 " " CALPRINTSTREAM)
(PRIN1 YR CALPRINTSTREAM)
(SETQ X 550)
(SETQ Y 16700)
(for I in (APPEND (for N from 1 to (DAYOF M 1 YR)
collect (QUOTE % ))
(for N from 1 to (DAYSIN M YR) collect N))
do (MOVETO X Y CALPRINTSTREAM)
(PRIN1 I CALPRINTSTREAM)
(add X 3750)
(add CT 1)
(COND
((EQ (IREMAINDER CT 7)
0)
(SETQ X 600)
(add Y -3166]
(for X from 300 to 26800 by 3750 do (DRAWLINE X 600 X 19600 40 (QUOTE
PAINT)
CALPRINTSTREAM))
(* Print vertical lines)
(DSPFONT PBIGFONT CALPRINTSTREAM)
(for X from 800 to 25600 by 3750 as D from 0 to 6
do (MOVETO X 19800 CALPRINTSTREAM)
(PRIN1 (DAYNAME D)
CALPRINTSTREAM)) (* Print day names)
(for Y from 600 to 19600 by 3166 do (DRAWLINE 300 Y 26550 Y 40 (QUOTE
PAINT)
CALPRINTSTREAM))
(* Print horizontal lines)
(SHOWMOON M YR 32.0 CALPRINTSTREAM)
(DSPFONT PLITTLEFONT CALPRINTSTREAM)
(SHOWMONTHSMALL (MONTHPLUS M -1)
(MONTHYEARPLUS M YR -1)
19300 950 28.0 CALPRINTSTREAM)
(SHOWMONTHSMALL (MONTHPLUS M 1)
(MONTHYEARPLUS M YR 1)
23100 950 28.0 CALPRINTSTREAM)
(SHOWREMSINMONTH M YR 31.0 CALPRINTSTREAM)
(CLOSEF CALPRINTSTREAM)
(PRINTOUT PROMPTWINDOW "done." T)
(CURSOR T])
(REMDT
[LAMBDA (R) (* MD "24-May-85 16:54")
(IPLUS [PACK (LDIFFERENCE (UNPACK (REMINDERTIME R))
(QUOTE (:]
(ITIMES (LISPDATEDAY (REMINDER.NEXTREMINDDATE R))
4096])
(REMINDERDAYLT
[LAMBDA (R1 R2) (* MD "24-May-85 16:55")
(ILEQ (REMDT R1)
(REMDT R2])
(REMINDERSOF
[LAMBDA (M D YR) (* edited: "20-Feb-86 11:40")
(INTERSECTION (GETHASH (CALMAKEKEY M D)
CALHASH)
(ACTIVEREMINDERNAMES])
(REMINDERTIME
[LAMBDA (R) (* MJD " 7-Feb-86 12:17")
(* For a timed-delete, return time of its
REMINDER.NEXTREMINDDATE; for a timed-saved or untimed,
return time of its REMINDER.EXPIRATIONDATE)
(* Timed-saves and untimed's have EXPIRATIONDATE years
of 2034; Timed's have NEXTREMINDDATE's of "now"
Timed-saves have times of 00:00:00, untimed's have
times of 12:01:00)
(if (EQ (LISPDATEYEAR (REMINDER.EXPIRATIONDATE R))
2034)
then (* It's a timed-save or an untimed)
(if (STRPOS "12:01" (REMINDER.EXPIRATIONDATE R))
then 0
else (SUBATOM (REMINDER.EXPIRATIONDATE R)
13 17))
else (SUBATOM (REMINDER.NEXTREMINDDATE R)
11 15])
(REMINDERTIMELT
[LAMBDA (R1 R2) (* MD " 6-Sep-84 11:16")
(ILESSP (PARSETIME (REMINDERTIME R1))
(PARSETIME (REMINDERTIME R2])
(REMSINMONTH
[LAMBDA (M YR) (* edited: "19-Feb-86 17:30")
(for D to (DAYSIN M YR) collect (REMINDERSOF M D YR])
(REPAINTMONTH
[LAMBDA (X Y) (* MJD "17-Feb-86 16:03")
(DSPCLIPPINGREGION (CREATEREGION 0 0 (WINDOWPROP CALMONTHWINDOW (QUOTE WIDTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE HEIGHT)))
CALMONTHSTREAM)
(SHOWMONTH (LIST NIL CALCURMONTH CALCURYEAR])
(REPAINTYEAR
[LAMBDA (X Y) (* MJD "17-Feb-86 16:02")
(DSPCLIPPINGREGION (CREATEREGION 0 0 (WINDOWPROP CALYEARWINDOW (QUOTE WIDTH))
(WINDOWPROP CALYEARWINDOW (QUOTE HEIGHT)))
CALYEARSTREAM)
(SHOWYEAR (LIST CALCURYEAR])
(SAMEDAYAS
[LAMBDA (LD M D YR) (* MD "12-Oct-84 14:23")
(COND
((AND (EQ (LISPDATEDAY LD)
D)
(EQ (LISPDATEMONTH LD)
M)
(OR (EQ (LISPDATEYEAR LD)
YR)
(EQ (LISPDATEYEAR LD)
2034)))
T)
(T NIL])
(SAMEMONTHAS
[LAMBDA (LD M YR) (* MD "10-May-85 10:50")
(AND (EQ (LISPDATEMONTH LD)
M)
(OR (EQ (LISPDATEYEAR LD)
YR)
(EQ (LISPDATEYEAR LD)
2034])
(SHOWDAY
[LAMBDA (ITEM MENUNAME BUTTON) (* MJD "28-Feb-86 12:53")
(PROG ((D (CAR ITEM))
(M (CADR ITEM))
(YR (CADDR ITEM)))
(COND
((NOT M)
(printout PROMPTWINDOW T
"Selecting a day in this month with Left will give you a Day Window.")
(RETURN NIL))
((NOT (CALYEARINRANGE YR))
(RETURN NIL))
((EQ BUTTON (QUOTE RIGHT))
(GETMOUSESTATE)
(if (INSIDEP (CREATEREGION 0 0 (WINDOWPROP CALMONTHWINDOW (QUOTE WIDTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE HEIGHT)))
(LASTMOUSEX CALMONTHSTREAM)
(LASTMOUSEY CALMONTHSTREAM))
then (CALEXTENDSEL)
else (DOWINDOWCOM CALMONTHWINDOW))
(RETURN NIL))
((EQ (CAR (LAST ITEM))
(QUOTE PREV))
(SHOWMONTH (LIST NIL (MONTHPLUS M -1)
(MONTHYEARPLUS M YR -1)))
(RETURN NIL))
((EQ (CAR (LAST ITEM))
(QUOTE NEXT))
(SHOWMONTH (LIST NIL (MONTHPLUS M 1)
(MONTHYEARPLUS M YR 1)))
(RETURN NIL)))
(if (AND CALMONTHWINDOW (EQ M CALCURMONTH))
then (SHOWREMSINDAY M D YR)) (* Only write in month window if it exists, and is
month of this day)
[OR CALDAYWINDOW
(PROG1 (SETQ CALDAYWINDOW
(CREATEW (create REGION
LEFT ← 48
BOTTOM ← 400
WIDTH ← 350
HEIGHT ← 16)
NIL NIL T))
(WINDOWPROP CALDAYWINDOW (QUOTE ICON)
CALDAYICON)
(WINDOWPROP CALDAYWINDOW (QUOTE RESHAPEFN)
(QUOTE NILL]
[OR CALDAYSTREAM (SETQ CALDAYSTREAM (DECODE/WINDOW/OR/DISPLAYSTREAM
CALDAYWINDOW NIL (CONCAT CALENDARVERSION " " (MKSTRING (MONTHNAME M))
" " D ", " (MKSTRING YR]
(* You need default locs in case SHOWDAY is called
programmatically w/o there being a Month window)
(SHAPEW CALDAYWINDOW (LIST (if CALMONTHMENU
then (IDIFFERENCE (CAR (MDMENUITEMREGION
D CALMONTHMENU))
(ITIMES (DAYOF M D YR)
12))
else CALDAYDEFAULTXLOC)
(IPLUS (if CALMONTHMENU
then (CADR (MDMENUITEMREGION D
CALMONTHMENU))
else CALDAYDEFAULTYLOC)
140)
350
(HEIGHTIFWINDOW
(IPLUS (ITIMES (IPLUS (LENGTH (REMINDERSOF
M D YR))
2)
12)
2)
T)))
(WINDOWPROP CALDAYWINDOW (QUOTE TITLE)
(CONCAT CALENDARVERSION " " (MKSTRING (MONTHNAME M))
" " D ", " (MKSTRING YR)))
(WYOFFSET (WYOFFSET NIL CALDAYSTREAM)
CALDAYSTREAM)
(COND
((type? MENU CALDAYMENU)
(DELETEMENU CALDAYMENU)))
(SETQ CALDAYMENU (create MENU
ITEMS ←(APPEND (LIST (LIST (QUOTE ADD)
M D YR))
(for REMINDER
in (REMINDERSOF M D YR)
collect
(LIST (if (NEQ (REMINDERTIME
REMINDER)
0)
then (REMINDERTIME
REMINDER)
else " ")
REMINDER
"Shows reminder options menu when released.")))
MENUCOLUMNS ← 1
MENUFONT ← DEFAULTFONT
MENUOUTLINESIZE ← 0
ITEMHEIGHT ← 12
ITEMWIDTH ← 36
WHENSELECTEDFN ←(QUOTE CALDISPEVENT)))
(COND
((NULL (REMINDERSOF M D YR))
(printout PROMPTWINDOW T "Calendar: Select ADD to add a new reminder.")))
(MAKEDAYTITLE M D YR)
(for REMINDER in (REMINDERSOF M D YR)
do (SPACES 6 CALDAYSTREAM)
(PRIN1 (CALREMDEF REMINDER)
CALDAYSTREAM)
(TERPRI CALDAYSTREAM))
(ADDMENU CALDAYMENU CALDAYWINDOW (QUOTE (0 . 0)))
(WINDOWPROP CALDAYWINDOW (QUOTE REPAINTFN)
NIL)
(WINDOWPROP CALDAYWINDOW (QUOTE SCROLLFN)
NIL)
(RETURN (SETQ CALCURDAY D])
(SHOWMONTH
[LAMBDA (ITEM) (* MJD "28-Feb-86 14:58")
(PROG ((M (CADR ITEM))
(YR (CAR (LAST ITEM)))
MLOC)
(if (NOT (CALYEARINRANGE YR))
then (RETURN NIL))
[CLEARW (OR CALMONTHWINDOW
(PROG1 [SETQ CALMONTHWINDOW
(CREATEW (PROGN (SETQ MLOC
(GETBOXPOSITION 868 700 NIL NIL NIL
"Please position the Month Window."))
(create REGION
LEFT ←(CAR MLOC)
BOTTOM ←(CDR MLOC)
WIDTH ← 868
HEIGHT ← 700]
(WINDOWPROP CALMONTHWINDOW (QUOTE HARDCOPYFN)
(QUOTE PRINTMONTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE SHRINKFN)
(QUOTE SHRINKMONTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE ICON)
CALMONTHICON)
(WINDOWPROP CALMONTHWINDOW (QUOTE TOTOPFN)
(QUOTE CIRCLETODAY))
(WINDOWPROP CALMONTHWINDOW (QUOTE RIGHTBUTTONFN)
(QUOTE CALMONTHRBF))
(WINDOWPROP CALMONTHWINDOW (QUOTE PROCESS)
CALDUMMYPROC]
[OR CALMONTHSTREAM (SETQ CALMONTHSTREAM (DECODE/WINDOW/OR/DISPLAYSTREAM
CALMONTHWINDOW NIL (CONCAT CALENDARVERSION " " (MKSTRING (MONTHNAME
M))
" "
(MKSTRING YR]
(WINDOWPROP CALMONTHWINDOW (QUOTE TITLE)
(CONCAT CALENDARVERSION " " (MKSTRING (MONTHNAME M))
" "
(MKSTRING YR)))
(SETCURSOR WAITINGCURSOR)
(DSPFONT BIGFONT CALMONTHWINDOW)
(COND
((type? MENU CALMONTHMENU)
(DELETEMENU CALMONTHMENU)))
(SETQ CALMONTHMENU (create MENU
ITEMS ←[APPEND (for I from 1
to (DAYOF M 1 YR)
collect (LIST (QUOTE % )))
(for I from 1
to (DAYSIN M YR)
collect (LIST I M YR))
(for I from 1
to (IDIFFERENCE
40
(IPLUS (DAYOF M 1 YR)
(DAYSIN M YR)))
collect (LIST (QUOTE % )))
(LIST (LIST (QUOTE % )
M YR (QUOTE PREV)))
(LIST (LIST (QUOTE % )
M YR (QUOTE NEXT]
MENUCOLUMNS ← 7
MENUFONT ← CALFONT
ITEMHEIGHT ← 100
ITEMWIDTH ← 120
WHENSELECTEDFN ←(QUOTE SHOWDAY)))
(ADDMENU CALMONTHMENU CALMONTHWINDOW (QUOTE (10 . 10)))
(WINDOWPROP CALMONTHWINDOW (QUOTE RESHAPEFN)
(QUOTE DON'T))
(WINDOWPROP CALMONTHWINDOW (QUOTE REPAINTFN)
(QUOTE REPAINTMONTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE BUTTONEVENTFN)
(QUOTE CALMONTHBEF))
(for X from 10 to 900 by 120 do (DRAWLINE X 10 X 610 1 (QUOTE REPLACE)
CALMONTHWINDOW))
(for X from 10 to 900 by 120 as D from 0 to 6
do (MOVETO (IPLUS X 24)
620 CALMONTHSTREAM)
(PRIN1 (DAYNAME D)
CALMONTHSTREAM))
(for Y from 10 to 700 by 100 do (DRAWLINE 10 Y 850 Y 1 (QUOTE REPLACE)
CALMONTHWINDOW))
(SHOWMOON M YR 1 CALMONTHWINDOW)
(DSPFONT LITTLEFONT CALMONTHWINDOW)
(SHOWREMSINMONTH M YR 1 CALMONTHSTREAM)
(SHOWMONTHSMALL (MONTHPLUS M -1)
(MONTHYEARPLUS M YR -1)
616 18 1 CALMONTHWINDOW)
(SHOWMONTHSMALL (MONTHPLUS M 1)
(MONTHYEARPLUS M YR 1)
736 18 1 CALMONTHWINDOW)
(DSPFONT CALFONT CALMONTHWINDOW)
(MOVETO 250 650 CALMONTHSTREAM)
(PRIN1 (MONTHNAME M)
CALMONTHSTREAM)
(PRIN1 " " CALMONTHSTREAM)
(PRIN1 YR CALMONTHSTREAM)
(CIRCLETODAY M YR)
(SETQ CALCURMONTH M)
(SETQ CALCURYEAR YR)
(CURSOR T)
(RETURN M])
(SHOWMONTHSMALL
[LAMBDA (M YR XLOC YLOC SCALE WINDOW) (* MJD " 6-Feb-86 12:41")
(PROG (X Y CT)
(SETQ CT 0)
(SETQ X XLOC)
(SETQ Y (IPLUS YLOC (TIMES 60 SCALE)))
(MOVETO (IPLUS X (TIMES SCALE 24))
(IPLUS Y (TIMES SCALE 12))
WINDOW)
(PRIN1 (MONTHNAME M)
WINDOW)
(for I in (APPEND (for N from 1 to (DAYOF M 1 YR) collect (QUOTE % ))
(for N from 1 to (DAYSIN M YR) collect N))
do (MOVETO X Y WINDOW)
(PRIN1 I WINDOW)
(add X (TIMES SCALE 16))
(add CT 1)
(COND
((EQ (IREMAINDER CT 7)
0)
(SETQ X XLOC)
(add Y (TIMES SCALE -10])
(SHOWMOON
[LAMBDA (M YR SCALE STREAM) (* MJD "12-Feb-86 17:25")
(for P in (POMDAYS M YR) as PMAP in [COND
((VIDEOCOLOR)
(QUOTE (NMMAP FQMAP FMMAP LQMAP)))
(T (QUOTE (FMMAP LQMAP NMMAP FQMAP]
do (BITBLT (EVAL PMAP)
NIL NIL STREAM (IPLUS (CAR (MDMENUITEMREGION P CALMONTHMENU SCALE))
(TIMES 2 SCALE))
(IPLUS (CADR (MDMENUITEMREGION P CALMONTHMENU SCALE))
(TIMES 52 SCALE))
34 34 (QUOTE INPUT)
(QUOTE INVERT])
(SHOWREMSINDAY
[LAMBDA (M D YR) (* MJD "28-Feb-86 13:38")
(* This code is similar to SHOWREMSINMONTH except that it is optimized for picking out the reminders for only one
particular day, rather than all reminders in a month.)
(BITBLT NIL NIL NIL CALMONTHWINDOW (IPLUS (CAR (MDMENUITEMREGION D CALMONTHMENU))
37)
(CADR (MDMENUITEMREGION D CALMONTHMENU))
81 98 (QUOTE TEXTURE)
(QUOTE ERASE)
BLACKSHADE)
(DSPFONT LITTLEFONT CALMONTHWINDOW)
(MOVETOUPPERLEFT CALMONTHSTREAM (MDMENUITEMREGION D CALMONTHMENU))
(DSPYPOSITION (IDIFFERENCE (DSPYPOSITION NIL CALMONTHSTREAM)
3)
CALMONTHSTREAM)
(SETQ DAYREGION (MDMENUITEMREGION D CALMONTHMENU))
(change (CADDR DAYREGION)
(IDIFFERENCE (CADDR DAYREGION)
2))
(DSPCLIPPINGREGION DAYREGION CALMONTHSTREAM)
(for REMINDER in (REMINDERSOF M D YR)
do (DSPXPOSITION (IPLUS (CAR (MDMENUITEMREGION D CALMONTHMENU))
36)
CALMONTHSTREAM)
(CALPRINTREM REMINDER CALMONTHSTREAM))
(DSPCLIPPINGREGION (CREATEREGION 0 0 (WINDOWPROP CALMONTHWINDOW (QUOTE WIDTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE HEIGHT)))
CALMONTHSTREAM])
(SHOWREMSINMONTH
[LAMBDA (M YR SCALE STREAM) (* MJD "28-Feb-86 13:13")
(PROG (D REMLIST DAYREGION)
(SETQ REMLIST (REMSINMONTH M YR))
(for REMINDER in REMLIST as D from 1 to (DAYSIN M YR)
do (SETQ DAYREGION (MDMENUITEMREGION D CALMONTHMENU SCALE))
(MOVETOUPPERLEFT STREAM DAYREGION)
(DSPYPOSITION (IDIFFERENCE (DSPYPOSITION NIL STREAM)
(TIMES 3 SCALE))
STREAM)
(change (CADDR DAYREGION)
(IDIFFERENCE (CADDR DAYREGION)
(TIMES 2 SCALE)))
(DSPCLIPPINGREGION DAYREGION STREAM)
(for R in REMINDER
do (DSPXPOSITION (IPLUS (CAR (MDMENUITEMREGION D CALMONTHMENU SCALE))
(TIMES 36 SCALE))
STREAM)
(CALPRINTREM R STREAM)))
(if (EQ (IMAGESTREAMTYPE STREAM)
(QUOTE DISPLAY))
then (DSPCLIPPINGREGION (CREATEREGION 0 0 (WINDOWPROP CALMONTHWINDOW
(QUOTE WIDTH))
(WINDOWPROP CALMONTHWINDOW
(QUOTE HEIGHT)))
STREAM])
(SHOWYEAR
[LAMBDA (ITEM) (* MJD "17-Feb-86 16:59")
(PROG (YR MLOC)
(SETQ YR (CAR ITEM))
[if (EQ YR (QUOTE Other))
then (TERPRI PROMPTWINDOW)
(SETQ YR (MKATOM (PROMPTFORWORD "Year: " NIL NIL PROMPTWINDOW NIL NIL
(CHARCODE EOL]
(COND
((CALYEARINRANGE YR)
[CLEARW (OR CALYEARWINDOW (PROG1 [SETQ CALYEARWINDOW
(PROGN (SETQ MLOC
(GETBOXPOSITION 364 324 NIL NIL
NIL
"Position the Year Window."))
(CREATEW (create REGION
LEFT ←(CAR
MLOC)
BOTTOM ←(CDR
MLOC)
WIDTH ← 364
HEIGHT ← 324)
(CONCAT
CALENDARVERSION
" "
(MKSTRING
YR]
(WINDOWPROP CALYEARWINDOW (QUOTE ICON)
CALYEARICON)
(* WINDOWPROP CALYEARWINDOW
(QUOTE SHRINKFN) (QUOTE SHRINKYEAR))
(ATTACHMENU CALMAINMENU CALYEARWINDOW
(QUOTE RIGHT)
(QUOTE TOP]
[OR CALYEARSTREAM (SETQ CALYEARSTREAM (DECODE/WINDOW/OR/DISPLAYSTREAM
CALYEARWINDOW NIL (CONCAT CALENDARVERSION " " (MKSTRING YR]
(WINDOWPROP CALYEARWINDOW (QUOTE TITLE)
(CONCAT CALENDARVERSION " " (MKSTRING YR)))
(COND
((type? MENU CALYEARMENU)
(DELETEMENU CALYEARMENU)))
(SETQ CALYEARMENU (create MENU
ITEMS ←(for I from 1 to 12
collect (LIST (QUOTE % )
I YR))
MENUCOLUMNS ← 3
MENUFONT ← CALFONT
ITEMHEIGHT ← 76
ITEMWIDTH ← 118
WHENSELECTEDFN ←(QUOTE SHOWMONTH)))
(ADDMENU CALYEARMENU CALYEARWINDOW (QUOTE (0 . 0)))
(WINDOWPROP CALYEARWINDOW (QUOTE RESHAPEFN)
(QUOTE DON'T))
(WINDOWPROP CALYEARWINDOW (QUOTE REPAINTFN)
(QUOTE REPAINTYEAR))
(DSPFONT DEFAULTFONT CALYEARWINDOW)
(MOVETO 157 294 CALYEARSTREAM)
(PRIN1 YR CALYEARSTREAM)
(DSPFONT LITTLEFONT CALYEARWINDOW)
(for Y from 0 to 3 do (for X from 0 to 2
do (SHOWMONTHSMALL (IPLUS (ADD1 X)
(ITIMES Y 3))
YR
(IPLUS (ITIMES X 120)
4)
(ITIMES (IDIFFERENCE
3 Y)
70)
1 CALYEARWINDOW)))
(SETQ CALCURYEAR YR))
(T (printout PROMPTWINDOW T "Sorry - I can only handle years between 1700 and 2100."])
(SHRINKMONTH
[LAMBDA (X) (* MJD "19-Feb-86 11:03")
(AND CALUPDATEONSHRINKFLG CALNEEDSUPDATE (CALUPDATEFILE))
(OR (WINDOWPROP CALMONTHWINDOW (QUOTE ICONPOSITION))
(WINDOWPROP CALMONTHWINDOW (QUOTE ICONPOSITION)
(GETBOXPOSITION (BITMAPWIDTH CALMONTHICON)
(BITMAPHEIGHT CALMONTHICON])
(SHRINKYEAR
[LAMBDA (X) (* MJD "17-Feb-86 16:45")
(OR (WINDOWPROP CALYEARWINDOW (QUOTE ICONPOSITION))
(WINDOWPROP CALYEARWINDOW (QUOTE ICONPOSITION)
(GETBOXPOSITION (BITMAPWIDTH CALYEARICON)
(BITMAPHEIGHT CALYEARICON])
(STOREREMS
[LAMBDA NIL (* edited: "20-Feb-86 11:41")
(CLRHASH CALHASH)
(for R in (ACTIVEREMINDERNAMES)
do (PUTHASH (CALMAKEKEY (LISPDATEMONTH (REMINDER.NEXTREMINDDATE R))
(LISPDATEDAY (REMINDER.NEXTREMINDDATE R)))
(SORT (NCONC1 (GETHASH (CALMAKEKEY (LISPDATEMONTH (
REMINDER.NEXTREMINDDATE
R))
(LISPDATEDAY (
REMINDER.NEXTREMINDDATE
R)))
CALHASH)
R)
(QUOTE REMINDERTIMELT))
CALHASH))
(DMPHASH CALHASH])
(YEAROF
[LAMBDA (MONTHWINDOW) (* MD " 5-Dec-84 14:03")
(SUBATOM (WINDOWPROP MONTHWINDOW (QUOTE TITLE))
-4 -1])
)
(RPAQ CALDAYICON (READBITMAP))
(64 64
"OOOOOOOOOOOOOOOO"
"OANOGLCGFAOGHOOO"
"NOMGGMOCGFNKKGOO"
"NOKKGLGCGFMMKGOO"
"NOHCGMOEGFLAHOOO"
"NOKKGMOEGFMMJGOO"
"OAKK@LCFFAMMKGOO"
"OOOOOOOOOOOOOOOO"
"H@@@@@@@@@@@@@@A"
"HOOOOOOOOOOO@@@A"
"HOOOOOOOOOOOH@@A"
"HOOOOOOOOOOOL@@A"
"HOOOOOOOOOOON@@A"
"HMOOOOOOOOOOO@@A"
"HMOOOOOOOOOOOH@A"
"HMGOOOOOOOOOOL@A"
"HMD@@@@@@@@@@L@A"
"HMD@AL@@@CH@@D@A"
"HMD@CN@@@GL@@D@A"
"HMD@CN@@@GL@@D@A"
"HMD@CN@@@GL@@D@A"
"HMD@AL@@@CH@@D@A"
"HMD@@@@@@@@@@D@A"
"HMD@@@@@@@@@@D@A"
"HMD@@@@@@@@@@D@A"
"HMD@@@@B@AH@CD@A"
"HMEOL@@G@AL@CD@A"
"HMEON@@MH@L@FD@A"
"HMDFG@AHL@F@FD@A"
"HMDFCHC@F@F@LD@A"
"HMDFAHB@F@CAHD@A"
"HMDFAHF@C@CAHD@A"
"HMDFAHL@CHAK@D@A"
"HMDFAHL@AH@O@D@A"
"HMDFAHL@AH@N@D@A"
"HMDFAHL@AH@F@D@A"
"HMDFAHL@AH@F@D@A"
"HMDFAHOOOH@F@D@A"
"HMDFAHOOOH@F@D@A"
"HMDFAHOOOH@F@D@A"
"HMDFAHL@AH@F@D@A"
"HMDFAHL@AH@F@D@A"
"HMDFAHL@AH@F@D@A"
"HMDFCHL@AH@F@D@A"
"HMEOO@L@AH@F@D@A"
"HMEOL@L@AH@F@D@A"
"HMD@@@@@@@@@@D@A"
"HMD@@@@@@@@@@F@A"
"HMD@@@@@@@@@@B@A"
"HMD@@@@@@@@@@C@A"
"HMD@@@@@@@@@@AHA"
"HMD@@@@@@@@@@@LA"
"HMB@@@@@@@@@@@FA"
"HMA@@@@@@@@@@@LA"
"HMA@@@@@@@@@@AHA"
"HM@H@@@@@@@@@C@A"
"HM@L@@@@@@@@ON@A"
"HE@GOOOOOOOO@D@A"
"HG@@@@@@@@@@@D@A"
"HC@@@@@@@@@@@D@A"
"HAOOOOOOOOOOOL@A"
"H@@@@@@@@@@@@@@A"
"H@@@@@@@@@@@@@@A"
"OOOOOOOOOOOOOOOO")
(RPAQ CALMONTHICON (READBITMAP))
(64 64
"OOOOOOOOOOOOOOOO"
"OANOGLCGFAOGHOOO"
"NOMGGMOCGFNKKGOO"
"NOKKGLGCGFMMKGOO"
"NOHCGMOEGFLAHOOO"
"NOKKGMOEGFMMJGOO"
"OAKK@LCFFAMMKGOO"
"OOOOOOOOOOOOOOOO"
"H@@@@@@@@@@@@@@A"
"H@@@DDOBDOIB@@@A"
"H@@@FLICDBAB@@@A"
"H@@@EDIBLBAN@@@A"
"H@@@EDIBDBAB@@@A"
"H@@@DDOBDBAB@@@A"
"H@@@@@@@@@@@@@@A"
"OOOOOOOOOOOOOOOO"
"OOOOOOOOOOOOOOOO"
"H@@@@@@@@@@@@@@A"
"HG@HHOHDDCN@O@NA"
"HD@MHB@ED@H@H@HA"
"HG@JHB@ED@H@N@NA"
"HA@JHB@CH@H@H@BA"
"HG@HHB@BH@H@H@NA"
"H@@@@@@@@@@@@@@A"
"OOOOOOOOOOOOOOOO"
"H@D@B@A@@H@D@B@A"
"H@D@B@AB@KHELBJA"
"H@D@B@AB@HHDDBJA"
"H@D@B@AB@IHELBOA"
"H@D@B@AB@J@DDBBA"
"H@D@B@AB@KHELBBA"
"H@D@B@A@@H@D@B@A"
"OOOOOOOOOOOOOOOO"
"H@D@B@A@@H@D@B@A"
"KHELBNAG@KHEGBJA"
"J@E@BBAE@JHEEBJA"
"KHELBBAG@KHEEBJA"
"HHEDBBAE@HHEEBJA"
"KHELBBAG@HHEGBJA"
"H@D@B@A@@H@D@B@A"
"OOOOOOOOOOOOOOOO"
"H@D@B@A@@H@D@B@A"
"JNEGBJIELJNEGBKI"
"JBEABJIE@JHEABJI"
"JNEGBKMELJNEABKI"
"JHEABHIDDJJEABJI"
"JNEGBHIELJNEABKI"
"H@D@B@A@@H@D@B@A"
"OOOOOOOOOOOOOOOO"
"H@D@B@A@@H@D@B@A"
"JNEKJNIFLKGEJJMM"
"JJDJJBIBDIADJJEA"
"JNEJJNIFLKGEKJMM"
"JBEBJHIDHJAE@JHE"
"JBEKJNIFLKGEHJMM"
"H@D@B@A@@H@D@B@A"
"OOOOOOOOOOOOOOOO"
"H@D@B@A@@H@D@B@A"
"KGEKJMMFNKGD@B@A"
"IDDHJEMBNIED@B@A"
"JGE@JIEDBIED@B@A"
"KGEHJMMFBKGD@B@A"
"H@D@B@A@@H@D@B@A"
"OOOOOOOOOOOOOOOO")
(RPAQ CALYEARICON (READBITMAP))
(64 64
"OOOOOOOOOOOOOOOO"
"OANOGLCGFAOGHOHA"
"NOMGGMOCGFNKKGME"
"NOKKGLGCGFMMKGME"
"NOHCGMOEGFLAHOOM"
"NOKKGMOEGFMMJGLA"
"OAKK@LCFFAMMKGMM"
"OOOOOOOOOOOOOOLA"
"H@@@@H@@@@D@@@GO"
"HCOOHHGOO@D@GN@A"
"H@@@@H@@@@D@@@@A"
"HEEEDH@BJHD@@EDA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HED@@HJJ@@DEEEDA"
"H@@@@H@@@@D@@@@A"
"OOOOOOOOOOOOOOOO"
"H@@@@H@@@@D@@@@A"
"H@OL@H@GH@D@CN@A"
"H@@@@H@@@@D@@@@A"
"HEEEDH@JJHD@@ADA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HE@@@HJJH@DEEEDA"
"H@@@@H@@@@D@@@@A"
"OOOOOOOOOOOOOOOO"
"H@@@@H@@@@D@@@@A"
"H@GL@HAON@DCOOHA"
"H@@@@H@@@@D@@@@A"
"HEEEDH@BJHD@@@DA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HED@@HJJJ@DEEEDA"
"H@@@@H@@@@D@@@@A"
"OOOOOOOOOOOOOOOO"
"H@@@@H@@@@D@@@@A"
"HCOO@HGOO@DCOOHA"
"H@@@@H@@@@D@@@@A"
"HAEEDH@@JHD@@@DA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"H@@@@H@@@@D@@@@A"
"HEEEDHJJJHDEEEDA"
"J@@@@H@@@@D@@@@A"
"KEEEDHJJJHDEEEDA"
"J@@@@H@@@@D@@@@A"
"HEE@@HJJJ@DEEEDA"
"H@@@@H@@@@D@@@@A"
"OOOOOOOOOOOOOOOO")
(RPAQ FQMAP (READBITMAP))
(34 34
"@@@GOH@@@@@@"
"@@COOO@@@@@@"
"@@OLGOL@@@@@"
"@AN@GON@@@@@"
"@GH@GOOH@@@@"
"@O@@GOOL@@@@"
"@L@@GOOL@@@@"
"AL@@GOON@@@@"
"CH@@GOOO@@@@"
"C@@@GOOO@@@@"
"G@@@GOOOH@@@"
"F@@@GOOOH@@@"
"F@@@GOOOH@@@"
"N@@@GOOOL@@@"
"L@@@GOOOL@@@"
"L@@@GOOOL@@@"
"L@@@GOOOL@@@"
"L@@@GOOOL@@@"
"L@@@GOOOL@@@"
"L@@@GOOOL@@@"
"N@@@GOOOL@@@"
"F@@@GOOOH@@@"
"F@@@GOOOH@@@"
"G@@@GOOOH@@@"
"C@@@GOOO@@@@"
"CH@@GOOO@@@@"
"AL@@GOON@@@@"
"@L@@GOOL@@@@"
"@O@@GOOL@@@@"
"@GH@GOOH@@@@"
"@AN@GON@@@@@"
"@@OLGOL@@@@@"
"@@COOO@@@@@@"
"@@@GOH@@@@@@")
(RPAQ FMMAP (READBITMAP))
(34 34
"@@@GOH@@@@@@"
"@@COOO@@@@@@"
"@@OOOOL@@@@@"
"@AOOOON@@@@@"
"@GOOOOOH@@@@"
"@OOOOOOL@@@@"
"@OOOOOOL@@@@"
"AOOOOOON@@@@"
"COOOOOOO@@@@"
"COOOOOOO@@@@"
"GOOOOOOOH@@@"
"GOOOOOOOH@@@"
"GOOOOOOOH@@@"
"OOOOOOOOL@@@"
"OOOOOOOOL@@@"
"OOOOOOOOL@@@"
"OOOOOOOOL@@@"
"OOOOOOOOL@@@"
"OOOOOOOOL@@@"
"OOOOOOOOL@@@"
"OOOOOOOOL@@@"
"GOOOOOOOH@@@"
"GOOOOOOOH@@@"
"GOOOOOOOH@@@"
"GOOOOOOO@@@@"
"COOOOOOO@@@@"
"AOOOOOON@@@@"
"@OOOOOOL@@@@"
"@OOOOOOL@@@@"
"@GOOOOOH@@@@"
"@AOOOON@@@@@"
"@@OOOOL@@@@@"
"@@COOO@@@@@@"
"@@@GOH@@@@@@")
(RPAQ LQMAP (READBITMAP))
(34 34
"@@@GOH@@@@@@"
"@@COOO@@@@@@"
"@@OOHOL@@@@@"
"@AOOHAN@@@@@"
"@GOOH@GH@@@@"
"@OOOH@CL@@@@"
"@OOOH@@L@@@@"
"AOOOH@@N@@@@"
"COOOH@@G@@@@"
"COOOH@@C@@@@"
"GOOOH@@CH@@@"
"GOOOH@@AH@@@"
"GOOOH@@AH@@@"
"OOOOH@@AL@@@"
"OOOOH@@@L@@@"
"OOOOH@@@L@@@"
"OOOOH@@@L@@@"
"OOOOH@@@L@@@"
"OOOOH@@@L@@@"
"OOOOH@@@L@@@"
"OOOOH@@AL@@@"
"GOOOH@@AH@@@"
"GOOOH@@AH@@@"
"GOOOH@@CH@@@"
"COOOH@@C@@@@"
"COOOH@@G@@@@"
"AOOOH@@N@@@@"
"@OOOH@@L@@@@"
"@OOOH@CL@@@@"
"@GOOH@GH@@@@"
"@AOOHAN@@@@@"
"@@OOHOL@@@@@"
"@@COOO@@@@@@"
"@@@GOH@@@@@@")
(RPAQ NMMAP (READBITMAP))
(34 34
"@@@GOH@@@@@@"
"@@COOO@@@@@@"
"@@OL@OL@@@@@"
"@AN@@AN@@@@@"
"@GH@@@GH@@@@"
"@O@@@@CL@@@@"
"@L@@@@@L@@@@"
"AL@@@@@N@@@@"
"CH@@@@@G@@@@"
"C@@@@@@C@@@@"
"G@@@@@@CH@@@"
"F@@@@@@AH@@@"
"F@@@@@@AH@@@"
"N@@@@@@AL@@@"
"L@@@@@@@L@@@"
"L@@@@@@@L@@@"
"L@@@@@@@L@@@"
"L@@@@@@@L@@@"
"L@@@@@@@L@@@"
"L@@@@@@@L@@@"
"N@@@@@@AL@@@"
"F@@@@@@AH@@@"
"F@@@@@@AH@@@"
"G@@@@@@CH@@@"
"C@@@@@@C@@@@"
"CH@@@@@G@@@@"
"AL@@@@@N@@@@"
"@L@@@@@L@@@@"
"@O@@@@CL@@@@"
"@GH@@@GH@@@@"
"@AN@@AN@@@@@"
"@@OL@OL@@@@@"
"@@COOO@@@@@@"
"@@@GOH@@@@@@")
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
PROMPTREMINDERS)
(PUTPROPS ALTO.TO.LISP.DATE READVICE [NIL (BEFORE FIRST (if (NOT DATE)
then
(RETURN NIL])
(READVISE ALTO.TO.LISP.DATE)
(PUTPROPS CALENDAR COPYRIGHT ("Xerox Corporation" 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3085 53461 (CALADDEVENT 3095 . 6613) (CALDISPEVENT 6615 . 9315) (CALDUMMYFN 9317 . 9448
) (CALENDAR 9450 . 12028) (CALEXTENDSEL 12030 . 12560) (CALMAKEKEY 12562 . 12716) (CALMONTHBEF 12718
. 12966) (CALMONTHRBF 12968 . 13397) (CALPRINTREM 13399 . 13895) (CALREMDEF 13897 . 14703) (CALTEST
14705 . 18703) (CALUNIQUEGENSYM 18705 . 18983) (CALUPDATEFILE 18985 . 21024) (CALYEARINRANGE 21026 .
21258) (CIRCLETODAY 21260 . 22331) (DAYNAME 22333 . 22536) (DAYOF 22538 . 23011) (DAYSIN 23013 . 23279
) (LISPDATEDAY 23281 . 23488) (LISPDATEMONTH 23490 . 23634) (LISPDATEYEAR 23636 . 23893) (MAKEDAYTITLE
23895 . 24399) (MDMENUITEMREGION 24401 . 24810) (MONTHABBR 24812 . 24999) (MONTHNAME 25001 . 25259) (
MONTHNUM 25261 . 25476) (MONTHPLUS 25478 . 25772) (MONTHYEARPLUS 25774 . 26026) (PACKDATE 26028 .
26936) (PARSETIME 26938 . 27754) (POM 27756 . 29643) (POMDAYS 29645 . 30386) (PRINTMONTH 30388 . 33231
) (REMDT 33233 . 33511) (REMINDERDAYLT 33513 . 33669) (REMINDERSOF 33671 . 33890) (REMINDERTIME 33892
. 34930) (REMINDERTIMELT 34932 . 35134) (REMSINMONTH 35136 . 35325) (REPAINTMONTH 35327 . 35670) (
REPAINTYEAR 35672 . 35994) (SAMEDAYAS 35996 . 36323) (SAMEMONTHAS 36325 . 36577) (SHOWDAY 36579 .
40885) (SHOWMONTH 40887 . 45004) (SHOWMONTHSMALL 45006 . 45831) (SHOWMOON 45833 . 46464) (
SHOWREMSINDAY 46466 . 47867) (SHOWREMSINMONTH 47869 . 49060) (SHOWYEAR 49062 . 51866) (SHRINKMONTH
51868 . 52267) (SHRINKYEAR 52269 . 52593) (STOREREMS 52595 . 53278) (YEAROF 53280 . 53459)))))
STOP