(FILECREATED "20-Nov-85 17:46:39" {QV}<NOTECARDS>1.3K>RHTPATCH007.;1 10524
changes to: (VARS RHTPATCH007COMS))
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH007COMS)
(RPAQQ RHTPATCH007COMS ((* * These are redefinitions of old functions in NCBROWSERCARD.)
(FNS NC.ExpandBrowserNode NC.RemoveDuplicateNodesFromGraph)))
(* * These are redefinitions of old functions in NCBROWSERCARD.)
(DEFINEQ
(NC.ExpandBrowserNode
(LAMBDA (Window) (* rht: "20-Nov-85 17:37")
(* * 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 Card LinkLabels RootCards RootNodes Lattice LinkIcon OldToNodePairs Graph
GraphNodes NodeLabel OldNode Link PropList BrowserSpecs BrowserFormat
DropVirtualNodesFlg Depth SpecialBrowserSpecs LabelPairs SavedLabelNodes)
(SETQ Card (NC.CoerceToCard Window))
(SETQ PropList (NC.FetchPropList Card))
(SETQ LinkLabels (CAR (LISTGET PropList (QUOTE BrowserLinkLabels))))
(SETQ RootCards (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)) (* Create hash array if haven't already.)
(NC.GetBrowserHashArray Card Graph)
(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.FIXP))
((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.CardFromBrowserNodeID
(fetch (GRAPHNODE NODEID) of
NodeToExpand)))
(APPEND GraphNodes)
LinkLabels Card Depth))
(AND SavedLabelNodes (replace (GRAPHNODE TONODES) of NodeToExpand
with (APPEND SavedLabelNodes (fetch (GRAPHNODE TONODES)
of NodeToExpand))))
(SETQ RootNodes (for RootCard in RootCards collect (NC.GetBrowserNodeID Card
RootCard)))
(NC.SetPropListDirtyFlg Card 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)
Card)))))
(* 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)))
(PUTPROP ToNodeID NodeID
(for LabelPair
in (GETPROP ToNodeID NodeID)
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 (for Node in Lattice bind NodeID
eachtime (BLOCK)
when (OR (FMEMB (SETQ NodeID
(
NC.CoerceToGraphNodeIDOrLabel
Node))
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)))
(* Build links legend and fix up TONODES in the
graph.)
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(NC.PutProp Card (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.SetPropListDirtyFlg Card T)
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.RelayoutBrowserCard Window))))
(NC.RemoveDuplicateNodesFromGraph
(LAMBDA (GraphNodes) (* rht: "20-Nov-85 17:37")
(* * There should be no virtual nodes or link param thingies. This removes duplicate nodes coalescing their
TONODES.)
(LET (DeletedNodeIDs)
(SETQ GraphNodes (for Node in GraphNodes bind NodeID AlreadyVisitedFlg
eachtime (BLOCK)
(SETQ NodeID (NC.CoerceToGraphNodeIDOrLabel Node))
(if (AND (SETQ AlreadyVisitedFlg (GETPROP
NodeID
(QUOTE AlreadyVisitedFlg)))
(NOT (FMEMB NodeID DeletedNodeIDs)))
then (push DeletedNodeIDs NodeID))
(PUTPROP NodeID (QUOTE CumulativeToNodesList)
(UNION (GETPROP NodeID (QUOTE
CumulativeToNodesList))
(fetch (GRAPHNODE TONODES)
of Node)))
unless AlreadyVisitedFlg collect (PUTPROP NodeID (QUOTE
AlreadyVisitedFlg)
T)
Node))
(for NodeID in DeletedNodeIDs bind GraphNode
do (SETQ GraphNode (FASSOC NodeID GraphNodes))
(replace (GRAPHNODE TONODES) of GraphNode with (GETPROP NodeID (QUOTE
CumulativeToNodesList))))
(for Node in GraphNodes bind NodeID
do (REMPROP (SETQ NodeID (NC.CoerceToGraphNodeIDOrLabel Node))
(QUOTE CumulativeToNodesList))
(REMPROP NodeID (QUOTE AlreadyVisitedFlg)))
GraphNodes)))
)
(PUTPROPS RHTPATCH007 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (461 10442 (NC.ExpandBrowserNode 471 . 8804) (NC.RemoveDuplicateNodesFromGraph 8806 .
10440)))))
STOP