(FILECREATED "12-Apr-85 15:33:32" {ERIS}<LISPCORE>SOURCES>PROMPTREMINDERS.;1 73123Q 

      changes to:  (FNS SETREMINDER REMINDER.NEXTREMINDDATE \PUTREMINDER \REMINDER.PROC)

      previous date: " 5-Dec-84 18:42:02" {ERIS}<LISPUSERS>PROMPTREMINDERS.;24)


(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT PROMPTREMINDERSCOMS)

(RPAQQ PROMPTREMINDERSCOMS [(COMS (DECLARE: DONTCOPY (MACROS NNLITATOM \CHECKTYPE \NULL.OR.FIXP 
							     \CHARS.OR.FIXP)
					    (PROP MACRO NCREATE)
					    (MACROS TIMERSUBTRACT)))
	(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS PERIODIC.PROMPT.REMINDER)
		  (RESOURCES \REMINDER.HOLD.TIMER \REMINDER.FLASH.TIMER \REMINDER.LITTLE.TIMER))
	(INITRESOURCES \REMINDER.HOLD.TIMER \REMINDER.FLASH.TIMER \REMINDER.LITTLE.TIMER)
	(RECORDS \SHOWABLE.PROMPT.REMINDER)
	(FNS SETREMINDER ACTIVEREMINDERNAMES INSPECTREMINDER REMINDER.NEXTREMINDDATE 
	     REMINDER.EXPIRATIONDATE REMINDER.PERIOD)
	(PROP ARGNAMES REMINDER.NEXTREMINDDATE REMINDER.EXPIRATIONDATE REMINDER.PERIOD)
	(FNS \PUTREMINDER \GETREMINDER \DELREMINDER)
	(FNS PERIODICALLYCHECKREMINDERS UNTILKEYDOWNP \PR.WINKMESSAGE \PR.KBDChangedP)
	(VARS (\PR.REMOVALS NIL))
	[INITVARS (DEFAULT.REMINDER.DURATION 74Q)
		  (DEFAULT.REMINDER.WINKINGDURATION 12Q)
		  (PERIODIC.PROMPT.REMINDERS NIL)
		  (REMINDERSTREAM (SELECTQ (SYSTEMTYPE)
					   (D PROMPTWINDOW)
					   (PROGN (RPAQ \RCLKSECOND 1750Q)
						  T]
	(GLOBALVARS \PR.REMOVALS REMINDERSTREAM \RCLKSECOND)
	(PROP GLOBALVAR PERIODIC.PROMPT.REMINDERS DEFAULT.REMINDER.DURATION 
	      DEFAULT.REMINDER.WINKINGDURATION DEFAULT.REMINDER.PERIOD)
	(FILEPKGCOMS REMINDERS)
	(FNS \REMINDER.PROC)
	[DECLARE: COPYWHEN (EQ COMPILEMODE (QUOTE D))
		  (INITVARS (CLOSEREMINDERSTREAMFLG NIL))
		  (VARS (\REMINDER.EVENT (CREATE.EVENT (QUOTE PERIODIC.PROMPT.REMINDERS)))
			(\FRCLKSECOND (FLOAT \RCLKSECOND))
			(\KEYBOARDLST NIL))
		  (GLOBALVARS CLOSEREMINDERSTREAMFLG \REMINDER.EVENT \FRCLKSECOND \KEYBOARDLST)
		  (GLOBALVARS \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.UTILIN \EM.KBDAD4 
			      \EM.KBDAD5)
		  (P (DEL.PROCESS (QUOTE REMINDERS.watchDog))
		     (MAPC (QUOTE (LOGOUTFORMS SYSOUTFORMS MAKESYSFORMS))
			   (FUNCTION (LAMBDA (X)
					     (MAPC [QUOTE ([BEFORE (PROGN (SETQ \KEYBOARDLST)
									  (DEL.PROCESS (QUOTE 
									       REMINDERS.watchDog]
							   (AFTER (PERIODICALLYCHECKREMINDERS
								    (QUOTE RESTART]
						   (FUNCTION (LAMBDA
							       (Y)
							       ([LAMBDA
								  (VAR FORM VAL)
								  (COND
								    [(BOUNDP VAR)
								     (OR (MEMBER FORM (SETQ
										   VAL
										   (EVALV VAR)))
									 (SET VAR (CONS FORM VAL]
								    (T (SET VAR (LIST FORM]
								(PACK* (CAR Y)
								       X)
								(CADR Y]
	[P (NLSETQ (PERIODICALLYCHECKREMINDERS (QUOTE RESTART)))
	   (SELECTQ (SYSTEMTYPE)
		    (D)
		    (PROGN (ADDTOVAR PROMPTCHARFORMS (PERIODICALLYCHECKREMINDERS]
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA REMINDER.PERIOD 
									  REMINDER.EXPIRATIONDATE 
									  REMINDER.NEXTREMINDDATE])
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 
[PUTPROPS NNLITATOM MACRO (OPENLAMBDA (X)
				      (AND X (LITATOM X]
[PUTPROPS \CHECKTYPE MACRO (X (PROG ((VAR (CAR X))
				     (PRED (CADR X)))
				    (if [AND (LISTP PRED)
					     (MEMB (CAR PRED)
						   (QUOTE (QUOTE FUNCTION]
					then
					(SETQ PRED (LIST (CADR PRED)
							 VAR)))
				    (RETURN (SUBPAIR (QUOTE (MSG VAR PRED))
						     (LIST (CONCAT 
						  "
 is not a suitable value for the variable:  "
								   VAR)
							   VAR PRED)
						     (QUOTE (until PRED do (SETQ VAR
										 (ERROR VAR MSG]
[PUTPROPS \NULL.OR.FIXP MACRO (OPENLAMBDA (X)
					  (OR (NULL X)
					      (FIXP X]
[PUTPROPS \CHARS.OR.FIXP MACRO (OPENLAMBDA (X)
					   (OR (FIXP X)
					       (STRINGP X)
					       (LITATOM X]
)


(PUTPROPS NCREATE MACRO (X (if (EQUAL (CAR X)
				      (QUOTE (QUOTE FIXP)))
			       then (QUOTE (IPLUS 3641100Q))
			     else (QUOTE IGNOREMACRO))))

(DECLARE: EVAL@COMPILE 
[PROGN (PUTPROPS TIMERSUBTRACT DMACRO (OPENLAMBDA (TIMER OLDTIMER)
						  (\BOXIDIFFERENCE OLDTIMER TIMER)))
       (PUTPROPS TIMERSUBTRACT MACRO (OPENLAMBDA (TIMER OLDTIMER)
						 (IDIFFERENCE OLDTIMER TIMER]
)
)
(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(TYPERECORD PERIODIC.PROMPT.REMINDER (REMINDER.TIMEOUTBOX REMINDER.MESSAGE REMINDER.PERIOD 
							  REMINDER.WINKINGDURATION REMINDER.DURATION 
							  REMINDER.FINALTIME REMINDER.NAME)
	    REMINDER.TIMEOUTBOX ←(SETUPTIMER 0)
	    [ACCESSFNS ([REMINDER.NEXTREMINDDATE
			  ([LAMBDA (TIMEBOX)
			      (DECLARE (LOCALVARS TIMEBOX))
			      (AND (\TIMER.TIMERP TIMEBOX)
				   (GDATE (SELECTQ (SYSTEMTYPE)
						   (D (LOGXOR MIN.FIXP TIMEBOX))
						   (IPLUS TIMEBOX (IDIFFERENCE (IDATE)
									       (IQUOTIENT
										 (CLOCK 0)
										 1750Q]
			    (fetch REMINDER.TIMEOUTBOX of DATUM))
			  (PROG2 (replace REMINDER.TIMEOUTBOX of DATUM
				    with (SETUPTIMER.DATE NEWVALUE (fetch REMINDER.TIMEOUTBOX
								      of DATUM)))
				 (OR (STRINGP NEWVALUE)
				     (fetch REMINDER.NEXTREMINDDATE of DATUM]
			(REMINDER.EXPIRATIONDATE
			  ([LAMBDA (TIMEBOX)
			      (DECLARE (LOCALVARS TIMEBOX))
			      (AND (\TIMER.TIMERP TIMEBOX)
				   (GDATE (SELECTQ (SYSTEMTYPE)
						   (D (LOGXOR MIN.FIXP TIMEBOX))
						   (IPLUS TIMEBOX (IDIFFERENCE (IDATE)
									       (IQUOTIENT
										 (CLOCK 0)
										 1750Q]
			    (fetch REMINDER.FINALTIME of DATUM))
			  (PROG2 (replace REMINDER.FINALTIME of DATUM with (SETUPTIMER.DATE NEWVALUE))
				 (fetch REMINDER.EXPIRATIONDATE of DATUM])
]

(DECLARE: EVAL@COMPILE 
[PUTDEF (QUOTE \REMINDER.HOLD.TIMER)
	(QUOTE RESOURCES)
	(QUOTE (NEW (SETUPTIMER 0 NIL (QUOTE TICKS]
[PUTDEF (QUOTE \REMINDER.FLASH.TIMER)
	(QUOTE RESOURCES)
	(QUOTE (NEW (SETUPTIMER 0 NIL (QUOTE TICKS]
[PUTDEF (QUOTE \REMINDER.LITTLE.TIMER)
	(QUOTE RESOURCES)
	(QUOTE (NEW (SETUPTIMER 0 NIL (QUOTE TICKS]
)
)
(/SETTOPVAL (QUOTE \\REMINDER.HOLD.TIMER.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\REMINDER.FLASH.TIMER.GLOBALRESOURCE))
(/SETTOPVAL (QUOTE \\REMINDER.LITTLE.TIMER.GLOBALRESOURCE))
[DECLARE: EVAL@COMPILE 

(RECORD \SHOWABLE.PROMPT.REMINDER (NIL NIL \REMINDER.MESSAGE \REMINDER.PERIOD 
				       \REMINDER.WINKINGDURATION \REMINDER.DURATION)
				  (CREATE (ERROR DATUM "Creations not allowed on this record"))
				  [ACCESSFNS ((\REMINDER.NEXTREMINDDATE (REMINDER.NEXTREMINDDATE
									  DATUM)
									(REMINDER.NEXTREMINDDATE
									  DATUM NEWVALUE))
					      (\REMINDER.EXPIRATIONDATE (REMINDER.EXPIRATIONDATE
									  DATUM)
									(REMINDER.EXPIRATIONDATE
									  DATUM NEWVALUE])
]
(DEFINEQ

(SETREMINDER
  [LAMBDA (NAME PERIOD MESSAGE INITIALDELAY EXPIRATION REMINDINGDURATION WINKINGDURATION)
                                                             (* lmm "12-Apr-85 13:13")
    (\CHECKTYPE NAME (QUOTE LITATOM))
    (\CHECKTYPE PERIOD (QUOTE \NULL.OR.FIXP))
    (\CHECKTYPE INITIALDELAY (QUOTE \CHARS.OR.FIXP))
    (PROG ((RNAME (OR NAME (GENSYM)))
	   REMINDER)
          [if [NULL (SETQ REMINDER (GETDEF RNAME (QUOTE REMINDERS)
					   NIL
					   (QUOTE NOERROR]
	      then                                           (* Big time delay before first "reminding" to allow 
							     time for the completion of this function!)
		   (SETQ REMINDER (create PERIODIC.PROMPT.REMINDER
					  REMINDER.TIMEOUTBOX ←(SETUPTIMER 37200Q NIL (QUOTE SECONDS]
          (replace REMINDER.MESSAGE of REMINDER with (OR MESSAGE RNAME))
          (replace REMINDER.DURATION of REMINDER with (OR (FIXP REMINDINGDURATION)
							  DEFAULT.REMINDER.DURATION))
          (replace REMINDER.WINKINGDURATION of (PROG1 REMINDER 
                                                             (* Comment PPLossage))
	     with (OR (FIXP WINKINGDURATION)
		      DEFAULT.REMINDER.WINKINGDURATION))
          (PUTDEF RNAME (QUOTE REMINDERS)
		  REMINDER)

          (* This call is made even for "old" reminders, to get the action of MARKASCHANGED * Note also how the PERIOD was 
	  null during this time, so that it didn't reset the timer.)


          (replace REMINDER.PERIOD of REMINDER with PERIOD)
          [replace REMINDER.TIMEOUTBOX of REMINDER with (if (OR (STRINGP INITIALDELAY)
								(AND INITIALDELAY (LITATOM 
										     INITIALDELAY)))
							    then (SETUPTIMER.DATE INITIALDELAY
										  (fetch 
									      REMINDER.TIMEOUTBOX
										     of REMINDER))
							  else (SETUPTIMER (OR INITIALDELAY PERIOD 0)
									   (fetch REMINDER.TIMEOUTBOX
									      of REMINDER)
									   (QUOTE SECONDS]
          (if EXPIRATION
	      then 

          (* * Third arg to REMINDER.NEXTREMINDDATE says dont mark as changed.)


		   (REMINDER.EXPIRATIONDATE REMINDER (if (FIXP EXPIRATION)
							 then (IPLUS EXPIRATION (IDATE (
REMINDER.NEXTREMINDDATE REMINDER)))
						       else (STRINGP EXPIRATION))
					    T))
          (SELECTQ (SYSTEMTYPE)
		   (D (NOTIFY.EVENT \REMINDER.EVENT))
		   NIL)
          (RETURN RNAME])

(ACTIVEREMINDERNAMES
  (LAMBDA NIL                                                (* JonL "29-NOV-82 16:58")
    (MAPCAR PERIODIC.PROMPT.REMINDERS (FUNCTION CAR))))

(INSPECTREMINDER
  (LAMBDA (NAME)                                             (* JonL " 9-May-84 02:25")
    (AND (NNLITATOM NAME)
	 (HASDEF NAME (QUOTE REMINDERS))
	 (SELECTQ (SYSTEMTYPE)
		  (D                                         (* NOCOPY so that one can SET the fields from the 
							     inspectWindow)
		     (INSPECT (GETDEF NAME (QUOTE REMINDERS)
				      NIL
				      (QUOTE NOCOPY))
			      (QUOTE \SHOWABLE.PROMPT.REMINDER)))
		  ((LAMBDA (DEF)
		      (printout NIL T "Message: " (fetch REMINDER.MESSAGE of DEF)
				T "Period: " (fetch REMINDER.PERIOD of DEF)
				.TAB 20 "Winking: " (fetch REMINDER.WINKINGDURATION of DEF)
				.TAB 40 "Reminding: " (fetch REMINDER.DURATION of DEF)
				T "NextRemindDate: " (REMINDER.NEXTREMINDDATE NAME))
		      (AND (SETQ DEF (REMINDER.EXPIRATIONDATE NAME))
			   (printout NIL T "NextExpiration: " DEF))
		      (TERPRI))
		    (GETDEF NAME (QUOTE REMINDERS)
			    NIL
			    (QUOTE NOCOPY)))))))

(REMINDER.NEXTREMINDDATE
  [LAMBDA N                                                  (* lmm "12-Apr-85 13:22")

          (* * 1-arg case is only asking for information; multi-arg for update; 3'rd arg, if non-null, says don't mark as 
	  changed.)


    (AND (IGEQ N 1)
	 (LET [(DEF (if (type? PERIODIC.PROMPT.REMINDER (ARG N 1))
			then (ARG N 1)
		      else (GETDEF (ARG N 1)
				   (QUOTE REMINDERS)
				   NIL
				   (QUOTE (NOERROR NOCOPY]
	   (AND (PROG1 DEF                                   (* Comment PPLossage))
		(LET ((SDATE (fetch REMINDER.NEXTREMINDDATE of DEF)))
		  (if (EQ N 1)
		      then SDATE
		    else [SETQ NEWDATE (OR (STRINGP (ARG N 2))
					   (GDATE (ARG N 2]
			 (if [AND (NOT (IEQP (IDATE SDATE)
					     (IDATE NEWDATE)))
				  (OR (ILEQ N 2)
				      (NULL (ARG N 3]
			     then (MARKASCHANGED (fetch REMINDER.NAME of DEF)
						 (QUOTE REMINDERS)
						 (QUOTE CHANGED)))
			 (NOTIFY.EVENT \REMINDER.EVENT)
			 (replace REMINDER.NEXTREMINDDATE of DEF with NEWDATE])

(REMINDER.EXPIRATIONDATE
  (LAMBDA N                                                  (* JonL " 9-Nov-84 01:02")

          (* * 1-arg case is only asking for information; multi-arg for update; 3'rd arg, if non-null, says don't mark as 
	  changed.)


    (PROG (DEF SDATE NEWDATE)
          (if (OR (NOT (IGEQ N 1))
		  (NULL (SETQ DEF (if (type? PERIODIC.PROMPT.REMINDER (ARG N 1))
				      then (ARG N 1)
				    else (GETDEF (ARG N 1)
						 (QUOTE REMINDERS)
						 NIL
						 (QUOTE (NOERROR NOCOPY)))))))
	      then (RETURN NIL))
          (SETQ SDATE (fetch REMINDER.EXPIRATIONDATE of DEF))
                                                             (* Note that SDATE must be either a STRINGP or NIL)
          (if (IGREATERP N 1)
	      then (SETQ NEWDATE (OR (STRINGP (ARG N 2))
				     (GDATE (ARG N 2))))
		   (if (AND (NOT (IEQP (IDATE SDATE)
				       (OR (FIXP (IDATE NEWDATE))
					   -1)))
			    (OR (ILEQ N 2)
				(NULL (ARG N 3))))
		       then (MARKASCHANGED (fetch REMINDER.NAME of DEF)
					   (QUOTE REMINDERS)
					   (QUOTE CHANGED)))
		   (replace REMINDER.EXPIRATIONDATE of DEF with (SETQ SDATE NEWDATE)))
          (RETURN SDATE))))

(REMINDER.PERIOD
  (LAMBDA N                                                  (* JonL "11-Jun-84 13:49")
    (AND (IGEQ N 1)
	 ((LAMBDA (DEF PERIOD)
	     (AND (PROG1 DEF                                 (* Comment PPLossage))
		  ((LAMBDA (PERIOD NEWPERIOD)
		      (if (IEQP N 1)
			  then PERIOD
			else (OR (IGEQ (SETQ NEWPERIOD (FIX (ARG N 2)))
				       1)
				 (ERRORX (LIST 27 NEWPERIOD)))
			     (if (NOT (IEQP PERIOD NEWPERIOD))
				 then (MARKASCHANGED (fetch REMINDER.NAME of DEF)
						     (QUOTE REMINDERS)
						     (QUOTE CHANGED)))
			     (replace REMINDER.PERIOD of DEF with NEWPERIOD)))
		    (fetch REMINDER.PERIOD of DEF))))
	   (if (type? PERIODIC.PROMPT.REMINDER (ARG N 1))
	       then (ARG N 1)
	     else (GETDEF (ARG N 1)
			  (QUOTE REMINDERS)
			  NIL
			  (QUOTE (NOERROR NOCOPY))))))))
)

(PUTPROPS REMINDER.NEXTREMINDDATE ARGNAMES (REMINDER (OPTIONAL: NEWVALUE)))

(PUTPROPS REMINDER.EXPIRATIONDATE ARGNAMES (REMINDER (OPTIONAL: NEWVALUE)))

(PUTPROPS REMINDER.PERIOD ARGNAMES (REMINDER (OPTIONAL: NEWVALUE)))
(DEFINEQ

(\PUTREMINDER
  [LAMBDA (NAME FILEPKGTYPE DEF)                             (* lmm "12-Apr-85 13:48")
    (DECLARE (GLOBALVARS PERIODIC.PROMPT.REMINDERS))
    [if (OR (NULL NAME)
	    (NOT (LITATOM NAME))
	    (NEQ FILEPKGTYPE (QUOTE REMINDERS)))
	then (ERRORX (LIST 33Q (if (EQ FILEPKGTYPE (QUOTE REMINDERS))
				   then NAME
				 else FILEPKGTYPE]
    (if (NOT (type? PERIODIC.PROMPT.REMINDER DEF))
	then (ERRORX (LIST 33Q DEF)))
    (PROG ((OLDDEF (ASSOC NAME PERIODIC.PROMPT.REMINDERS))
	   (PERIOD (fetch REMINDER.PERIOD of DEF)))
          (replace REMINDER.NAME of DEF)
          (MARKASCHANGED (PROG1 NAME                         (* Comment PPLossage))
			 FILEPKGTYPE
			 (if (NULL OLDDEF)
			     then                            (* AHA! A new definiton!)
				  (/SETTOPVAL (QUOTE PERIODIC.PROMPT.REMINDERS)
					      (CONS (LIST NAME DEF)
						    PERIODIC.PROMPT.REMINDERS))
				  (QUOTE DEFINED)
			   elseif (EQUAL (CDDR DEF)
					 (CDDR (CADR OLDDEF)))
			     then                            (* Blaaag! Notice how the CDDR depends upon 
							     PERIODIC.PROMPT.REMINDER being a TYPERECORD so as to 
							     skip checking the REMINDER.TIMEOUTBOX)
				  (RETURN)
			   else (/RPLACA (CDR OLDDEF)
					 DEF)
				(QUOTE CHANGED)))
          [AND (FIXP PERIOD)
	       (replace REMINDER.TIMEOUTBOX of DEF with (SETUPTIMER PERIOD (fetch REMINDER.TIMEOUTBOX
									      of DEF)
								    (QUOTE SECONDS]
          (NOTIFY.EVENT \REMINDER.EVENT))
    NAME])

(\GETREMINDER
  (LAMBDA (NAME TYPE)                                        (* JonL "21-NOV-82 17:11")
    (CADR (ASSOC NAME PERIODIC.PROMPT.REMINDERS))))

(\DELREMINDER
  (LAMBDA (NAME FILEPKGTYPE)                                 (* JonL "26-FEB-83 12:24")
    (if (OR (NULL NAME)
	    (NOT (LITATOM NAME))
	    (NEQ FILEPKGTYPE (QUOTE REMINDERS)))
	then (ERRORX (LIST 27 (if (EQ FILEPKGTYPE (QUOTE REMINDERS))
				  then NAME
				else FILEPKGTYPE))))
    (PROG ((OLDDEF (ASSOC NAME PERIODIC.PROMPT.REMINDERS)))
          (if OLDDEF
	      then (MARKASCHANGED NAME FILEPKGTYPE (QUOTE DELETED))
		   (/SETTOPVAL (QUOTE PERIODIC.PROMPT.REMINDERS)
			       (REMOVE OLDDEF PERIODIC.PROMPT.REMINDERS))
		   (RETURN T)))))
)
(DEFINEQ

(PERIODICALLYCHECKREMINDERS
  (LAMBDA (RESETP)                                           (* JonL " 5-Dec-84 18:35")
    (SELECTQ (SYSTEMTYPE)
	     (D (if (EQ RESETP (QUOTE RESTART))
		    then 

          (* * This handles restarting after sysout etc. Note that moving from one machine to another may involve different 
	  values for \RCLKSECOND)


			 (SETQ \KEYBOARDLST (LIST \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 
						  \EM.UTILIN \EM.KBDAD4 \EM.KBDAD5))
			 (OR (FIND.PROCESS)
			     (ADD.PROCESS (QUOTE (\REMINDER.PROC))
					  (QUOTE NAME)
					  (QUOTE REMINDERS.watchDog)
					  (QUOTE RESTARTABLE)
					  (QUOTE HARDRESET)))
			 (SETQ \FRCLKSECOND (FLOAT \RCLKSECOND))))
	     NIL)
    (RESETLST (SETQ \PR.REMOVALS)
	      (RESETSAVE NIL (QUOTE (PROGN (MAPC \PR.REMOVALS (FUNCTION (LAMBDA (X)
						     (DELDEF (CAR X)
							     (QUOTE REMINDERS))))))))
	      (PROG ((RSDSPP (SELECTQ (SYSTEMTYPE)
				      (D (if (DISPLAYSTREAMP REMINDERSTREAM)
					     then T
					   else (OR (STREAMP REMINDERSTREAM)
						    (SETQ REMINDERSTREAM (GETSTREAM REMINDERSTREAM
										    (QUOTE OUTPUT))))
						NIL))
				      NIL))
		     REMINDER Reminder'sTimer Reminmder'sPeriod Reminder'sExpiration MESSAGE FLASHFLG)
		    (DECLARE (SPECVARS RSDSPP FLASHFLG MESSAGE))
		    (for X in PERIODIC.PROMPT.REMINDERS
		       do (SETQ REMINDER (CADR X))
			  (if (AND (SETQ Reminder'sExpiration (fetch REMINDER.FINALTIME of REMINDER))
				   (OR (NOT (\TIMER.TIMERP Reminder'sExpiration))
				       (TIMEREXPIRED? Reminder'sExpiration (QUOTE SECONDS))))
			      then                           (* An expiration date was set, and he has expired!)
				   (push \PR.REMOVALS X)
			    elseif (OR (NULL (SETQ Reminder'sTimer (fetch REMINDER.TIMEOUTBOX
								      of REMINDER)))
				       (AND Reminder'sTimer (NOT (\TIMER.TIMERP Reminder'sTimer))
					    (PROG1 T (replace REMINDER.TIMEOUTBOX of REMINDER
							with (SETQ Reminder'sTimer)))))
			      then                           (* This guy is just an old "one-shot" reminder which 
							     has already fired off, but is being kept around for the
							     benefit of Denber.wbst)
				   (if (NULL Reminder'sExpiration)
				       then                  (* If he has a non-null expiration field, then the 
							     previous clause will eventuall delete him.)
					    (push \PR.REMOVALS X))
			    else (SETQ Reminmder'sPeriod (FIXP (fetch REMINDER.PERIOD of REMINDER)))
				 (if RESETP
				     then                    (* Reset timers upon startup after SYSOUT or LOGOUT as 
							     if the call to SETUPTIMER were made upon startup)
					  (if Reminmder'sPeriod
					      then (replace REMINDER.TIMEOUTBOX of REMINDER
						      with (SETUPTIMER Reminmder'sPeriod 
								       Reminder'sTimer (QUOTE SECONDS)
								       )))
				   elseif (TIMEREXPIRED? Reminder'sTimer (QUOTE SECONDS))
				     then                    (* When a reminder's timer has expired, then flash it 
							     at the luser, or "run" it as a form to be eval'd.)
					  (if Reminmder'sPeriod
					      then           (* For periodic reminders, set the next reminder time 
							     now, just in case he quits out of this with a ↑D)
						   (replace REMINDER.TIMEOUTBOX of REMINDER
						      with (SETUPTIMER Reminmder'sPeriod 
								       Reminder'sTimer (QUOTE SECONDS)
								       ))
					    elseif (NULL Reminder'sExpiration)
					      then           (* After having "fired off" a one-shot reminder, then 
							     delete it, unless of course there is a future 
							     expiration date.)
						   (push \PR.REMOVALS X)
					    else             (* This is to prevent a "kept, one-shot" reminder from 
							     firing off continuously.)
						 (replace REMINDER.TIMEOUTBOX of REMINDER
						    with NIL))
					  (if (NLISTP (SETQ MESSAGE (fetch REMINDER.MESSAGE
								       of REMINDER)))
					      then (SETQ FLASHFLG)
						   (UNTILKEYDOWNP (FUNCTION \PR.WINKMESSAGE)
								  .5
								  (fetch REMINDER.DURATION
								     of REMINDER)
								  (fetch REMINDER.WINKINGDURATION
								     of REMINDER)
								  (FUNCTION (LAMBDA NIL
								      (SELECTQ (SYSTEMTYPE)
									       (D (BLOCK)
										  (RINGBELLS 3))
									       (PRINTBELLS)))))
						   (SELECTQ (SYSTEMTYPE)
							    (D (if RSDSPP
								   then (DSPRESET REMINDERSTREAM)
								 else (TERPRI REMINDERSTREAM)))
							    (TERPRI REMINDERSTREAM))
					    else (NLSETQ (EVAL MESSAGE)))
					  (if Reminmder'sPeriod
					      then           (* Make the next reminder timeout more current.)
						   (replace REMINDER.TIMEOUTBOX of REMINDER
						      with (SETUPTIMER Reminmder'sPeriod 
								       Reminder'sTimer (QUOTE SECONDS)
								       ))))))
		    (SELECTQ (SYSTEMTYPE)
			     (D (AND CLOSEREMINDERSTREAMFLG RSDSPP (CLOSEW REMINDERSTREAM)))
			     NIL)))))

(UNTILKEYDOWNP
  (LAMBDA (FN INTERVAL.SECS DURATION.SECS subCycleDuration.secs subCycleFN)
                                                             (* JonL " 5-Dec-84 18:41")
    (OR (FIXP DURATION.SECS)
	(SETQ DURATION.SECS (FIXR DURATION.SECS)))
    (OR subCycleDuration.secs (SETQ subCycleDuration.secs DURATION.SECS))
    (PROG ((INTERVAL.TICS (FIX (FTIMES (OR (FLOATP INTERVAL.SECS)
					   (FLOAT INTERVAL.SECS))
				       (OR (FLOATP \FRCLKSECOND)
					   (SETQ \FRCLKSECOND (FLOAT \RCLKSECOND))))))
	   (FIRSTTIME T)
	   ADDRSLST KEYMASKLST OLDKEYLST)
          (SELECTQ (SYSTEMTYPE)
		   (D (SETQ KEYMASKLST
			(LOADTIMECONSTANT (PROG ((X (ARRAY 7 (QUOTE WORD)
							   (MASK.1'S 0 16)
							   0))
						 J)
					        (SETA X 4 0)
					        (SETA X 5 0)
					        (SETA X 6 0)
					        (for I in (LIST (\KEYNAMETONUMBER (QUOTE MIDDLE)))
						   do (SETQ J (LRSH I 4))
						      (SETA X J
							    (LOGOR (ELT X J)
								   (MASK.1'S (IDIFFERENCE
									       15
									       (IMOD I 16))
									     1))))
					        (for I in (LIST (\KEYNAMETONUMBER (QUOTE LSHIFT))
								(\KEYNAMETONUMBER (QUOTE LOCK))
								(\KEYNAMETONUMBER (QUOTE RSHIFT))
								(\KEYNAMETONUMBER (QUOTE CTRL)))
						   do (SETQ J (LRSH I 4))
						      (SETA X J
							    (BITCLEAR (ELT X J)
								      (MASK.1'S (IDIFFERENCE
										  15
										  (IMOD I 16))
										1))))
					        (RETURN (for I from 0 to 6
							   collect (LOGXOR (ELT X I)
									   (MASK.1'S 0 16)))))))
		      (SETQ ADDRSLST (OR \KEYBOARDLST (SETQ \KEYBOARDLST
					   (LIST \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 
						 \EM.UTILIN \EM.KBDAD4 \EM.KBDAD5))))
                                                             (* The masks are basically which key positions to 
							     ignore)
		      (SETQ OLDKEYLST (APPEND ADDRSLST NIL))
                                                             (* First, transfer the state of the keyboard, modulo 
							     the "masks", into the list OLDKEYLST)
		      (for L on OLDKEYLST as MASK in KEYMASKLST as A in ADDRSLST
			 do (FRPLACA L (LOGOR MASK (\GETBASE A 0)))))
		   NIL)
          (WITH-RESOURCES (\REMINDER.HOLD.TIMER \REMINDER.FLASH.TIMER \REMINDER.LITTLE.TIMER)
			  (during DURATION.SECS timerUnits (QUOTE SECONDS) usingTimer 
									     \REMINDER.HOLD.TIMER
			     eachtime (if FIRSTTIME
					  then (SETQ FIRSTTIME)
					elseif subCycleFN
					  then (APPLY subCycleFN))
			     when (during subCycleDuration.secs timerUnits (QUOTE SECONDS)
				     usingTimer \REMINDER.FLASH.TIMER
				     when (during INTERVAL.TICS timerUnits (QUOTE TICKS)
					     usingTimer \REMINDER.LITTLE.TIMER
					     when (\PR.KBDChangedP OLDKEYLST ADDRSLST KEYMASKLST)
					     do (RETURN T) finally (APPLY FN))
				     do                      (* Wink the message at him in the PROMPTWINDOW at 
							     roughly 1 second intervals, returning non-null if a key
							     is down.)
					(RETURN T))
			     do                              (* AHA! Quit due to key being "down")
				(RETURN))))))

(\PR.WINKMESSAGE
  (LAMBDA NIL
    (DECLARE (USEDFREE FLASHFLG MESSAGE RSDSPP))             (* JonL "15-Apr-84 14:46")
    (if FLASHFLG
	then (SELECTQ (SYSTEMTYPE)
		      (D (if RSDSPP
			     then (DSPRESET REMINDERSTREAM))
			 (BLOCK))
		      (PRIN1 (CONSTANT (CHARACTER (CHARCODE BELL)))
			     T))
      else (PRIN3 MESSAGE REMINDERSTREAM)
	   (TERPRI REMINDERSTREAM))

          (* * In D world, we alternate between FLASHing and not; but in other worlds, we print the message once and just 
	  continue FLASHing at the luser.)


    (SELECTQ (SYSTEMTYPE)
	     (D (SETQ FLASHFLG (NOT FLASHFLG)))
	     (if (NULL FLASHFLG)
		 then (SETQ FLASHFLG T)))))

(\PR.KBDChangedP
  (LAMBDA (ORIGKEYLST ADDRSLST MASKLST)                      (* JonL "29-Mar-84 17:17")
    (SELECTQ (SYSTEMTYPE)
	     (D (find A in ADDRSLST as WORD in ORIGKEYLST as MASK in MASKLST
		   suchthat (NEQ WORD (LOGOR MASK (\GETBASE A 0)))))
	     (READP T))))
)

(RPAQQ \PR.REMOVALS NIL)

(RPAQ? DEFAULT.REMINDER.DURATION 74Q)

(RPAQ? DEFAULT.REMINDER.WINKINGDURATION 12Q)

(RPAQ? PERIODIC.PROMPT.REMINDERS NIL)

(RPAQ? REMINDERSTREAM (SELECTQ (SYSTEMTYPE)
			       (D PROMPTWINDOW)
			       (PROGN (RPAQ \RCLKSECOND 1750Q)
				      T)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \PR.REMOVALS REMINDERSTREAM \RCLKSECOND)
)

(PUTPROPS PERIODIC.PROMPT.REMINDERS GLOBALVAR T)

(PUTPROPS DEFAULT.REMINDER.DURATION GLOBALVAR T)

(PUTPROPS DEFAULT.REMINDER.WINKINGDURATION GLOBALVAR T)

(PUTPROPS DEFAULT.REMINDER.PERIOD GLOBALVAR T)
(PUTDEF (QUOTE REMINDERS) (QUOTE FILEPKGCOMS) (QUOTE ((TYPE DESCRIPTION "Periodic PROMPT Reminders" 
							    GETDEF \GETREMINDER PUTDEF \PUTREMINDER 
							    DELDEF \DELREMINDER))))
(DEFINEQ

(\REMINDER.PROC
  [LAMBDA NIL                                                (* lmm "12-Apr-85 13:59")
    (do [AWAIT.EVENT \REMINDER.EVENT (bind (DELAY ←(TIMES 5 74Q)) for PR in PERIODIC.PROMPT.REMINDERS
					bind TIMER when [AND [\TIMER.TIMERP (SETQ TIMER
									      (fetch 
									      REMINDER.TIMEOUTBOX
										 of (CADR PR]
							     (NOT (TIMEREXPIRED? TIMER (QUOTE SECONDS]
					do [SETQ DELAY (IMIN DELAY (TIME.UNTIL TIMER (QUOTE SECONDS]
					finally (RETURN (TIMES DELAY 1750Q]
	(PERIODICALLYCHECKREMINDERS])
)
(DECLARE: COPYWHEN (EQ COMPILEMODE (QUOTE D)) 

(RPAQ? CLOSEREMINDERSTREAMFLG NIL)


(RPAQ \REMINDER.EVENT (CREATE.EVENT (QUOTE PERIODIC.PROMPT.REMINDERS)))

(RPAQ \FRCLKSECOND (FLOAT \RCLKSECOND))

(RPAQQ \KEYBOARDLST NIL)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS CLOSEREMINDERSTREAMFLG \REMINDER.EVENT \FRCLKSECOND \KEYBOARDLST)
)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.UTILIN \EM.KBDAD4 \EM.KBDAD5)
)

(DEL.PROCESS (QUOTE REMINDERS.watchDog))
[MAPC (QUOTE (LOGOUTFORMS SYSOUTFORMS MAKESYSFORMS))
      (FUNCTION (LAMBDA (X)
			(MAPC [QUOTE ([BEFORE (PROGN (SETQ \KEYBOARDLST)
						     (DEL.PROCESS (QUOTE REMINDERS.watchDog]
				      (AFTER (PERIODICALLYCHECKREMINDERS (QUOTE RESTART]
			      (FUNCTION (LAMBDA (Y)
						([LAMBDA (VAR FORM VAL)
							 (COND [(BOUNDP VAR)
								(OR (MEMBER FORM (SETQ VAL
										       (EVALV VAR)))
								    (SET VAR (CONS FORM VAL]
							       (T (SET VAR (LIST FORM]
						 (PACK* (CAR Y)
							X)
						 (CADR Y]
)
(NLSETQ (PERIODICALLYCHECKREMINDERS (QUOTE RESTART)))
[SELECTQ (SYSTEMTYPE)
	 (D)
	 (PROGN (ADDTOVAR PROMPTCHARFORMS (PERIODICALLYCHECKREMINDERS]
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA REMINDER.PERIOD REMINDER.EXPIRATIONDATE REMINDER.NEXTREMINDDATE)
)
(PUTPROPS PROMPTREMINDERS COPYRIGHT ("Xerox Corporation" 3676Q 3677Q 3700Q 3701Q))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (15564Q 34103Q (SETREMINDER 15576Q . 22733Q) (ACTIVEREMINDERNAMES 22735Q . 23211Q) (
INSPECTREMINDER 23213Q . 25207Q) (REMINDER.NEXTREMINDDATE 25211Q . 27500Q) (REMINDER.EXPIRATIONDATE 
27502Q . 32277Q) (REMINDER.PERIOD 32301Q . 34101Q)) (34457Q 41410Q (\PUTREMINDER 34471Q . 40013Q) (
\GETREMINDER 40015Q . 40256Q) (\DELREMINDER 40260Q . 41406Q)) (41411Q 65314Q (
PERIODICALLYCHECKREMINDERS 41423Q . 54315Q) (UNTILKEYDOWNP 54317Q . 63314Q) (\PR.WINKMESSAGE 63316Q . 
64622Q) (\PR.KBDChangedP 64624Q . 65312Q)) (66753Q 70172Q (\REMINDER.PROC 66765Q . 70170Q)))))
STOP