(FILECREATED "17-Oct-85 20:46:42" {QV}<NOTECARDS>RELEASE1.2I>RHTPATCH003.;4 37013
changes to: (FNS NC.GrowLinkLattice NC.UpdateBrowserCard NC.ExpandBrowserNode
NC.MakeBrowserCard)
(VARS RHTPATCH003COMS)
previous date: "16-Oct-85 15:22:28" {QV}<NOTECARDS>RELEASE1.2I>RHTPATCH003.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH003COMS)
(RPAQQ RHTPATCH003COMS ((FNS NC.GrowLinkLattice NC.UpdateBrowserCard NC.RelayoutBrowserCard
NC.ExpandBrowserNode NC.MakeBrowserCard)))
(DEFINEQ
(NC.GrowLinkLattice
(LAMBDA (RootIDList CurrentGraph ListOfLinkLabels GraphID DatabaseStream RemainingSearchDepth)
(* rht: "17-Oct-85 20: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 ID 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.)
(LET ((StartingIDChar (ADD1 (NCHARS GraphID)))
IDsAndDepthsQueue) (* Make the queue contain pairs of root ID and depth
remaining to search.)
(SETQ IDsAndDepthsQueue (for ID in RootIDList collect (CONS ID RemainingSearchDepth)))
(* Make it a TCONC list for fast appending to the end.)
(SETQ IDsAndDepthsQueue (CONS IDsAndDepthsQueue (LAST IDsAndDepthsQueue)))
(* * Do breadth-first search using the queue IDsAndDepthsQueue.)
(for bind IDAndDepth ID RemainingSearchDepth ToLinks FromLinks DestinationIDs GraphNodeID
GraphNode
eachtime (BLOCK) (* Grab and take apart 1st pair on queue.)
(SETQ IDAndDepth (CAAR IDsAndDepthsQueue))
(SETQ ID (CAR IDAndDepth))
(SETQ RemainingSearchDepth (CDR IDAndDepth))
(* Remove the front pair from the queue.)
(RPLACA IDsAndDepthsQueue (CDAR IDsAndDepthsQueue))
(* If that was the last pair, then start queue over
fresh.)
(if (NULL (CAR IDsAndDepthsQueue))
then (SETQ IDsAndDepthsQueue NIL))
while ID unless (EQ ID GraphID)
do (SETQ GraphNodeID (PACK* GraphID ID)) (* Go grab this ID's links.)
(if (NC.ActiveCardP ID)
then (SETQ ToLinks (NC.FetchToLinks ID))
(SETQ FromLinks (NC.FetchFromLinks ID))
else (WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GrowLinkLattice")
(NC.GetLinks ID DatabaseStream)
(SETQ ToLinks (NC.FetchToLinks ID))
(SETQ FromLinks (NC.FetchFromLinks ID))))
(* Crush the ID's proplist.)
(if (NOT (GETPROP GraphNodeID (QUOTE TouchedFlg)))
then (SETPROPLIST GraphNodeID NIL)
(PUTPROP GraphNodeID (QUOTE TouchedFlg)
T))
(PUTPROP GraphNodeID (QUOTE VisitedFlg)
T)
(if (IGREATERP RemainingSearchDepth 0)
then (SETQ DestinationIDs
(NCONC (for Link in ToLinks bind DestID DestVisitedFlg ThisWayLinkFlg
OtherWayLinkFlg
eachtime (BLOCK)
(SETQ DestID (PACK* GraphID (fetch (NOTECARDLINK
DESTINATIONID)
of Link)))
(SETQ DestVisitedFlg (GETPROP DestID (QUOTE VisitedFlg)))
(SETQ ThisWayLinkFlg (NC.LinkLabelP Link ListOfLinkLabels))
(SETQ OtherWayLinkFlg (NC.ReverseLinkLabelP Link
ListOfLinkLabels))
when ThisWayLinkFlg unless (AND DestVisitedFlg OtherWayLinkFlg)
collect (* Record presence of this link.)
(ADDPROP GraphNodeID DestID (fetch (NOTECARDLINK LINKLABEL)
of Link)
T)
DestID)
(for Link in FromLinks bind DestID DestTouchedFlg DestVisitedFlg
ThisWayLinkFlg OtherWayLinkFlg
eachtime (BLOCK)
(SETQ DestID (PACK* GraphID (fetch (NOTECARDLINK SOURCEID)
of Link)))
(SETQ DestVisitedFlg (GETPROP DestID (QUOTE VisitedFlg)))
(SETQ DestTouchedFlg (GETPROP DestID (QUOTE TouchedFlg)))
(SETQ ThisWayLinkFlg (NC.ReverseLinkLabelP Link
ListOfLinkLabels))
(SETQ OtherWayLinkFlg (NC.LinkLabelP Link ListOfLinkLabels))
when ThisWayLinkFlg unless (AND DestVisitedFlg OtherWayLinkFlg)
collect (* Crush the graphnodeID's prop list if it's never been
touched.)
(if (NOT DestTouchedFlg)
then (SETPROPLIST DestID NIL)
(PUTPROP DestID (QUOTE TouchedFlg)
T))
(* Record presence of this link.)
(ADDPROP DestID GraphNodeID (fetch (NOTECARDLINK LINKLABEL)
of Link)
T)
DestID)))
(SETQ DestinationIDs (DREMOVE (PACK* GraphID GraphID)
(INTERSECTION DestinationIDs DestinationIDs)))
else (SETQ DestinationIDs NIL))
(* * 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 (replace (GRAPHNODE TONODES) of GraphNode with DestinationIDs)
else (SETQ CurrentGraph
(NCONC CurrentGraph
(LIST (create GRAPHNODE
NODEID ← GraphNodeID
TONODES ← DestinationIDs
NODELABEL ← ID)))))
(* * Attach new IDs to end of queue.)
(for DestinationID in DestinationIDs unless (GETPROP DestinationID (QUOTE VisitedFlg))
eachtime (BLOCK) do (SETQ IDsAndDepthsQueue (TCONC IDsAndDepthsQueue
(CONS (SUBATOM DestinationID
StartingIDChar)
(SUB1 RemainingSearchDepth))))
))
CurrentGraph)))
(NC.UpdateBrowserCard
(LAMBDA (Window) (* rht: "17-Oct-85 19:59")
(* * 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.)
(PROG (ID LinkLabels RootIDs RootNodes Lattice LinkIcon Graph GraphNodes NodeLabel PropList
BrowserSpecs BrowserFormat DropVirtualNodesFlg Depth SpecialBrowserSpecs LabelPairs
OldLabelNodes OldRootIDs) (* Get rid of all attached windows except the graph
editor menu if any.)
(for Win in (ATTACHEDWINDOWS Window) unless (WINDOWPROP Win (QUOTE GRAPHEDITMENUFLG))
do (DETACHWINDOW Win)
(CLOSEW Win))
(SETQ ID (NC.IDFromWindow Window))
(SETQ PropList (NC.FetchPropList ID))
(SETQ LinkLabels (CAR (LISTGET PropList (QUOTE BrowserLinkLabels))))
(SETQ RootIDs (MKLIST (CAR (LISTGET PropList (QUOTE BrowserRoots)))))
(SETQ BrowserFormat (OR (CAR (LISTGET PropList (QUOTE BrowserFormat)))
(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 (LISTGET PropList (QUOTE BrowserDepth))
999999))
(SETQ SpecialBrowserSpecs (OR (CAR (LISTGET PropList (QUOTE SpecialBrowserSpecs)))
(create SPECIALBROWSERSPECS)))
(SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP Window (QUOTE GRAPH)))
)) (* Get new roots.)
(if (OR (NULL RootIDs)
(NC.YesP (NC.AskUser "Want to respecify roots? " "--" "No" T Window T NIL T)))
then (NC.BrowserFlipRoots Window ID GraphNodes (SETQ OldRootIDs RootIDs))
(SETQ RootIDs (NC.SelectNoteCards NIL NIL NC.SelectingBrowserSourceMenu Window NIL
(CONCAT
"Please select the Cards and/or Boxes the browser should start from."
(CHARACTER 13)
"(Current roots are highlighted.)")
T))
(NC.BrowserFlipRoots Window ID GraphNodes OldRootIDs)
(COND
((EQ RootIDs (QUOTE CANCELLED))
(RETURN))))
(NC.PrintMsg Window T (CHARACTER 13)
"Computing browser graph. Please wait. ...")
(* Compute lattice breadth-first from the roots.)
(SETQ Lattice (NC.GrowLinkLattice RootIDs NIL LinkLabels ID PSA.Database Depth))
(SETQ RootNodes (for RootID in RootIDs collect (PACK* ID RootID)))
(NC.SetPropListDirtyFlg ID T) (* Remove all links that are in the old browser graph
but not in the new one)
(for Node in GraphNodes bind NodeID Link
eachtime (BLOCK)
(SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
unless (FASSOC (OR (CAR NodeID)
NodeID)
Lattice)
do (if (NC.LinkIconImageObjP (SETQ LinkIcon (fetch (GRAPHNODE NODELABEL) of Node)))
then (WITH.MONITOR (NC.FetchMonitor PSA.Database)
(SETQ Link (NC.FetchLinkFromLinkIcon LinkIcon))
(NC.DelToLink Link PSA.Database)
(NC.DelFromLink Link PSA.Database T))
else (* 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 (NC.MakeLinkIcon
(NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE
NODELABEL)
of Node)
ID)))))
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(REMPROP NodeID (QUOTE TouchedFlg))
(REMPROP 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 (UNION (for Node in Lattice eachtime (BLOCK)
when (NULL (fetch (GRAPHNODE FROMNODES)
of Node))
unless (LISTP (fetch (GRAPHNODE NODEID)
of Node))
collect (fetch (GRAPHNODE NODEID)
of Node))
(INTERSECTION RootNodes Lattice))
(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.)
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(NC.PutProp ID (QUOTE BrowserRoots)
(LIST RootIDs))
(NC.PutProp ID (QUOTE BrowserDepth)
Depth)
(NC.PutProp ID (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.SetPropListDirtyFlg ID T)
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.RelayoutBrowserCard Window))))
(NC.RelayoutBrowserCard
(LAMBDA (Window) (* rht: "15-Oct-85 21:14")
(* * Called from the middle button of a browser or structeditbrowser card. This lays out and displays the browser,
but does not recompute the nodes.)
(PROG (ID RootIDs RootNodes OldToNodePairs Graph GraphNodes PropList BrowserFormat
DropVirtualNodesFlg SpecialBrowserSpecs)
(NC.PrintMsg Window T "Laying out graph ...")
(SETQ ID (NC.IDFromWindow Window))
(SETQ PropList (NC.FetchPropList ID))
(SETQ RootIDs (MKLIST (CAR (LISTGET PropList (QUOTE BrowserRoots)))))
(SETQ BrowserFormat (OR (CAR (LISTGET PropList (QUOTE BrowserFormat)))
(QUOTE (LATTICE)))) (* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
(SETQ SpecialBrowserSpecs (OR (CAR (LISTGET PropList (QUOTE SpecialBrowserSpecs)))
(create SPECIALBROWSERSPECS)))
(SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP Window (QUOTE GRAPH)))
)) (* check graph node size against image box size.)
(NC.GraphLinkIconUpdateCheck ID Window Graph NIL)
(* Save the TONODES values of the nodes so can replace later after LAYOUTGRAPH call. At the same time, throw away
all the link params info in TONODES field.)
(SETQ OldToNodePairs (for Node in GraphNodes bind ToNodes eachtime (BLOCK)
collect (PROG1 (CONS (fetch (GRAPHNODE NODEID) of Node)
(APPEND (SETQ ToNodes (fetch (GRAPHNODE
TONODES)
of Node))))
(replace (GRAPHNODE TONODES) of Node
with (for ToNode in ToNodes
collect (if (EQ (CAR ToNode)
LINKPARAMS)
then (CADR ToNode)
else ToNode))))))
(SETQ RootNodes (for RootID in RootIDs collect (PACK* ID RootID)))
(NC.SetPropListDirtyFlg ID T) (* Layout graph, including as roots any non-virtual
nodes with no from nodes to avoid disconnected graphs.)
(SETQ Graph (if GraphNodes
then (LAYOUTGRAPH GraphNodes (UNION (for Node in GraphNodes
eachtime (BLOCK)
when (NULL (fetch (GRAPHNODE
FROMNODES)
of Node))
unless (LISTP (fetch (GRAPHNODE
NODEID)
of Node))
collect (fetch (GRAPHNODE NODEID)
of Node))
(INTERSECTION RootNodes GraphNodes))
(SUBST (QUOTE LATTICE)
NC.*Graph*BrowserFormat BrowserFormat)
(fetch (SPECIALBROWSERSPECS Font) of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS MotherD) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS PersonalD) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS FamilyD) of
SpecialBrowserSpecs))
else (create GRAPH)))
(* Replace the TONODES fields of the Graph nodes by their pre-LAYOUTGRAPH values. Also throw away any nodes that
didn't appear in the old graph.)
(if Graph
then (replace (GRAPH GRAPHNODES) of Graph
with (for Node in (fetch (GRAPH GRAPHNODES) of Graph) bind AssocPair
eachtime (BLOCK) when (SETQ AssocPair (FASSOC (fetch (GRAPHNODE NODEID)
of Node)
OldToNodePairs))
collect (replace (GRAPHNODE TONODES) of Node with (CDR AssocPair))
(if DropVirtualNodesFlg
then (replace (GRAPHNODE NODEBORDER) of Node with NIL))
(* Throw away LINKPARAMS junk from the FromNodes that
LAYOUTGRAPH stuck in.)
(replace (GRAPHNODE FROMNODES) of Node
with (for FromNode in (fetch (GRAPHNODE FROMNODES)
of Node)
eachtime (BLOCK) collect (if (EQ (CAR FromNode)
LINKPARAMS)
then (CADR FromNode)
else FromNode)))
Node)))
(SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T)
(* * Have to reset windowprops since SHOWGRAPH messes with them.)
(* Disable the old-style right button grapher editor
menu.)
(WINDOWPROP Window (QUOTE RIGHTBUTTONFN)
(FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window (QUOTE REPAINTFN)
(FUNCTION NC.BrowserRepaintFn)
T)
(NC.SetSubstance ID (WINDOWPROP Window (QUOTE GRAPH)))
(NC.MarkCardDirty ID)
(OR (EQ (WINDOWPROP Window (QUOTE BUTTONEVENTFN))
(FUNCTION NC.TitleBarButtonEventFn))
(WINDOWPROP Window (QUOTE OLDBUTTONEVENTFN)
(WINDOWPROP Window (QUOTE BUTTONEVENTFN)
(FUNCTION NC.TitleBarButtonEventFn))))
(NC.ClearMsg Window T))))
(NC.ExpandBrowserNode
(LAMBDA (Window) (* rht: "17-Oct-85 19:59")
(* * Ask user to choose a node in the browser and recompute the part of the lattice under that node to the given
depth. And relayout the graph. The code is just a modification of the NC.UpdateBrowserCard code.)
(PROG (NodeToExpand ID LinkLabels RootIDs RootNodes Lattice LinkIcon OldToNodePairs Graph
GraphNodes NodeLabel OldNode Link PropList BrowserSpecs BrowserFormat
DropVirtualNodesFlg Depth SpecialBrowserSpecs LabelPairs)
(SETQ ID (NC.IDFromWindow Window))
(SETQ PropList (NC.FetchPropList ID))
(SETQ LinkLabels (CAR (LISTGET PropList (QUOTE BrowserLinkLabels))))
(SETQ RootIDs (MKLIST (CAR (LISTGET PropList (QUOTE BrowserRoots)))))
(SETQ BrowserFormat (CAR (LISTGET PropList (QUOTE BrowserFormat))))
(* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
(SETQ SpecialBrowserSpecs (OR (CAR (LISTGET PropList (QUOTE SpecialBrowserSpecs)))
(create SPECIALBROWSERSPECS)))
(SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP Window (QUOTE GRAPH)))
)) (* If there aren't any nodes in graph, then get out
pronto.)
(if (NULL GraphNodes)
then (NC.PrintMsg Window T "No nodes to expand.")
(DISMISS 1000)
(NC.ClearMsg Window T)
(RETURN NIL))
(NC.PrintMsg Window T "Pick node to expand." (CHARACTER 13))
(* Note call to the grapher function READ/NODE to
select a graph node.)
(SETQ NodeToExpand (READ/NODE GraphNodes Window))
(* Can't expand a label node.)
(if (NOT (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of NodeToExpand)))
then (NC.PrintMsg NIL T "Sorry, can't expand a label node.")
(FLASHW PROMPTWINDOW)
(NC.ClearMsg Window T)
(RETURN))
(SETQ Depth (MKATOM (NC.AskUser "Depth to expand (type integer or INF): " "--" 1 T Window
NIL NIL T)))
(COND
((EQ Depth (QUOTE INF))
(SETQ Depth MAX.INTEGER))
((NOT (AND (FIXP Depth)
(GREATERP Depth 0)))
(NC.PrintMsg Window T "Depth must be an integer greater than 0 or INF.")
(RETURN)))
(NC.PrintMsg Window T (CHARACTER 13)
"Augmenting browser graph. Please wait. ...")
(* Save the nodes pointed to by the chosen node that
are label nodes. GrowLinkLattice will trash those, so
we restore afterwards.)
(SETQ SavedLabelNodes (for ToNode in (fetch (GRAPHNODE TONODES) of NodeToExpand)
eachtime (BLOCK) when (AND (NOT (EQ (CAR ToNode)
LINKPARAMS))
(NOT (NC.LinkIconImageObjP ToNode)))
collect ToNode)) (* Increase link lattice from chosen node to given
depth.)
(SETQ Lattice (NC.GrowLinkLattice (LIST (NC.IDFromGraphNodeID (fetch (GRAPHNODE NODEID)
of NodeToExpand)))
(APPEND GraphNodes)
LinkLabels ID PSA.Database Depth))
(AND SavedLabelNodes (replace (GRAPHNODE TONODES) of NodeToExpand
with (APPEND SavedLabelNodes (fetch (GRAPHNODE TONODES)
of NodeToExpand))))
(SETQ RootNodes (for RootID in RootIDs collect (PACK* ID RootID)))
(NC.SetPropListDirtyFlg ID T) (* Create Links for all nodes in the new browser graph
but not in the old one.)
(for Node in Lattice bind NodeID
do (COND
((SETQ OldNode (FASSOC (SETQ NodeID (OR (NC.CoerceToGraphNodeID Node)
(fetch (GRAPHNODE NODEID) of Node)))
GraphNodes))
(replace (GRAPHNODE NODELABEL) of Node with (fetch (GRAPHNODE NODELABEL)
of OldNode)))
(T (replace (GRAPHNODE NODELABEL) of Node with (NC.MakeLinkIcon
(NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE
NODELABEL)
of Node)
ID)))))
(* Throw away virtual node info.)
(AND NodeID (replace (GRAPHNODE NODEID) of Node with NodeID))
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(REMPROP NodeID (QUOTE TouchedFlg))
(REMPROP NodeID (QUOTE VisitedFlg)) (* Smash all the unnecessary junk off existing nodes,
letting LAYOUTGRAPH and NC.MakeLinksLegend recompute.)
(replace (GRAPHNODE TONODES) of Node
with (for ToNode in (fetch (GRAPHNODE TONODES) of Node) bind ToNodeID
eachtime (BLOCK) collect (if (SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode)
)
then
(* Throw away link parameterlist info.)
(* Throw away link dashing info.)
(PUTPROP NodeID ToNodeID
(for LabelPair
in (GETPROP NodeID ToNodeID)
collect (OR (CAR LabelPair)
LabelPair)))
ToNodeID
else ToNode))))
(* LAYOUTGRAPH doesn't like duplicate nodes.
These get created when virtual nodes are turned into
regular nodes.)
(SETQ Lattice (NC.RemoveDuplicateNodesFromGraph Lattice))
(NC.RebuildFromNodesInGraph Lattice)
(SETQ Graph (LAYOUTGRAPH Lattice (UNION (for Node in Lattice eachtime (BLOCK)
when (NULL (fetch (GRAPHNODE FROMNODES)
of Node))
collect (OR (NC.CoerceToGraphNodeID Node)
(fetch (GRAPHNODE NODEID)
of Node)))
(INTERSECTION RootNodes Lattice))
(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)))
(* Build links legend and fix up TONODES in the graph.)
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(NC.PutProp ID (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.SetPropListDirtyFlg ID T)
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.RelayoutBrowserCard Window))))
(NC.MakeBrowserCard
(LAMBDA (ID Title NoDisplayFlg ParamList) (* rht: "17-Oct-85 20:20")
(* Make a browser card with id ID 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.)
(PROG (Lattice Window Graph PropList SpecialBrowserSpecs (RootIDs (MKLIST (LISTGET ParamList
(QUOTE
ROOTCARDS))))
RootNodes
(ListOfLinkLabels (LISTGET ParamList (QUOTE LINKTYPES)))
(BrowserFormat (LISTGET ParamList (QUOTE FORMAT)))
(Depth (LISTGET ParamList (QUOTE DEPTH)))
LabelPairs BrowserSpecs DropVirtualNodesFlg)
(NC.ActivateCard ID)
(COND
((NULL NoDisplayFlg)
(SETQ Window (CREATEW (NC.DetermineDisplayRegion ID NIL)
(NC.FetchTitle ID)
NIL))
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.GraphCardShrinkFn))
(WINDOWPROP Window (QUOTE NoteCardID)
ID)))
(if (NULL RootIDs)
then (SETQ RootIDs (if NoDisplayFlg
then (LIST NIL)
else (NC.SelectNoteCards NIL NIL NC.SelectingBrowserSourceMenu
Window NIL
"Please select the Cards and/or Boxes the browser should start from."
T))))
(COND
((EQ RootIDs (QUOTE CANCELLED))
(NC.DeactivateCard ID)
(CLOSEW Window)
(RETURN)))
(NC.HoldTTYProcess)
(SETQ BrowserSpecs (NC.AskBrowserSpecs Window NIL Depth BrowserFormat T
(if (OR ParamList NoDisplayFlg)
then (QUOTE DONTASK))))
(COND
((NULL BrowserSpecs)
(NC.DeactivateCard ID)
(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. ..."))
(* Compute lattice breakdth-first starting from roots.)
(SETQ Lattice (NC.GrowLinkLattice RootIDs NIL ListOfLinkLabels ID PSA.Database Depth))
(SETQ RootNodes (for RootID in RootIDs collect (PACK* ID RootID)))
(OR NoDisplayFlg (WINDOWPROP Window (QUOTE NoteCardID)
ID))
(* * 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 (NC.MakeLinkIcon
(NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE
NODELABEL)
of Node)
ID NIL)))
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(REMPROP (OR (CAR NodeID)
NodeID)
(QUOTE TouchedFlg))
(REMPROP (OR (CAR NodeID)
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)))
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(OR NoDisplayFlg (NC.PrintMsg Window NIL "Done!"))
(NC.SetSubstance ID Graph)
(NC.PutProp ID (QUOTE BrowserLinkLabels)
(LIST (OR ListOfLinkLabels NC.SubBoxLinkLabel)))
(NC.PutProp ID (QUOTE BrowserRoots)
(LIST RootIDs))
(NC.PutProp ID (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.PutProp ID (QUOTE BrowserFormat)
(LIST BrowserFormat))
(NC.PutProp ID (QUOTE BrowserDepth)
Depth)
(NC.PutProp ID (QUOTE SpecialBrowserSpecs)
(LIST SpecialBrowserSpecs))
(NC.SetPropListDirtyFlg ID T)
(COND
(NoDisplayFlg (RETURN ID)))
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.SetupTitleBarMenu Window ID (QUOTE Browser))
(NC.RelayoutBrowserCard Window)
(RETURN Window))))
)
(PUTPROPS RHTPATCH003 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (565 36931 (NC.GrowLinkLattice 575 . 7465) (NC.UpdateBrowserCard 7467 . 16573) (
NC.RelayoutBrowserCard 16575 . 22342) (NC.ExpandBrowserNode 22344 . 30205) (NC.MakeBrowserCard 30207
. 36929)))))
STOP