(FILECREATED "22-Apr-87 20:18:03" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH246.;1 43069
changes to: (VARS RHTPATCH246COMS)
(FNS NC.GETPROMPTWINDOW NC.SelectNoteCards NC.MoveCards NC.ClearMsg))
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH246COMS)
(RPAQQ RHTPATCH246COMS ((* * New stuff for NCINTERFACE)
(GLOBALVARS NC.PromptWindowMonitorLock)
(INITVARS (NC.PromptWindowMonitorLock (CREATE.MONITORLOCK
"PromptWindowMonitorLock")))
(* * Change to NCINTERFACE)
(FNS NC.GETPROMPTWINDOW NC.SelectNoteCards NC.CopyStructure
NC.MoveStructure)
(* * Change to NCDATABASE)
(FNS NC.CopyCards)
(* * New function for NCDATABASE)
(FNS NC.MoveCards)
(* * Change to NCUTILITIES)
(FNS NC.ClearMsg)))
(* * New stuff for NCINTERFACE)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.PromptWindowMonitorLock)
)
(RPAQ? NC.PromptWindowMonitorLock (CREATE.MONITORLOCK "PromptWindowMonitorLock"))
(* * Change to NCINTERFACE)
(DEFINEQ
(NC.GETPROMPTWINDOW
(LAMBDA (MAINWINDOW #LINES FONT DONTCREATE MINWIDTH) (* rht: "22-Apr-87 20:13")
(* makes sure that MAINWINDOW has an attached promptwindow and returns it. If one already exists, it is shaped to
be at least #LINES high. If FONT is NIL, the font of the main window is used for the promptwindow.)
(* * fgh 6/6/86 Adapted from system GETPROMPTWINDOW. Added MINWIDTH arg.)
(* * rht 7/2/86: Now attaches prompt window on right if near right edge of screen.)
(* * rht 7/4/86: Yanked out PositionOnEdge localvar. Put code in place.)
(* * rht 3/21/87: AttachWindowPositionOnEdge to attach prompt window is left if possible, then center, then right.
Also doesn't let prompt window be wider than screen.)
(* * rht 3/30/87: More ATTACHEDWINDOWS hacking. This time to get the unstacking and restacking of attachedwindows
right during reshaping of the prompt window.)
(* * rht&rg&pmi 4/22/87: Added stack of extra prompt windows and checks for whether they have processes equal to
this one.)
(DECLARE (GLOBALVARS WBorder))
(AND MINWIDTH (SETQ MINWIDTH (MIN (DIFFERENCE SCREENWIDTH (TIMES WBorder 2))
MINWIDTH)))
(WITH.MONITOR
NC.PromptWindowMonitorLock
(PROG ((PWINDOWPROP (WINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOW)))
(PWINDOWMINWIDTH (WINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOWMINWIDTH)))
(MAINWINDOWREGION (WINDOWPROP MAINWINDOW (QUOTE REGION)))
(OtherPWindowProps (WINDOWPROP MAINWINDOW (QUOTE OtherPromptWindows)))
PWINDOW PWINDOWREGION WIDTH HEIGHT OBSCUREDHEIGHT PWINDOW.PWINDOW PWinWidth
AttachWindowPositionOnEdge ThisPWindowProp)
(SETQ PWinWidth (WIDTHIFWINDOW (OR MINWIDTH PWINDOWMINWIDTH 1)))
(SETQ AttachWindowPositionOnEdge (COND
((LEQ (PLUS (fetch (REGION LEFT) of MAINWINDOWREGION)
PWinWidth)
SCREENWIDTH)
(QUOTE LEFT))
((LEQ (PLUS (fetch (REGION LEFT) of MAINWINDOWREGION)
(LRSH (PLUS PWinWidth (fetch (REGION WIDTH) of
MAINWINDOWREGION))
1))
SCREENWIDTH)
(QUOTE CENTER))
(T (QUOTE RIGHT)))) (* Find a free prompt window.)
(for PWindowProp in (CONS PWINDOWPROP OtherPWindowProps)
do (LET ((PWindowProcess (WINDOWPROP (CAR PWindowProp)
(QUOTE PromptWindowProcess))))
(if (EQ (THIS.PROCESS)
PWindowProcess)
then (SETQ ThisPWindowProp PWindowProp)
(RETURN PWindowProp))
(if (AND (NULL ThisPWindowProp)
(NOT (PROCESSP PWindowProcess)))
then (SETQ ThisPWindowProp PWindowProp))))
(COND
(DONTCREATE (RETURN (CAR ThisPWindowProp)))
(ThisPWindowProp
(SETQ PWINDOW (CAR ThisPWindowProp))
(WINDOWPROP PWINDOW (QUOTE PromptWindowProcess)
(THIS.PROCESS))
(COND
((NOT (OPENWP PWINDOW))
(ATTACHWINDOW PWINDOW MAINWINDOW (QUOTE TOP)
AttachWindowPositionOnEdge
(QUOTE LOCALCLOSE))))
(if (SETQ PWINDOW.PWINDOW (WINDOWPROP PWINDOW (QUOTE PROMPTWINDOW)))
then (* This prompt window has a prompt window of its own.
Close and detach it.)
(REMOVEWINDOW (CAR PWINDOW.PWINDOW)))
(WINDOWPROP PWINDOW (QUOTE MAXSIZE)
(CONS 64000 64000))
(WINDOWPROP PWINDOW (QUOTE MINSIZE)
(CONS 1 1))
(SETQ HEIGHT (HEIGHTIFWINDOW (TIMES (OR #LINES (CDR ThisPWindowProp)
1)
(FONTPROP (DSPFONT NIL PWINDOW)
(QUOTE HEIGHT)))))
(SETQ WIDTH (MAX PWinWidth (fetch (REGION WIDTH) of MAINWINDOWREGION)))
(SETQ PWINDOWREGION (WINDOWPROP PWINDOW (QUOTE REGION)))
(COND
((OR (NOT (EQP HEIGHT (fetch (REGION HEIGHT) of PWINDOWREGION)))
(NOT (EQP WIDTH (fetch (REGION WIDTH) of PWINDOWREGION))))
(* Window exists, but not right size.
Keep windows detached during reshaping in case
AttachWindowPositionOnEdge has changed.)
(* * Need to distinguish among the windows attached to MAINWINDOW between those attached before PWINDOW and those
attached after. The latter need to be reattached at AttachWindowPositionOnEdge after PWINDOW is reshaped.)
(LET ((DescriptionList (for Win in (ATTACHEDWINDOWS MAINWINDOW)
bind WA when (EQ (QUOTE TOP)
(CAR (SETQ WA
(WINDOWPROP
Win
(QUOTE
WHEREATTACHED)))))
collect (* Detach attached windows at the top of the main Win
and retuirn a list describing their attachment.)
(PROG1 (LIST Win (CDR WA)
(WINDOWPROP
Win
(QUOTE PASSTOMAINCOMS))
)
(DETACHWINDOW Win)))))
(* Have to smash these to let SHAPEW work.)
(WINDOWPROP PWINDOW (QUOTE MAXSIZE)
NIL)
(WINDOWPROP PWINDOW (QUOTE MINSIZE)
NIL)
(WINDOWPROP PWINDOW (QUOTE PASSTOMAINCOMS)
NIL)
(RESETLST (RESETSAVE NIL
(BQUOTE
(PROGN (WINDOWPROP
, PWINDOW (QUOTE OPENFN)
(QUOTE , (WINDOWPROP
PWINDOW
(QUOTE OPENFN)
NIL))))))
(SHAPEW PWINDOW
(create REGION
using PWINDOWREGION HEIGHT ← HEIGHT WIDTH ←
WIDTH)))
(* * Now reattach all the windows in order to their old locations, except that PWINDOW and those after it should be
attached at AttachWindowPositionOnEdge.)
(for WindowDescription in DescriptionList bind SeenPWINDOW
do (LET ((Win (CAR WindowDescription)))
(if (EQ Win PWINDOW)
then (SETQ SeenPWINDOW T))
(ATTACHWINDOW Win MAINWINDOW (QUOTE TOP)
(if SeenPWINDOW
then AttachWindowPositionOnEdge
else (CADR WindowDescription)))
(WINDOWPROP Win (QUOTE PASSTOMAINCOMS)
(CADDR WindowDescription)))))
(RPLACD ThisPWindowProp #LINES) (* Fall through to check visibility)
)))
(T (SETQ PWINDOW (CREATEW (create REGION
LEFT ← 0
BOTTOM ← 0
WIDTH ←(MAX PWinWidth (fetch
(REGION WIDTH) of
MAINWINDOWREGION))
HEIGHT ←(SETQ HEIGHT
(HEIGHTIFWINDOW
(TIMES (OR #LINES (SETQ #LINES 1))
(FONTPROP
(OR FONT (SETQ FONT
(DSPFONT NIL
MAINWINDOW)))
(QUOTE HEIGHT))))))
NIL NIL T))
(DSPSCROLL T PWINDOW)
(DSPFONT FONT PWINDOW)
(WINDOWPROP PWINDOW (QUOTE PAGEFULLFN)
(QUOTE NILL))
(ATTACHWINDOW PWINDOW MAINWINDOW (QUOTE TOP)
AttachWindowPositionOnEdge
(QUOTE LOCALCLOSE))
(if (NULL PWINDOWPROP)
then (WINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOW)
(CONS PWINDOW #LINES))
else (WINDOWADDPROP MAINWINDOW (QUOTE OtherPromptWindows)
(CONS PWINDOW #LINES)))
(WINDOWPROP PWINDOW (QUOTE PromptWindowProcess)
(THIS.PROCESS))
(WINDOWPROP PWINDOW (QUOTE OPENFN)
(FUNCTION \PROMPTWINDOW.OPENFN))))
(COND
((ILESSP (SETQ OBSCUREDHEIGHT (IDIFFERENCE SCREENHEIGHT
(fetch (REGION TOP)
of (WINDOWPROP PWINDOW
(QUOTE
REGION)))))
0) (* Promptwindow off screen at top, so slip window
group down to make it visible)
(RELMOVEW MAINWINDOW (create POSITION
XCOORD ← 0
YCOORD ← OBSCUREDHEIGHT))))
(WINDOWPROP PWINDOW (QUOTE MINSIZE)
(CONS 1 HEIGHT))
(WINDOWPROP PWINDOW (QUOTE MAXSIZE)
(CONS 64000 HEIGHT))
(WINDOWPROP MAINWINDOW (QUOTE PROMPTWINDOWMINWIDTH)
(OR MINWIDTH 1))
(OPENW PWINDOW)
(RETURN PWINDOW)))))
(NC.SelectNoteCards
(LAMBDA (SingleCardFlg SelectionPredicate Menu InstigatingCardOrWindow Msg CheckForCancelFlg)
(* rht: "22-Apr-87 18:12")
(* 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.)
(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 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)
(WINDOWPROP PromptWindow (QUOTE COPYINSERTFN)
(FUNCTION NC.SelectNoteCardsCopyInsertFn))
(WINDOWPROP PromptWindow (QUOTE CopyInsertEvent)
(SETQ CopyInsertEvent (CREATE.EVENT (QUOTE CopyInsertEvent))))
(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)))
(NAMED-RESETSAVE InternalResetVar (WINDOWPROP PromptWindow (QUOTE SelectCardsMonitor)
(CREATE.MONITORLOCK (QUOTE
SelectCards)))
(BQUOTE (WINDOWPROP , PromptWindow SelectCardsMonitor NIL)))
(* * Make the process behind the prompt window includiong control for a blibnking 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))))
(* * 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 (NOT (EQ SelectedCards (WINDOWPROP PromptWindow (QUOTE
SelectedCards))))
do (MONITOR.AWAIT.EVENT (WINDOWPROP PromptWindow (QUOTE
SelectCardsMonitor))
CopyInsertEvent))
(* * Get the latest selection list)
(SETQ SelectedCards (WINDOWPROP PromptWindow (QUOTE SelectedCards)))
(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*)))
(* * 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)
(NAMED-RESETUNSAVE NC.SelectNoteCardsResetVar (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 (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)
(SETQ ResetItems NIL)
(SETQ ResetItems (CONS (NAMED-RESETSAVE CardListResetVar
(NC.SetUserDataProp
Card
(QUOTE
ProcessInProgress)
(THIS.PROCESS))
(BQUOTE (
NC.SetUserDataProp
, Card
ProcessInProgress NIL)
))
ResetItems))
(SETQ ResetItems (CONS (NAMED-RESETSAVE CardListResetVar
(NC.SetUserDataProp
Card
(QUOTE
OperationInProgress)
"Select Card")
(BQUOTE (
NC.SetUserDataProp
, Card
OperationInProgress NIL)
))
ResetItems))
(SETQ ResetItems
(CONS (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))))
ResetItems))
(SETQ ResetItems (CONS (NAMED-RESETSAVE
CardListResetVar
(SETQ NC.CardBusyList (CONS (
THIS.PROCESS)
NC.CardBusyList))
(QUOTE (SETQ NC.CardBusyList
(DREMOVE (
THIS.PROCESS)
NC.CardBusyList))))
ResetItems))
(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))))))
(NC.CopyStructure
(LAMBDA (RootCards DestinationFileBox TraversalSpecs InterestedWindow QuietFlg)
(* rht: "22-Apr-87 18:34")
(* * Copy a NoteCard structure into a filebox)
(* * kirk 13/7/86: Placed TraversalSpecs after RootCards selection and changed prompt message)
(* * rht 9/2/86: Threw away CheckFlg arg. Wasn't being used. Changed to call NCP.CollectCards instead of outdated
NC.CollectCards. Changed arg named ToPosition to DestinationFileBox. Also changed FromCard to RootCard.
Passes two link types to NC.AskTraversalSpecs.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 3/9/87: Now accepts multiple root cards.)
(* * rg 3/9/87 added NC.ProtectedSessionOperation wrapper)
(* * RG 3/18/87 changed NC.ProtectedSessionOperation to NCP.WithLockedCards ; added NC.IfAllCardsFree wrapper)
(* * rht&rg&pmi 4/22/87: Removed calls to ERROR!)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu NC.SelectingCardMenu))
(NCP.WithLockedCards (SETQ RootCards (MKLIST RootCards))
(NC.IfAllCardsFree (NC.LockListOfCards RootCards "Copy Structure")
(if (AND (OR RootCards
(SETQ RootCards
(NC.SelectNoteCards NIL NIL
NC.SelectingCardsMenu NIL
"Shift-select the root cards of the structure")))
(OR TraversalSpecs
(SETQ TraversalSpecs
(NC.AskTraversalSpecs
(fetch (Card NoteFile)
of (CAR RootCards))
(QUOTE (SubBox FiledCard)))))
(OR DestinationFileBox
(SETQ DestinationFileBox
(NC.SelectNoteCards
T
(FUNCTION (LAMBDA (Card)
(NC.FileBoxP Card T)))
NC.SelectingCardMenu NIL
"Shift-select the FileBox to contain the structure."))))
then (NC.CopyCards (NCP.CollectCards
RootCards
(fetch (TRAVERSALSPECS
LinkTypes)
of TraversalSpecs)
(fetch (TRAVERSALSPECS
Depth)
of TraversalSpecs))
DestinationFileBox RootCards
QuietFlg InterestedWindow))))))
(NC.MoveStructure
(LAMBDA (RootCards DestinationFileBox TraversalSpecs InterestedWindow QuietFlg
Don'tPutToBeDeletedCardsFlg) (* rht: "22-Apr-87 18:36")
(* * Copy a NoteCard structure into a filebox)
(* * rht 9/2/86: Added QuietFlg and Don'tPutToBeDeletedCardsFlg args. Changed names of a few args and removed
Don'tClearFlg arg. Took out REVERSE to save time and space.)
(* * rht 3/9/87: Now accepts multiple root cards.)
(* * rht&rg&pmi 4/22/87: Now checks that NC.CopyStructure returns valid stuff before deleting.)
(LET ((Structure (NC.CopyStructure (MKLIST RootCards)
DestinationFileBox TraversalSpecs InterestedWindow QuietFlg))
)
(AND Structure (NC.DeleteNoteCards Structure T NIL InterestedWindow QuietFlg NIL
Don'tPutToBeDeletedCardsFlg)))))
)
(* * Change to NCDATABASE)
(DEFINEQ
(NC.CopyCards
(LAMBDA (Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow)
(* rht: "22-Apr-87 18:39")
(* * Create copies of cards in Cards. If DestNoteFileOrFileBox is a notefile, then destination will be the contents
box in that notefile, else the FileBox's notefile. RootCards should be NIL or a subset of Cards.
If NIL, then file all Cards in the dest filebox. Otherwise, just file RootCards in that filebox and assume others
are linked somehow to the RootCards. Links between cards in Cards are copied, but links from or to outside cards
aren't.)
(* * Currently all Cards must be in same notefile, but this perhaps could be relaxed if could prevent possibility
of two cards in different notefiles having the same UID.)
(* * kirk 24Apr86 Added calls to select cards if none provided)
(* * rht 9/2/86: Added InterestedWindow arg.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(* * rg 4/2/87 changed NC.CardSelectionOperation to NCP.WithLockedCards ; added NC.IfAllCardsFree wrapper)
(* * rht&rg&pmi 4/22/87: No longer calls ERROR!)
(NCP.WithLockedCards (NC.IfAllCardsFree (NC.LockListOfCards Cards "Copy Cards")
(PROG (NumCards SourceNoteFile DestNoteFile BoxToFileIn
TempStream CardHashArray LinksHashArray
CurrentLinkLabels NewLinkLabels
NewCardsAndLocsOnStream)
(* * Make sure the arguments are valid.)
(if (NULL Cards)
then (if (NULL (SETQ Cards
(NC.SelectNoteCards
NIL NIL
NC.SelectingCardsMenu NIL
"Shift-select from the same NoteFile cards to copy:")))
then (RETURN NIL)))
(SETQ Cards (MKLIST Cards))
(SETQ NumCards (LENGTH Cards))
(* All Cards to copy must live in same notefile.)
(SETQ SourceNoteFile (fetch (Card NoteFile)
of (CAR Cards)))
(if (NOT (AND (type? NoteFile
SourceNoteFile)
(OPENP (fetch
(NoteFile Stream)
of
SourceNoteFile))))
then (NC.ReportError
"NC.CopyCards"
(CONCAT (fetch (NoteFile
FullFileName)
of SourceNoteFile)
" not an open notefile.")))
(if (NOT (for Card in Cards
always
(NC.SameNoteFileP
(fetch (Card NoteFile)
of Card)
SourceNoteFile)))
then (NC.ReportError "NC.CopyCards"
"All cards in Cards arg don't live in the same notefile."))
(* Compute dest notefile and dest filebox.)
(if (NOT DestNoteFileOrFileBox)
then (if (EQ (QUOTE CANCELLED)
(SETQ
DestNoteFileOrFileBox
(NC.SelectNoteCards
T NIL
NC.SelectingCardMenu NIL
"Shift-select the FileBox to contain these cards."
T)))
then (RETURN NIL)))
(if (type? NoteFile DestNoteFileOrFileBox)
then (SETQ DestNoteFile
DestNoteFileOrFileBox)
(SETQ BoxToFileIn
(fetch (NoteFile
TableOfContentsCard)
of DestNoteFile))
elseif (NCP.FileBoxP DestNoteFileOrFileBox)
then (SETQ BoxToFileIn
DestNoteFileOrFileBox)
(SETQ DestNoteFile
(fetch (Card NoteFile)
of BoxToFileIn))
else (NC.ReportError "NC.CopyCards"
(CONCAT
"Arg not notefile or filebox: "
DestNoteFileOrFileBox)))
(if (NOT (AND (type? NoteFile
DestNoteFile)
(OPENP (fetch
(NoteFile Stream)
of DestNoteFile)
)))
then (NC.ReportError
"NC.CopyCards"
(CONCAT (fetch (NoteFile
FullFileName)
of DestNoteFile)
" not an open notefile.")))
(if (LDIFFERENCE (SETQ RootCards
(MKLIST RootCards))
Cards)
then (NC.ReportError "NC.CopyCards"
"RootCards argument not subset of Cards argument."))
(if (NULL RootCards)
then (SETQ RootCards Cards))
(* * Now get to work.)
(SETQ TempStream (OPENSTREAM (QUOTE
{NODIRCORE})
(QUOTE BOTH)))
(SETQ CurrentLinkLabels (NC.RetrieveLinkLabels
DestNoteFile))
(SETQ NewLinkLabels (TCONC NIL))
(SETQ LinksHashArray
(HASHARRAY NC.CopyCardsLinksHashArraySize NIL
(FUNCTION NC.MakeHashKey)
(FUNCTION NC.SameUIDP)))
(SETQ CardHashArray
(HASHARRAY NumCards NIL
(FUNCTION NC.MakeHashKeyFromCard)
(FUNCTION NC.SameCardP)))
(* * Create new cards in DestNoteFile for each card. Make these cards by copying original cards to a temp stream.
Keep track of UID mappings between original cards and card copies using CardHashArray.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Copying cards: creating empty copies."
(CHARACTER 13)
"Processing item "
1 " out of "
NumCards "..."
(CHARACTER 13)))
(SETQ NewCardsAndLocsOnStream
(for Card in Cards as i from 1
bind NewCard WasActiveFlg HadStatusNILFlg
IndexLocs
eachtime (BLOCK)
collect
(OR QuietFlg
(if (ZEROP (REMAINDER i 100))
then (NC.PrintMsg
InterestedWindow T
"Copying cards: creating empty copies."
(CHARACTER 13)
"Processing item " i
" out of "
NumCards "..."
(CHARACTER 13))))
(if (NOT (SETQ WasActiveFlg
(NC.ActiveCardP Card)))
then (NC.GetNoteCard Card))
(if (SETQ HadStatusNILFlg
(NULL (fetch (Card Status)
of Card)))
then
(* Have to have Status slot ACTIVE in order that Put
to stream won't break.)
(replace (Card Status)
of Card
with (QUOTE ACTIVE)))
(SETQ IndexLocs
(NC.PutNoteCardToStream Card NIL T
TempStream))
(if HadStatusNILFlg
then (replace (Card Status)
of Card with NIL))
(if (NOT WasActiveFlg)
then (NC.DeactivateCard Card))
(* Make new empty card for copy.)
(SETQ NewCard (NC.GetNewCard
DestNoteFile))
(* Map old cards to card copies.)
(PUTHASH Card NewCard CardHashArray)
(CONS NewCard IndexLocs)))
(* * For each card, get it off the temp stream, fix its links, fix browser info if necessary, and write it down to
the dest notefile.)
(SETFILEPTR TempStream 0)
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Copying cards: fixing links and browser cards."
(CHARACTER 13)
"Processing item "
1 " out of "
NumCards "..."
(CHARACTER 13)))
(for NewCardAndLocsOnStream in
NewCardsAndLocsOnStream
as i from 1 eachtime (BLOCK)
do (OR QuietFlg
(if (ZEROP (REMAINDER i 100))
then (NC.PrintMsg
InterestedWindow T
"Copying cards: fixing links and browser cards."
(CHARACTER 13)
"Processing item " i
" out of "
NumCards "..."
(CHARACTER 13))))
(LET ((NewCard (CAR
NewCardAndLocsOnStream))
(IndexLocs (CDR
NewCardAndLocsOnStream)))
(* Have to make status active for Get fns to work.)
(NC.SetStatus NewCard
(QUOTE ACTIVE))
(NC.GetNoteCardFromStream NewCard
TempStream
IndexLocs)
(NC.FixUpLinksInCardCopy NewCard
CardHashArray
LinksHashArray
CurrentLinkLabels
NewLinkLabels)
(if (NC.IsSubTypeOfP
(NC.FetchType NewCard)
(QUOTE Browser))
then (NC.FixUpBrowserCardCopy
NewCard CardHashArray))
(NC.PutNoteCard NewCard)))
(* * Link RootCards under filebox in DestNotefile.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Copying cards: filing "
(LENGTH RootCards)
" new cards in "
(NC.FetchTitle
BoxToFileIn)
"..."
(CHARACTER 13)))
(NC.FileBoxCollectChildren NIL BoxToFileIn
(for RootCard
in RootCards
eachtime
(BLOCK)
collect
(GETHASH
RootCard
CardHashArray))
T)
(* * Put out any new link labels to the dest notefile.)
(AND (SETQ NewLinkLabels (CDAR
NewLinkLabels))
(NC.StoreLinkLabels DestNoteFile
(APPEND
NewLinkLabels
CurrentLinkLabels)))
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
Cards)))))
)
(* * New function for NCDATABASE)
(DEFINEQ
(NC.MoveCards
(LAMBDA (Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow)
(* rht: "22-Apr-87 18:47")
(* * Move cards into a filebox by copying and deleting.)
(* * rht&rg&pmi 4/22/87: Took out ERROR!)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(OR Cards (SETQ Cards (NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu NIL
"Shift-select from the same NoteFile cards to move:")))
(if Cards
then (SETQ Cards (MKLIST Cards))
(NC.CopyCards Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow)
(NC.DeleteNoteCards Cards T NIL InterestedWindow QuietFlg NIL))))
)
(* * Change to NCUTILITIES)
(DEFINEQ
(NC.ClearMsg
(LAMBDA (MainWindow ClosePromptWindowFlg) (* rht: "22-Apr-87 20:09")
(* Clear and optionally close the promnpt window for
MainWindow)
(* * rht 9/10/85: Fixed so closes instead of removing prompt window and clears whether prompt win gets closed or
not.)
(* * rht 11/7/85: Now checks if MainWindow is a NC window. If so, clears its promptwindow. If not, clears
MainWindow itself.)
(* * fgh 5/1/86 Fix to above fix. If clearing MainWindow, still need to check the ClosePromptWindowFlg.
Don't close the main window if this flag in NIL.)
(* * fgh 6/8/86 Added call to REPOSITIONATTACHEDWINDOWS)
(* * fgh 6/13/86 Now uses prompt window for NF menus as well as cards.)
(* * fgh 6/27/86 Updated to match window width changes in NC.PrintMsg)
(* * fgh&rht 7/4/86: Now checks that window isn't shrunken before calling REPOSITIONATTACHEDWINDOWS)
(* * fgh 7/5/86 Redid the previous fix. Replaced REPOSITIONATTACHEDWINDOWS with FREEATTACHWINDOW in order to handle
cases for open but buried windows as well as shrunken windows.)
(* * rht&rg&pmi: 4/22/87: Now smashes the PromptWindowProcess windowprop.)
(DECLARE (GLOBALVARS NC.PromptWindowMonitorLock))
(WITH.MONITOR NC.PromptWindowMonitorLock
(LET (PromptWindow)
(if (WINDOWP MainWindow)
then (if (NC.NoteCardsWindowP MainWindow)
then (SETQ PromptWindow (NC.GETPROMPTWINDOW MainWindow
NIL NIL T))
(if (OPENWP PromptWindow)
then (CLEARW PromptWindow))
(WINDOWPROP PromptWindow (QUOTE MaxLineWidth)
NIL)
(WINDOWPROP PromptWindow (QUOTE LastLineLength)
NIL)
(WINDOWPROP PromptWindow (QUOTE OldMaxWidth)
0)
(WINDOWPROP MainWindow (QUOTE PromptWindowLastNotCR)
NIL)
(if ClosePromptWindowFlg
then (WINDOWPROP PromptWindow (QUOTE
PromptWindowProcess)
NIL)
(WINDOWDELPROP MainWindow (QUOTE
OtherPromptWindows)
(ASSOC
PromptWindow
(WINDOWPROP
MainWindow
(QUOTE
OtherPromptWindows))))
(FREEATTACHEDWINDOW PromptWindow)
(REMOVEWINDOW PromptWindow))
else (CLEARW MainWindow)
(if ClosePromptWindowFlg
then (CLOSEW MainWindow)))
else (CLRPROMPT))))))
)
(PUTPROPS RHTPATCH246 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1056 28510 (NC.GETPROMPTWINDOW 1066 . 9977) (NC.SelectNoteCards 9979 . 25147) (
NC.CopyStructure 25149 . 27607) (NC.MoveStructure 27609 . 28508)) (28544 39340 (NC.CopyCards 28554 .
39338)) (39381 40160 (NC.MoveCards 39391 . 40158)) (40195 42987 (NC.ClearMsg 40205 . 42985)))))
STOP