(FILECREATED "30-Nov-87 14:18:14" {QV}<NOTECARDS>1.3KNEXT>PMIPATCH072.;1 10062
changes to: (VARS PMIPATCH072COMS)
(FNS NC.GrowLinkLattice))
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT PMIPATCH072COMS)
(RPAQQ PMIPATCH072COMS ((* * rht&pmi 11/30/87: NC.GrowLinkLattice no longer allows following
backlinks if they go to the browser being created.)
(* * Changed in NCBROWSERCARD)
(FNS NC.GrowLinkLattice)))
(* * rht&pmi 11/30/87: NC.GrowLinkLattice no longer allows following backlinks if they go to
the browser being created.)
(* * Changed in NCBROWSERCARD)
(DEFINEQ
(NC.GrowLinkLattice
(LAMBDA (RootCardsList CurrentGraph ListOfLinkLabels GraphCard RemainingSearchDepth)
(* pmi: "30-Nov-87 12:48")
(* 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.)
(* * rht&pmi 11/30/87: No longer allows following backlinks if they go to this browser.)
(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 LinkFromUsFlg
SourceCard
eachtime
(BLOCK)
(if (AND (SETQ ThisWayLinkFlg (NC.ReverseLinkLabelP Link
ListOfLinkLabels))
(NOT (SETQ LinkFromUsFlg
(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 (OR LinkFromUsFlg (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)))
)
(PUTPROPS PMIPATCH072 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (655 9980 (NC.GrowLinkLattice 665 . 9978)))))
STOP