(FILECREATED "19-Feb-84 15:06:15" {PHYLUM}<LISPCORE>LIBRARY>UTILPROC.;1 8111
changes to: (FNS SHOWVMEM)
(VARS UTILPROCCOMS)
previous date: " 7-MAR-83 14:24:29" {PHYLUM}<LISPUSERS>UTILPROC.;17)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT UTILPROCCOMS)
(RPAQQ UTILPROCCOMS ((FNS CLOCKPROC MAILWATCHPROC MOVEPROC RSHOWPROC SHOWPROC)
(INITVARS (USENETDATE)
(RSHOWWINDOW)
(SHOWWINDOW))
(LOCALVARS . T)))
(DEFINEQ
(CLOCKPROC
[LAMBDA NIL (* bvm: "10-MAY-82 15:06")
(DECLARE (GLOBALVARS USENETDATE))
(PROG ((DS (WINDOWPROP [COND
((AND (BOUNDP (QUOTE CLOCKWINDOW))
(WINDOWP CLOCKWINDOW))
CLOCKWINDOW)
(T (SETQ CLOCKWINDOW (CREATEW (create REGION
LEFT ←(IDIFFERENCE
(fetch BITMAPWIDTH
of (SCREENBITMAP))
135)
BOTTOM ←(IDIFFERENCE
(fetch BITMAPHEIGHT
of (SCREENBITMAP))
30)
WIDTH ← 125
HEIGHT ← 16]
(QUOTE DSP)))
(DTBOX (CREATECELL \FIXP)))
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
10
(QUOTE BOLD))
DS)
[WINDOWPROP DS (QUOTE BUTTONEVENTFN)
(FUNCTION (LAMBDA (WINDOW)
(COND
((LASTMOUSESTATE (NOT UP))
(CLEARW WINDOW)
(WAKE.PROCESS (QUOTE CLOCKPROC]
LP (CLEAR DS)
(MOVETO 0 0 DS)
(PRIN3 (SUBSTRING [GDATE (ALTO.TO.LISP.DATE (SETQ DTBOX (OR (AND USENETDATE (NETDAYTIME0))
(DAYTIME0 DTBOX]
1 -4)
DS)
(BLOCK (IDIFFERENCE 60000 (ITIMES (IREMAINDER (LRSH DTBOX 1)
30)
2000)))
(GO LP])
(MAILWATCHPROC
[LAMBDA NIL (* bvm: "23-MAR-82 16:40")
(DECLARE (GLOBALVARS PROMPTCHARFORMS \WakeUpKey MAILINTERVAL USERNAME))
(* * Like MAILWATCHER, but runs as a process, periodically checking user's mailbox and printing status in its own
window)
(PROG ((WINDOW (DECODE/WINDOW/OR/DISPLAYSTREAM NIL (QUOTE MAILWINDOW)
"Mail status"))
(DOMAILCHECK T)
(INFO (GETPROP USERNAME (QUOTE MAILBOX)))
(FREQ (IQUOTIENT MAILINTERVAL 60000))
LASTMAIL X NEWMAIL? CNTR) (* FREQ is number of times we have to block.
Block interval is chosen to be smallp)
[COND
((SETQ X (ASSOC (QUOTE MAILWATCHER)
PROMPTCHARFORMS))
(SETQ PROMPTCHARFORMS (DREMOVE X PROMPTCHARFORMS]
(DSPSCROLL T WINDOW)
(DSPFONT (FONTCREATE (QUOTE HELVETICA)
8)
WINDOW)
[WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION (LAMBDA (WINDOW)
(COND
((LASTMOUSESTATE (NOT UP))
(WAKE.PROCESS (QUOTE MAILWATCHPROC]
(DSPRESET WINDOW)
LP [SETQ NEWMAIL? (MAILCHECK USERNAME (AND INFO (OR (CAR (LISTP INFO))
INFO))
(CADR (LISTP INFO]
[COND
[(NOT NEWMAIL?)
(DSPRESET WINDOW)
(COND
(DOMAILCHECK (PRIN1 "[No new mail]" WINDOW]
([OR DOMAILCHECK (AND (NEQ NEWMAIL? (QUOTE ?))
(NOT (EQUAL NEWMAIL? LASTMAIL]
(COND
(LASTMAIL (TERPRI WINDOW))
(T (DSPRESET WINDOW)))
(PRIN3 NEWMAIL? WINDOW)
(AND (NEQ NEWMAIL? (QUOTE ?))
(SETQ LASTMAIL NEWMAIL?]
(SETQ CNTR FREQ)
(do (add CNTR -1)
(SETQ DOMAILCHECK (NEQ (BLOCK 60000)
PSTAT.TIMEDOUT))
repeatuntil (OR DOMAILCHECK (ZEROP CNTR)))
(GO LP])
(MOVEPROC
[LAMBDA (W SPEED INREGION) (* bvm: " 5-APR-82 15:59")
(OR SPEED (SETQ SPEED 100))
(OR (WINDOWP W)
(SETQ W (WFROMDS W)))
(PROG ((DX 1)
(DY 1)
(WREG (WINDOWPROP W (QUOTE REGION)))
X Y EXTREME REFWINDOW)
[COND
((NOT INREGION)
(SETQ INREGION WHOLEDISPLAY))
((NOT (type? REGION INREGION))
(SETQ INREGION (WINDOWPROP (SETQ REFWINDOW INREGION)
(QUOTE REGION]
(SETQ X (fetch LEFT of WREG))
(SETQ Y (fetch BOTTOM of WREG))
LP [COND
((ILEQ (add X DX)
(SETQ EXTREME (fetch LEFT of INREGION)))
(SETQ DX (RAND 1 SPEED))
(SETQ X EXTREME))
([IGEQ X (SETQ EXTREME (IDIFFERENCE (fetch RIGHT of INREGION)
(fetch WIDTH of WREG]
(SETQ X EXTREME)
(SETQ DX (IMINUS (RAND 1 SPEED]
[COND
((ILEQ (add Y DY)
(SETQ EXTREME (fetch BOTTOM of INREGION)))
(SETQ Y EXTREME)
(SETQ DY (RAND 1 SPEED)))
([IGEQ Y (SETQ EXTREME (IDIFFERENCE (fetch TOP of INREGION)
(fetch HEIGHT of WREG]
(SETQ Y EXTREME)
(SETQ DY (IMINUS (RAND 1 SPEED]
(MOVEW W (create POSITION
XCOORD ← X
YCOORD ← Y))
(BLOCK)
[AND REFWINDOW (SETQ INREGION (WINDOWPROP REFWINDOW (QUOTE REGION]
(GO LP])
(RSHOWPROC
[LAMBDA (SPEED) (* lmm "16-JUN-82 17:36")
(OR SPEED (SETQ SPEED 12Q))
(OR RSHOWWINDOW (SETQ RSHOWWINDOW (CREATEW NIL NIL 1)))
(PROG ((DX 1)
(DY 1)
(WREG (WINDOWPROP RSHOWWINDOW (QUOTE REGION)))
X Y EXTREME REFWINDOW INREGION)
[COND
((NOT INREGION)
(SETQ INREGION WHOLEDISPLAY))
((NOT (type? REGION INREGION))
(SETQ INREGION (WINDOWPROP (SETQ REFWINDOW INREGION)
(QUOTE REGION]
(SETQ X (fetch LEFT of WREG))
(SETQ Y (fetch BOTTOM of WREG))
LP (PROG [(W (WINDOWPROP RSHOWWINDOW (QUOTE WIDTH)))
(H (WINDOWPROP RSHOWWINDOW (QUOTE HEIGHT]
[COND
((ILEQ (add X DX)
(SETQ EXTREME (fetch LEFT of INREGION)))
(SETQ DX (RAND 1 SPEED))
(SETQ X EXTREME))
([IGEQ X (SETQ EXTREME (IDIFFERENCE (fetch RIGHT of INREGION)
(fetch WIDTH of WREG]
(SETQ X EXTREME)
(SETQ DX (IMINUS (RAND 1 SPEED]
[COND
((ILEQ (add Y DY)
(SETQ EXTREME (fetch BOTTOM of INREGION)))
(SETQ Y EXTREME)
(SETQ DY (RAND 1 SPEED)))
([IGEQ Y (SETQ EXTREME (IDIFFERENCE (fetch TOP of INREGION)
(fetch HEIGHT of WREG]
(SETQ Y EXTREME)
(SETQ DY (IMINUS (RAND 1 SPEED]
(DRAWGRAYBOX X Y (IPLUS X W)
(IPLUS Y H))
(BITBLT (SCREENBITMAP)
X Y RSHOWWINDOW)
(COND
((ILESSP (IDIFFERENCE SCREENHEIGHT Y)
H)
(BITBLT NIL NIL NIL RSHOWWINDOW NIL (IDIFFERENCE SCREENHEIGHT Y)
NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WINDOWBACKGROUNDSHADE)))
(COND
((ILESSP (IDIFFERENCE SCREENWIDTH X)
W)
(BITBLT NIL NIL NIL RSHOWWINDOW (IDIFFERENCE SCREENWIDTH X)
NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WINDOWBACKGROUNDSHADE)))
(DRAWGRAYBOX X Y (IPLUS X W)
(IPLUS Y H)))
(BLOCK)
[AND REFWINDOW (SETQ INREGION (WINDOWPROP REFWINDOW (QUOTE REGION]
(GO LP])
(SHOWPROC
[LAMBDA NIL (* lmm "15-JUN-82 16:03")
(OR SHOWWINDOW (SETQ SHOWWINDOW (CREATEW NIL NIL 1)))
(do (BLOCK)
(BITBLT (SCREENBITMAP)
LASTMOUSEX LASTMOUSEY SHOWWINDOW)
(COND
((ILESSP (IDIFFERENCE SCREENHEIGHT LASTMOUSEY)
(WINDOWPROP SHOWWINDOW (QUOTE HEIGHT)))
(BITBLT NIL NIL NIL SHOWWINDOW NIL (IDIFFERENCE SCREENHEIGHT LASTMOUSEY)
NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WINDOWBACKGROUNDSHADE)))
(COND
((ILESSP (IDIFFERENCE SCREENWIDTH LASTMOUSEX)
(WINDOWPROP SHOWWINDOW (QUOTE WIDTH)))
(BITBLT NIL NIL NIL SHOWWINDOW (IDIFFERENCE SCREENWIDTH LASTMOUSEX)
NIL NIL NIL (QUOTE TEXTURE)
(QUOTE REPLACE)
WINDOWBACKGROUNDSHADE])
)
(RPAQ? USENETDATE )
(RPAQ? RSHOWWINDOW )
(RPAQ? SHOWWINDOW )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(PUTPROPS UTILPROC COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (484 7903 (CLOCKPROC 494 . 1766) (MAILWATCHPROC 1768 . 3621) (MOVEPROC 3623 . 5040) (
RSHOWPROC 5042 . 7135) (SHOWPROC 7137 . 7901)))))
STOP