(FILECREATED "17-Jul-86 13:32:03" {ICE}<DENBER>LISP>CALENDAR.;101 61240
changes to: (VARS CALENDARCOMS)
(FNS LISPDATEDAY SHOWDAY ACTUALREMINDDATE CALCREATEREM CALEXTENDSEL CALADDEVENT
SHOWMONTH SHRINKMONTH CALMONTHRBF INVERTGROUP MENUITEM MENUREGIONITEM
CLOSEMONTH)
previous date: "13-Jun-86 15:07:20" {ICE}<DENBER>LISP>CALENDAR.;97)
(* 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)
(CALENDARVERSION "Calendar Version 1.95")
(CALMAINMENU)
(CALMONTHMENU)
(CALMONTHSTREAM)
(CALMONTHWINDOW)
(CALREMINDERS)
(CALYEARMENU)
(CALYEARSTREAM)
(CALYEARWINDOW))
(INITVARS (CALDEFAULTHOST&DIR)
(CALHASH (HARRAY 200))
(CALFONT)
(CALKEEPEXPIREDREMSFLG)
(CALMONTHICON)
(CALNEEDSUPDATE)
(CALREMSLOADED)
(CALUPDATEONSHRINKFLG)
(PBIGFONT)
(PCALFONT)
(PLITTLEFONT))
(FNS ACTUALREMINDDATE CALADDEVENT CALCREATEREM CALDISPEVENT CALENDAR CALEXTENDSEL CALMAKEKEY
CALMONTHBEF CALMONTHICONFN CALMONTHRBF CALPRINTREM CALREMDEF CALUNIQUEGENSYM
CALUPDATEFILE CALUPDATEINIT CALYEARINRANGE CIRCLETODAY CLEARDAY CLOSEMONTH DAYNAME DAYOF
DAYSIN INVERTGROUP LISPDATEDAY LISPDATEMONTH LISPDATEYEAR MAKEDAYTITLE MDMENUITEMREGION
MENUITEM MENUREGIONITEM MONTHABBR MONTHNAME MONTHNUM MONTHPLUS MONTHYEARPLUS PACKDATE
PARSETIME POM POMDAYS PR PRINTMONTH REMDT REMINDERDAYLT REMINDERSOF REMINDERTIME
REMINDERTIMELT REMSINMONTH REPAINTMONTH REPAINTYEAR SAMEDAYAS SAMEMONTHAS SHOWDAY
SHOWMONTH SHOWMONTHSMALL SHOWMOON SHOWREMSINDAY SHOWREMSINMONTH SHOWYEAR SHRINKMONTH
SHRINKYEAR STOREREMS YEAROF)
(BITMAPS CALDAYICON CALMONTHICONMAP 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)
(RPAQ CALENDARVERSION "Calendar Version 1.95")
(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? CALMONTHICON )
(RPAQ? CALNEEDSUPDATE )
(RPAQ? CALREMSLOADED )
(RPAQ? CALUPDATEONSHRINKFLG )
(RPAQ? PBIGFONT )
(RPAQ? PCALFONT )
(RPAQ? PLITTLEFONT )
(DEFINEQ
(ACTUALREMINDDATE
[LAMBDA (R) (* MJD "16-Jul-86 12:56")
(* Finds the day in which this reminder should appear.
For timed-saves, this is the expiration-date, for all
others it's the next-remind-date.)
(* I don't remember why this was -
now it doesn't seem necessary)
(if (EQ (LISPDATEYEAR (REMINDER.EXPIRATIONDATE R))
2034)
then (REMINDER.EXPIRATIONDATE R)
else (REMINDER.NEXTREMINDDATE R])
(CALADDEVENT
[LAMBDA (M D YR) (* MJD " 2-Jul-86 14:10")
(* 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 MSG 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]
(if (AND (IGREATERP (LENGTH (ACTIVEREMINDERNAMES))
0)
(NOT CALNEEDSUPDATE))
then (SETQ CALREMSLOADED T))
(SETQ MSG (OR (PROMPTFORWORD "Message:" NIL NIL PROMPTWINDOW NIL NIL (CHARCODE
EOL))
" "))
(for RDAY from D to (OR (WINDOWPROP CALMONTHWINDOW (QUOTE GROUPEND))
D)
do (CALCREATEREM MSG REMTIME M RDAY YR)
(SHOWREMSINDAY M RDAY YR))
(SHOWDAY (LIST D M YR))
(SETQ CALNEEDSUPDATE T)
(if (NOT CALUPDATEONSHRINKFLG)
then (CALUPDATEINIT])
(CALCREATEREM
[LAMBDA (MSG REMTIME M D YR) (* MJD "16-Jul-86 11:33")
(PROG (R REMDATE)
(SETQ REMDATE (PACKDATE REMTIME M D YR)) (* For some reason, this had 2034 instead of YR)
[pushnew CALREMINDERS (SETREMINDER (SETQ R (CALUNIQUEGENSYM))
NIL MSG 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])
(CALDISPEVENT
[LAMBDA (ITEM) (* MJD " 4-Jun-86 16:43")
(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]
(DISMISS 10)
(BEEPOFF)))
(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 (ACTUALREMINDDATE
(CADR ITEM)))
(LISPDATEMONTH (ACTUALREMINDDATE
(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])
(CALENDAR
[LAMBDA (M D YR) (* MJD "23-Apr-86 17:33")
(AND CALDEFAULTHOST&DIR (INFILEP (PACKFILENAME (QUOTE NAME)
(QUOTE CALREMINDERS)
(QUOTE DIRECTORY)
CALDEFAULTHOST&DIR))
(LOAD? (PACKFILENAME (QUOTE NAME)
(QUOTE CALREMINDERS)
(QUOTE DIRECTORY)
CALDEFAULTHOST&DIR))
(SETQ CALREMSLOADED T))
(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 NIL (* MJD " 2-Jul-86 13:40")
(PROG (DEND NEWEND)
(while (MOUSESTATE (ONLY RIGHT))
do (SETQ DEND (CAR (MENUREGIONITEM CALMONTHMENU)))
(INVERTGROUP CALCURMONTH CALCURDAY CALCURYEAR CALCURMONTH DEND CALCURYEAR
BLACKSHADE)
(SETQ NEWEND (CAR (MENUREGIONITEM CALMONTHMENU)))
(if (ILESSP NEWEND DEND)
then (INVERTGROUP CALCURMONTH NEWEND CALCURYEAR CALCURMONTH DEND
CALCURYEAR WHITESHADE)
(SETQ DEND NEWEND)))
(WINDOWPROP CALMONTHWINDOW (QUOTE GROUPEND)
DEND)
(TOTOPW CALDAYWINDOW])
(CALMAKEKEY
[LAMBDA (M D) (* MJD "22-Apr-86 10:36")
(BLOCK)
(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])
(CALMONTHICONFN
[LAMBDA (W ICON) (* MJD "29-May-86 14:20")
(if ICON
then (ICONW.TITLE ICON (MONTHNAME CALCURMONTH))
ICON
else [SETQ CALMONTHICON (create TITLEDICON
ICON ← CALMONTHICONMAP
TITLEREG ←(QUOTE (0 47 64 10]
(TITLEDICONW CALMONTHICON (MONTHNAME CALCURMONTH)
LITTLEFONT])
(CALMONTHRBF
[LAMBDA (X) (* MJD "25-Jun-86 13:10")
(if (INSIDEP (CREATEREGION 0 0 (WINDOWPROP CALMONTHWINDOW (QUOTE WIDTH))
(IDIFFERENCE (WINDOWPROP CALMONTHWINDOW (QUOTE HEIGHT))
90))
(LASTMOUSEX CALMONTHSTREAM)
(LASTMOUSEY CALMONTHSTREAM))
then (if (MOUSESTATE LEFT)
then (MENUBUTTONFN CALMONTHWINDOW)
else (CALEXTENDSEL))
else (DOWINDOWCOM CALMONTHWINDOW])
(CALPRINTREM
[LAMBDA (REMINDER STREAM) (* MJD "16-May-86 12:20")
(* 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])
(CALUNIQUEGENSYM
[LAMBDA NIL (* MJD "17-Jan-86 14:37")
(PROG (REMNAME)
(repeatwhile (MEMBER REMNAME (ACTIVEREMINDERNAMES)) do (SETQ REMNAME (GENSYM))
)
(RETURN REMNAME])
(CALUPDATEFILE
[LAMBDA (FILE) (* MJD "13-Jun-86 14:20")
(PROG (FSTREAM)
[OUTPUT (SETQ FSTREAM (OPENSTREAM FILE (QUOTE OUTPUT)
(QUOTE OLD/NEW]
(printout PROMPTWINDOW T "Updating reminder file " FILE "...")
(STOREREMS)
(for X in (ACTIVEREMINDERNAMES)
do (BLOCK)
(PRINT [BQUOTE (PUTDEF (QUOTE , X)
(QUOTE REMINDERS)
(QUOTE , (GETDEF X (QUOTE REMINDERS]
FSTREAM)
finally (PRINT (BQUOTE (RPAQQ CALREMINDERS , (ACTIVEREMINDERNAMES)))
FSTREAM))
(PRINT (QUOTE STOP)
FSTREAM)
(CLOSEF FSTREAM)
(SETQ CALNEEDSUPDATE NIL)
(SETQ CALREMSLOADED T)
(printout PROMPTWINDOW "done."])
(CALUPDATEINIT
[LAMBDA NIL (* MJD "16-May-86 16:02")
(PROG (FILE)
(SETCURSOR WAITINGCURSOR)
[SETQ FILE (PACKFILENAME (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]
(CURSOR T)
(if (AND (NOT CALREMSLOADED)
(INFILEP FILE))
then (if (MOUSECONFIRM (CONCAT "There is a CALREMINDERS file on "
CALDEFAULTHOST&DIR
" which you haven't loaded yet. Should I overwrite it?"))
then (CALUPDATEFILE FILE)
else (PRINTOUT PROMPTWINDOW T
"File not updated; to load it, call (CALENDAR).")
(RETURN NIL))
else (CALUPDATEFILE FILE])
(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 (W) (* MJD "16-May-86 13:20")
(* Put a circle around today. Only do this if: 1: the current month is this month, 2: the current year is this year
(don't want circle around 3/12/87 if it's 3/12/86), and 3: today is different from the day already circled.)
(COND
([AND (EQ CALCURMONTH (LISPDATEMONTH (DATE)))
(EQ CALCURYEAR (LISPDATEYEAR (DATE)))
(NEQ CALCIRCLEDAY (LISPDATEDAY (DATE]
(TOTOPW CALMONTHWINDOW T)
(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])
(CLEARDAY
[LAMBDA (D) (* MJD "16-May-86 14:06")
(* Erase the contents of this day box so it can be
rewritten.)
(SETQ CALCIRCLEDAY NIL) (* Fool CIRCLETODAY into erasing the circle before
clearing the box. Then we'll be OK when we redraw the
circle.)
(CIRCLETODAY CALMONTHWINDOW)
(BITBLT NIL NIL NIL CALMONTHWINDOW (CAR (MDMENUITEMREGION D CALMONTHMENU))
(IPLUS (CADR (MDMENUITEMREGION D CALMONTHMENU))
37)
119 61 (QUOTE TEXTURE)
(QUOTE ERASE)
BLACKSHADE)
(SETQ CALCIRCLEDAY NIL)
(CIRCLETODAY CALMONTHWINDOW])
(CLOSEMONTH
[LAMBDA (X) (* MJD "23-Jun-86 13:30")
(AND CALUPDATEONSHRINKFLG CALNEEDSUPDATE (ADD.PROCESS (QUOTE (CALUPDATEINIT])
(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])
(INVERTGROUP
[LAMBDA (M1 D1 YR1 M2 D2 YR2 SHADE) (* MJD "25-Jun-86 13:08")
(AND D2 (for D from D1 to D2 do (SHADEITEM (MENUITEM D CALMONTHMENU)
CALMONTHMENU SHADE])
(LISPDATEDAY
[LAMBDA (LD) (* MJD "10-Jul-86 12: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])
(MENUITEM
[LAMBDA (ITEM MNAME) (* MJD "25-Jun-86 12:03")
(for I in (fetch ITEMS of MNAME) thereis (EQ ITEM (CAR I])
(MENUREGIONITEM
[LAMBDA (MNAME) (* MJD "25-Jun-86 12:09")
(GETMOUSESTATE)
(for I in (fetch ITEMS of MNAME) thereis (INSIDEP (MENUITEMREGION I MNAME)
(LASTMOUSEX CALMONTHSTREAM)
(LASTMOUSEY CALMONTHSTREAM])
(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) (* MJD "13-Mar-86 15:47")
(* PLIST is list of phase of each day.
Then return list of first days of phases NM, FQ, Full,
LQ in that order.)
(* The COND is complicated because the first phase may be split between the beginning and end of the month.
Since we want the first day of the phase (which might not be the first time it appears on the list) we have to
check for this.)
(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))
(IF (EQ D (CAR (LAST PLIST)))
THEN [ADD1 (IDIFFERENCE (DAYSIN M YR)
(COUNT
(MEMBER (CAR PLIST)
(NLEFT PLIST
15]
ELSE 1))
(T (ADD1 (IDIFFERENCE (DAYSIN M YR)
(COUNT (MEMBER D PLIST])
(PR
[LAMBDA NIL (* MJD "16-May-86 13:47")
(PROG (R)
(SETQ R (MENU (CREATE MENU
ITEMS ←(ACTIVEREMINDERNAMES)
TITLE ← "Reminder:")))
(PRINTOUT T "* Reminder " R " *" T "Text: " (CADDR (GETDEF R (QUOTE REMINDER)))
T "Next remind date: " (REMINDER.NEXTREMINDDATE R)
T "Expiration date: " (REMINDER.EXPIRATIONDATE R)
T])
(PRINTMONTH
[LAMBDA (W STREAM) (* MJD " 4-Jun-86 16:46")
(PROG ((CALPSCALE 190)
(M CALCURMONTH)
(YR CALCURYEAR))
(SETCURSOR WAITINGCURSOR)
(PRINTOUT PROMPTWINDOW T "Formatting for print...")
(* SETQ STREAM NIL)
[SETQ CALPRINTSTREAM (OPENIMAGESTREAM (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(FULLNAME STREAM))
(QUOTE INTERPRESS)
(QUOTE (LANDSCAPE T]
(SETQ STREAM NIL)
[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) (* MJD "16-May-86 11:57")
(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 "16-Jul-86 10:56")
(PROG ((D (CAR ITEM))
(M (CADR ITEM))
(YR (CADDR ITEM))
DFHEIGHT)
(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 BUTTON (WINDOWPROP CALMONTHWINDOW (QUOTE GROUPEND)))
then (INVERTGROUP M CALCURDAY YR M (WINDOWPROP CALMONTHWINDOW (QUOTE GROUPEND)
)
YR WHITESHADE)
(WINDOWPROP CALMONTHWINDOW (QUOTE GROUPEND)
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)
(SETQ DFHEIGHT (FONTPROP DEFAULTFONT (QUOTE HEIGHT)))
(SHAPEW CALDAYWINDOW (LIST (if CALMONTHMENU
then (IDIFFERENCE (CAR (MDMENUITEMREGION
D CALMONTHMENU))
(ITIMES (DAYOF M D YR)
DFHEIGHT))
else CALDAYDEFAULTXLOC)
(IPLUS (if CALMONTHMENU
then (CADR (MDMENUITEMREGION D
CALMONTHMENU))
else CALDAYDEFAULTYLOC)
140)
350
(HEIGHTIFWINDOW
(IPLUS (ITIMES (IPLUS (LENGTH (REMINDERSOF
M D YR))
2)
DFHEIGHT)
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 ← DFHEIGHT
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 " 2-Jul-86 13:31")
(PROG ((CALLTYPE (CAR ITEM))
(M (CADR ITEM))
(YR (CAR (LAST ITEM)))
MLOC)
(if (NOT (CALYEARINRANGE YR))
then (RETURN NIL))
[CLEARW (OR CALMONTHWINDOW
(PROG1 [SETQ CALMONTHWINDOW
(CREATEW (if CALLTYPE
then (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))
else (QUOTE (32 32 868 700]
(WINDOWPROP CALMONTHWINDOW (QUOTE HARDCOPYFN)
(QUOTE PRINTMONTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE CLOSEFN)
(QUOTE CLOSEMONTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE SHRINKFN)
(QUOTE SHRINKMONTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE ICONFN)
(QUOTE CALMONTHICONFN))
(WINDOWPROP CALMONTHWINDOW (QUOTE TOTOPFN)
(QUOTE CIRCLETODAY))
(WINDOWPROP CALMONTHWINDOW (QUOTE RIGHTBUTTONFN)
(QUOTE CALMONTHRBF))
(WINDOWPROP CALMONTHWINDOW (QUOTE PROCESS)
(FIND.PROCESS (QUOTE BACKGROUND]
[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)))
(WINDOWPROP CALMONTHWINDOW (QUOTE GROUPEND)
NIL)
(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 as D from 0 to 6
do (DRAWLINE X 10 X 610 1 (QUOTE REPLACE)
CALMONTHWINDOW)
(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)
(SETQ CALCURMONTH M)
(SETQ CALCURYEAR YR)
(SETQ CALCIRCLEDAY NIL)
(CIRCLETODAY CALMONTHWINDOW)
(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 "16-May-86 11:53")
(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 52 SCALE))
(IPLUS (CADR (MDMENUITEMREGION P CALMONTHMENU SCALE))
(TIMES 2 SCALE))
34 34 (QUOTE INPUT)
(QUOTE INVERT])
(SHOWREMSINDAY
[LAMBDA (M D YR) (* MJD "16-May-86 14:09")
(* 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.)
(CLEARDAY D)
(DSPFONT LITTLEFONT CALMONTHWINDOW)
(MOVETOUPPERLEFT CALMONTHSTREAM (MDMENUITEMREGION D CALMONTHMENU))
(DSPYPOSITION (IDIFFERENCE (DSPYPOSITION NIL CALMONTHSTREAM)
2)
CALMONTHSTREAM)
(SETQ DAYREGION (MDMENUITEMREGION D CALMONTHMENU))
(change (CADDR DAYREGION)
(IDIFFERENCE (CADDR DAYREGION)
2))
(DSPCLIPPINGREGION DAYREGION CALMONTHSTREAM)
(for REMINDER in (REMINDERSOF M D YR) as I to 7
do (DSPXPOSITION (IPLUS (CAR (MDMENUITEMREGION D CALMONTHMENU))
2)
CALMONTHSTREAM)
(CALPRINTREM REMINDER CALMONTHSTREAM))
(DSPCLIPPINGREGION (CREATEREGION 0 0 (WINDOWPROP CALMONTHWINDOW (QUOTE WIDTH))
(WINDOWPROP CALMONTHWINDOW (QUOTE HEIGHT)))
CALMONTHSTREAM])
(SHOWREMSINMONTH
[LAMBDA (M YR SCALE STREAM) (* MJD "16-May-86 12:19")
(* Handles printing of all reminders in a month both for screen and on paper. Changes here may need to be done to
SHOWREMSINDAY also.)
(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 2 SCALE))
STREAM)
(change (CADDR DAYREGION)
(IDIFFERENCE (CADDR DAYREGION)
(TIMES 2 SCALE)))
(DSPCLIPPINGREGION DAYREGION STREAM)
(for R in REMINDER as I to 7
do (DSPXPOSITION (IPLUS (CAR (MDMENUITEMREGION D CALMONTHMENU SCALE))
(TIMES 2 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 "20-Mar-86 13:27")
(PROG ((YR (CAR ITEM))
(CALLTYPE (LENGTH ITEM))
MLOC)
[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
(CREATEW (if (NEQ CALLTYPE 1)
then (PROGN (SETQ MLOC
(GETBOXPOSITION 364 324
NIL NIL
NIL
"Please position the Year Window."))
(create REGION
LEFT ←(CAR
MLOC)
BOTTOM ←(CDR
MLOC)
WIDTH ← 364
HEIGHT ← 324))
else (QUOTE (32 400 364 324]
(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 "25-Jun-86 10:45")
[AND CALUPDATEONSHRINKFLG CALNEEDSUPDATE (ADD.PROCESS (QUOTE (CALUPDATEINIT]
(OR CALMONTHICON (SETQ CALMONTHICON (CREATE TITLEDICON
ICON ← CALMONTHICONMAP
TITLEREG ←(QUOTE (0 47 64 10])
(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 (* MJD "16-May-86 15:26")
(CLRHASH CALHASH)
(for R in (ACTIVEREMINDERNAMES)
do (BLOCK)
(PUTHASH (CALMAKEKEY (LISPDATEMONTH (ACTUALREMINDDATE R))
(LISPDATEDAY (ACTUALREMINDDATE R)))
(SORT (NCONC1 (GETHASH (CALMAKEKEY (LISPDATEMONTH (ACTUALREMINDDATE
R))
(LISPDATEDAY (ACTUALREMINDDATE
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 CALMONTHICONMAP (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 (3199 54976 (ACTUALREMINDDATE 3209 . 3879) (CALADDEVENT 3881 . 6436) (CALCREATEREM 6438
. 8033) (CALDISPEVENT 8035 . 10941) (CALENDAR 10943 . 13208) (CALEXTENDSEL 13210 . 13920) (CALMAKEKEY
13922 . 14088) (CALMONTHBEF 14090 . 14338) (CALMONTHICONFN 14340 . 14761) (CALMONTHRBF 14763 . 15303)
(CALPRINTREM 15305 . 15805) (CALREMDEF 15807 . 16613) (CALUNIQUEGENSYM 16615 . 16893) (CALUPDATEFILE
16895 . 17752) (CALUPDATEINIT 17754 . 18742) (CALYEARINRANGE 18744 . 18976) (CIRCLETODAY 18978 . 20378
) (CLEARDAY 20380 . 21200) (CLOSEMONTH 21202 . 21406) (DAYNAME 21408 . 21611) (DAYOF 21613 . 22086) (
DAYSIN 22088 . 22354) (INVERTGROUP 22356 . 22595) (LISPDATEDAY 22597 . 22819) (LISPDATEMONTH 22821 .
22965) (LISPDATEYEAR 22967 . 23224) (MAKEDAYTITLE 23226 . 23730) (MDMENUITEMREGION 23732 . 24141) (
MENUITEM 24143 . 24338) (MENUREGIONITEM 24340 . 24666) (MONTHABBR 24668 . 24855) (MONTHNAME 24857 .
25115) (MONTHNUM 25117 . 25332) (MONTHPLUS 25334 . 25628) (MONTHYEARPLUS 25630 . 25882) (PACKDATE
25884 . 26792) (PARSETIME 26794 . 27610) (POM 27612 . 29499) (POMDAYS 29501 . 30680) (PR 30682 . 31142
) (PRINTMONTH 31144 . 34171) (REMDT 34173 . 34451) (REMINDERDAYLT 34453 . 34609) (REMINDERSOF 34611 .
34830) (REMINDERTIME 34832 . 35870) (REMINDERTIMELT 35872 . 36074) (REMSINMONTH 36076 . 36261) (
REPAINTMONTH 36263 . 36606) (REPAINTYEAR 36608 . 36930) (SAMEDAYAS 36932 . 37259) (SAMEMONTHAS 37261
. 37513) (SHOWDAY 37515 . 42221) (SHOWMONTH 42223 . 46648) (SHOWMONTHSMALL 46650 . 47475) (SHOWMOON
47477 . 48108) (SHOWREMSINDAY 48110 . 49302) (SHOWREMSINMONTH 49304 . 50672) (SHOWYEAR 50674 . 53470)
(SHRINKMONTH 53472 . 53829) (SHRINKYEAR 53831 . 54155) (STOREREMS 54157 . 54793) (YEAROF 54795 . 54974
)))))
STOP