(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
(FILECREATED "11-May-88 18:18:08" {QV}<NOTECARDS>1.3LNEXT>RGPATCH083.;1 21157
changes to%: (VARS RGPATCH083COMS)
(FNS NC.SelectNoteCards NC.BinLoopProcess))
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RGPATCH083COMS)
(RPAQQ RGPATCH083COMS (
(* ;; "rg 5/11/88: put BinLoop in its own function. Not a big deal, but the interpreted version tickled a storage leak bug in Lyric, and I just generally dislike having interpreted code lying around.")
(* ;; "new for NCINTERFACE")
(FNS NC.BinLoopProcess)
(* ;; "changes to NCINTERFACE")
(FNS NC.SelectNoteCards)
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
RGPATCH083)))
(* ;;
"rg 5/11/88: put BinLoop in its own function. Not a big deal, but the interpreted version tickled a storage leak bug in Lyric, and I just generally dislike having interpreted code lying around."
)
(* ;; "new for NCINTERFACE")
(DEFINEQ
(NC.BinLoopProcess
[LAMBDA NIL (* ; "Edited 11-May-88 12:23 by Randy.Gobbel")
(PROG NIL
(BLOCK)
(TTYDISPLAYSTREAM (PROCESSPROP (THIS.PROCESS)
'WINDOW))
XXXX
(BIN)
(BLOCK)
(GO XXXX])
)
(* ;; "changes to NCINTERFACE")
(DEFINEQ
(NC.SelectNoteCards
[LAMBDA (SingleCardFlg SelectionPredicate Menu InstigatingCardOrWindow Msg CheckForCancelFlg
FileLevelLockFlg) (* ; "Edited 11-May-88 12:29 by Randy.Gobbel")
(* ;;; "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.")
(* ;; "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 'SelectCardsMonitor
(CREATE.MONITORLOCK 'SelectCards))
`(WINDOWPROP ,PromptWindow SelectCardsMonitor NIL))
[WINDOWPROP PromptWindow 'CopyInsertEvent (SETQ CopyInsertEvent (CREATE.EVENT 'CopyInsertEvent]
(WINDOWPROP PromptWindow 'NewCardsProcessed T)
[WINDOWPROP PromptWindow 'CardProcessedEvent (SETQ CardProcessedEvent (CREATE.EVENT
'CardProcessedEvent]
(WINDOWPROP PromptWindow 'SelectNoteCardsProcess (THIS.PROCESS))
(WINDOWPROP PromptWindow 'COPYINSERTFN (FUNCTION NC.SelectNoteCardsCopyInsertFn))
(NAMED-RESETSAVE InternalResetVar (WINDOWPROP PromptWindow 'SelectedCards NIL)
`(WINDOWPROP ,PromptWindow SelectedCards NIL))
(NAMED-RESETSAVE InternalResetVar (WINDOWPROP PromptWindow 'SelectingCards T)
`(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 'PROCESS (SETQ BinLoopProcess (ADD.PROCESS
'(NC.BinLoopProcess)
'WINDOW PromptWindow 'NAME '
BinLoopProcess 'TTYENTRYFN
[FUNCTION (LAMBDA (Process)
(PROCESSPROP Process
'OldCaret
(CARET CROSSHAIRS))
(ECHOMODE]
'TTYEXITFN
(FUNCTION (LAMBDA (Process)
(CARET (PROCESSPROP
Process
'OldCaret))
(ECHOMODE T]
[NAMED-RESETSAVE InternalResetVar NIL `(DEL.PROCESS ,BinLoopProcess]
(* ;; "Insure the prompt window is cleared on the way out")
[NAMED-RESETSAVE InternalResetVar NIL
`(PROGN (AND (HASTTYWINDOWP ,BinLoopProcess)
(TTY.PROCESS (if (AND (PROCESSP ,OldTTYProcess)
(HASTTYWINDOWP ,OldTTYProcess))
then ,OldTTYProcess
else T)))
(NC.ClearMsg ,InstigatingWindow T]
(WINDOWADDPROP PromptWindow '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 'TOP
else 'BOTTOM)
(if (AND (WINDOWP InstigatingWindow)
(WINDOWP PromptWindow))
then (CDR (WINDOWPROP PromptWindow
'WHEREATTACHED))
else 'LEFT))
(WINDOWPROP (WFROMMENU Menu)
'SelectionPromptWindow PromptWindow))
`(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 'PROCESS))
(* ;; "Loop as long as necessary")
[WITH.MONITOR
(WINDOWPROP PromptWindow 'SelectCardsMonitor)
(until (OR (EQ SelectedCards 'DON'T)
(AND SingleCardFlg SelectedCards)
(EQ (CAR SelectedCards)
'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 'SelectedCards]
do (MONITOR.AWAIT.EVENT (WINDOWPROP PromptWindow 'SelectCardsMonitor)
CopyInsertEvent 1000)) (* ; "Get the latest selection list")
(SETQ SelectedCards (WINDOWPROP PromptWindow 'SelectedCards))
(WINDOWPROP PromptWindow 'NewCardsProcessed T)
(NOTIFY.EVENT CardProcessedEvent T)
(OR (PROCESSP BinLoopProcess)
(SETQ SelectedCards '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 'DONE)
(NEQ SelectedCards 'DON'T)
(NEQ Card '*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 'SelectedCards (SETQ SelectedCards
(CONS Card (CDR SelectedCards]
(* ;
"Check to make sure that the selection is valid")
[COND
((EQ Card '*Undo% Selection*) (* ;
"Chop off two elements from the list --- the indicator and the previous item.")
(SETQ Card (CADR SelectedCards))
(WINDOWPROP PromptWindow '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
'ResetItems))
(NC.SetUserDataProp Card '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 'SelectedCards (SETQ SelectedCards (CDR SelectedCards]
((AND (SETQ OpInProgress (if FileLevelLockFlg
then (NC.NoteFileCheckOpInProgress
(fetch (Card NoteFile) of Card))
else (NC.CardCheckOpInProgress Card)))
(NEQ OpInProgress 'US))
(NC.PrintOperationInProgressMsg InstigatingWindow "Select Card" OpInProgress)
(DISMISS 1000)
(WINDOWPROP PromptWindow '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)
'OperationInProgress
"Select Card")
`(NC.NoteFileProp ,(fetch (Card NoteFile) of Card)
OperationInProgress NIL))
(NAMED-RESETSAVE CardListResetVar (NC.NoteFileProp
(fetch (Card NoteFile)
of Card)
'ProcessInProgress
(THIS.PROCESS))
`(NC.NoteFileProp ,(fetch (Card NoteFile) of Card)
ProcessInProgress NIL))
(NAMED-RESETSAVE CardListResetVar (SETQ NC.NoteFileBusyList
(CONS (THIS.PROCESS)
NC.NoteFileBusyList))
'(SETQ NC.NoteFileBusyList (DREMOVE (THIS.PROCESS)
NC.NoteFileBusyList]
else (SETQ ResetItems (LIST [NAMED-RESETSAVE CardListResetVar
(SETQ NC.CardBusyList (CONS (THIS.PROCESS
)
NC.CardBusyList
))
'(SETQ NC.CardBusyList (DREMOVE (
THIS.PROCESS
)
NC.CardBusyList
]
[NAMED-RESETSAVE
CardListResetVar
[NC.NoteFileProp
(fetch (Card NoteFile) of Card)
'CardProcessInProgressList
(CONS (THIS.PROCESS)
(NC.NoteFileProp (fetch (Card NoteFile)
of Card)
'CardProcessInProgressList]
`(NC.ResetCardProcessInProgress
,(fetch (Card NoteFile) of Card]
(NAMED-RESETSAVE CardListResetVar
(NC.SetUserDataProp Card '
OperationInProgress "Select Card")
`(NC.SetUserDataProp ,Card
OperationInProgress NIL))
(NAMED-RESETSAVE CardListResetVar
(NC.SetUserDataProp Card '
ProcessInProgress (THIS.PROCESS))
`(NC.SetUserDataProp ,Card
ProcessInProgress NIL]
(NAMED-RESETSAVE InternalResetVar (NC.SetUserDataProp Card 'ResetItems
ResetItems)
`(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
'WIDTH]
then (NC.PrintMsg InstigatingWindow NIL (CHARACTER 13]
(* ;; "Return the result")
(PROG1 [COND
((EQ SelectedCards 'DON'T)
(COND
(CheckForCancelFlg 'DON'T)
(T NIL)))
(SingleCardFlg (if (EQ (CAR SelectedCards)
'DONE)
then NIL
else (CAR SelectedCards)))
(T (if (EQ (CAR SelectedCards)
'DONE)
then (DREVERSE (CDR SelectedCards))
else (DREVERSE SelectedCards]
(WINDOWPROP PromptWindow 'SelectedCards NIL])
)
(PUTPROPS RGPATCH083 FILETYPE :TCOMPL)
(PUTPROPS RGPATCH083 MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP" :BASE 10))
(PUTPROPS RGPATCH083 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1220 1555 (NC.BinLoopProcess 1230 . 1553)) (1596 20935 (NC.SelectNoteCards 1606 . 20933
)))))
STOP