(FILECREATED " 2-Jan-85 08:44:03" {ERIS}<LISPCORE>LIBRARY>PAGEHOLD.;28 19488
changes to: (FNS END.OF.PAGE.HOLD)
previous date: "13-Dec-84 04:28:27" {ERIS}<LISPCORE>LIBRARY>PAGEHOLD.;27)
(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PAGEHOLDCOMS)
(RPAQQ PAGEHOLDCOMS ((COMS (* * "Temporary kludge patches.")
(P (UNADVISE PAGEFULLFN)))
(COMS (* "Parameters adjustable by user.")
(INITVARS (PAGE.WAIT.SECONDS 20)
(PAGE.WAIT.ACTIVITY (QUOTE WINKING))
(PAGE.WAIT.IGNORETYPEAHEAD NIL)
(PAGE.WAIT.FONT (FONTCREATE (QUOTE HELVETICA)
12))
(PAGE.WAIT.HOLDMSG (QUOTE (" -- SHIFT to hold typeout -- "
198)))
(PAGE.WAIT.RELEASEMSG (QUOTE (" -- Release SHIFT for more -- "
215)))
(PAGE.WAIT.STOPMSG (QUOTE (" -- Scrolling Stopped -- " 169))))
(GLOBALVARS PAGE.WAIT.SECONDS PAGE.WAIT.ACTIVITY PAGE.WAIT.IGNORETYPEAHEAD
PAGE.WAIT.FONT PAGE.WAIT.HOLDMSG PAGE.WAIT.RELEASEMSG
PAGE.WAIT.STOPMSG))
(DECLARE: DONTCOPY (MACROS SHIFTDOWN? CTRLREALLYDOWN?)
(RECORDS PAGEHOLDBUTTON PAGEHOLDMSG))
(VARS (HoldingButtonMenu NIL)
(HoldButtonBottomLine (FONTDESCENT PAGE.WAIT.FONT))
(TitleBarHeight (FONTHEIGHT (DSPFONT NIL WindowTitleDisplayStream)))
(\PAGEHOLD.DISMISS.TIMER (SETUPTIMER 0)))
(GLOBALVARS HoldingButtonMenu HoldButtonBottomLine TitleBarHeight
\PAGEHOLD.DISMISS.TIMER)
(FNS END.OF.PAGE.HOLD \PageHold.printMessage \PageHold.buttonEventFn
\PageHold.doMenu)
(COMS (* "Items related to the PAGEHOLDBUTTON resource")
(DECLARE: DONTCOPY (RESOURCES PAGEHOLDBUTTON))
(INITRESOURCES PAGEHOLDBUTTON)
(FNS MakePageHoldButton \PageHold.GET))
(P (MOVD? (QUOTE PAGEFULLFN)
(QUOTE OLDPAGEFULLFN))
(MOVD (QUOTE END.OF.PAGE.HOLD)
(QUOTE PAGEFULLFN)))
(LOCALVARS . T)))
(* * "Temporary kludge patches.")
(UNADVISE PAGEFULLFN)
(* "Parameters adjustable by user.")
(RPAQ? PAGE.WAIT.SECONDS 20)
(RPAQ? PAGE.WAIT.ACTIVITY (QUOTE WINKING))
(RPAQ? PAGE.WAIT.IGNORETYPEAHEAD NIL)
(RPAQ? PAGE.WAIT.FONT (FONTCREATE (QUOTE HELVETICA)
12))
(RPAQ? PAGE.WAIT.HOLDMSG (QUOTE (" -- SHIFT to hold typeout -- " 198)))
(RPAQ? PAGE.WAIT.RELEASEMSG (QUOTE (" -- Release SHIFT for more -- " 215)))
(RPAQ? PAGE.WAIT.STOPMSG (QUOTE (" -- Scrolling Stopped -- " 169)))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS PAGE.WAIT.SECONDS PAGE.WAIT.ACTIVITY PAGE.WAIT.IGNORETYPEAHEAD PAGE.WAIT.FONT
PAGE.WAIT.HOLDMSG PAGE.WAIT.RELEASEMSG PAGE.WAIT.STOPMSG)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS SHIFTDOWN? MACRO (NIL
(OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT)))))
(PUTPROPS CTRLREALLYDOWN? MACRO ((N)
(AND (KEYDOWNP (QUOTE CTRL))
(PROGN (* Consider it a spazz if he didn't keep the CTRL key
down for at least N milliseconds)
(\DISMISS.WITHOUT.BLOCKING N \PAGEHOLD.DISMISS.TIMER)
(KEYDOWNP (QUOTE CTRL))))))
)
[DECLARE: EVAL@COMPILE
(RECORD PAGEHOLDBUTTON (TIMERS ACTIVITY BUTTONIMAGE PAGEHOLDBUTTONWIDTH))
(RECORD PAGEHOLDMSG (MSG WIDTH))
]
)
(RPAQQ HoldingButtonMenu NIL)
(RPAQ HoldButtonBottomLine (FONTDESCENT PAGE.WAIT.FONT))
(RPAQ TitleBarHeight (FONTHEIGHT (DSPFONT NIL WindowTitleDisplayStream)))
(RPAQ \PAGEHOLD.DISMISS.TIMER (SETUPTIMER 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS HoldingButtonMenu HoldButtonBottomLine TitleBarHeight \PAGEHOLD.DISMISS.TIMER)
)
(DEFINEQ
(END.OF.PAGE.HOLD
(LAMBDA (STREAM) (* JonL " 2-Jan-85 08:43")
(LET* ((WINDOW (WFROMDS (if (NULL STREAM)
then (TTYDISPLAYSTREAM)
else (\DTEST STREAM (QUOTE STREAM)))))
(WAIT.SECS (OR (WINDOWPROP WINDOW (QUOTE PAGE.WAIT.SECONDS))
PAGE.WAIT.SECONDS)))
(DECLARE (SPECVARS WINDOW WAIT.SECS))
(if (OR (NULL WAIT.SECS)
(AND (NOT (FIXP WAIT.SECS))
(NEQ WAIT.SECS (QUOTE STOP)))
(EQ (DSPSCROLL NIL WINDOW)
(QUOTE OFF)))
then (* If we're losing because of an invalid value in
PAGE.WAIT.SECONDS then try to fix it up.)
(if (NULL (WINDOWPROP WINDOW (QUOTE PAGE.WAIT.SECONDS)))
then (SETQ PAGE.WAIT.SECONDS 0))
T
elseif (AND (NOT (SHIFTDOWN?))
(NEQ WAIT.SECS (QUOTE STOP))
(OR (ILESSP WAIT.SECS 1)
(CTRLREALLYDOWN? 125)
(AND (NOT PAGE.WAIT.IGNORETYPEAHEAD)
(EQ (THIS.PROCESS)
(TTY.PROCESS))
(READP T))))
then (* Immediate release case)
T
else
(RESETLST (* A RESETLST so that the button can be forced down,
regardless of how things got exited)
(LET* ((CURRENTBUTTON (GETRESOURCE PAGEHOLDBUTTON (OR (WINDOWPROP WINDOW (QUOTE
PAGE.WAIT.ACTIVITY))
PAGE.WAIT.ACTIVITY)))
(BORDERSIZE (OR (FIXP (WINDOWPROP WINDOW (QUOTE BORDER)))
0))
(REG (WINDOWPROP WINDOW (QUOTE REGION)))
(LEFT (IDIFFERENCE (IDIFFERENCE (fetch (REGION PRIGHT) of REG)
BORDERSIZE)
(fetch PAGEHOLDBUTTONWIDTH of CURRENTBUTTON)))
(BOTTOM (IDIFFERENCE (fetch (REGION PTOP) of REG)
(IPLUS TitleBarHeight BORDERSIZE)))
(BUTTON.WINDOW (fetch BUTTONIMAGE of CURRENTBUTTON)))
(if (IGREATERP LEFT (IDIFFERENCE SCREENWIDTH 25))
then (* If the right edge of the window is almost off the
screen then put the "button" on the left side.)
(SETQ LEFT (IPLUS BORDERSIZE (fetch (REGION LEFT) of REG))))
(if (IGREATERP BOTTOM (IDIFFERENCE SCREENHEIGHT 12))
then (* If the top of the window is almost off the screen
then put the "button" on the bottom.)
(SETQ BOTTOM (IPLUS BORDERSIZE (IDIFFERENCE (fetch (REGION BOTTOM)
of REG)
(WINDOWPROP (fetch BUTTONIMAGE
of CURRENTBUTTON)
(QUOTE HEIGHT))))))
(PROG ((INFINITY MAX.FIXP)
(BUTTON.WINDOW (fetch BUTTONIMAGE of CURRENTBUTTON))
(ACTIVITY (fetch ACTIVITY of CURRENTBUTTON))
(FIRSTIMEP T)
(MESSAGESTATE 1)
FLASHINTERVAL MESSAGESTATEINIT STOPFLG INDEFINITEHOLD HOLDPROP WAITTIMER
FLASHTIMER MENUSIGNAL TIMERSLST)
(WINDOWPROP BUTTON.WINDOW (QUOTE END.OF.PAGE.HOLD)
T)
(MOVEW BUTTON.WINDOW LEFT BOTTOM)
(DSPRESET BUTTON.WINDOW)
(RESETSAVE (PROGN BUTTON.WINDOW)
(QUOTE (AND (WINDOWP OLDVALUE)
(CLOSEW OLDVALUE))))
(OPENW BUTTON.WINDOW)
INITIALIZETIMERS
(SETQ TIMERSLST (fetch TIMERS of CURRENTBUTTON))
(SETQ FLASHTIMER (SETUPTIMER 0 (pop TIMERSLST)
(QUOTE TICKS)))
(SETQ FLASHINTERVAL (if (EQ ACTIVITY (QUOTE FLASHING))
then (SETQ MESSAGESTATEINIT 4)
(SELECTC \MACHINETYPE
(\DANDELION (CONSTANT (TIMES 1250
\DLION.RCLKMILLISECOND)))
(CONSTANT (TIMES 1250 \ALTO.RCLKMILLISECOND))
)
else (* So it's WINKING or NIL)
(SETQ MESSAGESTATEINIT 2)
(SELECTC \MACHINETYPE
(\DANDELION (CONSTANT (TIMES 750
\DLION.RCLKMILLISECOND)))
(CONSTANT (TIMES 750 \ALTO.RCLKMILLISECOND)))))
(SETQ WAITTIMER (if (EQ WAIT.SECS (QUOTE STOP))
then (* Initialization done in case a menu selection changes
state)
(SETQ FIRSTIMEP (SETQ STOPFLG T))
(SETQ MESSAGESTATE (SETQ MESSAGESTATEINIT 1))
NIL
else (SETQ STOPFLG)
(SETUPTIMER WAIT.SECS (pop TIMERSLST)
(QUOTE SECONDS))))
(AND INDEFINITEHOLD (BLOCK 375))
LOOP(if FLASHTIMER
then (if (AND (SHIFTDOWN?)
(OR (NULL INDEFINITEHOLD)
(TIMEREXPIRED? INDEFINITEHOLD (QUOTE SECONDS)))
(NOT STOPFLG))
then (* Lock in on holding message while SHIFT is down)
(DSPRESET BUTTON.WINDOW)
(\PageHold.printMessage CURRENTBUTTON T PAGE.WAIT.RELEASEMSG)
(SETQ WAITTIMER (SETQ FLASHTIMER))
elseif (TIMEREXPIRED? FLASHTIMER (QUOTE TICKS))
then (if (OR FIRSTIMEP (AND ACTIVITY (NOT STOPFLG)))
then (SETQ FIRSTIMEP)
(if (ILEQ (add MESSAGESTATE -1)
0)
then (\PageHold.printMessage CURRENTBUTTON T
(if STOPFLG
then
PAGE.WAIT.STOPMSG
else
PAGE.WAIT.RELEASEMSG))
(SETQ MESSAGESTATE MESSAGESTATEINIT)
elseif INDEFINITEHOLD
then (DSPRESET BUTTON.WINDOW)
else (SELECTQ
ACTIVITY
(WINKING (\PageHold.printMessage CURRENTBUTTON
NIL
PAGE.WAIT.HOLDMSG))
(FLASHING (if (ODDP MESSAGESTATE)
then (DSPRESET BUTTON.WINDOW)
else (\PageHold.printMessage
CURRENTBUTTON NIL
(if (IGEQ MESSAGESTATE 2)
then PAGE.WAIT.HOLDMSG
else PAGE.WAIT.RELEASEMSG)
)))
NIL))
else (* Make sure the button continues to be visible, even
when there is no activity)
(TOTOPW BUTTON.WINDOW))
(SETQ FLASHTIMER (SETUPTIMER FLASHINTERVAL FLASHTIMER
(QUOTE TICKS)))))
(BLOCK)
(SELECTQ (SETQ HOLDPROP (WINDOWPROP BUTTON.WINDOW (QUOTE END.OF.PAGE.HOLD)))
((NIL END.OF.PAGE.HOLD) (* Release by simple LEFT mousing)
(RETURN T))
((MENU) (* Aha, some intervention via MENU so first restore the
windowprop to the "waiting" state.)
(WINDOWPROP BUTTON.WINDOW (QUOTE END.OF.PAGE.HOLD)
T)
(SELECTQ (SETQ MENUSIGNAL (\PageHold.doMenu))
(END.OF.PAGE.HOLD (RETURN T))
(PAGE.WAIT.SECONDS (FRESHLINE PROMPTWINDOW)
(SETQ WAIT.SECS
(MKATOM (PROMPTFORWORD
"Default holding timelimit for this window = "
WAIT.SECS NIL
PROMPTWINDOW NIL
30)))
(if (NUMBERP WAIT.SECS)
then (SETQ WAIT.SECS (FIX WAIT.SECS))
elseif (EQ WAIT.SECS (QUOTE STOP))
else (SETQ WAIT.SECS))
(WINDOWPROP WINDOW (QUOTE PAGE.WAIT.SECONDS)
WAIT.SECS)
(SELECTQ WAIT.SECS
(0 (RETURN T))
(NIL (SETQ WAIT.SECS
PAGE.WAIT.SECONDS))
NIL)
(GO INITIALIZETIMERS))
((0 INFINITY DEFAULT STOP)
(SETQ WAIT.SECS (SELECTQ MENUSIGNAL
(0 0)
(INFINITY INFINITY)
(DEFAULT PAGE.WAIT.SECONDS)
(STOP (QUOTE STOP))
NIL))
(FLASHWINDOW WINDOW)
(PROMPTPRINT "Setting Default timelimit for this window to "
MENUSIGNAL)
(WINDOWPROP WINDOW (QUOTE PAGE.WAIT.SECONDS)
(AND (NEQ MENUSIGNAL (QUOTE DEFAULT))
WAIT.SECS))
(if (EQ 0 WAIT.SECS)
then (RETURN)
else (GO INITIALIZETIMERS)))
(T (GO SETUPINDEFINITEHOLD))
((PAGE.WAIT.STOPMSG)
(SETQ WAIT.SECS (QUOTE STOP))
(GO INITIALIZETIMERS))
NIL))
(if (AND (NOT PAGE.WAIT.IGNORETYPEAHEAD)
(EQ (THIS.PROCESS)
(TTY.PROCESS))
(READP T))
then (* Flush the character he typed to "release")
(\GETKEY)
(RETURN)
elseif (AND (NOT STOPFLG)
(CTRLREALLYDOWN? 125))
then (if (NOT (SHIFTDOWN?))
then (* If only the CTRL key is down, then immediate
release.)
(RETURN)
elseif (OR (NULL INDEFINITEHOLD)
(TIMEREXPIRED? INDEFINITEHOLD (QUOTE SECONDS)))
then (GO SETUPINDEFINITEHOLD))))
(if (AND WAITTIMER (TIMEREXPIRED? WAITTIMER (QUOTE SECONDS)))
then (SETQ WAITTIMER))
(if (AND (NOT STOPFLG)
(NULL WAITTIMER)
(NOT (SHIFTDOWN?)))
then (* Basic return from timeout, where no holding action
is present)
(RETURN T))
(GO LOOP)
SETUPINDEFINITEHOLD
(SETQ WAIT.SECS INFINITY)
(SETQ INDEFINITEHOLD (SETUPTIMER 5 (OR INDEFINITEHOLD (pop TIMERSLST))
(QUOTE SECONDS)))
(GO INITIALIZETIMERS))
(FREERESOURCE PAGEHOLDBUTTON CURRENTBUTTON)
T))))))
(\PageHold.printMessage
(LAMBDA (PAGEHOLDBUTTON BOTTOMP MSG) (* JonL " 1-Dec-84 17:03")
(DECLARE (GLOBALVARS HoldButtonBottomLine))
(LET ((BUTTON.WINDOW (fetch BUTTONIMAGE of PAGEHOLDBUTTON)))
(DSPRESET BUTTON.WINDOW)
(if BOTTOMP
then (DSPYPOSITION HoldButtonBottomLine BUTTON.WINDOW))
(DSPXPOSITION (LRSH (DIFFERENCE (fetch PAGEHOLDBUTTONWIDTH of PAGEHOLDBUTTON)
(fetch (PAGEHOLDMSG WIDTH) of MSG))
1)
BUTTON.WINDOW)
(PRIN3 (fetch (PAGEHOLDMSG MSG) of MSG)
BUTTON.WINDOW))))
(\PageHold.buttonEventFn
(LAMBDA (W) (* JonL " 5-Oct-84 23:54")
(WINDOWPROP W (QUOTE END.OF.PAGE.HOLD)
(if (LASTMOUSESTATE MIDDLE)
then (QUOTE MENU)
elseif (LASTMOUSESTATE LEFT)
then (QUOTE END.OF.PAGE.HOLD)
else))))
(\PageHold.doMenu
(LAMBDA NIL (* JonL " 6-Oct-84 18:28")
(MENU (OR HoldingButtonMenu (SETQ HoldingButtonMenu (create MENU
ITEMS ←(QUOTE ((
"set Window Wait to read-in" (QUOTE PAGE.WAIT.SECONDS)
"Window gets new PAGE.WAIT.SECS property from type-in.")
(
"set Window Wait to infinity" (QUOTE INFINITY)
"Set Window's PAGE.WAIT.SECS prop to infinity")
(
"set Window Wait to 0" 0 "Set Window's PAGE.WAIT.SECS prop to 0")
(
"use default Wait value" (QUOTE DEFAULT)
"Remove Window's PAGE.WAIT.SECS property")
(
"set Window Wait to 'stop'" (QUOTE T)
"Set Window's PAGE.WAIT.SECS prop for 'stopping' mode")
(
"Keep this hold indefinitely" (QUOTE T)
"Go into indefinite hold mode")
("simple 'stop' now"
(QUOTE
HoldMessage.stop)
"Puts current hold into 'stopped' state")
("Release this hold!"
(QUOTE
END.OF.PAGE.HOLD)
"Simple release from holding")))
MENUBORDERSIZE ← 1
TITLE ← "Window Wait Options"))))))
)
(* "Items related to the PAGEHOLDBUTTON resource")
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTDEF (QUOTE PAGEHOLDBUTTON)
(QUOTE RESOURCES)
(QUOTE (NEW (MakePageHoldButton . ARGS)
FREE
(RPLACA (OR (find L on (CDR \PAGEHOLDBUTTONS)
suchthat
(NULL (CAR L)))
(LAST (NCONC1 \PAGEHOLDBUTTONS NIL)))
(PROG1 . ARGS))
GET
(\PageHold.GET . ARGS)
INIT
(/SETTOPVAL (QUOTE \PAGEHOLDBUTTONS)
(LIST NIL)))))
)
)
(/SETTOPVAL (QUOTE \PAGEHOLDBUTTONS)
(LIST NIL))
(DEFINEQ
(MakePageHoldButton
(LAMBDA (ACTIVITY) (* JonL " 1-Dec-84 17:04")
(PROG ((BORDERSIZE (SELECTQ (OR ACTIVITY PAGE.WAIT.ACTIVITY)
((WINKING)
8)
((FLASHING)
2)
((NIL)
0)
(PROGN (if ACTIVITY
then (\ILLEGAL.ARG ACTIVITY))
(* Patch up the global variable)
(SETQ PAGE.WAIT.ACTIVITY)
0)))
(MOREWIDTH (STRINGWIDTH (fetch (PAGEHOLDMSG MSG) of PAGE.WAIT.HOLDMSG)
PAGE.WAIT.FONT))
(HOLDINGWIDTH (STRINGWIDTH (fetch (PAGEHOLDMSG MSG) of PAGE.WAIT.RELEASEMSG)
PAGE.WAIT.FONT))
(HoldMessageAdjustment 4)
WINDOW HoldingButtonWidth)
(OR ACTIVITY (SETQ ACTIVITY PAGE.WAIT.ACTIVITY))
(SETQ HoldingButtonWidth (WIDTHIFWINDOW (IPLUS HoldMessageAdjustment HOLDINGWIDTH
HoldMessageAdjustment)
BORDERSIZE))
(SETQ WINDOW (CREATEW (create REGION
WIDTH ← HoldingButtonWidth
HEIGHT ←(HEIGHTIFWINDOW (TIMES (SELECTQ ACTIVITY
(WINKING 2)
1)
(FONTHEIGHT PAGE.WAIT.FONT))
NIL BORDERSIZE))
NIL BORDERSIZE T))
(DSPFONT PAGE.WAIT.FONT WINDOW)
(DSPTEXTURE GRAYSHADE WINDOW)
(WINDOWPROP WINDOW (QUOTE SHRINKFN)
(QUOTE DON'T))
(WINDOWPROP WINDOW (QUOTE RESHAPEFN)
(QUOTE DON'T))
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(QUOTE \PageHold.buttonEventFn))
(WINDOWPROP WINDOW (QUOTE END.OF.PAGE.HOLD)
T)
(RETURN (create PAGEHOLDBUTTON
TIMERS ←(to 3 collect (SETUPTIMER 0))
ACTIVITY ← ACTIVITY
BUTTONIMAGE ← WINDOW
PAGEHOLDBUTTONWIDTH ←(WINDOWPROP WINDOW (QUOTE WIDTH)))))))
(\PageHold.GET
(LAMBDA (ACTIVITY) (* JonL "12-Nov-84 20:28")
(OR (for L on (PROG1 (CDR \PAGEHOLDBUTTONS) (* Comment PPLossage)
)
when (EQ ACTIVITY (fetch (PAGEHOLDBUTTON ACTIVITY) of (CAR L)))
do (RETURN (PROG1 (CAR L)
(RPLACA L NIL))))
(NEWRESOURCE PAGEHOLDBUTTON ACTIVITY))))
)
(MOVD? (QUOTE PAGEFULLFN)
(QUOTE OLDPAGEFULLFN))
(MOVD (QUOTE END.OF.PAGE.HOLD)
(QUOTE PAGEFULLFN))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
(PUTPROPS PAGEHOLD COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3758 16295 (END.OF.PAGE.HOLD 3768 . 14079) (\PageHold.printMessage 14081 . 14726) (
\PageHold.buttonEventFn 14728 . 15063) (\PageHold.doMenu 15065 . 16293)) (16833 19232 (
MakePageHoldButton 16843 . 18799) (\PageHold.GET 18801 . 19230)))))
STOP