(FILECREATED " 8-Sep-85 17:24:33" {ERIS}<CUTTING>LISP>IDLER.;22 22881
changes to: (VARS IDLERCOMS)
(FNS IDLE.SET.OPTION IDLE.SHOW.OPTION \IDLER \IDLE.EXIT? \IDLE.IS.PREVIOUS
\IDLE.ISMEMBER \IDLE.STRING-EQUAL)
previous date: " 7-Sep-85 17:07:54" {ERIS}<CUTTING>LISP>IDLER.;21)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IDLERCOMS)
(RPAQQ IDLERCOMS ((COMS
(* * Basic idling facility)
(FNS IDLE IDLE.SET.OPTION IDLE.SHOW.OPTION \IDLER \IDLE.OUT \IDLE.EXIT? \IDLE.IS.PREVIOUS
\IDLE.ISMEMBER \IDLE.AUTHENTICATE \IDLE.STRING-EQUAL)
(INITVARS [IDLE.PROFILE (QUOTE (ALLOWED.LOGINS LOGIN FORGET NIL TIMEOUT 10 DISPLAYFN
IDLE.BOUNCING.BOX SAVEVM 10
SUSPEND.PROCESS.NAMES
(MOUSE LAFITEMAILWATCH CROCK.PROCESS
SPACEWINDOW REMINDERS.WATCHDOG)
RESETVARS
((PUPTRACEFLG NIL)
(XIPTRACEFLG NIL)
(\AFTERLOGINFNS NIL)
(SAVEVMMAX (REALMEMORYSIZE]
(\IDLING))
(GLOBALVARS IDLE.PROFILE \IDLING \LASTUSERACTION)
(APPENDVARS (TTYBACKGROUNDFNS \IDLE.OUT))
[ADDVARS
(BackgroundMenuCommands
(Idle (QUOTE (IDLE))
"Enter Idle mode"
(SUBITEMS ("Timeout" (QUOTE (IDLE.SET.OPTION (QUOTE TIMEOUT)))
"Set how long before idling started")
("Display" (QUOTE (IDLE.SET.OPTION (QUOTE DISPLAYFN)))
"Choose idle display")
["Allowed Logins"
(QUOTE (IDLE.SHOW.OPTION (QUOTE ALLOWED.LOGINS)))
"Who can exit idle mode"
(SUBITEMS ("Unlocked" (QUOTE (IDLE.SET.OPTION (QUOTE ALLOWED.LOGINS)
(QUOTE UNLOCKED)))
"Just exit, no login")
("Login" (QUOTE (IDLE.SET.OPTION (QUOTE ALLOWED.LOGINS)
(QUOTE LOGIN)))
"Any user, require login")
("Authenticate" (QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE AUTHENTICATE)
))
"Any user, Check password with net")
("Group" (QUOTE (IDLE.SET.OPTION (QUOTE ALLOWED.LOGINS)
(QUOTE ADD)))
"Specify group of users"
(SUBITEMS ("Add Previous User"
(QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
T))
"Verify password")
("Add" (QUOTE (IDLE.SET.OPTION
(QUOTE ALLOWED.LOGINS)
(QUOTE ADD)))
"Add a group or username")
("Remove" (QUOTE (IDLE.SET.OPTION
(QUOTE ALLOWED.LOGINS)
(QUOTE REMOVE)))
"Remove a group or username"]
("Forget" (QUOTE (IDLE.SET.OPTION (QUOTE FORGET)))
"Toggle erasure of password upon entering idle mode"]
(VARS (BackgroundMenu)))
(COMS (* * Default idle display)
(FNS IDLE.BOUNCING.BOX IDLE.BITMAP)
[INITVARS (IDLE.BOUNCING.BOX "Interlisp-D")
(IDLE.FUNCTIONS (QUOTE (("Bouncing Box" (QUOTE IDLE.BOUNCING.BOX))
("Bouncing Username" (QUOTE (LAMBDA (W)
(IDLE.BOUNCING.BOX
W
(USERNAME)
400]
(GLOBALVARS IDLE.FUNCTIONS IDLE.BOUNCING.BOX))))
(* * Basic idling facility)
(DEFINEQ
(IDLE
[LAMBDA NIL (* drc: " 7-Sep-85 17:01")
(OR (FNTYP (LISTGET IDLE.PROFILE (QUOTE DISPLAYFN)))
(LISTPUT IDLE.PROFILE (QUOTE DISPLAYFN)
(QUOTE IDLE.BOUNCING.BOX)))
(\CARET.DOWN)
(SETQ \IDLING T)
(ADD.PROCESS (QUOTE (\IDLER))
(QUOTE RESTARTABLE)
T)
(BLOCK])
(IDLE.SET.OPTION
[LAMBDA (OPTION X) (* drc: " 8-Sep-85 16:43")
(CLEARW PROMPTWINDOW)
(IDLE.SHOW.OPTION OPTION "Old")
(LET ((OLD.OPTION (LISTGET IDLE.PROFILE OPTION)))
(LISTPUT IDLE.PROFILE OPTION
(SELECTQ OPTION
(DISPLAYFN (OR (MENU (create MENU
ITEMS ← IDLE.FUNCTIONS))
OLD.OPTION))
(TIMEOUT (LET [(MINS (if (FGETD (QUOTE RNUMBER))
then (RNUMBER "Idle Timeout (in minutes)" NIL
NIL NIL T)
else (MKATOM (PROMPTFORWORD "Idle Timeout:" NIL NIL
PROMPTWINDOW NIL
(QUOTE TTY]
(if (NULL MINS)
then OLD.OPTION
elseif (AND (SMALLP MINS)
(GREATERP MINS 0))
then MINS
else NIL)))
(FORGET (NOT OLD.OPTION))
(ALLOWED.LOGINS (SETQ OLD.OPTION (LISTP OLD.OPTION))
(SELECTQ
X
(UNLOCKED NIL)
(LOGIN (QUOTE LOGIN))
(AUTHENTICATE (QUOTE AUTHENTICATE))
(T (UNION (LIST T)
OLD.OPTION))
[ADD (LET [(GROUP (PROMPTFORWORD "Add Allowed Login:"
NIL NIL PROMPTWINDOW
NIL (QUOTE TTY]
(PRINTOUT PROMPTWINDOW " Checking..")
(COND
([OR (AND CH.NET.HINT (STRPOS ":" GROUP)
(CH.LOOKUP.OBJECT GROUP))
(AND DEFAULTREGISTRY
(LISTP (GV.READENTRY GROUP]
(PRINTOUT PROMPTWINDOW "..ok" T)
(CONS GROUP OLD.OPTION))
(T (PRINTOUT PROMPTWINDOW T GROUP
" not a group or username"
T)
OLD.OPTION]
(REMOVE (AND OLD.OPTION
(REMOVE (MENU (create MENU
TITLE ←
"Remove group "
CENTERFLG ← T
ITEMS ← OLD.OPTION))
OLD.OPTION)))
OLD.OPTION))
OLD.OPTION)))
(IDLE.SHOW.OPTION OPTION "New"])
(IDLE.SHOW.OPTION
[LAMBDA (OPTION STRING) (* drc: " 8-Sep-85 17:22")
(LET ((VALUE (LISTGET IDLE.PROFILE OPTION)))
(PRINTOUT PROMPTWINDOW (if STRING
then (CONCAT STRING " ")
else "")
"Idle "
(SELECTQ OPTION
(ALLOWED.LOGINS "Allowed Logins")
(L-CASE OPTION T))
": "
(SELECTQ OPTION
(TIMEOUT (if (AND (SMALLP VALUE)
(GREATERP VALUE 0))
then (CONCAT VALUE " minute" (if (EQ VALUE 1)
then ""
else "s"))
else "never"))
(ALLOWED.LOGINS (if (LISTP VALUE)
then (SUBST "<<Previous User>>" T VALUE)
else (SELECTQ VALUE
(NIL "Unlocked")
(LOGIN "Anyone, require login")
(AUTHENTICATE
"Any user with a network account")
(NS.AUTHENTICATE
"Any user with an NS account")
(GV.AUTHENTICATE
"Any user with a GV account")
"Bad value for ALLOWED.LOGINS")))
(MKSTRING VALUE))
T])
(\IDLER
[LAMBDA NIL (* drc: " 8-Sep-85 17:23")
(RESETLST (RESETSAVE NIL (QUOTE (SETTOPVAL \IDLING NIL)))
(PROG ((START.TIME (ALTO.TO.LISP.DATE \LASTUSERACTION))
W SAVEVM.TIMER IDLE.PROCESS NO.ERROR EXIT? INTERRUPTED.STRING)
(OR (OBTAIN.MONITORLOCK \GETPASSWORD.LOCK T T)
(PROGN (* someone else trying to login)
(RETURN)))
(PROGN (* do things like dump cache listings and flush files
to servers *before* passwords get smashed)
(\USEREVENT (QUOTE BEFORESAVEVM))
(\DEVICEEVENT (QUOTE BEFORESAVEVM)))
[for X in (LISTGET IDLE.PROFILE (QUOTE RESETVARS))
do (* turn off things like pup-trace, xiptrace and the
like)
[RESETSAVE NIL (LIST (QUOTE SETTOPVAL)
(CAR X)
(GETTOPVAL (CAR X]
(SETTOPVAL (CAR X)
(EVAL (CADR X]
(RESETSAVE (GCGAG NIL))
[for X in (LISTGET IDLE.PROFILE (QUOTE SUSPEND.PROCESS.NAMES)) bind PROC
do (* Turn off things like CROCK, LAFITEMAILWATCH,
SPACEWINDOW, REMINDERS)
(COND
((SETQ PROC (FIND.PROCESS X))
(RESETSAVE NIL (LIST (FUNCTION WAKE.PROCESS)
PROC))
(SUSPEND.PROCESS PROC] (* so that mouse buttons will trigger READP)
(RESETSAVE (MODIFY.KEYACTIONS (QUOTE ((LEFT (18 18)
18 18)
(MIDDLE (18 18)
18 18)
(RIGHT (18 18)
18 18)))
T))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
(RESETSAVE (RESET.INTERRUPTS NIL T))
(AND (LISTGET IDLE.PROFILE (QUOTE FORGET))
(SETPASSWORD NIL (USERNAME)
""))
(\CARET.DOWN)
(SETQ W (CREATEW WHOLESCREEN NIL 0 T))
(CLEARW PROMPTWINDOW)
[RESETSAVE (CURSOR (CURSORCREATE (BITMAPCREATE 0 0]
(RESETSAVE NIL (BQUOTE (CLOSEW , W)))
(RESETSAVE (VIDEOCOLOR T))
(RESETSAVE (CHANGEBACKGROUNDBORDER WHITESHADE))
(OPENW W)
[AND (SMALLP (LISTGET IDLE.PROFILE (QUOTE SAVEVM)))
(SETQ SAVEVM.TIMER (SETUPTIMER (TIMES (LISTGET IDLE.PROFILE (QUOTE SAVEVM))
60000]
[SETQ IDLE.PROCESS (ADD.PROCESS (CONS (LISTGET IDLE.PROFILE (QUOTE DISPLAYFN))
(CONS W (LISTGET IDLE.PROFILE (QUOTE
DISPLAY.DATA]
[RESETSAVE NIL (BQUOTE (AND (PROCESSP (QUOTE , IDLE.PROCESS))
(DEL.PROCESS (QUOTE , IDLE.PROCESS]
(BLOCK) (* Let the demo get started first)
WAIT.FOR.CHAR
(if (NOT (READP))
then (BLOCK 250)
(\SAVEVMBACKGROUND)
(if (AND SAVEVM.TIMER (TIMEREXPIRED? SAVEVM.TIMER))
then (RESETFORM (CURSOR SAVINGCURSOR)
(SAVEVM))
(SETQ SAVEVM.TIMER))
(GO WAIT.FOR.CHAR))
(COND
((PROCESSP IDLE.PROCESS)
(SUSPEND.PROCESS IDLE.PROCESS)))
[SETQ NO.ERROR (NLSETQ (SETQ EXIT? (\IDLE.EXIT?]
(COND
((NOT NO.ERROR)
(SETQ INTERRUPTED.STRING "ERROR while checking Allowed Logins"))
((NOT EXIT?)
[SETQ INTERRUPTED.STRING (CONCAT "Someone tried to use the machine at "
(GDATE NIL (DATEFORMAT NO.DATE]
(DISMISS 5000)
(AND IDLE.PROCESS (WAKE.PROCESS IDLE.PROCESS))
(CLEARBUF T)
(GO WAIT.FOR.CHAR)))
EXIT(CLOSEW W)
(FRESHLINE PROMPTWINDOW)
(AND INTERRUPTED.STRING (PRINTOUT PROMPTWINDOW INTERRUPTED.STRING T))
(PRINTOUT PROMPTWINDOW "Idle time " (LET [(GONE (IDIFFERENCE (IDATE)
START.TIME))
(ONEDAY (IDIFFERENCE (IDATE
"2-Jan-80 00:00:00")
(IDATE
"1-Jan-80 00:00:00"]
(if (ILESSP GONE ONEDAY)
then (GDATE (IPLUS (IDATE
"1-Jan-80 00:00:00")
GONE)
(DATEFORMAT NO.DATE))
else (CONCAT (SETQ GONE
(QUOTIENT GONE ONEDAY))
" day"
(if (GREATERP GONE 1)
then "s."
else "."])
(\IDLE.OUT
[LAMBDA NIL (* drc: " 4-Sep-85 14:23")
(AND (NOT \IDLING)
(SMALLP (LISTGET IDLE.PROFILE (QUOTE TIMEOUT)))
(GREATERP (LISTGET IDLE.PROFILE (QUOTE TIMEOUT))
0)
(\SECONDSCLOCKGREATERP \LASTUSERACTION (TIMES (LISTGET IDLE.PROFILE (QUOTE TIMEOUT))
60))
(IDLE])
(\IDLE.EXIT?
[LAMBDA NIL (* drc: " 8-Sep-85 17:18")
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(CLEARBUF T)
(LET ((GROUP (LISTGET IDLE.PROFILE (QUOTE ALLOWED.LOGINS)))
(NAME (USERNAME))
PWD OLDPWD)
(if (OR (NULL GROUP)
(NULL NAME)
(\IDLE.STRING-EQUAL NAME ""))
then (* We don't need a password)
T
else (CLEARW PROMPTWINDOW) (* prompt for password, maybe new username)
[SETQ PWD (if (EQUAL GROUP (QUOTE (T)))
then (* Only previous user allowed to login)
(PROMPTFORWORD (CONCAT (USERNAME)
" password:")
NIL NIL NIL (QUOTE *)
(QUOTE TTY))
else (PROG1 [CDR (SETQ NAME (\LOGIN.READ NIL NAME NIL NIL
(QUOTE NS]
(SETQ NAME (MKSTRING (CAR NAME]
(* decide whether NAME and PWD are in GROUP)
(if [SELECTQ GROUP
(LOGIN T)
((AUTHENTICATE NS.AUTHENTICATE GV.AUTHENTICATE)
(\IDLE.AUTHENTICATE NAME PWD GROUP))
(COND
((NLISTP GROUP)
(PRINTOUT T "Bad value for Idle ALLOWED.LOGINS")
T)
((AND (MEMB T GROUP)
(\IDLE.IS.PREVIOUS NAME PWD)))
((\IDLE.ISMEMBER GROUP NAME PWD]
then (* Yes, let them in)
(SETPASSWORD NIL NAME PWD)
T
else (* Nope. Go idle some more)
(AND (\IDLE.STRING-EQUAL NAME (USERNAME))
(PRINTOUT T " incorrect password" T))
NIL])
(\IDLE.IS.PREVIOUS
[LAMBDA (NAME PWD) (* drc: " 8-Sep-85 17:19")
(AND (\IDLE.STRING-EQUAL (USERNAME)
NAME)
(LET [(OLDPWD (\DECRYPT.PWD (CONCAT (CDR (\INTERNAL/GETPASSWORD]
(* * note that \INTERNAL/GETPASSWORD will do a login if noone is logged in. That should never happen here, as we
check above for username = nullString , but this can cause strange behaviour if one is not careful)
(OR (\IDLE.STRING-EQUAL OLDPWD "")
(\IDLE.STRING-EQUAL PWD OLDPWD])
(\IDLE.ISMEMBER
[LAMBDA (GROUP NAME PWD) (* drc: " 8-Sep-85 17:19")
(OR (for X in GROUP suchthat (COND
([if (STRPOS ":" X)
then (EQUAL.CH.NAMES (PARSE.NSNAME NAME)
(PARSE.NSNAME X))
else (\IDLE.STRING-EQUAL X
(if (OR (STRPOS "." NAME)
(NULL DEFAULTREGISTRY)
(NOT (STRPOS "." X)))
then NAME
else (CONCAT NAME "."
DEFAULTREGISTRY]
(PRINTOUT T , X " allowed to login." T)
T)))
(for X in GROUP suchthat (COND
((if (AND DEFAULTREGISTRY (STRPOS "↑." X))
then (PRINTOUT T "..." X "?...")
(SELECTQ (GV.ISMEMBERCLOSURE X (\CHECKNAME NAME))
(T (PRINTOUT T "ok.")
T)
(NIL (PRINTOUT T "no.")
NIL)
(BadRName (PRINTOUT T "not a GV group")
NIL)
T)
elseif (AND CH.NET.HINT (STRPOS ":" X))
then (PRINTOUT T "..." X "?...")
(SELECTQ (CH.ISMEMBER (PARSE.NSNAME X)
(QUOTE MEMBERS)
NIL
(CH.LOOKUP.OBJECT NAME))
(T (PRINTOUT T "ok.")
T)
(NIL (PRINTOUT T "no.")
NIL)
(ERROR (PRINTOUT T "not an NS group")
NIL)
T))
(PRINTOUT T , X " allowed to login.")
T])
(\IDLE.AUTHENTICATE
[LAMBDA (NAME PWD TYPE) (* drc: " 5-Sep-85 15:28")
(* * This does not do the same thing as IDLE.AUTHENTICATE used to. That is now done by \IDLE.EXIT? All this does is
authentication.)
(PRINTOUT PROMPTWINDOW T "Authenticating " NAME " ...")
(LET ((NS (NEQ TYPE (QUOTE GV.AUTHENTICATE)))
(GV (NEQ TYPE (QUOTE NS.AUTHENTICATE)))
CODE)
(AND (EQ TYPE (QUOTE AUTHENTICATE))
(if (STRPOS ":" NAME)
then (SETQ GV)
(SETQ NS T)
elseif (STRPOS "." NAME)
then (SETQ NS)
(SETQ GV T)))
[OR [AND NS (EQ T (SETQ CODE (NS.AUTHENTICATE (NS.MAKE.SIMPLE.CREDENTIALS
(CONS NAME (\ENCRYPT.PWD (CONCAT PWD]
(AND GV (SETQ CODE (GV.AUTHENTICATE NAME (\ENCRYPT.PWD (CONCAT PWD]
(SELECTQ CODE
(AllDown (PRINTOUT PROMPTWINDOW "All authentication servers down" T)
(NEQ MODE (QUOTE LOCK)))
((T NIL)
(PRINTOUT PROMPTWINDOW "ok.")
T)
((CredentialsInvalid BadRName BadPassword)
(PRINTOUT PROMPTWINDOW CODE T)
NIL)
(PROGN (PRINTOUT PROMPTWINDOW T "Odd response from authenticator: " CODE)
T])
(\IDLE.STRING-EQUAL
[LAMBDA (X Y) (* drc: " 8-Sep-85 16:38")
(* * I use this instead of STRING-EQUAL for 2 reasons: (1) STRING-EQUAL is not in Intermezzo sysouts, and
(2) In the Common Lisp specification STRING-EQUAL will not work for atoms.)
(STREQUAL (U-CASE (MKSTRING X))
(U-CASE (MKSTRING Y])
)
(RPAQ? IDLE.PROFILE [QUOTE (ALLOWED.LOGINS LOGIN FORGET NIL TIMEOUT 10 DISPLAYFN IDLE.BOUNCING.BOX
SAVEVM 10 SUSPEND.PROCESS.NAMES
(MOUSE LAFITEMAILWATCH CROCK.PROCESS SPACEWINDOW
REMINDERS.WATCHDOG)
RESETVARS
((PUPTRACEFLG NIL)
(XIPTRACEFLG NIL)
(\AFTERLOGINFNS NIL)
(SAVEVMMAX (REALMEMORYSIZE])
(RPAQ? \IDLING )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS IDLE.PROFILE \IDLING \LASTUSERACTION)
)
(APPENDTOVAR TTYBACKGROUNDFNS \IDLE.OUT)
(ADDTOVAR BackgroundMenuCommands (Idle
(QUOTE (IDLE))
"Enter Idle mode"
(SUBITEMS ("Timeout" (QUOTE (IDLE.SET.OPTION (QUOTE TIMEOUT)))
"Set how long before idling started")
("Display" (QUOTE (IDLE.SET.OPTION (QUOTE DISPLAYFN)))
"Choose idle display")
["Allowed Logins" (QUOTE (IDLE.SHOW.OPTION (QUOTE ALLOWED.LOGINS)))
"Who can exit idle mode"
(SUBITEMS ("Unlocked" (QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE UNLOCKED)
))
"Just exit, no login")
("Login" (QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE LOGIN)))
"Any user, require login")
("Authenticate" (QUOTE (IDLE.SET.OPTION
(QUOTE ALLOWED.LOGINS)
(QUOTE AUTHENTICATE)))
"Any user, Check password with net")
("Group" (QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE ADD)))
"Specify group of users"
(SUBITEMS
("Add Previous User"
(QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
T))
"Verify password")
("Add" (QUOTE (IDLE.SET.OPTION
(QUOTE ALLOWED.LOGINS)
(QUOTE ADD)))
"Add a group or username")
("Remove" (QUOTE (IDLE.SET.OPTION
(QUOTE ALLOWED.LOGINS)
(QUOTE REMOVE)))
"Remove a group or username"]
("Forget" (QUOTE (IDLE.SET.OPTION (QUOTE FORGET)))
"Toggle erasure of password upon entering idle mode"))))
(RPAQQ BackgroundMenu NIL)
(* * Default idle display)
(DEFINEQ
(IDLE.BOUNCING.BOX
[LAMBDA (WINDOW BOX WAIT) (* drc: "30-Aug-85 15:45")
(OR WAIT (SETQ WAIT 1000))
(OR BOX (SETQ BOX IDLE.BOUNCING.BOX))
(RESETLST (LET ((MAXX (WINDOWPROP WINDOW (QUOTE WIDTH)))
(MAXY (WINDOWPROP WINDOW (QUOTE HEIGHT)))
BITMAP)
(if (LISTP BOX)
then (SETQ BOX (COPY BOX)) (* don't want to trash user's box)
(RESETSAVE NIL (BQUOTE (RPLACD , BOX NIL)))
(* remove circularity so it can be GC'd)
(NCONC BOX BOX) (* make it circular))
(while T
do (SETQ BITMAP (IDLE.BITMAP BITMAP BOX))
(AND (LISTP BOX)
(SETQ BOX (CDR BOX))) (* rotate it)
[SETQ X (RAND (IDIFFERENCE MAXX (BITMAPWIDTH BITMAP]
[SETQ Y (RAND (IDIFFERENCE MAXY (BITMAPHEIGHT BITMAP]
(BITBLT BITMAP 0 0 WINDOW X Y NIL NIL NIL (QUOTE INVERT))
(BLOCK WAIT)
(BITBLT BITMAP 0 0 WINDOW X Y NIL NIL NIL (QUOTE INVERT])
(IDLE.BITMAP
[LAMBDA (BITMAP BOX) (* drc: "30-Aug-85 15:52")
(if (STRINGP BOX)
then (if (BITMAPP BITMAP)
then BITMAP
else (LET ((FONT (FONTCREATE (QUOTE TIMESROMAND)
36))
DSP)
(SETQ BITMAP (BITMAPCREATE (STRINGWIDTH BOX FONT)
(FONTHEIGHT FONT)))
(SETQ DSP (DSPCREATE BITMAP))
(DSPFONT FONT DSP)
(MOVETO 0 (DIFFERENCE (FONTHEIGHT FONT)
(FONTASCENT FONT))
DSP)
(PRIN3 BOX DSP)
BITMAP))
elseif (BITMAPP BOX)
then BOX
elseif (LISTP BOX)
then [OR (BITMAPP (SETQ BITMAP (CAR BOX)))
(CAR (RPLACA BOX (IDLE.BITMAP NIL BITMAP]
elseif (WINDOWP BOX)
then (LET [(REGION (WINDOWPROP BOX (QUOTE REGION]
(SETQ BITMAP (BITMAPCREATE (fetch (REGION WIDTH) of REGION)
(fetch (REGION HEIGHT) of REGION)))
(TOTOPW BOX)
(BITBLT (SCREENBITMAP)
(fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
BITMAP)
BITMAP)
else (IDLE.BITMAP BITMAP "Interlisp-D"])
)
(RPAQ? IDLE.BOUNCING.BOX "Interlisp-D")
(RPAQ? IDLE.FUNCTIONS [QUOTE (("Bouncing Box" (QUOTE IDLE.BOUNCING.BOX))
("Bouncing Username" (QUOTE (LAMBDA (W)
(IDLE.BOUNCING.BOX W (USERNAME)
400])
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS IDLE.FUNCTIONS IDLE.BOUNCING.BOX)
)
(PUTPROPS IDLER COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3142 17730 (IDLE 3152 . 3553) (IDLE.SET.OPTION 3555 . 5673) (IDLE.SHOW.OPTION 5675 .
6846) (\IDLER 6848 . 11580) (\IDLE.OUT 11582 . 11987) (\IDLE.EXIT? 11989 . 13859) (\IDLE.IS.PREVIOUS
13861 . 14453) (\IDLE.ISMEMBER 14455 . 15990) (\IDLE.AUTHENTICATE 15992 . 17319) (\IDLE.STRING-EQUAL
17321 . 17728)) (19942 22487 (IDLE.BOUNCING.BOX 19952 . 21162) (IDLE.BITMAP 21164 . 22485)))))
STOP