(FILECREATED "30-Oct-85 23:38:01" {QV}<NOTECARDS>1.3K>RHTPATCH002.;1 9133
changes to: (VARS RHTPATCH002COMS)
(FNS NC.MakeLinksLegend))
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH002COMS)
(RPAQQ RHTPATCH002COMS ((* * Change to a function in NCBROWSERCARD.)
(FNS NC.MakeLinksLegend)))
(* * Change to a function in NCBROWSERCARD.)
(DEFINEQ
(NC.MakeLinksLegend
(LAMBDA (Graph Win DropVirtualNodesFlg) (* rht: "30-Oct-85 23:35")
(* * For every node in the lattice, there should be properties off of its NODEID for each node it's connected to.
The values of these props are lists of linklabels. Change these values to also contain the dashing number by
assigning a unique dashing number to each new label we come across. If the global var NC.LinkDashingInBrowser is
non-nil, then put out a menu serving as a legend mapping link label names to dashing styles.
If not, then the menu just contains names of link labels.)
(* * rht 3/9/85: Modified to use Danny's grapher improvements. Now changes destination nodes to be in the new list
format.)
(PROG (LabelPairs (MaxDashingStylesNum (LENGTH NC.DashingStyles))
ReferencedNodes NumAppearances OldNumAppearances UnderlyingNodeID)
(for Node in (fetch (GRAPH GRAPHNODES) of Graph) bind NodeID (LabelNum ← 0)
eachtime (BLOCK)
do
(if DropVirtualNodesFlg
then (* Throw away the border indicating a virtual node.)
(replace (GRAPHNODE NODEBORDER) of Node with NIL))
(SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(PUTPROP (SETQ UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node)
NodeID))
(QUOTE NumAppearances)
(if (SETQ OldNumAppearances (GETPROP UnderlyingNodeID (QUOTE NumAppearances)))
then (ADD1 OldNumAppearances)
else 1))
(if (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of Node))
then
(replace (GRAPHNODE TONODES) of Node
with
(for DestNode in (fetch (GRAPHNODE TONODES) of Node) eachtime (BLOCK)
bind NewLabelPairs Labels DestNodeID NewDestNode NotLabelNodeFlg
join (* If already computed a LinkParams list, then rip out
the ID.)
(if (EQ (CAR DestNode)
LINKPARAMS)
then (SETQ DestNode (CADR DestNode)))
(* Check for virtual nodes.)
(SETQ DestNodeID (if (LISTP DestNode)
then (CAR DestNode)
else DestNode))
(SETQ NewDestNode (if DropVirtualNodesFlg
then DestNodeID
else DestNode))
(SETQ NotLabelNodeFlg (NC.IDFromGraphNodeID DestNodeID))
(* Turn forward labels into pairs by adding dashing
numbers.)
(SETQ NewLabelPairs
(if (AND NotLabelNodeFlg
(NOT (OR (LISTP (CAR (GETPROP NodeID DestNodeID)))
(LISTP (CAR (GETPROP DestNodeID NodeID))))))
then (* Okay to continue since we haven't visited this pair
already.)
(APPEND (if (SETQ Labels (GETPROP NodeID DestNodeID))
then (PUTPROP
NodeID DestNodeID
(for Label in Labels bind Pair
collect (COND
((NULL (SETQ Pair
(FASSOC Label
LabelPairs)))
(SETQ Pair
(CONS Label
(COND
((ILESSP LabelNum
MaxDashingStylesNum)
(SETQ LabelNum
(ADD1 LabelNum))
)
(T LabelNum))))
(SETQ LabelPairs
(CONS Pair LabelPairs))))
Pair)))
(if (SETQ Labels (GETPROP DestNodeID NodeID))
then (PUTPROP
DestNodeID NodeID
(for Label in Labels bind Pair
collect (COND
((NULL (SETQ Pair
(FASSOC Label
LabelPairs)))
(SETQ Pair
(CONS Label
(COND
((ILESSP LabelNum
MaxDashingStylesNum)
(SETQ LabelNum
(ADD1 LabelNum))
)
(T LabelNum))))
(SETQ LabelPairs
(CONS Pair LabelPairs))))
Pair))))))
(* Likewise for backward labels.)
(if NewLabelPairs
then (* Stick this dest node on the referenced list since we
know a node points to it.)
(if (NOT (FMEMB NewDestNode ReferencedNodes))
then (push ReferencedNodes NewDestNode))
(LIST (COND
((CDR NewLabelPairs)
(* There are multiple links joining these two nodes so
record nodeids in param list so we can draw flower of
links.)
(LIST LINKPARAMS NewDestNode (QUOTE DRAWLINKFN)
(FUNCTION NC.BrowserDrawLinkFn)
(QUOTE NODEID)
NodeID
(QUOTE DESTNODEID)
DestNodeID))
(T (* Only one link, so compute dashing style here.)
(* Check whether link is forward or backward and throw
in backward flag if appropriate.)
(if (GETPROP NodeID DestNodeID)
then (LIST LINKPARAMS NewDestNode
(QUOTE DRAWLINKFN)
(FUNCTION NC.BrowserDrawLinkFn)
(QUOTE DASHING)
(CAR (FNTH NC.DashingStyles
(CDAR NewLabelPairs))))
else (LIST LINKPARAMS NewDestNode (QUOTE
DRAWLINKFN)
(FUNCTION NC.BrowserDrawLinkFn)
(QUOTE DASHING)
(CAR (FNTH NC.DashingStyles
(CDAR NewLabelPairs)))
(QUOTE BACKWARDFLG)
T)))))
else (* Stick this dest node on the referenced list since we
know a node points to it.)
(if (NOT (FMEMB DestNodeID ReferencedNodes))
then (push ReferencedNodes DestNodeID))
(if (NOT NotLabelNodeFlg)
then (LIST DestNodeID)
else NIL))))))
(* * Note that the following loop gains time at the expense of space. The space-efficient version would only
generate cons nodes for nodes to be deleted, but would require in general, several walks through the structure.)
(* Delete all nodes except the ones that either point to something or are pointed to. But keep those unreferenced
nodes that appear exactly once in the graph. They'll wind up being roots.)
(replace (GRAPH GRAPHNODES) of Graph
with (for Node in (fetch (GRAPH GRAPHNODES) of Graph) eachtime (BLOCK)
when (LET* ((UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node)
(fetch (GRAPHNODE NODEID) of Node)))
(NumAppearances (GETPROP UnderlyingNodeID (QUOTE NumAppearances))))
(if (OR (fetch (GRAPHNODE TONODES) of Node)
(FMEMB (fetch (GRAPHNODE NODEID) of Node)
ReferencedNodes)
(EQ NumAppearances 1))
else (* This node is getting deleted.)
(PUTPROP UnderlyingNodeID (QUOTE NumAppearances)
(SUB1 NumAppearances))
NIL))
collect Node)) (* Get rid of node borders for virtual nodes that now
only appear once in the graph.
Also clean off prop list.)
(for Node in (fetch (GRAPH GRAPHNODES) of Graph)
do (LET ((UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node)
(fetch (GRAPHNODE NODEID) of Node))))
(if (EQ 1 (GETPROP UnderlyingNodeID (QUOTE NumAppearances)))
then (replace (GRAPHNODE NODEBORDER) of Node with NIL))
(REMPROP UnderlyingNodeID (QUOTE NumAppearances))))
(SETQ LabelPairs (DREVERSE LabelPairs))
(AND Win (NC.MakeLinksLegendMenu Win LabelPairs))
(RETURN LabelPairs))))
)
(PUTPROPS RHTPATCH002 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (414 9051 (NC.MakeLinksLegend 424 . 9049)))))
STOP