(FILECREATED "26-Oct-87 19:46:44" {QV}<NOTECARDS>1.3KNEXT>RHTPATCH292.;1 13523
changes to: (VARS RHTPATCH292COMS)
(FNS NC.CachedAddToLink NC.MakeGlobalLink))
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH292COMS)
(RPAQQ RHTPATCH292COMS ((* * Fix to bug 739: half-links created when making global links from
browser. Changed the place that new link is added to global links list.
Also fixed NC.GrowLinkLattice to leave links cached or uncached
depending on how they were when we came in.)
(* * Change to NCBROWSERCARD)
(FNS NC.GrowLinkLattice)
(* * Changes to NCLINKS)
(FNS NC.CachedAddToLink NC.MakeGlobalLink)))
(* * Fix to bug 739: half-links created when making global links from browser. Changed the
place that new link is added to global links list. Also fixed NC.GrowLinkLattice to leave links
cached or uncached depending on how they were when we came in.)
(* * Change to NCBROWSERCARD)
(DEFINEQ
(NC.GrowLinkLattice
(LAMBDA (RootCardsList CurrentGraph ListOfLinkLabels GraphCard RemainingSearchDepth)
(* rht: "26-Oct-87 18:41")
(* Grow a lattice by following the links from RootID card among ListOfLinkLabels. Lattice will be fed to
LAYOUTGRAPH, so for each note card encountered by following the links just fill in the ID, LABEL and daughter IDs)
(* * rht 8/3/84: Changed so as to also follow from links if they are present (prefixed by "←") on
ListOfLinkLabels.)
(* * rht 10/4/84: Now stores the link label on the prop list of the NODEID of the graph under the property name of
the destination ID. This is so that links can be drawn with dashing depending on the link's label.)
(* * rht 3/8/85: Added RemainingSearchDepth arg to limit the lattice growth to given depth.)
(* * rht 8/9/85: Changed so that backward links are no longer stored as a separate link type.
Rather they're told apart from forward links by being stored on the destination node's prop list.)
(* * rht 4/4/85: Now first arg can be either a root Card or an existing graphnode. If the latter, then we're
expanding an existing graph below that node. If the former than we're starting a new lattice.)
(* * rht 10/17/85: Changed from a recursive depth-first algorithm to a loop-driven breadth-first alg.)
(* * rht 11/17/85: Handles new card and notefile objects.)
(* * rht 5/26/87: Now tries to follow cross-file links.)
(* * rht 10/26/87: Now deactivates cards at the end that we had to NC.GetLinks for.)
(LET (CardsAndDepthsQueue CardsNeedingDeactivation) (* Make the queue contain pairs of root Card and depth
remaining to search.)
(SETQ CardsAndDepthsQueue (for Card in RootCardsList collect (CONS Card
RemainingSearchDepth)))
(* Make it a TCONC list for fast appending to the
end.)
(SETQ CardsAndDepthsQueue (CONS CardsAndDepthsQueue (LAST CardsAndDepthsQueue)))
(* * Do breadth-first search using the queue IDsAndDepthsQueue.)
(for bind CardAndDepth Card RemainingSearchDepth ToLinks FromLinks DestinationIDs
GraphNodeID GraphNode
eachtime (BLOCK) (* Grab and take apart 1st pair on queue.)
(SETQ CardAndDepth (CAAR CardsAndDepthsQueue))
(SETQ Card (CAR CardAndDepth))
(SETQ RemainingSearchDepth (CDR CardAndDepth))
(* Remove the front pair from the queue.)
(RPLACA CardsAndDepthsQueue (CDAR CardsAndDepthsQueue))
(* If that was the last pair, then start queue over
fresh.)
(if (NULL (CAR CardsAndDepthsQueue))
then (SETQ CardsAndDepthsQueue NIL))
while Card unless (NC.SameCardP Card GraphCard)
do
(SETQ GraphNodeID (NC.GetBrowserNodeID GraphCard Card))
(* Go grab this ID's links.)
(if (NC.ActiveCardP Card)
then (SETQ ToLinks (NC.FetchToLinks Card))
(SETQ FromLinks (NC.FetchFromLinks Card))
else (NC.GetLinks Card)
(SETQ ToLinks (NC.FetchToLinks Card))
(SETQ FromLinks (NC.FetchFromLinks Card))
(push CardsNeedingDeactivation Card))
(if (IGREATERP RemainingSearchDepth 0)
then (* Crush the ID's proplist.)
(if (NOT (NC.GraphNodeIDGetProp GraphNodeID (QUOTE TouchedFlg)))
then (NC.SmashGraphNodeIDProps GraphNodeID)
(NC.GraphNodeIDPutProp GraphNodeID (QUOTE TouchedFlg)
T))
(SETQ DestinationIDs
(NCONC (for Link in ToLinks bind DestID DestVisitedFlg DestTouchedFlg
ThisWayLinkFlg OtherWayLinkFlg
eachtime (BLOCK)
(if (SETQ ThisWayLinkFlg (NC.LinkLabelP Link
ListOfLinkLabels))
then (SETQ DestID
(NC.GetBrowserNodeID
GraphCard
(LET ((DestCard (fetch (Link
DestinationCard)
of Link)))
(if (NC.CrossFileLinkCardP
DestCard)
then (OR (
NC.GetCrossFileLinkDestCard
DestCard)
DestCard)
else DestCard))))
(SETQ DestVisitedFlg (NC.GraphNodeIDGetProp
DestID
(QUOTE VisitedFlg)))
(SETQ DestTouchedFlg (NC.GraphNodeIDGetProp
DestID
(QUOTE TouchedFlg)))
(SETQ OtherWayLinkFlg (NC.ReverseLinkLabelP
Link ListOfLinkLabels)))
when ThisWayLinkFlg unless (AND DestVisitedFlg OtherWayLinkFlg)
collect (* Record presence of this link.)
(NC.UIDAddProp GraphNodeID DestID (fetch (Link Label)
of Link)
T)
DestID)
(for Link in FromLinks bind DestID DestTouchedFlg DestVisitedFlg
ThisWayLinkFlg OtherWayLinkFlg
SourceCard
eachtime
(BLOCK)
(if (AND (SETQ ThisWayLinkFlg (NC.ReverseLinkLabelP Link
ListOfLinkLabels))
(NOT (NC.SameCardP
GraphCard
(SETQ SourceCard
(LET ((SrcCard (fetch (Link SourceCard)
of Link)))
(if (NC.CrossFileLinkCardP SrcCard)
then (OR (
NC.GetCrossFileLinkDestCard
SrcCard)
SrcCard)
else SrcCard))))))
then (SETQ DestID (NC.GetBrowserNodeID GraphCard
SourceCard))
(SETQ DestVisitedFlg (NC.GraphNodeIDGetProp
DestID
(QUOTE VisitedFlg)))
(SETQ DestTouchedFlg (NC.GraphNodeIDGetProp
DestID
(QUOTE TouchedFlg)))
(SETQ OtherWayLinkFlg (NC.LinkLabelP Link
ListOfLinkLabels)))
when ThisWayLinkFlg unless (AND DestVisitedFlg OtherWayLinkFlg)
collect
(* Crush the dest node's prop list if it's never been touched. But if dest node is a fringe node for this search,
don't have to clear the whole proplist.)
(if (NOT DestTouchedFlg)
then (if (EQ 1 RemainingSearchDepth)
then (NC.GraphNodeIDRemProp DestID
GraphNodeID)
else (NC.SmashGraphNodeIDProps DestID)
(NC.GraphNodeIDPutProp DestID
(QUOTE
TouchedFlg)
T)))
(* Record presence of this link.)
(NC.UIDAddProp DestID GraphNodeID (fetch (Link Label)
of Link)
T)
DestID)))
(SETQ DestinationIDs (DREMOVE (NC.GetBrowserNodeID GraphCard GraphCard)
(INTERSECTION DestinationIDs DestinationIDs)))
else (SETQ DestinationIDs NIL))
(NC.GraphNodeIDPutProp GraphNodeID (QUOTE VisitedFlg)
T)
(* * Create new node and add to graph unless we're working on a node already in the graph.)
(if (SETQ GraphNode (FASSOC GraphNodeID CurrentGraph))
then (* If node is in graph, but we won't expand further,
then leave it's destination IDs alone.)
(AND (GREATERP RemainingSearchDepth 0)
(replace (GRAPHNODE TONODES) of GraphNode with DestinationIDs))
else (SETQ CurrentGraph
(NCONC CurrentGraph
(LIST (create GRAPHNODE
NODEID ← GraphNodeID
TONODES ← DestinationIDs
NODELABEL ← Card)))))
(* * Attach new IDs to end of queue.)
(for DestinationID in DestinationIDs bind DestCard
eachtime (BLOCK)
(SETQ DestCard (NC.CardFromBrowserNodeID DestinationID))
unless (OR (NC.GraphNodeIDGetProp DestinationID (QUOTE VisitedFlg))
(for CardAndDepth in (CAR CardsAndDepthsQueue) eachtime
(BLOCK)
thereis (NC.SameCardP DestCard (CAR CardAndDepth))))
do (SETQ CardsAndDepthsQueue (TCONC CardsAndDepthsQueue (CONS DestCard
(SUB1
RemainingSearchDepth)))))
)
(for Card in CardsNeedingDeactivation do (NC.DeactivateCard Card))
CurrentGraph)))
)
(* * Changes to NCLINKS)
(DEFINEQ
(NC.CachedAddToLink
(LAMBDA (Link SourceCard LinkToInsertAfter BeingMovedFlg)
(* rht: "26-Oct-87 19:31")
(* * Add Link to the cached ToLinks of the source card)
(* * rht 3/26/85: Added LinkToInsertAfter arg which is either NIL, ATEND, or a link after which to insert new link.
If NIL, then insert at front of list. If ATEND then insert at end.)
(* * kirk: 13Nov85: changed to use NoteFile instead of DatabaseStream)
(* * kirk 15Nov85: deleted use of LinkID)
(* * rht 8/11/86: Added BeingMovedFlg. If non-nil, then delete instance of Link from ToLinks before inserting it in
new spot.)
(* * rht 10/26/87: Now adds to global links list if necessary.)
(LET ((ToLinks (NC.FetchToLinks SourceCard)))
(if BeingMovedFlg
then (* Look for and delete old instance of the link.)
(if (NC.SameLinkP Link (CAR ToLinks))
then (NC.SetToLinks SourceCard (SETQ ToLinks (CDR ToLinks)))
else (for RestOfToLinks on ToLinks thereis (NC.SameLinkP
Link
(CADR RestOfToLinks))
finally (RPLACD RestOfToLinks (CDDR RestOfToLinks)))))
(COND
((AND ToLinks (type? Link LinkToInsertAfter))
(* Destructively insert after a given link.)
(for RestOfToLinks on ToLinks thereis (NC.SameLinkP LinkToInsertAfter
(CAR RestOfToLinks))
finally (COND
(RestOfToLinks (RPLACD RestOfToLinks (CONS Link (CDR RestOfToLinks))
))
(T (NC.SetToLinks SourceCard (NCONC1 ToLinks Link))))))
((EQ LinkToInsertAfter (QUOTE ATEND)) (* Destructively insert at the end.)
(NC.SetToLinks SourceCard (NCONC1 ToLinks Link)))
(T (* Stick it at the front.)
(NC.SetToLinks SourceCard (CONS Link ToLinks))))
(if (EQ (fetch (Link AnchorMode) of Link)
(QUOTE GlobalGlobal))
then (NC.SetGlobalLinks SourceCard (CONS Link (NC.FetchGlobalLinks SourceCard))))
(NC.SetLinksDirtyFlg SourceCard T)
Link)))
(NC.MakeGlobalLink
(LAMBDA (Window LinkLabel DestinationCard SourceCard DisplayMode)
(* rht: "26-Oct-87 19:32")
(* * Make a new global link from DestinationCard to SourceCard with label LinkLabel and display mode DisplayMode.
Window is optional if SourceCard is specified, otherwise it is required.)
(* * rht 11/9/84: Now checks result of NC.MakeLink before building link.)
(* * rht 10/26/87: Now lets functions under NC.MakeLink take care of adding to global links list.)
(NC.MakeLink Window LinkLabel DestinationCard SourceCard DisplayMode (QUOTE GlobalGlobal)
NIL NIL (QUOTE ATEND))))
)
(PUTPROPS RHTPATCH292 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1028 10193 (NC.GrowLinkLattice 1038 . 10191)) (10225 13441 (NC.CachedAddToLink 10235 .
12700) (NC.MakeGlobalLink 12702 . 13439)))))
STOP