(FILECREATED "12-Aug-87 16:33:29" {QV}<NOTECARDS>1.3KNEXT>RGPATCH057.;2 24305
changes to: (VARS RGPATCH057COMS)
(FNS NC.ZapBinLoopProcess NC.AskUserResetWindow NC.AskUser NC.ZapAskUserProcess
NC.SelectNoteCards)
previous date: "12-Aug-87 16:24:22" {QV}<NOTECARDS>1.3KNEXT>RGPATCH057.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RGPATCH057COMS)
(RPAQQ RGPATCH057COMS ((* * rg 8/11/87 now always makes sure interrupts are standard before calling
PROMPTFORWORD or TTYIN, always closes window if exited because of error.
Closing a prompt window aborts the process behind it.)
(* * changes to NCUTLITIES)
(FNS NC.AskUser NC.AskUserResetWindow)
(* * new for NCUTLITIES)
(FNS NC.ZapAskUserProcess)
(* * changes to NCINTERFACE)
(FNS NC.SelectNoteCards)
(* * new for NCINTERFACE)
(FNS NC.ZapBinLoopProcess)))
(* * rg 8/11/87 now always makes sure interrupts are standard before calling PROMPTFORWORD or
TTYIN, always closes window if exited because of error. Closing a prompt window aborts the
process behind it.)
(* * changes to NCUTLITIES)
(DEFINEQ
(NC.AskUser
[LAMBDA (Msg Prompt FirstTry ClearFirstFlg MainWindow DontCloseAtEndFlg DontClearAtEndFlg
PROMPTFORWORDFlg) (* Randy.Gobbel "12-Aug-87 15:22")
(* Get a response from the user -
using the promptwindow attached to MainWindow)
(* * rht 9/16/84: Added DontClearAtEndFlg which if non-nil prevents the call to NC.ClearMsg.)
(* * rht 5/22/85: Now uses TTYIN instead of PROMPTFORWORD so that people can edit their answer.)
(* * rht 5/30/85: Added PROMPTFORWORDFlg so callers doing yes/no questions can get old style PROMPTFORWORD
functionality.)
(* * rht 8/6/85: Wrapped TTYIN with NLSETQ so wouldn't break if CR inadvertantly inserted in string.)
(* * fgh 5/22/86 Added handling of COPYBYBKSYSBUF so that user can shift select into prompt windows being called
from TEdit main windows.)
(* * fgh 6/27/86 Added ERROR! is problems under TTYIN NLSETQ. Allows other process to kill the askuser process.)
(* * rg 5/1/87 fixed problem that sometimes caused Exec window's process to get smashed)
(* * rg 8/11/87 reset interrupts before calling TTYIN)
(LET (AskWindow TextObj)
(RESETLST
(* * If MainWindow is a TEdit window, make sur we can shift select into the prompt window.)
(RESETSAVE NIL (BQUOTE (NC.AskUserResetWindow , (SETQ AskWindow
(NC.PrintMsg MainWindow
ClearFirstFlg Msg)
)
, MainWindow ,
DontClearAtEndFlg ,
DontCloseAtEndFlg)))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
[if (SETQ TextObj (WINDOWPROP MainWindow (QUOTE TEXTOBJ)))
then (RESETSAVE (TEXTPROP TextObj (QUOTE COPYBYBKSYSBUF)
T)
(BQUOTE (TEXTPROP , TextObj COPYBYBKSYSBUF ,
(TEXTPROP TextObj (QUOTE
COPYBYBKSYSBUF]
(* * Go ahead and ask)
(WINDOWPROP AskWindow (QUOTE AskUserProcess)
(THIS.PROCESS))
(WINDOWADDPROP AskWindow (QUOTE CLOSEFN)
(FUNCTION NC.ZapAskUserProcess)
T)
(PROG1 [if PROMPTFORWORDFlg
then (TTY.PROCESS (THIS.PROCESS))
[RESETFORM (RESET.INTERRUPTS (LISPINTERRUPTS)
T)
(PROMPTFORWORD Prompt FirstTry
"To type a ?, type CTRL-V followed by a ?."
AskWindow NIL NIL
(CHARCODE (EOL]
else (RESETLST (RESETSAVE (TTYDISPLAYSTREAM AskWindow))
(RESETSAVE (RESET.INTERRUPTS (LISPINTERRUPTS)
T))
(CAR (OR [NLSETQ (TTYIN
(MKLIST (OR Prompt "")
)
NIL NIL
(QUOTE (STRING NORAISE))
NIL NIL
(AND FirstTry
(LIST FirstTry]
(ERROR!]
(WINDOWDELPROP AskWindow (QUOTE CLOSEFN)
(FUNCTION NC.ZapAskUserProcess])
(NC.AskUserResetWindow
[LAMBDA (AskWindow MainWindow DontClearAtEndFlg DontCloseAtEndFlg)
(* Randy.Gobbel "12-Aug-87 16:02")
(* * called from RESETRESTORE to blow away prompt window, unless flags tell us not to)
(* * rg 3/6/87 created)
(* * rg 5/1/87 now check AskWindow non-nil so we don't accidentally smash the Exec window)
(* * rg 8/11/87 always blow away window on error)
(* * Setting the PromptWindow PROCESS to NIL is to break a circularity caused by TEXTOBJ -> PROMPTWINDOW -> PROCESS
-> TEXTSTREAM -> TEXTOBJ)
(AND AskWindow (WINDOWPROP AskWindow (QUOTE PROCESS)
NIL))
(AND AskWindow (WINDOWDELPROP AskWindow (QUOTE CLOSEFN)
(FUNCTION NC.ZapAskUserProcess)))
(if (EQ RESETSTATE (QUOTE ERROR))
then (NC.ClearMsg MainWindow T)
else (OR DontClearAtEndFlg (NC.ClearMsg MainWindow (NULL DontCloseAtEndFlg])
)
(* * new for NCUTLITIES)
(DEFINEQ
(NC.ZapAskUserProcess
[LAMBDA (Window) (* Randy.Gobbel "12-Aug-87 16:04")
(LET [(AskUserProcess (WINDOWPROP WINDOW (QUOTE AskUserProcess]
(WINDOWDELPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.ZapAskUserProcess))
[AND (PROCESSP AskUserProcess)
(PROCESS.EVAL AskUserProcess (QUOTE (ERROR!]
(QUOTE DON'T])
)
(* * changes to NCINTERFACE)
(DEFINEQ
(NC.SelectNoteCards
[LAMBDA (SingleCardFlg SelectionPredicate Menu InstigatingCardOrWindow Msg CheckForCancelFlg
FileLevelLockFlg) (* Randy.Gobbel "12-Aug-87 16:18")
(* Select a set of note cards or a single note card, depending on SingleCardFlg. Works by interpreting all mouse
presses until a card has been chosen (if SingleCardFlg is T) or until the Done button has been pressed
(if SingleCardFlg is NIL). If the mouse press occus within a Title bar of a notecard, add that note card to the
selected list. Otherwise, if you are pointing into a note card, call the BUTTONEVENTFN for that note card.
The Selection in Progress flag has been set, so all note card BUTTONEVENTFNs should know to ignore all presses
except those that occur on link icons. Link icon presses should simply add the desination of that link to the
selected note cards list. This function should always be called from inside of an NC.CardSelectionOperation
wrapper.)
(* * rht 8/1/84: Changed second RESETSAVE call to give NC.ClearMsg a NIL argument.)
(* * rht 1/9/85: Fixed so now prints name of selected item even it's a link.)
(* * rht 2/15/85: Now can backspace over last selection chosen. Added new arg Msg so that when we reprint the list,
we can reprint the message as well.)
(* * rht 3/23/85: Added the CheckForCancelFlg arg, which if non-nil causes Cancel to be handled differently then
Done after no selections. Namely, Cancel will return the atom CANCELLED whereas Done with no selections returns
NIL. If CheckForCancelFlg is NIL then NIL is returned in both cases.)
(* * fgh 11/14/85 Updated to handle Card and NoteFile objects.)
(* * rht 11/18/85: Fixed so able to select when InstigatingNoteFile is NIL.)
(* * fgh 12/20/85 Totally rewritten for 1.3 selection mechanism. Based on COPYINSERT now rather than on takingf
over the mouse process.)
(* * fgh 1/15/86 Added call to SPAWN.MOUSE in case this is called under the mouse process)
(* * kirk 25Apr86 Changed to use SessionIcon (NC.NoteCardsIconWindow) rather than PROMPTWINDOW if no Instigating
window is supplied.)
(* * fgh 7/5/86 Added code to put CRs into printout of selected cards in order to keep prompt window from getting
infinitely wide to accomdate the printout.)
(* * rht 10/5/86: Now allows choice of cards from remote notefile.)
(* * rht 10/18/86: Give TTY process to process that originally had it if possible.)
(* * rht & pmi 11/14/86: Now checks for valid card before testing SelectionPredicate.)
(* * pmi 12/5/86 Modified prompt messages to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument.)
(* * rg 3/18/87 reworked for NC.CardSelectionOperation: added NAMED-RESETSAVE forms for Card locking.)
(* * 3/23/87: Changed to call REMOVEWINDOW instead of DETACHWINDOW before deleting the attached menu.
Also changed so that menu is attached to InstigatingWindow rather than to PromptWindow. This makes it possible for
windows to "slide down" when selection ends.)
(* * rht 3/24/87: Now calls NC.CoerceToInterestedWindow)
(* * RG 4/1/87 changed CANCELLED to DON'T)
(* * rg 4/22/87 changed some names,)
(* * rht&rg&pmi 4/22/87: Moved location of ALLOW.BUTTON.EVENTS.)
(* * rg 6/2/87 added FileLevelLockFlg)
(* * rht 6/6/87: If user selects a cross-file link card, then try to follow it.)
(DECLARE (USEDFREE CardListResetVar))
(* * if we are running under the mouse process, start up a new mouse process)
(ALLOW.BUTTON.EVENTS)
(LET (Window Card ButtonEventFn InstigatingWindow InstigatingCard InstigatingNoteFile MenuWindow
PromptWindow CopyInsertEvent CardProcessedEvent SelectedCards BinLoopProcess
OldTTYProcess OpInProgress ResetItems TTYResetVar InternalResetVar)
(NAMED-RESETLST
InternalResetVar
(OR SelectionPredicate (SETQ SelectionPredicate (FUNCTION TRUE)))
(SETQ PromptWindow (OR (NC.AttachPromptWindow (SETQ InstigatingWindow
(NC.CoerceToInterestedWindow
InstigatingCardOrWindow)))
PROMPTWINDOW))
(SETQ InstigatingCard (NC.CoerceToCard InstigatingCardOrWindow))
(SETQ InstigatingNoteFile (AND InstigatingCard (fetch (Card NoteFile) of
InstigatingCard)))
(NC.PrintMsg InstigatingWindow T (COND
(Msg (CONCAT Msg (CHARACTER 13)))
(T ""))
"Items shift-selected: ")
(SETQ OldTTYProcess (TTY.PROCESS))
(* * Set up the prompt window for proper use by the CopyInsertFn)
(NAMED-RESETSAVE InternalResetVar (WINDOWPROP PromptWindow (QUOTE SelectCardsMonitor)
(CREATE.MONITORLOCK (QUOTE
SelectCards)))
(BQUOTE (WINDOWPROP , PromptWindow SelectCardsMonitor NIL)))
[WINDOWPROP PromptWindow (QUOTE CopyInsertEvent)
(SETQ CopyInsertEvent (CREATE.EVENT (QUOTE CopyInsertEvent]
(WINDOWPROP PromptWindow (QUOTE NewCardsProcessed)
T)
[WINDOWPROP PromptWindow (QUOTE CardProcessedEvent)
(SETQ CardProcessedEvent (CREATE.EVENT (QUOTE CardProcessedEvent]
(WINDOWPROP PromptWindow (QUOTE SelectNoteCardsProcess)
(THIS.PROCESS))
(WINDOWPROP PromptWindow (QUOTE COPYINSERTFN)
(FUNCTION NC.SelectNoteCardsCopyInsertFn))
(NAMED-RESETSAVE InternalResetVar (WINDOWPROP PromptWindow (QUOTE SelectedCards)
NIL)
(BQUOTE (WINDOWPROP , PromptWindow (QUOTE SelectedCards)
NIL)))
(NAMED-RESETSAVE InternalResetVar (WINDOWPROP PromptWindow (QUOTE SelectingCards)
T)
(BQUOTE (WINDOWPROP , PromptWindow SelectingCards NIL)))
(* * make sure ↑E aborts properly)
(NAMED-RESETSAVE InternalResetVar (RESET.INTERRUPTS (LISPINTERRUPTS)
T))
(* * Make the process behind the prompt window including control for a blinking cursor)
[WINDOWPROP PromptWindow (QUOTE PROCESS)
(SETQ BinLoopProcess (ADD.PROCESS
(QUOTE (PROG NIL (BLOCK)
(TTYDISPLAYSTREAM (PROCESSPROP (THIS.PROCESS)
(QUOTE WINDOW)))
XXXX
(BIN)
(BLOCK)
(GO XXXX)))
(QUOTE WINDOW)
PromptWindow
(QUOTE NAME)
(QUOTE BinLoopProcess)
(QUOTE TTYENTRYFN)
(FUNCTION [LAMBDA (Process)
(PROCESSPROP Process (QUOTE OldCaret)
(CARET CROSSHAIRS))
(ECHOMODE])
(QUOTE TTYEXITFN)
(FUNCTION (LAMBDA (Process)
(CARET (PROCESSPROP Process (QUOTE OldCaret)))
(ECHOMODE T]
(NAMED-RESETSAVE InternalResetVar NIL (BQUOTE (DEL.PROCESS , BinLoopProcess)))
(* * Insure the prompt window is cleared on the way out)
[NAMED-RESETSAVE InternalResetVar NIL
(BQUOTE (PROGN (AND (HASTTYWINDOWP , BinLoopProcess)
(TTY.PROCESS (if (AND (PROCESSP
, OldTTYProcess)
(HASTTYWINDOWP
, OldTTYProcess)
)
then , OldTTYProcess
else T)))
(NC.ClearMsg , InstigatingWindow T]
(WINDOWADDPROP PromptWindow (QUOTE CLOSEFN)
(FUNCTION NC.ZapBinLoopProcess))
(* * Set up the menu above the prompt window)
(* fix in case MENUPOSITION is set incorrectly in menu
passed down)
(replace (MENU MENUPOSITION) of Menu
with (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0)))
[NAMED-RESETSAVE InternalResetVar (PROGN (ATTACHMENU
Menu
(OR InstigatingWindow PROMPTWINDOW)
(if InstigatingWindow
then (QUOTE TOP)
else (QUOTE BOTTOM))
(if (AND (WINDOWP InstigatingWindow)
(WINDOWP PromptWindow))
then (CDR (WINDOWPROP
PromptWindow
(QUOTE WHEREATTACHED))
)
else (QUOTE LEFT)))
(WINDOWPROP (WFROMMENU Menu)
(QUOTE SelectionPromptWindow)
PromptWindow))
(BQUOTE (PROGN (REMOVEWINDOW (WFROMMENU , Menu]
(* * If there is an instigating window, make sure it and all its attachments are visible on the screen.)
(if InstigatingWindow
then (NC.MoveWindowOntoScreen InstigatingWindow))
(* * Give the prompt window the tty process)
(TTY.PROCESS (WINDOWPROP PromptWindow (QUOTE PROCESS)))
(* * Loop as long as necessary)
[WITH.MONITOR
(WINDOWPROP PromptWindow (QUOTE SelectCardsMonitor))
(until (OR (EQ SelectedCards (QUOTE DON'T))
(AND SingleCardFlg SelectedCards)
(EQ (CAR SelectedCards)
(QUOTE DONE)))
do
( (* Wait for the user to respond by copy inserting
something into the prompt window)
(until [OR (NOT (PROCESSP BinLoopProcess))
(NOT (EQ SelectedCards (WINDOWPROP PromptWindow (QUOTE
SelectedCards]
do (MONITOR.AWAIT.EVENT (WINDOWPROP PromptWindow (QUOTE
SelectCardsMonitor))
CopyInsertEvent 1000))
(* Get the latest selection list)
(SETQ SelectedCards (WINDOWPROP PromptWindow (QUOTE SelectedCards)))
(WINDOWPROP PromptWindow (QUOTE NewCardsProcessed)
T)
(NOTIFY.EVENT CardProcessedEvent T)
(OR (PROCESSP BinLoopProcess)
(SETQ SelectedCards (QUOTE DON'T)))
(NAMED-RESETLST
TTYResetVar (* Turn off the caret)
(NAMED-RESETSAVE TTYResetVar (TTY.PROCESS (THIS.PROCESS)))
(* If the last thing wasn't a done or cancel, process
the new selection)
(SETQ Card (CAR SelectedCards))
(WITH.MONITOR
NC.LockLock
(COND
((AND (NEQ Card (QUOTE DONE))
(NEQ SelectedCards (QUOTE DON'T))
(NEQ Card (QUOTE *New% Card*)))
(* Try to follow cross-file links.)
[if (AND (NC.ValidCardP Card)
(NC.CrossFileLinkCardP Card))
then (SETQ Card (NC.GetCrossFileLinkDestCard Card
InstigatingWindow))
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
(SETQ SelectedCards (CONS Card (CDR
SelectedCards]
(* Check to make sure that the selection is valid)
[COND
((EQ Card (QUOTE *Undo% Selection*))
(* Chop off two elements from the list -
the indicator and the previous item.)
(SETQ Card (CADR SelectedCards))
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
(SETQ SelectedCards (CDDR SelectedCards)))
(* now get our hands off of all the locks we've
acquired for this card)
(if Card
then (NAMED-RESETUNSAVE CardListResetVar (NC.FetchUserDataProp
Card
(QUOTE ResetItems)))
(NC.SetUserDataProp Card (QUOTE ResetItems)
NIL))
(NC.ClearMsg InstigatingWindow NIL))
[(OR (NOT (NC.ValidCardP Card))
(NULL (APPLY* SelectionPredicate Card)))
(* Does this card match the slection predicate)
(NC.PrintMsg InstigatingWindow T "*** Invalid selection. ***"
(CHARACTER 13))
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
(SETQ SelectedCards (CDR SelectedCards]
((AND (SETQ OpInProgress (if FileLevelLockFlg
then (NC.NoteFileCheckOpInProgress
(fetch (Card NoteFile)
of Card))
else (NC.CardCheckOpInProgress Card)))
(NEQ OpInProgress (QUOTE US)))
(NC.PrintOperationInProgressMsg InstigatingWindow "Select Card"
OpInProgress)
(DISMISS 1000)
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
(SETQ SelectedCards (CDR SelectedCards)))
(NC.ClearMsg InstigatingWindow NIL))
(T (* A valid selection.)
(NC.ClearMsg InstigatingWindow NIL)
[if FileLevelLockFlg
then [SETQ ResetItems
(LIST (NAMED-RESETSAVE
CardListResetVar
(NC.NoteFileProp (fetch (Card NoteFile)
of Card)
(QUOTE OperationInProgress)
"Select Card")
(BQUOTE (NC.NoteFileProp
,
(fetch (Card NoteFile)
of Card)
OperationInProgress NIL)))
(NAMED-RESETSAVE
CardListResetVar
(NC.NoteFileProp (fetch (Card NoteFile)
of Card)
(QUOTE ProcessInProgress)
(THIS.PROCESS))
(BQUOTE (NC.NoteFileProp
,
(fetch (Card NoteFile)
of Card)
ProcessInProgress NIL)))
(NAMED-RESETSAVE CardListResetVar
(SETQ NC.NoteFileBusyList
(CONS (THIS.PROCESS)
NC.NoteFileBusyList))
(QUOTE (SETQ
NC.NoteFileBusyList
(DREMOVE
(THIS.PROCESS)
NC.NoteFileBusyList]
else (SETQ ResetItems
(LIST [NAMED-RESETSAVE CardListResetVar
(SETQ NC.CardBusyList
(CONS (THIS.PROCESS)
NC.CardBusyList))
(QUOTE (SETQ
NC.CardBusyList
(DREMOVE (
THIS.PROCESS)
NC.CardBusyList]
[NAMED-RESETSAVE
CardListResetVar
[NC.NoteFileProp
(fetch (Card NoteFile) of Card)
(QUOTE CardProcessInProgressList)
(CONS (THIS.PROCESS)
(NC.NoteFileProp (fetch
(Card NoteFile)
of Card)
(QUOTE
CardProcessInProgressList]
(BQUOTE (NC.ResetCardProcessInProgress
,
(fetch (Card NoteFile)
of Card]
(NAMED-RESETSAVE CardListResetVar
(NC.SetUserDataProp
Card
(QUOTE OperationInProgress)
"Select Card")
(BQUOTE (NC.SetUserDataProp
, Card
OperationInProgress NIL)
))
(NAMED-RESETSAVE CardListResetVar
(NC.SetUserDataProp
Card
(QUOTE ProcessInProgress)
(THIS.PROCESS))
(BQUOTE (NC.SetUserDataProp
, Card
ProcessInProgress NIL]
(NAMED-RESETSAVE InternalResetVar (NC.SetUserDataProp
Card
(QUOTE ResetItems)
ResetItems)
(BQUOTE (NC.SetUserDataProp , Card ResetItems
NIL]
(* * Print the results in the prompt window)
(NC.PrintMsg InstigatingWindow NIL (COND
(Msg (CONCAT Msg (CHARACTER 13)))
(T ""))
"Items selected: ")
(for ThisCard in (REVERSE SelectedCards)
do (NC.PrintMsg InstigatingWindow NIL (NC.RetrieveTitle ThisCard)
", ")
(if [AND InstigatingWindow (GREATERP
(DSPXPOSITION NIL PromptWindow)
(TIMES 1.25 (WINDOWPROP InstigatingWindow
(QUOTE WIDTH]
then (NC.PrintMsg InstigatingWindow NIL (CHARACTER 13]
(* * Return the result)
(PROG1 [COND
((EQ SelectedCards (QUOTE DON'T))
(COND
(CheckForCancelFlg (QUOTE DON'T))
(T NIL)))
(SingleCardFlg (if (EQ (CAR SelectedCards)
(QUOTE DONE))
then NIL
else (CAR SelectedCards)))
(T (if (EQ (CAR SelectedCards)
(QUOTE DONE))
then (DREVERSE (CDR SelectedCards))
else (DREVERSE SelectedCards]
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
NIL])
)
(* * new for NCINTERFACE)
(DEFINEQ
(NC.ZapBinLoopProcess
[LAMBDA (Window) (* Randy.Gobbel "12-Aug-87 16:15")
(LET [(BinLoopProcess (WINDOWPROP Window (QUOTE PROCESS]
(WINDOWDELPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.ZapBinLoopProcess))
(AND (PROCESSP BinLoopProcess)
(DEL.PROCESS BinLoopProcess])
)
(PUTPROPS RGPATCH057 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1176 5514 (NC.AskUser 1186 . 4437) (NC.AskUserResetWindow 4439 . 5512)) (5546 5991 (
NC.ZapAskUserProcess 5556 . 5989)) (6027 23804 (NC.SelectNoteCards 6037 . 23802)) (23837 24224 (
NC.ZapBinLoopProcess 23847 . 24222)))))
STOP