(FILECREATED "30-Oct-85 23:38:01" {QV}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