(FILECREATED "20-Mar-87 12:04:14" {QV}<NOTECARDS>1.3K>NEXT>RGPATCH018.;11 123185
changes to: (VARS RGPATCH018COMS)
(MACROS NAMED-RESETLST NAMED-RESETSAVE NAMED-RESETUNSAVE NC.CardSelectionOperation
ABORT.PROTECT)
(FNS NC.AddParents NC.DeleteNoteCards NC.UnfileNoteCard NC.MakeLink
NC.MakeFilingLinks NC.AddGlobalLinksToCard NC.AddLinksToCard NCP.SelectCards
NC.FileBoxCollectChildren NC.MakeBrowserCard NC.UpdateBrowserCard
NC.BrowserAddNode NC.CopyCards NC.DeleteStructure NC.CopyStructure
NC.SelectNoteCards NAMED-RESETSAVE NC.MakeDocument NAMED-RESETLST
NAMED-RESETUNSAVE NC.PrintOperationInProgressMsg NC.CloseListOfActiveCards
NC.QuitWithoutSaving NAMED-RESETRESTORE NC.DeleteNoteCard
NC.BrowserRemoveNode NC.MakeSearchCard NC.MakeLinkIndex)
previous date: "13-Mar-87 15:21:26" {QV}<NOTECARDS>1.3K>NEXT>RGPATCH018.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RGPATCH018COMS)
(RPAQQ RGPATCH018COMS [(* * rg 3/19/87 concurrency fixes, major pile number two. This includes all
of the machinery to lock cards while they're being selected.)
[DECLARE: COPY FIRST [P (LOAD? (NC.FindFile (QUOTE NCSEARCHCARD]
[P (LOAD? (NC.FindFile (QUOTE NCBROWSERCARD]
[P (LOAD? (NC.FindFile (QUOTE NCDOCUMENTCARD]
(P (LOAD? (NC.FindFile (QUOTE NCLINKINDEXCARD]
(* * changes to NCCARDS)
(* * DELETE NC.DetermineSources)
(FNS NC.AddParents NC.DeleteNoteCards NC.UnfileNoteCard
NC.PrintOperationInProgressMsg NC.QuitWithoutSaving NC.DeleteNoteCard)
(* * changes to NCLINKS)
(FNS NC.MakeLink NC.MakeFilingLinks NC.AddGlobalLinksToCard
NC.AddLinksToCard)
(* * changes to NCPROGINT)
(FNS NCP.SelectCards)
(* * changes to NCFILEBOXCARD)
(FNS NC.FileBoxCollectChildren)
(* * changes to NCBROWSERCARD)
(FNS NC.MakeBrowserCard NC.UpdateBrowserCard NC.BrowserAddNode
NC.BrowserRemoveNode)
(* * changes to NCDATABASE)
(FNS NC.CopyCards NC.CloseListOfActiveCards)
(* * changes to NCINTERFACE)
(FNS NC.DeleteStructure NC.CopyStructure NC.SelectNoteCards
NC.NoteFileOperations)
(* * changes to NCUTILITIES)
(FNS NC.SessionCheckOpInProgress NC.NoteFileCheckOpInProgress)
(* * changes to NCSEARCHCARD)
(FNS NC.MakeSearchCard)
(* * changes to NCDOCUMENTCARD)
(FNS NC.MakeDocument)
(* * changes to NCLINKINDEXCARD)
(FNS NC.MakeLinkIndex)
(* * new for NCUTILITIES)
(MACROS ABORT.PROTECT NC.CardSelectionOperation NAMED-RESETLST
NAMED-RESETSAVE NAMED-RESETUNSAVE)
(FNS NAMED-RESETLST NAMED-RESETSAVE NAMED-RESETRESTORE NAMED-RESETUNSAVE)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA NAMED-RESETSAVE NAMED-RESETLST)
(NLAML NAMED-RESETUNSAVE)
(LAMA])
(* * rg 3/19/87 concurrency fixes, major pile number two. This includes all of the machinery
to lock cards while they're being selected.)
(DECLARE: COPY FIRST
(LOAD? (NC.FindFile (QUOTE NCSEARCHCARD)))
(LOAD? (NC.FindFile (QUOTE NCBROWSERCARD)))
(LOAD? (NC.FindFile (QUOTE NCDOCUMENTCARD)))
(LOAD? (NC.FindFile (QUOTE NCLINKINDEXCARD)))
)
(* * changes to NCCARDS)
(* * DELETE NC.DetermineSources)
(DEFINEQ
(NC.AddParents
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel "18-Mar-87 16:02")
(* Add a subtopic link from a contents card specified by the user to the contents card specified by
WindowOrTextStream. But first check to make sure that this would not introduce any circularities in the contents
lattice.)
(* * rht 12/8/84: Massive shaving. Now calls NC.MakeChildLink to do the tough work.)
(* * rht 10/3/85: No longer prints final, annoying, slow-to-disappear message in prompt window if nothing
selected.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * fgh 6/9/86 Added code to check to make sure that another operation is not in progress on this card when this
fn is called.)
(* * rht 7/5/86: Now checks for readonly cards.)
(* * rht&pmi 11/24/86: Surrounded call to NC.MakeChildLink with NC.ActivateCardAndDo so that ParentCard will be
active for duration of the call.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 1/28/87: Took out call to NC.ActivateCardAndDo. Need to make sure ParentCard gets saved after getting link
if wasn't active originally.)
(* * rg 3/3/87 Enlarged scope of NC.ProtectedCardOperation)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(NC.CardSelectionOperation (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 "18-Mar-87 16:03")
(* Delete note cards. If no card specified then get a
list of note cards to be deleted.
Then delete these cards.)
(* * fgh 11/11/85: Updated to handle new Card objects. Also split off main work of deleteing a single note card
into NC.DeleteNoteCard function.)
(* * kirk 21Feb86 Added InterestedWindow)
(* * kirk 29Apr86 Now returns CardIdentifiers)
(* * fgh 6/9/86 Added checks to see if other operations are in progress)
(* * rht 7/4/86: Now checks that card is not read-only.)
(* * kirk 18Aug86 Added main window for windowless cards.)
(* * rht 8/29/86: Reorganized and added call to NC.SeverAllLinks to make deleting more efficient.
Added QuietFlg, NoGroupConfirmFlg and Don'tPutToBeDeletedCardsFlg args.)
(* * rht 9/5/86: Now forces NoGroupConfirmFlg to be non-nil if NoIndividualConfirmFlg is NIL and only one card to
delete.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 12/16/86: Removed obsolete Don'tPutToBeDeletedCardsFlg arg.)
(* * rht 3/9/87: Changed NC.DeleteSelectingMenu to NC.SelectingCardsMenu.)
(* * rg 3/9/87 added NC.ProtectedSessionOperation wrapper)
(* * rg 3/11/87 changed call of NC.DeleteNoteCard to NC.DeleteNoteCardInternal)
(* * rg 3/18/87 changed NC.ProtectedSessionOperation to NC.CardSelectionOperation)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu))
(NC.CardSelectionOperation (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.UnfileNoteCard
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel "18-Mar-87 16:04")
(* Take a notecard out of a file box.
Called fom title bar menu.)
(* * fgh 11/12/85 Updated to handle Card objects.)
(* * fgh 6/9/86 Added code to check to make sure that another operation is not in progress on this card when this
fn is called.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 2/2/87: Fixed bug %#418: Trashed all the stuff about opening PropListEditor on the fromlinks.
Now just uses SelectNoteCards to choose the fileboxes to delete from.)
(* * rg 3/4/87 rewritten for new NC.ProtectedCardOperation)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(DECLARE (GLOBALVARS NC.SelectingParentsMenu))
(NC.CardSelectionOperation (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.PrintOperationInProgressMsg
[LAMBDA (Window Operation OperationInProgress) (* Randy.Gobbel "18-Mar-87 19:26")
(* * Notify the user that they are attempting to do an operation while another operation is in progress.
Use a prompt window above the card's promptwindow because the card's prompt window is probably being used for the
operation.)
(* * fgh 6/9/86 First created.)
(* * RG 3/10/87 removed redundant (?) call to NC.AttachPromptWindow)
(LET (PWindow)
(if (OPENWP (SETQ PWindow (NC.AttachPromptWindow Window NIL NIL NIL T)))
then (SETQ PWindow (NC.AttachPromptWindow PWindow 1 30 NIL NIL))
else (SETQ PWindow (NC.AttachPromptWindow Window NIL 30 NIL NIL)))
(NC.PrintMsg PWindow T "## Can't " Operation (CHARACTER 13)
"## " OperationInProgress " in progress.")
(REPOSITIONATTACHEDWINDOWS Window)
(DISMISS 2000)
(CLOSEW PWindow])
(NC.QuitWithoutSaving
[LAMBDA (CardIdentifier) (* Randy.Gobbel "16-Mar-87 18:25")
(* 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)
(* * rg 3/16/87 Now uses NC.DeleteNoteCard instead of NC.DeleteNoteCards)
(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.DeleteNoteCard Card T])
(NC.DeleteNoteCard
[LAMBDA (CardIdentifier DontClearFlg) (* Randy.Gobbel "16-Mar-87 18:24")
(* * 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" (NULL
DontClearFlg)
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])
)
(* * changes to NCLINKS)
(DEFINEQ
(NC.MakeLink
[LAMBDA (Window LinkLabel DestinationCard SourceCard DisplayMode AnchorMode Message NoDisplayFlg
LinkToInsertAfter CrossFileLinksMode) (* Randy.Gobbel "18-Mar-87 16:06")
(* * Make a link from (OR Window SourceCard) to DestinationCard with linklabel of LinkLabel)
(* * rht 1/12/85: If need to create a new card, then now shows card type menu near window of SourceID.)
(* * rht 1/13/85: Added extra args Message and NoDisplayFlg.)
(* * rht 3/26/85: Added LinkToInsertAfter arg which should be NIL or a link to insert the new To link after.
If NIL, then insert at front of ToLinks.)
(* * kirk 9/23/85: took out GETPROMPTWINDOW call for asknotecardtype)
(* * kirk: 14Nov85: changed NC.CoerceToID to to NC.CoerceToCard)
(* * fgh 11/16/85 Changed from PROG to LET and used COND to contyrol returnmed value.)
(* * fgh 2/5/86 Changed call DefaultLinkDisplayMode to FetchLinkDisplayMode)
(* * fgh 6/5/86 Now calls AskLinkLabel if LinkLabel arg is NIL)
(* * rht 7/4/86: Added check for readonly card.)
(* * kef 7/17/86: Added calls to grab the write permission on the appropriate card parts.)
(* * kef 7/22/86: Saves the links on the Destination Card now right away, while still holding onto the FROMLINKS
write lock.)
(* * fgh 8/30/86 Adpated to use NC.IfCardPartNotBusy.)
(* * rht 9/29/86: Tossed Ken's call to NC.PutFromLinks; It was the cause of too many nasty breaks.
Also made syntactic fixes.)
(* * rht 10/4/86: Now handles cross file links. New arg CrossFileLinksMode determines whether cross-file link will
be two-way, i.e. will destination card know it's being linked to.)
(* * rht 11/10/86: Now creates new crossfile link if Destination card is a CrossFileLink card that we didn't just
create.)
(* * rht 11/14/86: Now checks if non-nil DestinationCard before trying to do cross-filelink stuff.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * rht 12/9/86: Throws out JustCreatedFlg marker stuff.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 12/16/86: Fixed bug whereby electing not to open notefile containing crossfilelink dest card caused
break.)
(* * rht 12/16/86: Now passes Window down to NC.GetCrossFileLinkDestCard.)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(DECLARE (GLOBALVARS NC.SelectingSingleCardMenu NC.NewCrossFileLinksTwoWayFlg))
(OR SourceCard (SETQ SourceCard (NC.CoerceToCard Window)))
(AND (NC.CheckForNotReadOnly SourceCard Window "Can't make links in ")
(NC.CardSelectionOperation
(LET (Link Type)
(OR Window (SETQ Window (NC.FetchWindow SourceCard)))
(OR Message (SETQ Message
"Please shift-select the Card or Box to be linked to."))
(OR LinkLabel (SETQ LinkLabel (NC.AskLinkLabel Window NIL NIL T NIL)))
(OR DestinationCard (SETQ DestinationCard
(NC.SelectNoteCards T [FUNCTION (LAMBDA (Card)
(COND
((NOT (NC.SameCardP Card SourceCard))
T)
(T (NC.PrintMsg Window T
"A Card/Box cannot link to itself. "
(CHARACTER 13)
"Selection ignored."
(CHARACTER 13))
NIL]
NC.SelectingSingleCardMenu SourceCard Message)))
[if (EQ DestinationCard (QUOTE *New% Card*))
then (SETQ DestinationCard (AND (SETQ Type (NC.AskNoteCardType
(WINDOWREGION Window)))
(NC.CoerceToCard
(NC.MakeNoteCard Type
(fetch
(Card NoteFile)
of SourceCard)
NIL NoDisplayFlg]
(* * If we're trying to link to a CrossFileLink card, then check whether card was just created.
If so, then it's the first link, otherwise we make a new CrossFileLink.)
(AND DestinationCard (NC.CrossFileLinkCardP DestinationCard)
(SETQ DestinationCard (NC.GetCrossFileLinkDestCard DestinationCard
Window))
(NC.SetUserDataProp DestinationCard (QUOTE JustCreatedFlg)
NIL))
(if DestinationCard
then (NC.IfCardPartNotBusy
DestinationCard
(QUOTE FROMLINKS)
(NC.IfCardPartNotBusy
SourceCard
(QUOTE TOLINKS)
(* * If have cross-file link, then make two new crossfilelink cards, one per notefile. Make global link over there
from crossfilelink card to DestinationCard and local link here from SourceCard to crossfilelink card.)
[if (NOT (NC.SameNoteFileP (fetch (Card NoteFile)
of SourceCard)
(fetch (Card NoteFile)
of DestinationCard)))
then (LET [(CrossFileLinksTwoWayFlg
(OR (EQ CrossFileLinksMode (QUOTE TWOWAY))
(AND (NULL CrossFileLinksMode)
NC.NewCrossFileLinksTwoWayFlg]
(if CrossFileLinksTwoWayFlg
then (NC.MakeGlobalLink Window LinkLabel
DestinationCard
(
NC.CreateCrossFileLinkCard
DestinationCard
SourceCard T)
DisplayMode))
(SETQ DestinationCard (NC.CreateCrossFileLinkCard
SourceCard DestinationCard
CrossFileLinksTwoWayFlg]
[SETQ Link (create Link
UID ← (NC.MakeUID)
SourceCard ← SourceCard
DestinationCard ← DestinationCard
AnchorMode ← AnchorMode
Label ← LinkLabel
DisplayMode ← (OR DisplayMode (
NC.FetchLinkDisplayMode
SourceCard]
(NC.AddToLink Link LinkToInsertAfter)
(NC.AddFromLink Link)
Link))
else NIL])
(NC.MakeFilingLinks
[LAMBDA (Card Msg) (* Randy.Gobbel "18-Mar-87 16:06")
(* Hooks card specified by Card to all of the current
contents cards by a Contents link)
(* * rht 8/1/84: Changed the NC.PrintMsg2 call for "No FileBox has been specified." to use NIL as second arg rather
than T. This prevents erasure of previous error messages.)
(* * rht 12/8/84: Massive rewrite. Now calls NC.MakeChildLink. And always orphanizes if no parent specified.
This is because it's currently called only by NC.InsureProperFiling.)
(* * rht 6/25/85: Now returns NewParents and checks if CANCELLED comes back from NC.SelectNoteCards so can abort
the calling operation.)
(* * Fgh 11/15/85 Adapted from and intended to replace NC.MakeContentsHooks)
(* * fgh 8/6/86 Updated to use NC.AttachPromptWindow and added Msg arg)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 2/19/87 Make sure NewParents always has the real value)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(DECLARE (GLOBALVARS NC.SelectingContentsMenu))
(NC.CardSelectionOperation (PROG (OneHook (Window (NC.FetchWindow Card))
NewParents)
(SETQ NewParents (NC.SelectNoteCards
NIL
(FUNCTION NC.FileBoxP)
NC.SelectingContentsMenu Card (CONCAT (OR Msg "")
"Please shift-select the Boxes to file this card in."
(CHARACTER
13)
"'Done' with no selections files it in the ToBeFiled box.")
T))
[COND
([NOT (OR (EQ NewParents (QUOTE CANCELLED))
(AND NewParents
(for ParentCard in NewParents
bind OneHook
when (NC.MakeChildLink Card
ParentCard
Window)
do (SETQ OneHook T)
finally (RETURN OneHook]
(NC.PrintMsg Window NIL "No FileBox has been specified."
(CHARACTER 13)
"This card will be filed in the ToBeFiled Box."
(CHARACTER 13))
[SETQ NewParents (NC.HookToOrphanCard
Card
(fetch (NoteFile ToBeFiledCard)
of (fetch (Card NoteFile) of Card]
(COND
((NC.AttachPromptWindow Window NIL NIL NIL T)
(SPAWN.MOUSE)
(DISMISS 2000)
(NC.ClearMsg Window T]
(RETURN NewParents])
(NC.AddGlobalLinksToCard
[LAMBDA (CardIdentifier SingleLinkFlg) (* Randy.Gobbel "18-Mar-87 16:08")
(* * 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)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(NC.ProtectedCardOperation SourceCard "Add Global Link(s)" NIL
(NC.CardSelectionOperation
(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.AddLinksToCard
[LAMBDA (CardIdentifier LinkLabel DestinationCards) (* Randy.Gobbel "18-Mar-87 16:09")
(* * Adds multiple links to card designated by CardIdentifier. Rest of args can be NIL.)
(* * fgh 6/9/86 Added Checks to make sure other interaction operation not in porgress.)
(* * rht 9/23/86: Fixed bug in function passed to NC.SelectNoteCards.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(LET ((SourceCard (NC.CoerceToCard CardIdentifier))
CardType Window OperationInProgress)
(NC.ProtectedCardOperation SourceCard "Insert Links" NIL
(NC.CardSelectionOperation
(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])
)
(* * changes to NCPROGINT)
(DEFINEQ
(NCP.SelectCards
[LAMBDA (InstigatingCardOrWindow SingleCardFlg SelectionPredicate Msg CheckForCancelFlg)
(* Randy.Gobbel "18-Mar-87 16:09")
(* * Return a list of cards selected. A menu pops up near the prompt window with "DONE" and "CANCEL" buttons.
User selects by clicking in card's title bar.)
(* * rht 11/18/85: Updated to handle new notefile and card object formats. Now takes optional extra args and passes
to NC.SelectNoteCards.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 3/2/87: Fix to bug %#342: Now makes sure instigating card is displayed, else passes NIL to
NC.SelectNoteCards.)
(* * added NC.CardSelectionOperation wrapper)
(NC.CardSelectionOperation (NC.SelectNoteCards SingleCardFlg SelectionPredicate
(if SingleCardFlg
then NC.SelectingCardMenu
else NC.SelectingCardsMenu)
(COND
((OPENWP InstigatingCardOrWindow)
InstigatingCardOrWindow)
((AND (NCP.ValidCardP
InstigatingCardOrWindow)
(NCP.CardDisplayedP
InstigatingCardOrWindow))
InstigatingCardOrWindow)
(T NIL))
Msg CheckForCancelFlg])
)
(* * changes to NCFILEBOXCARD)
(DEFINEQ
(NC.FileBoxCollectChildren
[LAMBDA (WindowOrTextStream Card NewChildren NoDisplayFlg)
(* Randy.Gobbel "18-Mar-87 16:10")
(* * Ask user for new children (either cards or fileboxes) for this filebox. Check to make sure that no
circularities are introduced. This code is sort of the inverse of the NC.AddParents code and thus looks quite
similar.)
(* * rht 10/29/84: Added NoDisplayFlg to prevent error message when no appropriate elements exist.
Also now returns ID if at least one child was added, NIL otherwise.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * rht 7/5/86: Now checks for readonly cards.)
(* * rht 8/11/86: Added code to check to make sure that another operation is not in progress on this card when this
fn is called.)
(* * rht 10/17/86: Made successful filing operations NOT do dismiss.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 1/28/87: Now activates parent box if necessary and saves before deactivating.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(OR Card (SETQ Card (NC.CoerceToCard WindowOrTextStream)))
(NC.ProtectedCardOperation Card "Put Cards Here" NIL
(NC.CardSelectionOperation
(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.MakeBrowserCard
[LAMBDA (Card Title NoDisplayFlg ParamList) (* Randy.Gobbel "18-Mar-87 16:12")
(* Make a browser card with id Card using root at RootID and the link following predictae specified by Predicate.
IF Root and/or ListOfLinkLabels not specified, ask the user.)
(* * rht 8/3/84: Changed to call NC.AskLinkLabel with its ReverseLinkLabel parameter set to T.)
(* * fgh 10/2/84 Changed Link Icons to be image objects in NodeLabel of Graph Npodes rather than annotations on
graph nodes.)
(* * rht 10/19/84: Fixed setting up of browser card's prop list in case NoDisplayFlg is T so we have no Window.
Now NC.MakeLinksLegend returns the label pairs.)
(* * rht 11/27/84: Removed the WINDOWADDPROP call to put NC.GraphCardCloseFn on the CLOSEFN of the window.
This causes trouble. NC.QuitCard will get put on by NC.MakeNoteCard and that's enough.)
(* * rht 1/3/85: Now puts a dummy region of the right size if the NoDisplayFlg is on.)
(* * rht 1/15/85: Put hooks for AddNode, AddLink, etc. so editing graph edits underlying structure.)
(* * rht 2/14/85: Added VerticalFlg and made BrowserSpecs get put on browser's proplist in all cases.)
(* * rht 4/1/85: Now calls NC.AskBrowserSpecs with additional Don'tAskFlg in case of call from Programmer's
interface.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 2/7/86: Now gets browser format, etc. via fetch/set fns.)
(* * rht 5/6/86: Took out call to NC.SetupTitleBarMenu.)
(* * rht 5/8/86: Added calls to rig title bar properly.)
(* * rht 7/10/86: Now passes ListOfLinkLabels to NC.AskBrowserSpecs.)
(* * rht 9/19/86: Mod to above fix. Now calls NC.MakeNewCardWindow a new fn that creates window and hangs Card off
windowprop.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection. Also added GLOBALVARS
statement.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 12/16/86: Now checks that NC.MakeLink succeeded before creating a real link icon. If not, then make a
standin for a cross file link icon.)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(DECLARE (GLOBALVARS NC.SubBoxLinkLabel NC.BrowserContentsLinkLabel NC.SpecialBrowserSpecsFlg
NC.*Graph*BrowserFormat NC.SelectingBrowserSourceMenu))
(NC.CardSelectionOperation (PROG ([RootCards (MKLIST (LISTGET ParamList (QUOTE ROOTCARDS]
(ListOfLinkLabels (LISTGET ParamList (QUOTE LINKTYPES)))
(BrowserFormat (LISTGET ParamList (QUOTE FORMAT)))
(Depth (LISTGET ParamList (QUOTE DEPTH)))
(CardType (NC.RetrieveType Card))
Lattice RootNodes Window Graph SpecialBrowserSpecs
BrowserSpecs DropVirtualNodesFlg)
(NC.ActivateCard Card)
[COND
((NULL NoDisplayFlg)
(SETQ Window (NC.MakeNewCardWindow Card
(OR Title
"Untitled")))
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.GraphCardShrinkFn]
[if (NULL RootCards)
then (SETQ RootCards
(if NoDisplayFlg
then (LIST NIL)
else (NC.SelectNoteCards NIL NIL
NC.SelectingBrowserSourceMenu
Window
"Please shift-select the Cards and/or Boxes the browser should start from."
T]
(COND
((EQ RootCards (QUOTE CANCELLED))
(NC.DeactivateCard Card)
(CLOSEW Window)
(RETURN)))
(NC.HoldTTYProcess)
[SETQ BrowserSpecs (NC.AskBrowserSpecs
Window Card ListOfLinkLabels Depth BrowserFormat T
(if (OR ParamList NoDisplayFlg)
then (QUOTE DONTASK]
(COND
((NULL BrowserSpecs)
(NC.DeactivateCard Card)
(CLOSEW Window)
(RETURN)))
(SETQ ListOfLinkLabels (CAR BrowserSpecs))
(SETQ Depth (CADR BrowserSpecs))
(SETQ BrowserFormat (CADDR BrowserSpecs))
(* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
[SETQ SpecialBrowserSpecs (COND
(NC.SpecialBrowserSpecsFlg (NC.AskSpecialBrowserSpecs
Window))
(T (create SPECIALBROWSERSPECS]
(OR NoDisplayFlg (NC.PrintMsg Window T (CHARACTER 13)
"Computing browser graph. Please wait. ..."))
(* Create new browser hash array)
(NC.GetBrowserHashArray Card)
(* Compute lattice breakdth-first starting from
roots.)
(SETQ Lattice (NC.GrowLinkLattice RootCards NIL
ListOfLinkLabels Card
Depth))
(SETQ RootNodes (for RootCard in RootCards
collect (NC.GetBrowserNodeID Card
RootCard)))
(OR NoDisplayFlg (WINDOWPROP Window (QUOTE
NoteCardObject)
Card))
(* * Link destination id information stored in NodeLabel field into a LinkIcon for display)
(for Node in Lattice bind NodeID eachtime (BLOCK)
do
[replace (GRAPHNODE NODELABEL) of Node
with (LET ((NewLink (NC.MakeLink
Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
Card NIL)))
(if NewLink
then (NC.MakeLinkIcon NewLink)
else (NC.MakeCrossFileLinkIconStandIn
(NCP.CardTitle
(fetch (GRAPHNODE NODELABEL)
of Node]
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(NC.GraphNodeIDRemProp (NC.CoerceToGraphNodeID NodeID)
(QUOTE TouchedFlg))
(NC.GraphNodeIDRemProp (NC.CoerceToGraphNodeID NodeID)
(QUOTE VisitedFlg)))
(SETQ Graph (if (AND Lattice RootNodes)
then (LAYOUTGRAPH Lattice RootNodes
(SUBST (QUOTE
LATTICE)
NC.*Graph*BrowserFormat
BrowserFormat)
(fetch (
SPECIALBROWSERSPECS Font) of SpecialBrowserSpecs)
(fetch (
SPECIALBROWSERSPECS MotherD) of SpecialBrowserSpecs)
(fetch (
SPECIALBROWSERSPECS PersonalD) of SpecialBrowserSpecs)
(fetch (
SPECIALBROWSERSPECS FamilyD) of SpecialBrowserSpecs))
else (create GRAPH)))
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph
Window
DropVirtualNodesFlg))
(OR NoDisplayFlg (NC.PrintMsg Window NIL "Done!"))
(NC.SetSubstance Card Graph)
(NC.SetBrowserLinkLabels Card (OR ListOfLinkLabels
(LIST
NC.SubBoxLinkLabel)))
(NC.SetBrowserRoots Card RootCards)
(NC.SetBrowserFormat Card BrowserFormat)
(NC.SetBrowserDepth Card Depth)
(NC.SetSpecialBrowserSpecs Card SpecialBrowserSpecs)
(COND
(NoDisplayFlg (RETURN Card)))
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.InstallTitleBarLeftMenu Window CardType)
(NC.InstallTitleBarMiddleMenu Window CardType)
(NC.RelayoutBrowserCard Window)
(RETURN Window])
(NC.UpdateBrowserCard
[LAMBDA (Window) (* Randy.Gobbel "18-Mar-87 16:13")
(* * rht 10/14/84: Added call to DETACHALLWINDOWS to close any existing links legend window and prompt window.
Also added call to NC.MakeLinksLegend to make a new attached legend menu.)
(* * rht 1/15/85: Put hooks for AddNode, AddLink, etc. so editing graph edits underlying structure.)
(* * rht 2/14/85: Added ability to respecify roots and link labels before recomputing graph.)
(* * rht 3/8/85: Modified to use new browser props stored on card's proplist as of release 1.2.)
(* * rht 3/17/85: Now takes OnlyLayoutFlg argument. If set, then don't recompute lattice or ask about root nodes.)
(* * rht 11/17/85: updated to handle new card and notefile objects.)
(* * kirk 23Jan86 Changed to use NC.AskYesOrNo)
(* * rht 2/7/86: Now gets and sets browser format, etc. via fetch/set fns.)
(* * rht 3/7/86: Now only closes the Links legend menu attached window.)
(* * rht 6/10/86: Moved code to delete links legend menu and code to make new browser hash array to after
questioning user about respecifying roots.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 12/16/86: Now checks that NC.MakeLink succeeded before creating a real link icon. If not, then make a
standin for a cross file link icon.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Recompute Browser Card" NIL
(NC.CardSelectionOperation
(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.BrowserAddNode
[LAMBDA (Graph Window) (* Randy.Gobbel "18-Mar-87 16:16")
(* * Called by grapher when user creates a new node. Returns new node or nil.)
(* * rht 11/17/85: updated to handle new card and notefile formats.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection. Also added GLOBALVARS
statement.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/18/87 added NC.ProtectedCardOperation and NC.CardSelectionOperation wrappers)
(DECLARE (GLOBALVARS NC.BrowserContentsLinkLabel))
(NC.ProtectedCardOperation (NC.CoerceToCard Window)
"Add Node" Window
(NC.CardSelectionOperation
(PROG ((GraphCard (NC.CoerceToCard Window))
Link GraphNodeID Card)
(* Get user to select an existing card.
Not allowed to create a new one.)
(SETQ Card (NC.SelectNoteCards
T
[FUNCTION (LAMBDA (SelectedCard)
(COND
((NOT (NC.SameCardP SelectedCard GraphCard))
T)
(T (NC.PrintMsg Window T
"The browser can't link to itself."
(CHARACTER 13)
"Selection ignored."
(CHARACTER 13))
NIL]
NC.SelectingCardMenu GraphCard
"Shift-select a card or box to include in browser."))
(if (NULL Card)
then (RETURN NIL))
(* Make link from browser to new card.)
(SETQ Link (NC.MakeLink Window
NC.BrowserContentsLinkLabel Card
GraphCard NIL NIL NIL T))
(* Check that it doesn't already exist.
If not, create a browser node.)
(COND
(Link (* Create hash array if haven't already.)
(NC.GetBrowserHashArray GraphCard Graph)
[SETQ GraphNodeID (NC.GetBrowserNodeID
GraphCard
(SETQ Card (fetch (Link DestinationCard)
of Link]
(COND
((for Node in (fetch (GRAPH GRAPHNODES)
of Graph)
thereis (EQ GraphNodeID (
NC.CoerceToGraphNodeID
Node)))
(NC.PrintMsg Window T "Node for card '"
(NC.RetrieveTitle Card)
"' already in graph.")
(NCP.DeleteLinks Link)
(RETURN NIL)))
(NC.MarkCardDirty GraphCard)
(RETURN (NODECREATE GraphNodeID (
NC.MakeLinkIcon Link)
(CURSORPOSITION NIL Window]
)
(NC.BrowserRemoveNode
[LAMBDA (Graph Window DeleteCardFlg NodeToRemove QuietFlg)
(* Randy.Gobbel "16-Mar-87 18:30")
(* * Called by grapher when user removes a node.)
(* * rht 11/17/85: Updated to handle new card and notefile formats.)
(* * rht 2/7/86: Changed to use NC.SetBrowserRoots instead of NC.PutProp)
(* * rht 4/30/86: Now takes optional NodeToRemove and QuietFlg argument.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(PROG ((GraphCard (NC.CoerceToCard Window))
Card NodeToRemoveID RootCards NodesToRemove NumVirtuals)
[OR NodeToRemove (SETQ NodeToRemove (NC.SelectGraphNode Window Graph
(if DeleteCardFlg
then
"Choose node of card to delete."
else
"Choose node to remove."]
(SETQ NodeToRemoveID (NC.CoerceToGraphNodeIDOrLabel NodeToRemove))
(SETQ Card (NC.CardFromBrowserNodeID NodeToRemoveID))
(* If we're supposed to be deleting a card, then check
that node represents a card and that user confirms.)
(if DeleteCardFlg
then (if (NC.ValidCardP Card)
then (if (NOT (NC.AskYesOrNo (CONCAT "Want to delete the "
(NC.RetrieveTitle Card)
" card? ")
"--"
(QUOTE Yes)
T Window NIL NIL))
then (FLIPNODE NodeToRemove Window)
(RETURN (NC.PrintMsg NIL T
"Card & Node delete aborted.")))
else (NC.PrintMsg NIL T "No card for that node.")
(FLASHW PROMPTWINDOW)
(FLIPNODE NodeToRemove Window)
(RETURN NIL)))
(AND (NC.ValidCardP GraphCard)
(NC.MarkCardDirty GraphCard))
(* We require that all virtual nodes for this node must be removed at once if this one has any link edges to or
from it.)
(SETQ NodesToRemove (for Node in (fetch (GRAPH GRAPHNODES) of Graph)
when (EQ NodeToRemoveID (NC.CoerceToGraphNodeIDOrLabel
Node))
collect Node)) (* If there are no edges into or out of this node,
then just delete from graph.)
(if (AND (NOT DeleteCardFlg)
(NULL (fetch (GRAPHNODE FROMNODES) of NodeToRemove))
(NULL (fetch (GRAPHNODE TONODES) of NodeToRemove)))
then (FLIPNODE NodeToRemove Window) (* Delete the browsercontents link from the browser.)
(if (AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard))
then (NC.DelBrowserContentsLink GraphCard Card)
(* Remove entry for this node from browser hash
array.)
(NC.RemoveBrowserNodeHashArrayEntry GraphCard Card))
(RETURN (NC.GraphRemoveNode NodeToRemove Graph Window)))
(* If there are companion virtual nodes, ask for user
confirmation.)
(if [AND (NOT DeleteCardFlg)
(GREATERP (SETQ NumVirtuals (LENGTH NodesToRemove))
1)
(NOT (PROGN (NC.PrintMsg Window T NumVirtuals
" virtual companion nodes will be removed."
(CHARACTER 13))
(NC.YesP (NC.AskUser "Still want to remove? " "--"
(QUOTE Yes)
NIL Window NIL NIL T]
then (FLIPNODE NodeToRemove Window)
(RETURN NIL)) (* Delete the browsercontents link from the browser.)
(AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard)
(NC.DelBrowserContentsLink GraphCard Card))
(* Delete all record of links to and from this node on
prop lists.)
(NC.SmashGraphNodeIDProps NodeToRemoveID)
(for Node in (fetch (GRAPH GRAPHNODES) of Graph) eachtime (BLOCK)
bind UID when (type? UID (SETQ UID (NC.CoerceToGraphNodeID Node)))
do (NC.GraphNodeIDRemProp UID NodeToRemoveID))
(if (AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard))
then (* Remove from the root ids list.)
(SETQ RootCards (NC.FetchBrowserRoots GraphCard))
(if (for RootCard in RootCards eachtime (BLOCK)
thereis (NC.SameCardP Card RootCard))
then (NC.SetBrowserRoots GraphCard (for RootCard in RootCards
eachtime (BLOCK)
unless (NC.SameCardP Card
RootCard)
collect RootCard)))
(* Remove entry for this node from browser hash
array.)
(NC.RemoveBrowserNodeHashArrayEntry GraphCard Card))
(* Get rid of node and its virtual buddies from
graph.)
(AND Window (FLIPNODE NodeToRemove Window))
(for Node in NodesToRemove do (NC.GraphRemoveNode Node Graph Window))
(* Delete card if we're supposed to.)
(if DeleteCardFlg
then (NC.PrintMsg NIL T "Deleting " Card " ... ")
(NC.DeleteNoteCard Card)
(NC.PrintMsg NIL T "Done." (CHARACTER 13)))
(AND Window (REDISPLAYW Window))
(OR QuietFlg (NC.PrintMsg NIL T "Nodes: " [CONCATLIST
(for Node in NodesToRemove
collect (PACK* (fetch (GRAPHNODE NODEID)
of Node)
(QUOTE % ]
"removed."])
)
(* * changes to NCDATABASE)
(DEFINEQ
(NC.CopyCards
[LAMBDA (Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow)
(* Randy.Gobbel "18-Mar-87 16:00")
(* * Create copies of cards in Cards. If DestNoteFileOrFileBox is a notefile, then destination will be the contents
box in that notefile, else the FileBox's notefile. RootCards should be NIL or a subset of Cards.
If NIL, then file all Cards in the dest filebox. Otherwise, just file RootCards in that filebox and assume others
are linked somehow to the RootCards. Links between cards in Cards are copied, but links from or to outside cards
aren't.)
(* * Currently all Cards must be in same notefile, but this perhaps could be relaxed if could prevent possibility
of two cards in different notefiles having the same UID.)
(* * kirk 24Apr86 Added calls to select cards if none provided)
(* * rht 9/2/86: Added InterestedWindow arg.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper)
(NC.CardSelectionOperation (LET (NumCards SourceNoteFile DestNoteFile BoxToFileIn TempStream
CardHashArray LinksHashArray CurrentLinkLabels
NewLinkLabels NewCardsAndLocsOnStream)
(* * Make sure the arguments are valid.)
(if (NULL Cards)
then (if (NULL (SETQ Cards
(NC.SelectNoteCards NIL NIL
NC.SelectingCardsMenu NIL
"Shift-select from the same NoteFile cards to copy:")))
then (ERROR!)))
(SETQ Cards (MKLIST Cards))
(SETQ NumCards (LENGTH Cards))
(* All Cards to copy must live in same notefile.)
(SETQ SourceNoteFile (fetch (Card NoteFile)
of (CAR Cards)))
(if [NOT (AND (type? NoteFile SourceNoteFile)
(OPENP (fetch (NoteFile Stream)
of SourceNoteFile]
then (NC.ReportError "NC.CopyCards"
(CONCAT (fetch (NoteFile
FullFileName)
of SourceNoteFile)
" not an open notefile.")))
(if (NOT (for Card in Cards
always (NC.SameNoteFileP (fetch
(Card NoteFile)
of Card)
SourceNoteFile)))
then (NC.ReportError "NC.CopyCards"
"All cards in Cards arg don't live in the same notefile."))
(* Compute dest notefile and dest filebox.)
(if (NOT DestNoteFileOrFileBox)
then (if (EQ (QUOTE CANCELLED)
(SETQ DestNoteFileOrFileBox
(NC.SelectNoteCards T NIL
NC.SelectingCardMenu NIL
"Shift-select the FileBox to contain these cards."
T)))
then (ERROR!)))
(if (type? NoteFile DestNoteFileOrFileBox)
then (SETQ DestNoteFile DestNoteFileOrFileBox)
(SETQ BoxToFileIn (fetch (NoteFile
TableOfContentsCard)
of DestNoteFile))
elseif (NCP.FileBoxP DestNoteFileOrFileBox)
then (SETQ BoxToFileIn DestNoteFileOrFileBox)
(SETQ DestNoteFile (fetch (Card NoteFile)
of BoxToFileIn))
else (NC.ReportError "NC.CopyCards" (CONCAT
"Arg not notefile or filebox: "
DestNoteFileOrFileBox)))
(if [NOT (AND (type? NoteFile DestNoteFile)
(OPENP (fetch (NoteFile Stream)
of DestNoteFile]
then (NC.ReportError "NC.CopyCards"
(CONCAT (fetch (NoteFile
FullFileName)
of DestNoteFile)
" not an open notefile.")))
(if (LDIFFERENCE (SETQ RootCards (MKLIST RootCards))
Cards)
then (NC.ReportError "NC.CopyCards"
"RootCards argument not subset of Cards argument."))
(if (NULL RootCards)
then (SETQ RootCards Cards))
(* * Now get to work.)
(SETQ TempStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
(SETQ CurrentLinkLabels (NC.RetrieveLinkLabels DestNoteFile))
(SETQ NewLinkLabels (TCONC NIL))
(SETQ LinksHashArray (HASHARRAY
NC.CopyCardsLinksHashArraySize NIL
(FUNCTION NC.MakeHashKey)
(FUNCTION NC.SameUIDP)))
(SETQ CardHashArray (HASHARRAY NumCards NIL
(FUNCTION
NC.MakeHashKeyFromCard)
(FUNCTION NC.SameCardP)))
(* * Create new cards in DestNoteFile for each card. Make these cards by copying original cards to a temp stream.
Keep track of UID mappings between original cards and card copies using CardHashArray.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Copying cards: creating empty copies."
(CHARACTER 13)
"Processing item " 1 " out of "
NumCards "..." (CHARACTER 13)))
(SETQ NewCardsAndLocsOnStream
(for Card in Cards as i from 1
bind NewCard WasActiveFlg HadStatusNILFlg IndexLocs
eachtime (BLOCK)
collect [OR QuietFlg (if (ZEROP (REMAINDER i 100))
then (NC.PrintMsg
InterestedWindow T
"Copying cards: creating empty copies."
(CHARACTER 13)
"Processing item " i
" out of "
NumCards "..."
(CHARACTER 13]
(if (NOT (SETQ WasActiveFlg (NC.ActiveCardP
Card)))
then (NC.GetNoteCard Card))
(if (SETQ HadStatusNILFlg
(NULL (fetch (Card Status)
of Card)))
then
(* Have to have Status slot ACTIVE in order that Put
to stream won't break.)
(replace (Card Status) of Card
with (QUOTE ACTIVE)))
(SETQ IndexLocs (NC.PutNoteCardToStream Card
NIL T
TempStream))
(if HadStatusNILFlg
then (replace (Card Status) of Card
with NIL))
(if (NOT WasActiveFlg)
then (NC.DeactivateCard Card))
(* Make new empty card for copy.)
(SETQ NewCard (NC.GetNewCard DestNoteFile))
(* Map old cards to card copies.)
(PUTHASH Card NewCard CardHashArray)
(CONS NewCard IndexLocs)))
(* * For each card, get it off the temp stream, fix its links, fix browser info if necessary, and write it down to
the dest notefile.)
(SETFILEPTR TempStream 0)
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Copying cards: fixing links and browser cards."
(CHARACTER 13)
"Processing item " 1 " out of "
NumCards "..." (CHARACTER 13)))
(for NewCardAndLocsOnStream in NewCardsAndLocsOnStream
as i from 1 eachtime (BLOCK)
do [OR QuietFlg (if (ZEROP (REMAINDER i 100))
then (NC.PrintMsg InterestedWindow
T
"Copying cards: fixing links and browser cards."
(CHARACTER
13)
"Processing item "
i " out of "
NumCards "..."
(CHARACTER
13]
(LET ((NewCard (CAR NewCardAndLocsOnStream))
(IndexLocs (CDR NewCardAndLocsOnStream)))
(* Have to make status active for Get fns to work.)
(NC.SetStatus NewCard (QUOTE ACTIVE))
(NC.GetNoteCardFromStream NewCard TempStream
IndexLocs)
(NC.FixUpLinksInCardCopy NewCard CardHashArray
LinksHashArray
CurrentLinkLabels
NewLinkLabels)
(if (NC.IsSubTypeOfP (NC.FetchType NewCard)
(QUOTE Browser))
then (NC.FixUpBrowserCardCopy NewCard
CardHashArray))
(NC.PutNoteCard NewCard)))
(* * Link RootCards under filebox in DestNotefile.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Copying cards: filing "
(LENGTH RootCards)
" new cards in "
(NC.FetchTitle BoxToFileIn)
"..."
(CHARACTER 13)))
(NC.FileBoxCollectChildren NIL BoxToFileIn
(for RootCard in RootCards
eachtime (BLOCK)
collect (GETHASH RootCard
CardHashArray))
T)
(* * Put out any new link labels to the dest notefile.)
(AND (SETQ NewLinkLabels (CDAR NewLinkLabels))
(NC.StoreLinkLabels DestNoteFile (APPEND NewLinkLabels
CurrentLinkLabels)))
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
Cards])
(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])
)
(* * changes to NCINTERFACE)
(DEFINEQ
(NC.DeleteStructure
[LAMBDA (RootCards TraversalSpecs InterestedWindow QuietFlg Don'tPutToBeDeletedCardsFlg)
(* Randy.Gobbel "18-Mar-87 15:58")
(* * 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)
(* * turned NC.ProtectedSessionOperation into NC.CardSelectionOperation)
(NC.CardSelectionOperation (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.CopyStructure
[LAMBDA (RootCards DestinationFileBox TraversalSpecs InterestedWindow QuietFlg)
(* Randy.Gobbel "18-Mar-87 15:53")
(* * Copy a NoteCard structure into a filebox)
(* * kirk 13/7/86: Placed TraversalSpecs after RootCards selection and changed prompt message)
(* * rht 9/2/86: Threw away CheckFlg arg. Wasn't being used. Changed to call NCP.CollectCards instead of outdated
NC.CollectCards. Changed arg named ToPosition to DestinationFileBox. Also changed FromCard to RootCard.
Passes two link types to NC.AskTraversalSpecs.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rht 3/9/87: Now accepts multiple root cards.)
(* * rg 3/9/87 added NC.ProtectedSessionOperation wrapper)
(* * RG 3/18/87 changed NC.ProtectedSessionOperation to NAMED-RESETLST)
(DECLARE (GLOBALVARS NC.SelectingCardsMenu NC.SelectingCardMenu))
(NC.CardSelectionOperation (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]
(ERROR!))
(OR DestinationFileBox (SETQ DestinationFileBox
(NC.SelectNoteCards T (FUNCTION [LAMBDA (Card)
(NC.FileBoxP Card T])
NC.SelectingCardMenu NIL
"Shift-select the FileBox to contain the structure."))
(ERROR!))
(NC.CopyCards (NCP.CollectCards RootCards (fetch (TRAVERSALSPECS
LinkTypes)
of TraversalSpecs)
(fetch (TRAVERSALSPECS Depth)
of TraversalSpecs))
DestinationFileBox RootCards QuietFlg InterestedWindow]
)
(NC.SelectNoteCards
[LAMBDA (SingleCardFlg SelectionPredicate Menu InstigatingCardOrWindow Msg CheckForCancelFlg)
(* Randy.Gobbel "19-Mar-87 12:10")
(* Select a set of note cards or a single note card, depending on SingleCardFlg. Works by interpreting all mouse
presses until a card has been chosen (if SingleCardFlg is T) or until the Done button has been pressed
(if SingleCardFlg is NIL). If the mouse press occus within a Title bar of a notecard, add that note card to the
selected list. Otherwise, if you are pointing into a note card, call the BUTTONEVENTFN for that note card.
The Selection in Progress flag has been set, so all note card BUTTONEVENTFNs should know to ignore all presses
except those that occur on link icons. Link icon presses should simply add the desination of that link to the
selected note cards list. This function should always be called from inside of an NC.CardSelectionOperation
wrapper.)
(* * rht 8/1/84: Changed second RESETSAVE call to give NC.ClearMsg a NIL argument.)
(* * rht 1/9/85: Fixed so now prints name of selected item even it's a link.)
(* * rht 2/15/85: Now can backspace over last selection chosen. Added new arg Msg so that when we reprint the list,
we can reprint the message as well.)
(* * rht 3/23/85: Added the CheckForCancelFlg arg, which if non-nil causes Cancel to be handled differently then
Done after no selections. Namely, Cancel will return the atom CANCELLED whereas Done with no selections returns
NIL. If CheckForCancelFlg is NIL then NIL is returned in both cases.)
(* * fgh 11/14/85 Updated to handle Card and NoteFile objects.)
(* * rht 11/18/85: Fixed so able to select when InstigatingNoteFile is NIL.)
(* * fgh 12/20/85 Totally rewritten for 1.3 selection mechanism. Based on COPYINSERT now rather than on takingf
over the mouse process.)
(* * fgh 1/15/86 Added call to SPAWN.MOUSE in case this is called under the mouse process)
(* * kirk 25Apr86 Changed to use SessionIcon (NC.NoteCardsIconWindow) rather than PROMPTWINDOW if no Instigating
window is supplied.)
(* * fgh 7/5/86 Added code to put CRs into printout of selected cards in order to keep prompt window from getting
infinitely wide to accomdate the printout.)
(* * rht 10/5/86: Now allows choice of cards from remote notefile.)
(* * rht 10/18/86: Give TTY process to process that originally had it if possible.)
(* * rht & pmi 11/14/86: Now checks for valid card before testing SelectionPredicate.)
(* * pmi 12/5/86 Modified prompt messages to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument.)
(* * rg 3/18/87 reworked for NC.CardSelectionOperation: added NAMED-RESETSAVE forms for Card locking.)
(DECLARE (USEDFREE NC.SelectNoteCardsResetVar))
(LET (Window Card ButtonEventFn InstigatingWindow InstigatingCard InstigatingNoteFile MenuWindow
PromptWindow CopyInsertEvent SelectedCards PromptWindowProcess OldTTYProcess
OpInProgress ResetItems TTYResetVar InternalResetVar)
(NAMED-RESETLST
InternalResetVar
(OR SelectionPredicate (SETQ SelectionPredicate (FUNCTION TRUE)))
[COND
((NC.CardP InstigatingCardOrWindow)
(SETQ InstigatingWindow (NC.FetchWindow InstigatingCardOrWindow))
(SETQ PromptWindow (NC.AttachPromptWindow InstigatingWindow)))
((WINDOWP InstigatingCardOrWindow)
(SETQ InstigatingWindow InstigatingCardOrWindow)
(SETQ PromptWindow (NC.AttachPromptWindow InstigatingWindow)))
(T (SETQ InstigatingWindow (SETQ PromptWindow (NC.AttachPromptWindow
NC.NoteCardsIconWindow]
(SETQ InstigatingCard (NC.CoerceToCard InstigatingCardOrWindow))
(SETQ InstigatingNoteFile (AND InstigatingCard (fetch (Card NoteFile) of
InstigatingCard)))
(NC.PrintMsg InstigatingWindow T (COND
(Msg (CONCAT Msg (CHARACTER 13)))
(T ""))
"Items shift-selected: ")
(SETQ OldTTYProcess (TTY.PROCESS))
(* * if we are running under the mouse process, start up a new mouse process)
(ALLOW.BUTTON.EVENTS)
(* * Set up the prompt window for proper use by the CopyInsertFn)
(WINDOWPROP PromptWindow (QUOTE COPYINSERTFN)
(FUNCTION NC.SelectNoteCardsCopyInsertFn))
[WINDOWPROP PromptWindow (QUOTE CopyInsertEvent)
(SETQ CopyInsertEvent (CREATE.EVENT (QUOTE CopyInsertEvent]
(NAMED-RESETSAVE InternalResetVar (WINDOWPROP PromptWindow (QUOTE SelectedCards)
NIL)
(BQUOTE (WINDOWPROP , PromptWindow (QUOTE SelectedCards)
NIL)))
(NAMED-RESETSAVE InternalResetVar (WINDOWPROP PromptWindow (QUOTE SelectingCards)
T)
(BQUOTE (WINDOWPROP , PromptWindow SelectingCards NIL)))
(NAMED-RESETSAVE InternalResetVar (WINDOWPROP PromptWindow (QUOTE SelectCardsMonitor)
(CREATE.MONITORLOCK (QUOTE
SelectCards)))
(BQUOTE (WINDOWPROP , PromptWindow SelectCards NIL)))
(* * Make the process behind the prompt window includiong control for a blibnking cursor)
[WINDOWPROP PromptWindow (QUOTE PROCESS)
(SETQ PromptWindowProcess (ADD.PROCESS
(QUOTE (PROG NIL (BLOCK)
(TTYDISPLAYSTREAM (PROCESSPROP (THIS.PROCESS)
(QUOTE WINDOW)))
XXXX
(BIN)
(BLOCK)
(GO XXXX)))
(QUOTE WINDOW)
PromptWindow
(QUOTE NAME)
(QUOTE SelectNoteCardsProc)
(QUOTE TTYENTRYFN)
(FUNCTION [LAMBDA (Process)
(PROCESSPROP Process (QUOTE OldCaret)
(CARET CROSSHAIRS))
(ECHOMODE])
(QUOTE TTYEXITFN)
(FUNCTION (LAMBDA (Process)
(CARET (PROCESSPROP Process (QUOTE OldCaret)))
(ECHOMODE T]
(NAMED-RESETSAVE InternalResetVar NIL (BQUOTE (DEL.PROCESS , PromptWindowProcess)))
(* * Insure the prompt window is cleared on the way out)
[NAMED-RESETSAVE InternalResetVar NIL
(BQUOTE (PROGN (AND (HASTTYWINDOWP , PromptWindowProcess)
(TTY.PROCESS (if (AND (PROCESSP
, OldTTYProcess)
(HASTTYWINDOWP
, OldTTYProcess)
)
then , OldTTYProcess
else T)))
(NC.ClearMsg , InstigatingWindow T]
(* * Set up the menu above the prompt window)
(* fix in case MENUPOSITION is set incorrectly in menu
passed down)
(replace (MENU MENUPOSITION) of Menu
with (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0)))
[NAMED-RESETSAVE InternalResetVar (ATTACHMENU Menu PromptWindow (if
InstigatingWindow
then
(QUOTE TOP)
else (QUOTE
BOTTOM))
(QUOTE LEFT))
(BQUOTE (PROGN (DETACHWINDOW (WFROMMENU , Menu))
(DELETEMENU , Menu T]
(* * If there is an instigating window, make sure it and all its attachments are visible on the screen.)
(if InstigatingWindow
then (NC.MoveWindowOntoScreen InstigatingWindow))
(* * Give the prompt window the tty process)
(TTY.PROCESS (WINDOWPROP PromptWindow (QUOTE PROCESS)))
(* * Loop as long as necessary)
[WITH.MONITOR
(WINDOWPROP PromptWindow (QUOTE SelectCardsMonitor))
(until (OR (EQ SelectedCards (QUOTE CANCELLED))
(AND SingleCardFlg SelectedCards)
(EQ (CAR SelectedCards)
(QUOTE DONE)))
do
(
(* * Wait for the user to respond by copy inserting something into the prompt window)
(until [NOT (EQ SelectedCards (WINDOWPROP PromptWindow (QUOTE
SelectedCards]
do (MONITOR.AWAIT.EVENT (WINDOWPROP PromptWindow (QUOTE
SelectCardsMonitor))
CopyInsertEvent))
(* * Get the latest selection list)
(SETQ SelectedCards (WINDOWPROP PromptWindow (QUOTE SelectedCards)))
(NAMED-RESETLST
TTYResetVar
(* * Turn off the caret)
(NAMED-RESETSAVE TTYResetVar (TTY.PROCESS (THIS.PROCESS)))
(* * If the last thing wasn't a done or cancel, process the new selection)
(SETQ Card (CAR SelectedCards))
(WITH.MONITOR
NC.LockLock
(COND
((AND (NEQ Card (QUOTE DONE))
(NEQ SelectedCards (QUOTE CANCELLED))
(NEQ Card (QUOTE *New% Card*)))
(* * Check to make sure that the selection is valid)
[COND
((EQ Card (QUOTE *Undo% Selection*))
(* Chop off two elements from the list -
the indicator and the previous item.)
(SETQ Card (CADR SelectedCards))
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
(SETQ SelectedCards (CDDR SelectedCards)))
(* now get our hands off of all the locks we've
acquired for this card)
(NAMED-RESETUNSAVE NC.SelectNoteCardsResetVar (NC.FetchUserDataProp
Card
(QUOTE ResetItems)))
(NC.SetUserDataProp Card (QUOTE ResetItems)
NIL)
(NC.ClearMsg InstigatingWindow NIL))
[(OR (NOT (NC.ValidCardP Card))
(NULL (APPLY* SelectionPredicate Card)))
(* Does this card match the slection predicate)
(NC.PrintMsg InstigatingWindow T "*** Invalid selection. ***"
(CHARACTER 13))
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
(SETQ SelectedCards (CDR SelectedCards]
((SETQ OpInProgress (NC.CardCheckOpInProgress Card))
(NC.PrintOperationInProgressMsg InstigatingWindow "Select Card"
OpInProgress)
(DISMISS 1000)
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
(SETQ SelectedCards (CDR SelectedCards)))
(NC.ClearMsg InstigatingWindow NIL))
(T (* A valid selection.)
(NC.ClearMsg InstigatingWindow NIL)
(SETQ ResetItems NIL)
(SETQ ResetItems (CONS (NAMED-RESETSAVE
NC.SelectNoteCardsResetVar
(NC.SetUserDataProp
Card
(QUOTE
ProcessInProgress)
(THIS.PROCESS))
(BQUOTE (
NC.SetUserDataProp
, Card
ProcessInProgress NIL)
))
ResetItems))
(SETQ ResetItems (CONS (NAMED-RESETSAVE
NC.SelectNoteCardsResetVar
(NC.SetUserDataProp
Card
(QUOTE
OperationInProgress)
"Select Card")
(BQUOTE (
NC.SetUserDataProp
, Card
OperationInProgress NIL)
))
ResetItems))
(SETQ ResetItems
(CONS [NAMED-RESETSAVE NC.SelectNoteCardsResetVar
[NC.NoteFileProp
(fetch (Card NoteFile) of Card)
(QUOTE CardProcessInProgressList)
(CONS (THIS.PROCESS)
(NC.NoteFileProp
(fetch (Card NoteFile)
of Card)
(QUOTE
CardProcessInProgressList]
(BQUOTE (NC.ResetCardProcessInProgress
,
(fetch (Card NoteFile)
of Card]
ResetItems))
(SETQ ResetItems (CONS [NAMED-RESETSAVE
NC.SelectNoteCardsResetVar
(SETQ NC.CardBusyList (CONS (
THIS.PROCESS)
NC.CardBusyList))
(QUOTE (SETQ NC.CardBusyList
(DREMOVE (
THIS.PROCESS)
NC.CardBusyList]
ResetItems))
(NAMED-RESETSAVE InternalResetVar (NC.SetUserDataProp
Card
(QUOTE ResetItems)
ResetItems)
(BQUOTE (NC.SetUserDataProp , Card ResetItems
NIL]
(* * Print the results in the prompt window)
(NC.PrintMsg InstigatingWindow NIL (COND
(Msg (CONCAT Msg (CHARACTER 13)))
(T ""))
"Items selected: ")
(for ThisCard in (REVERSE SelectedCards)
do (NC.PrintMsg InstigatingWindow NIL (NC.RetrieveTitle ThisCard)
", ")
(if [AND InstigatingWindow (GREATERP
(DSPXPOSITION NIL PromptWindow)
(TIMES 1.25 (WINDOWPROP InstigatingWindow
(QUOTE WIDTH]
then (NC.PrintMsg InstigatingWindow NIL (CHARACTER 13]
(* * Return the result)
(PROG1 [COND
((EQ SelectedCards (QUOTE CANCELLED))
(COND
(CheckForCancelFlg (QUOTE CANCELLED))
(T NIL)))
(SingleCardFlg (if (EQ (CAR SelectedCards)
(QUOTE DONE))
then NIL
else (CAR SelectedCards)))
(T (if (EQ (CAR SelectedCards)
(QUOTE DONE))
then (DREVERSE (CDR SelectedCards))
else (DREVERSE SelectedCards]
(WINDOWPROP PromptWindow (QUOTE SelectedCards)
NIL])
(NC.NoteFileOperations
[LAMBDA (NoteFile) (* Randy.Gobbel "12-Mar-87 17:51")
(* Ask user to choose which database operation.
Called from main menu whenselected fn.)
(* * fgh 11/14/85 Updated to handle NoteFile object and per NoteFile menus.)
(* * kirk 14Jan86 Added Close/Delete cards and changed the format)
(* * fgh 6/13/86 Now sets BusyOperation of NF menu to something interesting.)
(* * kirk 3Jul86 passed NoteFileMenuWindow to NC.CompactNoteFile)
(* * fgh 7/5/86 Fixed above fix and put NoteFileMenuWindow is all calls.)
(* * rht 7/5/86: Added read-only open to notefileops menu.)
(* * kirk 7/14/86 Took comma out of FullFileName in NC.DeleteDatabaseFile call)
(* * kirk 15Jul86 Added Grey shade to non-functional items when file is open/closed)
(* * kef 8/6/86: Added SPAWN.MOUSE towards the end to eliminate the extraneous printing of "NoteFile Busy" which
seemed to be constantly occurring for remote NoteFiles.)
(* * pmi 12/4/86 Removed menu creation and shading of operations for open or closed NoteFile.
Now just uses appropriate pre-defined menu, depending on whether NoteFile is open or closed.)
(* * rht 2/11/87: Now makes sure NC.OpenedNoteFileMenu and NC.ClosedNoteFileMenu are non-nil.)
(DECLARE (GLOBALVARS NC.OpenedNoteFileMenu NC.ClosedNoteFileMenu))
(if (OR (NULL NC.OpenedNoteFileMenu)
(NULL NC.ClosedNoteFileMenu))
then (NC.MakeNoteFileIconOperationsMenus))
(LET (Menu)
(if (NC.NoteFileOpenP NoteFile)
then (SETQ Menu NC.OpenedNoteFileMenu)
else (SETQ Menu NC.ClosedNoteFileMenu))
(PUTMENUPROP Menu (QUOTE NoteFile)
NoteFile)
(ALLOW.BUTTON.EVENTS)
(MENU Menu])
)
(* * changes to NCUTILITIES)
(DEFINEQ
(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.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])
)
(* * changes to NCSEARCHCARD)
(DEFINEQ
(NC.MakeSearchCard
[LAMBDA (Card Title NoDisplayFlg) (* Randy.Gobbel "16-Mar-87 18:32")
(* Search for cards with specified characteristics and create a list card containing pointers to these cards.
For now search is limited to cards whose title contains a specified string.)
(* * rht 11/8/84: Fixed some confusion between ListCardID and ID variables.)
(* * fgh 11/17/85 Updated to handle multiple notefiles and crad objects.)
(* * rht 4/11/86: changed to call NC.ApplySuper.)
(* * rht 10/21/86: Now deletes card if no search string specified.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(LET ((NoteFile (fetch (Card NoteFile) of Card))
SearchString HitCards WindowOrCard Window)
(SPAWN.MOUSE)
(SETQ WindowOrCard (NC.ApplySupersFn MakeFn Card (OR Title "SearchCard")
NoDisplayFlg))
(NC.ActivateCard Card)
(SETQ Window (AND (WINDOWP WindowOrCard)
WindowOrCard))
(SETQ SearchString (NC.AskUser "Please enter the search string: " NIL NIL T Window))
(if (OR (EQUAL SearchString "")
(NOT SearchString))
then (NC.DeleteNoteCard Card)
NIL
else [NC.SetTitle Card (SETQ Title (OR Title (CONCAT "Cards with %""
SearchString "%" in title"]
(AND Window (WINDOWPROP Window (QUOTE TITLE)
Title))
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(NC.PrintMsg Window T "Searching for cards ...")
(SETQ HitCards (NC.TitleSearch NoteFile SearchString))
(TEDIT.INSERT (NC.FetchSubstance Card)
(CONCAT " List compiled on: " (DATE)
(CHARACTER 13)
(CHARACTER 13))
1)
(for HitCard in HitCards unless (EQ HitCard Card)
do (NC.InsertLinkBeforeMarker Card HitCard
NC.ListContentsLinkLabel NIL NIL))
(NC.PrintMsg Window NIL "Done!" (CHARACTER 13)))
(BLOCK 250)
(NC.ClearMsg Window T)
WindowOrCard])
)
(* * changes to NCDOCUMENTCARD)
(DEFINEQ
(NC.MakeDocument
[LAMBDA (Card Title NoDisplayFlg CardIdentifier) (* Randy.Gobbel "18-Mar-87 16:19")
(* * Called from a filebox's title bar. Makes a document by smashing all the descendant cards's text together.
Ask user if wants numbered section headings and titles. The former are made from FileBox titles, the latter from
notecard titles. Delete embedded links at the end if the user desires.)
(* * rht 10/22/84: Hacked to be callable from Programmer's interface.)
(* * rht 11/17/84: Checks for cancel when choosing rootID and also when setting parameters.)
(* * rht 8/25/85: Now dumps sketch and graph cards as well as text cards.)
(* * rht 9/16/85: Now handles cr's around titles using para leading.)
(* * fgh 11/178/85 Updated to handle Card and NoteFile objects.)
(* * kirk 27Jun86 Moved NC.RetrieveTitle call so does not break when user Cancels)
(* * rht 7/31/86: Now checks for card types having ExportSubstanceFn prop.)
(* * kirk 8/22/86 Fix of free use of NoteFile var)
(* * rht 10/15/86: Integrated markM's changes and fixed box numbering.)
(* * rht 11/17/86: Now calls NC.ApplySupersFn rather than NC.MakeNoteCard.)
(* * pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.)
(* * pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(* * rg 3/18/87 added NC.CardSelectionOperation wrapper. Still needs ProtectedCardOperation wrapper!)
(NC.CardSelectionOperation (PROG (RootCard RootTitle DocWindow DocCard DocWindowOrCard
DocStream HeadingsFromFileboxes TitlesFromNoteCards
BuildBackLinks CopyEmbeddedLinks ExpandEmbeddedLinks
InspectWin RootSubstanceType)
(OR NoDisplayFlg (SPAWN.MOUSE))
(SETQ DocWindowOrCard (NC.ApplySupersFn MakeFn Card
"Document"
NoDisplayFlg))
(if NoDisplayFlg
then (SETQ DocWindow NIL)
(SETQ DocCard DocWindowOrCard)
else (SETQ DocWindow DocWindowOrCard)
(SETQ DocCard (NC.CoerceToCard DocWindow)))
(* NC.MakeNoteCard either returned an Card or a window
depending on NoDisplayFlg.)
(SETQ RootCard (OR (NC.CoerceToCard CardIdentifier)
(NC.SelectNoteCards T NIL
NC.SelectingCardMenu
DocWindow
"Please shift-select the Note Card or File Box the document should start from.")))
(if (NOT RootCard)
then (NC.DeleteNoteCard Card)
(RETURN NIL))
(SETQ RootTitle (NC.RetrieveTitle RootCard))
(NC.SetTitle DocCard (CONCAT "Document from %"" RootTitle
"%""))
(AND DocWindow (WINDOWPROP DocWindow (QUOTE TITLE)
(NC.RetrieveTitle DocCard)))
(SETQ DocStream (NC.FetchSubstance DocCard))
(* * Get MakeDocument parameters from user via inspector window.)
(if (NOT NoDisplayFlg)
then (SETQ InspectWin (NC.BuildMakeDocInspector
DocWindow))
(TOTOPW InspectWin)
(for while (OPENWP InspectWin)
do (BLOCK)))
(if (EQ (GETPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--))
(QUOTE QUIT))
then (PUTPROP (QUOTE NC.MakeDocParameters)
(QUOTE --DONE--)
(QUOTE --CANCEL--))
(NC.DeleteNoteCard Card)
(RETURN NIL))
(SETQ HeadingsFromFileboxes (GETPROP (QUOTE
NC.MakeDocParameters)
(QUOTE
HeadingsFromFileboxes)))
(SETQ TitlesFromNoteCards (GETPROP (QUOTE
NC.MakeDocParameters)
(QUOTE
TitlesFromNoteCards)))
(SETQ BuildBackLinks (GETPROP (QUOTE
NC.MakeDocParameters)
(QUOTE BuildBackLinks)))
(SETQ CopyEmbeddedLinks (GETPROP (QUOTE
NC.MakeDocParameters)
(QUOTE
CopyEmbeddedLinks)))
(SETQ ExpandEmbeddedLinks (GETPROP (QUOTE
NC.MakeDocParameters)
(QUOTE
ExpandEmbeddedLinks)))
(* * Call recursive routine to dump filebox.)
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(NC.PrintMsg DocWindow NIL
"Collecting text from descendant cards ... ")
(* * Clean up the SeenBefore markers placed on the cards and boxes just copied.)
[RESETSAVE
NIL
(QUOTE (PROGN (for Card
in (NC.FetchUserDataProp
DocCard
(QUOTE SeenCards))
do (NC.SetUserDataProp
Card
(QUOTE SeenBefore)
NIL))
(NC.SetUserDataProp
DocCard
(QUOTE SeenCards)
NIL]
(* * Unbelievably kludgy hack to get around Intermezzo TEdit bug. Just insert and delete a CR.)
(TEDIT.INSERT DocStream NC.CRString 1)
(TEDIT.DELETE DocStream 1 1)
(NC.DumpCardToDoc RootCard DocCard DocStream 0 0
HeadingsFromFileboxes
TitlesFromNoteCards
BuildBackLinks
CopyEmbeddedLinks
ExpandEmbeddedLinks)
(NC.PrintMsg DocWindow NIL "Done!"))
(COND
((NOT NoDisplayFlg)
(BLOCK 250)
(NC.ClearMsg DocWindow T)))
(RETURN DocWindowOrCard])
)
(* * changes to NCLINKINDEXCARD)
(DEFINEQ
(NC.MakeLinkIndex
[LAMBDA (Card Title NoDisplayFlg SpecialArgsList) (* Randy.Gobbel "16-Mar-87 18:35")
(* * Gather all instances of a given set of linktypes, printing the titles of cards at the from and to ends of the
link.)
(* * rht 10/24/84: Now callable from Programmer's interface. If NoDisplayFlg it non-nil, then will build LinkIndex
invisibly. If SpecialArgsList is non-nil, then should be list of (<linklabels> <backpointersP>))
(* * rht 9/21/85: Now uses stylesheet for LinkIndexSpecs. Broke out workhorse code into the function
NC.ComputeLinkIndex)
(* * fgh 11/17/85 Updated to handle Card objects.)
(* * rht 4/11/86: Took out call to NCP.AddTitleBarMenuItems. Now done in NC.AddLinkIndexCard.
Also changed to call NC.ApplySuper.)
(* * rht 9/5/86: Now bails out properly if user aborts in stylesheet.)
(* * rht 9/19/86: Now passes IndexCard rather than Window to NC.AskLinkIndexSpecs. Added call to NC.HoldTTYProcess
to keep linkindexspecs on top.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(PROG ((LinkLabels (CAR SpecialArgsList))
(BackLinksFlg (CADR SpecialArgsList))
Window LinkIndexSpecs)
(SPAWN.MOUSE)
(SETQ Window (WINDOWP (NC.ApplySupersFn MakeFn Card (CONCAT "Link Index: "
(DATE))
NoDisplayFlg)))
(if (NOT NoDisplayFlg)
then (NC.HoldTTYProcess)
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Card LinkLabels BackLinksFlg T))
(if (NULL LinkIndexSpecs)
then (NC.DeleteNoteCards Card)
(RETURN NIL))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs)))
(NC.ComputeLinkIndex Card LinkLabels BackLinksFlg)
(RETURN (if NoDisplayFlg
then Card
else (NC.ClearMsg Window T)
Window])
)
(* * new for NCUTILITIES)
(DECLARE: EVAL@COMPILE
(DEFMACRO ABORT.PROTECT (MAIN-FORM CLEANUP-FORM)
(BQUOTE (RESETLST (RESETSAVE NIL (QUOTE (AND RESETSTATE , CLEANUP-FORM)))
, MAIN-FORM)))
[DEFMACRO NC.CardSelectionOperation (&BODY Body)
(BQUOTE (LET (NC.SelectNoteCardsResetVar)
(NAMED-RESETLST NC.SelectNoteCardsResetVar ,@ Body]
[PUTPROPS NAMED-RESETLST MACRO ((X . Y)
(PROG (RESETY RESETZ (LISPXHIST LISPXHIST))
[NAMED-RESETRESTORE (QUOTE X)
(SETQ RESETZ (COND ((XNLSETQ (SETQ RESETY (PROGN . Y))
INTERNAL)
NIL)
(T (QUOTE ERROR]
(RETURN (COND (RESETZ (ERROR!))
(T RESETY]
(DEFMACRO NAMED-RESETSAVE (RESETHANDLE &REST FORMS)
(BQUOTE (LET (RESETITEM)
(SETQ , RESETHANDLE
(CONS [SETQ
RESETITEM ,
(COND
[(AND (ATOM (CAR FORMS))
(CAR FORMS))
(SUBPAIR (QUOTE (VAR VAL))
(CDR X)
(QUOTE (PROG1 [CONS (QUOTE VAR)
(CONS (STKSCAN (QUOTE VAR))
(EVAL (QUOTE VAR]
(SET (QUOTE VAR)
VAL]
[(CDR FORMS)
(BQUOTE (LIST , (CADR FORMS)
,
(CAR FORMS]
(T (BQUOTE (LIST (LIST [QUOTE , (COND ((EQ (CAAR FORMS)
(QUOTE SETQ))
(CAR (CADDAR FORMS)))
(T (CAAR FORMS]
,
(CAR FORMS]
, RESETHANDLE))
RESETITEM)))
[DEFMACRO NAMED-RESETUNSAVE (RESETHANDLE ITEMFORM)
(BQUOTE (LET ((ITEMLIST , ITEMFORM))
(for ITEM in ITEMLIST do (SET RESETHANDLE (DREMOVE ITEM , RESETHANDLE))
(COND ((LISTP (CAR ITEM))
[SETQ OLDVALUE (COND ((CDR ITEM)
(CADR ITEM))
(T (CADAR ITEM]
(APPLY (CAAR ITEM)
(CDAR ITEM)))
(T (SET (CAR ITEM)
(CDR ITEM]
)
(DEFINEQ
(NAMED-RESETLST
[NLAMBDA RESETX (* Randy.Gobbel "19-Mar-87 11:06")
(* NAMED-RESETLST and NAMED-RESETSAVE act just like the generic versions, except that they take a RESETHANDLE
argument. This allows the scope of RESETLSTs to overlap. The RESETHANDLE variable should be bound inside of a LET
or PROG to ensure that different processes do not collide in their use of this facility.)
(PROG (RESETY RESETZ (LISPXHIST LISPXHIST))
(SET (CAR RESETX)
NIL)
[NAMED-RESETRESTORE (CAR RESETX)
(COND
((SETQ RESETY (ERRORSET (CONS (QUOTE PROGN)
(CDR RESETX))
(QUOTE INTERNAL)))
NIL)
(T (QUOTE ERROR]
[COND
(RESETY (RETURN (CAR RESETY]
(ERROR!])
(NAMED-RESETSAVE
[NLAMBDA RESETX (* Randy.Gobbel "19-Mar-87 19:33")
(* for use under a NAMED-RESETLST. If RESETX is atmic, like RESETVAR, otherwise like RESETFORM, i.e. performs the
resetting and saving associated with these functions. The restoration aad errorset protectionis done by
NAMED-RESETLST. The item added to RESETHANDLE is returned for possible later use by NAMED-RESETUNSAVE.
When used a la RESETFORM, can take a second argument whose value (computed before firt argument) is restoration
form, e.g. (NAMED-RESETSAVE FOO (SETSEPR --) (LIST (QUOTE SETSEPR) (GETSEPR))) (NAMED-RESETSAVE FOO NIL form) means
just add value of form to FOO)
(LET ((RESETHANDLE (CAR RESETX))
RESETITEM)
(SETQ RESETX (CDR RESETX))
(SET RESETHANDLE (CONS [SETQ RESETITEM (COND
[(AND (CAR RESETX)
(ATOM (CAR RESETX)))
(PROG1 (CONS (CAR RESETX)
(CAR RESETX))
(SET (CAR RESETX)
(EVAL (CADR RESETX)
(QUOTE INTERNAL]
[(CDR RESETX)
(* CADR of the entry put on resetvarslst is the value of the saving form. The variable OLDVALUE is bound to this
value during restoration. This makes it more convenient for the estoration to be conditional, e.g. the user can
perform (RESETSAVE (FOO mumble) (QUOTE (AND pred (FIE OLDVALUE)))))
(LIST (EVAL (CADR RESETX))
(EVAL (CAR RESETX]
(T (LIST (LIST (COND
((EQ (CAAR RESETX)
(QUOTE SETQ))
(CAR (CADDAR RESETX)))
(T (CAAR RESETX)))
(EVAL (CAR RESETX]
(EVAL RESETHANDLE)))
RESETITEM])
(NAMED-RESETRESTORE
[LAMBDA (RESETHANDLE RESETSTATE) (* Randy.Gobbel "18-Mar-87 19:07")
(* Goes down RESETHANDLE doing restoration until it gets to NIL. RESETSTATE is either NIL, ERROR, or RESET,
depending on whether restoration is at normal (successful) completion of a NAMED-RESETLST, following an error or
control-E, or following a control-D)
(PROG (RESETZ OLDVALUE (VARSLST (EVAL RESETHANDLE)))
LP (COND
(VARSLST (SETQ RESETZ (CAR VARSLST))
(SETQ VARSLST (CDR VARSLST))
[COND
((LISTP (CAR RESETZ))
[SETQ OLDVALUE (COND
((CDR RESETZ)
(* occurs for RESETSAVE's when second aagument is specified. In this case, (CADR RESETZ) is the value of the saving
form, i.e. the first argument to RESETSAVE.)
(CADR RESETZ))
(T (CADAR RESETZ]
(APPLY (CAAR RESETZ)
(CDAR RESETZ)))
(T (SET (CAR RESETZ)
(CDR RESETZ]
(GO LP)))
(SET RESETHANDLE NIL])
(NAMED-RESETUNSAVE
[NLAMBDA (RESETHANDLE ITEMFORM) (* Randy.Gobbel "19-Mar-87 12:04")
(LET ((ITEMLIST (EVAL ITEMFORM)))
(for ITEM in ITEMLIST
do (SET RESETHANDLE (DREMOVE ITEM (EVAL RESETHANDLE)))
(COND
((LISTP (CAR ITEM))
[SETQ OLDVALUE (COND
((CDR ITEM)
(CADR ITEM))
(T (CADAR ITEM]
(APPLY (CAAR ITEM)
(CDAR ITEM)))
(T (SET (CAR ITEM)
(CDR ITEM])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA NAMED-RESETSAVE NAMED-RESETLST)
(ADDTOVAR NLAML NAMED-RESETUNSAVE)
(ADDTOVAR LAMA )
)
(PUTPROPS RGPATCH018 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3291 23608 (NC.AddParents 3301 . 6103) (NC.DeleteNoteCards 6105 . 12265) (
NC.UnfileNoteCard 12267 . 14391) (NC.PrintOperationInProgressMsg 14393 . 15439) (NC.QuitWithoutSaving
15441 . 22046) (NC.DeleteNoteCard 22048 . 23606)) (23640 37055 (NC.MakeLink 23650 . 29953) (
NC.MakeFilingLinks 29955 . 32869) (NC.AddGlobalLinksToCard 32871 . 34898) (NC.AddLinksToCard 34900 .
37053)) (37089 38530 (NCP.SelectCards 37099 . 38528)) (38568 41595 (NC.FileBoxCollectChildren 38578 .
41593)) (41633 70153 (NC.MakeBrowserCard 41643 . 50178) (NC.UpdateBrowserCard 50180 . 61085) (
NC.BrowserAddNode 61087 . 64052) (NC.BrowserRemoveNode 64054 . 70151)) (70188 81321 (NC.CopyCards
70198 . 80045) (NC.CloseListOfActiveCards 80047 . 81319)) (81357 102068 (NC.DeleteStructure 81367 .
83228) (NC.CopyStructure 83230 . 85419) (NC.SelectNoteCards 85421 . 100011) (NC.NoteFileOperations
100013 . 102066)) (102104 106099 (NC.SessionCheckOpInProgress 102114 . 103963) (
NC.NoteFileCheckOpInProgress 103965 . 106097)) (106136 108401 (NC.MakeSearchCard 106146 . 108399)) (
108440 114565 (NC.MakeDocument 108450 . 114563)) (114605 116689 (NC.MakeLinkIndex 114615 . 116687)) (
118498 122925 (NAMED-RESETLST 118508 . 119377) (NAMED-RESETSAVE 119379 . 121250) (NAMED-RESETRESTORE
121252 . 122376) (NAMED-RESETUNSAVE 122378 . 122923)))))
STOP