Google
 

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