(FILECREATED " 2-Sep-86 17:05:07" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH097.;13 37556
changes to: (FNS NC.MoveStructure NC.CopyStructure NC.CloseStructure NC.DeleteStructure
NC.CopyCards NC.DeleteNoteCards NC.DelReferencesToCardFromBrowser
NC.SeverAllLinks NC.SmartDeleteLinks)
(VARS RHTPATCH097COMS)
previous date: "29-Aug-86 21:47:25" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH097.;8)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH097COMS)
(RPAQQ RHTPATCH097COMS ((* * New function for NCCARDS)
(FNS NC.SeverAllLinks)
(* * New function for NCLINKS)
(FNS NC.SmartDeleteLinks)
(* * New function for NCUTILITIES)
(FNS NC.UnionListsOfLinks)
(* * Change to NCCARDS)
(FNS NC.DeleteNoteCards)
(* * Change to NCPROGINT)
(FNS NCP.CollectCards NCP.GetLinks)
(* * Changes to NCINTERFACE)
(FNS NC.DeleteStructure NC.MoveStructure NC.CopyStructure NC.CloseStructure)
(* * Change the ADDVARS in NCINTERFACE as follows.)
(ADDVARS (NC.StructureOpsItems (Copy% Structure (NC.CopyStructure NIL NIL
NIL
NC.NoteCardsIconWindow)
"Copy note cards belonging to a structure.")
(Move% Structure (NC.MoveStructure NIL NIL
NIL
NC.NoteCardsIconWindow)
"Move note cards belonging to a structure.")
(Close% Structure (NC.CloseStructure NIL NIL
NC.NoteCardsIconWindow)
"Close note cards belonging to a structure.")
(Delete% Structure (NC.DeleteStructure
NIL NIL
NC.NoteCardsIconWindow)
"Delete note cards belonging to a structure.")))
(* * Changes to NCDATABASE)
(FNS NC.AskTraversalSpecs NC.CopyCards)
(* * Changes to NCBROWSERCARD)
(FNS NC.DelReferencesToCardFromBrowser)))
(* * New function for NCCARDS)
(DEFINEQ
(NC.SeverAllLinks
(LAMBDA (ListOfCards QuietFlg InterestedWindow Don'tPutToBeDeletedCardsFlg)
(* rht: " 1-Sep-86 23:15")
(* * Delete all links into and out of any cards in ListOfCards. Furthermore, do it efficiently by caching a card
only long enough to delete all the links between it and ListOfCards.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Gathering links of " (LENGTH ListOfCards)
" cards."))
(NC.SmartDeleteLinks (NC.UnionListsOfLinks (for Card in ListOfCards
join (APPEND (NC.RetrieveToLinks Card)))
(for Card in ListOfCards
join (APPEND (NC.RetrieveFromLinks Card)))
)
QuietFlg InterestedWindow Don'tPutToBeDeletedCardsFlg)))
)
(* * New function for NCLINKS)
(DEFINEQ
(NC.SmartDeleteLinks
(LAMBDA (ListOfLinks QuietFlg InterestedWindow Don'tPutToBeDeletedCardsFlg)
(* rht: " 1-Sep-86 23:15")
(* * 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.)
(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)
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 (AND Don'tPutToBeDeletedCardsFlg
(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 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 (SETQ WasNotActiveFlg (NOT (NC.ActiveCardP SourceCard)))
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 T)
(SETQ PreviousSourceCard SourceCard))
finally (if WasNotActiveFlg
then (* Have to call NC.CardSaveFn first and then
NC.QuitCard with Don'tSaveFlg to avoid
insureProperFiling check.)
(if (AND Don'tPutToBeDeletedCardsFlg (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 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)))))
)
(* * New function for NCUTILITIES)
(DEFINEQ
(NC.UnionListsOfLinks
(LAMBDA (LinksList1 LinksList2) (* rht: "29-Aug-86 16:28")
(* * Return a list containing links appearing in either LinksList1 and LinksList2.)
(if (GREATERP (LENGTH LinksList2)
(LENGTH LinksList1))
then (* Swap in order that first list be the longest.)
(PSETQ LinksList1 LinksList2 LinksList2 LinksList1))
(APPEND LinksList2 (for Link1 in LinksList1 unless (for Link2 in LinksList2
thereis (NC.SameLinkP Link1
Link2))
collect Link1))))
)
(* * Change to NCCARDS)
(DEFINEQ
(NC.DeleteNoteCards
(LAMBDA (CardIdentifiers NoIndividualConfirmFlg DontClearFlg InterestedWindow QuietFlg
NoGroupConfirmFlg Don'tPutToBeDeletedCardsFlg)
(* rht: " 2-Sep-86 13:42")
(* 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.)
(OR CardIdentifiers (SETQ CardIdentifiers (NC.SelectNoteCards NIL NIL
NC.DeleteSelectingMenu
InterestedWindow NIL
"Please select the Note Cards to be deleted.")))
(* * 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
Don'tPutToBeDeletedCardsFlg)
(* * 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 (LET ((OperationInProgress (NC.OperationInProgress Card)))
(OR QuietFlg (if (ZEROP (REMAINDER i 10))
then (NC.PrintMsg InterestedWindow T
"Deleting cards: "
i " out of " NumToDelete
" ...")))
(if OperationInProgress
then (NC.PrintOperationInProgressMsg (NC.FetchWindow
Card)
"Delete Card(s)"
OperationInProgress)
else (NC.ProtectedCardOperation Card Delete% Card%(s%)
(NC.DeleteNoteCard Card)))))
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
CardIdentifiers))))
)
(* * Change to NCPROGINT)
(DEFINEQ
(NCP.CollectCards
(LAMBDA (RootCards LinkTypes MaxDepth) (* rht: "29-Aug-86 21:20")
(* * Starting from RootCards and following link of types in LinkTypes to a max depth of MaxDepth, collect and
return all cards encountered. LinkTypes can contain backward links.)
(* * rht 8/29/86: Now handles case of NULL MaxDepth. Also handles case when RootCards is single card instead of
list.)
(OR MaxDepth (SETQ MaxDepth 65535))
(if (LEQ MaxDepth 0)
then RootCards
else (for Depth from 1 to MaxDepth eachtime (BLOCK)
bind (Fringe ←(MKLIST RootCards))
(Collection ←(APPEND (MKLIST RootCards)))
do (SETQ Fringe (LDIFFERENCE (NCP.CardNeighbors Fringe LinkTypes)
Collection))
(if (NULL Fringe)
then (RETURN Collection)
else (SETQ Collection (NCONC Fringe Collection)))
finally (RETURN Collection)))))
(NCP.GetLinks
(LAMBDA (Cards DestinationCards Labels NoteFile) (* rht: "29-Aug-86 21:44")
(* * Returns a list of all links from Cards to DestinationCards whose link label is one of Labels.
Labels can be nil, in which case all such links are returned. Cards and DestinationCards can each be atomic.
Each can also be nil. For example, if DestinationCards is nil, then all links pointing from Cards to anywhere with
given labels are returned. Note that if both Cards and DestinationCards are nil, then will return all links whose
label is one of Labels. If all three args are nil, then return all links in the current notefile.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 8/29/86: Now blocks in loops and checks whether links cached before retrieving.)
(LET (ValidCards ValidDestinationCards)
(SETQ Labels (MKLIST Labels))
(SETQ ValidCards (for Card in (MKLIST Cards) eachtime (BLOCK)
unless (COND
((NOT (NC.ValidCardP Card))
(NCP.ReportError Card " not an existing card or box.")
T))
collect Card))
(SETQ ValidDestinationCards (for Card in (MKLIST DestinationCards) eachtime
(BLOCK)
unless (COND
((NOT (NC.ValidCardP Card))
(NCP.ReportError Card
" not an existing card or box.")
T))
collect Card))
(COND
(Cards (for Card in ValidCards eachtime (BLOCK)
join (LET ((HadLinksCachedFlg (NC.LinksCachedP Card)))
(PROG1 (for Link in (NC.RetrieveToLinks Card)
when (COND
(DestinationCards (FMEMB (fetch
(Link
DestinationCard)
of Link)
ValidDestinationCards))
(T T))
when (COND
(Labels (FMEMB (fetch (Link Label)
of Link)
Labels))
(T T))
collect Link)
(OR HadLinksCachedFlg (NC.UncacheLinks Card))))))
(DestinationCards (for Card in ValidDestinationCards eachtime (BLOCK)
join (LET ((HadLinksCachedFlg (NC.LinksCachedP Card)))
(PROG1 (for Link in (NC.RetrieveFromLinks Card)
when (COND
(Labels (FMEMB
(fetch (Link Label)
of Link)
Labels))
(T T))
collect Link)
(OR HadLinksCachedFlg (NC.UncacheLinks
Card))))))
(T (NCP.MapLinks NoteFile (FUNCTION PROG1)
(LAMBDA (Link)
(if Labels
then (FMEMB (fetch (Link Label) of Link)
Labels)
else T))))))))
)
(* * Changes to NCINTERFACE)
(DEFINEQ
(NC.DeleteStructure
(LAMBDA (RootCard TraversalSpecs InterestedWindow QuietFlg Don'tPutToBeDeletedCardsFlg)
(* rht: " 2-Sep-86 16:52")
(* * 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.)
(OR RootCard (SETQ RootCard (NC.SelectNoteCards T NIL NC.SelectingCardMenu NIL NIL
"Shift-select the root card of the structure"))
(ERROR!))
(OR TraversalSpecs (SETQ TraversalSpecs (NC.AskTraversalSpecs RootCard (QUOTE
(SubBox FiledCard)))))
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Collecting cards to delete ..."))
(AND RootCard TraversalSpecs (NC.DeleteNoteCards (NCP.CollectCards RootCard
(fetch (TRAVERSALSPECS
LinkTypes)
of TraversalSpecs)
(fetch (TRAVERSALSPECS
Depth)
of TraversalSpecs))
T NIL InterestedWindow QuietFlg NIL
Don'tPutToBeDeletedCardsFlg))
RootCard))
(NC.MoveStructure
(LAMBDA (RootCard DestinationFileBox TraversalSpecs InterestedWindow QuietFlg
Don'tPutToBeDeletedCardsFlg) (* rht: " 2-Sep-86 16:53")
(* * 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.)
(NC.DeleteNoteCards (NC.CopyStructure RootCard DestinationFileBox TraversalSpecs
InterestedWindow QuietFlg)
T NIL InterestedWindow QuietFlg NIL Don'tPutToBeDeletedCardsFlg)))
(NC.CopyStructure
(LAMBDA (RootCard DestinationFileBox TraversalSpecs InterestedWindow QuietFlg)
(* rht: " 2-Sep-86 16:48")
(* * Copy a NoteCard structure into a filebox)
(* * kirk 13/7/86: Placed TraversalSpecs after RootCard 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.)
(OR RootCard (SETQ RootCard (NC.SelectNoteCards T NIL NC.SelectingCardMenu NIL NIL
"Shift-select the root card of the structure"))
(ERROR!))
(OR TraversalSpecs (SETQ TraversalSpecs (NC.AskTraversalSpecs RootCard (QUOTE
(SubBox FiledCard))))
(ERROR!))
(OR DestinationFileBox (SETQ DestinationFileBox (NC.SelectNoteCards T NIL
NC.SelectingCardMenu NIL
NIL
"Shift-select the FileBox to contain the structure."))
(ERROR!))
(NC.CopyCards (NCP.CollectCards RootCard (fetch (TRAVERSALSPECS LinkTypes) of
TraversalSpecs)
(fetch (TRAVERSALSPECS Depth) of TraversalSpecs))
DestinationFileBox RootCard QuietFlg InterestedWindow)))
(NC.CloseStructure
(LAMBDA (RootCard TraversalSpecs InterestedWindow QuietFlg)
(* rht: " 2-Sep-86 17:03")
(* * rht 9/2/86: Replaced call to outdated NC.CollectCards with NCP.CollectCards. Threw away useless NoCheckFlg and
Don'tClearFlg args.)
(OR RootCard (SETQ RootCard (NC.SelectNoteCards T NIL NC.SelectingCardMenu NIL NIL
"Shift-select the root card of the structure"))
(ERROR!))
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Collecting cards to close ..."))
(OR TraversalSpecs (SETQ TraversalSpecs (NC.AskTraversalSpecs RootCard (QUOTE
(SubBox FiledCard)))))
(NC.CloseNoteCards (NCP.CollectCards RootCard (fetch (TRAVERSALSPECS LinkTypes)
of TraversalSpecs)
(fetch (TRAVERSALSPECS Depth) of TraversalSpecs))
NIL NIL InterestedWindow)
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
RootCard))
)
(* * Change the ADDVARS in NCINTERFACE as follows.)
(ADDTOVAR NC.StructureOpsItems (Copy% Structure (NC.CopyStructure NIL NIL NIL
NC.NoteCardsIconWindow)
"Copy note cards belonging to a structure.")
(Move% Structure (NC.MoveStructure NIL NIL NIL
NC.NoteCardsIconWindow)
"Move note cards belonging to a structure.")
(Close% Structure (NC.CloseStructure NIL NIL NC.NoteCardsIconWindow)
"Close note cards belonging to a structure.")
(Delete% Structure (NC.DeleteStructure NIL NIL
NC.NoteCardsIconWindow)
"Delete note cards belonging to a structure."))
(* * Changes to NCDATABASE)
(DEFINEQ
(NC.AskTraversalSpecs
(LAMBDA (SourceCard OldLinkLabels OldDepth Don'tAskFlg) (* rht: "29-Aug-86 18:37")
(* * Get a traversal specification from the user.)
(* * kirk 7/29/86 changed to allow backlinks and position specs above source card)
(* * rht 8/29/86: Fixed bug that was causing Depth spec to be ignored.)
(PROG ((LinkLabels (NC.RetrieveLinkLabels (fetch (Card NoteFile) of SourceCard)
T))
Choices Position MainWindow)
(OR OldLinkLabels (SETQ OldLinkLabels LinkLabels))
(if Don'tAskFlg
then (RETURN (LIST OldLinkLabels OldDepth)))
(SETQ MainWindow (NC.FetchWindow SourceCard))
(SETQ Position (AND (WINDOWP MainWindow)
(create POSITION
XCOORD ←(fetch (REGION LEFT)
of (WINDOWPROP MainWindow (QUOTE
REGION)))
YCOORD ←(fetch (REGION TOP) of (WINDOWREGION
MainWindow)))))
(OR OldDepth (SETQ OldDepth 99999))
(RESETFORM (CURSOR (QUOTE WAITINGCURSOR))
(* The stylesheet is in a global var.
We only need to provide its position, items, and
selections.)
(STYLE.PROP NC.TraversalSpecsStylesheet (QUOTE POSITION)
Position)
(STYLE.PROP NC.TraversalSpecsStylesheet (QUOTE ITEMS)
(LIST (create MENU
ITEMS ← LinkLabels)
(create MENU
ITEMS ←(for Link in LinkLabels
collect (PACK* (QUOTE ←)
Link)))
(create MENU
ITEMS ←(QUOTE (0 1 2 3 4 5 6 7 8 9 INF)))))
(STYLE.PROP NC.TraversalSpecsStylesheet (QUOTE SELECTIONS)
(LIST (for Label in OldLinkLabels
when (NEQ (NTHCHAR Label 1)
(QUOTE ←))
collect Label)
(for Label in OldLinkLabels
when (EQ (NTHCHAR Label 1)
(QUOTE ←))
collect Label)
(if (OR (NOT (FIXP OldDepth))
(IGREATERP OldDepth 9)
(ILESSP OldDepth 0))
then (QUOTE INF)
else OldDepth))))
(SETQ Choices (STYLESHEET NC.TraversalSpecsStylesheet))
(RETURN (COND
(Choices (create TRAVERSALSPECS
LinkTypes ←(APPEND (CAR Choices)
(CADR Choices))
Depth ←(OR (FIXP (CADDR Choices))
MAX.FIXP)))
(T NIL))))))
(NC.CopyCards
(LAMBDA (Cards DestNoteFileOrFileBox RootCards QuietFlg InterestedWindow)
(* rht: " 2-Sep-86 16:46")
(* * 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.)
(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 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 NIL
"Shift-select the FileBox to contain these cards."
T)))
then (ERROR!)))
(if (type? NoteFile DestNoteFileOrFileBox)
then (SETQ DestNoteFile DestNoteFileOrFileBox)
(SETQ BoxToFileIn (fetch (NoteFile TableOfContentsCard) of DestNoteFile))
elseif (NCP.FileBoxP DestNoteFileOrFileBox)
then (SETQ BoxToFileIn DestNoteFileOrFileBox)
(SETQ DestNoteFile (fetch (Card NoteFile) of BoxToFileIn))
else (NC.ReportError "NC.CopyCards" (CONCAT "Arg not notefile or filebox: "
DestNoteFileOrFileBox)))
(if (NOT (AND (type? NoteFile DestNoteFile)
(OPENP (fetch (NoteFile Stream) of DestNoteFile))))
then (NC.ReportError "NC.CopyCards" (CONCAT (fetch (NoteFile FullFileName)
of DestNoteFile)
" not an open notefile.")))
(if (LDIFFERENCE (SETQ RootCards (MKLIST RootCards))
Cards)
then (NC.ReportError "NC.CopyCards"
"RootCards argument not subset of Cards argument."))
(if (NULL RootCards)
then (SETQ RootCards Cards))
(* * Now get to work.)
(SETQ TempStream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
(SETQ CurrentLinkLabels (NC.RetrieveLinkLabels DestNoteFile))
(SETQ NewLinkLabels (TCONC NIL))
(SETQ LinksHashArray (HASHARRAY NC.CopyCardsLinksHashArraySize NIL
(FUNCTION NC.MakeHashKey)
(FUNCTION NC.SameUIDP)))
(SETQ CardHashArray (HASHARRAY NumCards NIL (FUNCTION NC.MakeHashKeyFromCard)
(FUNCTION NC.SameCardP)))
(* * Create new cards in DestNoteFile for each card. Make these cards by copying original cards to a temp stream.
Keep track of UID mappings between original cards and card copies using CardHashArray.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Copying cards: creating empty copies."
(CHARACTER 13)
"Processing item " 1 " out of " NumCards "..." (CHARACTER
13)))
(SETQ NewCardsAndLocsOnStream
(for Card in Cards as i from 1 bind NewCard WasActiveFlg HadStatusNILFlg
IndexLocs
eachtime (BLOCK)
collect (OR QuietFlg (if (ZEROP (REMAINDER i 100))
then (NC.PrintMsg InterestedWindow T
"Copying cards: creating empty copies."
(CHARACTER 13)
"Processing item " i " out of "
NumCards "..." (CHARACTER 13))))
(if (NOT (SETQ WasActiveFlg (NC.ActiveCardP Card)))
then (NC.GetNoteCard Card))
(if (SETQ HadStatusNILFlg (NULL (fetch (Card Status) of Card)))
then (* Have to have Status slot ACTIVE in order that Put
to stream won't break.)
(replace (Card Status) of Card with (QUOTE ACTIVE)))
(SETQ IndexLocs (NC.PutNoteCardToStream Card NIL T TempStream))
(if HadStatusNILFlg
then (replace (Card Status) of Card with NIL))
(if (NOT WasActiveFlg)
then (NC.DeactivateCard Card))
(* Make new empty card for copy.)
(SETQ NewCard (NC.GetNewCard DestNoteFile))
(* Map old cards to card copies.)
(PUTHASH Card NewCard CardHashArray)
(CONS NewCard IndexLocs)))
(* * For each card, get it off the temp stream, fix its links, fix browser info if necessary, and write it down to
the dest notefile.)
(SETFILEPTR TempStream 0)
(OR QuietFlg (NC.PrintMsg InterestedWindow T
"Copying cards: fixing links and browser cards."
(CHARACTER 13)
"Processing item " 1 " out of " NumCards "..." (CHARACTER
13)))
(for NewCardAndLocsOnStream in NewCardsAndLocsOnStream as i from 1 eachtime
(BLOCK)
do (OR QuietFlg (if (ZEROP (REMAINDER i 100))
then (NC.PrintMsg InterestedWindow T
"Copying cards: fixing links and browser cards."
(CHARACTER 13)
"Processing item " i " out of " NumCards
"..."
(CHARACTER 13))))
(LET ((NewCard (CAR NewCardAndLocsOnStream))
(IndexLocs (CDR NewCardAndLocsOnStream)))
(* Have to make status active for Get fns to work.)
(NC.SetStatus NewCard (QUOTE ACTIVE))
(NC.GetNoteCardFromStream NewCard TempStream IndexLocs)
(NC.FixUpLinksInCardCopy NewCard CardHashArray LinksHashArray
CurrentLinkLabels NewLinkLabels)
(if (NC.IsSubTypeOfP (NC.FetchType NewCard)
(QUOTE Browser))
then (NC.FixUpBrowserCardCopy NewCard CardHashArray))
(NC.PutNoteCard NewCard)))
(* * Link RootCards under filebox in DestNotefile.)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Copying cards: filing " (LENGTH
RootCards)
" new cards in "
(NC.FetchTitle BoxToFileIn)
"..."
(CHARACTER 13)))
(NC.FileBoxCollectChildren NIL BoxToFileIn (for RootCard in RootCards eachtime
(BLOCK)
collect (GETHASH RootCard CardHashArray))
T)
(* * Put out any new link labels to the dest notefile.)
(AND (SETQ NewLinkLabels (CDAR NewLinkLabels))
(NC.StoreLinkLabels DestNoteFile (APPEND NewLinkLabels CurrentLinkLabels)))
(OR QuietFlg (NC.ClearMsg InterestedWindow T))
Cards)))
)
(* * Changes to NCBROWSERCARD)
(DEFINEQ
(NC.DelReferencesToCardFromBrowser
(LAMBDA (SourceCard LinkOrDestinationCard) (* rht: " 2-Sep-86 15:30")
(* * Delete from the browser specified by SourceCard all link icon nodes whose DESTINATIONID is eq to
DestinationID. This just checks the case of the SourceCard being a browser root and then passes off to GRAPHCARD's
DelReferencesFn.)
(* * rht 4/30/86: No longer passes control up to Super's DeleteLinksFn. Work is now done here.)
(* * rht 9/2/86: Now sets dirtyflg of substance if change was made.)
(LET ((LinkFlg (type? Link LinkOrDestinationCard))
(ImageBox (NC.DeletedLinkImageBoxFn NC.DeletedLinkImageObject))
LinkIcon Graph DestinationCard BrowserRoots)
(if LinkFlg
then (OR (NC.CardP SourceCard)
(SETQ SourceCard (fetch (Link SourceCard) of LinkOrDestinationCard)))
(SETQ DestinationCard (fetch (Link DestinationCard) of
LinkOrDestinationCard))
else (SETQ DestinationCard LinkOrDestinationCard))
(if (SETQ RootCardToDelete (for RootCard in (SETQ BrowserRoots (
NC.FetchBrowserRoots SourceCard))
eachtime (BLOCK) do (if (NC.SameCardP
DestinationCard
RootCard)
then (RETURN RootCard))))
then (NC.SetBrowserRoots SourceCard (DREMOVE RootCardToDelete BrowserRoots)))
(SETQ Graph (NC.FetchSubstance SourceCard))
(for GraphNode in (fetch (GRAPH GRAPHNODES) of Graph)
when (AND (NC.LinkIconImageObjP (SETQ LinkIcon (fetch (GRAPHNODE NODELABEL)
of GraphNode)))
(if LinkFlg
then (NC.SameLinkP LinkOrDestinationCard (NC.FetchLinkFromLinkIcon
LinkIcon))
else (NC.SameCardP (fetch (Link DestinationCard)
of (NC.FetchLinkFromLinkIcon LinkIcon))
DestinationCard)))
do (if NC.UseDeletedLinkIconIndicatorsFlg
then (replace (GRAPHNODE NODELABEL) of GraphNode with
NC.DeletedLinkImageObject)
(replace (GRAPHNODE NODEWIDTH) of GraphNode
with (fetch (IMAGEBOX XSIZE) of ImageBox))
(replace (GRAPHNODE NODEHEIGHT) of GraphNode
with (fetch (IMAGEBOX YSIZE) of ImageBox))
(NC.SetSubstanceDirtyFlg SourceCard T)
else (NC.BrowserRemoveNode Graph (NC.FetchWindow SourceCard)
NIL GraphNode T)))
(if (AND (NC.ActiveCardP SourceCard)
(NC.FetchWindow SourceCard))
then (REDISPLAYGRAPH (NC.FetchWindow SourceCard))))))
)
(PUTPROPS RHTPATCH097 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1962 2831 (NC.SeverAllLinks 1972 . 2829)) (2869 8347 (NC.SmartDeleteLinks 2879 . 8345))
(8389 9076 (NC.UnionListsOfLinks 8399 . 9074)) (9107 13966 (NC.DeleteNoteCards 9117 . 13964)) (13999
18027 (NCP.CollectCards 14009 . 15045) (NCP.GetLinks 15047 . 18025)) (18063 22474 (NC.DeleteStructure
18073 . 19311) (NC.MoveStructure 19313 . 19957) (NC.CopyStructure 19959 . 21436) (NC.CloseStructure
21438 . 22472)) (23155 34595 (NC.AskTraversalSpecs 23165 . 25831) (NC.CopyCards 25833 . 34593)) (34633
37474 (NC.DelReferencesToCardFromBrowser 34643 . 37472)))))
STOP