Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED " 4-DEC-81 00:01:34" <LISPUSERS>REMIND.;2 8618
changes to: REMINDCOMS
previous date: "27-NOV-81 12:43:59" <LISPUSERS>REMIND.;1)
(PRETTYCOMPRINT REMINDCOMS)
(RPAQQ REMINDCOMS [(FNS ADDREMINDER CANCELREMINDERS CHECKREMINDERS LOADREMINDERS REMIND
UPDATEREMINDFILE)
(DECLARE: DONTCOPY EVAL@COMPILE (RECORDS REMINDNOTICE)
(FILES (SOURCE)
DATETIMERECORDS))
(DECLARE: DONTEVAL@LOAD DOCOPY (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
DATETIME IOWAITDAEMON))
(VARS (REMINDERLIST NIL)
(CHECKREMINDERINTERVAL 5))
(ADDVARS (IOWAITDAEMONFORMS (CHECKREMINDERS))
(AFTERSYSOUTFORMS (LOADREMINDERS)))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS
(NLAMA)
(NLAML REMIND)
(LAMA])
(DEFINEQ
(ADDREMINDER
[LAMBDA (when what) (* edited: "28-Aug-80 21:10")
(* Adds a reminder to the remind queue and updates the file)
(PROG (newRecord DATUM) (*)
[COND
((type? MULTIPLEDATETIMES when)
(SETNOWDATETIME)
(SETQ DATUM (GETPROP (QUOTE NOW)
(QUOTE DATETIME)))
(SETQ newRecord (create REMINDNOTICE
EXPIREDATE _(EVAL (fetch NEXTFROMDATEFN of when))
REPEATINTERVAL _ when
REMINDER _ what))
(COND
((NOT (fetch HOUR of (fetch EXPIREDATE of newRecord)))
(replace HOUR of (fetch EXPIREDATE of newRecord) with 0)))
(COND
((NOT (fetch MINUTE of (fetch EXPIREDATE of newRecord)))
(replace MINUTE of (fetch EXPIREDATE of newRecord) with 1)))
[COND
((NOT (fetch AMORPM of (fetch EXPIREDATE of newRecord)))
(replace AMORPM of (fetch EXPIREDATE of newRecord) with (QUOTE AM]
(FINISHDATETIME (fetch EXPIREDATE of newRecord)))
(T (SETQ newRecord (create REMINDNOTICE
EXPIREDATE _ when
REMINDER _ what]
(push REMINDERLIST newRecord)
(UPDATEREMINDFILE])
(CANCELREMINDERS
[LAMBDA NIL (* edited: "15-Jul-79 15:32")
(* This function goes through the reminder list and displays each reminder and asks the user whether or not s/he
wants to cancel it. After running through the list, if any changes were made, then the disk copy of the remind file
is updated.)
(PROG (newReminderList changes)
[for reminder in REMINDERLIST do (printout T T "Expire date - "
[COND
((type? MULTIPLEDATETIMES
(fetch REPEATINTERVAL of reminder))
(DATETIMETOSTRING (fetch REPEATINTERVAL
of reminder)))
(T (DATETIMETOSTRING (fetch EXPIREDATE
of reminder]
T "Reminder - " (fetch REMINDER of reminder)
T)
(COND
((EQ [ASKUSER 10 (QUOTE N)
"Do you want to delete this request? "
(QUOTE ((Y "es
")
(N "o
"]
(QUOTE N))
(push newReminderList reminder))
(T (SETQ changes T]
(COND
(changes (SETQ REMINDERLIST newReminderList)
(UPDATEREMINDFILE])
(CHECKREMINDERS
[LAMBDA NIL (* edited: "25-Jul-79 09:38")
(* For each reminder checks it and if expired, executes it and deletes it from the remind queue.
When all reminders are checked the file is updated if any changes were made)
(PROG (remindFile fullName changes now DATUM newReminderList)
(CHECKTODAY)
(SETNOWDATETIME)
(SETQ now (GETPROP (QUOTE NOW)
(QUOTE DATETIME)))
[for rem on (APPEND REMINDERLIST) bind reminder
do (SETQ reminder (CAR rem))
(COND
[(DLESSP (fetch EXPIREDATE of reminder)
now)
(SETQ changes T)
(printout T "" "Reminder expired " (DATETIMETOSTRING (fetch EXPIREDATE
of reminder))
T)
[COND
((STRINGP (fetch REMINDER of reminder))
(printout T (fetch REMINDER of reminder)
T))
(T (EVAL (fetch REMINDER of reminder]
(COND
((type? MULTIPLEDATETIMES (fetch REPEATINTERVAL of reminder))
(SETQ DATUM (fetch EXPIREDATE of reminder))
[repeatwhile (DLESSP DATUM now) do (SETQ DATUM
(EVAL (fetch ADVANCEFN
of (fetch REPEATINTERVAL
of reminder]
(replace EXPIREDATE of reminder with DATUM)
(push newReminderList reminder]
(T (push newReminderList reminder]
(COND
((NOT changes)
(RETURN CHECKREMINDERINTERVAL)))
(SETQ REMINDERLIST newReminderList)
(UPDATEREMINDFILE)
(RETURN CHECKREMINDERINTERVAL])
(LOADREMINDERS
[LAMBDA NIL (* edited: " 6-Jul-79 00:33")
(PROG (file)
[SETQ file (INFILEP (PACKFILENAME (QUOTE DIRECTORY)
(DIRECTORYNAME)
(QUOTE NAME)
(QUOTE REMIND)
(QUOTE EXTENSION)
(QUOTE LISP]
(COND
(file (OPENFILE file (QUOTE INPUT)
(QUOTE OLD))
(EVAL (READ file))
(CLOSEF file])
(REMIND
[NLAMBDA (when what) (* lmm "27-NOV-81 12:40")
(* Sets up a remind notice which will be produced when the time occurs. WHAT is a reminder, either a string to be
printed or a form to be evaluated)
(PROG (time)
(CHECKTODAY)
(SETNOWDATETIME)
TRY (COND
[when (SETQ time (PARSEDATETIME when))
(COND
((type? DATETIME time)
(COND
((NOT (fetch HOUR of time))
(replace HOUR of time with 0)))
(COND
((NOT (fetch MINUTE of time))
(replace MINUTE of time with 1)))
[COND
((NOT (fetch AMORPM of time))
(replace AMORPM of time with (QUOTE AM]
(SETQ time (FINISHDATETIME time]
(T (RETURN)))
(COND
((type? DATETIMEERROR time)
(printout T "Date format error - " (fetch MESSAGE of time)
T
(fetch CURRENTTOKENLST of time)
T "Try again (NIL to give up) - ")
(SETQ when (READ T))
(GO TRY))
((OR (type? DURATION time)
(type? QUALIFIEDDATETIME time))
(printout T "Date must be a specific time or a recurring time " T
"Try again (NIL to give up) - ")
(SETQ when (READ T))
(GO TRY))
([AND (type? DATETIME time)
(DLESSP time (GETPROP (QUOTE NOW)
(QUOTE DATETIME]
(printout T "Your date has already expired" T "Try again (NIL to give up) - ")
(SETQ when (READ T))
(GO TRY))) (* We have date. Now see that it gets inserted into the remind list)
(ADDREMINDER time what])
(UPDATEREMINDFILE
[LAMBDA NIL (* lmm "27-NOV-81 12:37")
(* Updates the user's remind file to reflect the state of REMINDERLIST)
(PROG (remindFile fullName)
(SETQ remindFile (PACKFILENAME (QUOTE DIRECTORY)
(DIRECTORYNAME)
(QUOTE NAME)
(QUOTE REMIND)
(QUOTE EXTENSION)
(QUOTE LISP)))
(SETQ fullName (FULLNAME remindFile (QUOTE OLD)))
(COND
(fullName (DELFILE fullName)))
(COND
(REMINDERLIST (OUTFILE remindFile)
(PRIN1 "(RPAQQ REMINDERLIST ")
(PRINT REMINDERLIST)
(PRIN1 ")
STOP
")
(CLOSEF remindFile])
)
(DECLARE: DONTCOPY EVAL@COMPILE
[DECLARE: EVAL@COMPILE
(RECORD REMINDNOTICE (EXPIREDATE REPEATINTERVAL REMINDER))
]
(FILESLOAD (SOURCE)
DATETIMERECORDS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
DATETIME IOWAITDAEMON)
)
(RPAQQ REMINDERLIST NIL)
(RPAQQ CHECKREMINDERINTERVAL 5)
(ADDTOVAR IOWAITDAEMONFORMS (CHECKREMINDERS))
(ADDTOVAR AFTERSYSOUTFORMS (LOADREMINDERS))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML REMIND)
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (850 7977 (ADDREMINDER 862 . 2214) (CANCELREMINDERS 2218 . 3454) (CHECKREMINDERS 3458 .
5151) (LOADREMINDERS 5155 . 5572) (REMIND 5576 . 7276) (UPDATEREMINDFILE 7280 . 7974)))))
(PUTPROPS REMIND COPYRIGHTOWNER NONE)
STOP