(FILECREATED "16-Mar-87 12:07:42" {QV}<NOTECARDS>1.3K>NEXT>RGPATCH016.;16 218041
changes to: (MACROS NC.ProtectedCardOperation NC.ProtectedNoteFileOperation
NC.ProtectedSessionOperation)
(FNS NC.AssignTitle NC.DeleteNoteCards NC.CheckFiling NC.DeleteNoteCard
NC.CloseListOfActiveCards NC.NoteFileCheckOpInProgress
NC.SessionCheckOpInProgress NC.OpenNoteFile NC.CloseNoteCards
NC.CloseStructure NC.DeleteStructure NC.MoveStructure NCP.CloseCards
NC.MoveCards NC.AskUser NC.AddParents NC.QuitCard NC.UnfileNoteCard
NC.CardSaveFn NC.AddGlobalLinksToCard NC.AddLinkToCard NC.AddLinksToCard
NC.RelayoutGraphCard NC.FileBoxCollectChildren NC.UpdateBrowserCard
NC.RelayoutBrowserCard NC.ConnectNodesInBrowser NC.UnconnectNodesInBrowser
NC.ExpandBrowserNode NC.ChangeBrowserSpecs NC.MakeBrowserOverviewWin
NC.AskBrowserOverviewSpecs NC.RecomputeLinkIndex NC.ChangeLinkIndexSpecs
NC.QuitWithoutSaving NC.CloseNoteFile NC.CheckpointNoteFile
NC.CardCheckOpInProgress NC.AskUserResetWindow NC.AbortSession
NC.SessionToNoteFileLock NC.CardOperationsInProgress
NC.ResetCardProcessInProgress NC.ProcessName NC.AskUser1 NC.TEditMenuFn
NC.TEditMenuFn1)
(VARS RGPATCH016COMS NC.LockLock)
(ADVICE PROCESS.APPLY-IN-\TEDIT.BUTTONEVENTFN)
previous date: " 4-Mar-87 18:30:42" {QV}<NOTECARDS>1.3K>NEXT>RGPATCH016.;6)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RGPATCH016COMS)
(RPAQQ RGPATCH016COMS ((* * RG 2/26/87 Concurrency fixes ; part 1)
(* * DELETE the function NC.TerminateCardOperationInProgress ; move
NC.ProtectedCardOperation to NCDATABASE)
(FILES (FROM NOTECARDS)
NCGRAPHCARD NCBROWSERCARD NCLINKINDEXCARD NCREPAIR)
(* * changes to NCCARDS)
(MACROS NC.ProtectedCardOperation)
(FNS NC.AssignTitle NC.AddParents NC.DeleteNoteCards NC.QuitCard
NC.CheckFiling NC.UnfileNoteCard NC.CardSaveFn NC.QuitWithoutSaving
NC.DeleteNoteCard NC.AbortCard NC.CardOperationsInProgress)
(* * changes to NCDATABASE)
(MACROS NC.ProtectedNoteFileOperation)
(FNS NC.CloseListOfActiveCards NC.SaveDirtyCards NC.AbortSession
NC.OpenNoteFile NC.CloseNoteFile NC.CheckpointNoteFile
NC.CheckpointDatabase NC.OpenDatabaseFile
NC.ProcessNoteFileNotFoundError NC.ProcessTruncationRequest
NC.ProcessNoteFileNeedsConversionError
NC.ProcessNoteFileNeedsTruncationError
NC.ProcessInspectAndRepairRequest)
(* * changes to NCLINKS)
(FNS NC.AddGlobalLinksToCard NC.AddLinkToCard NC.AddLinksToCard
NC.SmartDeleteLinks)
(* * changes to NCGRAPHCARD)
(FNS NC.RelayoutGraphCard)
(* * changes to NCFILEBOXCARD)
(FNS NC.FileBoxCollectChildren)
(* * changes to NCBROWSERCARD)
(FNS NC.UpdateBrowserCard NC.RelayoutBrowserCard NC.ConnectNodesInBrowser
NC.UnconnectNodesInBrowser NC.ExpandBrowserNode NC.ChangeBrowserSpecs
NC.MakeBrowserOverviewWin NC.AskBrowserOverviewSpecs)
(* * changes to NCLINKINDEXCARD)
(FNS NC.RecomputeLinkIndex NC.ChangeLinkIndexSpecs)
(* * changes to NCINTERFACE)
(FNS NC.CloseNoteCards NC.CloseStructure NC.DeleteStructure NC.MoveStructure
NC.DoNoteFileOp NC.FileBrowserCheckpoint
NC.NoteFileTitleLeftWhenSelectedFn NC.CloseSession NC.MoveCards)
(* * changes to NCPROGINT)
(FNS NCP.CloseCards NCP.UndisplayCards NCP.UncacheCards NCP.CloseNoteFiles
NCP.OpenNoteFile)
(* * changes to NCREPAIR)
(FNS NC.MessageWinAttachedMenuWhenSelectedFn NC.ScavengerPhase1)
(* * changes to NCUTILITIES)
(FNS NC.AskUser)
(* * New for NCUTILITIES)
(FNS NC.AskUserResetWindow)
(* * New for NCDATABASE)
(MACROS NC.ProtectedSessionOperation)
(GLOBALVARS NC.LockLock NC.SessionProcessInProgress
NC.SessionOperationInProgress NC.NoteFileBusyList
NC.CardBusyList)
(INITVARS (NC.LockLock (CREATE.MONITORLOCK "NoteCards Meta-lock"))
NC.SessionProcessInProgress NC.SessionOperationInProgress
NC.NoteFileBusyList NC.CardBusyList)
(FNS NC.CardCheckOpInProgress NC.NoteFileCheckOpInProgress
NC.SessionCheckOpInProgress NC.SessionToNoteFileLock)
(FNS NC.ResetCardProcessInProgress NC.ProcessName)
(* * New for KOTOTEDITPATCHES)
(ADVISE (PROCESS.APPLY IN \TEDIT.BUTTONEVENTFN))))
(* * RG 2/26/87 Concurrency fixes ; part 1)
(* * DELETE the function NC.TerminateCardOperationInProgress ; move NC.ProtectedCardOperation
to NCDATABASE)
(FILESLOAD (FROM NOTECARDS)
NCGRAPHCARD NCBROWSERCARD NCLINKINDEXCARD NCREPAIR)
(* * changes to NCCARDS)
(DECLARE: EVAL@COMPILE
[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.FetchWindow , Card))
, Operation OpInProgress)
(QUOTE DON'T]
)
(DEFINEQ
(NC.AssignTitle
[LAMBDA (CardIdentifier NoClearMsgFlg NewTitle) (* Randy.Gobbel "10-Mar-87 19:20")
(* * Change the title of the card specified by the WindowOrTextStreamOrID)
(* * rht 2/1/85: Changed from NC.PutTitle to NC.SetTitleDirtyFlg, unless card is not active.
We shouldn't be writing to the notefile until save time.)
(* * fgh 11/11/85: Added support for CardID, CardInfo and noteFile objects. Also entered call to Nc.StoreTitle.)
(* * 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.)
(* * fgh 6/13/86 Now spawns mouse in case called under MOUSE process.)
(* * fgh 6/27/86 returns T if completed okay.)
(* * rht 7/4/86: Added check for readonly card.)
(* * kef 7/16/86: Added obtain write permission.)
(* * kef 7/24/86: Doesn't release the write lock if this is a new card.)
(* * 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.)
(* * fgh 8/30/86 Converted to use NC.IfCardPartNotBusy.)
(* * rg 3/3/87 Enlarged scope of NC.ProtectedCardOperation)
(ALLOW.BUTTON.EVENTS)
(LET ((Card (NC.CoerceToCard CardIdentifier))
ContainingCard OldTitle Window)
(NC.ProtectedCardOperation Card "Assign Title" NIL
(NC.IfCardPartNotBusy
Card
(QUOTE TITLE)
(SETQ Window (NC.FetchWindow Card))
(if (NC.CheckForNotReadOnly Card Window
"Can't change titles for cards in ")
then (COND
((SETQ NewTitle
(OR (STRINGP NewTitle)
(AND NewTitle (OR (LITATOM
NewTitle)
(NUMBERP
NewTitle))
(MKSTRING NewTitle))
(NC.AskUser
(CONCAT
"Enter the title for this card"
(CHARACTER 13))
"--> "
(COND
((AND (STREQUAL (SETQ OldTitle
(
NC.RetrieveTitle
Card))
"Untitled")
(NC.FetchNewCardFlg Card))
NIL)
(T OldTitle))
(NULL NoClearMsgFlg)
Window)))
(NC.SetTitle Card NewTitle)
(* * Now do a PutTitle so that anyone else coming along will pick up on the new title. The only exception is if
this card hasn't been written to the NoteFile yet, which is true when the NewCardFlg is T. In that case, we can't
put the title down yet, so just mark it dirty.)
(COND
((fetch (Card NewCardFlg) of Card)
(NC.SetTitleDirtyFlg Card T))
(T (NC.PutTitle Card)
(NC.SetTitleDirtyFlg Card NIL)))
(AND (WINDOWP Window)
(WINDOWPROP Window (QUOTE TITLE)
NewTitle))
(for FromLink in (NC.RetrieveFromLinks
Card)
do (AND (NC.ActiveCardP
(SETQ ContainingCard
(fetch (Link SourceCard)
of FromLink)))
(WINDOWP (NC.FetchWindow
ContainingCard))
(NC.UpdateLinkImages
ContainingCard
Card)))
T))
else NIL])
(NC.AddParents
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel " 4-Mar-87 14:36")
(* 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)
(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.DeleteNoteCards
[LAMBDA (CardIdentifiers NoIndividualConfirmFlg DontClearFlg InterestedWindow QuietFlg
NoGroupConfirmFlg) (* Randy.Gobbel "11-Mar-87 12:13")
(* 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)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(NC.ProtectedSessionOperation
"Delete Note Cards" InterestedWindow (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.SeverAllLinks 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.ProtectedCardOperation Card "Delete Card" InterestedWindow
(NC.DeleteNoteCardInternal Card)))
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
CardIdentifiers])
(NC.QuitCard
[LAMBDA (CardIdentifier CallCloseWFlg DontSaveFlg DontRecacheFlg InterestedWindow OperationMsg
QuietFlg Don'tDeactivateFlg) (* Randy.Gobbel " 5-Mar-87 14:29")
(* * 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)
(DECLARE (GLOBALVARS NC.RemoveDELETEMEImageObjsFromCardFlg))
(LET ((Card (NC.CoerceToCard CardIdentifier))
Window ReadOnlyCardFlg)
(NC.ProtectedCardOperation
Card "Close Card" InterestedWindow (SETQ Window (NC.FetchWindow Card))
(PROG NIL
(OR InterestedWindow (SETQ InterestedWindow Window))
(SETQ ReadOnlyCardFlg (NC.ReadOnlyCardP Card))
(* The window not being open should mean that it's
shrunken. If so, expand it.)
(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)
(QUOTE CANCELLED))
(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.CheckFiling
[LAMBDA (Card) (* Randy.Gobbel "10-Mar-87 19:20")
(* Check to make sure this card has a contents hook of
some sort. If not, hook it up to a contents card.)
(* * rht 12/8/84: Now checks whether both cards *and* fileboxes have been filed.)
(* * rht 12/9/84: Now files in orphan filebox if NC.ForceFiling flag is off, without bothering the user.)
(* * rht 2/9/85: Added call to NC.CardNeedsFilingP)
(* * fgh 11/12/85 Updated to handle Card and NoteFile objects.)
(* * fgh 6/9/86 Updated to set operation in progress indicator.)
(* * rg 1/28/87 Make sure we always return a useful value)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation)
(NC.ProtectedCardOperation Card "Filing" NIL (COND
[(NC.CardNeedsFilingP Card)
(COND
[NC.ForceFilingFlg (NC.MakeFilingLinks Card
(CONCAT "This card ("
(
NC.RetrieveTitle
Card)
") is not currently filed in a FileBox."
(CHARACTER
13]
(T (NC.PrintMsg (NC.FetchWindow Card)
T "This card (" (NC.RetrieveTitle Card)
") is not currently filed in a FileBox."
(CHARACTER 13)
"It is being filed in the ToBeFiled FileBox."
(CHARACTER 13))
(NC.HookToOrphanCard Card (fetch (NoteFile ToBeFiledCard)
of (fetch (Card NoteFile)
of Card]
(T T])
(NC.UnfileNoteCard
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel " 4-Mar-87 14:11")
(* 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)
(DECLARE (GLOBALVARS NC.SelectingParentsMenu))
(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])
(NC.CardSaveFn
[LAMBDA (WindowOrID QuietFlg InterestedWindow OperationMsg)
(* Randy.Gobbel " 4-Mar-87 18:07")
(* * 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)
(LET ((Card (NC.CoerceToCard WindowOrID))
Window OldRegion NewRegion DoneAPutP)
(NC.ProtectedCardOperation
Card "Save Card" InterestedWindow (SETQ Window (NC.FetchWindow Card))
(SETQ InterestedWindow (OR Window InterestedWindow))
(LET [(WhenSavedFn (GETPROP (NC.FetchType Card)
(QUOTE WhenSavedFn]
(AND WhenSavedFn (APPLY* WhenSavedFn Card)))
(if (NC.CheckForNotReadOnly Card Window "Can't save cards in ")
then (OR QuietFlg (NC.PrintMsg InterestedWindow T (OR OperationMsg "")
(NC.FetchTitle Card)
": Checking ... "))
(COND
((OR (NC.CardDirtyP Card)
(NC.FetchNewCardFlg Card))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "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 NIL "Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "region, "))
(NC.PutRegion Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchTitleDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL "Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "title, "))
(NC.PutTitle Card)
(SETQ DoneAPutP T)))
(COND
((NC.FetchPropListDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL "Saving "))
(OR QuietFlg (NC.PrintMsg InterestedWindow NIL "proplist, "))
(NC.PutPropList Card)
(SETQ DoneAPutP T)))
[COND
((NC.FetchLinksDirtyFlg Card)
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL "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]
(OR DoneAPutP QuietFlg (NC.PrintMsg InterestedWindow NIL (CHARACTER
13)
"Nothing changed. "))
(* 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 (PROGN (NC.PrintMsg InterestedWindow NIL "Done."
(CHARACTER 13))
(if Window
then (NC.ClearMsg Window T])
(NC.QuitWithoutSaving
[LAMBDA (CardIdentifier) (* Randy.Gobbel " 5-Mar-87 18:06")
(* Quit from a note card without saving its contents on the database. But must make sure that any updates that
would have been done to this card even if it had been on the database are carried out on the old image currently on
the database)
(* * rht 2/1/85: Now only writes out links if it has to. Also resets dirty flags and calls normal quit procedure.
I think we've still got possible problems with recently changed titles, both ours and those of cards we point to.)
(* * rht 2/3/85: Now handles title changes properly. Also fixed so that changes to from links will force links to
be written.)
(* * rht 2/9/85: Now accepts IDs as arg.)
(* * fgh 11/12/85: Updated to handle Card objects. Removed DatabaseStream argument.)
(* * fgh 6/4/86 No longer asks for confirmation if no changes have been made.)
(* * kef 8/7/86: Now compares ToLinks by NC.SameUIDP rather than EQ. Situation comes up in Server, when the same
UIDs may not be EQ. Also, now obtains write lock on FROMLINKS before deleting FROMLINKS on the DestinationCard of a
changed FROMLINK.)
(* * fgh 8/30/86 Converted to use NC.WithWrotePermission macro.)
(* * rht 10/16/86: Changed NC.ProtectedCardOperation wrapper placement so that card deletion could still happen for
new cards.)
(* * rg 3/3/87 Rewrote NC.ProtectedCardOperation wrapping)
(LET (Window Card NewFromLinks ToLinks DeletedLinks Process TextObj MadeNewLinksP
ChangedFromLinksP OldFromLinks OldToLinks)
(SETQ Card (NC.CoerceToCard CardIdentifier))
(NC.ProtectedCardOperation Card "Close w/o Saving" NIL (SETQ Window (NC.FetchWindow
Card))
(SETQ ToLinks (NC.FetchToLinks Card))
(SETQ NewFromLinks (NC.FetchFromLinks Card))
(if (OR (NULL (OR (NC.CardDirtyP Card)
(NC.FetchLinksDirtyFlg Card)
(NC.FetchTitleDirtyFlg Card)
(NC.FetchPropListDirtyFlg Card)))
(NC.AskYesOrNo
"Are you sure you want to flush your changes?"
" -- " "Yes" T Window NIL NIL))
then
(* * EIther no changes have been made or the user has confirmed.)
(if (EQ (fetch (Card Status) of Card)
(QUOTE ACTIVE))
then (* Read old card parts off notefile.)
(NC.GetNoteCard Card)
(* If from links have changed then we'll have to write
the new ones out.)
(SETQ OldFromLinks (NC.FetchFromLinks Card))
(if (NOT (NC.SameLinksP NewFromLinks OldFromLinks)
)
then (NC.SetFromLinks Card NewFromLinks)
(SETQ ChangedFromLinksP T))
(* Delete the back links from all links that are not
in the old to link set.)
(SETQ OldToLinks (NC.FetchToLinks Card))
[for ToLink in ToLinks
unless (for Link in OldToLinks
eachtime (BLOCK)
thereis (NC.SameLinkP Link ToLink))
do (LET ((DestinationCard (fetch (Link
DestinationCard)
of ToLink)))
(* Grab the writelock on the FROMLINKS before trying
to write out the change.)
(NC.WithWritePermission DestinationCard
(QUOTE FROMLINKS)
(NC.DelFromLink
ToLink)
(SETQ
MadeNewLinksP T]
(* Check to make sure none of the old To links point
to a deleted card. If so, replace with a deleted
marker.)
(SETQ DeletedLinks
(bind DestinationCard for Link in OldToLinks
eachtime (BLOCK)
when [PROGN (SETQ DestinationCard
(fetch (Link DestinationCard)
of Link))
(AND (NOT (NC.ActiveCardP
DestinationCard))
(EQ (QUOTE DELETED)
(NC.FetchStatus
DestinationCard]
collect (NC.DelReferencesToCard Card
DestinationCard)
Link))
(NC.SetToLinks Card (LDIFFERENCE OldToLinks
DeletedLinks))
(* Mark links dirty if we had to delete any to links
or if the from links changed.)
(NC.SetLinksDirtyFlg Card (OR DeletedLinks
ChangedFromLinksP))
(* Mark the substance dirty if had to delete any to
links.)
(if DeletedLinks
then (NC.MarkCardDirty Card)
else (NC.MarkCardDirty Card (QUOTE RESET)))
(NC.SetPropListDirtyFlg Card NIL)
(if (NC.FetchTitleDirtyFlg Card)
then
(* If we've changed title and any of the cards pointing to this one are up on the screen, then we need to update
their images.)
(for FromLink in OldFromLinks
bind SourceCard eachtime (BLOCK)
when
(AND (NC.ActiveCardP
(SETQ SourceCard
(fetch (Link SourceCard)
of FromLink)))
(WINDOWP (NC.FetchWindow
SourceCard)))
do (NC.UpdateLinkImages SourceCard
Card))
(NC.SetTitleDirtyFlg Card NIL))
(NC.QuitCard Card T)
else (* If the card has never been written to the database
quit w/o saving is equivalent to deleting the card.)
(NC.PrintMsg Window T
"This card has never been saved."
(CHARACTER 13)
"It will be deleted from the database."
(CHARACTER 13))
(NC.DeleteNoteCards Card NIL T])
(NC.DeleteNoteCard
[LAMBDA (CardIdentifier) (* Randy.Gobbel "11-Mar-87 16:30")
(* * User interface level fn to delete a single note card from a NoteFile)
(LET (Card InterestedWindow)
(NC.ProtectedCardOperation (NC.CoerceToCard CardIdentifier)
"Delete Note Card"
(NC.FetchWindow Card)
(SETQ Card (NC.CoerceToCard CardIdentifier))
(SETQ InterestedWindow (NC.FetchWindow Card))
(AND (if (NC.TopLevelCardP Card)
then (NC.PrintMsg InterestedWindow T
"You cannot delete this FileBox."
(CHARACTER 13))
(DISMISS 1000)
(NC.ClearMsg InterestedWindow T)
NIL
else T)
(NC.CheckForNotReadOnly Card InterestedWindow
"Can't delete cards from a ")
(PROG1 (NC.AskYesOrNo
"Are you sure you want to delete this?"
" -- " "Yes" T InterestedWindow
NIL NIL)
(NC.ClearMsg))
(PROGN
(* * Mark UID of card about to be deleted.)
(NC.UIDPutProp (fetch (Card UID)
of Card)
(QUOTE AboutToBeDeletedFlg)
T)
(* * Sever all links into and out of Card)
(NC.SeverAllLinks (LIST Card)
T)
(* * Now delete the card)
(NC.DeleteNoteCardInternal Card])
(NC.AbortCard
[LAMBDA (Card QuietFlg) (* Randy.Gobbel " 4-Mar-87 14:42")
(* * Kill this card's process and its window.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * rht 7/6/86: Now passes non-nil Don'tRecacheFlg to NC.QuitCard.)
(* * rht 7/13/86: Now takes QuietFlg and passes to NC.QuitCard.)
(NC.QuitCard Card NIL T T NIL NIL QuietFlg])
(NC.CardOperationsInProgress
[LAMBDA (NoteFile AskAndTerminateFlg) (* Randy.Gobbel " 5-Mar-87 15:41")
(* * Check if any cards have operations in progress. If so, either return their processes or Ask the user if they
should be terminated and termionate them, depending on AskAndTerminateFlg. If the user say no terminations, then
return the LITATOM ABORT.)
(* * fgh 6/13/86 First created)
(* * fgh 7/16/86 Due to change of NC.MapCards from fn to macro had to change the RETFROM NC.MapVCards to a RETFROM
MAPHASH.)
(* * rg 3/4/87 rewritten to sort of cooperate with new concurrency machinery. WARNING: THE VALUE RETURNED FROM THIS
FUNCTION IS VOLATILE AND SHOULD NOT BE RELIED ON. IN ADDITION, CALLING THIS FUNCTION MAY RESULT IN THE NOTECARDS
WORLD BEING LEFT IN AN INCONSISTENT STATE)
(WITH.MONITOR NC.LockLock (LET (Processes (NC.NoteFileProp NoteFile (QUOTE
CardProcessInProgressList)))
(if (NULL AskAndTerminateFlg)
then (* Just Return a lst of proceses)
Processes
else (if (NULL Processes)
then NIL
else (if (NC.AskYesOrNo
(CONCAT
"There are cards with operations in progress."
(CHARACTER 13)
"Do you want to terminate these operations?"
(CHARACTER 13))
"-->"
(QUOTE Yes)
T
(WFROMMENU (fetch (NoteFile Menu)
of NoteFile)))
then [for Process in Processes
do (PROCESS.EVAL
Process
(QUOTE (ERROR!]
else (QUOTE ABORT])
)
(* * 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 , InterestedWindow (WFROMMENU (fetch (NoteFile Menu)
of , NoteFile)))
, Operation OpInProgress)
(QUOTE DON'T]
)
(DEFINEQ
(NC.CloseListOfActiveCards
[LAMBDA (ActiveCards InterestedWindow QuietFlg) (* Randy.Gobbel "12-Mar-87 18:43")
(* * Close a list of active cards.)
(* * rg 3/4/87 added NC.ProtectedSessionOperation wrapper)
(* * rg 3/12/87 Oops. REMOVED NC.ProtectedSessionOperation wrapper)
(for Card in ActiveCards bind Window
do [for CardPart in (QUOTE (SUBSTANCE TOLINKS GLOBALTOLINKS PROPLIST))
do (OR (NC.ApplyFn ObtainWritePermissionFn Card CardPart)
(until (NC.ApplyFn ObtainWritePermissionFn Card CardPart)
do (OR QuietFlg (NC.PrintMsg InterestedWindow T
(CONCAT
"Waiting to obtain write permission for the "
CardPart " on card "
(NC.FetchTitle Card)
"...")))
(BLOCK)
finally (OR QuietFlg (NC.PrintMsg InterestedWindow NIL "done."]
(NC.QuitCard Card T NIL T InterestedWindow NIL QuietFlg)
(if (SETQ Window (NC.FetchWindow Card))
then (bind (Process ← (WINDOWPROP Window (QUOTE PROCESS)))
until (OR (NULL Process)
(PROCESS.FINISHEDP Process))
do (BLOCK])
(NC.SaveDirtyCards
[LAMBDA (NoteFile TerminateOperationsInProgressFlg InterestedWindow OperationMsg QuietFlg)
(* Randy.Gobbel " 4-Mar-87 16:36")
(* * 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)
(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 (AND TerminateOperationsInProgressFlg (
NC.TerminateCardOperationInProgress Card))
(NC.CardSaveFn Card QuietFlg InterestedWindow OperationMsg)))
(for Win in ShrunkenCardWins eachtime (BLOCK) do (SHRINKW Win])
(NC.AbortSession
[LAMBDA (NoteFile InterestedWindow Don'tConfirmFlg QuietFlg)
(* Randy.Gobbel " 6-Mar-87 14:46")
(* * 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)
(DECLARE (GLOBALVARS NC.MsgDelay))
(NC.ProtectedSessionOperation
"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)
[OR InterestedWindow (SETQ InterestedWindow (WFROMMENU (fetch (NoteFile Menu)
of NoteFile]
(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.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 "13-Mar-87 18:06")
(* * 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)
(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 FullFileName) of NoteFile with FileName)
(replace (NoteFile ReadOnlyFlg) of NoteFile with ReadOnlyFlg)
(RETURN
(NC.ProtectedNoteFileOperation
NoteFile "Open NoteFile" InterestedWindow
(PROG NIL
(* * If there is no interested window, see if the menu window can be used.)
[if (AND (NULL InterestedWindow)
(fetch (NoteFile Menu) of NoteFile))
then (SETQ InterestedWindow (WFROMMENU (fetch (NoteFile Menu)
of NoteFile]
(* * 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))
(* * 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]
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 " 4-Mar-87 16:07")
(* * 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)
(DECLARE (GLOBALVARS NC.MsgDelay NC.CloseNoteFileFns))
(if (NC.ReadOnlyNoteFileP NoteFile)
then (NC.AbortSession NoteFile InterestedWindow)
else
(ALLOW.BUTTON.EVENTS)
(PROG ((FullFileName (fetch (NoteFile FullFileName) of NoteFile))
CardTotal ActiveCards ReturnValue (OperationMsg ""))
[OR InterestedWindow (if (type? MENU (fetch (NoteFile Menu) of NoteFile))
then (SETQ InterestedWindow (WFROMMENU
(fetch (NoteFile Menu) of NoteFile]
(* * 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)))
(* * Do the rest under an operation in progress lock.)
(RETURN
(NC.ProtectedNoteFileOperation
NoteFile "Close NoteFile" InterestedWindow
(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 " 4-Mar-87 17:44")
(* * 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)
(DECLARE (GLOBALVARS NC.MsgDelay))
(NC.ProtectedNoteFileOperation
NoteFile "Checkpoint NoteFile" InterestedWindow
(PROG ((FullFileName (fetch (NoteFile FullFileName) of NoteFile))
ReturnValue)
[OR InterestedWindow (SETQ InterestedWindow (WFROMMENU (fetch (NoteFile Menu)
of NoteFile]
(* * 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 T
"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.CheckpointDatabase
[LAMBDA (NoteFile QuietFlg Don'tSaveDirtyCardsFlg InterestedWindow OperationMsg)
(* Randy.Gobbel " 4-Mar-87 16:09")
(* * First save to the database any cards currently dirty. Copy the index array back into the file and set the
LastChkptPtr to the end of the file.)
(* * rht 11/12/85: Now calls NC.PutHashArray to do the hard work.)
(* * 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.)
(* * fgh 9/1/86 Now just a compatibility wrapper for NC.CheckpointNoteFile. Part of device vector impleementation.)
(* * rg 3/4/87 removed Don'tCheckXXXFlgs)
(NC.CheckpointNoteFile NoteFile QuietFlg Don'tSaveDirtyCardsFlg InterestedWindow OperationMsg])
(NC.OpenDatabaseFile
[LAMBDA (NoteFileOrFileName Access Don'tCacheTypesAndTitlesFlg QuietFlg Don'tCreateFlg
Convertw/oConfirmFlg Don'tCreateArrayFlg Don'tTruncateFlg
Don'tCreateInterfaceFlg Don'tGetSpecialCardsFlg InterestedWindow)
(* Randy.Gobbel " 4-Mar-87 16:21")
(DECLARE (GLOBALVARS NC.NoteFilesHashArray))
(NC.OpenNoteFile NoteFileOrFileName NC.NoteFilesHashArray Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg Convertw/oConfirmFlg Don'tCreateArrayFlg Don'tTruncateFlg
Don'tCreateInterfaceFlg Don'tGetSpecialCardsFlg InterestedWindow NIL NIL
QuietFlg (if (EQ Access (QUOTE INPUT))
then T
else NIL])
(NC.ProcessNoteFileNotFoundError
[LAMBDA (NoteFile NoteFilesHashArray Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
Convertw/oConfirmFlg Don'tCreateArrayFlg Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg InterestedWindow PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg)
(* Randy.Gobbel " 4-Mar-87 16:21")
(* * NoteFile couldnot be found when an attempt was made to open it. Find out if the user wants to create it.)
(* * fgh 5/23/86 First created.)
(* * fgh 9/1/86 Updated args to match NC.OpenNoteFIle.)
(* * rht 10/31/86: Added Don'tCheckForTruncationFlg arg.)
(if QuietFlg
then
(* * If QuietFlg is set, then we'll just have to send back a error notification.)
(QUOTE NoteFileNotFound)
else
(* * Otherwise, we can interact with the user.)
(LET (NewFileName)
(* * Notify user of the error)
(NC.PrintMsg InterestedWindow T "Could not find NoteFile " (fetch (NoteFile
FullFileName)
of NoteFile)
(CHARACTER 13))
(* * If the user wants to create the file, then create it and try the open again.)
(if (AND (NULL Don'tCreateFlg)
(NC.AskYesOrNo (CONCAT "Do you want to create "
(fetch (NoteFile FullFileName)
of NoteFile))
" -- " "Y" NIL InterestedWindow T NIL))
then (if [CAR (ERSETQ (SETQ NewFileName (NC.CreateNoteFile
NoteFile NIL NIL InterestedWindow
(CONCAT "Opening NoteFile" (CHARACTER
13]
then (NC.OpenNoteFile NoteFile NoteFilesHashArray
Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
Convertw/oConfirmFlg Don'tCreateArrayFlg
Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg InterestedWindow
PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg))
else (QUOTE NoteFileNotFound])
(NC.ProcessTruncationRequest
[LAMBDA (NoteFile NoteFilesHashArray Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
Convertw/oConfirmFlg Don'tCreateArrayFlg Don'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg PromptWindow PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg) (* Randy.Gobbel " 4-Mar-87 16:23")
(* * Do the actual truncation of a NoteFile that has stuf past the checkpoint pointer.)
(* * fgh 5/25/86 First created.)
(* * fgh 9/1/86 Updated args to match NC.OpenNoteFile.)
(* * rht 2/19/87: Now passes PromptWindow arg to TruncationFn.)
(LET (ReturnValue (TruncationFn (fetch (NoteFile TruncateNoteFileFn) of NoteFile)))
(* * Do the truncation.)
(if [type? NoteFile (CAR (ERSETQ (SETQ ReturnValue (APPLY* TruncationFn NoteFile
PromptWindow]
then
(* * Truncation successful, Open the note file.)
(NC.OpenNoteFile NoteFile NoteFilesHashArray Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg Convertw/oConfirmFlg Don'tCreateArrayFlg
Don'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg PromptWindow PublicOrPrivate
MenuPosition QuietFlg ReadOnlyFlg)
else
(* * Error during truncation fn. report and get out of here.)
(SELECTQ ReturnValue
(NoteFileTruncationAborted (QUOTE NoteFileTruncationAborted))
(PROGN (ERSETQ (NC.ReportError NIL (CONCAT
"NoteFile truncation failed for NoteFile "
(fetch
(NoteFile
FullFileName)
of NoteFile)
" because "
ReturnValue ".")))
(QUOTE NoteFileTruncationFailed])
(NC.ProcessNoteFileNeedsConversionError
[LAMBDA (NoteFile NoteFilesHashArray Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
Convertw/oConfirmFlg Don'tCreateArrayFlg Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg PromptWindow PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg)
(* Randy.Gobbel " 4-Mar-87 16:24")
(* * Discovered NoteFile needs version conversion when attempted to open it. Process that error.)
(* * fgh 5/23/86 First created.)
(* * fgh 9/1/86 Updated args to match NC.OpenNoteFile.)
(* * rht 10/31/86: Added Don'tCheckForTruncationFlg arg.)
(* * 11/6/86: Now passes PromptWindow down to conversion fn.)
(LET (ConversionFn ReturnValue)
(* * If appropriate, notify the user.)
(if (WINDOWP PromptWindow)
then (NC.PrintMsg PromptWindow T "NoteFile " (fetch (NoteFile FullFileName)
of NoteFile)
"is an old format file."
(CHARACTER 13)))
(* * If the device has a ConversionFn, then apply it and try to Open the NoteFile.)
(if (SETQ ConversionFn (fetch (NoteFile ConvertNoteFileFormatFn) of NoteFile))
then
(* * ask the user if conversion should be done. If so, do it, else return an error msg,)
(if (OR Convertw/oConfirmFlg (NC.AskYesOrNo
"Do you want to convert it to the new format? "
" -- " "Y" NIL PromptWindow))
then
(* * go ahead and convert.)
[if [type? NoteFile (CAR (ERSETQ (SETQ ReturnValue
(APPLY* ConversionFn
NoteFile
PromptWindow]
then
(* * Conversion successful, Open the note file.)
(NC.OpenNoteFile NoteFile NoteFilesHashArray
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg Convertw/oConfirmFlg
Don'tCreateArrayFlg Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg PromptWindow
PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg)
else
(* * Error during conversion fn. report and get out of here.)
(SELECTQ ReturnValue
(PROGN [ERSETQ
(NC.ReportError
NIL
(CONCAT
"NoteFile format conversion failed for NoteFile "
(fetch (NoteFile
FullFileName)
of NoteFile]
(QUOTE NoteFileConversionFailed]
else
(* * User said don't convert. Just return)
(QUOTE NoteFileNeedsConversion))
else
(* * No conversion fn. Tell the user if appropriate and return an error msg.)
(if (WINDOWP PromptWindow)
then (NC.PrintMsg PromptWindow NIL "No format conversion possible."
(CHARACTER 13)
"See a NoteCards wizard."
(CHARACTER 13)))
(QUOTE NoteFileNeedsConversion])
(NC.ProcessNoteFileNeedsTruncationError
[LAMBDA (NoteFile NoteFilesHashArray Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
Convertw/oConfirmFlg Don'tCreateArrayFlg Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg PromptWindow PublicOrPrivate MenuPosition QuietFlg
ReadOnlyFlg Don'tCheckForTruncationFlg)
(* Randy.Gobbel " 4-Mar-87 16:31")
(* * Discovered NoteFile needs version truncation when attempted to open it. Process that error.)
(* * fgh 5/23/86 First created.)
(* * fgh 9/1/86 Updated args to match NC.OpenNoteFile.)
(* * rht 10/29/86: Changed name from Abort to Cancel.)
(* * rht 10/31/86: Added Don'tCheckForTruncationFlg arg.)
(PROG (TruncationFn)
(* * If appropriate, notify the user.)
(if (WINDOWP PromptWindow)
then (NC.PrintMsg PromptWindow T "NoteFile " (fetch (NoteFile FullFileName)
of NoteFile)
" has information written since last successful close or checkpoint."
(CHARACTER 13)))
(* * If the device has a TruncationFn then apply it and try to Open the NoteFile.)
(if (AND (NULL Can'tTruncateFlg)
(SETQ TruncationFn (fetch (NoteFile TruncateNoteFileFn) of NoteFile)))
then
(* * ASk the user if they want to truncate, or abort, or repair the notefile.)
(SELECTQ (NC.AskUserAboutTruncation NoteFile PromptWindow)
(Cancel (RETURN (QUOTE CancelOpen)))
(Inspect% &% Repair (RETURN (NC.ProcessInspectAndRepairRequest
NoteFile NoteFilesHashArray
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg Convertw/oConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
PromptWindow PublicOrPrivate
MenuPosition QuietFlg ReadOnlyFlg
Don'tCheckForTruncationFlg)))
(Truncate% File (RETURN (NC.ProcessTruncationRequest NoteFile
NoteFilesHashArray
Don'tCacheTypesAndTitlesFlg
Don'tCreateFlg
Convertw/oConfirmFlg
Don'tCreateArrayFlg
Can'tTruncateFlg
Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg
PromptWindow
PublicOrPrivate
MenuPosition
QuietFlg
ReadOnlyFlg
Don'tCheckForTruncationFlg)))
(SHOULDNT
"Illegal menu option selected in NC.AskUserAboutTruncation."))
else
(* * No TruncationFn. Tell the user if appropriate and return an error msg.)
(if (WINDOWP PromptWindow)
then (NC.PrintMsg PromptWindow NIL
"No file truncation possible for this NoteFile."
(CHARACTER 13)
"See a NoteCards wizard."
(CHARACTER 13)))
(RETURN (QUOTE NoteFileNeedsTruncation])
(NC.ProcessInspectAndRepairRequest
[LAMBDA (NoteFile NoteFilesHashArray Don'tCacheTypesAndTitlesFlg Don'tCreateFlg
Convertw/oConfirmFlg Don'tCreateArrayFlg Can'tTruncateFlg Don'tCreateInterfaceFlg
Don'tGetSpecialCardsFlg PromptWindow PublicOrPrivate
Don'tCheckOperationsInProgressFlg MenuPosition QuietFlg ReadOnlyFlg
Don'tCheckForTruncationFlg) (* rht: " 1-Nov-86 19:15")
(* * Do an an InspectAndRepair on a file then try to reopen. Used when checkpoint pinter out of sorts during an
Open.)
(* * fgh 5/25/86 First created.)
(* * fgh 9/1/86 Updated args to match NC.OpenNoteFile.)
(* * rht 10/31/86: Changed outdated call to NC.RepairNoteFile to NC.InspectAndRepairNoteFile.
Added Don'tCheckForTruncationFlg arg. No longer tries to open after NC.InspectAndRepairNoteFile returns.)
(if (CAR (ERSETQ (NC.InspectAndRepairNoteFile NoteFile NIL PromptWindow)))
then
(* * For now, can't open after NC.InspectAndRepairNoteFile returns because returns before repair has completed.)
(* * (* * Repair NoteFile succeeded, try to Open the NF now.) (NC.OpenNoteFile NoteFile NoteFilesHashArray
Don'tCacheTypesAndTitlesFlg Don'tCreateFlg Convertw/oConfirmFlg Don'tCreateArrayFlg Can'tTruncateFlg
Don'tCreateInterfaceFlg Don'tGetSpecialCardsFlg PromptWindow PublicOrPrivate T MenuPosition QuietFlg ReadOnlyFlg
Don'tCheckForTruncationFlg))
NIL
else
(* * REapir NoteFile failed for some reason. Report and return.)
[ERSETQ (NC.ReportError NIL (CONCAT "NoteFile Inspect&RepairFailed for NoteFile "
(fetch (NoteFile FullFileName) of NoteFile]
(QUOTE InspectAndRepairFailed])
)
(* * changes to NCLINKS)
(DEFINEQ
(NC.AddGlobalLinksToCard
[LAMBDA (CardIdentifier SingleLinkFlg) (* Randy.Gobbel " 4-Mar-87 14:13")
(* * Called from card's menu to add some global links.)
(* * rht 11/24/85: Fixed bugs. It was calling NC.CoerceToID.)
(* * fgh 6/9/86 Added chack for other interaction operations already 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.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation)
(NC.ProtectedCardOperation SourceCard "Add Global Link(s)" NIL
(LET (Window SourceCard DestinationCards Label)
(SETQ SourceCard (NC.CoerceToCard CardIdentifier))
(SETQ Window (NC.FetchWindow SourceCard))
(SETQ Label (NC.AskLinkLabel Window NIL NIL T T))
(AND Label (if SingleLinkFlg
then (NC.MakeGlobalLink Window Label NIL
SourceCard)
(NC.ClearMsg Window T)
else (SETQ DestinationCards
(NC.SelectNoteCards
NIL
[FUNCTION (LAMBDA (Card)
(COND
((NEQ Card SourceCard)
T)
(T (NC.PrintMsg Window 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.MakeGlobalLink Window Label
DestinationCard
SourceCard])
(NC.AddLinkToCard
[LAMBDA (CardIdentifier LinkOrLinkLabel DestinationCard) (* Randy.Gobbel " 4-Mar-87 14:15")
(* * Add a link to card designated by CardIdentifier. Rest of args can be NIL. Currently, this dispatches on card
type. Should eventually call something like an InsertLinkFn.)
(* * 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.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation)
(LET ((Card (NC.CoerceToCard CardIdentifier))
CardType Window)
(NC.ProtectedCardOperation Card "Insert Link" NIL (SETQ Window (NC.FetchWindow Card))
(SETQ CardType (NC.FetchType Card))
(OR LinkOrLinkLabel (SETQ LinkOrLinkLabel
(NC.AskLinkLabel Window NIL NIL T T)))
(AND LinkOrLinkLabel (COND
((NC.IsSubTypeOfP CardType (QUOTE Text))
(NC.InsertLinkInText (NC.FetchSubstance Card)
LinkOrLinkLabel DestinationCard
Card))
((NC.IsSubTypeOfP CardType (QUOTE Graph))
(NC.AddLinkToGraphCard Window LinkOrLinkLabel
DestinationCard))
((NC.IsSubTypeOfP CardType (QUOTE Sketch))
(NC.AddLinkToSketchCard Window LinkOrLinkLabel
DestinationCard])
(NC.AddLinksToCard
[LAMBDA (CardIdentifier LinkLabel DestinationCards) (* Randy.Gobbel " 4-Mar-87 14:20")
(* * 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)
(LET ((SourceCard (NC.CoerceToCard CardIdentifier))
CardType Window OperationInProgress)
(NC.ProtectedCardOperation SourceCard "Insert Links" NIL (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])
(NC.SmartDeleteLinks
[LAMBDA (ListOfLinks QuietFlg InterestedWindow) (* Randy.Gobbel " 4-Mar-87 14:40")
(* * Delete a bunch of links efficiently. Sort so that links with same source bunch together.
This way, only read and write each source card once. If a card has the AboutToBeDeletedFlg UID prop set and
Don'tPutToBeDeletedCardsFlg is non-nil, then don't put it down to the file even if changes were made.
Just throw away its cache.)
(* * rht 10/17/86: Now passes non-nil NoOrphanHookFlg to NC.DeleteLink unless destination card is marked as about
to be deleted.)
(* * rht 11/4/86: Now takes Don'tCreateDeletedImageObjFlg arg.)
(* * rht 11/13/86: Undid change of 11/4/86. Now passes non-nil Don'tDelLinkIconFlg to NC.DeleteLink instead like it
used to.)
(* * rht 11/14/86: Avoids call to NC.GetNoteCard for cards about to be deleted.)
(* * rht 12/16/86: Removed obsolete Don'tPutToBeDeletedCardsFlg arg.)
(LET (DestCardsw/oLinksCached NumLinksToDelete)
(* * For each destination card, make sure its links are cached. At the same time, collect these cards for future
uncaching.)
(SETQ DestCardsw/oLinksCached (for Link in ListOfLinks bind DestCard
when [NOT (NC.LinksCachedP (SETQ DestCard
(fetch (Link
DestinationCard)
of Link]
collect (NC.GetLinks DestCard)
DestCard))
(* * Sort the List of links so that links with same source cards bunch together.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Sorting " (SETQ NumLinksToDelete
(LENGTH ListOfLinks))
" links prior to deletion."))
[SORT ListOfLinks (FUNCTION (LAMBDA (Link1 Link2)
(LESSP (fetch (Card IndexLoc) of (fetch (Link SourceCard) of Link1))
(fetch (Card IndexLoc) of (fetch (Link SourceCard) of Link2]
(* * Now bring up source cards one at a time and do the delete of the links.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Deleting links: 1 out of "
NumLinksToDelete " ..."))
[for Link in ListOfLinks as i from 1 bind PreviousSourceCard WasNotActiveFlg
SavedFromLinks HadLinksCachedFlg
eachtime (BLOCK) when (NC.ValidLinkP Link)
do (OR QuietFlg (if (ZEROP (REMAINDER i 10))
then (NC.PrintMsg InterestedWindow T "Deleting links: " i
" out of "
NumLinksToDelete " ...")))
(LET ((SourceCard (fetch (Link SourceCard) of Link)))
[if (NOT (NC.SameCardP SourceCard PreviousSourceCard))
then (* Write down changes to previous card's substance.)
(if WasNotActiveFlg
then (* Have to call NC.CardSaveFn first and then
NC.QuitCard with Don'tSaveFlg to avoid
insureProperFiling check.)
(if (NC.UIDGetProp (fetch (Card UID) of
PreviousSourceCard)
(QUOTE AboutToBeDeletedFlg))
then (* Throw away cache if card about to be deleted.)
(NC.DeactivateCard PreviousSourceCard)
else (NC.CardSaveFn PreviousSourceCard T)
(NC.QuitCard PreviousSourceCard NIL T NIL NIL
NIL T))
(* Recache links for previous card if they were cached
before.)
(if HadLinksCachedFlg
then (NC.GetLinks PreviousSourceCard)))
(* Cache card and overwrite from links with previously
cached ones.)
(if [AND (SETQ WasNotActiveFlg (NOT (NC.ActiveCardP
SourceCard)))
(NOT (NC.UIDGetProp (fetch (Card UID)
of SourceCard)
(QUOTE AboutToBeDeletedFlg]
then (* Save cached from links for this card.)
(SETQ SavedFromLinks (if (SETQ HadLinksCachedFlg
(NC.LinksCachedP
SourceCard))
then (NC.FetchFromLinks
SourceCard)))
(NC.GetNoteCard SourceCard)
(if HadLinksCachedFlg
then (NC.SetFromLinks SourceCard SavedFromLinks]
(NC.DeleteLink Link (NC.UIDGetProp (fetch (Card UID)
of (fetch (Link DestinationCard)
of Link))
(QUOTE AboutToBeDeletedFlg))
(NC.UIDGetProp (fetch (Card UID)
of (fetch (Link SourceCard)
of Link))
(QUOTE AboutToBeDeletedFlg)))
(SETQ PreviousSourceCard SourceCard))
finally (if (AND WasNotActiveFlg (NC.ValidCardP PreviousSourceCard))
then (* Have to call NC.CardSaveFn first and then
NC.QuitCard with Don'tSaveFlg to avoid
insureProperFiling check.)
(if (NC.UIDGetProp (fetch (Card UID) of PreviousSourceCard)
(QUOTE AboutToBeDeletedFlg))
then (* Throw away cache if card about to be deleted.)
(NC.DeactivateCard PreviousSourceCard)
else (NC.CardSaveFn PreviousSourceCard T)
(NC.QuitCard PreviousSourceCard NIL T NIL NIL NIL T))
(* Recache links for previous card if they were cached
before.)
(if HadLinksCachedFlg
then (NC.GetLinks PreviousSourceCard]
(* * Finally, write down links for cards whose links have changed and whose links weren't cached when this function
was called.)
(for DestCard in DestCardsw/oLinksCached eachtime (BLOCK) when (
NC.FetchLinksDirtyFlg
DestCard)
do (NC.PutLinks DestCard))
(OR QuietFlg (NC.ClearMsg InterestedWindow T])
)
(* * changes to NCGRAPHCARD)
(DEFINEQ
(NC.RelayoutGraphCard
[LAMBDA (Win) (* Randy.Gobbel " 4-Mar-87 14:24")
(* * Relayout the graph by making roots out of all nodes without FROMNODES.)
(* * rht 8/15/86: Now uses proper COPYBUTTONEVENTFN in the SHOWGRAPH call.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation)
(LET ((Card (NC.CoerceToCard Win)))
(NC.ProtectedCardOperation Card "Relayout Graph Card" NIL
(LET ((Graph (WINDOWPROP Win (QUOTE GRAPH)))
GraphNodes)
(if (SETQ GraphNodes (fetch (GRAPH GRAPHNODES)
of Graph))
then
(SETQ Graph
(LAYOUTGRAPH
GraphNodes
(OR (for Node in GraphNodes
when (NULL (fetch (GRAPHNODE
FROMNODES)
of Node))
collect (fetch (GRAPHNODE NODEID)
of Node))
(fetch (GRAPHNODE NODEID)
of (CAR GraphNodes)))
(QUOTE Lattice)))
(replace (GRAPH GRAPH.ADDNODEFN) of Graph
with (FUNCTION NC.GraphAddNodeFn))
(replace (GRAPH GRAPH.DELETENODEFN) of Graph
with (FUNCTION NC.GraphDeleteNodeFn))
(replace (GRAPH GRAPH.ADDLINKFN) of Graph
with (FUNCTION NC.GraphAddLinkFn))
(replace (GRAPH GRAPH.DELETELINKFN) of Graph
with (FUNCTION NC.GraphDeleteLinkFn))
(replace (GRAPH GRAPH.MOVENODEFN) of Graph
with (FUNCTION NC.GraphMoveNodeFn))
(replace (GRAPH GRAPH.FONTCHANGEFN) of Graph
with (FUNCTION NC.GraphFontChangeFn))
(SHOWGRAPH Graph Win (FUNCTION
NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T (FUNCTION
NC.GRAPHERCOPYBUTTONEVENTFN))
(NC.InstallTitleBarButtonEventFn
Win
(FUNCTION NC.TitleBarButtonEventFn])
)
(* * changes to NCFILEBOXCARD)
(DEFINEQ
(NC.FileBoxCollectChildren
[LAMBDA (WindowOrTextStream Card NewChildren NoDisplayFlg)
(* Randy.Gobbel " 4-Mar-87 14:37")
(* * 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)
(OR Card (SETQ Card (NC.CoerceToCard WindowOrTextStream)))
(NC.ProtectedCardOperation Card "Put Cards Here" NIL
(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 NCBROWSERCARD)
(DEFINEQ
(NC.UpdateBrowserCard
[LAMBDA (Window) (* Randy.Gobbel " 4-Mar-87 16:40")
(* * 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)
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Recompute Browser Card" NIL
(PROG (LinkLabels RootCards RootNodes Lattice LinkIcon Graph GraphNodes NodeLabel
BrowserSpecs BrowserFormat DropVirtualNodesFlg Depth
SpecialBrowserSpecs OldLabelNodes OldRootCards)
(SETQ RootCards (NC.FetchBrowserRoots 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 CANCELLED))
(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 bind NodeID NodeLabel eachtime (BLOCK)
unless (FASSOC (OR (CAR (SETQ NodeID (fetch (GRAPHNODE NODEID)
of Node)))
NodeID)
Lattice)
do (COND
((NC.LinkIconImageObjP (SETQ NodeLabel (fetch (GRAPHNODE NODELABEL)
of Node)))
(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 bind NodeID OldNode eachtime (BLOCK)
do (SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
[COND
((SETQ OldNode (FASSOC NodeID GraphNodes))
(replace (GRAPHNODE NODELABEL) of Node with (fetch
(GRAPHNODE
NODELABEL)
of OldNode)))
(T (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.RelayoutBrowserCard
[LAMBDA (Window) (* Randy.Gobbel " 4-Mar-87 14:25")
(* * Called from the middle button of a browser or structeditbrowser card. This lays out and displays the browser,
but does not recompute the nodes.)
(* * rht 11/17/85: updated to handle new notefile and card objects.)
(* * rht 2/7/86: Now gets browser format, etc. via fetch/set fns.)
(* * rht 2/28/86: Added WINDOWPROP for SCROLLFN and RESHAPEFN.)
(* * rht 5/8/86: Added calls to rig title bar properly.)
(* * fgh 6/30/86 Added NC.GRAPHERCOPYBUTTONEVENTFN to SHOWGRAPH call)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Relayout Browser Card" NIL
(PROG (RootCards RootNodeIDs OldToNodePairs Graph GraphNodes BrowserFormat
DropVirtualNodesFlg SpecialBrowserSpecs)
(NC.PrintMsg Window T "Laying out graph ...")
(SETQ RootCards (NC.FetchBrowserRoots 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 SpecialBrowserSpecs (OR (CAR (NC.FetchSpecialBrowserSpecs Card))
(create SPECIALBROWSERSPECS)))
[SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph
(WINDOWPROP Window
(QUOTE
GRAPH]
(* Create hash array if haven't already.)
(NC.GetBrowserHashArray Card Graph) (* check graph node size against image box size.)
(NC.GraphLinkIconUpdateCheck Card Window Graph NIL)
(* Save the TONODES values of the nodes so can replace later after LAYOUTGRAPH call. At the same time, throw away
all the link params info in TONODES field.)
[SETQ OldToNodePairs (for Node in GraphNodes bind ToNodes eachtime
(BLOCK)
collect
(PROG1 [CONS (fetch (GRAPHNODE NODEID)
of Node)
(APPEND (SETQ ToNodes
(fetch (GRAPHNODE
TONODES)
of Node]
(replace (GRAPHNODE TONODES) of Node
with (for ToNode in ToNodes
collect
(if (EQ (CAR ToNode)
LINKPARAMS)
then (CADR ToNode)
else ToNode]
(SETQ RootNodeIDs (for RootCard in RootCards collect (NC.GetBrowserNodeID
Card RootCard)))
(NC.SetPropListDirtyFlg Card T) (* Layout graph, including as roots any non-virtual
nodes with no from nodes to avoid disconnected
graphs.)
(SETQ Graph (if GraphNodes
then (LAYOUTGRAPH
GraphNodes
(for Node in GraphNodes bind NodeID
eachtime (BLOCK)
(SETQ NodeID (fetch (GRAPHNODE NODEID)
of Node))
when (OR (AND (NULL (fetch (GRAPHNODE
FROMNODES)
of Node))
(NOT (LISTP NodeID)))
(FMEMB NodeID RootNodeIDs))
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)))
(* Replace the TONODES fields of the Graph nodes by their pre-LAYOUTGRAPH values. Also throw away any nodes that
didn't appear in the old graph.)
(if Graph
then (replace (GRAPH GRAPHNODES) of Graph
with (for Node in (fetch (GRAPH GRAPHNODES) of Graph)
bind AssocPair eachtime (BLOCK)
when (SETQ AssocPair (FASSOC (fetch (GRAPHNODE
NODEID)
of Node)
OldToNodePairs))
collect (replace (GRAPHNODE TONODES) of Node
with (CDR AssocPair))
(if DropVirtualNodesFlg
then (replace (GRAPHNODE NODEBORDER)
of Node with NIL))
(* Throw away LINKPARAMS junk from the FromNodes that
LAYOUTGRAPH stuck in.)
(replace (GRAPHNODE FROMNODES) of Node
with (for FromNode
in (fetch (GRAPHNODE FROMNODES)
of Node)
eachtime (BLOCK)
collect
(if (EQ (CAR FromNode)
LINKPARAMS)
then (CADR FromNode)
else FromNode)))
Node)))
(SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T (FUNCTION NC.GRAPHERCOPYBUTTONEVENTFN))
(* * Have to reset windowprops since SHOWGRAPH messes with them.)
(* Disable the old-style right button grapher editor
menu.)
(WINDOWPROP Window (QUOTE RIGHTBUTTONFN)
(FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window (QUOTE REPAINTFN)
(FUNCTION NC.BrowserRepaintFn)
T)
(WINDOWPROP Window (QUOTE SCROLLFN)
(FUNCTION NC.BrowserScrollFn))
(WINDOWPROP Window (QUOTE RESHAPEFN)
(FUNCTION NC.BrowserReshapeFn))
(NC.SetSubstance Card (WINDOWPROP Window (QUOTE GRAPH)))
(NC.MarkCardDirty Card)
(NC.InstallTitleBarButtonEventFn Window (FUNCTION NC.TitleBarButtonEventFn))
(NC.ClearMsg Window T])
(NC.ConnectNodesInBrowser
[LAMBDA (Window) (* Randy.Gobbel " 4-Mar-87 13:50")
(* * Draw any links, from the current link set, between any pairs of nodes currently being shown in the browser.)
(* * rht 2/7/86: Now gets and sets browser format, etc. via fetch/set fns. Also fixed one last old call to
GETPROPLIST on a NodeID.)
(* * rht 3/2/86: Added WINDOWPROP for SCROLLFN and RESHAPEFN.)
(* * fgh 5/21/86 Updated reinstallation of title bar menus after SHOWGRAPH to use new title bar menu mechanism.)
(* * rht 6/10/86: Now calls NC.ShowBrowserGraph.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Reconnect Browser Card" NIL
(PROG (LinkLabels Graph GraphNodes BrowserFormat DropVirtualNodesFlg NodeIDs)
(SETQ LinkLabels (NC.FetchBrowserLinkLabels Card))
(SETQ BrowserFormat (NC.FetchBrowserFormat Card))
(* 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 GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph
(WINDOWPROP Window
(QUOTE
GRAPH]
(* Create hash array if haven't already.)
(NC.GetBrowserHashArray Card Graph) (* check graph node size against image box size.)
(NC.GraphLinkIconUpdateCheck Card Window Graph NIL)
(* These are the workhorse loops that rebuild the
TONODES of each nonvirtual node.)
(* First smash all the nodeID's proplists and
accumulate nodeIDs.)
(SETQ NodeIDs (for Node in GraphNodes bind NodeID eachtime (BLOCK)
when (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL)
of Node))
collect (NC.SmashGraphNodeIDProps (SETQ NodeID
(
NC.CoerceToGraphNodeID
Node)))
NodeID)) (* Throw away duplicates obtained from virtual nodes.)
(SETQ NodeIDs (INTERSECTION NodeIDs NodeIDs))
(* Next accumulate all linktypes on the from node's proplist using the To node's graphnodeID as prop name.
We do the analogous thing for backward links, but notice that we ignore backward linktypes that also appear in the
list in their forward version.)
(for NodeID in NodeIDs bind RealCard
do (for Link in (NC.RetrieveToLinks (SETQ RealCard (
NC.CardFromBrowserNodeID
NodeID)))
bind DestNodeID eachtime (BLOCK) when (NC.LinkLabelP Link
LinkLabels)
when (FMEMB (SETQ DestNodeID (NC.GetBrowserNodeID
Card
(fetch (Link DestinationCard) of Link)))
NodeIDs)
do (NC.UIDAddProp NodeID DestNodeID (fetch (Link Label)
of Link)
T))
(for Link in (NC.RetrieveFromLinks RealCard) bind SourceNodeID
eachtime (BLOCK) when (AND (NC.ReverseLinkLabelP Link
LinkLabels)
(NOT (NC.LinkLabelP Link
LinkLabels)))
when (FMEMB (SETQ SourceNodeID (NC.GetBrowserNodeID
Card
(fetch (Link SourceCard) of Link)))
NodeIDs)
do (NC.UIDAddProp SourceNodeID NodeID (fetch (Link Label)
of Link)
T)))
[for Node in GraphNodes bind NodeID OldToNodeIDs eachtime (BLOCK)
unless (LISTP (SETQ NodeID (fetch (GRAPHNODE NODEID) of Node)))
when (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of Node))
do (* Accumulate the old NodeIDs, possibly virtual, from
the TONODES list.)
(SETQ OldToNodeIDs (for ToNode in (fetch (GRAPHNODE TONODES)
of Node)
collect (if (EQ (CAR ToNode)
LINKPARAMS)
then (CADR ToNode)
else ToNode)))
(* The trick here is to use a virtual node for this ToNode if one was used before, otherwise just the ToNodeID.
Also throw in the label nodes that were in the TONODES list before.)
(replace (GRAPHNODE TONODES) of Node
with (NCONC (for ToNodeID on (
NC.ComputeBrowserSavedLinkingInfoForNode
NodeID)
by (CDDR ToNodeID) eachtime (BLOCK)
collect (OR (for OldToNodeID in OldToNodeIDs
thereis
(AND (LISTP OldToNodeID)
(EQ (CAR ToNodeID)
(CAR OldToNodeID))
OldToNodeID))
(CAR ToNodeID)))
(for ToNodeID in OldToNodeIDs eachtime (BLOCK)
unless (NC.SameCardP Card (
NC.CardFromBrowserNodeID
(NC.CoerceToGraphNodeID
ToNodeID)))
collect ToNodeID]
(NC.RebuildFromNodesInGraph GraphNodes)
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph Window
DropVirtualNodesFlg))
(* Display the graph.)
(NC.ShowBrowserGraph Graph Window)
(NC.SetSubstance Card (WINDOWPROP Window (QUOTE GRAPH)))
(NC.MarkCardDirty Card)
(NC.ClearMsg Window T])
(NC.UnconnectNodesInBrowser
[LAMBDA (Window) (* Randy.Gobbel " 4-Mar-87 13:51")
(* * Remove all the links in the browser.)
(* * rht 11/17/85: Now handles new card and notefile objects.)
(* * rht 2/7/86: Now gets and sets browser format, etc. via fetch/set fns.)
(* * fgh 5/21/86 Updated reinstallation of title bar menus after SHOWGRAPH to use new title bar menu mechanism.)
(* * rht 6/10/86: Now calls NC.ShowBrowserGraph.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation Card "Unconnect Browser Card" NIL
(PROG (Graph GraphNodes BrowserFormat DropVirtualNodesFlg)
(SETQ BrowserFormat (NC.FetchBrowserFormat Card))
(* 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 GraphNodes (fetch (GRAPH GRAPHNODES)
of (SETQ Graph
(WINDOWPROP Window
(QUOTE
GRAPH]
(* smash all the nodeID's proplists and TONODES
fields.)
(for Node in GraphNodes bind NodeID
unless [PROGN (BLOCK)
(LISTP (SETQ NodeID
(fetch (GRAPHNODE
NODEID)
of Node]
do (NC.SmashGraphNodeIDProps NodeID)
(replace (GRAPHNODE TONODES) of Node
with NIL)
(replace (GRAPHNODE FROMNODES) of Node
with NIL))
(NC.MakeLinksLegend Graph Window DropVirtualNodesFlg)
(* Display the graph.)
(NC.ShowBrowserGraph Graph Window)
(NC.SetSubstance Card (WINDOWPROP Window
(QUOTE GRAPH)))
(NC.MarkCardDirty Card)
(NC.SetBrowserLinksLegend Card NIL)
(NC.ClearMsg Window T])
(NC.ExpandBrowserNode
[LAMBDA (Window) (* Randy.Gobbel " 4-Mar-87 13:54")
(* * Ask user to choose a node in the browser and recompute the part of the lattice under that node to the given
depth. And relayout the graph. The code is just a modification of the NC.UpdateBrowserCard code.)
(* * rht 2/7/86: Now gets and sets browser format, etc. via fetch/set fns.)
(* * rht 6/10/86: No longer does relayout after expand. Uses NC.LayoutNewBrowserNodes to compute proper locations
of new nodes. Also calls NC.ShowBrowserGraph.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Expand Node of Browser Card" NIL
(PROG (NodeToExpand LinkLabels RootCards RootNodes Lattice LinkIcon OldToNodePairs Graph
GraphNodes NodeLabel OldNode Link BrowserSpecs BrowserFormat
DropVirtualNodesFlg Depth SpecialBrowserSpecs SavedLabelNodes
NewNodes)
(SETQ RootCards (NC.FetchBrowserRoots Card))
(SETQ LinkLabels (NC.FetchBrowserLinkLabels Card))
(SETQ BrowserFormat (NC.FetchBrowserFormat Card))
(* 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 (OR (NC.FetchSpecialBrowserSpecs Card)
(create SPECIALBROWSERSPECS)))
[SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph
(WINDOWPROP Window
(QUOTE
GRAPH]
(* If there aren't any nodes in graph, then get out
pronto.)
(if (NULL GraphNodes)
then (NC.PrintMsg Window T "No nodes to expand.")
(DISMISS 1000)
(NC.ClearMsg Window T)
(RETURN NIL)) (* Create hash array if haven't already.)
(NC.GetBrowserHashArray Card Graph)
(NC.PrintMsg Window T "Pick node to expand." (CHARACTER 13))
(* Note call to the grapher function READ/NODE to
select a graph node.)
(SETQ NodeToExpand (READ/NODE GraphNodes Window))
(* Can't expand a label node.)
(if (NOT (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of
NodeToExpand)))
then (NC.PrintMsg NIL T "Sorry, can't expand a label node.")
(FLASHW PROMPTWINDOW)
(NC.ClearMsg Window T)
(RETURN))
(SETQ Depth (MKATOM (NC.AskUser "Depth to expand (type integer or INF): "
"--"
1 T Window NIL NIL T)))
(COND
((EQ Depth (QUOTE INF))
(SETQ Depth MAX.FIXP))
((NOT (AND (FIXP Depth)
(GREATERP Depth 0)))
(NC.PrintMsg Window T "Depth must be an integer greater than 0 or INF.")
(RETURN)))
(NC.PrintMsg Window T (CHARACTER 13)
"Augmenting browser graph. Please wait. ...")
(* Save the nodes pointed to by the chosen node that
are label nodes. GrowLinkLattice will trash those, so
we restore afterwards.)
(SETQ SavedLabelNodes (for ToNode in (fetch (GRAPHNODE TONODES)
of NodeToExpand)
eachtime (BLOCK)
when (AND (NOT (EQ (CAR ToNode)
LINKPARAMS))
(NOT (NC.LinkIconImageObjP ToNode)))
collect ToNode))
(* Increase link lattice from chosen node to given
depth.)
(SETQ Lattice (NC.GrowLinkLattice (LIST (NC.CardFromBrowserNodeID
(fetch (GRAPHNODE NODEID)
of NodeToExpand)))
(APPEND GraphNodes)
LinkLabels Card Depth))
[AND SavedLabelNodes (replace (GRAPHNODE TONODES) of NodeToExpand
with (APPEND SavedLabelNodes (fetch (GRAPHNODE
TONODES)
of NodeToExpand]
(SETQ RootNodes (for RootCard in RootCards collect (NC.GetBrowserNodeID
Card RootCard)))
(NC.SetPropListDirtyFlg Card T) (* Create Links for all nodes in the new browser graph
but not in the old one.)
[for Node in Lattice bind NodeID
do (COND
((SETQ OldNode (FASSOC (SETQ NodeID (OR (NC.CoerceToGraphNodeID
Node)
(fetch (GRAPHNODE
NODEID)
of Node)))
GraphNodes))
(replace (GRAPHNODE NODELABEL) of Node with (fetch
(GRAPHNODE
NODELABEL)
of OldNode)))
(T (replace (GRAPHNODE NODELABEL) of Node
with (NC.MakeLinkIcon (NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE
NODELABEL)
of Node)
Card)))
(* Make a list of all new nodes.)
(push NewNodes Node))) (* Throw away virtual node info.)
(AND NodeID (replace (GRAPHNODE NODEID) of Node with NodeID))
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(NC.GraphNodeIDRemProp NodeID (QUOTE TouchedFlg))
(NC.GraphNodeIDRemProp NodeID (QUOTE VisitedFlg))
(* Smash all the unnecessary junk off existing nodes,
letting LAYOUTGRAPH and NC.MakeLinksLegend recompute.)
(replace (GRAPHNODE TONODES) of Node
with (for ToNode in (fetch (GRAPHNODE TONODES) of Node)
bind ToNodeID eachtime (BLOCK)
collect (if (SETQ ToNodeID (NC.CoerceToGraphNodeID
ToNode))
then
(* Throw away link parameterlist info.)
(* Throw away link dashing info.)
(NC.GraphNodeIDPutProp
NodeID ToNodeID
(for LabelPair
in (NC.GraphNodeIDGetProp
NodeID ToNodeID)
collect (OR (CAR LabelPair)
LabelPair)))
(NC.GraphNodeIDPutProp
ToNodeID NodeID
(for LabelPair
in (NC.GraphNodeIDGetProp
ToNodeID NodeID)
collect (OR (CAR LabelPair)
LabelPair)))
ToNodeID
else ToNode]
(* LAYOUTGRAPH doesn't like duplicate nodes.
These get created when virtual nodes are turned into
regular nodes.)
(SETQ Lattice (NC.RemoveDuplicateNodesFromGraph Lattice))
(NC.RebuildFromNodesInGraph Lattice)
(AND NewNodes (NC.LayoutNewBrowserNodes NodeToExpand NewNodes BrowserFormat
SpecialBrowserSpecs))
(replace (GRAPH GRAPHNODES) of Graph with Lattice)
(* Build links legend and fix up TONODES in the
graph.)
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph Window
DropVirtualNodesFlg))
(WINDOWPROP Window (QUOTE GRAPH)
Graph) (* Display the graph.)
(NC.ShowBrowserGraph Graph Window)
(NC.SetSubstance Card Graph)
(NC.MarkCardDirty Card)
(NC.ClearMsg Window T])
(NC.ChangeBrowserSpecs
[LAMBDA (Window) (* Randy.Gobbel " 4-Mar-87 13:55")
(* * Change the values of the various browser specs including link types, browser format, search depth, etc.)
(* * rht 11/17/85: Updated for new card and notefile objects.)
(* * rht 2/7/86: Now sets and gets browser link labels, etc. via fetch/set fns.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation Card "Browser Specs" NIL
(PROG (LinkLabels RootNodes BrowserSpecs BrowserFormat Depth)
(SETQ LinkLabels (NC.FetchBrowserLinkLabels Card))
(SETQ BrowserFormat (NC.FetchBrowserFormat Card))
(SETQ Depth (NC.FetchBrowserDepth Card))
(SETQ BrowserSpecs (NC.AskBrowserSpecs Window Card
LinkLabels
Depth
BrowserFormat))
(SETQ LinkLabels (CAR BrowserSpecs))
(SETQ Depth (CADR BrowserSpecs))
(SETQ BrowserFormat (CADDR BrowserSpecs))
(NC.SetPropListDirtyFlg Card T)
(NC.SetBrowserLinkLabels Card LinkLabels)
(NC.SetBrowserFormat Card BrowserFormat)
(NC.SetBrowserDepth Card Depth)
(NC.ClearMsg Window T])
(NC.MakeBrowserOverviewWin
[LAMBDA (BrowserWin Region) (* Randy.Gobbel " 4-Mar-87 13:57")
(* * Make and attach a little window to contain a shrunken bitmap of the entire browser. If Region arg is passed
then use that as size for overview win, else use defaults.)
(* * rht 3/7/86: Now uses stylesheet to figure out where to attach.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard BrowserWin)))
(NC.ProtectedCardOperation Card "Build Browser Overview" NIL
(LET ((OverviewWinWidth (if Region
then (fetch (REGION WIDTH)
of Region)
else (OR (WINDOWPROP
BrowserWin
(QUOTE
OverviewWinWidth))
NC.BrowserOverviewDefaultWidth)))
(OverviewWinHeight (if Region
then (fetch (REGION HEIGHT)
of Region)
else (OR (WINDOWPROP
BrowserWin
(QUOTE
OverviewWinHeight))
NC.BrowserOverviewDefaultHeight)))
[OverviewWin (OPENWP (WINDOWPROP BrowserWin
(QUOTE
BrowserOverviewWin]
(WhereToAttach (OR (WINDOWPROP BrowserWin (QUOTE
WHERETOATTACHOVERVIEWWIN))
NC.DefaultWhereToAttachOverviewWin)))
(if OverviewWin
else (* Make a new overview window.)
(SETQ OverviewWin
(CREATEW (CREATEREGION (fetch (POSITION
XCOORD)
of
NC.OffScreenPosition)
(fetch (POSITION
YCOORD)
of
NC.OffScreenPosition)
OverviewWinWidth
OverviewWinHeight)))
(WINDOWPROP BrowserWin (QUOTE
BrowserOverviewWin)
OverviewWin))
(NC.ReattachBrowserOverviewWin OverviewWin BrowserWin
WhereToAttach)
(NC.RedrawBrowserOverviewWin OverviewWin BrowserWin])
(NC.AskBrowserOverviewSpecs
[LAMBDA (BrowserWin) (* Randy.Gobbel " 4-Mar-87 14:00")
(* * Put up stylesheet to get mode and where to attach overview win.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard BrowserWin)))
(NC.ProtectedCardOperation Card "Browser Overview Specs" NIL
(LET ((WhereLastAttached (OR (WINDOWPROP BrowserWin
(QUOTE
WHERETOATTACHOVERVIEWWIN))
NC.DefaultWhereToAttachOverviewWin)
)
(LastMode (OR (WINDOWPROP BrowserWin (QUOTE
OVERVIEWWINMODE))
NC.DefaultBrowserOverviewMode))
OverviewSpecsResults)
(STYLE.PROP NC.BrowserOverviewSpecsStylesheet
(QUOTE SELECTIONS)
(LIST (CAR WhereLastAttached)
(SELECTQ (CDR WhereLastAttached)
((TOP RIGHT)
(QUOTE TOP/RIGHT))
((LEFT BOTTOM)
(QUOTE BOTTOM/LEFT))
(QUOTE CENTER))
LastMode))
[STYLE.PROP NC.BrowserOverviewSpecsStylesheet
(QUOTE POSITION)
(create POSITION
XCOORD ← (fetch (REGION LEFT)
of
(WINDOWPROP
BrowserWin
(QUOTE REGION)))
YCOORD ← (fetch (REGION TOP)
of (WINDOWREGION
BrowserWin]
(if (SETQ OverviewSpecsResults (STYLESHEET
NC.BrowserOverviewSpecsStylesheet))
then (WINDOWPROP BrowserWin (QUOTE
WHERETOATTACHOVERVIEWWIN)
(CONS (CAR OverviewSpecsResults)
(CADR
OverviewSpecsResults)))
(WINDOWPROP BrowserWin (QUOTE OVERVIEWWINMODE)
(CADDR OverviewSpecsResults))
else NIL])
)
(* * changes to NCLINKINDEXCARD)
(DEFINEQ
(NC.RecomputeLinkIndex
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel " 4-Mar-87 14:31")
(* * Recompute the contents of the link index card. Modeled after NC.UpdateBrowserCard.)
(* * fgh 11/17/85 Updated to handle Card object.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard WindowOrTextStream))
Window LinkLabels BackLinksFlg PropList BrowserSpecs TextStream)
(NC.ProtectedCardOperation Card "Recompute LinkIndex" NIL (SETQ Window (NC.FetchWindow
Card))
(SETQ TextStream (TEXTSTREAM WindowOrTextStream))
(SETQ PropList (NC.FetchPropList Card))
[SETQ LinkLabels (CAR (LISTGET PropList (QUOTE
LinkIndexLinkLabels]
(SETQ BackLinksFlg (LISTGET PropList (QUOTE
LinkIndexBackLinksFlg)))
(NC.PrintMsg Window T "Clearing old contents of link index ..."
(CHARACTER 13))
[TEDIT.DELETE TextStream (TEDIT.SETSEL TextStream 1
(fetch (TEXTOBJ
TEXTLEN)
of (TEXTOBJ
TextStream]
(NC.PrintMsg Window NIL "Done." (CHARACTER 13))
(NC.ComputeLinkIndex Card LinkLabels BackLinksFlg)
(NC.ClearMsg Window T])
(NC.ChangeLinkIndexSpecs
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel " 4-Mar-87 14:32")
(* * Change the values of the various link index specs including link types and back links flag.)
(* * rht 9/19/86: Changed to pass Card rather than Window to NC.AskLinkIndexSpecs.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard WindowOrTextStream))
LinkLabels BackLinksFlg PropList LinkIndexSpecs)
(NC.ProtectedCardOperation Card "LinkIndex Specs" NIL (SETQ PropList (NC.FetchPropList
Card))
[SETQ LinkLabels (CAR (LISTGET PropList (QUOTE
LinkIndexLinkLabels]
(SETQ BackLinksFlg (LISTGET PropList (QUOTE
LinkIndexBackLinksFlg)))
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Card LinkLabels
BackLinksFlg))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs))
(NC.SetPropListDirtyFlg Card T)
(NC.PutProp Card (QUOTE LinkIndexLinkLabels)
(LIST LinkLabels))
(NC.PutProp Card (QUOTE LinkIndexBackLinksFlg)
BackLinksFlg)
(NC.ClearMsg (NC.FetchWindow Card)
T])
)
(* * changes to NCINTERFACE)
(DEFINEQ
(NC.CloseNoteCards
[LAMBDA (CardIdOrCardList NoCheckFlg DontClearFlg InterestedWindow)
(* Randy.Gobbel " 9-Mar-87 18:36")
(* * 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)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(NC.ProtectedSessionOperation "Close Note Cards" InterestedWindow
(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.CloseStructure
[LAMBDA (RootCards TraversalSpecs InterestedWindow QuietFlg)
(* Randy.Gobbel " 9-Mar-87 18:33")
(* * 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)
(NC.ProtectedSessionOperation "Close Structure" InterestedWindow (SETQ RootCards (MKLIST
RootCards))
(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.DeleteStructure
[LAMBDA (RootCards TraversalSpecs InterestedWindow QuietFlg Don'tPutToBeDeletedCardsFlg)
(* Randy.Gobbel " 9-Mar-87 18:34")
(* * 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)
(NC.ProtectedSessionOperation "Delete Structure" InterestedWindow (SETQ RootCards (MKLIST
RootCards))
(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.MoveStructure
[LAMBDA (RootCards DestinationFileBox TraversalSpecs InterestedWindow QuietFlg
Don'tPutToBeDeletedCardsFlg) (* rht: " 9-Mar-87 12:38")
(* * Copy a NoteCard structure into a filebox)
(* * rht 9/2/86: Added QuietFlg and Don'tPutToBeDeletedCardsFlg args. Changed names of a few args and removed
Don'tClearFlg arg. Took out REVERSE to save time and space.)
(* * rht 3/9/87: Now accepts multiple root cards.)
(NC.DeleteNoteCards (NC.CopyStructure (MKLIST RootCards)
DestinationFileBox TraversalSpecs InterestedWindow
QuietFlg)
T NIL InterestedWindow QuietFlg NIL Don'tPutToBeDeletedCardsFlg])
(NC.DoNoteFileOp
[LAMBDA (Op) (* Randy.Gobbel " 4-Mar-87 16:14")
(* * Do a NoteFile op chosen from NC icon menu)
(* * rht 7/2/86: Now calls NC.AbortSession with NC.NoteCardsIconWindow arg.)
(* * rht 7/5/86: Added Read-only% Open entry.)
(* * rht 7/17/86: Now calls NC.InspectAndRepairNoteFile instead of NC.ScavengerPhase1.)
(* * pmi 12/4/86: Added NC.NoteCardsIconWindow argument to calls to NC.ListOfNoteFilesMenu for "Delete" and
"Rename" operations)
(* * rht 2/11/87: Now handles case when Op has unexpected value.)
(* * rht 2/16/87: Added Close% w/o% confirm case.)
(DECLARE (GLOBALVARS NC.NoteCardsIconWindow))
(SELECTQ Op
[Open% NoteFile (LET [(NoteFile (NC.ListOfNoteFilesMenu T NIL NC.NoteCardsIconWindow
(QUOTE Open% NoteFile]
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.OpenDatabaseFile NoteFile NIL NIL NIL NIL NIL NIL
NIL NIL NIL
NC.NoteCardsIconWindow]
[Read-only% Open (LET [(NoteFile (NC.ListOfNoteFilesMenu T NIL
NC.NoteCardsIconWindow
(QUOTE Open% NoteFile]
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.OpenDatabaseFile NoteFile (QUOTE INPUT)
NIL NIL NIL NIL NIL NIL NIL NIL
NC.NoteCardsIconWindow]
[Checkpoint% NoteFile (LET [(NoteFile (NC.ListOfNoteFilesMenu NIL T
NC.NoteCardsIconWindow
(QUOTE
Checkpoint% NoteFile]
(if NoteFile
then (NC.CheckpointDatabase NoteFile NIL NIL
NC.NoteCardsIconWindow]
[Close% NoteFile (LET [(NoteFile (NC.ListOfNoteFilesMenu NIL T
NC.NoteCardsIconWindow
(QUOTE Close% NoteFile]
(if NoteFile
then (NC.CloseNoteFile NoteFile NC.NoteCardsIconWindow]
[Close% w/o% confirm (LET [(NoteFile (NC.ListOfNoteFilesMenu NIL T
NC.NoteCardsIconWindow
(QUOTE
Close% NoteFile]
(if NoteFile
then (NC.CloseNoteFile NoteFile
NC.NoteCardsIconWindow NIL T]
[Abort% NoteFile (LET [(NoteFile (NC.ListOfNoteFilesMenu NIL T
NC.NoteCardsIconWindow
(QUOTE Abort% NoteFile]
(if NoteFile
then (NC.AbortSession NoteFile NC.NoteCardsIconWindow]
[Compact% NoteFile (LET [(NoteFile (NC.ListOfNoteFilesMenu T NIL
NC.NoteCardsIconWindow
(QUOTE
Compact% NoteFile]
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.CompactNoteFile NoteFile NIL NIL
NC.NoteCardsIconWindow]
[Compact% In% Place (LET [(NoteFile (NC.ListOfNoteFilesMenu T NIL
NC.NoteCardsIconWindow
(QUOTE
Compact% NoteFile]
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.CompactNoteFile NoteFile NIL T
NC.NoteCardsIconWindow]
[Inspect&Repair% NoteFile (LET [(NoteFile (NC.ListOfNoteFilesMenu T NIL
NC.NoteCardsIconWindow
(QUOTE
Inspect&Repair% NoteFile]
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.InspectAndRepairNoteFile NoteFile NIL
NC.NoteCardsIconWindow]
[Read% Substances (LET [(NoteFile (NC.ListOfNoteFilesMenu T NIL
NC.NoteCardsIconWindow
(QUOTE
Inspect&Repair% NoteFile]
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.InspectAndRepairNoteFile NoteFile T
NC.NoteCardsIconWindow]
[Copy% NoteFile (LET [(NoteFile (NC.ListOfNoteFilesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE Copy% NoteFile]
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.CopyNoteFile NoteFile NIL NC.NoteCardsIconWindow]
[Rename% NoteFile (LET [(NoteFile (NC.ListOfNoteFilesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE Rename% NoteFile]
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.RenameNoteFile NoteFile NIL
NC.NoteCardsIconWindow]
[Delete% NoteFile (LET [(NoteFile (NC.ListOfNoteFilesMenu T (QUOTE CLOSED)
NC.NoteCardsIconWindow
(QUOTE Delete% NoteFile]
(if (NULL NoteFile)
then NIL
else (if (EQ NoteFile (QUOTE NEW))
then (SETQ NoteFile NIL))
(NC.DeleteDatabaseFile NoteFile
NC.NoteCardsIconWindow]
(Create% NoteFile (NC.CreateDatabaseFile NIL NIL NIL NIL NIL NIL
NC.NoteCardsIconWindow))
(LET [(NoteFile (NC.ListOfNoteFilesMenu NIL T NC.NoteCardsIconWindow (QUOTE
Close% NoteFile]
(if NoteFile
then (APPLY* Op NoteFile NC.NoteCardsIconWindow])
(NC.FileBrowserCheckpoint
[LAMBDA (Browser Key Item Menu) (* Randy.Gobbel " 4-Mar-87 16:13")
(* * Function called from file browser menu for notefile checkpoint.)
(* * rht 7/2/86: Now passes InterestedWindow arg to NC.CheckpointDatabase.)
(for FileObject in (FB.SELECTEDFILES Browser)
do (LET* ((FileName (MKATOM (FB.FETCHFILENAME FileObject)))
(NoteFile (NC.NoteFileFromFileName FileName)))
(if (type? NoteFile NoteFile)
then (NC.CheckpointDatabase NoteFile NIL NIL (fetch (FILEBROWSER
PROMPTWINDOW)
of Browser))
else (NC.PrintMsg NIL NIL FileName " is not an open NoteFile!!!"
(CHARACTER 13])
(NC.NoteFileTitleLeftWhenSelectedFn
[LAMBDA (Item Menu Button) (* Randy.Gobbel " 4-Mar-87 16:20")
(* * WhenSelectedFn for the menus NC.OpenedNoteFileMenu and NC.ClosedNoteFileMenu. These operations used to be
performed by NC.NoteFileOperations. Provides faster Left-button title bar menu on NoteFile icons.)
(* * rht 2/11/87: Now handles possibly extra unanticipated menu items.)
(* * rht 2/11/87: Removed useless call to DEFAULTWHENSELECTEDFN.)
(* * rht 2/16/87: Added Close% cards% w/o% confirm case.)
(DECLARE (GLOBALVARS NC.NoteFilesHashArray NC.NoteFileIconCloseOperations
NC.NoteFileIconOpenOperations NC.MsgDelay))
(LET ((NoteFile (GETMENUPROP Menu (QUOTE NoteFile)))
(Operation (CAR Item))
NoteFileMenuWindow)
(SETQ NoteFileMenuWindow (WFROMMENU (fetch (NoteFile Menu) of NoteFile)))
(WINDOWPROP NoteFileMenuWindow (QUOTE BusyOperation)
Operation)
(COND
((AND (NC.NoteFileOpenP NoteFile)
(NOT (FMEMB Operation NC.NoteFileIconOpenOperations)))
(NC.PrintMsg NoteFileMenuWindow T "Can't " Operation " an open notefile."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg NoteFileMenuWindow T))
((AND (NOT (NC.NoteFileOpenP NoteFile))
(NOT (FMEMB (CAR Item)
NC.NoteFileIconCloseOperations)))
(NC.PrintMsg NoteFileMenuWindow T "Can't " Operation " a closed notefile."
(CHARACTER 13))
(DISMISS NC.MsgDelay)
(NC.ClearMsg NoteFileMenuWindow T))
(T (SELECTQ Operation
(Open (NC.OpenNoteFile NoteFile NC.NoteFilesHashArray NIL NIL NIL NIL NIL
NIL NIL NoteFileMenuWindow))
(Read-only% Open (NC.OpenNoteFile NoteFile NC.NoteFilesHashArray NIL NIL
NIL NIL NIL NIL NIL NoteFileMenuWindow
NIL NIL NIL T))
(Checkpoint (NC.CheckpointNoteFile NoteFile NIL NIL NoteFileMenuWindow))
(Close (NC.CloseNoteFile NoteFile NoteFileMenuWindow))
(Close% w/o% confirm (NC.CloseNoteFile NoteFile NoteFileMenuWindow T))
(Abort (NC.AbortSession NoteFile NoteFileMenuWindow))
(Compact (NC.CompactNoteFile NoteFile NIL NIL NoteFileMenuWindow))
(Compact% To% Target% File (NC.CompactNoteFile NoteFile NIL NIL
NoteFileMenuWindow))
(Compact% In% Place (NC.CompactNoteFile NoteFile NIL T NoteFileMenuWindow))
(Inspect&Repair (NC.InspectAndRepairNoteFile NoteFile NIL
NoteFileMenuWindow))
(Read% Substances (NC.InspectAndRepairNoteFile NoteFile T
NoteFileMenuWindow))
(Copy (NC.CopyNoteFile NoteFile NIL NoteFileMenuWindow))
(Rename (NC.RenameNoteFile NoteFile))
(Delete (NC.DeleteDatabaseFile NoteFile NoteFileMenuWindow))
(APPLY* (CADR Item)
NoteFile NoteFileMenuWindow])
(NC.CloseSession
[LAMBDA (DeleteChangesFlg AutoConfirmFlg) (* Randy.Gobbel " 4-Mar-87 16:18")
(* * Checkpoint all open NoteFiles)
(* * rht 2/16/87: Now accepts AutoConfirmFlg and passes to NC.AbortSession and NC.CloseNoteFile.)
[MAPHASH NC.NoteFilesHashArray (FUNCTION (LAMBDA (Value Key)
(AND (type? NoteFile Value)
(if (AND (STREAMP (SETQ Stream (fetch (NoteFile Stream)
of Value)))
(OPENP Stream))
then (if DeleteChangesFlg
then (NC.AbortSession Value NIL AutoConfirmFlg)
else (NC.CloseNoteFile Value NIL AutoConfirmFlg]
(NC.PrintMsg NIL T "Done closing all NoteFiles."])
(NC.MoveCards
[LAMBDA (Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow)
(* Randy.Gobbel " 9-Mar-87 18:30")
(* * Move cards into a filebox by copying and deleting.)
(* * rg 3/9/87 added NC.ProtectedSessionOperation wrapper)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(NC.ProtectedSessionOperation "Move Cards" InterestedWindow
(if (NULL Cards)
then (if (NULL (SETQ Cards
(NC.SelectNoteCards NIL NIL
NC.SelectingCardsMenu NIL
"Shift-select from the same NoteFile cards to move:")))
then (ERROR!)))
(SETQ Cards (MKLIST Cards))
(NC.CopyCards Cards DestNoteFileOrFileBox RootCards QuietFlg
InterestedWindow)
(NC.DeleteNoteCards Cards T NIL InterestedWindow QuietFlg NIL])
)
(* * changes to NCPROGINT)
(DEFINEQ
(NCP.CloseCards
[LAMBDA (Cards QuietFlg) (* Randy.Gobbel " 9-Mar-87 18:39")
(* * 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)
(NC.ProtectedSessionOperation "NCP.CloseCards" NIL
(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 DON'T))
(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.UndisplayCards
[LAMBDA (Cards QuietFlg WriteChangesFlg) (* Randy.Gobbel " 4-Mar-87 14:42")
(* * If card is valid and displayed, then undisplay it but leave it cached. If WriteChangesFlg is non-nil, then
save changes to the file, otherwise saving will wait until card is uncached.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(for Card in (MKLIST Cards) do [COND
((NOT (NC.ValidCardP Card))
(NCP.ReportError (QUOTE NCP.UndisplayCards)
(CONCAT Card
" not an existing card or filebox.")))
((NOT (NCP.CardDisplayedP Card))
(NCP.PrintMsg NIL T Card
" already undisplayed: NCP.UndisplayCards"))
(T (LET ((OldProc (TTY.PROCESS)))
(PROG1 (NC.QuitCard Card T (NOT
WriteChangesFlg)
NIL NIL NIL QuietFlg T)
(AND (PROCESSP OldProc)
(TTY.PROCESS OldProc]
finally (RETURN Card])
(NCP.UncacheCards
[LAMBDA (Cards QuietFlg) (* Randy.Gobbel " 4-Mar-87 14:43")
(* * Uncache and undisplay any active cards in Cards)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(for Card in (MKLIST Cards) do (COND
((NOT (NC.ValidCardP Card))
(NCP.ReportError (QUOTE NCP.UncacheCards)
(CONCAT Card
" not an existing card or filebox.")))
((NOT (NCP.CardCachedP Card))
(NCP.ReportError (QUOTE NCP.UncacheCards)
(CONCAT Card
" must be cached before can uncache.")))
((NCP.CardDisplayedP Card)
(NCP.ReportError (QUOTE NCP.UncacheCards)
(CONCAT Card
" must be undisplayed before can uncache.")))
(T (NC.QuitCard Card NIL NIL NIL NIL NIL QuietFlg])
(NCP.CloseNoteFiles
[LAMBDA (NoteFilesOrT QuietFlg AutoConfirmFlg) (* Randy.Gobbel " 4-Mar-87 16:16")
(* * Prog's intface function for closing a notefile.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 7/7/86: Now takes list of notefiles. If arg is T, then close all open notefiles.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * 11/16/86: Now calls NC.CloseNoteFile instead of NC.CloseDatabaseFile.)
(* * rht 2/16/87: Now takes AutoConfirmFlg and passes to NC.CloseNoteFile.)
(for NoteFile in (if (EQ NoteFilesOrT T)
then (NCP.ListOfOpenNoteFiles)
else (MKLIST NoteFilesOrT))
do (if (NOT (NCP.OpenNoteFileP NoteFile))
then (NCP.ReportError (QUOTE NCP.CloseNoteFiles)
(CONCAT "Argument " NoteFile
" is not a currently open notefile."))
NIL
else (NC.CloseNoteFile NoteFile NIL QuietFlg])
(NCP.OpenNoteFile
[LAMBDA (NoteFileOrFileName Don'tCreateFlg Convertw/oConfirmFlg QuietFlg MenuPosition ReadOnlyFlg
Don'tCreateInterfaceFlg) (* Randy.Gobbel " 4-Mar-87 16:27")
(* * Prog's intface version of opening a notefile.)
(* * rht 7/7/86: Now takes QuietFlg and MenuPosition arg. Takes either NoteFile object or file name.)
(* * rht 7/16/86: Added ReadOnlyFlg arg.)
(* * rht 7/26/86: Added Don'tCreateInterfaceFlg)
(* * Fix to bug %#391: Now calls NC.OpenNoteFile instead of NC.OpenDatabaseFile.)
(if (type? NoteFile NoteFileOrFileName)
then (NC.OpenNoteFile NoteFileOrFileName NIL NIL Don'tCreateFlg Convertw/oConfirmFlg NIL
NIL Don'tCreateInterfaceFlg NIL NIL NIL MenuPosition QuietFlg
(AND ReadOnlyFlg (QUOTE INPUT))
NIL)
else (LET ((FileNameWithExt (NC.DatabaseFileName "Name of NoteFile to open:" " -- " T NIL
NoteFileOrFileName)))
(AND FileNameWithExt
(NC.OpenNoteFile FileNameWithExt NIL NIL Don'tCreateFlg
Convertw/oConfirmFlg NIL NIL Don'tCreateInterfaceFlg NIL
NIL NIL MenuPosition QuietFlg (AND ReadOnlyFlg
(QUOTE INPUT))
NIL])
)
(* * changes to NCREPAIR)
(DEFINEQ
(NC.MessageWinAttachedMenuWhenSelectedFn
[LAMBDA (Item Menu MouseKey) (* Randy.Gobbel " 4-Mar-87 16:11")
(* * Called when selecting from the attached menu to the main message window.)
(* * rht 9/17/85: Now gets MaxIDNum from WINDOWPROP of MessageWin and uses it for looping through cards.)
(* * rht 12/8/85: Modified to reflect new card and notefile object fomats.)
(* * rht 3/22/86: Took out NOTIFY.EVENT stuff since NC.ScavengerPhase1 is no longer hanging on completion of phase
3.0)
(* * rht 7/16/86: Added NC.AttachPromptWindow calls.)
(LET ((MenuWin (WFROMMENU Menu))
(Operation (CAR Item))
MessageWin NoteFile InspectorWins BadNewsList ExtraBadNews)
(SETQ MessageWin (MAINWINDOW MenuWin))
(SETQ NoteFile (WINDOWPROP MessageWin (QUOTE NOTEFILE)))
(SETQ BadNewsList (WINDOWPROP MessageWin (QUOTE BADNEWSLIST)))
(SETQ ExtraBadNews (WINDOWPROP MessageWin (QUOTE EXTRABADNEWS)))
(SELECTQ Operation
(Abort (if (NC.AskYesOrNo
"Do you really want to abort the Inspect & Repair process? "
NIL
(QUOTE Yes)
T
(NC.AttachPromptWindow MessageWin)
NIL NIL)
then (* Bail out.)
(WINDOWDELPROP MessageWin (QUOTE CLOSEFN)
(FUNCTION NC.MessageWinCloseFn))
(CLOSEW MessageWin)
(NC.ScavengerCleanup MessageWin)))
(Recheck% Bad% Cards (* Rerun the end of phase1.)
(DETACHWINDOW MenuWin)
(CLOSEW MenuWin)
(NC.ScavengerPhase1 NoteFile NIL MessageWin T
(NC.AttachPromptWindow MessageWin)))
(Inspect% Cards (* Bring up the big card inspector menu.)
(DETACHWINDOW MenuWin)
(CLOSEW MenuWin)
(NC.BuildCardInspectorMenu
[NC.MapCards NoteFile (FUNCTION [LAMBDA (Card)
Card])
(FUNCTION (LAMBDA (Card)
(AND (FMEMB (NC.FetchStatus Card)
(QUOTE (ACTIVE BADPOINTER
NIL)))
(NOT (NC.WorthlessCardP Card]
(APPEND ExtraBadNews BadNewsList)
NoteFile MessageWin))
(Include% Deleted% Cards (* Like above except include also the deleted cards.)
(DETACHWINDOW MenuWin)
(CLOSEW MenuWin)
(NC.BuildCardInspectorMenu
[NC.MapCards NoteFile (FUNCTION [LAMBDA (Card)
Card])
(FUNCTION (LAMBDA (Card)
(AND (FMEMB (NC.FetchStatus
Card)
(QUOTE
(ACTIVE BADPOINTER
NIL DELETED)
))
(NOT (NC.WorthlessCardP
Card]
(APPEND ExtraBadNews BadNewsList)
NoteFile MessageWin))
[Continue% Repair (* If changes were made, then checkpoint the
notefile.)
(if (NEQ (NC.CheckForBadLinksAndTitlesAndPropLists
NoteFile
MessageWin
BadNewsList)
(QUOTE ABORT))
then (if (WINDOWPROP MessageWin (QUOTE
NEEDCHECKPOINT))
then (NC.CheckpointDatabase NoteFile NIL NIL
(
NC.AttachPromptWindow
MessageWin)))
(WINDOWDELPROP MessageWin (QUOTE CLOSEFN)
(FUNCTION NC.MessageWinCloseFn))
(CLOSEW MessageWin)
(* Rebuild the links.)
(NC.ScavengeDatabaseFile NoteFile
(WINDOWPROP
MessageWin
(QUOTE
LINKSLABELSNEWS))
(WINDOWPROP
MessageWin
(QUOTE BADBOXES))
(WINDOWPROP
MessageWin
(QUOTE
CARDSWITHLINKSRESET))
(WINDOWPROP
MessageWin
(QUOTE
INTERESTEDWINDOW]
(End% Inspect&Repair (* Don't have to scavenge links.
Close up gracefully.)
(NC.CheckForBadLinksAndTitlesAndPropLists NoteFile
MessageWin
BadNewsList)
(WINDOWDELPROP MessageWin (QUOTE CLOSEFN)
(FUNCTION NC.MessageWinCloseFn))
(CLOSEW MessageWin)
(NC.CloseDatabaseFile NoteFile))
NIL])
(NC.ScavengerPhase1
[LAMBDA (FileNameOrNoteFile ReadSubstancesFlg ScavengerInteractionWin RecheckBadCardsFlg
InterestedWindow) (* Randy.Gobbel " 4-Mar-87 16:26")
(* * This is the first phase of the scavenger. Runs over entire data portion of the notefile, accumulating pointers
to healthy parts of cards. Then runs over index array asking user what to do with bad or outdated pointers.
If ReadSubstancesFlg is non-nil then it'll do robust gets of the substances. This slows things down, but makes
checking more comprehensive.)
(* * rht 12/7/85: Updated to handle new notefile and card object formats.)
(* * rht 3/22/86: No longer hangs bad cards off proplist of Reason atoms. Uses local var ReasonsHashArray instead.
NC.ScavengerPhase1 no longer hanging on completion of phase 3)
(* * rht 7/7/86: Now passes non-nil Don'tCheckOperationInProgress flg to NC.OpenDatabaseFile.)
(* * rht 7/16/86: Added InterestedWindow arg.)
(* * rht 9/16/86: Changed call to NC.OpenDatabaseFile so that it won't try to get special cards.)
(* * rht 10/31/86: Changed call from NC.OpenDatabaseFile to NC.OpenNoteFile. Now returns non-nil if successful.)
(* * rht 11/13/86: Now passes non-nil Don'tCreateFlg to NC.OpenNoteFile.)
(* * rht 2/18/87: Added SPAWN.MOUSE call.)
(DECLARE (GLOBALVARS NC.ScavengerAttachedMenuFont NC.ScavengerInteractionWinRegion))
(PROG (FileName NoteFile UnknownCardTypesList ReasonsList ReasonsHashArray CardsToDelete Menu
MenuItems LinkLabelsNews CardTotal BadNewsList BadBoxes ExtraBadNews
FirstTimeFlg InspectorPendingEvent NoteFileMenu NoteFileOpsMenuItem
CanDoPhase3Flg NoteFileStream)
(* * First, take care of opening notefile if needed.)
(SPAWN.MOUSE)
(if (AND (type? NoteFile FileNameOrNoteFile)
(SETQ NoteFileStream (fetch (NoteFile Stream) of FileNameOrNoteFile))
(OPENP NoteFileStream))
then (* This notefile is already open For when we do
recursive call.)
(SETQ NoteFile FileNameOrNoteFile)
else (* Get file name and open the file if conditions are
okay.)
(SETQ FileName FileNameOrNoteFile)
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName
"What is the name of the NoteFile to Inspect&Repair? "
NIL T NIL NIL
InterestedWindow)))
(RETURN NIL))
(AND (NULL (SETQ NoteFile
(NC.OpenNoteFile FileName NIL T T NIL NIL NIL T T
InterestedWindow NIL NIL NIL NIL T)))
(NC.PrintMsg InterestedWindow NIL "Couldn't open " FileName "."
(CHARACTER 13)
"Repair aborted.")
(RETURN NIL))
(NC.ClearMsg InterestedWindow T))
(SETQ CardTotal (SUB1 (fetch (NoteFile NextIndexNum) of NoteFile)))
(* Build a window for talking to the user if one
wasn't passed in.)
(if (WINDOWP ScavengerInteractionWin)
then (CLEARW ScavengerInteractionWin)
else (SETQ ScavengerInteractionWin (CREATEW NC.ScavengerInteractionWinRegion
"Inspect&Repair Interaction Window"
NIL T))
(* This flg indicates that we're in the first call to
the scavenger.)
(SETQ FirstTimeFlg T)
(WINDOWADDPROP ScavengerInteractionWin (QUOTE CLOSEFN)
(FUNCTION NC.MessageWinCloseFn)
T)) (* Stash InterestedWindow for calls to phase 3 under
menu whenselected fn.)
(OR (WINDOWPROP ScavengerInteractionWin (QUOTE INTERESTEDWINDOW))
(WINDOWPROP ScavengerInteractionWin (QUOTE INTERESTEDWINDOW)
InterestedWindow)) (* Get all relevant info about the data area of the
notefile onto the cards' prop lists.)
(if (OR (NOT FirstTimeFlg)
(EQ (NC.GetScavengerInfo NoteFile ReadSubstancesFlg
ScavengerInteractionWin InterestedWindow)
(QUOTE SUCCESS)))
then (WINDOWPROP ScavengerInteractionWin (QUOTE NOTEFILE)
NoteFile)
(WINDOWPROP ScavengerInteractionWin (QUOTE CARDTOTAL)
CardTotal)
else (* Something's wrong. Couldn't get scavenger info.
Bail out.)
(NC.ScavengerCleanup ScavengerInteractionWin InterestedWindow)
(CLOSEW ScavengerInteractionWin)
(RETURN NIL))
(* * Check the list of card types that are undefined to see if user has loaded a definition since the last time we
checked. If he has, then go try to read the substance card parts for those newly defined card types.)
(NC.CheckUnknownCardTypes NoteFile ReadSubstancesFlg ScavengerInteractionWin)
(* * Next step is to run down the in-core index and find those cards having pointers to bad items in the data area.
We also need to look for undefined card types and for pointers past the checkpoint pointer.
However, we can reuse old bad news list if nothing has changed.)
[if (OR FirstTimeFlg RecheckBadCardsFlg (WINDOWPROP ScavengerInteractionWin
(QUOTE NEEDCHECKPOINT)))
then (WINDOWPROP ScavengerInteractionWin (QUOTE ORIGINALBADNEWSLIST)
(SETQ BadNewsList (NC.BuildBadCardsList NoteFile
ScavengerInteractionWin
FirstTimeFlg
InterestedWindow)))
else (SETQ BadNewsList (WINDOWPROP ScavengerInteractionWin (QUOTE
ORIGINALBADNEWSLIST]
(* * Okay, now all the troublesome IDs and the reasons for their troubles are recorded in BadNewsList.
We next need to get directives from the user as to what to do for each problem card.)
(NC.RepositionWindowIfNeeded ScavengerInteractionWin)
(* If there's bad news for link labels then take off
list and store in a local var.)
(if (SETQ LinkLabelsNews (for BadCardEntry in BadNewsList
bind (LinkLabelsCard ← (fetch (NoteFile
LinkLabelsCard)
of NoteFile))
eachtime (BLOCK) when (NC.SameCardP
LinkLabelsCard
(CAR
BadCardEntry))
do (RETURN BadCardEntry)))
then (SETQ BadNewsList (DREMOVE LinkLabelsNews BadNewsList)))
(* Accumulate general statistics on the problems.)
(SETQ ReasonsHashArray (HASHARRAY 100))
[for BadNews in BadNewsList bind Card Type eachtime (BLOCK)
unless (FMEMB (CADR BadNews)
(QUOTE (DELETED FREE)))
do (SETQ Card (CAR BadNews))
(for Reason in (CDDDR BadNews) eachtime (BLOCK)
do (PUTHASH Reason (CONS Card (GETHASH Reason ReasonsHashArray))
ReasonsHashArray)
(if (NOT (FMEMB Reason ReasonsList))
then (SETQ ReasonsList (CONS Reason ReasonsList)))
(if (EQ Reason (QUOTE UNKNOWNCARDTYPE))
then (* Accumulate the list of unknown card types for
nondeleted cards.)
(if (NOT (FMEMB (SETQ Type (
NC.FetchTypeFromScavengerInfo
Card))
UnknownCardTypesList))
then (push UnknownCardTypesList Type]
(* Build the menu entries that we know will be present
regardless of which cards are bad.)
[SETQ MenuItems (QUOTE ((Abort (QUOTE Abort)
"Quit this Inspect&Repair operation.")
(Recheck% Bad% Cards (QUOTE Recheck% Bad% Cards)
"Recompute bad cards list. Useful if you've just loaded some card type definitions.")
(Inspect% Cards (QUOTE Inspect% Cards)
"Bring up the cards inspector menu."
(SUBITEMS (Include% Deleted% Cards
(QUOTE Include% Deleted% Cards)
"Throw in deleted cards as well."]
(* Print a message if news on link labels is worse
than just past checkpoint.)
(if [AND LinkLabelsNews (NOT (EQUAL (CDDDR LinkLabelsNews)
(QUOTE (MAINDATAPASTCHKPT]
then (push ExtraBadNews LinkLabelsNews)
(NC.PrintMsg ScavengerInteractionWin NIL "The link types are bad."
(CHARACTER 13)
"If you don't back them up to a previous version, then phase 3 of Inspect&Repair will rebuild them."
(CHARACTER 13))
(WINDOWPROP ScavengerInteractionWin (QUOTE NEEDLINKSCAVENGE)
T)) (* Collect any fileboxes that have bad substances.)
(if (SETQ BadBoxes (LET (Boxes)
(SETQ BadNewsList
(for News in BadNewsList bind Box eachtime
(BLOCK)
unless (if (AND (EQ (
NC.FetchTypeFromScavengerInfo
(SETQ Box (CAR News)))
(QUOTE FileBox))
(FMEMB (QUOTE BADMAINDATA)
(CDDDR News)))
then (push Boxes Box)
(* If nothing else is wrong with those boxes, then
take off bad news list.)
(EQ (LENGTH (CDDDR News))
1)
else NIL)
collect News))
Boxes))
then (NC.PrintMsg ScavengerInteractionWin NIL "Fileboxes "
(for Box in BadBoxes collect (
NC.FetchTitleFromScavengerInfo
Box))
" have bad substance(s)."
(CHARACTER 13)
"If you don't delete them or back up to a previous version, then phase 3 of Inspect&Repair will rebuild their contents."
(CHARACTER 13))
(WINDOWPROP ScavengerInteractionWin (QUOTE NEEDLINKSCAVENGE)
T)) (* Print out totals of active and deleted cards.)
(LET ((ActivesTotal 0)
(DeletedsTotal 0))
[NC.MapCards NoteFile (FUNCTION (LAMBDA (Card)
(SELECTQ (NC.FetchStatus Card)
(ACTIVE (SETQ ActivesTotal (ADD1 ActivesTotal)))
(DELETED (SETQ DeletedsTotal (ADD1 DeletedsTotal)))
NIL]
(NC.PrintMsg ScavengerInteractionWin NIL "Out of " CardTotal " cards:"
(CHARACTER 13)
"there are " ActivesTotal " active cards and " DeletedsTotal
" deleted cards."
(CHARACTER 13)))
(if ReasonsList
then (* Print out messages for bad cards.)
(NC.PrintMsg ScavengerInteractionWin NIL "Of the non-deleted ones,"
(CHARACTER 13))
[for Reason in ReasonsList eachtime (BLOCK)
do (NC.PrintMsg ScavengerInteractionWin NIL (LENGTH (GETHASH Reason
ReasonsHashArray))
" have "
(GETPROP Reason (QUOTE ReasonString))
(CHARACTER 13))
(if (EQ Reason (QUOTE UNKNOWNCARDTYPE))
then (NC.PrintMsg ScavengerInteractionWin NIL
"The unknown types are: "
UnknownCardTypesList "." (CHARACTER 13]
else (NC.PrintMsg ScavengerInteractionWin NIL "All non-deleted cards look okay."
(CHARACTER 13)))
(* Only allow continuation to phase 3 of repair, links rebuilding, if there's no bad news that can't be fixed.
We can fix bad proplist, titles or links. We can also fix even bad substances if they're for fileboxes.)
(if [for News in BadNewsList eachtime (BLOCK)
unless (FMEMB (CADR News)
(QUOTE (DELETED FREE)))
unless (EQ (NC.FetchTypeFromScavengerInfo (CAR News))
(QUOTE FileBox))
never (INTERSECTION (CDDDR News)
(QUOTE (BADMAINDATA UNKNOWNCARDTYPE]
then (* Add the appropriate menu items.)
(if (NOT (WINDOWPROP ScavengerInteractionWin (QUOTE NEEDLINKSCAVENGE)))
then (SETQ MenuItems (CONS (QUOTE (End% Inspect&Repair
(QUOTE End% Inspect&Repair)
"This exits Inspect&Repair normally, closing the notefile."))
MenuItems)))
(SETQ CanDoPhase3Flg T)
(SETQ MenuItems (CONS (QUOTE (Continue% Repair (QUOTE Continue% Repair)
"Complete Inspect&Repair by rebuilding the links."))
MenuItems)))
(* Make sure a checkpoint will happen before
continuing to phase 3 if there are any card parts
beyond the checkpt pointer.)
(if (INTERSECTION ReasonsList (QUOTE (MAINDATAPASTCHKPT LINKSPASTCHKPT
TITLEPASTCHKPT
PROPLISTPASTCHKPT)))
then (AND CanDoPhase3Flg (NC.PrintMsg ScavengerInteractionWin NIL
"'Continue Repair' will integrate any card part versions beyond chkpt pointer."
(CHARACTER 13)))
(WINDOWPROP ScavengerInteractionWin (QUOTE NEEDCHECKPOINT)
T)) (* Ugliness! Have to cache all these vars on window so
that attached menu's whenselectedfn will be able to
grab them.)
(WINDOWPROP ScavengerInteractionWin (QUOTE BADNEWSLIST)
BadNewsList)
(WINDOWPROP ScavengerInteractionWin (QUOTE EXTRABADNEWS)
ExtraBadNews)
(WINDOWPROP ScavengerInteractionWin (QUOTE LINKSLABELSNEWS)
LinkLabelsNews)
(WINDOWPROP ScavengerInteractionWin (QUOTE BADBOXES)
BadBoxes)
(ATTACHMENU (create MENU
ITEMS ← MenuItems
WHENSELECTEDFN ← (FUNCTION
NC.MessageWinAttachedMenuWhenSelectedFn)
MENUFONT ← NC.ScavengerAttachedMenuFont)
ScavengerInteractionWin
(QUOTE RIGHT)
(QUOTE TOP))
(RETURN NoteFile])
)
(* * changes to NCUTILITIES)
(DEFINEQ
(NC.AskUser
[LAMBDA (Msg Prompt FirstTry ClearFirstFlg MainWindow DontCloseAtEndFlg DontClearAtEndFlg
PROMPTFORWORDFlg) (* Randy.Gobbel " 6-Mar-87 12:22")
(* Get a response from the user -
using the promptwindow attached to MainWindow)
(* * rht 9/16/84: Added DontClearAtEndFlg which if non-nil prevents the call to NC.ClearMsg.)
(* * rht 5/22/85: Now uses TTYIN instead of PROMPTFORWORD so that people can edit their answer.)
(* * rht 5/30/85: Added PROMPTFORWORDFlg so callers doing yes/no questions can get old style PROMPTFORWORD
functionality.)
(* * rht 8/6/85: Wrapped TTYIN with NLSETQ so wouldn't break if CR inadvertantly inserted in string.)
(* * fgh 5/22/86 Added handling of COPYBYBKSYSBUF so that user can shift select into prompt windows being called
from TEdit main windows.)
(* * fgh 6/27/86 Added ERROR! is problems under TTYIN NLSETQ. Allows other process to kill the askuser process.)
(LET (AskWindow TextObj)
(RESETLST
(* * If MainWindow is a TEdit window, make sur we can shift select into the prompt window.)
(RESETSAVE (SETQ AskWindow (NC.PrintMsg MainWindow ClearFirstFlg Msg))
(BQUOTE (NC.AskUserResetWindow , AskWindow , MainWindow ,
DontClearAtEndFlg ,
DontCloseAtEndFlg)))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
[if (SETQ TextObj (WINDOWPROP MainWindow (QUOTE TEXTOBJ)))
then (RESETSAVE (TEXTPROP TextObj (QUOTE COPYBYBKSYSBUF)
T)
(BQUOTE (TEXTPROP , TextObj COPYBYBKSYSBUF ,
(TEXTPROP TextObj (QUOTE
COPYBYBKSYSBUF]
(* * Go ahead and ask)
(PROG1 (if PROMPTFORWORDFlg
then (TTY.PROCESS (THIS.PROCESS))
(PROMPTFORWORD Prompt FirstTry
"To type a ?, type CTRL-V followed by a ?."
AskWindow NIL NIL (CHARCODE (EOL)))
else (RESETFORM (TTYDISPLAYSTREAM AskWindow)
(CAR (OR [NLSETQ
(TTYIN (MKLIST (OR Prompt "")
)
NIL NIL
(QUOTE (STRING NORAISE))
NIL NIL
(AND FirstTry
(LIST FirstTry]
(PROGN (WINDOWPROP AskWindow
(QUOTE
PROCESS)
NIL)
(OR DontClearAtEndFlg
(NC.ClearMsg
MainWindow
(NULL
DontCloseAtEndFlg)))
(ERROR!])
)
(* * New for NCUTILITIES)
(DEFINEQ
(NC.AskUserResetWindow
[LAMBDA (AskWindow MainWindow DontClearAtEndFlg DontCloseAtEndFlg)
(* Randy.Gobbel " 6-Mar-87 12:21")
(* * called from RESETRESTORE to blow away prompt window, unless flags tell us not to)
(* * rg 3/6/87 created)
(* * Setting the PromptWindow PROCESS to NIL is to break a circularity caused by TEXTOBJ -> PROMPTWINDOW -> PROCESS
-> TEXTSTREAM -> TEXTOBJ)
(WINDOWPROP AskWindow (QUOTE PROCESS)
NIL)
(OR DontClearAtEndFlg (NC.ClearMsg MainWindow (NULL DontCloseAtEndFlg])
)
(* * New for NCDATABASE)
(DECLARE: EVAL@COMPILE
[DEFMACRO NC.ProtectedSessionOperation (Operation InterestedWindow &REST Body)
(BQUOTE (RESETLST (OBTAIN.MONITORLOCK NC.LockLock)
(LET ((OpInProgress (NC.SessionCheckOpInProgress)))
(if (NULL OpInProgress)
then
(RESETSAVE NC.SessionProcessInProgress (THIS.PROCESS))
(RESETSAVE NC.SessionOperationInProgress , Operation))
(RELEASE.MONITORLOCK NC.LockLock)
(if (OR (NULL OpInProgress)
(EQ OpInProgress (QUOTE US)))
then ,@ Body else (NC.PrintOperationInProgressMsg ,
InterestedWindow ,
Operation
OpInProgress)
(QUOTE DON'T]
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.LockLock NC.SessionProcessInProgress NC.SessionOperationInProgress NC.NoteFileBusyList
NC.CardBusyList)
)
(RPAQ? NC.LockLock (CREATE.MONITORLOCK "NoteCards Meta-lock"))
(RPAQ? NC.SessionProcessInProgress NIL)
(RPAQ? NC.SessionOperationInProgress NIL)
(RPAQ? NC.NoteFileBusyList NIL)
(RPAQ? NC.CardBusyList NIL)
(DEFINEQ
(NC.CardCheckOpInProgress
[LAMBDA (Card) (* Randy.Gobbel " 6-Mar-87 12:04")
(* * Return the operation in progress if any. Checks session level, then NoteFile level, then Card level.
Returns NIL if there is no conflict at any level, otherwise a string describing the conflicting operation.
THIS PROCEDURE IS INTERNAL TO THE NOTECARDS GLOBAL MONITOR!)
(* * rg 3/3/87 First created.)
(LET (ProcInProgress)
(COND
[(PROCESSP (SETQ ProcInProgress NC.SessionProcessInProgress))
(* someone doing a session op, check to see if it's
us)
(COND
((NEQ ProcInProgress (THIS.PROCESS)) (* if someone else has the session lock, return that
op)
NC.SessionOperationInProgress)
(T (* we have the session lock)
(QUOTE US]
[[PROCESSP (SETQ ProcInProgress (NC.NoteFileProp (fetch (Card NoteFile)
of Card)
(QUOTE ProcessInProgress]
(* someone doing a NF op, check to see if it's us)
(COND
((NEQ ProcInProgress (THIS.PROCESS)) (* if someone else has the NF lock, return that op)
(NC.NoteFileProp (fetch (Card NoteFile) of Card)
(QUOTE OperationInProgress)))
(T (* we have the NF lock)
(QUOTE US]
[[PROCESSP (SETQ ProcInProgress (NC.FetchUserDataProp Card (QUOTE
ProcessInProgress]
(* if someone has the card lock, see if it's us)
(COND
((NEQ ProcInProgress (THIS.PROCESS)) (* if someone else has the card lock, return that op)
(NC.FetchUserDataProp Card (QUOTE OperationInProgress)))
(T (* we have the card lock)
(QUOTE US]
(T (* all relevant locks are free)
NIL])
(NC.NoteFileCheckOpInProgress
[LAMBDA (NoteFile) (* Randy.Gobbel "12-Mar-87 18:45")
(* * NoteFile level check for operation in progress. Checks session level, then NoteFile level, then Card level.
Returns NIL if there is no conflict at any level, otherwise a string describing the conflicting operation.
THIS PROCEDURE IS INTERNAL TO THE NOTECARDS GLOBAL MONITOR!)
(* * rg 3/3/87 created)
(LET (ProcInProgress CardProcessInProgressList)
(COND
((PROCESSP NC.SessionProcessInProgress) (* someone doing a session op, check to see if it's
us)
(COND
((NEQ NC.SessionProcessInProgress (THIS.PROCESS))
(* if someone else has the session lock, return that
op)
NC.SessionOperationInProgress)
(T (* we have the session lock, just return NIL)
NIL)))
([PROCESSP (SETQ ProcInProgress (NC.NoteFileProp NoteFile (QUOTE ProcessInProgress]
(* someone doing a NF op, check to see if it's us)
(COND
((NEQ ProcInProgress (THIS.PROCESS)) (* if someone else has the NF lock, return that op)
(NC.NoteFileProp NoteFile (QUOTE OperationInProgress)))
(T (* we have the NF lock, do nothing)
NIL)))
([FMEMB (THIS.PROCESS)
(SETQ CardProcessInProgressList (NC.NoteFileProp NoteFile (QUOTE
CardProcessInProgressList]
(NC.ReportError (QUOTE NC.ProtectedNoteFileOperation)
"protected NoteFile operation called from within protected card operation"))
(CardProcessInProgressList (* some card ops in progress, we lose)
"Card Operations")
(T (* all relevant locks are free)
NIL])
(NC.SessionCheckOpInProgress
[LAMBDA NIL (* Randy.Gobbel "12-Mar-87 18:44")
(* * Session level check for operation in progress. Checks session level, then NoteFile level, then Card level.
Returns NIL if there is no conflict at any level, otherwise a string describing the conflicting operation.
THIS PROCEDURE IS INTERNAL TO THE NOTECARDS GLOBAL MONITOR!)
(* * rg 3/3/87 created)
(LET (BusyList)
(COND
[(PROCESSP NC.SessionProcessInProgress) (* someone doing a session op, check to see if it's
us)
(COND
((NEQ NC.SessionProcessInProgress (THIS.PROCESS))
(* if someone else has the session lock, return that
op)
NC.SessionOperationInProgress)
(T (* we have the session lock)
(QUOTE US]
((FMEMB (THIS.PROCESS)
(SETQ BusyList NC.NoteFileBusyList))
(NC.ReportError (QUOTE NC.ProtectedSessionOperation)
"protected session operation called from within protected NoteFile operation"))
(BusyList (* some NF ops are active, we lose)
"NoteFile Operations")
((FMEMB (THIS.PROCESS)
(SETQ BusyList NC.CardBusyList))
(NC.ReportError (QUOTE NC.ProtectedSessionOperation)
"protected session operation called from within protected Card operation"))
(BusyList (* some card ops are active, we lose)
"Card Operations")
(T (* all relevant locks are free)
NIL])
(NC.SessionToNoteFileLock
[LAMBDA (NoteFile Operation) (* Randy.Gobbel " 9-Mar-87 12:51")
(* * downgrade session lock to NoteFile lock for specified NF. MUST BE CALLED ONLY FROM WITHIN
NC.ProtectedSessionOperation!)
(* * rg 3/9/87 created)
(COND
((NEQ NC.SessionProcessInProgress (THIS.PROCESS))
(NC.ReportError "NC.SessionToNoteFileLock"
"Attempted to release session lock when not held by this process")))
(OBTAIN.MONITORLOCK NC.LockLock)
[RESETSAVE (NC.NoteFileProp NoteFile (QUOTE OperationInProgress)
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]
(SETTOPVAL (QUOTE NC.SessionProcessInProgress)
NIL)
(SETTOPVAL (QUOTE NC.SessionOperationInProgress)
NIL)
(RELEASE.MONITORLOCK NC.LockLock])
)
(DEFINEQ
(NC.ResetCardProcessInProgress
[LAMBDA (NoteFile) (* Randy.Gobbel " 5-Mar-87 15:31")
(NC.NoteFileProp NoteFile (QUOTE CardProcessInProgressList)
(DREMOVE (THIS.PROCESS)
(NC.NoteFileProp NoteFile (QUOTE CardProcessInProgressList])
(NC.ProcessName
[LAMBDA NIL (* Randy.Gobbel " 5-Mar-87 16:45")
(PROCESSPROP (THIS.PROCESS)
(QUOTE NAME])
)
(* * New for KOTOTEDITPATCHES)
(PUTPROPS PROCESS.APPLY-IN-\TEDIT.BUTTONEVENTFN READVICE [(\TEDIT.BUTTONEVENTFN . PROCESS.APPLY)
(AROUND NIL (ADD.PROCESS
(LIST USERFN (KWOTE W])
(READVISE PROCESS.APPLY-IN-\TEDIT.BUTTONEVENTFN)
(PUTPROPS RGPATCH016 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (6384 44257 (NC.AssignTitle 6394 . 10037) (NC.AddParents 10039 . 12704) (
NC.DeleteNoteCards 12706 . 18464) (NC.QuitCard 18466 . 23981) (NC.CheckFiling 23983 . 25741) (
NC.UnfileNoteCard 25743 . 27744) (NC.CardSaveFn 27746 . 33880) (NC.QuitWithoutSaving 33882 . 40401) (
NC.DeleteNoteCard 40403 . 41924) (NC.AbortCard 41926 . 42395) (NC.CardOperationsInProgress 42397 .
44255)) (45664 99550 (NC.CloseListOfActiveCards 45674 . 46946) (NC.SaveDirtyCards 46948 . 48645) (
NC.AbortSession 48647 . 54077) (NC.OpenNoteFile 54079 . 67989) (NC.CloseNoteFile 67991 . 80281) (
NC.CheckpointNoteFile 80283 . 85012) (NC.CheckpointDatabase 85014 . 86364) (NC.OpenDatabaseFile 86366
. 87141) (NC.ProcessNoteFileNotFoundError 87143 . 89383) (NC.ProcessTruncationRequest 89385 . 91264)
(NC.ProcessNoteFileNeedsConversionError 91266 . 94513) (NC.ProcessNoteFileNeedsTruncationError 94515
. 97688) (NC.ProcessInspectAndRepairRequest 97690 . 99548)) (99582 111412 (NC.AddGlobalLinksToCard
99592 . 101588) (NC.AddLinkToCard 101590 . 103032) (NC.AddLinksToCard 103034 . 105015) (
NC.SmartDeleteLinks 105017 . 111410)) (111448 113683 (NC.RelayoutGraphCard 111458 . 113681)) (113721
116575 (NC.FileBoxCollectChildren 113731 . 116573)) (116613 158458 (NC.UpdateBrowserCard 116623 .
127744) (NC.RelayoutBrowserCard 127746 . 134637) (NC.ConnectNodesInBrowser 134639 . 141035) (
NC.UnconnectNodesInBrowser 141037 . 143544) (NC.ExpandBrowserNode 143546 . 152326) (
NC.ChangeBrowserSpecs 152328 . 153914) (NC.MakeBrowserOverviewWin 153916 . 156313) (
NC.AskBrowserOverviewSpecs 156315 . 158456)) (158498 161581 (NC.RecomputeLinkIndex 158508 . 160065) (
NC.ChangeLinkIndexSpecs 160067 . 161579)) (161617 179087 (NC.CloseNoteCards 161627 . 163292) (
NC.CloseStructure 163294 . 164956) (NC.DeleteStructure 164958 . 166788) (NC.MoveStructure 166790 .
167527) (NC.DoNoteFileOp 167529 . 173529) (NC.FileBrowserCheckpoint 173531 . 174339) (
NC.NoteFileTitleLeftWhenSelectedFn 174341 . 177363) (NC.CloseSession 177365 . 178139) (NC.MoveCards
178141 . 179085)) (179121 185005 (NCP.CloseCards 179131 . 180552) (NCP.UndisplayCards 180554 . 181656)
(NCP.UncacheCards 181658 . 182614) (NCP.CloseNoteFiles 182616 . 183702) (NCP.OpenNoteFile 183704 .
185003)) (185038 204835 (NC.MessageWinAttachedMenuWhenSelectedFn 185048 . 189806) (NC.ScavengerPhase1
189808 . 204833)) (204871 207662 (NC.AskUser 204881 . 207660)) (207695 208360 (NC.AskUserResetWindow
207705 . 208358)) (209454 217179 (NC.CardCheckOpInProgress 209464 . 211742) (
NC.NoteFileCheckOpInProgress 211744 . 213876) (NC.SessionCheckOpInProgress 213878 . 215727) (
NC.SessionToNoteFileLock 215729 . 217177)) (217180 217698 (NC.ResetCardProcessInProgress 217190 .
217512) (NC.ProcessName 217514 . 217696)))))
STOP