(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