(FILECREATED " 3-Apr-87 15:09:21" {QV}<NOTECARDS>1.3K>NEXT>RGPATCH023.;5 167383
changes to: (VARS RGPATCH023COMS)
(FNS NCP.CloseCards NC.LockListOfCards NC.CopyCards NC.CopyStructure)
(MACROS NC.IfAllCardsFree NCP.WithLockedCards)
previous date: " 2-Apr-87 16:41:59" {QV}<NOTECARDS>1.3K>NEXT>RGPATCH023.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RGPATCH023COMS)
(RPAQQ RGPATCH023COMS ((* * rg 4/2/87 lots of concurrency fixes: CANCELLED globally replaced by
DON'T; new macros and function for protecting lists of cards; wrappers
added to a few places)
[DECLARE: COPY FIRST (P (LOAD? (NC.FindFile (QUOTE NCBROWSERCARD)))
(LOAD? (NC.FindFile (QUOTE NCFILEBOXCARD)))
(LOAD? (NC.FindFile (QUOTE NCDOCUMENTCARD]
(* * new for NCDATABASE)
(* * NC.CardSelectionOperation should be deleted, superceded by
NC.WithLockedCards)
(MACROS NC.IfAllCardsFree)
(FNS NC.LockListOfCards)
(* * changes to NCDATABASE)
(MACROS NC.ProtectedNoteFileOperation NC.ProtectedCardOperation)
(FNS NC.OpenNoteFile NC.CloseNoteFile NC.CheckpointNoteFile
NC.SaveDirtyCards NC.AbortSession NC.CopyCards)
(* * changes to NCCARDS)
(FNS NC.EditNoteCard NC.QuitCard NC.CardSaveFn NC.DeleteNoteCards
NC.InsureProperFiling NC.AddParents NC.UnfileNoteCard)
(* * changes to NCINTERFACE)
(FNS NC.SelectNoteCards NC.CloseStructure NC.CopyStructure
NC.DeleteStructure NC.CloseNoteCards NC.EditProperties NC.ShowLinks
NC.ShowInfo NC.SelectionMenusWhenSelectedFn)
(* * changes to NCLINKS)
(FNS NC.MakeFilingLinks NC.MakeLink NC.AddGlobalLinkToCard NC.AddLinksToCard)
(* * new for NCPROGINT)
(MACROS NCP.WithLockedCards)
(* * changes to NCPROGINT)
(FNS NCP.CloseCards NCP.SelectCards)
(* * changes to NCBROWSERCARD)
(FNS NC.MakeBrowserCard NC.UpdateBrowserCard NC.BrowserAddNode)
(* * changes to NCFILEBOXCARD)
(FNS NC.FileBoxCollectChildren)
(* * changes to NCDOCUMENTCARD)
(FNS NC.MakeDocument)))
(* * rg 4/2/87 lots of concurrency fixes: CANCELLED globally replaced by DON'T; new macros and
function for protecting lists of cards; wrappers added to a few places)
(DECLARE: COPY FIRST
(LOAD? (NC.FindFile (QUOTE NCBROWSERCARD)))
(LOAD? (NC.FindFile (QUOTE NCFILEBOXCARD)))
(LOAD? (NC.FindFile (QUOTE NCDOCUMENTCARD)))
)
(* * new for NCDATABASE)
(* * NC.CardSelectionOperation should be deleted, superceded by NC.WithLockedCards)
(DECLARE: EVAL@COMPILE
[DEFMACRO NC.IfAllCardsFree (LockForm &BODY Body)
(LET ((LockStatus (GENSYM)))
(BQUOTE (LET ((, LockStatus , LockForm))
(if [for Status in , LockStatus never (AND Status (NEQ Status
(QUOTE US]
then ,@ Body else , LockStatus]
)
(DEFINEQ
(NC.LockListOfCards
[LAMBDA (CardIdentifiers Operation) (* Randy.Gobbel " 2-Apr-87 16:49")
(* * set locks on cards passed in, return a list of the lock statuses. Status = NIL means lock was free, =
(QUOTE US) means we already had it, = <string> means operation described by the string was already in progress on
that card)
(* * RG 4/2/87 created)
(DECLARE (USEDFREE CardListResetVar))
(WITH.MONITOR NC.LockLock (LET* [(Cards (for CardIdentifier in CardIdentifiers
collect (NC.CoerceToCard CardIdentifier)))
(LockStatusList (for Card in Cards collect (
NC.CardCheckOpInProgress
Card]
[for Card in Cards as Status in LockStatusList
when (NULL Status)
do [NAMED-RESETSAVE CardListResetVar (NC.SetUserDataProp
Card
(QUOTE ProcessInProgress)
(THIS.PROCESS))
(BQUOTE (NC.SetUserDataProp
, Card ProcessInProgress ,
(NC.FetchUserDataProp
Card
(QUOTE
ProcessInProgress]
[NAMED-RESETSAVE CardListResetVar (NC.SetUserDataProp
Card
(QUOTE OperationInProgress)
Operation)
(BQUOTE (NC.SetUserDataProp
, Card OperationInProgress
, (NC.FetchUserDataProp
Card
(QUOTE
OperationInProgress]
[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 (SETQ
NC.CardBusyList (CONS (
THIS.PROCESS)
NC.CardBusyList))
(QUOTE (SETQ NC.CardBusyList
(DREMOVE (
THIS.PROCESS)
NC.CardBusyList]
LockStatusList])
)
(* * changes to NCDATABASE)
(DECLARE: EVAL@COMPILE
[DEFMACRO NC.ProtectedNoteFileOperation (NoteFile Operation InterestedWindow &REST Body)
(BQUOTE (RESETLST (OBTAIN.MONITORLOCK NC.LockLock)
(LET ((OpInProgress (NC.NoteFileCheckOpInProgress , NoteFile)))
[if (NULL OpInProgress)
then
[RESETSAVE (NC.NoteFileProp , NoteFile (QUOTE
OperationInProgress)
(QUOTE , Operation))
(BQUOTE (NC.NoteFileProp , , NoteFile
OperationInProgress ,
(NC.NoteFileProp
, NoteFile (QUOTE
OperationInProgress]
[RESETSAVE (NC.NoteFileProp , NoteFile (QUOTE ProcessInProgress)
(THIS.PROCESS))
(BQUOTE (NC.NoteFileProp , , NoteFile
ProcessInProgress ,
(NC.NoteFileProp
, NoteFile (QUOTE
ProcessInProgress]
(RESETSAVE (SETQ NC.NoteFileBusyList (CONS (THIS.PROCESS)
NC.NoteFileBusyList))
(QUOTE (SETQ NC.NoteFileBusyList (DREMOVE (
THIS.PROCESS)
NC.NoteFileBusyList]
(RELEASE.MONITORLOCK NC.LockLock)
(if (OR (NULL OpInProgress)
(EQ OpInProgress (QUOTE US)))
then ,@ Body else (NC.PrintOperationInProgressMsg
(OR (OPENWP , InterestedWindow)
(NC.CoerceToInterestedWindow , NoteFile))
, Operation OpInProgress)
(QUOTE DON'T]
[DEFMACRO NC.ProtectedCardOperation (Card Operation InterestedWindow &BODY Body)
(BQUOTE (RESETLST (OBTAIN.MONITORLOCK NC.LockLock)
(LET ((OpInProgress (NC.CardCheckOpInProgress , Card)))
[if (NULL OpInProgress)
then
[RESETSAVE (NC.SetUserDataProp , Card (QUOTE ProcessInProgress)
(THIS.PROCESS))
(BQUOTE (NC.SetUserDataProp , , Card
ProcessInProgress ,
(NC.FetchUserDataProp
, Card (QUOTE
ProcessInProgress]
[RESETSAVE (NC.SetUserDataProp , Card (QUOTE OperationInProgress)
(QUOTE , Operation))
(BQUOTE (NC.SetUserDataProp , , Card
OperationInProgress ,
(NC.FetchUserDataProp
, Card (QUOTE
OperationInProgress]
[RESETSAVE [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]
(RESETSAVE (SETQ NC.CardBusyList (CONS (THIS.PROCESS)
NC.CardBusyList))
(QUOTE (SETQ NC.CardBusyList (DREMOVE (THIS.PROCESS)
NC.CardBusyList]
(RELEASE.MONITORLOCK NC.LockLock)
(if (OR (NULL OpInProgress)
(EQ OpInProgress (QUOTE US)))
then ,@ Body else (NC.PrintOperationInProgressMsg
(OR , InterestedWindow (NC.CoerceToInterestedWindow , Card))
, Operation OpInProgress)
(QUOTE DON'T]
)
(DEFINEQ
(NC.OpenNoteFile
[LAMBDA (NoteFileOrFileName NoteFilesHashArray Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
ConvertNoConfirmFlg Don'tCreateArrayFlg Can'tTruncateFlg
Don'tCreateInterfaceFlg Don'tGetSpecialCardsFlg InterestedWindow
PublicOrPrivate MenuPosition QuietFlg ReadOnlyFlg
Don'tCheckForTruncationFlg) (* Randy.Gobbel " 2-Apr-87 16:08")
(* * fgh 5/23/86 Renamed to NC.OpenNoteFile from NC.OpenDatabaseFile. Total revamp to implement device vector.)
(* * kef 7/18/86: Inserted a call to stuff the UID into the NoteFile because BuildHashArray needed it.)
(* * kef 7/21/86: Moved up the install of the NoteFile into the NoteFileHashArray to before the building of the
NoteFile's hash array. The reason is that the remote multi client build hash array function needs to get a list of
UIDs, and in order to do this, it needs to grab a Courier stream for the NoteFile given only the UID.
It can only do this if the UID is registered in the NoteFilesHashArray.)
(* * fgh 8/31/86 Updated to account for changes made to system since 5/23/86 revamp. Changes reimplemented include:
(fgh 6/8/86 Added code to insure that two files with SameUIDP would never be open at once.)
(fgh 6/25/86 Added contention locks -- NC.ProtectedNoteFileOperation, Don'tCheckOperationInProgressFlg etc.)
(fgh 6/27/86 Added MenuPsotion arg to pass to SetUpNoteFileInterface) (kirk 15Jul86 Added call to
NC.SetUpNoteFileInterface if already open))
(* * fgh 9/1/86 Reimplemented ReadOnly NoteFile open.)
(* * fgh 9/4/86 Put in default for NoteFilesHashArray which is NC.NoteFilesHashArray)
(* * kirk/rht 8/29/86: Now resets Name after conversion from version 2 to version3.)
(* * rht 10/29/86: Changed "aborted" to "canceled" in message.)
(* * rht 10/31/86: Added Don'tCheckForTruncationFlg arg.)
(* * rht&pmi 11/21/86: Took away the protection from around the AFTER call to open events fns.)
(* * pmi 12/12/86: Added InterestedWindow argument to NC.SetUpNoteFileInterface so that it can print a prompt to
the user about placing the NoteFile menu.)
(* * rg 3/4/87 Added NC.ProtectedSessionOperation wrapper, removed Don'tCheckOperationsInProgressFlg)
(* * rht 3/25/87: Now calls NC.CoerceToInterestedWindow.)
(* * pmi 3/31/87: Moved line of code which sets the ReadOnlyFlg to just after the test for an open notefile.
Otherwise, a notefile opened read-only could be changed to one opened normally.)
(* * rht 4/2/87: Now passes InterestedWindow to opennotefilefns.)
(* * rg 4/2/87 enlarged scope of NC.ProtectedNoteFileOperation)
(DECLARE (GLOBALVARS NC.OpenNoteFileFns NC.LastNoteFileOpened))
(* * NOTE: Session lock turns into NoteFile lock after NoteFile is created)
(PROG (NoteFile FileName ReturnValue CriticalUIDs)
(* * Figure out the name of the file containing the NoteFile)
(if [NULL (SETQ FileName (COND
((type? NoteFile NoteFileOrFileName)
(fetch (NoteFile FullFileName) of NoteFileOrFileName))
(NoteFileOrFileName)
(T (NC.DatabaseFileName "Name of NoteFile to open:" " -- " T NIL NIL
InterestedWindow]
then (RETURN)) (* SETQ FileName (OR (FULLNAME FileName) FileName))
(* * Create a NoteFile object or use existing notefile object if there is one for this file name.)
[SETQ NoteFile (if (type? NoteFile NoteFileOrFileName)
then NoteFileOrFileName
else (OR (NC.NoteFileFromFileName FileName)
(create NoteFile]
(* * (replace (NoteFile ReadOnlyFlg) of NoteFile with ReadOnlyFlg))
(RETURN
(NC.ProtectedNoteFileOperation
NoteFile "Open NoteFile" InterestedWindow (OR (OPENWP InterestedWindow)
(SETQ InterestedWindow
(NC.CoerceToInterestedWindow
NoteFile)))
(replace (NoteFile FullFileName) of NoteFile with FileName)
(PROG NIL
(* * Figure out the appropriate device vector from the file name.)
(NC.InstallDeviceVectorInNoteFile NoteFile PublicOrPrivate)
(* * If this is an open NoteFIle, just bring up its menu.)
(if (NC.NoteFileOpenP NoteFile)
then (OR Don'tCreateInterfaceFlg (NC.SetUpNoteFileInterface
NoteFile
MenuPosition
InterestedWindow))
(* bring up or create notefile icon if needed)
(RETURN NIL))
(* * Moved this replace to after test for open notefile. Otherwise, if notefile is open read-only, it well be
changed to regular open.)
(replace (NoteFile ReadOnlyFlg) of NoteFile with ReadOnlyFlg)
(* * Notify user.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Opening NoteFile: "
FileName " ..." (CHARACTER 13)))
(SETQ ReturnValue
(PROG NIL
(* * Run through OpenNoteFileFns with param of BEFORE. Exit if any returns DON'T)
(if [for Function in NC.OpenNoteFileFns
thereis (OR (EQ Function (QUOTE DON'T))
(EQ (QUOTE DON'T)
(APPLY* Function FileName NoteFile
(QUOTE BEFORE)
InterestedWindow]
then (if (WINDOWP InterestedWindow)
then (NC.PrintMsg InterestedWindow NIL
"Open canceled for NoteFile "
FileName "." (CHARACTER
13))
(NC.ClearMsg InterestedWindow T))
(RETURN))
(* * Call the device specific OpenNoteFileFn, which returns a list of special UIDs)
(if [NULL (ERSETQ (SETQ ReturnValue
(APPLY* (fetch (NoteFile
OpenNoteFileFn)
of NoteFile)
NoteFile InterestedWindow
Don'tCheckForTruncationFlg]
then (SETQ ReturnValue (QUOTE NoteFileOpenFailed)))
(* * Process error returns from the OpenNoteFileFn)
(if (NOT (LITATOM ReturnValue))
then
(* * OpenNoteFileFn returned correctly)
(SETQ CriticalUIDs ReturnValue)
else
(* * Error, process it.)
(SETQ ReturnValue
(OR [SELECTQ
ReturnValue
(NoteFileNotFound (NC.ProcessNoteFileNotFoundError
NoteFile NoteFilesHashArray
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg ConvertNoConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
InterestedWindow PublicOrPrivate
MenuPosition QuietFlg ReadOnlyFlg
Don'tCheckForTruncationFlg))
(NoteFileNeedsConversion (
NC.ProcessNoteFileNeedsConversionError
NoteFile NoteFilesHashArray
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg
ConvertNoConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
InterestedWindow
PublicOrPrivate
MenuPosition QuietFlg
ReadOnlyFlg
Don'tCheckForTruncationFlg))
(NoteFileNeedsTruncation (
NC.ProcessNoteFileNeedsTruncationError
NoteFile NoteFilesHashArray
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg
ConvertNoConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
InterestedWindow
PublicOrPrivate
MenuPosition QuietFlg
ReadOnlyFlg
Don'tCheckForTruncationFlg))
[NoteFileAlreadyOpen
(ERSETQ (NC.ReportError
NIL
(CONCAT (fetch (NoteFile
FullFileName)
of NoteFile)
" is already open for exclusive access. Open failed."]
[NoteFileOpenFailed
(ERSETQ (NC.ReportError
NIL
(CONCAT "Open of "
(fetch (NoteFile
FullFileName)
of NoteFile)
" failed for unknown reason."]
[NoteFileHeaderBad
(ERSETQ (NC.ReportError
NIL
(CONCAT "Header of NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
" is bad. Contact a NoteCards wizard."]
(PROGN (ERSETQ (NC.ReportError NIL
(CONCAT
"Unknown error code ("
ReturnValue
") returned by OpenNoteFileFn for NoteFile "
FileName]
ReturnValue))
(* * notify the user. if there's been a problem)
(if (AND (NOT (type? NoteFile ReturnValue))
(WINDOWP InterestedWindow))
then (NC.PrintMsg InterestedWindow NIL
"Open canceled for NoteFile "
FileName "." (CHARACTER 13))
(NC.ClearMsg InterestedWindow T))
(* * return whatever the error processing returned.)
(RETURN ReturnValue))
(SETQ ReturnValue)
(* * Make sure there is no other open NF with this UID.)
(LET (NF)
(if (AND (SETQ NF (GETHASH (fetch (
NoteFileCriticalUIDs NoteFile) of CriticalUIDs)
NC.NoteFilesHashArray))
(NEQ (fetch (NoteFile FullFileName)
of NoteFile)
(fetch (NoteFile FullFileName)
of NF))
(NC.NoteFileOpenP NF))
then (FLASHW PROMPTWINDOW)
(NC.PrintMsg PROMPTWINDOW T "Couldn't open "
FileName (CHARACTER 13)
"because "
(fetch (NoteFile FullFileName)
of NF)
" is already open "
(CHARACTER 13)
"and has the same UID.")
(NC.CloseNoteFile NoteFile InterestedWindow T)
(RETURN NIL)))
(* * If needed, build a hash array by calling the device specific BuilHashArrayFn.)
(replace (NoteFile UID) of NoteFile with (fetch
(
NoteFileCriticalUIDs NoteFile) of CriticalUIDs))
(* * Store this NoteFile object in the appropriate NoteFile hash array)
(NC.StoreNoteFileInHashArray NoteFile (OR NoteFilesHashArray
NC.NoteFilesHashArray))
(if (NOT Don'tCreateArrayFlg)
then
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Opening NoteFile: "
FileName
(CHARACTER 13)
"Building index array ..."
(CHARACTER 13)))
(if
(OR [NULL (ERSETQ (SETQ ReturnValue
(APPLY*
(fetch (NoteFile
BuildHashArrayFn)
of NoteFile)
NoteFile QuietFlg
InterestedWindow
(CONCAT "Opening NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
(CHARACTER 13]
(NOT (type? NoteFile ReturnValue)))
then
(* * Error during building of hash array)
(ERSETQ (NC.ReportError
NIL
(CONCAT
"Build Hash Array failed for NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile)
" because " ReturnValue)))
(RETURN)))
(* * Set up critical UIDs in NoteFile object using the values returned from OpenNoteFileFn.)
(NC.InstallCriticalUIDsInNoteFile NoteFile CriticalUIDs)
(* * if needed, cache the special cards)
[if (NOT Don'tGetSpecialCardsFlg)
then (NC.GetSpecialCards NoteFile QuietFlg InterestedWindow
(CONCAT "Opening NoteFile: "
(fetch (NoteFile
FullFileName)
of NoteFile)
(CHARACTER 13]
(* * If needed, start the titles and types caching process)
[if (NOT Don'tCacheTypesAndTitlesFlg)
then (replace (NoteFile CachingProcess) of NoteFile
with (ADD.PROCESS (LIST (FUNCTION
NC.CacheTypesAndTitles)
NoteFile]
(* * If needed, open up a NoteFile interface.)
(if (NOT Don'tCreateInterfaceFlg)
then (NC.SetUpNoteFileInterface NoteFile MenuPosition
InterestedWindow))
(* * Record this as the last NF opened.)
(SETQ NC.LastNoteFileOpened NoteFile)
(RETURN NoteFile)))
(if (type? NoteFile ReturnValue)
then
(* * Run through OpenNoteFIleFns with param of AFTER. Stop if any returns DON'T)
[for Function in NC.OpenNoteFileFns
thereis (EQ (QUOTE DON'T)
(APPLY* Function FileName NoteFile
(QUOTE AFTER]
(* * Go home, returning NoteFile)
(if (NULL QuietFlg)
then (NC.PrintMsg InterestedWindow T "Opening NoteFile: "
FileName (CHARACTER 13)
"Done."
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T))
(RETURN NoteFile)
else
(* * Bail out if open was unsuccessful.)
(RETURN NIL])
(NC.CloseNoteFile
[LAMBDA (NoteFile InterestedWindow QuietFlg AutoConfirmFlg)
(* Randy.Gobbel "27-Mar-87 15:17")
(* * Close a NoteFIle)
(* * rht 10/23/84: Now gives user option of closing and saving all open cards on the screen.)
(* * rht 11/8/84: Put RESETLST around NC.CacheTitles call.)
(* * rht 1/9/85: Clear the NC.UncachingNotCompleted variable when close successfully completes.)
(* * rht 1/31/85: Added call to checkpoint database. That in turn dumps the next nodeID and next linkID.)
(* * rht 7/14/85: Replaced the call to reset the main menu with call to NC.ResetMainMenu. Also took out redundant
reset of PSA.Database, since NC.ForceDatabaseClose is doing that.)
(* * fgh 10/16/85 removed call to CacheTypesAndTitles because uncacheing now done automatically by cache
mechanism.)
(* * fkr 10/29/85: Now kills caching process from database streamprop.)
(* * fkr 11/8/85 Updated to handle new NoteFile object and new CardID scheme.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * rht 3/26/86: Now searches for active cards over whole notefile not just among cards up on screen.
Uses NC.MapCards.)
(* * kirk 28Apr86 Now returns NoteFile if successful.)
(* * fgh 5/2/86 Cleaned up. Ask user to confirm only if there are cards on the screen, not if there are active, but
not displayed ones. Added calls to the NC.CloseNoteFileFns before and after the closeing.)
(* * fgh 5/26/86 Revamp for device vector implementation.)
(* * kef 7/24/86: Changed the last expression at the end that smashes the NoteFile device out of the NoteFile data
structure. This is so that the Interface will not bomb trying to apply an OPENP function with a NIL Device.)
(* * kef 8/4/86: Added something to obtain the write lock on the parts of the active NoteCards that deactivating
will release. This is also so that any changes may be written to the server.)
(* * fgh 8/31/86 Reimplemented changes in system made since 5/23/86 conversion. Reimplemented changes include:
(* * fgh 6/4/86 Fixed so that shrunken cards are counted as open when asking for confirmation when there are open
cards on screen.) (* * fgh 6/13/86 Now checks for card operations in progress and kills them if necessary.)
(* * fgh 6/25/86 Added NC.ProtectedNoteFileOperation macro call. Added Don'tCheckOperationInProgressFlg args.)
(* * rht 7/4/86: Added check for readonly notefile.) (* * rht 7/13/86: Added QuietFlg arg. Note that this will
cause open cards on the screen to be closed and saved without asking user for confirmation.)
(* * rpr 11/13/86: After closing active cards, checks to see if any special cards were made active and closes
them.))
(* * pmi 12/22/86 Made test for open notefile consistent with other NoteFile operations (ie. Abort Checkpoint,))
(* * rht 2/16/87: Added AutoConfirmFlg argument to prevent user having to confirm whether to close and save open
cards. Note that QuietFlg is stronger than AutoConfirmFlg in that other messages are suppressed as well.)
(* * rg 3/4/87 changes for new concurrency machinery)
(* * rht 3/25/87: Now calls NC.CoerceToInterestedWindow.)
(* * rg 3/27/87 redid concurrency wrapper)
(DECLARE (GLOBALVARS NC.MsgDelay NC.CloseNoteFileFns))
(NC.ProtectedNoteFileOperation
NoteFile "Close NoteFile" InterestedWindow (OR (OPENWP InterestedWindow)
(SETQ InterestedWindow (
NC.CoerceToInterestedWindow NoteFile)))
(if (NC.ReadOnlyNoteFileP NoteFile)
then (NC.AbortSession NoteFile InterestedWindow)
else
(ALLOW.BUTTON.EVENTS)
(PROG ((FullFileName (fetch (NoteFile FullFileName) of NoteFile))
CardTotal ActiveCards ReturnValue (OperationMsg ""))
(* * Make sure NF is open)
(if [NULL (ERSETQ (SETQ ReturnValue (NC.NoteFileOpenP NoteFile]
then (SETQ ReturnValue (QUOTE OpenPFailed)))
(if (NULL ReturnValue)
then
(* * NoteFile is not open.)
(NC.PrintMsg InterestedWindow T "Can't close a closed notefile."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T)
(RETURN NIL)
elseif (NOT (type? NoteFile ReturnValue))
then
(* * Error return from NoteFileOpenPFn)
(if [NULL (ERSETQ (NC.ReportError NIL (CONCAT "OpenP test on "
FullFileName
"failed because "
ReturnValue
(CHARACTER
13)
"OK to continue Close. ↑ to abort Close."]
then (RETURN ReturnValue)))
(RETURN
(PROG NIL
(RESETSAVE NIL (BQUOTE (NC.ClearMsg , InterestedWindow T)))
(* * Delete the types and titles caching process if still alive. Have to do it now in order to make checking
operations that follow suitably efficient. Note its a bit too early since we can still cancel this close.
But any harm done is loss of speed if NoteFile remains open when close iss cancelled.)
(DEL.PROCESS (fetch (NoteFile CachingProcess) of NoteFile))
(* * See if any cards have operations in progress. If so, kill them after confirming with user.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
"Checking for card operations in progress ..."
(CHARACTER 13)))
(if (EQ (QUOTE ABORT)
(NC.CardOperationsInProgress NoteFile T))
then (RETURN NIL))
(NC.ClearMsg InterestedWindow NIL)
(* * If NULL QuietFlg then look for cards on the screen. If there are active cards ask the user if they still want
to close. When there's a non-NIL QuietFlg we just close the active cards.)
(if
(AND (NULL QuietFlg)
(NULL AutoConfirmFlg)
[for Window in (OPENWINDOWS)
thereis
(LET (Card)
(AND [SETQ Card
(OR (NC.CardFromWindow Window)
(AND (WINDOWP (WINDOWPROP
Window
(QUOTE ICONFOR)))
(NC.CardFromWindow
(WINDOWPROP Window
(QUOTE ICONFOR]
(NC.SameNoteFileP NoteFile (fetch
(Card NoteFile)
of Card]
(NULL (NC.AskYesOrNo (CONCAT
"There are still cards on the screen from this NoteFile "
FullFileName "." (CHARACTER
13)
"Want to close and save them? ")
" -- "
(QUOTE Yes)
NIL InterestedWindow NIL NIL)))
then (RETURN NIL))
(* * Run through CloseNoteFileFns with param of BEFORE. Exit if any returns DON'T)
(if [for Function in NC.CloseNoteFileFns
thereis (OR (EQ Function (QUOTE DON'T))
(EQ (QUOTE DON'T)
(APPLY* Function NoteFile (QUOTE BEFORE]
then (RETURN NIL))
(* * Close all the active cards)
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
"Checking for active cards ..."
(CHARACTER 13)))
[if (SETQ ActiveCards (NC.MapCards NoteFile (FUNCTION [LAMBDA (Card)
Card])
(FUNCTION NC.ActiveCardP)))
then (if (NULL QuietFlg)
then (NC.PrintMsg InterestedWindow T
"Closing and saving active cards ... "))
(RESETLST (RESETSAVE NC.ForceSourcesFlg NIL)
(RESETSAVE NC.ForceFilingFlg NIL)
(RESETSAVE NC.ForceTitlesFlg NIL)
(NC.CloseListOfActiveCards ActiveCards
InterestedWindow
QuietFlg)
(NC.CloseListOfActiveCards (for Card
in (
NC.FetchSpecialCards
NoteFile)
when
(NC.ActiveCardP
Card)
collect Card)
InterestedWindow
QuietFlg))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "Done."
(CHARACTER 13]
(* * Checkpoint the NoteFile.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Closing Notefile ... "
(CHARACTER 13)))
(if [NULL (CAR (ERSETQ (SETQ ReturnValue
(NC.CheckpointNoteFile NoteFile
QuietFlg T
InterestedWindow
OperationMsg]
then (SETQ ReturnValue (QUOTE CheckpointFailed)))
(* * Process error returns from in NC.CheckpointNoteFile)
(if (NOT (type? NoteFile ReturnValue))
then (if [NULL (ERSETQ (NC.ReportError NIL
(CONCAT
"Checkpoint of NoteFile "
FullFileName
" failed because "
ReturnValue "."
(CHARACTER 13)
"OK to continue Close. ↑ to abort Close."]
then (RETURN ReturnValue)))
(* * Close the file.)
(if [NULL (CAR (ERSETQ (SETQ ReturnValue
(APPLY* (fetch (NoteFile
CloseNoteFileFn)
of NoteFile)
NoteFile InterestedWindow]
then (SETQ ReturnValue (QUOTE CloseFailed)))
(* * Process error returns from the close.)
[if (NOT (type? NoteFile ReturnValue))
then (SELECTQ
ReturnValue
(NoteFileNotOpen
(if [NULL (ERSETQ (NC.ReportError
NIL
(CONCAT "NoteFile" FullFileName
" is not open."
(CHARACTER 13)
"OK to continue Close. ↑ to abort Close."]
then (RETURN ReturnValue)))
(PROGN [ERSETQ (NC.ReportError NIL
(CONCAT
"Close of NoteFile "
FullFileName
" failed because "
ReturnValue
"."
(CHARACTER
13]
(RETURN ReturnValue]
(* * Run through CloseNoteFileFns with param of AFTER. Stop if any returns DON'T)
[for Function in NC.CloseNoteFileFns
thereis (EQ (QUOTE DON'T)
(APPLY* Function NoteFile (QUOTE AFTER]
(* * Reset the interface and notify the user.)
(NC.ResetNoteFileInterface NoteFile)
(OR QuietFlg (NC.PrintMsg InterestedWindow T FullFileName " closed."))
(* * * Cleanup a bit.)
(* Clean off the card cache's)
(ADD.PROCESS (LIST (FUNCTION NC.CleanupCardObjects)
(fetch (NoteFile HashArray) of NoteFile)))
(* Clean off the NoteFile object to remove any
circularities.)
(create NoteFile smashing NoteFile Stream ← NIL UID ←
(fetch (NoteFile UID) of NoteFile)
FullFileName ← FullFileName Menu ←
(fetch (NoteFile Menu) of NoteFile)
NoteFileDevice ← (fetch (NoteFile
NoteFileDevice)
of NoteFile))
(* * Return the NF)
(RETURN NoteFile])
(NC.CheckpointNoteFile
[LAMBDA (NoteFile QuietFlg Don'tSaveDirtyCardsFlg InterestedWindow OperationMsg)
(* Randy.Gobbel "30-Mar-87 18:09")
(* * Checkpoint a notefile by call the device specific checkpoint fn.)
(* * fgh 5/26/86 First created.)
(* * fgh 9/1/86 Updated with with changes made to checkpinting since 5/23/86. Reimplemented changes include:
(* * fgh 6/4/86 Added Don'tSaveDirtyCardsFlg to prevent double passes through active cards at close time)
(* * fgh 6/13/86 Changed printouts to NF menu. Added check for operations in progress.) (* * fgh 6/25/86 Put in
contention lock and NC.ProtectedNoteFileOperation Added Don'tCheckOperationInProgressFlg
Don'tCheckCardOperationsInProgressFlg & InterestedWindow args.) (* * rht 7/4/86: Added check for readonly
notefile.) (* * rht 7/16/86: Now passes QuietFlg arg down to NC.SaveDirtyCards.))
(* * pmi 12/3/86 Added check for open NoteFile before attempting Checkpoint (Code stolen from NC.CloseNoteFile))
(* * pmi 12/22/86 Made test for open notefile consistent with other NoteFile operations (ie. Abort Close))
(* * rg 3/4/87 rewritten for new concurrency machinery)
(* * rht 3/25/87: Now calls NC.CoerceToInterestedWindow.)
(* * rg 3/27/87 fiddled with NC.ProtectedNoteFileOperation wrapper)
(DECLARE (GLOBALVARS NC.MsgDelay))
(NC.ProtectedNoteFileOperation
NoteFile "Checkpoint NoteFile" InterestedWindow (OR (OPENWP InterestedWindow)
(SETQ InterestedWindow (
NC.CoerceToInterestedWindow
NoteFile)))
(PROG ((FullFileName (fetch (NoteFile FullFileName) of NoteFile))
ReturnValue)
(* * Make sure NF is open)
(if [NULL (ERSETQ (SETQ ReturnValue (NC.NoteFileOpenP NoteFile]
then (SETQ ReturnValue (QUOTE OpenPFailed)))
(if (NULL ReturnValue)
then
(* * NoteFile is not open.)
(NC.PrintMsg InterestedWindow T "Can't checkpoint a closed notefile."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T)
(RETURN NIL)
elseif (NOT (type? NoteFile ReturnValue))
then
(* * Error return from NoteFileOpenPFn)
(if [NULL (ERSETQ (NC.ReportError NIL (CONCAT "OpenP test on "
FullFileName
"failed because "
ReturnValue
(CHARACTER 13)
"OK to continue Checkpoint. ↑ to abort Checkpoint."]
then (RETURN ReturnValue)))
(SETQ OperationMsg (CONCAT (OR OperationMsg "")
"Checkpointing " FullFileName (CHARACTER 13)))
(if (NC.CheckForNotReadOnly NoteFile InterestedWindow "Can't checkpoint ")
then (RETURN (PROGN [OR QuietFlg (RESETSAVE NIL
(BQUOTE (NC.ClearMsg
,
InterestedWindow T]
(* * If appropriate, msg the user.)
(OR QuietFlg (NC.PrintMsg InterestedWindow
"Checkpointing notefile "
FullFileName " ..."
(CHARACTER 13)))
(* * Save the dirty cards on the screen if necessary.)
(if (NULL Don'tSaveDirtyCardsFlg)
then (NC.SaveDirtyCards NoteFile T
InterestedWindow
OperationMsg QuietFlg))
(* Put out the new ChkptPtr to the file.)
(* * Call the device specific checkpoint fn.)
(if [NULL (ERSETQ (SETQ ReturnValue
(APPLY* (fetch
(NoteFile
CheckpointNoteFileFn)
of NoteFile)
NoteFile
InterestedWindow
OperationMsg QuietFlg]
then (SETQ ReturnValue (QUOTE CheckpointFailed))
)
(* * Process the error returns.)
(if (type? NoteFile ReturnValue)
then
(* * Successful return.)
(OR QuietFlg (NC.PrintMsg InterestedWindow
T
(OR
OperationMsg "")
" Checkpoint done."
(CHARACTER
13)))
NoteFile
else
(* * Error return.)
(ERSETQ (NC.ReportError NIL
(CONCAT
"Checkpoint failed for "
FullFileName
" because "
ReturnValue ".")
))
ReturnValue])
(NC.SaveDirtyCards
[LAMBDA (NoteFile InterestedWindow OperationMsg QuietFlg)
(* Randy.Gobbel "30-Mar-87 18:10")
(* * Save every card that is both active and dirty to the notefile.)
(* * rht 9/21/85: Now records cards that were shrunken and reshrinks after checkpoint is completed.)
(* * fgh 10/15/85 Put in stuff to make using cache array efficient)
(* * rht 10/20/85: Now uses NC.GetShrunkenWin to find if card's win is shrunken, rather than looking at all open
windows on the screen.)
(* * rht 11/13/85: Updated to handle new NoteFile and Card formats.)
(* * fgh 6/13/86 Added TerminateOperationsInProgressFlg OperationMsg & InterestedWindow arg and associated action.)
(* * kirk/rht 9/10/86 Added QuietFlg)
(* * rht 3/30/87: Now passes NIL InterestedWindow arg to NC.CardSaveFn so that card's prompt window will be used if
possible.)
(LET (ShrunkenCardWins ActiveCards)
[NC.MapCards NoteFile (FUNCTION (LAMBDA (Card)
(if (NC.ActiveCardP Card)
then (push ActiveCards Card))
(if (NC.GetShrunkenWin Card)
then (push ShrunkenCardWins (NC.FetchWindow Card]
(RESETLST (RESETSAVE NC.ForceSourcesFlg NIL)
(RESETSAVE NC.ForceTitlesFlg NIL)
(for Card in ActiveCards eachtime (BLOCK)
do (NC.CardSaveFn Card QuietFlg NIL OperationMsg)))
(for Win in ShrunkenCardWins eachtime (BLOCK) do (SHRINKW Win])
(NC.AbortSession
[LAMBDA (NoteFile InterestedWindow Don'tConfirmFlg QuietFlg)
(* Randy.Gobbel "31-Mar-87 18:41")
(* * Kill the current notecards session. Work lost since last checkpoint.)
(* * rht 7/14/85: Replaced the call to reset the main menu with call to NC.ResetMainMenu. Also took out redundant
reset of PSA.Database, since NC.ForceDatabaseClose is doing that.)
(* * fgh & rht 10/16/85 Update with new cacheing mechanism.)
(* * fkr 11/8/85 Updated to handle noteFile object and new CardID scheme.)
(* * kirk 20Jan86 Added Don'tCloseFlg to leave NoteFile open after done deleting changes.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * rht 7/2/86: No longer bugs you if no changes were made since last checkpoint. Removed Don'tCloseFlg arg and
added InterestedWindow arg.)
(* * rht 7/6/86: Now clears InterestedWindow of final truncating message.)
(* * rht 7/13/86: Added Don'tConfirmFlg and QuietFlg args. Note that Don'tConfirmFlg non-nil stops questioning of
user as to losing all changes.)
(* * kirk 11/17/86 Changed call on SETFILEINFO to pass stream instead of filename.)
(* * pmi 12/22/86 Made test for open notefile consistent with other NoteFile operations (ie. Checkpoint, Close))
(* * rht 2/19/87: Added DEL.PROCESS call to kill caching process.)
(* * rg 3/6/87 added NC.ProtectedSessionOperation wrapper)
(* * rht 3/25/87: Now calls NC.CoerceToInterestedWindow.)
(* * rg 3/31/87 changed ProtectedSessionOp to ProtectedNoteFileOp)
(DECLARE (GLOBALVARS NC.MsgDelay))
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow NoteFile)))
(NC.ProtectedNoteFileOperation
NoteFile "Abort Session" InterestedWindow
(PROG ((Stream (fetch (NoteFile Stream) of NoteFile))
(FullFileName (fetch (NoteFile FullFileName) of NoteFile))
(LastChkptPtr (fetch (NoteFile CheckptPtr) of NoteFile))
EndPtr CardTotal NewBytes ReturnValue)
(if [NULL (ERSETQ (SETQ ReturnValue (NC.NoteFileOpenP NoteFile]
then (SETQ ReturnValue (QUOTE OpenPFailed)))
(if (NULL ReturnValue)
then
(* * NoteFile is not open.)
(NC.PrintMsg InterestedWindow T "Can't abort a closed notefile."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg InterestedWindow T)
(RETURN NIL)
elseif (NOT (type? NoteFile ReturnValue))
then
(* * Error return from NoteFileOpenPFn)
(if [NULL (ERSETQ (NC.ReportError NIL (CONCAT "OpenP test on "
FullFileName
"failed because "
ReturnValue
(CHARACTER 13)
"OK to continue Abort. ↑ to abort Abort."]
then (RETURN ReturnValue)))
(* * Delete the types and titles caching process if still alive. Have to do it now in order to make checking
operations that follow suitably efficient. Note its a bit too early since we can still cancel this close.
But any harm done is loss of speed if NoteFile remains open when close iss cancelled.)
(DEL.PROCESS (fetch (NoteFile CachingProcess) of NoteFile))
(SETQ EndPtr (GETEOFPTR Stream))
(SETQ NewBytes (IDIFFERENCE EndPtr LastChkptPtr))
(if (OR (ZEROP NewBytes)
Don'tConfirmFlg
(NC.AskYesOrNo (CONCAT "Do you wish to lose all changes since"
(CHARACTER 13)
"the last checkpoint (" NewBytes " bytes) of "
FullFileName)
"--" "Yes" T InterestedWindow NIL T))
then [LET ((CardNumber 0)
(CardTotal (fetch (NoteFile HashArraySize) of NoteFile)))
(NC.MapCards NoteFile
(FUNCTION (LAMBDA (Card)
(LET (Win)
(SETQ CardNumber (ADD1 CardNumber))
[OR QuietFlg (COND
((ZEROP (IREMAINDER CardNumber 100))
(NC.PrintMsg InterestedWindow T
"Quitting from active cards ... "
(CHARACTER 13)
"Processing item number "
CardNumber " out of "
CardTotal "."
(CHARACTER 13]
(COND
((NC.ActiveCardP Card)
(SETQ Win (NC.FetchWindow Card))
(NC.AbortCard Card QuietFlg)
(COND
(Win (bind (Process ←
(WINDOWPROP
Win
(QUOTE PROCESS)))
until (OR (NULL Process)
(PROCESS.FINISHEDP
Process))
do (BLOCK))
(CLOSEW Win]
[COND
((LESSP LastChkptPtr EndPtr)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Truncating file "
FullFileName " ..."))
(COND
((NOT (SETFILEINFO Stream (QUOTE LENGTH)
LastChkptPtr))
(NC.PrintMsg InterestedWindow NIL "Couldn't truncate "
FullFileName "." (CHARACTER 13]
(NC.ResetNoteFileInterface NoteFile)
(NC.ForceDatabaseClose NoteFile))
(NC.ClearMsg InterestedWindow T])
(NC.CopyCards
[LAMBDA (Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow)
(* Randy.Gobbel " 2-Apr-87 15:38")
(* * 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)
(NCP.WithLockedCards (NC.IfAllCardsFree (NC.LockListOfCards Cards "Copy Cards")
(LET (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 (ERROR!)))
(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 (ERROR!)))
(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])
)
(* * changes to NCCARDS)
(DEFINEQ
(NC.EditNoteCard
[LAMBDA (Card Region/Position TypeSpecificArgs) (* Randy.Gobbel "30-Mar-87 18:16")
(* * Bring the already created NoteCard specified by ID onto the screen at Region or Position specified by
Region/Position)
(* * fgh 11/11/85: Updated to handle new Card object.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * kirk 15May86 Added call to NC.AttachNoteFileName)
(* * rht 7/13/86: Added TypeSpecificArgs arg.)
(* * kef 7/16/86: Added NC.ObtainCardEditPermission.)
(* * kef 8/7/86: Added check to make sure that applying the EditFn worked. If not, then release those write locks,
thus keeping the writelock count consistent.)
(* * fgh 8/30/86 Converted APPLY* to NC.ApplyFn.)
(* * rht 10/6/86: Added checks before doing WINDOWPROP calls in case there was a recursive call to
NC.EditNoteCard.)
(* * rg 3/30/87 added NC.ProtectedCardOperation wrapper)
(DECLARE (GLOBALVARS NC.ShowNoteFileOnCards))
(NC.ProtectedCardOperation Card "Edit NoteCard" NIL (RESETSAVE (CURSOR WAITINGCURSOR))
(PROG (NoteCardType Window Substance EditResult)
[COND
((AND (NC.ActiveCardP Card)
(NC.ObtainEditPermission Card))
(SETQ Substance (NC.FetchSubstance Card)))
((NC.ObtainEditPermission Card)
(NC.GetNoteCard Card)
(SETQ Substance (NC.FetchSubstance Card)))
(T (RETURN (NC.CardPartBusy Card
(QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST]
(SETQ NoteCardType (NC.RetrieveType Card))
(COND
([AND (SETQ EditResult
(ERSETQ (NC.ApplyFn EditFn Card Substance
Region/Position
TypeSpecificArgs)))
(WINDOWP (SETQ Window (CAR EditResult]
(WINDOWADDPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.QuitCard)
(QUOTE FIRST))
(OR (NC.CardP (WINDOWPROP Window (QUOTE
NoteCardObject)))
(WINDOWPROP Window (QUOTE NoteCardObject)
Card))
[OR (EQ (WINDOWPROP Window (QUOTE
COPYBUTTONEVENTFN))
(FUNCTION NC.CopyButtonEventFn))
(WINDOWPROP Window (QUOTE OldCopyButtonEventFn)
(WINDOWPROP Window (QUOTE
COPYBUTTONEVENTFN)
(FUNCTION
NC.CopyButtonEventFn]
(if NC.ShowNoteFileOnCards
then (NC.AttachNoteFileName Window)))
(T (* At this point, we've obtain the write locks but the
edit failed, so we'd better release them)
(for CardPart in (QUOTE (SUBSTANCE TOLINKS
GLOBALTOLINKS
PROPLIST))
do (NC.ApplyFn ReleaseWritePermissionFn Card
CardPart))
(RETURN)))
(RETURN Window])
(NC.QuitCard
[LAMBDA (CardIdentifier CallCloseWFlg DontSaveFlg DontRecacheFlg InterestedWindow OperationMsg
QuietFlg Don'tDeactivateFlg) (* Randy.Gobbel " 1-Apr-87 17:33")
(* * Force note card specified by ID to quit or stop)
(* * rht 2/9/85: New arg DontSaveFlg prevents NC.CardSaveFn from being called. Used when aborting a card.
This is NOT equivalent to NC.QuitWithoutSaving.)
(* * rht 6/25/85: Now moves card off screen before saving if NC.CloseCardsOffScreenFlg is non-nil.)
(* * rht 6/25/85: Brought the insure proper filing check back here from NC.CardSaveFn. Bails out if user cancelled
operation inside of NC.InsureProperFiling)
(* * fgh 11/11/85: Updated to handle CardID and CardInfo objects.)
(* * fgh 1/16/86 Put in code to insure that if one of the TopLevelCards is quit then it is reactivated immedialtely
to make sure it stays cached for fast access.)
(* * fgh 2/5/86 Added call to NC.ApplyFn)
(* * fgh 5/2/86 Added DontRecacheFlg arg)
(* * fgh 6/9/86 Added code to check to make sure other operations are not in progress. And DontCheckOpInProgressFlg
arg to match)
(* * fgh 6/26/86 Added InterestedWindow & OperationMsg arg.)
(* * rht 7/2/86: Now bails out if notefile is readonly, user confirms, but we're supposed to write down changes.)
(* * rht 7/13/86: Now takes QuietFlg arg.)
(* * rht 7/14/86: Call NC.DeactivateCard from here instead of in card type QuitFn. Take a Don'tDeactivateFlg as
well.)
(* * rht 10/7/86: Now removes DELETEME imageobj's from card substance.)
(* * rht 11/2/86: Now returns DON'T if operation in progress.)
(* * rht 11/13/86: Now closes open proplist editor if any before saving.)
(* * rg 3/4/87 rewritten to use new NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg arg)
(* * rht 3/24/87: Now calls NC.CoerceToInterestedWindow and passes InterestedWindow to NC.InsureProperFiling.)
(DECLARE (GLOBALVARS NC.RemoveDELETEMEImageObjsFromCardFlg))
(LET ((Card (NC.CoerceToCard CardIdentifier))
Window ReadOnlyCardFlg)
(NC.ProtectedCardOperation
Card "Close Card" InterestedWindow
(PROG NIL
(SETQ ReadOnlyCardFlg (NC.ReadOnlyCardP Card))
(* The window not being open should mean that it's
shrunken. If so, expand it.)
(SETQ Window (NC.FetchWindow Card))
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow
Card)))
(COND
((AND Window (NOT (OPENWP Window)))
(EXPANDW Window)))
(* * if proper filing says don't quit then get out)
[OR DontSaveFlg ReadOnlyCardFlg (COND
((EQ (NC.InsureProperFiling Card InterestedWindow)
(QUOTE DON'T))
(RETURN (QUOTE DON'T]
(* * If card is readonly but we've made changes that we're supposed to save, then get user confirmation and bail
out.)
(if [AND (NOT DontSaveFlg)
(NOT Don'tDeactivateFlg)
ReadOnlyCardFlg
(NC.CardSomehowDirtyP Card)
(NULL QuietFlg)
(NOT (PROGN (NC.PrintMsg InterestedWindow T
"Card has been changed, but notefile is readonly."
(CHARACTER 13))
(NC.AskYesOrNo
"Want to quit anyway, flushing changes? "
NIL
(QUOTE Yes)
NIL InterestedWindow]
then (RETURN (QUOTE DON'T)))
(* * Otherwise go ahead and quit)
(RETURN (PROGN (* Close open proplist editor if any.)
[AND Window (LET ((PropListEditorWindow (
NC.PropListEditorOpenP
Window)))
(AND PropListEditorWindow (CLOSEW
PropListEditorWindow]
(COND
((AND Window NC.CloseCardsOffScreenFlg)
[COND
((NOT (NC.FetchSavedRegion Card))
(NC.SetSavedRegion Card (WINDOWPROP Window
(QUOTE REGION]
(MOVEW Window 1500 1500)))
(OR DontSaveFlg (if ReadOnlyCardFlg
then (NC.TurnOffDirtyFlgs Card)
else
(AND
NC.RemoveDELETEMEImageObjsFromCardFlg
(
NC.RemoveDELETEMEImageObjsFromCard
Card
(FUNCTION NC.DELETEMEImageObjP))
)
(NC.CardSaveFn Card (OR
NC.CloseCardsOffScreenFlg
QuietFlg)
InterestedWindow
OperationMsg)))
(AND Window (WINDOWDELPROP Window (QUOTE CLOSEFN)
(FUNCTION NC.QuitCard)))
(PROG1 (NC.ApplyFn QuitFn Card)
(AND CallCloseWFlg Window
(PROGN (WINDOWPROP Window (QUOTE
NoteCardObject)
NIL)
(CLOSEW Window)))
(OR Don'tDeactivateFlg (NC.DeactivateCard Card))
(* * if this is one of the top level cards, then make sure it stays cached)
(if (AND (NC.TopLevelCardP Card)
(NULL DontRecacheFlg)
(NULL Don'tDeactivateFlg))
then (NCP.ActivateCards Card])
(NC.CardSaveFn
[LAMBDA (WindowOrID QuietFlg InterestedWindow OperationMsg)
(* Randy.Gobbel "31-Mar-87 14:03")
(* * rht 2/1/85: New function for saving ANY kind of card. All strangenesses are handled in NC.CardDirtyP and
NC.MarkCardDirty. Added print statements to show what is being saved. Lets NC.CardDirtyP take care of proper dirty
checks.)
(* * rht 2/8/85: Added InsureFilingFlg)
(* * rht 6/25/85: Pulled out InsureFilingFlg. That check now done upstairs in NC.QuitCard.)
(* * rht 9/20/85: Added QuietFlg.)
(* * fgh 11/12/85 Updated to handle Card objects. Removed DatabaseStream object.)
(* * kirk 29Jan86 replaced call on undefined NC.UpdateRegionData with NC.PutRegion)
(* * fgh 6/13/86 Added operations in progress code and DontCheckForOpsInProgressFlg arg.)
(* * fgh 6/26/86 Added InterestedWindow & OperationMsg arg.)
(* * rht 7/4/86: Added check for readonly notefile.)
(* * kef 7/22/86: Added something to obtain the write permission on the FROMLINKS if the links have been changed.
FROMLINKS aren't ordinarily obtained at edit time like the rest of the links are.)
(* * kef 7/30/86: Modified to check for Client's concept of whether he owns the write lock or not, thus deciding
whether or not to setup the release of the write lock afterwards.)
(* * kef 7/30/86: Added a check to see if the NewCardFlg was on, then release TITLE and FROMLINKS writelocks.
This is needed since ordinary deactivation of cards won't do this; i.e., only new cards have their TITLE and
FROMLINKS also writelocked.)
(* * fgh 8/30/86 Changed APPLY* to NC.ApplyFn where possible.)
(* * rht&pmi 11/21/86: Now calls WhenSavedFn for card type if any.)
(* * rg 3/4/87 rewritten for new NC.ProtectedCardOperation, removed DontCheckForOpsInProgressFlg)
(* * rht 3/23/87: Fixed weirdness with InterestedWindow/Window.)
(* * Rht 3/24/87: Now calls NC.CoerceToInterestedWindow)
(* * rht 3/30/87: No longer prints messages if nothing got written down.)
(* * rg 3/31/87 fiddled w/ InterestedWindow stuff)
(LET ((Card (NC.CoerceToCard WindowOrID))
Window OldRegion NewRegion DoneAPutP)
(NC.ProtectedCardOperation
Card "Save Card" InterestedWindow (LET [(WhenSavedFn (GETPROP (NC.FetchType Card)
(QUOTE WhenSavedFn]
(AND WhenSavedFn (APPLY* WhenSavedFn Card)))
(SETQ Window (NC.FetchWindow Card))
(OR InterestedWindow (SETQ InterestedWindow (NC.CoerceToInterestedWindow Card)))
(if (NC.CheckForNotReadOnly Card InterestedWindow "Can't save cards in ")
then (COND
((OR (NC.CardDirtyP Card)
(NC.FetchNewCardFlg Card))
(OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "substance, "))
(NC.PutMainCardData Card T)
(SETQ DoneAPutP T)
(NC.MarkCardDirty Card (QUOTE RESET)))
([AND (NOT (NC.FetchBeingDeletedFlg Card))
Window
(OR [NOT (EQUAL (fetch (REGION WIDTH) of (SETQ OldRegion
(NC.FetchRegion
Card)))
(fetch (REGION WIDTH)
of (SETQ NewRegion (WINDOWPROP
Window
(QUOTE REGION]
(NOT (EQUAL (fetch (REGION HEIGHT) of OldRegion)
(fetch (REGION HEIGHT) of NewRegion]
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "region, "))
(NC.PutRegion Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchTitleDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "title, "))
(NC.PutTitle Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchPropListDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "proplist, "))
(NC.PutPropList Card)
(SETQ DoneAPutP T)))
[COND
((NC.FetchLinksDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow T
(OR OperationMsg "")
(NC.FetchTitle Card)
": Saving ... "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "links, "))
(* Make sure that we have the FROMLINKS of this card.
Only necessary because all of the LINKS are written
together.)
(RESETLST (until (NC.ApplyFn ObtainWritePermissionFn Card (QUOTE
FROMLINKS))
do (BLOCK)
(NC.PrintMsg InterestedWindow NIL
"waiting for FROMLINKS write permission...."))
(RESETSAVE NIL (BQUOTE (APPLY* , (fetch (Card
ReleaseWritePermissionFn)
of Card)
, Card FROMLINKS)))
(NC.PutLinks Card)
(SETQ DoneAPutP T] (* It's not a new card anymore.)
(COND
((NC.FetchNewCardFlg Card)
(* If a new card, then make sure we release the FROMLINKS and TITLE. Necessary because DeactivateCard normally
doesn't do this, because the FROMLINKS and TITLE aren't ordinarily owned on an active card.)
(NC.ApplyFn ReleaseWritePermissionFn Card (QUOTE FROMLINKS))
(NC.ApplyFn ReleaseWritePermissionFn Card (QUOTE TITLE))
(NC.SetNewCardFlg Card NIL)))
(OR QuietFlg (if DoneAPutP
then (NC.PrintMsg InterestedWindow NIL "Done."
(CHARACTER 13))
(NC.ClearMsg InterestedWindow T])
(NC.DeleteNoteCards
[LAMBDA (CardIdentifiers NoIndividualConfirmFlg DontClearFlg InterestedWindow QuietFlg
NoGroupConfirmFlg) (* Randy.Gobbel " 2-Apr-87 16:05")
(* Delete note cards. If no card specified then get a
list of note cards to be deleted.
Then delete these cards.)
(* * fgh 11/11/85: Updated to handle new Card objects. Also split off main work of deleteing a single note card
into NC.DeleteNoteCard function.)
(* * kirk 21Feb86 Added InterestedWindow)
(* * kirk 29Apr86 Now returns CardIdentifiers)
(* * fgh 6/9/86 Added checks to see if other operations are in progress)
(* * rht 7/4/86: Now checks that card is not read-only.)
(* * kirk 18Aug86 Added main window for windowless cards.)
(* * rht 8/29/86: Reorganized and added call to NC.SeverAllLinks to make deleting more efficient.
Added QuietFlg, NoGroupConfirmFlg and Don'tPutToBeDeletedCardsFlg args.)
(* * rht 9/5/86: Now forces NoGroupConfirmFlg to be non-nil if NoIndividualConfirmFlg is NIL and only one card to
delete.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 12/16/86: Removed obsolete Don'tPutToBeDeletedCardsFlg arg.)
(* * rht 3/9/87: Changed NC.DeleteSelectingMenu to NC.SelectingCardsMenu.)
(* * rg 3/9/87 added NC.ProtectedSessionOperation wrapper)
(* * rg 3/11/87 changed call of NC.DeleteNoteCard to NC.DeleteNoteCardInternal)
(* * rg 3/18/87 changed NC.ProtectedSessionOperation to NC.CardSelectionOperation)
(* * rht 3/30/87: Now calls NC.SeverExternalLinks rather than NC.SeverAllLinks.)
(* * rg 3/31/87 now protects cards passed in in list)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(NCP.WithLockedCards
(NC.IfAllCardsFree (NC.LockListOfCards (MKLIST CardIdentifiers)
"Delete Note Cards")
(OR CardIdentifiers (SETQ CardIdentifiers
(NC.SelectNoteCards NIL NIL NC.SelectingCardsMenu InterestedWindow
"Please shift-select the Note Cards to be deleted.")))
(* * Kludge in case args are nil, say, when we're called from a card's menu.)
(if (AND (NULL NoIndividualConfirmFlg)
(NULL NoGroupConfirmFlg)
(EQ (LENGTH (MKLIST CardIdentifiers))
1))
then (SETQ NoGroupConfirmFlg T)
(SETQ QuietFlg T))
(* * First collect cards that are deletable.)
(LET ((CardsToDelete (for CardIdentifier in (MKLIST CardIdentifiers)
bind Card eachtime (BLOCK)
when
[AND (SETQ Card (NC.CoerceToCard
CardIdentifier))
(if (NOT (NC.TopLevelCardP Card))
else (NC.PrintMsg (NC.FetchWindow
Card)
T
"You cannot delete this FileBox."
(CHARACTER 13))
(DISMISS 1000)
(NC.ClearMsg (NC.FetchWindow
Card)
T)
NIL)
(NC.CheckForNotReadOnly Card (
NC.FetchWindow
Card)
"Can't delete cards from a ")
(OR NoIndividualConfirmFlg
(PROG1 (NC.AskYesOrNo
"Are you sure you want to delete this?"
" -- " "Yes" (NULL
DontClearFlg)
(OR (NC.FetchWindow
Card)
InterestedWindow)
NIL NIL)
(NC.ClearMsg]
collect Card))
(NumSpecified (LENGTH (MKLIST CardIdentifiers)))
NumToDelete)
(SETQ NumToDelete (LENGTH CardsToDelete))
(if [AND (GREATERP NumToDelete 0)
(if (EQUAL NumToDelete NumSpecified)
then (OR NoGroupConfirmFlg
(PROG1 (NC.AskYesOrNo
(CONCAT "You've specified "
NumToDelete
" cards to delete."
(CHARACTER 13)
"Are you sure you want to delete them? ")
NIL "Yes" (NULL DontClearFlg)
InterestedWindow)
(NC.ClearMsg)))
else (PROG1 (NC.AskYesOrNo (CONCAT "Out of "
NumSpecified
" cards specified, "
(DIFFERENCE
NumSpecified
NumToDelete)
" are not deletable."
(CHARACTER
13)
"Want to delete the remaining "
NumToDelete
" cards? ")
NIL "Yes" (NULL
DontClearFlg)
InterestedWindow)
(NC.ClearMsg]
then
(* * Mark UIDs of cards about to be deleted.)
(for Card in CardsToDelete
do (NC.UIDPutProp (fetch (Card UID) of Card)
(QUOTE AboutToBeDeletedFlg)
T))
(* * Sever all links into and out of CardsToDelete)
(NC.SeverExternalLinks CardsToDelete QuietFlg
InterestedWindow)
(* * Now delete the cards one at a time.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Deleting cards: 1 out of "
NumToDelete " ..."))
(for Card in CardsToDelete as i from 1
eachtime (BLOCK)
do (OR QuietFlg
(if (ZEROP (REMAINDER i 10))
then (NC.PrintMsg InterestedWindow T
"Deleting cards: "
i " out of "
NumToDelete " ...")))
(NC.DeleteNoteCardInternal Card QuietFlg
InterestedWindow T))
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
CardIdentifiers])
(NC.InsureProperFiling
[LAMBDA (Card InterestedWindow) (* Randy.Gobbel " 1-Apr-87 17:33")
(* Called when any type of note card is being quitted
from, i.e., closed)
(* * rht 12/9/84: Moved check of the NC.ForceFiling flag into NC.CheckContentsHooks.)
(* * fgh 11/12/85 Updated to handle Card and NoteFile objects.)
(* * fgh 6/27/86 Changed format to allow being killed by ERROR!)
(* * rg 1/28/87 Now returns CANCELLED if any of the component tests fail)
(* * rht 3/23/87: Now takes InterestedWindow arg.)
(* * rg 4/1/87 now returns DON'T if component tests fail)
(OR (AND (NULL (NC.FetchBeingDeletedFlg Card))
(NC.CheckTitle Card InterestedWindow)
(NC.CheckFiling Card InterestedWindow))
(QUOTE DON'T])
(NC.AddParents
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel " 2-Apr-87 15:38")
(* Add a subtopic link from a contents card specified by the user to the contents card specified by
WindowOrTextStream. But first check to make sure that this would not introduce any circularities in the contents
lattice.)
(* * rht 12/8/84: Massive shaving. Now calls NC.MakeChildLink to do the tough work.)
(* * rht 10/3/85: No longer prints final, annoying, slow-to-disappear message in prompt window if nothing
selected.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * fgh 6/9/86 Added code to check to make sure that another operation is not in progress on this card when this
fn is called.)
(* * rht 7/5/86: Now checks for readonly cards.)
(* * rht&pmi 11/24/86: Surrounded call to NC.MakeChildLink with NC.ActivateCardAndDo so that ParentCard will be
active for duration of the call.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 1/28/87: Took out call to NC.ActivateCardAndDo. Need to make sure ParentCard gets saved after getting link
if wasn't active originally.)
(* * rg 3/3/87 Enlarged scope of NC.ProtectedCardOperation)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(* * rg 4/2/87 changed NC.CardSelectionOperation to NCP.WithLockedCards)
(NCP.WithLockedCards (LET (Card NewParents (Window (WINDOW.FROM.TEDIT.THING WindowOrTextStream))
)
(SETQ Card (NC.CoerceToCard Window))
(NC.ProtectedCardOperation
Card "Designate FileBoxes" NIL
(if (NC.CheckForNotReadOnly Card Window "Can't do filing in ")
then (SETQ NewParents (NC.SelectNoteCards
NIL
(FUNCTION NC.FileBoxP)
NC.SelectingParentsMenu Card
" Please shift-select the new parent FileBox(es)."))
(AND NewParents Card
(for ParentCard in NewParents bind OneHook
when [LET ((WasActiveFlg (NC.ActiveCardP
ParentCard)))
(OR WasActiveFlg (NC.GetNoteCard
ParentCard))
(PROG1 (NC.MakeChildLink Card
ParentCard
Window)
(OR WasActiveFlg
(NC.QuitCard
ParentCard NIL
NIL NIL
NIL NIL
T]
do (SETQ OneHook T) finally (RETURN
OneHook])
(NC.UnfileNoteCard
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel " 2-Apr-87 15:38")
(* Take a notecard out of a file box.
Called fom title bar menu.)
(* * fgh 11/12/85 Updated to handle Card objects.)
(* * fgh 6/9/86 Added code to check to make sure that another operation is not in progress on this card when this
fn is called.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 2/2/87: Fixed bug %#418: Trashed all the stuff about opening PropListEditor on the fromlinks.
Now just uses SelectNoteCards to choose the fileboxes to delete from.)
(* * rg 3/4/87 rewritten for new NC.ProtectedCardOperation)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(* * RG 4/2/87 changed NC.CardSelectionOperation to NCP.WithLockedCards)
(DECLARE (GLOBALVARS NC.SelectingParentsMenu))
(NCP.WithLockedCards (LET ((Card (NC.CoerceToCard WindowOrTextStream)))
(NC.ProtectedCardOperation
Card "Unfile" NIL (LET* [(FromLinks (NC.FetchFromLinks Card))
(Parents (for FromLink in FromLinks
when
(FMEMB (fetch (Link Label)
of FromLink)
(QUOTE (FiledCard
SubBox)))
collect (fetch (Link
SourceCard)
of FromLink]
(for Box
in (NC.SelectNoteCards
NIL
[FUNCTION (LAMBDA (Box)
(AND (NC.FileBoxP Box)
(FMEMB Box Parents]
NC.SelectingParentsMenu Card
"Please shift-select the file box(es) from which to remove this card. ")
do (for FromLink in FromLinks
when (NC.SameCardP
Box
(fetch (Link SourceCard)
of FromLink))
do (NC.DeleteLink FromLink T])
)
(* * changes to NCINTERFACE)
(DEFINEQ
(NC.SelectNoteCards
[LAMBDA (SingleCardFlg SelectionPredicate Menu InstigatingCardOrWindow Msg CheckForCancelFlg)
(* Randy.Gobbel " 2-Apr-87 15:01")
(* 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)
(DECLARE (USEDFREE CardListResetVar))
(LET (Window Card ButtonEventFn InstigatingWindow InstigatingCard InstigatingNoteFile MenuWindow
PromptWindow CopyInsertEvent SelectedCards PromptWindowProcess 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))
(* * if we are running under the mouse process, start up a new mouse process)
(ALLOW.BUTTON.EVENTS)
(* * 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 SelectCards NIL)))
(* * Make the process behind the prompt window includiong control for a blibnking cursor)
[WINDOWPROP PromptWindow (QUOTE PROCESS)
(SETQ PromptWindowProcess (ADD.PROCESS
(QUOTE (PROG NIL (BLOCK)
(TTYDISPLAYSTREAM (PROCESSPROP (THIS.PROCESS)
(QUOTE WINDOW)))
XXXX
(BIN)
(BLOCK)
(GO XXXX)))
(QUOTE WINDOW)
PromptWindow
(QUOTE NAME)
(QUOTE SelectNoteCardsProc)
(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 , PromptWindowProcess)))
(* * Insure the prompt window is cleared on the way out)
[NAMED-RESETSAVE InternalResetVar NIL
(BQUOTE (PROGN (AND (HASTTYWINDOWP , PromptWindowProcess)
(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))
(DELETEMENU , Menu T]
(* * 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.CloseStructure
[LAMBDA (RootCards TraversalSpecs InterestedWindow QuietFlg)
(* Randy.Gobbel " 2-Apr-87 15:38")
(* * rht 9/2/86: Replaced call to outdated NC.CollectCards with NCP.CollectCards. Threw away useless NoCheckFlg and
Don'tClearFlg args.)
(* * 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 4/1/87 changes NC.ProtectedSessionOperation to NCP.WithLockedCards ; added NC.IfAllCardsFree wrapper)
(NCP.WithLockedCards (SETQ RootCards (MKLIST RootCards))
(NC.IfAllCardsFree (NC.LockListOfCards RootCards "Close Structure")
(OR RootCards (SETQ RootCards
(NC.SelectNoteCards NIL NIL
NC.SelectingCardsMenu NIL
"Shift-select the root cards of the structure"))
(ERROR!))
[OR TraversalSpecs (SETQ TraversalSpecs
(NC.AskTraversalSpecs (fetch (Card NoteFile)
of (CAR RootCards))
(QUOTE (SubBox
FiledCard]
(if (AND RootCards TraversalSpecs)
then (OR QuietFlg (NC.PrintMsg InterestedWindow
T
"Collecting cards to close ..."))
(NC.CloseNoteCards
(NCP.CollectCards RootCards
(fetch (TRAVERSALSPECS
LinkTypes)
of TraversalSpecs)
(fetch (TRAVERSALSPECS
Depth)
of TraversalSpecs))
NIL NIL InterestedWindow)
(OR QuietFlg (NC.ClearMsg InterestedWindow
T))
RootCards])
(NC.CopyStructure
[LAMBDA (RootCards DestinationFileBox TraversalSpecs InterestedWindow QuietFlg)
(* Randy.Gobbel " 2-Apr-87 15:38")
(* * 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)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu NC.SelectingCardMenu))
(NCP.WithLockedCards (SETQ RootCards (MKLIST RootCards))
(NC.IfAllCardsFree (NC.LockListOfCards RootCards "Copy Structure")
(OR RootCards (SETQ RootCards
(NC.SelectNoteCards NIL NIL
NC.SelectingCardsMenu NIL
"Shift-select the root cards of the structure"))
(ERROR!))
(OR TraversalSpecs [SETQ TraversalSpecs
(NC.AskTraversalSpecs (fetch (Card NoteFile)
of (CAR RootCards))
(QUOTE (SubBox
FiledCard]
(ERROR!))
(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."))
(ERROR!))
(NC.CopyCards (NCP.CollectCards RootCards
(fetch
(TRAVERSALSPECS
LinkTypes)
of
TraversalSpecs)
(fetch
(TRAVERSALSPECS
Depth)
of
TraversalSpecs))
DestinationFileBox RootCards QuietFlg
InterestedWindow])
(NC.DeleteStructure
[LAMBDA (RootCards TraversalSpecs InterestedWindow QuietFlg Don'tPutToBeDeletedCardsFlg)
(* Randy.Gobbel " 2-Apr-87 15:38")
(* * rht 8/29/86: Reorganized and changed to call NCP.CollectCards which is more efficient than the old
NCP.ComputeTransitiveClosure. Also now takes QuietFlg and Don'tPutToBeDeletedCardsFlg args.
Threw away Don'tClearFlg.)
(* * 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 4/2/87 turned NC.ProtectedSessionOperation into NC.CardSelectionOperation)
(NCP.WithLockedCards (SETQ RootCards (MKLIST RootCards))
(NC.IfAllCardsFree (NC.LockListOfCards RootCards "Delete Structure")
(OR RootCards (SETQ RootCards
(NC.SelectNoteCards NIL NIL
NC.SelectingCardsMenu NIL
"Shift-select the root cards of the structure"))
(ERROR!))
[OR TraversalSpecs (SETQ TraversalSpecs
(NC.AskTraversalSpecs (fetch (Card NoteFile)
of (CAR RootCards))
(QUOTE (SubBox
FiledCard]
(if (AND RootCards TraversalSpecs)
then (OR QuietFlg (NC.PrintMsg InterestedWindow
T
"Collecting cards to delete ..."))
(NC.DeleteNoteCards
(NCP.CollectCards RootCards
(fetch (TRAVERSALSPECS
LinkTypes)
of TraversalSpecs)
(fetch (TRAVERSALSPECS
Depth)
of TraversalSpecs))
T NIL InterestedWindow QuietFlg NIL
Don'tPutToBeDeletedCardsFlg)
(OR QuietFlg (NC.ClearMsg InterestedWindow
T))
RootCards])
(NC.CloseNoteCards
[LAMBDA (CardIdOrCardList NoCheckFlg DontClearFlg InterestedWindow)
(* Randy.Gobbel " 2-Apr-87 15:38")
(* * Close note acrds on the screen)
(* * fgh 11/14/85 Updated to handle Card object.)
(* * kirk 21Feb86 Added InterestedWindow)
(* * fgh 6/27/86 Fixed call to NC.SelectNoteCards to use just InterestedWindow)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 3/9/87: Changed NC.DeleteSelectingMenu to NC.SelectingCardsMenu.)
(* * rg 3/9/87 added NC.ProtectedSessionOperation wrapper)
(* * rg 4/1/87 changes NC.ProtectedSessionOperation to NCP.WithLockedCards ; also added NC.IfAllCardsFree wrapper)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(NCP.WithLockedCards (NC.IfAllCardsFree (NC.LockListOfCards (MKLIST CardIdOrCardList)
"Close Note Cards")
(LET (Cards Window)
[SETQ Cards
(COND
((LISTP CardIdOrCardList))
(CardIdOrCardList (NC.CoerceToCard
CardIdOrCardList))
(T (NC.SelectNoteCards NIL NIL
NC.SelectingCardsMenu
InterestedWindow
"Please shift-select the cards to be closed."]
(ALLOW.BUTTON.EVENTS)
(for Card in (MKLIST Cards)
do (COND
((AND (NC.ActiveCardP Card)
(SETQ Window (NC.FetchWindow
Card)))
(COND
((NEQ (NC.QuitCard Card T)
(QUOTE DON'T))
(while (OPENWP Window)
do (BLOCK])
(NC.EditProperties
[LAMBDA (TextStream) (* Randy.Gobbel " 1-Apr-87 12:25")
(* Open a property list editor for the card
corresponding to TextStream.
Called from Title bar menus.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * rht 4/11/86: No longer sticks dates and Updates in property list. Only user-defined stuff.)
(* * kef 7/22/86: Added call to card's obtain write permission function for the PROPLIST.)
(* * fgh 8/30/86 Converted APPLY* to NC.ApplyFn.)
(* * rht 1/16/87: Now uses NC.SystemCardPropNames globalvar.)
(* * rg 4/1/87 added NC.ProtectedCardOperation wrapper)
(DECLARE (GLOBALVARS NC.SystemCardPropNames))
(LET ((Card (NC.CoerceToCard (WINDOW.FROM.TEDIT.THING TextStream)))
PropList PropEditorWindow)
(NC.ProtectedCardOperation Card "Edit Properties" NIL (SETQ PropList (NC.FetchPropList
Card))
(COND
((NC.ApplyFn ObtainWritePermissionFn Card (QUOTE PROPLIST))
(WINDOWPROP (SETQ PropEditorWindow
(NC.OpenPropListEditor
TextStream
(for SubList on PropList
by (CDDR SubList)
when (NOT (FMEMB (CAR SubList)
NC.SystemCardPropNames))
join (LIST (CAR SubList)
(CADR SubList)))
"Edit Property List"))
(QUOTE ReleaseWritePermissionP)
T)
PropEditorWindow)
(T (NC.CardPartBusy Card (QUOTE PROPLIST])
(NC.ShowLinks
[LAMBDA (TextStream) (* Randy.Gobbel " 1-Apr-87 13:33")
(* Open an inspector for the links for note card
specified by TextStream above the window for the note
card.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * fgh 5/2/86 Included calls to NC.InsureLinkDisplayMode to handle litatom link display modes.
Added InsdiePropListEditor and Reverse indicators to UserData field of Links in show links editor.
Also added ShowLinks property onto the editor window so other functions can detect that a window is a show links
window.)
(* * rht 8/11/86: Now passes non-nil ShowLinksFlg to NC.OpenPropListEditor.)
(LET [Links EditWindow (Card (NC.CoerceToCard (WINDOW.FROM.TEDIT.THING TextStream]
[NC.ProtectedCardOperation
Card "Show Links" NIL
(SETQ Links (NCONC [for Link in (NC.FetchToLinks Card)
join (LIST (COND
((EQ (fetch (Link AnchorMode) of Link)
(QUOTE GlobalGlobal))
"Global TO")
(T "TO"))
(LIST (create Link
using
Link DisplayMode ←
(create LINKDISPLAYMODE
copying
(NC.InsureLinkDisplayMode
(fetch (Link DisplayMode)
of Link))
SHOWTITLEFLG ← T SHOWLINKTYPEFLG
← T)
UserData ← (QUOTE (
InsidePropListEditor T]
(for Link in (NC.FetchFromLinks Card)
join (LIST "FROM"
(LIST (create Link
using
Link DisplayMode ←
(create LINKDISPLAYMODE
copying
(NC.InsureLinkDisplayMode
(fetch (Link DisplayMode)
of Link))
SHOWTITLEFLG ← T SHOWLINKTYPEFLG
← T)
SourceCard ← (fetch (Link
DestinationCard)
of Link)
DestinationCard ←
(fetch (Link SourceCard)
of Link)
UserData ←
(QUOTE (InsidePropListEditor T
Reversed T]
(WINDOWPROP (SETQ EditWindow (NC.OpenPropListEditor TextStream Links "List of Links" T
T T))
(QUOTE ShowLinks)
T)
EditWindow])
(NC.ShowInfo
[LAMBDA (Window) (* Randy.Gobbel " 1-Apr-87 13:37")
(* * Bring up an inspector on certain attribute/value pairs of this card. The default ones are card part dates and
Updates.)
(* * Need a hook so that users can provide other attribute/value pairs for given card types.)
(* * kirk: 1May86 added NC.AttachNoteFileName)
(* * fgh 6/13/86 Now places and sizes window with less visual nnoise.)
(* * fgh&rht 7/4/86: Now also print card type.)
(* * rht 7/14/86: Now includes card object if global param is set. No longer includes UID.)
(* * rg 4/1/87 added NC.ProtectedCardOperation wrapper)
(LET ((Card (NC.CoerceToCard Window))
[Attributes (BQUOTE (Type ItemDate TitleDate LinksDate PropsDate Updates ,@
(AND NC.IncludeCardObjectInShowInfo (QUOTE (CardObject]
Region AttributesAndValues InfoWindow)
(NC.ProtectedCardOperation Card "Show Info" NIL (NC.AttachNoteFileName Window)
(SETQ Region (WINDOWREGION Window))
(for Win in (ATTACHEDWINDOWS Window)
when (WINDOWPROP Win (QUOTE ShowInfo))
do (CLOSEW Win))
(* close any previous info window)
[SETQ AttributesAndValues
(BQUOTE (Type , (NC.FetchType Card)
ItemDate , (NC.FetchItemDate Card)
TitleDate , (NC.FetchTitleDate Card)
LinksDate , (NC.FetchLinksDate Card)
PropsDate , (NC.FetchPropListDate Card)
Updates , (LISTGET (NC.FetchPropList Card)
(QUOTE Updates))
,@
(AND NC.IncludeCardObjectInShowInfo
(BQUOTE (CardObject , Card]
(SETQ InfoWindow (INSPECTW.CREATE
AttributesAndValues Attributes (FUNCTION LISTGET)
NIL "Can't set values of these attributes." NIL NIL
"Card attributes"
NIL
(CREATEW (CREATEREGION (fetch (POSITION XCOORD)
of NC.OffScreenPosition)
(fetch (POSITION YCOORD)
of NC.OffScreenPosition)
(fetch (REGION WIDTH)
of Region)
50)
NIL NIL)))
(SHAPEW InfoWindow (create REGION
using
(WINDOWPROP InfoWindow (QUOTE REGION)
)
HEIGHT ←
(HEIGHTIFWINDOW
(fetch (REGION HEIGHT)
of (WINDOWPROP InfoWindow
(QUOTE EXTENT))
)
T)))
(ATTACHWINDOW InfoWindow Window (QUOTE TOP)
(QUOTE JUSTIFY)
(QUOTE LOCALCLOSE))
(NC.MoveWindowOntoScreen Window)
(REDISPLAYW InfoWindow)
(WINDOWPROP InfoWindow (QUOTE ShowInfo)
(QUOTE Showing))
(WINDOWADDPROP InfoWindow (QUOTE CLOSEFN)
(FUNCTION FREEATTACHEDWINDOW)
T])
(NC.SelectionMenusWhenSelectedFn
[LAMBDA (Item Menu Button) (* Randy.Gobbel " 1-Apr-87 17:40")
(* * rht 2/15/85: Added handler for Undo.)
(* * fgh 12/20/85 Updated for use with 1.3 selection mechanism.)
(* * rht & pmi 12/12/86: Now finds promptwindow using the MAINWINDOW windowprop rather than the MAINWINDOW
function.)
(* * rht 3/23/87: Now looks for PromptWindow on SelectionPromptWindow instead of looking for main window.)
(* * rg 4/1/87 changed CANCELLED to DON'T)
(LET [(PromptWindow (WINDOWPROP (WFROMMENU Menu)
(QUOTE SelectionPromptWindow]
(SELECTQ (CAR Item)
[(Done)
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
(CONS (QUOTE DONE)
(WINDOWPROP PromptWindow (QUOTE SelectedCards]
((Abort Cancel)
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
(QUOTE DON'T)))
[New% Card (WINDOWPROP PromptWindow (QUOTE SelectedCards)
(CONS (QUOTE *New% Card*)
(WINDOWPROP PromptWindow (QUOTE
SelectedCards]
[NoSource (WINDOWPROP PromptWindow (QUOTE SelectedCards)
(LIST (QUOTE NC00000]
[Undo (WINDOWPROP PromptWindow (QUOTE SelectedCards)
(CONS (QUOTE *Undo% Selection*)
(WINDOWPROP PromptWindow (QUOTE SelectedCards]
NIL)
(NOTIFY.EVENT (WINDOWPROP PromptWindow (QUOTE CopyInsertEvent])
)
(* * changes to NCLINKS)
(DEFINEQ
(NC.MakeFilingLinks
[LAMBDA (Card Msg InterestedWindow) (* Randy.Gobbel " 2-Apr-87 15:38")
(* Hooks card specified by Card to all of the current
contents cards by a Contents link)
(* * rht 8/1/84: Changed the NC.PrintMsg2 call for "No FileBox has been specified." to use NIL as second arg rather
than T. This prevents erasure of previous error messages.)
(* * rht 12/8/84: Massive rewrite. Now calls NC.MakeChildLink. And always orphanizes if no parent specified.
This is because it's currently called only by NC.InsureProperFiling.)
(* * rht 6/25/85: Now returns NewParents and checks if CANCELLED comes back from NC.SelectNoteCards so can abort
the calling operation.)
(* * Fgh 11/15/85 Adapted from and intended to replace NC.MakeContentsHooks)
(* * fgh 8/6/86 Updated to use NC.AttachPromptWindow and added Msg arg)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 2/19/87 Make sure NewParents always has the real value)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(* * rht 3/23/87: Changed so that message will fit on one less line.)
(* * rht 3/23/87: Now takes InterestedWindow arg.)
(* * Rht 3/24/87: Now calls NC.CoerceToInterestedWindow)
(* * rht 3/26/87: No longer allows selection of boxes in foreign notefiles.)
(* * rg 4/1/87 changed CANCELLED to DON'T)
(DECLARE (GLOBALVARS NC.SelectingContentsMenu))
(NCP.WithLockedCards (PROG ((NoteFile (fetch (Card NoteFile) of Card))
OneHook NewParents)
(OR InterestedWindow (SETQ InterestedWindow (
NC.CoerceToInterestedWindow Card)))
(SETQ NewParents (NC.SelectNoteCards
NIL
[FUNCTION (LAMBDA (SelectedCard)
(AND (NC.FileBoxP SelectedCard)
(NC.SameNoteFileP NoteFile (fetch (Card NoteFile)
of SelectedCard]
NC.SelectingContentsMenu Card (CONCAT (OR Msg "")
"('Done' with no selections files in ToBeFiled.)")
T))
[COND
([NOT (OR (EQ NewParents (QUOTE DON'T))
(AND NewParents
(for ParentCard in NewParents
bind OneHook
when (NC.MakeChildLink Card ParentCard
InterestedWindow)
do (SETQ OneHook T)
finally (RETURN OneHook]
(NC.PrintMsg InterestedWindow NIL
"No FileBox has been specified."
(CHARACTER 13)
"This card will be filed in the ToBeFiled Box."
(CHARACTER 13))
(SETQ NewParents (NC.HookToOrphanCard Card
(fetch (NoteFile
ToBeFiledCard)
of NoteFile)))
(COND
((NC.AttachPromptWindow InterestedWindow NIL NIL NIL T)
(SPAWN.MOUSE)
(DISMISS 2000)
(NC.ClearMsg InterestedWindow T]
(RETURN NewParents])
(NC.MakeLink
[LAMBDA (Window LinkLabel DestinationCard SourceCard DisplayMode AnchorMode Message NoDisplayFlg
LinkToInsertAfter CrossFileLinksMode) (* Randy.Gobbel " 2-Apr-87 15:38")
(* * Make a link from (OR Window SourceCard) to DestinationCard with linklabel of LinkLabel)
(* * rht 1/12/85: If need to create a new card, then now shows card type menu near window of SourceID.)
(* * rht 1/13/85: Added extra args Message and NoDisplayFlg.)
(* * rht 3/26/85: Added LinkToInsertAfter arg which should be NIL or a link to insert the new To link after.
If NIL, then insert at front of ToLinks.)
(* * kirk 9/23/85: took out GETPROMPTWINDOW call for asknotecardtype)
(* * kirk: 14Nov85: changed NC.CoerceToID to to NC.CoerceToCard)
(* * fgh 11/16/85 Changed from PROG to LET and used COND to contyrol returnmed value.)
(* * fgh 2/5/86 Changed call DefaultLinkDisplayMode to FetchLinkDisplayMode)
(* * fgh 6/5/86 Now calls AskLinkLabel if LinkLabel arg is NIL)
(* * rht 7/4/86: Added check for readonly card.)
(* * kef 7/17/86: Added calls to grab the write permission on the appropriate card parts.)
(* * kef 7/22/86: Saves the links on the Destination Card now right away, while still holding onto the FROMLINKS
write lock.)
(* * fgh 8/30/86 Adpated to use NC.IfCardPartNotBusy.)
(* * rht 9/29/86: Tossed Ken's call to NC.PutFromLinks; It was the cause of too many nasty breaks.
Also made syntactic fixes.)
(* * rht 10/4/86: Now handles cross file links. New arg CrossFileLinksMode determines whether cross-file link will
be two-way, i.e. will destination card know it's being linked to.)
(* * rht 11/10/86: Now creates new crossfile link if Destination card is a CrossFileLink card that we didn't just
create.)
(* * rht 11/14/86: Now checks if non-nil DestinationCard before trying to do cross-filelink stuff.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * rht 12/9/86: Throws out JustCreatedFlg marker stuff.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 12/16/86: Fixed bug whereby electing not to open notefile containing crossfilelink dest card caused
break.)
(* * rht 12/16/86: Now passes Window down to NC.GetCrossFileLinkDestCard.)
(* * rg 3/18/87 added NCP.WithLockedCards wrapper)
(DECLARE (GLOBALVARS NC.SelectingSingleCardMenu NC.NewCrossFileLinksTwoWayFlg))
(OR SourceCard (SETQ SourceCard (NC.CoerceToCard Window)))
(AND (NC.CheckForNotReadOnly SourceCard Window "Can't make links in ")
(NCP.WithLockedCards
(LET (Link Type)
(OR Window (SETQ Window (NC.FetchWindow SourceCard)))
(OR Message (SETQ Message
"Please shift-select the Card or Box to be linked to."))
(OR LinkLabel (SETQ LinkLabel (NC.AskLinkLabel Window NIL NIL T NIL)))
(OR DestinationCard (SETQ DestinationCard
(NC.SelectNoteCards T [FUNCTION (LAMBDA (Card)
(COND
((NOT (NC.SameCardP Card SourceCard))
T)
(T (NC.PrintMsg Window T
"A Card/Box cannot link to itself. "
(CHARACTER 13)
"Selection ignored."
(CHARACTER 13))
NIL]
NC.SelectingSingleCardMenu SourceCard Message)))
[if (EQ DestinationCard (QUOTE *New% Card*))
then (SETQ DestinationCard (AND (SETQ Type (NC.AskNoteCardType
(WINDOWREGION Window)))
(NC.CoerceToCard
(NC.MakeNoteCard Type
(fetch
(Card NoteFile)
of SourceCard)
NIL NoDisplayFlg]
(* * If we're trying to link to a CrossFileLink card, then check whether card was just created.
If so, then it's the first link, otherwise we make a new CrossFileLink.)
(AND DestinationCard (NC.CrossFileLinkCardP DestinationCard)
(SETQ DestinationCard (NC.GetCrossFileLinkDestCard DestinationCard
Window))
(NC.SetUserDataProp DestinationCard (QUOTE JustCreatedFlg)
NIL))
(if DestinationCard
then (NC.IfCardPartNotBusy
DestinationCard
(QUOTE FROMLINKS)
(NC.IfCardPartNotBusy
SourceCard
(QUOTE TOLINKS)
(* * If have cross-file link, then make two new crossfilelink cards, one per notefile. Make global link over there
from crossfilelink card to DestinationCard and local link here from SourceCard to crossfilelink card.)
[if (NOT (NC.SameNoteFileP (fetch (Card NoteFile)
of SourceCard)
(fetch (Card NoteFile)
of DestinationCard)))
then (LET [(CrossFileLinksTwoWayFlg
(OR (EQ CrossFileLinksMode (QUOTE TWOWAY))
(AND (NULL CrossFileLinksMode)
NC.NewCrossFileLinksTwoWayFlg]
(if CrossFileLinksTwoWayFlg
then (NC.MakeGlobalLink Window LinkLabel
DestinationCard
(
NC.CreateCrossFileLinkCard
DestinationCard
SourceCard T)
DisplayMode))
(SETQ DestinationCard (NC.CreateCrossFileLinkCard
SourceCard DestinationCard
CrossFileLinksTwoWayFlg]
[SETQ Link (create Link
UID ← (NC.MakeUID)
SourceCard ← SourceCard
DestinationCard ← DestinationCard
AnchorMode ← AnchorMode
Label ← LinkLabel
DisplayMode ← (OR DisplayMode (
NC.FetchLinkDisplayMode
SourceCard]
(NC.AddToLink Link LinkToInsertAfter)
(NC.AddFromLink Link)
Link))
else NIL])
(NC.AddGlobalLinkToCard
[LAMBDA (WindowOrTextStream) (* rht: "15-Feb-85 18:54")
(* * Called from card's menu to add one global link.)
(NC.AddGlobalLinksToCard WindowOrTextStream T])
(NC.AddLinksToCard
[LAMBDA (CardIdentifier LinkLabel DestinationCards) (* Randy.Gobbel " 2-Apr-87 15:38")
(* * Adds multiple links to card designated by CardIdentifier. Rest of args can be NIL.)
(* * fgh 6/9/86 Added Checks to make sure other interaction operation not in porgress.)
(* * rht 9/23/86: Fixed bug in function passed to NC.SelectNoteCards.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(* * RG 4/2/87 changed NC.CardSelectionOperation to NCP.WithLockedCards)
(LET ((SourceCard (NC.CoerceToCard CardIdentifier))
CardType Window OperationInProgress)
(NC.ProtectedCardOperation SourceCard "Insert Links" NIL
(NCP.WithLockedCards
(SETQ Window (NC.FetchWindow SourceCard))
(SETQ CardType (NC.FetchType SourceCard))
(OR LinkLabel (SETQ LinkLabel
(NC.AskLinkLabel Window NIL NIL T T)))
(if LinkLabel
then (OR DestinationCards
(SETQ DestinationCards
(NC.SelectNoteCards
NIL
[FUNCTION (LAMBDA (SelectedCard)
(COND
((NOT (NC.SameCardP SelectedCard
SourceCard))
T)
(T (NC.PrintMsg (NC.FetchWindow
SourceCard)
T
"A Card/Box cannot point to itself. "
(CHARACTER
13)
"Selection ignored."
(CHARACTER
13))
NIL]
NC.SelectingMultipleCardsMenu SourceCard
"Please shift-select the Cards or Boxes to be pointed to.")))
(NC.ClearMsg Window T)
(for DestinationCard in DestinationCards
do (NC.AddLinkToCard CardIdentifier LinkLabel
DestinationCard])
)
(* * new for NCPROGINT)
(DECLARE: EVAL@COMPILE
[DEFMACRO NCP.WithLockedCards (&BODY Body)
(BQUOTE (LET (CardListResetVar)
(NAMED-RESETLST CardListResetVar ,@ Body]
)
(* * changes to NCPROGINT)
(DEFINEQ
(NCP.CloseCards
[LAMBDA (Cards QuietFlg) (* Randy.Gobbel " 2-Apr-87 16:59")
(* * Uncache and undisplay any active cards in Cards)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * rht 3/9/87: Fixed so that wouldn't try to get PROCESS windowprop from NIL Win.)
(* * rg 3/9/87 fixed args to NC.QuitCard ; added NC.ProtectedSessionOperation wrapper)
(* * rg 4/2/87 changed NC.ProtectedSessionOperation to NCP.WithLockedCards ; added NC.IfAllCardsFree wrapper)
(NCP.WithLockedCards (NC.IfAllCardsFree (NC.LockListOfCards (MKLIST Cards)
"Close Cards")
(for Card in (MKLIST Cards) bind Win
(OldProc
←
(TTY.PROCESS)
)
do (if (NOT (NC.ValidCardP Card))
then (NCP.ReportError "NCP.CloseCards"
(CONCAT Card
" not an existing card or filebox."))
elseif (AND (NCP.CardCachedP Card)
(NEQ (NC.QuitCard Card T
NIL NIL
NIL NIL
QuietFlg)
(QUOTE CANCELLED))
(SETQ Win (NC.FetchWindow
Card)))
then
(bind [Process ←
(AND Win
(WINDOWPROP
Win
(QUOTE PROCESS]
until (OR (NULL Process)
(PROCESS.FINISHEDP
Process))
do (BLOCK)))
finally (AND (PROCESSP OldProc)
(TTY.PROCESS OldProc))
(RETURN Card])
(NCP.SelectCards
[LAMBDA (InstigatingCardOrWindow SingleCardFlg SelectionPredicate Msg CheckForCancelFlg)
(* Randy.Gobbel " 2-Apr-87 15:38")
(* * Return a list of cards selected. A menu pops up near the prompt window with "DONE" and "CANCEL" buttons.
User selects by clicking in card's title bar.)
(* * rht 11/18/85: Updated to handle new notefile and card object formats. Now takes optional extra args and passes
to NC.SelectNoteCards.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 3/2/87: Fix to bug %#342: Now makes sure instigating card is displayed, else passes NIL to
NC.SelectNoteCards.)
(* * rg 4/2/87 added NCP.WithLockedCards wrapper)
(NCP.WithLockedCards (NC.SelectNoteCards SingleCardFlg SelectionPredicate
(if SingleCardFlg
then NC.SelectingCardMenu
else NC.SelectingCardsMenu)
(COND
((OPENWP InstigatingCardOrWindow)
InstigatingCardOrWindow)
((AND (NCP.ValidCardP InstigatingCardOrWindow)
(NCP.CardDisplayedP
InstigatingCardOrWindow))
InstigatingCardOrWindow)
(T NIL))
Msg CheckForCancelFlg])
)
(* * changes to NCBROWSERCARD)
(DEFINEQ
(NC.MakeBrowserCard
[LAMBDA (Card Title NoDisplayFlg ParamList) (* Randy.Gobbel " 2-Apr-87 15:38")
(* Make a browser card with id Card using root at RootID and the link following predictae specified by Predicate.
IF Root and/or ListOfLinkLabels not specified, ask the user.)
(* * rht 8/3/84: Changed to call NC.AskLinkLabel with its ReverseLinkLabel parameter set to T.)
(* * fgh 10/2/84 Changed Link Icons to be image objects in NodeLabel of Graph Npodes rather than annotations on
graph nodes.)
(* * rht 10/19/84: Fixed setting up of browser card's prop list in case NoDisplayFlg is T so we have no Window.
Now NC.MakeLinksLegend returns the label pairs.)
(* * rht 11/27/84: Removed the WINDOWADDPROP call to put NC.GraphCardCloseFn on the CLOSEFN of the window.
This causes trouble. NC.QuitCard will get put on by NC.MakeNoteCard and that's enough.)
(* * rht 1/3/85: Now puts a dummy region of the right size if the NoDisplayFlg is on.)
(* * rht 1/15/85: Put hooks for AddNode, AddLink, etc. so editing graph edits underlying structure.)
(* * rht 2/14/85: Added VerticalFlg and made BrowserSpecs get put on browser's proplist in all cases.)
(* * rht 4/1/85: Now calls NC.AskBrowserSpecs with additional Don'tAskFlg in case of call from Programmer's
interface.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 2/7/86: Now gets browser format, etc. via fetch/set fns.)
(* * rht 5/6/86: Took out call to NC.SetupTitleBarMenu.)
(* * rht 5/8/86: Added calls to rig title bar properly.)
(* * rht 7/10/86: Now passes ListOfLinkLabels to NC.AskBrowserSpecs.)
(* * rht 9/19/86: Mod to above fix. Now calls NC.MakeNewCardWindow a new fn that creates window and hangs Card off
windowprop.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection. Also added GLOBALVARS
statement.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 12/16/86: Now checks that NC.MakeLink succeeded before creating a real link icon. If not, then make a
standin for a cross file link icon.)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(* * rht 3/20/87: Removed needless call to NC.ActivateCard.)
(* * rg 4/2/87 changed wrapper to NCP.WithLockedCards and added NC.IfAllCardsFree wrapper)
(DECLARE (GLOBALVARS NC.SubBoxLinkLabel NC.BrowserContentsLinkLabel NC.SpecialBrowserSpecsFlg
NC.*Graph*BrowserFormat NC.SelectingBrowserSourceMenu))
(NCP.WithLockedCards (PROG ([RootCards (MKLIST (LISTGET ParamList (QUOTE ROOTCARDS]
(ListOfLinkLabels (LISTGET ParamList (QUOTE LINKTYPES)))
(BrowserFormat (LISTGET ParamList (QUOTE FORMAT)))
(Depth (LISTGET ParamList (QUOTE DEPTH)))
(CardType (NC.RetrieveType Card))
Lattice RootNodes Window Graph SpecialBrowserSpecs BrowserSpecs
DropVirtualNodesFlg)
(NC.IfAllCardsFree
(NC.LockListOfCards RootCards "Make Browser Card")
[COND
((NULL NoDisplayFlg)
(SETQ Window (NC.MakeNewCardWindow Card (OR Title
"Untitled")))
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.GraphCardShrinkFn]
[if (NULL RootCards)
then (SETQ RootCards
(if NoDisplayFlg
then (LIST NIL)
else (NC.SelectNoteCards NIL NIL
NC.SelectingBrowserSourceMenu
Window
"Please shift-select the Cards and/or Boxes the browser should start from."
T]
(COND
((EQ RootCards (QUOTE DON'T))
(NC.DeactivateCard Card)
(CLOSEW Window)
(RETURN)))
(NC.HoldTTYProcess)
[SETQ BrowserSpecs (NC.AskBrowserSpecs Window Card
ListOfLinkLabels Depth
BrowserFormat T
(if (OR ParamList
NoDisplayFlg)
then
(QUOTE DONTASK]
(COND
((NULL BrowserSpecs)
(NC.DeactivateCard Card)
(CLOSEW Window)
(RETURN)))
(SETQ ListOfLinkLabels (CAR BrowserSpecs))
(SETQ Depth (CADR BrowserSpecs))
(SETQ BrowserFormat (CADDR BrowserSpecs))
(* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
[SETQ SpecialBrowserSpecs (COND
(NC.SpecialBrowserSpecsFlg (NC.AskSpecialBrowserSpecs Window)
)
(T (create SPECIALBROWSERSPECS]
(OR NoDisplayFlg (NC.PrintMsg Window T (CHARACTER 13)
"Computing browser graph. Please wait. ..."))
(* Create new browser hash array)
(NC.GetBrowserHashArray Card)
(* Compute lattice breakdth-first starting from
roots.)
(SETQ Lattice (NC.GrowLinkLattice RootCards NIL
ListOfLinkLabels Card Depth))
(SETQ RootNodes (for RootCard in RootCards
collect (NC.GetBrowserNodeID Card
RootCard)))
(OR NoDisplayFlg (WINDOWPROP Window (QUOTE NoteCardObject)
Card))
(* * Link destination id information stored in NodeLabel field into a LinkIcon for display)
(for Node in Lattice bind NodeID eachtime (BLOCK)
do [replace (GRAPHNODE NODELABEL) of Node
with (LET ((NewLink (NC.MakeLink
Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
Card NIL)))
(if NewLink
then (NC.MakeLinkIcon NewLink)
else (NC.MakeCrossFileLinkIconStandIn
(NCP.CardTitle
(fetch (GRAPHNODE NODELABEL)
of Node]
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(NC.GraphNodeIDRemProp (NC.CoerceToGraphNodeID NodeID)
(QUOTE TouchedFlg))
(NC.GraphNodeIDRemProp (NC.CoerceToGraphNodeID NodeID)
(QUOTE VisitedFlg)))
(SETQ Graph (if (AND Lattice RootNodes)
then (LAYOUTGRAPH Lattice RootNodes
(SUBST (QUOTE LATTICE)
NC.*Graph*BrowserFormat
BrowserFormat)
(fetch (
SPECIALBROWSERSPECS Font) of SpecialBrowserSpecs)
(fetch (
SPECIALBROWSERSPECS MotherD) of SpecialBrowserSpecs)
(fetch (
SPECIALBROWSERSPECS PersonalD) of SpecialBrowserSpecs)
(fetch (
SPECIALBROWSERSPECS FamilyD) of SpecialBrowserSpecs))
else (create GRAPH)))
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph
Window
DropVirtualNodesFlg))
(OR NoDisplayFlg (NC.PrintMsg Window NIL "Done!"))
(NC.SetSubstance Card Graph)
(NC.SetBrowserLinkLabels Card (OR ListOfLinkLabels
(LIST NC.SubBoxLinkLabel)))
(NC.SetBrowserRoots Card RootCards)
(NC.SetBrowserFormat Card BrowserFormat)
(NC.SetBrowserDepth Card Depth)
(NC.SetSpecialBrowserSpecs Card SpecialBrowserSpecs)
(COND
(NoDisplayFlg (RETURN Card)))
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.InstallTitleBarLeftMenu Window CardType)
(NC.InstallTitleBarMiddleMenu Window CardType)
(NC.RelayoutBrowserCard Window)
(RETURN Window])
(NC.UpdateBrowserCard
[LAMBDA (Window) (* Randy.Gobbel " 2-Apr-87 15:38")
(* * rht 10/14/84: Added call to DETACHALLWINDOWS to close any existing links legend window and prompt window.
Also added call to NC.MakeLinksLegend to make a new attached legend menu.)
(* * rht 1/15/85: Put hooks for AddNode, AddLink, etc. so editing graph edits underlying structure.)
(* * rht 2/14/85: Added ability to respecify roots and link labels before recomputing graph.)
(* * rht 3/8/85: Modified to use new browser props stored on card's proplist as of release 1.2.)
(* * rht 3/17/85: Now takes OnlyLayoutFlg argument. If set, then don't recompute lattice or ask about root nodes.)
(* * rht 11/17/85: updated to handle new card and notefile objects.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * rht 2/7/86: Now gets and sets browser format, etc. via fetch/set fns.)
(* * rht 3/7/86: Now only closes the Links legend menu attached window.)
(* * rht 6/10/86: Moved code to delete links legend menu and code to make new browser hash array to after
questioning user about respecifying roots.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 12/16/86: Now checks that NC.MakeLink succeeded before creating a real link icon. If not, then make a
standin for a cross file link icon.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(* * rht 3/19/87: Fixed the part that calls NC.MakeLink so it really only rebuilds links if they've changed.)
(* * rg 4/1/87 changed CANCELLED to DON'T)
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Recompute Browser Card" NIL
(NCP.WithLockedCards
(PROG (LinkLabels RootCards RootNodes Lattice LinkIcon Graph GraphNodes NodeLabel
BrowserSpecs BrowserFormat DropVirtualNodesFlg Depth
SpecialBrowserSpecs OldLabelNodes OldRootCards)
(SETQ RootCards (NC.FetchBrowserRoots Card))
(NC.IfAllCardsFree
(NC.LockListOfCards RootCards "Update Browser Card")
(SETQ LinkLabels (NC.FetchBrowserLinkLabels Card))
[SETQ BrowserFormat (OR (NC.FetchBrowserFormat Card)
(QUOTE (LATTICE]
(* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
(SETQ Depth (OR (NC.FetchBrowserDepth Card)
999999))
(SETQ SpecialBrowserSpecs (OR (NC.FetchSpecialBrowserSpecs Card)
(create SPECIALBROWSERSPECS)))
[SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph
(WINDOWPROP
Window
(QUOTE GRAPH]
(* Get new roots.)
[if (OR (NULL RootCards)
(NC.AskYesOrNo "Want to respecify roots? " "--" "No" T Window T
NIL))
then (NC.BrowserFlipRoots Window Card GraphNodes (SETQ OldRootCards
RootCards))
(SETQ RootCards (NC.SelectNoteCards NIL NIL
NC.SelectingBrowserSourceMenu
Window (CONCAT
"Please shift-select the Cards and/or Boxes the browser should start from."
(CHARACTER 13)
"(Current roots are highlighted.)")
T))
(NC.BrowserFlipRoots Window Card GraphNodes OldRootCards)
(COND
((EQ RootCards (QUOTE DON'T))
(RETURN] (* Get rid of the links legend menu attached window.)
(for Win in (ATTACHEDWINDOWS Window) when (WINDOWPROP Win
(QUOTE
LINKSLEGENDWINP))
do (DETACHWINDOW Win)
(CLOSEW Win)) (* Smash the current hash array, putting a fresh one
in its place.)
(NC.GetBrowserHashArray Card)
(NC.PrintMsg Window T (CHARACTER 13)
"Computing browser graph. Please wait. ...")
(* Compute lattice breadth-first from the roots.)
(SETQ Lattice (NC.GrowLinkLattice RootCards NIL LinkLabels Card Depth))
(SETQ RootNodes (for RootCard in RootCards collect (
NC.GetBrowserNodeID
Card RootCard)))
(NC.SetPropListDirtyFlg Card T) (* Remove all links that are in the old browser graph
but not in the new one)
[for Node in GraphNodes eachtime (BLOCK)
unless [for LatticeNode in Lattice bind (CardForNode
←
(
NC.CardFromBrowserNodeID
(
NC.CoerceToGraphNodeID
Node)))
thereis (NC.SameCardP CardForNode (
NC.CardFromBrowserNodeID
(NC.CoerceToGraphNodeID
LatticeNode]
do (LET ((NodeLabel (fetch (GRAPHNODE NODELABEL) of Node)))
(COND
((NC.LinkIconImageObjP NodeLabel)
(NC.DeleteLink (NC.FetchLinkFromLinkIcon NodeLabel)
T T))
((STRINGP NodeLabel)
(* Collect the label nodes from the old browser.)
(SETQ OldLabelNodes (CONS Node OldLabelNodes]
(* Create Links for all nodes in the new browser graph
but not in the old one.)
[for Node in Lattice eachtime (BLOCK)
do (LET [(NodeID (fetch (GRAPHNODE NODEID) of Node))
(OldNode (for GraphNode in GraphNodes
bind (CardForNode ← (NC.CardFromBrowserNodeID
(NC.CoerceToGraphNodeID
Node)))
when (NC.SameCardP CardForNode
(NC.CardFromBrowserNodeID
(NC.CoerceToGraphNodeID
GraphNode)))
do (RETURN GraphNode]
[if OldNode
then (replace (GRAPHNODE NODELABEL) of Node
with (fetch (GRAPHNODE NODELABEL) of OldNode))
else (replace (GRAPHNODE NODELABEL) of Node
with
(LET ((NewLink (NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE
NODELABEL)
of Node)
Card NIL)))
(if NewLink
then (NC.MakeLinkIcon NewLink)
else (NC.MakeCrossFileLinkIconStandIn
(NCP.CardTitle
(fetch (GRAPHNODE NODELABEL)
of Node]
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(NC.GraphNodeIDRemProp NodeID (QUOTE TouchedFlg))
(NC.GraphNodeIDRemProp NodeID (QUOTE VisitedFlg]
(* Throw in the label nodes from the old browser.)
(SETQ Lattice (NCONC Lattice OldLabelNodes))
(* For each old label node, take away nonexistent
fromnodes and save the label nodes that no longer have
any from nodes.)
(for OldLabelNode in OldLabelNodes eachtime (BLOCK)
do (replace (GRAPHNODE FROMNODES) of OldLabelNode
with (for FromNodeID in (fetch (GRAPHNODE FROMNODES)
of OldLabelNode)
bind FromNode eachtime (BLOCK)
when (SETQ FromNode (FASSOC FromNodeID Lattice))
collect (* If the From node isn't a label node, then add to
its Tonode list.)
[if (NC.LinkIconImageObjP
(fetch (GRAPHNODE NODELABEL)
of FromNode))
then (replace (GRAPHNODE TONODES)
of FromNode
with
(CONS (fetch (GRAPHNODE
NODEID)
of OldLabelNode)
(fetch (GRAPHNODE
TONODES)
of FromNode]
FromNodeID))
(* For the old label node's ToNodes, just need to
remove any for ToNodes that no longer exist.)
(replace (GRAPHNODE TONODES) of OldLabelNode
with (for ToNodeID in (fetch (GRAPHNODE TONODES)
of OldLabelNode)
bind ToNode eachtime (BLOCK)
when (SETQ ToNode (FASSOC ToNodeID Lattice))
collect (* If the To node isn't a label node, then add to its
FromNode list.)
[if (NC.LinkIconImageObjP
(fetch (GRAPHNODE NODELABEL)
of ToNode))
then (replace (GRAPHNODE FROMNODES)
of ToNode
with
(CONS (fetch (GRAPHNODE
NODEID)
of OldLabelNode)
(fetch (GRAPHNODE
FROMNODES)
of ToNode]
ToNodeID)))
(* Layout graph, including as roots any non-virtual
nodes with no from nodes to avoid disconnected
graphs.)
(SETQ Graph (if (AND Lattice RootNodes)
then (LAYOUTGRAPH
Lattice
(for Node in Lattice bind NodeID
eachtime (BLOCK)
(SETQ NodeID
(OR (NC.CoerceToGraphNodeID
Node)
(fetch (GRAPHNODE NODEID)
of Node)))
when (OR (FMEMB NodeID RootNodes)
(NULL (fetch (GRAPHNODE
FROMNODES)
of Node)))
collect NodeID)
(SUBST (QUOTE LATTICE)
NC.*Graph*BrowserFormat BrowserFormat)
(fetch (SPECIALBROWSERSPECS Font) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS MotherD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS PersonalD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS FamilyD)
of SpecialBrowserSpecs))
else (create GRAPH)))
(* Build links legend and fix up TONODES in the
graph.)
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph Window
DropVirtualNodesFlg))
(NC.SetBrowserRoots Card RootCards)
(NC.SetBrowserDepth Card Depth)
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.RelayoutBrowserCard Window])
(NC.BrowserAddNode
[LAMBDA (Graph Window) (* Randy.Gobbel " 2-Apr-87 15:38")
(* * Called by grapher when user creates a new node. Returns new node or nil.)
(* * rht 11/17/85: updated to handle new card and notefile formats.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection. Also added GLOBALVARS
statement.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/18/87 added NC.ProtectedCardOperation and NC.CardSelectionOperation wrappers)
(* * rg 4/2/87 changed NC.CardSelectionOperation to NCP.WithLockedCards)
(DECLARE (GLOBALVARS NC.BrowserContentsLinkLabel))
(NC.ProtectedCardOperation (NC.CoerceToCard Window)
"Add Node" Window
(NCP.WithLockedCards (PROG ((GraphCard (NC.CoerceToCard Window))
Link GraphNodeID Card)
(* Get user to select an existing card.
Not allowed to create a new one.)
(SETQ Card
(NC.SelectNoteCards
T
[FUNCTION (LAMBDA (SelectedCard)
(COND
((NOT (NC.SameCardP
SelectedCard
GraphCard))
T)
(T (NC.PrintMsg Window T
"The browser can't link to itself."
(CHARACTER
13)
"Selection ignored."
(CHARACTER
13))
NIL]
NC.SelectingCardMenu GraphCard
"Shift-select a card or box to include in browser."))
(if (NULL Card)
then (RETURN NIL))
(* Make link from browser to new card.)
(SETQ Link
(NC.MakeLink Window
NC.BrowserContentsLinkLabel
Card GraphCard NIL NIL
NIL T))
(* Check that it doesn't already exist.
If not, create a browser node.)
(COND
(Link
(* Create hash array if haven't already.)
(NC.GetBrowserHashArray
GraphCard
Graph)
[SETQ GraphNodeID
(NC.GetBrowserNodeID
GraphCard
(SETQ Card
(fetch (Link
DestinationCard)
of Link]
(COND
((for Node
in (fetch (GRAPH
GRAPHNODES)
of Graph)
thereis
(EQ GraphNodeID
(
NC.CoerceToGraphNodeID
Node)))
(NC.PrintMsg Window T
"Node for card '"
(
NC.RetrieveTitle
Card)
"' already in graph.")
(NCP.DeleteLinks Link)
(RETURN NIL)))
(NC.MarkCardDirty GraphCard)
(RETURN (NODECREATE
GraphNodeID
(NC.MakeLinkIcon
Link)
(CURSORPOSITION
NIL Window])
)
(* * changes to NCFILEBOXCARD)
(DEFINEQ
(NC.FileBoxCollectChildren
[LAMBDA (WindowOrTextStream Card NewChildren NoDisplayFlg)
(* Randy.Gobbel " 2-Apr-87 15:38")
(* * Ask user for new children (either cards or fileboxes) for this filebox. Check to make sure that no
circularities are introduced. This code is sort of the inverse of the NC.AddParents code and thus looks quite
similar.)
(* * rht 10/29/84: Added NoDisplayFlg to prevent error message when no appropriate elements exist.
Also now returns ID if at least one child was added, NIL otherwise.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * rht 7/5/86: Now checks for readonly cards.)
(* * rht 8/11/86: Added code to check to make sure that another operation is not in progress on this card when this
fn is called.)
(* * rht 10/17/86: Made successful filing operations NOT do dismiss.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 1/28/87: Now activates parent box if necessary and saves before deactivating.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(OR Card (SETQ Card (NC.CoerceToCard WindowOrTextStream)))
(NC.ProtectedCardOperation Card "Put Cards Here" NIL
(NCP.WithLockedCards
(LET ((Window (NC.FetchWindow Card)))
(if (NC.CheckForNotReadOnly Card Window
"Can't do filing in ")
then (OR NewChildren (SETQ NewChildren
(NC.SelectNoteCards NIL NIL
NC.SelectingFileBoxChildrenMenu
Card
" Please shift-select new children.")))
(COND
([AND NewChildren Card
(LET ((WasActiveFlg (NC.ActiveCardP
Card)))
(OR WasActiveFlg (NC.GetNoteCard
Card))
(PROG1 (for NewChild
in NewChildren
bind OneHook
when (NC.MakeChildLink
NewChild Card
Window)
do (SETQ OneHook T)
finally (RETURN
OneHook))
(OR WasActiveFlg
(NC.QuitCard Card
NIL NIL
NIL NIL
NIL T]
Card)
((NULL NoDisplayFlg)
(NC.PrintMsg Window NIL
"No appropriate NoteCards or FileBoxes chosen."
(CHARACTER 13)
"Hence no children added."
(CHARACTER 13))
(DISMISS 1000)
(NC.ClearMsg Window T)
NIL)
(T NIL])
)
(* * changes to NCDOCUMENTCARD)
(DEFINEQ
(NC.MakeDocument
[LAMBDA (Card Title NoDisplayFlg CardIdentifier) (* Randy.Gobbel " 2-Apr-87 15:38")
(* * Called from a filebox's title bar. Makes a document by smashing all the descendant cards's text together.
Ask user if wants numbered section headings and titles. The former are made from FileBox titles, the latter from
notecard titles. Delete embedded links at the end if the user desires.)
(* * rht 10/22/84: Hacked to be callable from Programmer's interface.)
(* * rht 11/17/84: Checks for cancel when choosing rootID and also when setting parameters.)
(* * rht 8/25/85: Now dumps sketch and graph cards as well as text cards.)
(* * rht 9/16/85: Now handles cr's around titles using para leading.)
(* * fgh 11/178/85 Updated to handle Card and NoteFile objects.)
(* * kirk 27Jun86 Moved NC.RetrieveTitle call so does not break when user Cancels)
(* * rht 7/31/86: Now checks for card types having ExportSubstanceFn prop.)
(* * kirk 8/22/86 Fix of free use of NoteFile var)
(* * rht 10/15/86: Integrated markM's changes and fixed box numbering.)
(* * rht 11/17/86: Now calls NC.ApplySupersFn rather than NC.MakeNoteCard.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper. Still needs ProtectedCardOperation wrapper!)
(* * rg 4/2/87 changed NC.CardSelectionOperation to NCP.WithLockedCards)
(NCP.WithLockedCards (PROG (RootCard RootTitle DocWindow DocCard DocWindowOrCard DocStream
HeadingsFromFileboxes TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks ExpandEmbeddedLinks InspectWin
RootSubstanceType)
(OR NoDisplayFlg (SPAWN.MOUSE))
(SETQ DocWindowOrCard (NC.ApplySupersFn MakeFn Card "Document"
NoDisplayFlg))
(if NoDisplayFlg
then (SETQ DocWindow NIL)
(SETQ DocCard DocWindowOrCard)
else (SETQ DocWindow DocWindowOrCard)
(SETQ DocCard (NC.CoerceToCard DocWindow)))
(* NC.MakeNoteCard either returned an Card or a window
depending on NoDisplayFlg.)
(SETQ RootCard (OR (NC.CoerceToCard CardIdentifier)
(NC.SelectNoteCards T NIL
NC.SelectingCardMenu
DocWindow
"Please shift-select the Note Card or File Box the document should start from.")))
(if (NOT RootCard)
then (NC.DeleteNoteCard Card)
(RETURN NIL))
(SETQ RootTitle (NC.RetrieveTitle RootCard))
(NC.SetTitle DocCard (CONCAT "Document from %"" RootTitle "%""))
(AND DocWindow (WINDOWPROP DocWindow (QUOTE TITLE)
(NC.RetrieveTitle DocCard)))
(SETQ DocStream (NC.FetchSubstance DocCard))
(* * Get MakeDocument parameters from user via inspector window.)
(if (NOT NoDisplayFlg)
then (SETQ InspectWin (NC.BuildMakeDocInspector DocWindow))
(TOTOPW InspectWin)
(for while (OPENWP InspectWin) do (BLOCK)))
(if (EQ (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--))
(QUOTE QUIT))
then (PUTPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--)
(QUOTE --CANCEL--))
(NC.DeleteNoteCard Card)
(RETURN NIL))
(SETQ HeadingsFromFileboxes (GETPROP (QUOTE
NC.MakeDocParameters)
(QUOTE
HeadingsFromFileboxes)))
(SETQ TitlesFromNoteCards (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE TitlesFromNoteCards))
)
(SETQ BuildBackLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE BuildBackLinks)))
(SETQ CopyEmbeddedLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE CopyEmbeddedLinks)))
(SETQ ExpandEmbeddedLinks (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE ExpandEmbeddedLinks))
)
(* * Call recursive routine to dump filebox.)
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(NC.PrintMsg DocWindow NIL
"Collecting text from descendant cards ... ")
(* * Clean up the SeenBefore markers placed on the cards and boxes just copied.)
[RESETSAVE NIL
(QUOTE (PROGN
(for Card
in (NC.FetchUserDataProp
DocCard
(QUOTE SeenCards))
do (NC.SetUserDataProp
Card
(QUOTE SeenBefore)
NIL))
(NC.SetUserDataProp
DocCard
(QUOTE SeenCards)
NIL]
(* * Unbelievably kludgy hack to get around Intermezzo TEdit bug. Just insert and delete a CR.)
(TEDIT.INSERT DocStream NC.CRString 1)
(TEDIT.DELETE DocStream 1 1)
(NC.DumpCardToDoc RootCard DocCard DocStream 0 0
HeadingsFromFileboxes
TitlesFromNoteCards BuildBackLinks
CopyEmbeddedLinks
ExpandEmbeddedLinks)
(NC.PrintMsg DocWindow NIL "Done!"))
(COND
((NOT NoDisplayFlg)
(BLOCK 250)
(NC.ClearMsg DocWindow T)))
(RETURN DocWindowOrCard])
)
(PUTPROPS RGPATCH023 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2845 5301 (NC.LockListOfCards 2855 . 5299)) (8393 58114 (NC.OpenNoteFile 8403 . 22867)
(NC.CloseNoteFile 22869 . 35183) (NC.CheckpointNoteFile 35185 . 40086) (NC.SaveDirtyCards 40088 .
41777) (NC.AbortSession 41779 . 47346) (NC.CopyCards 47348 . 58112)) (58146 85993 (NC.EditNoteCard
58156 . 61320) (NC.QuitCard 61322 . 67030) (NC.CardSaveFn 67032 . 73591) (NC.DeleteNoteCards 73593 .
79910) (NC.InsureProperFiling 79912 . 80875) (NC.AddParents 80877 . 83734) (NC.UnfileNoteCard 83736 .
85991)) (86029 118431 (NC.SelectNoteCards 86039 . 101071) (NC.CloseStructure 101073 . 102960) (
NC.CopyStructure 102962 . 105370) (NC.DeleteStructure 105372 . 107405) (NC.CloseNoteCards 107407 .
109362) (NC.EditProperties 109364 . 111126) (NC.ShowLinks 111128 . 113628) (NC.ShowInfo 113630 .
116815) (NC.SelectionMenusWhenSelectedFn 116817 . 118429)) (118463 130696 (NC.MakeFilingLinks 118473
. 121914) (NC.MakeLink 121916 . 128207) (NC.AddGlobalLinkToCard 128209 . 128455) (NC.AddLinksToCard
128457 . 130694)) (130915 134063 (NCP.CloseCards 130925 . 132668) (NCP.SelectCards 132670 . 134061)) (
134101 158111 (NC.MakeBrowserCard 134111 . 142757) (NC.UpdateBrowserCard 142759 . 154667) (
NC.BrowserAddNode 154669 . 158109)) (158149 161170 (NC.FileBoxCollectChildren 158159 . 161168)) (
161209 167302 (NC.MakeDocument 161219 . 167300)))))
STOP