(FILECREATED " 2-Dec-85 17:24:14" {QV}<NOTECARDS>RELEASE1.2I>NCBROWSERCARD.;40 136703
changes to: (FNS NC.MakeLinksLegend)
previous date: "22-Oct-85 15:56:11" {QV}<NOTECARDS>RELEASE1.2I>NCBROWSERCARD.;39)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCBROWSERCARDCOMS)
(RPAQQ NCBROWSERCARDCOMS ([E (SETQ NC.SystemDate (DATE))
(PUTPROP (QUOTE NC.SystemDate)
(QUOTE NewestFile)
(ROOTFILENAME (FULLNAME (OUTPUT]
(* * Stuff for the Notecards browser.)
(FILES NCGRAPHSUBSTANCE NCGRAPHCARD)
(GLOBALVARS NC.SelectingBrowserSourceMenu NC.SpecialBrowserSpecsFlg
NC.BrowserContentsLinkLabel NC.SubBoxLinkLabel NC.FiledCardLinkLabel PSA.Database
NC.SelectingCardMenu NC.BrowserTitleBarMenu NC.DashingStyles
NC.GraphFlowerLinkSeparation NC.LinkDashingInBrowser NC.ArrowHeadsInBrowser
NC.BrowserSpecsStylesheet NC.BrowserFormatOptions NC.*Graph*BrowserFormat
NC.GraphEditMenuItems NC.GraphEditUnfixedMenuItems NC.LinkIconShowTitleFlg
NC.LinkIconShowLinkTypeFlg NC.LinkIconAttachBitmapFlg)
(INITVARS (NC.LinkDashingInBrowser NIL)
(NC.ArrowHeadsInBrowser (QUOTE None)))
[VARS [NC.DashingStyles (QUOTE (NIL (4 4)
(10 4 2 4)
(1 4)
(4 10)
(8 4)
(14 4)
(10 4 2 4 2 4)
(10 4 2 4 2 4 2 4]
(NC.GraphFlowerLinkSeparation 8)
(NC.BrowserSpecsStylesheet (CREATE.STYLE (QUOTE ITEMS)
(LIST (create MENU ITEMS ← T)
(create MENU ITEMS ← T)
(create MENU ITEMS ← T)
(create MENU ITEMS ← T)
(create MENU ITEMS ← T))
(QUOTE SELECTIONS)
(QUOTE (T T T T T))
(QUOTE ITEM.TITLES)
(QUOTE (Forward% Links Backward% Links Depth
Format Orientation))
(QUOTE ITEM.TITLE.FONT)
(FONTCOPY MENUFONT (QUOTE WEIGHT)
(QUOTE BOLD))
(QUOTE NEED.NOT.FILL.IN)
(QUOTE (MULTI MULTI NIL NIL NIL))
(QUOTE TITLE)
"Browser Specs?"))
[NC.BrowserFormatOptions (QUOTE ((*GRAPH* *GRAPH*
"Build a directed graph (no virtual nodes).")
(LATTICE LATTICE
"Build an acyclic directed graph (uses virtual nodes in case of cycles).")
(COMPACT COMPACT
"Build a forest using minimal screen space.")
(FAST FAST
"Build a forest, sacrificing screen space for speed."]
(NC.*Graph*BrowserFormat (QUOTE *GRAPH*))
[NC.GraphEditMenuItems (QUOTE ((Create% Card% &% Node NC.BrowserCreateCardFn
"Create a new card and a corresponding browser node.")
(Create% Link% &% Edge NC.BrowserCreateLinkFn
"Create a new link and a corresponding browser edge."
(SUBITEMS (
Create% Global% Link% &% Edge NC.BrowserCreateGlobalLinkFn
"Create a new global link and a corresponding browser edge.")))
(Delete% Card% &% Node NC.BrowserDeleteCardFn
"Delete an existing card and its browser node.")
(Delete% Link% &% Edge NC.BrowserDeleteLinkFn
"Delete an existing link and its browser edge.")
(Add% Label NC.BrowserAddLabelFn
"Add a string label to graph.")
(Add% Node NC.BrowserAddNodeFn
"Add a node to the browser corresponding to some existing card.")
(Add% Edge NC.BrowserAddEdgeFn
"Add an edge to the browser (no link created).")
(Remove% Node NC.BrowserRemoveNodeFn
"Remove a browser node (no card deleted).")
(Remove% Edge NC.BrowserRemoveEdgeFn
"Remove an edge from the browser (no link deleted).")
(Move% Node NC.BrowserMoveNodeFn "Move a browser node.")
(Label% Smaller NC.BrowserShrinkLabelFn
"Reduce font size for a browser label.")
(Label% Larger NC.BrowserGrowLabelFn
"Increase font size for a browser label.")
("<-> Shade" EDITTOGGLELABEL
"Inverts label shade for a browser label."]
(NC.GraphEditUnfixedMenuItems (APPEND NC.GraphEditMenuItems (QUOTE ((FIX% MENU
NC.BrowserFixGraphEditMenuFn
"Attach this menu to edge of browser window."]
(* * BROWSER mechanisms)
(FNS NC.MakeBrowserCard NC.BringUpBrowserCard)
(FNS NC.GrowLinkLattice NC.UpdateBrowserCard NC.ReorderVirtualGraphNodes
NC.RelayoutBrowserCard NC.ConnectNodesInBrowser NC.UnconnectNodesInBrowser
NC.ExpandBrowserNode NC.NotBrowserHookP NC.AskBrowserSpecs NC.ChangeBrowserSpecs
NC.AskSpecialBrowserSpecs NC.IDFromGraphNodeID NC.BrowserFlipRoots NC.SelectGraphNode
NC.GraphEdgesInconsistentP NC.DisplayGraphLinksBetween NC.RebuildFromNodesInGraph
NC.RemoveDuplicateNodesFromGraph)
(RECORDS SPECIALBROWSERSPECS)
(* * Graph editor menu functions.)
(FNS NC.GetGraphEditMenu NC.BrowserRightButtonFn NC.GraphEditMenuWhenSelectedFn
NC.BrowserCreateCardFn NC.BrowserAddLabelFn NC.BrowserAddNodeFn NC.BrowserCreateLinkFn
NC.BrowserCreateGlobalLinkFn NC.BrowserAddLink NC.BrowserAddGlobalLink
NC.BrowserAddEdgeFn NC.BrowserDeleteCardFn NC.BrowserRemoveNodeFn NC.BrowserDeleteLinkFn
NC.BrowserRemoveEdgeFn NC.BrowserShrinkLabelFn NC.BrowserGrowLabelFn
NC.BrowserMoveNodeFn NC.BrowserFixGraphEditMenuFn NC.BrowserCreateCard
NC.BrowserCreateLink NC.BrowserDeleteCard NC.BrowserDeleteLink NC.BrowserAddNode
NC.BrowserAddLabel NC.BrowserAddEdge NC.BrowserRemoveNode NC.DelBrowserContentsLink
NC.BrowserRemoveEdge NC.GraphRemoveNode)
(* * Grapher hacks for browser)
(FNS NC.MakeLinksLegend NC.MakeLinksLegendMenu NC.LinksLegendRepaintFn NC.BrowserDrawLinkFn
NC.DrawFlowerLinks NC.DrawFlowerLink NC.LinksLegendReshapeFn NC.DrawArrowHead)
(* * Miscellaneous)
(FNS NC.GraphLinkIconUpdateCheck NC.BrowserRepaintFn NC.CoerceToGraphNodeID
NC.CoerceToGraphNodeIDOrLabel)
(GLOBALVARS NC.ArrowHeadLength NC.ArrowHeadAngle NC.ArrowHeadXVal NC.ArrowHeadYVal)
[VARS (NC.ArrowHeadLength 7)
(NC.ArrowHeadAngle 20)
(NC.ArrowHeadXVal (TIMES NC.ArrowHeadLength (COS NC.ArrowHeadAngle)))
(NC.ArrowHeadYVal (TIMES NC.ArrowHeadLength (SIN NC.ArrowHeadAngle]
(FNS NC.AddBrowserCard)
(P (NC.AddBrowserCard))))
(* * Stuff for the Notecards browser.)
(FILESLOAD NCGRAPHSUBSTANCE NCGRAPHCARD)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.SelectingBrowserSourceMenu NC.SpecialBrowserSpecsFlg NC.BrowserContentsLinkLabel
NC.SubBoxLinkLabel NC.FiledCardLinkLabel PSA.Database NC.SelectingCardMenu
NC.BrowserTitleBarMenu NC.DashingStyles NC.GraphFlowerLinkSeparation
NC.LinkDashingInBrowser NC.ArrowHeadsInBrowser NC.BrowserSpecsStylesheet
NC.BrowserFormatOptions NC.*Graph*BrowserFormat NC.GraphEditMenuItems
NC.GraphEditUnfixedMenuItems NC.LinkIconShowTitleFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconAttachBitmapFlg)
)
(RPAQ? NC.LinkDashingInBrowser NIL)
(RPAQ? NC.ArrowHeadsInBrowser (QUOTE None))
(RPAQQ NC.DashingStyles (NIL (4 4)
(10 4 2 4)
(1 4)
(4 10)
(8 4)
(14 4)
(10 4 2 4 2 4)
(10 4 2 4 2 4 2 4)))
(RPAQQ NC.GraphFlowerLinkSeparation 8)
(RPAQ NC.BrowserSpecsStylesheet (CREATE.STYLE (QUOTE ITEMS)
(LIST (create MENU ITEMS ← T)
(create MENU ITEMS ← T)
(create MENU ITEMS ← T)
(create MENU ITEMS ← T)
(create MENU ITEMS ← T))
(QUOTE SELECTIONS)
(QUOTE (T T T T T))
(QUOTE ITEM.TITLES)
(QUOTE (Forward% Links Backward% Links Depth Format
Orientation))
(QUOTE ITEM.TITLE.FONT)
(FONTCOPY MENUFONT (QUOTE WEIGHT)
(QUOTE BOLD))
(QUOTE NEED.NOT.FILL.IN)
(QUOTE (MULTI MULTI NIL NIL NIL))
(QUOTE TITLE)
"Browser Specs?"))
(RPAQQ NC.BrowserFormatOptions ((*GRAPH* *GRAPH* "Build a directed graph (no virtual nodes).")
(LATTICE LATTICE
"Build an acyclic directed graph (uses virtual nodes in case of cycles).")
(COMPACT COMPACT "Build a forest using minimal screen space.")
(FAST FAST "Build a forest, sacrificing screen space for speed.")))
(RPAQQ NC.*Graph*BrowserFormat *GRAPH*)
(RPAQQ NC.GraphEditMenuItems ((Create% Card% &% Node NC.BrowserCreateCardFn
"Create a new card and a corresponding browser node.")
(Create% Link% &% Edge NC.BrowserCreateLinkFn
"Create a new link and a corresponding browser edge."
(SUBITEMS (Create% Global% Link% &% Edge
NC.BrowserCreateGlobalLinkFn
"Create a new global link and a corresponding browser edge.")))
(Delete% Card% &% Node NC.BrowserDeleteCardFn
"Delete an existing card and its browser node.")
(Delete% Link% &% Edge NC.BrowserDeleteLinkFn
"Delete an existing link and its browser edge.")
(Add% Label NC.BrowserAddLabelFn "Add a string label to graph.")
(Add% Node NC.BrowserAddNodeFn
"Add a node to the browser corresponding to some existing card.")
(Add% Edge NC.BrowserAddEdgeFn
"Add an edge to the browser (no link created).")
(Remove% Node NC.BrowserRemoveNodeFn
"Remove a browser node (no card deleted).")
(Remove% Edge NC.BrowserRemoveEdgeFn
"Remove an edge from the browser (no link deleted).")
(Move% Node NC.BrowserMoveNodeFn "Move a browser node.")
(Label% Smaller NC.BrowserShrinkLabelFn
"Reduce font size for a browser label.")
(Label% Larger NC.BrowserGrowLabelFn
"Increase font size for a browser label.")
("<-> Shade" EDITTOGGLELABEL "Inverts label shade for a browser label.")
))
(RPAQ NC.GraphEditUnfixedMenuItems [APPEND NC.GraphEditMenuItems (QUOTE ((FIX% MENU
NC.BrowserFixGraphEditMenuFn
"Attach this menu to edge of browser window."])
(* * BROWSER mechanisms)
(DEFINEQ
(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))))
(NC.BringUpBrowserCard
(LAMBDA (ID Substance Region/Position) (* rht: "11-Sep-85 12:07")
(* * Given a browser Substance, open a browser window and set it up to be a NoteCard with ID.)
(* * rht 11/17/84: Now returns window.)
(* * rht 9/11/85: Now checks for changed link icon display global params.)
(LET ((Window (NC.BringUpGraphCard ID Substance Region/Position)))
(NC.SetupTitleBarMenu Window ID (QUOTE Browser))
(NC.MakeLinksLegendMenu Window (CAR (LISTGET (NC.RetrievePropList ID)
(QUOTE BrowserLinksLegend))))
(* Disable the old-style right button grapher editor
menu.)
(WINDOWPROP Window (QUOTE RIGHTBUTTONFN)
(FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.GraphCardShrinkFn))
(WINDOWADDPROP Window (QUOTE REPAINTFN)
(FUNCTION NC.BrowserRepaintFn)
T)
(* * I have to hang notecard's ID on window now in case REDISPLAYW runs and tries to get ID from window.)
(WINDOWPROP Window (QUOTE NoteCardID)
ID) (* Check if link icon display global params have
changed since last time card was up.
If so, fix graph nodes and redisplay.)
(if (NC.GraphLinkIconUpdateCheck ID Window Substance T)
then (REDISPLAYW Window))
Window)))
)
(DEFINEQ
(NC.GrowLinkLattice
(LAMBDA (RootIDList CurrentGraph ListOfLinkLabels GraphID DatabaseStream RemainingSearchDepth)
(* rht: "18-Oct-85 11:19")
(* 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))))
(if (IGREATERP RemainingSearchDepth 0)
then (* Crush the ID's proplist.)
(if (NOT (GETPROP GraphNodeID (QUOTE TouchedFlg)))
then (SETPROPLIST GraphNodeID NIL)
(PUTPROP GraphNodeID (QUOTE TouchedFlg)
T))
(SETQ DestinationIDs
(NCONC (for Link in ToLinks bind DestID DestVisitedFlg DestTouchedFlg
ThisWayLinkFlg OtherWayLinkFlg
eachtime (BLOCK)
(SETQ DestID (PACK* GraphID (fetch (NOTECARDLINK
DESTINATIONID)
of Link)))
(SETQ DestVisitedFlg (GETPROP DestID (QUOTE VisitedFlg)))
(SETQ DestTouchedFlg (GETPROP DestID (QUOTE TouchedFlg)))
(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 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 (REMPROP DestID GraphNodeID)
else (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))
(PUTPROP 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 ← ID)))))
(* * Attach new IDs to end of queue.)
(for DestinationID in DestinationIDs bind DestID
eachtime (BLOCK)
(SETQ DestID (SUBATOM DestinationID StartingIDChar))
unless (OR (GETPROP DestinationID (QUOTE VisitedFlg))
(FASSOC DestID (CAR IDsAndDepthsQueue)))
do (SETQ IDsAndDepthsQueue (TCONC IDsAndDepthsQueue (CONS DestID (SUB1
RemainingSearchDepth)))))
)
CurrentGraph)))
(NC.UpdateBrowserCard
(LAMBDA (Window) (* rht: "17-Oct-85 22:12")
(* * 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 (for Node in Lattice bind NodeID
eachtime (BLOCK)
(SETQ NodeID
(OR (NC.CoerceToGraphNodeID Node)
(fetch (GRAPHNODE NODEID)
of Node)))
when (OR (FMEMB NodeID 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))
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.ReorderVirtualGraphNodes
(LAMBDA (Graph) (* rht: "29-Aug-85 12:23")
(* * Move the virtual nodes of Graph to the end. LAYOUTGRAPH puts them at the front, which is inconvenient.
Note that this assumes that virtual nodes are grouped at the front.)
(LET ((Nodes (fetch (GRAPH GRAPHNODES) of Graph))
VirtualNodes)
(SETQ VirtualNodes (for Node in old Nodes while (LISTP (fetch (GRAPHNODE NODEID) of Node))
collect Node))
(replace (GRAPH GRAPHNODES) of Graph with (NCONC Nodes VirtualNodes)))))
(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.ConnectNodesInBrowser
(LAMBDA (Window) (* rht: "23-Sep-85 15:44")
(* * Draw any links, from the current link set, between any pairs of nodes currently being shown in the browser.)
(PROG (ID LinkLabels Graph GraphNodes PropList BrowserFormat DropVirtualNodesFlg LabelPairs
NodeIDs)
(SETQ ID (NC.IDFromWindow Window))
(SETQ PropList (NC.FetchPropList ID))
(SETQ LinkLabels (CAR (LISTGET PropList (QUOTE BrowserLinkLabels))))
(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 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)
(* These are the workhorse loops that rebuild the
TONODES of each nonvirtual node.)
(* First smash all the nodeID's proplists and
accumulate nodeIDs.)
(SETQ NodeIDs (for Node in GraphNodes bind NodeID eachtime (BLOCK)
when (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of Node))
collect (SETPROPLIST (SETQ NodeID (NC.CoerceToGraphNodeID Node))
NIL)
NodeID)) (* Throw away duplicates obtained from virtual nodes.)
(SETQ NodeIDs (INTERSECTION NodeIDs NodeIDs))
(* Next accumulate all linktypes on the from node's proplist using the To node's graphnodeID as prop name.
We do the analogous thing for backward links, but notice that we ignore backward linktypes that also appear in the
list in their forward version.)
(for NodeID in NodeIDs bind RealNodeID
do (for Link in (NC.RetrieveToLinks (SETQ RealNodeID (SUBATOM NodeID
(ADD1 (NCHARS ID))))
PSA.Database)
bind DestNodeID eachtime (BLOCK) when (NC.LinkLabelP Link LinkLabels)
when (FMEMB (SETQ DestNodeID (PACK* ID (fetch (NOTECARDLINK DESTINATIONID)
of Link)))
NodeIDs)
do (ADDPROP NodeID DestNodeID (fetch (NOTECARDLINK LINKLABEL) of Link)
T))
(for Link in (NC.RetrieveFromLinks RealNodeID PSA.Database) bind SourceNodeID
eachtime (BLOCK) when (AND (NC.ReverseLinkLabelP Link LinkLabels)
(NOT (NC.LinkLabelP Link LinkLabels)))
when (FMEMB (SETQ SourceNodeID (PACK* ID (fetch (NOTECARDLINK SOURCEID)
of Link)))
NodeIDs)
do (ADDPROP SourceNodeID NodeID (fetch (NOTECARDLINK LINKLABEL) of Link)
T)))
(for Node in GraphNodes bind NodeID OldToNodeIDs eachtime (BLOCK)
unless (LISTP (SETQ NodeID (fetch (GRAPHNODE NODEID) of Node)))
when (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of Node))
do (* Accumulate the old NodeIDs, possibly virtual, from
the TONODES list.)
(SETQ OldToNodeIDs (for ToNode in (fetch (GRAPHNODE TONODES) of Node)
collect (if (EQ (CAR ToNode)
LINKPARAMS)
then (CADR ToNode)
else ToNode)))
(* The trick here is to use a virtual node for this ToNode if one was used before, otherwise just the ToNodeID.
Also throw in the label nodes that were in the TONODES list before.)
(replace (GRAPHNODE TONODES) of Node with (NCONC (for ToNodeID in (GETPROPLIST NodeID)
by (CDDR ToNodeID)
eachtime (BLOCK)
collect (OR (FASSOC ToNodeID
OldToNodeIDs)
ToNodeID))
(for ToNodeID in OldToNodeIDs
eachtime (BLOCK)
unless
(EQ ID (SUBATOM (
NC.CoerceToGraphNodeID ToNodeID)
1
(NCHARS ID)))
collect ToNodeID))))
(NC.RebuildFromNodesInGraph GraphNodes)
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(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)
(NC.PutProp ID (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(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.UnconnectNodesInBrowser
(LAMBDA (Window) (* rht: "11-Sep-85 12:16")
(* * Remove all the links in the browser.)
(PROG (ID Graph GraphNodes PropList BrowserFormat DropVirtualNodesFlg)
(SETQ ID (NC.IDFromWindow Window))
(SETQ PropList (NC.FetchPropList ID))
(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 GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP Window (QUOTE GRAPH)))
)) (* smash all the nodeID's proplists and TONODES
fields.)
(for Node in GraphNodes bind NodeID unless (PROGN (BLOCK)
(LISTP (SETQ NodeID (fetch (GRAPHNODE
NODEID)
of Node))))
do (SETPROPLIST NodeID NIL)
(replace (GRAPHNODE TONODES) of Node with NIL)
(replace (GRAPHNODE FROMNODES) of Node with NIL))
(NC.MakeLinksLegend Graph Window DropVirtualNodesFlg)
(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)
(NC.PutProp ID (QUOTE BrowserLinksLegend)
NIL)
(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 23:32")
(* * 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 SavedLabelNodes)
(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)))
(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)
(SETQ NodeID (OR (NC.CoerceToGraphNodeID
Node)
(fetch (GRAPHNODE NODEID)
of Node)))
when (OR (FMEMB NodeID 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 ID (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.SetPropListDirtyFlg ID T)
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.RelayoutBrowserCard Window))))
(NC.NotBrowserHookP
(LAMBDA (Link) (* NoteCards% User " 5-Jun-84 17:29")
(COND
((EQ (fetch (NOTECARDLINK LINKLABEL) of Link)
NC.BrowserContentsLinkLabel)
NIL)
(T T))))
(NC.AskBrowserSpecs
(LAMBDA (MainWindow OldLinkLabels OldDepth OldFormat CreatingBrowserFlg Don'tAskFlg)
(* rht: " 3-Oct-85 19:35")
(* * Puts up the big stylesheet asking user about link types, depth, browser format, etc. The stylesheet returns a
list of 5 things: forward links, backward links, depth, format, and orientation. The last two are smashed together
to form a browserformat and the first two are nconc'ed together. Thus we return a list of 3 things: links, depth,
and browserformat.)
(* * rht 4/1/85: Now takes Don'tAskFlg arg for when we don't want to ask the user for browser specs.)
(PROG ((LinkLabels (NC.RetrieveLinkLabels PSA.Database T))
Position Choices ReverseFlg)
(if Don'tAskFlg
then (RETURN (LIST (OR OldLinkLabels LinkLabels)
(OR OldDepth 99999)
(OR OldFormat (QUOTE (LATTICE))))))
(SETQ Position (AND (WINDOWP MainWindow)
(create POSITION
XCOORD ←(fetch (REGION LEFT) of (WINDOWPROP MainWindow
(QUOTE REGION)))
YCOORD ←(fetch (REGION TOP) of (WINDOWREGION MainWindow)))))
(if CreatingBrowserFlg
then (SETQ OldLinkLabels LinkLabels))
(SETQ ReverseFlg (EQ (CADDR OldFormat)
(QUOTE REVERSE))) (* The stylesheet is in a global var.
We only need to provide its position, items, and
selections.)
(STYLE.PROP NC.BrowserSpecsStylesheet (QUOTE POSITION)
Position)
(STYLE.PROP NC.BrowserSpecsStylesheet (QUOTE ITEMS)
(LIST (create MENU
ITEMS ← LinkLabels)
(create MENU
ITEMS ←(for Link in LinkLabels collect (PACK* (QUOTE ←)
Link)))
(create MENU
ITEMS ←(QUOTE (0 1 2 3 4 5 6 7 8 9 INF)))
(create MENU
ITEMS ← NC.BrowserFormatOptions)
(create MENU
ITEMS ←(QUOTE (Horizontal Vertical Reverse/Horizontal
Reverse/Vertical)))))
(STYLE.PROP NC.BrowserSpecsStylesheet (QUOTE SELECTIONS)
(LIST (for Label in OldLinkLabels when (NEQ (NTHCHAR Label 1)
(QUOTE ←))
collect Label)
(for Label in OldLinkLabels when (EQ (NTHCHAR Label 1)
(QUOTE ←))
collect Label)
(if (OR (NOT (FIXP OldDepth))
(IGREATERP OldDepth 9)
(ILESSP OldDepth 0))
then (QUOTE INF)
else OldDepth)
(OR (CAR (FASSOC (CAR OldFormat)
NC.BrowserFormatOptions))
(QUOTE LATTICE))
(if (EQ (CADR OldFormat)
(QUOTE VERTICAL))
then (if ReverseFlg
then (QUOTE Reverse/Vertical)
else (QUOTE Vertical))
else (if ReverseFlg
then (QUOTE Reverse/Horizontal)
else (QUOTE Horizontal)))))
(SETQ Choices (STYLESHEET NC.BrowserSpecsStylesheet))
(RETURN (COND
(Choices (LIST (APPEND (CAR Choices)
(CADR Choices))
(OR (FIXP (CADDR Choices))
MAX.INTEGER)
(CONS (CADDDR Choices)
(SELECTQ (CADDDR (CDR Choices))
(Horizontal (LIST (QUOTE HORIZONTAL)
(QUOTE REVERSE/DAUGHTERS)))
(Vertical (LIST (QUOTE VERTICAL)
NIL))
(Reverse/Horizontal (LIST (QUOTE HORIZONTAL)
(QUOTE REVERSE)
(QUOTE REVERSE/DAUGHTERS))
)
(Reverse/Vertical (LIST (QUOTE VERTICAL)
(QUOTE REVERSE)))
NIL))))
(CreatingBrowserFlg NIL)
(T (LIST OldLinkLabels OldDepth OldFormat)))))))
(NC.ChangeBrowserSpecs
(LAMBDA (Window) (* rht: "23-Apr-85 00:06")
(* * Change the values of the various browser specs including link types, browser format, search depth, etc.)
(PROG (ID LinkLabels RootIDs RootNodes PropList BrowserSpecs BrowserFormat Depth)
(SETQ ID (NC.IDFromWindow Window))
(SETQ PropList (NC.FetchPropList ID))
(SETQ LinkLabels (CAR (LISTGET PropList (QUOTE BrowserLinkLabels))))
(SETQ BrowserFormat (CAR (LISTGET PropList (QUOTE BrowserFormat))))
(SETQ Depth (LISTGET PropList (QUOTE BrowserDepth)))
(SETQ BrowserSpecs (NC.AskBrowserSpecs Window LinkLabels Depth BrowserFormat))
(SETQ LinkLabels (CAR BrowserSpecs))
(SETQ Depth (CADR BrowserSpecs))
(SETQ BrowserFormat (CADDR BrowserSpecs))
(NC.SetPropListDirtyFlg ID T)
(NC.PutProp ID (QUOTE BrowserLinkLabels)
(LIST LinkLabels))
(NC.PutProp ID (QUOTE BrowserFormat)
(LIST BrowserFormat))
(NC.PutProp ID (QUOTE BrowserDepth)
Depth)
(NC.ClearMsg Window T))))
(NC.AskSpecialBrowserSpecs
(LAMBDA (BrowserWindow) (* rht: "30-May-85 21:44")
(* * Get the specification for laying out a browser graph from the user and return them in a BrowserSpecs record.)
(* * rht 3/8/85: Threw out question about browser Format. That is now obtained in NC.AskBrowserSpecs along with link
types, etc.)
(PROG (BrowserSpecs)
(OR (WINDOWP BrowserWindow)
(SETQ BrowserWindow))
(SETQ BrowserSpecs (create SPECIALBROWSERSPECS
Font ← NIL
MotherD ←(FIXP (MKATOM (NC.AskUser
"What is the MotherD for this browser? "
NIL NIL T BrowserWindow T)))
PersonalD ←(FIXP (MKATOM (OR (NC.AskUser
"What is the PersoalD for this browser? "
NIL NIL T BrowserWindow
T)
10)))
FamilyD ←(FIXP (MKATOM (NC.AskUser
"What is the FamilyD for this browser? "
NIL NIL T BrowserWindow T)))))
(RETURN BrowserSpecs))))
(NC.IDFromGraphNodeID
(LAMBDA (GraphNodeID) (* rht: "11-Apr-85 12:10")
(* * Peel off the ID from latter half of GraphNodeID.)
(PROG ((ID (SUBATOM GraphNodeID 8)))
(RETURN (AND (NC.IDP ID)
ID)))))
(NC.BrowserFlipRoots
(LAMBDA (Window GraphID GraphNodes RootIDs) (* rht: "12-Apr-85 01:07")
(* * Flip to reverse video for each root node in the graph.)
(for RootID in RootIDs bind RootNode
do (SETQ RootNode (FASSOC (PACK* GraphID RootID)
GraphNodes))
(AND RootNode (FLIPNODE RootNode Window)))))
(NC.SelectGraphNode
(LAMBDA (Window Graph Mess) (* rht: "28-Apr-85 21:05")
(* * User selects a node from the browser. The node is inverted and returned.)
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(CLRPROMPT)
(PROG (NODE)
(COND
((NOT (fetch (GRAPH GRAPHNODES) of Graph))
(PROMPTPRINT " No nodes in graph.")
(RETURN)))
(PROMPTPRINT Mess)
(SETQ NODE (READ/NODE (fetch (GRAPH GRAPHNODES) of Graph)
Window))
(TERPRI T)
(FLIPNODE NODE Window)
(RETURN NODE)))))
(NC.GraphEdgesInconsistentP
(LAMBDA (Graph QuietFlg) (* rht: "28-Apr-85 21:51")
(* * Returns NIL if FROMNODES of every node agree in number with sum of everybody's TONODES to that node.
Otherwise, return list of inconsistent nodes.)
(PROG ((GraphNodes (fetch (GRAPH GRAPHNODES) of Graph))
NumFromNodes NumToNodes)
(RETURN (for Node in GraphNodes bind NodeID
when (PROG2 (SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(NOT (EQP (SETQ NumFromNodes (LENGTH (fetch (GRAPHNODE FROMNODES)
of Node)))
(SETQ NumToNodes
(for OtherNode in GraphNodes
sum (for ToNode in (fetch (GRAPHNODE TONODES)
of OtherNode)
when (EQ NodeID (if (EQ (CAR ToNode)
LINKPARAMS)
then (CADR ToNode)
else ToNode))
count ToNode)))))
(OR QuietFlg (PRINT (CONCAT NodeID ": " NumFromNodes " From nodes, "
NumToNodes " To nodes."))))
collect Node)))))
(NC.DisplayGraphLinksBetween
(LAMBDA (FromNode ToNode Window Graph) (* rht: "29-Apr-85 00:19")
(* * Display (or undisplay) the grapher links joining FromNode and ToNode.)
(PROG (LinkParams ReverseLinkParams)
(COND
((SETQ LinkParams (LINKPARAMETERS FromNode ToNode))
(DISPLAYLINK FromNode ToNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph 1 LinkParams))
((SETQ ReverseLinkParams (LINKPARAMETERS ToNode FromNode))
(DISPLAYLINK ToNode FromNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph 1 ReverseLinkParams))))))
(NC.RebuildFromNodesInGraph
(LAMBDA (GraphNodes) (* rht: "31-Aug-85 16:50")
(* * Remove the FROMNODES from every graph node and rebuild them using the TONODES. Note that there must not be link
param thingies in the TONODES, but virtual nodes are okay.)
(for Node in GraphNodes bind NodeID NewFromNodes eachtime (BLOCK)
do (SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(SETQ NewFromNodes (for OtherNode in GraphNodes when (FMEMB NodeID (fetch (GRAPHNODE
TONODES)
of OtherNode))
collect (fetch (GRAPHNODE NODEID) of OtherNode)))
(replace (GRAPHNODE FROMNODES) of Node with (INTERSECTION NewFromNodes NewFromNodes)))))
(NC.RemoveDuplicateNodesFromGraph
(LAMBDA (GraphNodes) (* rht: " 3-Sep-85 12:43")
(* * 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.CoerceToGraphNodeID 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.CoerceToGraphNodeID Node))
(QUOTE CumulativeToNodesList))
(REMPROP NodeID (QUOTE AlreadyVisitedFlg)))
GraphNodes)))
)
[DECLARE: EVAL@COMPILE
(RECORD SPECIALBROWSERSPECS (Font MotherD PersonalD FamilyD)
PersonalD ← 10)
]
(* * Graph editor menu functions.)
(DEFINEQ
(NC.GetGraphEditMenu
(LAMBDA (Window) (* rht: "12-Apr-85 18:46")
(* * Create, if necessary, and bring up the graph editor menu.)
(PROG ((GraphEditUnfixableMenu (WINDOWPROP Window (QUOTE GRAPHEDITUNFIXABLEMENU)))
(GraphEditFixableMenu (WINDOWPROP Window (QUOTE GRAPHEDITFIXABLEMENU)))
GraphEditMenuWin) (* If menu is already up, then put up a menu without
the FIXMENU option, otherwise, allow user to fix menu.)
(if (for Win in (ATTACHEDWINDOWS Window) thereis (WINDOWPROP Win (QUOTE GRAPHEDITMENUFLG)))
then (OR GraphEditUnfixableMenu
(WINDOWPROP Window (QUOTE GRAPHEDITUNFIXABLEMENU)
(SETQ GraphEditUnfixableMenu
(create MENU
ITEMS ← NC.GraphEditMenuItems
TITLE ← "Graph Editor Menu"
WHENSELECTEDFN ←(FUNCTION NC.GraphEditMenuWhenSelectedFn)
CHANGEOFFSETFLG ← T
MENUOFFSET ←(CONS -1 0)))))
(PUTMENUPROP GraphEditUnfixableMenu (QUOTE MAINWINDOW)
Window)
(MENU GraphEditUnfixableMenu)
else (OR GraphEditFixableMenu
(WINDOWPROP Window (QUOTE GRAPHEDITFIXABLEMENU)
(SETQ GraphEditFixableMenu
(create MENU
ITEMS ← NC.GraphEditUnfixedMenuItems
TITLE ← "Graph Editor Menu"
WHENSELECTEDFN ←(FUNCTION NC.GraphEditMenuWhenSelectedFn)
CHANGEOFFSETFLG ← T
MENUOFFSET ←(CONS -1 0)))))
(PUTMENUPROP GraphEditFixableMenu (QUOTE MAINWINDOW)
Window)
(MENU GraphEditFixableMenu)))))
(NC.BrowserRightButtonFn
(LAMBDA (Window) (* rht: "12-Apr-85 18:27")
(* * Causes grapher editor menu to come up on right button. If menu is already fixed then brings up menu without
FIXMENU item.)
(COND
((NOT (INSIDE? (DSPCLIPPINGREGION NIL Window)
(LASTMOUSEX Window)
(LASTMOUSEY Window)))
(DOWINDOWCOM Window))
(T (NC.GetGraphEditMenu Window) (* do menu)
))))
(NC.GraphEditMenuWhenSelectedFn
(LAMBDA (MenuItem Menu MouseKey) (* rht: "10-Apr-85 15:20")
(* * Called when a selection is made in the graph editor menu. Just call the function, passing it the main window as
arg.)
(APPLY* (CADR MenuItem)
(GETMENUPROP Menu (QUOTE MAINWINDOW)))))
(NC.BrowserCreateCardFn
(LAMBDA (Window) (* rht: "10-Apr-85 12:34")
(* * Called from graph edit menu to create card and node. Just sets up the proper ADDNODEFN in graph record and
invokes grapher editor.)
(replace (GRAPH GRAPH.ADDNODEFN) of (WINDOWPROP Window (QUOTE GRAPH))
with (FUNCTION NC.BrowserCreateCard))
(EDITADDNODE Window)))
(NC.BrowserAddLabelFn
(LAMBDA (Window) (* rht: "25-Apr-85 22:56")
(* * Called from graph edit menu to add label to graph. Just sets up the proper ADDNODEFN in graph record and
invokes grapher editor.)
(replace (GRAPH GRAPH.ADDNODEFN) of (WINDOWPROP Window (QUOTE GRAPH))
with (FUNCTION NC.BrowserAddLabel))
(EDITADDNODE Window)))
(NC.BrowserAddNodeFn
(LAMBDA (Window) (* rht: "10-Apr-85 12:34")
(* * Called from graph edit menu to create browser node for an existing card. Just sets up the proper ADDNODEFN in
graph record and invokes grapher editor.)
(replace (GRAPH GRAPH.ADDNODEFN) of (WINDOWPROP Window (QUOTE GRAPH))
with (FUNCTION NC.BrowserAddNode))
(EDITADDNODE Window)))
(NC.BrowserCreateLinkFn
(LAMBDA (Window) (* rht: "23-Apr-85 23:43")
(* * Called from graph edit menu to create link and edge.)
(EDITAPPLYTOLINK (FUNCTION NC.BrowserAddLink)
(QUOTE added)
(WINDOWPROP Window (QUOTE GRAPH))
Window)))
(NC.BrowserCreateGlobalLinkFn
(LAMBDA (Window) (* rht: "20-Sep-85 14:34")
(* * Called from graph edit menu to create a global link and edge.)
(EDITAPPLYTOLINK (FUNCTION NC.BrowserAddGlobalLink)
(QUOTE added)
(WINDOWPROP Window (QUOTE GRAPH))
Window)))
(NC.BrowserAddLink
(LAMBDA (FromNode ToNode Win Graph GlobalLinkFlg) (* rht: "20-Sep-85 14:38")
(* * Like grapher's ADD/AND/DISPLAY/LINK except has different checks and builds a real NC Link.)
(* * rht 9/20/85: Added GlobalLinkFlg arg to force the link created to be global. Currently, it's global anyway if
from node is a sketch card, for example.)
(PROG (Link LinkLabel ID LabelPairs LabelPair PropList (MaxDashingStylesNum (LENGTH
NC.DashingStyles))
LabelNum ToNodeID FromNodeID OldDestNode LinkParams ReverseLinkParams
SavedDeleteLinkFn NumberOfLinks)
(COND
((NOT (AND (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of FromNode))
(NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of ToNode))))
(NC.PrintMsg NIL T
"Can't create link from or to a label node. Try 'Add Edge' instead.")
(FLASHW PROMPTWINDOW)
(RETURN NIL))
((SETQ Link (NC.BrowserCreateLink FromNode ToNode Graph Win GlobalLinkFlg))
(* We successfully created a link.
Now undraw existing link and redraw with new one
added.)
(* First, check whether label for new link is already
in graph.)
(SETQ ID (NC.IDFromWindow Win))
(SETQ PropList (NC.FetchPropList ID))
(SETQ LabelPairs (CAR (NC.GetProp ID (QUOTE BrowserLinksLegend))))
(SETQ LinkLabel (fetch (NOTECARDLINK LINKLABEL) of Link))
(* If link label hasn't appeared in the graph, make a
new dashing number for it and update links legend.)
(if (NULL (SETQ LabelPair (FASSOC LinkLabel LabelPairs)))
then (SETQ LabelPairs (APPEND LabelPairs (LIST (SETQ LabelPair
(CONS LinkLabel
(COND
((ILESSP (SETQ LabelNum
(LENGTH
LabelPairs))
MaxDashingStylesNum)
(SETQ LabelNum
(ADD1 LabelNum)))
(T LabelNum)))))))
(NC.PutProp ID (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.MakeLinksLegendMenu Win LabelPairs))
(SETQ FromNodeID (NC.CoerceToGraphNodeID FromNode))
(SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode))
(SETQ NumberOfLinks (PLUS (LENGTH (GETPROP FromNodeID ToNodeID))
(LENGTH (GETPROP ToNodeID FromNodeID))))
(SETQ LinkParams (LINKPARAMETERS FromNode ToNode))
(SETQ ReverseLinkParams (LINKPARAMETERS ToNode FromNode))
(COND
((OR (ZEROP NumberOfLinks)
(AND (NULL LinkParams)
(NULL ReverseLinkParams)))
(if (OR (FMEMB (fetch (GRAPHNODE NODEID) of FromNode)
(fetch (GRAPHNODE TONODES) of ToNode))
(FMEMB (fetch (GRAPHNODE NODEID) of ToNode)
(fetch (GRAPHNODE TONODES) of FromNode)))
then (* There are no links, but there is an edge.
Delete it and redisplay.)
(SETQ SavedDeleteLinkFn (fetch (GRAPH GRAPH.DELETELINKFN) of Graph))
(replace (GRAPH GRAPH.DELETELINKFN) of Graph with NIL)
(DELETE/AND/DISPLAY/LINK FromNode ToNode Win Graph)
(NC.PrintMsg NIL T "Replacing existing edge with new link edge.")
(FLASHW PROMPTWINDOW)) (* This is first link between these two nodes so
compute dashing here.)
(replace (GRAPHNODE TONODES) of FromNode
with (CONS (LIST LINKPARAMS (fetch (GRAPHNODE NODEID) of ToNode)
(QUOTE DRAWLINKFN)
(FUNCTION NC.BrowserDrawLinkFn)
(QUOTE DASHING)
(CAR (FNTH NC.DashingStyles (CDR LabelPair))))
(fetch (GRAPHNODE TONODES) of FromNode)))
(replace (GRAPHNODE FROMNODES) of ToNode with (CONS (fetch (GRAPHNODE NODEID)
of FromNode)
(fetch (GRAPHNODE FROMNODES)
of ToNode))))
(LinkParams (* There are multiple links.
And the link params is on the FromNode.)
(DISPLAYLINK FromNode ToNode
(CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 LinkParams)
(* If there was only one link, then change so
multi-link indicator.)
(if (EQP NumberOfLinks 1)
then (RPLACD (CDR LinkParams)
(LIST (QUOTE NODEID)
FromNodeID
(QUOTE DESTNODEID)
ToNodeID))))
(T (* There are multiple links.
The Link params is on the ToNode.)
(DISPLAYLINK ToNode FromNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 ReverseLinkParams)
(* If there was only one link, then change so
multi-link indicator.)
(if (EQP NumberOfLinks 1)
then (RPLACD (CDR ReverseLinkParams)
(LIST (QUOTE NODEID)
ToNodeID
(QUOTE DESTNODEID)
FromNodeID)))))
(ADDPROP FromNodeID ToNodeID LabelPair)
(COND
(LinkParams (DISPLAYLINK FromNode ToNode
(CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 LinkParams))
(ReverseLinkParams (DISPLAYLINK ToNode FromNode
(CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 ReverseLinkParams))
(T (DISPLAYLINK FromNode ToNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 (LINKPARAMETERS FromNode ToNode))))
(RETURN NIL))))))
(NC.BrowserAddGlobalLink
(LAMBDA (FromNode ToNode Win Graph) (* rht: "20-Sep-85 14:34")
(* * This function just allows us to get a GlobalLinkFlg into NC.BrowserAddLink.)
(NC.BrowserAddLink FromNode ToNode Win Graph T)))
(NC.BrowserAddEdgeFn
(LAMBDA (Window) (* rht: "25-Apr-85 23:16")
(* * Called from graph edit menu to create edge.)
(EDITAPPLYTOLINK (FUNCTION NC.BrowserAddEdge)
(QUOTE added)
(WINDOWPROP Window (QUOTE GRAPH))
Window)))
(NC.BrowserDeleteCardFn
(LAMBDA (Window) (* rht: "28-Apr-85 22:34")
(* * Called from graph edit menu to delete card and node.)
(PROG ((Graph (WINDOWPROP Window (QUOTE GRAPH))))
(replace (GRAPH GRAPH.DELETENODEFN) of Graph with NIL)
(NC.BrowserRemoveNode Graph Window T))))
(NC.BrowserRemoveNodeFn
(LAMBDA (Window) (* rht: "28-Apr-85 22:34")
(* * Called from graph edit menu to delete a browser node.)
(PROG ((Graph (WINDOWPROP Window (QUOTE GRAPH))))
(replace (GRAPH GRAPH.DELETENODEFN) of Graph with NIL)
(NC.BrowserRemoveNode Graph Window))))
(NC.BrowserDeleteLinkFn
(LAMBDA (Window) (* rht: "24-Apr-85 21:57")
(* * Called from graph edit menu to delete link and edge.)
(EDITAPPLYTOLINK (FUNCTION NC.BrowserDeleteLink)
(QUOTE deleted)
(WINDOWPROP Window (QUOTE GRAPH))
Window)))
(NC.BrowserRemoveEdgeFn
(LAMBDA (Window) (* rht: "27-Apr-85 16:53")
(* * Called from graph edit menu to remove browser edge.)
(EDITAPPLYTOLINK (FUNCTION NC.BrowserRemoveEdge)
(QUOTE removed)
(WINDOWPROP Window (QUOTE GRAPH))
Window)))
(NC.BrowserShrinkLabelFn
(LAMBDA (Window) (* rht: "10-Apr-85 12:47")
(* * Shrink a browser label font.)
(EDITCHANGEFONT (QUOTE SMALLER)
Window)))
(NC.BrowserGrowLabelFn
(LAMBDA (Window) (* rht: "10-Apr-85 12:49")
(* * Increase a browser label font.)
(EDITCHANGEFONT (QUOTE LARGER)
Window)))
(NC.BrowserMoveNodeFn
(LAMBDA (Window) (* rht: "22-Oct-85 15:48")
(* * Move a browser node)
(EDITMOVENODE Window)
(NC.MarkCardDirty (NC.IDFromWindow Window))))
(NC.BrowserFixGraphEditMenuFn
(LAMBDA (Window) (* rht: "20-Sep-85 12:34")
(* * Attach the Graph edit menu to the side of the browser window. Put it below the links legend.)
(* * rht 9/20/85: Now uses ADDMENU offscreen so it doesn't flash in lower left corner before coming up.)
(LET (GraphEditMenu GraphEditMenuWin)
(SETQ GraphEditMenu (create MENU
ITEMS ← NC.GraphEditMenuItems
TITLE ← "Editor Menu"
WHENSELECTEDFN ←(FUNCTION NC.GraphEditMenuWhenSelectedFn)))
(PUTMENUPROP GraphEditMenu (QUOTE MAINWINDOW)
Window)
(ATTACHWINDOW (SETQ GraphEditMenuWin (ADDMENU GraphEditMenu NIL NC.OffScreenPosition))
Window
(QUOTE RIGHT)
(QUOTE BOTTOM)
(QUOTE LOCALCLOSE))
(WINDOWPROP GraphEditMenuWin (QUOTE GRAPHEDITMENUFLG)
T))))
(NC.BrowserCreateCard
(LAMBDA (Graph Window) (* rht: "22-Sep-85 16:27")
(* * Called from grapher ADDNODE fn. Used to create a new card and corresponding browser node.)
(PROG (Link (GraphID (NC.IDFromWindow Window))
GraphNodeID ID Title)
(SETQ Link (NC.MakeLink Window NC.BrowserContentsLinkLabel (QUOTE *New% Card*)
GraphID NIL NIL NIL T))
(SETQ Title (NC.FetchTitle (SETQ ID (fetch (NOTECARDLINK DESTINATIONID) of Link))))
(if Link
then (NC.SetTitle ID (OR (NC.AskUser "Title of new card: " NIL (if (STREQUAL "Untitled"
Title)
then NIL
else Title)
T Window)
"Untitled"))
(SETQ GraphNodeID (PACK* GraphID ID))
(NC.MarkCardDirty GraphID)
(RETURN (NODECREATE GraphNodeID (NC.MakeLinkIcon Link)
(CURSORPOSITION NIL Window)))
else (RETURN NIL)))))
(NC.BrowserCreateLink
(LAMBDA (FromNode ToNode Graph Window GlobalLinkFlg) (* rht: "21-Sep-85 13:36")
(* * Called by grapher when user creates a new link.)
(* * rht 9/20/85: Added GlobalLinkFlg arg to force the link created to be global. Currently, it's global anyway if
from node is a sketch card, for example.)
(LET ((GraphID (NC.IDFromWindow Window))
SourceID SourceType DestinationID LinkLabel StartingIDChar)
(if (EQ FromNode ToNode)
then (NC.PrintMsg NIL T "Can't create a link from node to itself.")
(FLASHW PROMPTWINDOW)
NIL
else (NC.MarkCardDirty GraphID)
(SETQ StartingIDChar (ADD1 (NCHARS GraphID)))
(SETQ SourceID (SUBATOM (NC.CoerceToGraphNodeID FromNode)
StartingIDChar))
(SETQ DestinationID (SUBATOM (NC.CoerceToGraphNodeID ToNode)
StartingIDChar))
(SETQ LinkLabel (COND
((AND (NOT GlobalLinkFlg)
(EQ (SETQ SourceType (NC.FetchType SourceID))
(QUOTE FileBox)))
(COND
((EQ (NC.FetchType DestinationID)
(QUOTE FileBox))
NC.SubBoxLinkLabel)
(T NC.FiledCardLinkLabel)))
(T (NC.AskLinkLabel Window NIL NIL T T))))
(AND LinkLabel (COND
((AND (NOT GlobalLinkFlg)
(EQ (NCP.CardTypeSubstance SourceType)
(QUOTE TEXT)))
(NCP.LocalGlobalLink LinkLabel SourceID DestinationID (QUOTE END)))
(T (NCP.GlobalGlobalLink LinkLabel SourceID DestinationID))))))))
(NC.BrowserDeleteCard
(LAMBDA (Node Graph Window) (* rht: "30-May-85 21:45")
(* * Called by grapher when user deletes a node. Will try to delete the card behind the node as well.)
(PROG ((GraphID (NC.IDFromWindow Window))
ID StartingIDChar GraphNodeID RootIDs)
(SETQ StartingIDChar (ADD1 (NCHARS GraphID)))
(SETQ ID (SUBATOM (fetch (GRAPHNODE NODEID) of Node)
StartingIDChar))
(NC.MarkCardDirty GraphID) (* Delete all record of links to and from this node on
prop lists.)
(SETPROPLIST (SETQ GraphNodeID (NC.CoerceToGraphNodeID Node))
NIL)
(for OtherNode in (fetch (GRAPH GRAPHNODES) of Graph) do (REMPROP (NC.CoerceToGraphNodeID
OtherNode)
GraphNodeID))
(* Does user really want to delete the card behind this
node?)
(COND
((AND (NCP.ValidID ID)
(NC.YesP (NC.AskUser (CONCAT "Want to delete the " (NC.FetchTitle ID)
" card? ")
"--"
(QUOTE Yes)
T Window NIL NIL T)))
(NCP.DeleteCards ID) (* Redisplay so that the deletedLinkIcon goes away.)
(DISPLAYNODE Node (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph) (* Remove from the root ids list.)
(SETQ RootIDs (MKLIST (CAR (NC.GetProp GraphID (QUOTE BrowserRoots)))))
(if (FMEMB ID RootIDs)
then (NC.PutProp GraphID (QUOTE BrowserRoots)
(LIST (DREMOVE ID RootIDs)))))
(T (NC.PrintMsg Window NIL "Card not deleted."))))))
(NC.BrowserDeleteLink
(LAMBDA (FromNode ToNode Window Graph) (* rht: "30-May-85 21:46")
(* * Called by grapher when user deletes a link.)
(PROG ((GraphID (NC.IDFromWindow Window))
SourceID SourceType DestinationID LinkLabel StartingIDChar Link Links FromNodeID ToNodeID
LabelPairs MenuItems ExistingLabels LinkAndLabelPair LinkParams ReverseLinkParams)
(* Be sure this is a link between non-label nodes.)
(if (NOT (AND (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of FromNode))
(NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of ToNode))))
then (NC.PrintMsg Window T
"Can't delete link from or to a label node. Try 'Remove Edge' instead.")
(RETURN NIL))
(SETQ StartingIDChar (ADD1 (NCHARS GraphID)))
(SETQ SourceID (SUBATOM (SETQ FromNodeID (NC.CoerceToGraphNodeID FromNode))
StartingIDChar))
(SETQ DestinationID (SUBATOM (SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode))
StartingIDChar))
(SETQ Links (NCP.GetLinks SourceID DestinationID))
(SETQ LabelPairs (GETPROP FromNodeID ToNodeID))
(SETQ ExistingLabels (for Link in Links collect (fetch (NOTECARDLINK LINKLABEL)
of Link)))
(NC.MarkCardDirty GraphID)
(* Let user choose among those edges having links that exist in the real world, and those edges whose corresponding
real-life links have been deleted.)
(SETQ MenuItems (NCONC (for Link in Links bind LinkLabel LabelPair
when (SETQ LabelPair (FASSOC (SETQ LinkLabel (fetch (NOTECARDLINK
LINKLABEL)
of Link))
LabelPairs))
collect (LIST LinkLabel (BQUOTE (QUOTE (, Link , LabelPair)))))
(for LabelPair in LabelPairs unless (FMEMB (CAR LabelPair)
ExistingLabels)
collect (LIST (CAR LabelPair)
(BQUOTE (QUOTE (, NIL , LabelPair)))))))
(SETQ LinkAndLabelPair (COND
((CDR MenuItems)
(MENU (create MENU
ITEMS ← MenuItems
TITLE ← "Which link to delete?")))
(T (EVAL (CADAR MenuItems)))))
(COND
((NOT LinkAndLabelPair)
(FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "No link to delete.")
(RETURN NIL))
((SETQ Link (CAR LinkAndLabelPair))
(if (NC.YesP (NC.AskUser (CONCAT "Want to delete the " (fetch (NOTECARDLINK LINKLABEL)
of Link)
" link between "
(NC.FetchTitle SourceID)
" and "
(NC.FetchTitle DestinationID)
"? ")
"--"
(QUOTE Yes)
T Window NIL NIL T))
then (NCP.DeleteLinks Link)
else (RETURN NIL)))
((NOT (NC.YesP (NC.AskUser (CONCAT "Link for that label already deleted." (CHARACTER
13)
"Want to delete its edge? ")
"- -"
(QUOTE Yes)
T Window NIL NIL T)))
(RETURN NIL))) (* Undisplay the links between the nodes.)
(COND
((SETQ LinkParams (LINKPARAMETERS FromNode ToNode))
(DISPLAYLINK FromNode ToNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph 1 LinkParams))
((SETQ ReverseLinkParams (LINKPARAMETERS ToNode FromNode))
(DISPLAYLINK ToNode FromNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph 1 ReverseLinkParams)))
(* Remove the first occurrence of the label pair from
the proper prop list.)
(PUTPROP FromNodeID ToNodeID (for RestOfLabelPairs on LabelPairs
bind (LabelPair ←(CADR LinkAndLabelPair))
first (if (EQ LabelPair (CAR LabelPairs))
then (RETURN (CDR LabelPairs)))
do (if (EQ LabelPair (CADR RestOfLabelPairs))
then (RPLACD RestOfLabelPairs (CDDR RestOfLabelPairs)
)
(RETURN LabelPairs))))
(* If that was the last edge between the two nodes,
then remove the edge from the graph.)
(if (AND (NULL (GETPROP FromNodeID ToNodeID))
(NULL (GETPROP ToNodeID FromNodeID)))
then (SETQ FromNodeID (fetch (GRAPHNODE NODEID) of FromNode))
(SETQ ToNodeID (fetch (GRAPHNODE NODEID) of ToNode))
(if LinkParams
then (replace (GRAPHNODE TONODES) of FromNode
with (for Node in (fetch (GRAPHNODE TONODES) of FromNode)
unless (EQ (CADR Node)
ToNodeID)
collect Node))
(replace (GRAPHNODE FROMNODES) of ToNode
with (DREMOVE FromNodeID (fetch (GRAPHNODE FROMNODES) of ToNode)))
else (replace (GRAPHNODE TONODES) of ToNode with (for Node
in (fetch (GRAPHNODE TONODES)
of ToNode)
unless (EQ (CADR Node)
FromNodeID)
collect Node))
(replace (GRAPHNODE FROMNODES) of FromNode
with (DREMOVE ToNodeID (fetch (GRAPHNODE FROMNODES) of FromNode))))
else (* Redisplay links between the two nodes.)
(if LinkParams
then (DISPLAYLINK FromNode ToNode
(CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph 1 LinkParams)
else (DISPLAYLINK ToNode FromNode
(CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph 1 ReverseLinkParams))))))
(NC.BrowserAddNode
(LAMBDA (Graph Window) (* rht: "27-Apr-85 18:54")
(* * Called by grapher when user creates a new node. Returns new node or nil.)
(PROG (Link (GraphID (NC.IDFromWindow Window))
GraphNodeID ID) (* Get user to select an existing card.
Not allowed to create a new one.)
(SETQ ID (NC.SelectNoteCards T (FUNCTION (LAMBDA (CardID)
(COND
((NEQ CardID GraphID)
T)
(T (NC.PrintMsg Window T
"The browser can't link to itself."
(CHARACTER 13)
"Selection ignored."
(CHARACTER 13))
NIL))))
NC.SelectingCardMenu GraphID NIL
"Select a card or box to include in browser."))
(if (NULL ID)
then (RETURN NIL)) (* Make link from browser to new card.)
(SETQ Link (NC.MakeLink Window NC.BrowserContentsLinkLabel ID GraphID NIL NIL NIL T))
(* Check that it doesn't already exist.
If not, create a browser node.)
(COND
(Link (SETQ GraphNodeID (PACK* GraphID (SETQ ID (fetch (NOTECARDLINK DESTINATIONID)
of Link))))
(COND
((for Node in (fetch (GRAPH GRAPHNODES) of Graph) thereis (EQ GraphNodeID
(
NC.CoerceToGraphNodeID Node)))
(NC.PrintMsg Window T "Node for card '" (NC.FetchTitle ID)
"' already in graph.")
(NCP.DeleteLinks Link)
(RETURN NIL)))
(NC.MarkCardDirty GraphID)
(RETURN (NODECREATE GraphNodeID (NC.MakeLinkIcon Link)
(CURSORPOSITION NIL Window))))))))
(NC.BrowserAddLabel
(LAMBDA (Graph Window) (* rht: "25-Apr-85 22:55")
(* * This builds a label node in the default grapher style except that we force non-boxed nodes.)
(DEFAULT.ADDNODEFN Graph Window NIL)))
(NC.BrowserAddEdge
(LAMBDA (FromNode ToNode Window Graph) (* rht: "20-Aug-85 11:56")
(* * Called by grapher when user adds a new edge. Will only allow edge addition if there are currently no edges
between the two nodes.)
(LET ((GraphID (NC.IDFromWindow Window))
SourceID SourceType DestinationID StartingIDChar)
(COND
((EQ FromNode ToNode)
(NC.PrintMsg NIL T "Can't add edge from a node to itself.")
(FLASHW PROMPTWINDOW))
((OR (MEMBTONODES (fetch (GRAPHNODE NODEID) of ToNode)
(fetch (GRAPHNODE TONODES) of FromNode))
(MEMBTONODES (fetch (GRAPHNODE NODEID) of FromNode)
(fetch (GRAPHNODE TONODES) of ToNode)))
(NC.PrintMsg NIL T "There is already an edge between those two nodes.")
(FLASHW PROMPTWINDOW))
(T (NC.MarkCardDirty GraphID)
(ADD/AND/DISPLAY/LINK FromNode ToNode Window Graph)))
NIL)))
(NC.BrowserRemoveNode
(LAMBDA (Graph Window DeleteCardFlg) (* rht: "20-Sep-85 12:57")
(* * Called by grapher when user removes a node.)
(PROG ((GraphID (NC.IDFromWindow Window))
ID StartingIDChar NodeToRemoveID RootIDs NodesToRemove NumVirtuals NodeToRemove)
(SETQ NodeToRemove (NC.SelectGraphNode Window Graph (if DeleteCardFlg
then
"Choose node of card to delete."
else "Choose node to remove.")))
(SETQ StartingIDChar (ADD1 (NCHARS GraphID)))
(SETQ NodeToRemoveID (NC.CoerceToGraphNodeIDOrLabel NodeToRemove))
(SETQ ID (SUBATOM NodeToRemoveID StartingIDChar))
(* If we're supposed to be deleting a card, then check
that node represents a card and that user confirms.)
(if DeleteCardFlg
then (if (NCP.ValidID ID)
then (if (NOT (NC.YesP (NC.AskUser (CONCAT "Want to delete the " (
NC.FetchTitle ID)
" card? ")
"--"
(QUOTE Yes)
T Window NIL NIL T)))
then (FLIPNODE NodeToRemove Window)
(RETURN (NC.PrintMsg NIL T "Card & Node delete aborted.")))
else (NC.PrintMsg NIL T "No card for that node.")
(FLASHW PROMPTWINDOW)
(FLIPNODE NodeToRemove Window)
(RETURN NIL)))
(NC.MarkCardDirty GraphID)
(* We require that all virtual nodes for this node must be removed at once if this one has any link edges to or from
it.)
(SETQ NodesToRemove (for Node in (fetch (GRAPH GRAPHNODES) of Graph)
when (EQ NodeToRemoveID (NC.CoerceToGraphNodeIDOrLabel Node))
collect Node)) (* If there are no edges into or out of this node, then
just delete from graph.)
(if (AND (NOT DeleteCardFlg)
(NULL (fetch (GRAPHNODE FROMNODES) of NodeToRemove))
(NULL (fetch (GRAPHNODE TONODES) of NodeToRemove)))
then (FLIPNODE NodeToRemove Window) (* Delete the browsercontents link from the browser.)
(AND (NCP.ValidID ID)
(NC.DelBrowserContentsLink GraphID ID))
(RETURN (NC.GraphRemoveNode NodeToRemove Graph Window)))
(* If there are companion virtual nodes, ask for user
confirmation.)
(if (AND (NOT DeleteCardFlg)
(GREATERP (SETQ NumVirtuals (LENGTH NodesToRemove))
1)
(NOT (PROGN (NC.PrintMsg Window T NumVirtuals
" virtual companion nodes will be removed."
(CHARACTER 13))
(NC.YesP (NC.AskUser "Still want to remove? " "--" (QUOTE Yes)
NIL Window NIL NIL T)))))
then (FLIPNODE NodeToRemove Window)
(RETURN NIL)) (* Delete the browsercontents link from the browser.)
(AND (NCP.ValidID ID)
(NC.DelBrowserContentsLink GraphID ID)) (* Delete all record of links to and from this node on
prop lists.)
(SETPROPLIST NodeToRemoveID NIL)
(for Node in (fetch (GRAPH GRAPHNODES) of Graph) do (REMPROP (NC.CoerceToGraphNodeID Node)
NodeToRemoveID))
(* Remove from the root ids list.)
(SETQ RootIDs (MKLIST (CAR (NC.GetProp GraphID (QUOTE BrowserRoots)))))
(if (FMEMB ID RootIDs)
then (NC.PutProp GraphID (QUOTE BrowserRoots)
(LIST (DREMOVE ID RootIDs))))
(* Get rid of node and its virtual buddies from graph.)
(FLIPNODE NodeToRemove Window)
(for Node in NodesToRemove do (NC.GraphRemoveNode Node Graph Window))
(* Delete card if we're supposed to.)
(if DeleteCardFlg
then (NC.PrintMsg NIL T "Deleting " ID " ... ")
(NCP.DeleteCards ID)
(NC.PrintMsg NIL T "Done." (CHARACTER 13)))
(REDISPLAYW Window)
(NC.PrintMsg NIL T "Nodes: " (CONCATLIST (for Node in NodesToRemove
collect (PACK* (fetch (GRAPHNODE NODEID)
of Node)
(QUOTE % ))))
"removed."))))
(NC.DelBrowserContentsLink
(LAMBDA (GraphID DestID) (* rht: "22-May-85 12:57")
(* * Delete the browsercontents link connecting GraphID and DestID.)
(PROG ((Links (NCP.GetLinks GraphID DestID NC.BrowserContentsLinkLabel))
Link)
(if (CDR Links)
then (NC.ReportError "NC.DelBrowserContentsLink" (CONCAT
"Multiple browser contents links between "
GraphID " and " DestID))
(RETURN NIL))
(NC.DelFromLink (SETQ Link (CAR Links))
PSA.Database)
(NC.DelToLink Link PSA.Database)
(replace (NOTECARDLINK LINKID) of Link with -1))))
(NC.BrowserRemoveEdge
(LAMBDA (FromNode ToNode Window Graph) (* rht: "29-Apr-85 00:23")
(* * Called by grapher when user deletes an edge. This code is just like NC.BrowserDeleteLink except we don't affect
any notecards links.)
(PROG ((GraphID (NC.IDFromWindow Window))
FromNodeID ToNodeID LabelPairs MenuItems LinkParams ReverseLinkParams LabelPairToRemove)
(* If this is a link between nodes one of which is non-label, then it must be a non-link edge, so let grapher handle
it.)
(if (NOT (AND (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of FromNode))
(NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of ToNode))))
then (RETURN (DELETE/AND/DISPLAY/LINK FromNode ToNode Window Graph)))
(SETQ FromNodeID (NC.CoerceToGraphNodeID FromNode))
(SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode))
(SETQ LabelPairs (GETPROP FromNodeID ToNodeID))
(if (AND (NULL LabelPairs)
(NULL (GETPROP ToNodeID FromNodeID)))
then (* No link edges so let grapher try to delete a
non-link edge between these nodes if any.)
(RETURN (DELETE/AND/DISPLAY/LINK FromNode ToNode Window Graph)))
(NC.MarkCardDirty GraphID) (* Let user choose among all edges from FromNode to
ToNode.)
(SETQ MenuItems (for LabelPair in LabelPairs collect (LIST (CAR LabelPair)
(BQUOTE (QUOTE , LabelPair)))))
(SETQ LabelPairToRemove (if (CDR MenuItems)
then (MENU (create MENU
ITEMS ← MenuItems
TITLE ← "Which edge to delete?"))
else (EVAL (CADAR MenuItems))))
(if (NOT LabelPairToRemove)
then (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "No edge to delete.")
(RETURN NIL))
(SETQ LinkParams (LINKPARAMETERS FromNode ToNode))
(SETQ ReverseLinkParams (LINKPARAMETERS ToNode FromNode))
(* Undisplay the links between the nodes.)
(NC.DisplayGraphLinksBetween FromNode ToNode Window Graph)
(* Remove the first occurrence of the label pair from
the proper prop list.)
(PUTPROP FromNodeID ToNodeID (DFIRSTREMOVE LabelPairToRemove LabelPairs))
(* If that was the last edge between the two nodes,
then remove the edge from the graph.)
(if (AND (NULL (GETPROP FromNodeID ToNodeID))
(NULL (GETPROP ToNodeID FromNodeID)))
then (SETQ FromNodeID (fetch (GRAPHNODE NODEID) of FromNode))
(SETQ ToNodeID (fetch (GRAPHNODE NODEID) of ToNode))
(if LinkParams
then (replace (GRAPHNODE TONODES) of FromNode
with (for Node in (fetch (GRAPHNODE TONODES) of FromNode)
unless (EQ (CADR Node)
ToNodeID)
collect Node))
(replace (GRAPHNODE FROMNODES) of ToNode
with (DFIRSTREMOVE FromNodeID (fetch (GRAPHNODE FROMNODES)
of ToNode)))
else (replace (GRAPHNODE TONODES) of ToNode with (for Node
in (fetch (GRAPHNODE TONODES)
of ToNode)
unless (EQ (CADR Node)
FromNodeID)
collect Node))
(replace (GRAPHNODE FROMNODES) of FromNode
with (DFIRSTREMOVE ToNodeID (fetch (GRAPHNODE FROMNODES) of FromNode))))
else (* Redisplay links between the two nodes.)
(NC.DisplayGraphLinksBetween FromNode ToNode Window Graph)))))
(NC.GraphRemoveNode
(LAMBDA (Node Graph Window) (* rht: "29-Apr-85 00:39")
(* * Remove this node from the graph. This code taken from Grapher's EDITDELETENODE)
(for ToNode in (TOLINKS Node) bind OtherNode
do (* Undisplay links.)
(NC.DisplayGraphLinksBetween Node (SETQ OtherNode (GETNODEFROMID
(if (EQ (CAR ToNode)
LINKPARAMS)
then (CADR ToNode)
else ToNode)
(fetch (GRAPH GRAPHNODES) of Graph)))
Window Graph)
(GRAPHDELETELINK Node OtherNode Graph Window))
(for FromNode in (FROMLINKS Node) bind OtherNode
do (* Undisplay links.)
(NC.DisplayGraphLinksBetween (SETQ OtherNode (GETNODEFROMID (if (EQ (CAR FromNode)
LINKPARAMS)
then (CADR FromNode)
else FromNode)
(fetch (GRAPH GRAPHNODES)
of Graph)))
Node Window Graph)
(GRAPHDELETELINK OtherNode Node Graph Window))
(DISPLAYNODE Node (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph)
(GRAPHDELETENODE Node Graph Window)
(NC.PrintMsg NIL T "Node " (fetch (GRAPHNODE NODELABEL) of Node)
" removed.")
Node))
)
(* * Grapher hacks for browser)
(DEFINEQ
(NC.MakeLinksLegend
[LAMBDA (Graph Win DropVirtualNodesFlg) (* Dan.Jordan " 2-Dec-85 17:20")
(* * 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])
(NC.MakeLinksLegendMenu
(LAMBDA (Win LabelPairs) (* rht: "20-Sep-85 13:35")
(* * Build a links legend menu and attach to Win)
(* * rht 1/10/85: Before starting, kill any old links legend menus for Win.)
(PROG (Menu MenuWin PromptWin MainWinPromptInfo)
(for AttachedWin in (ATTACHEDWINDOWS Win) when (WINDOWPROP AttachedWin (QUOTE
LINKSLEGENDWINP))
do (CLOSEW AttachedWin))
(SETQ Menu (COND
(NC.LinkDashingInBrowser (create MENU
ITEMS ←(for Pair in LabelPairs
join (LIST (CAR Pair)
(LIST (QUOTE " "))))
TITLE ←(QUOTE Links)
MENUCOLUMNS ← 2))
(T (create MENU
ITEMS ←(for Pair in LabelPairs collect (CAR Pair))
TITLE ←(QUOTE Links)
MENUCOLUMNS ← 1)))) (* Detach the prompt window for a second, saving the
prompt window info from the main win's props.)
(if (SETQ PromptWin (GETPROMPTWINDOW Win NIL NIL T))
then (SETQ MainWinPromptInfo (WINDOWPROP Win (QUOTE PROMPTWINDOW)))
(DETACHWINDOW PromptWin)) (* Stick the links legend window at upper right
corner.)
(ATTACHWINDOW (SETQ MenuWin (ADDMENU Menu NIL NC.OffScreenPosition))
Win
(QUOTE RIGHT)
(QUOTE TOP)
(QUOTE LOCALCLOSE))
(WINDOWADDPROP MenuWin (QUOTE REPAINTFN)
(QUOTE NC.LinksLegendRepaintFn))
(WINDOWADDPROP MenuWin (QUOTE RESHAPEFN)
(QUOTE NC.LinksLegendReshapeFn))
(WINDOWADDPROP MenuWin (QUOTE LINKSLEGENDWINP)
T)
(WINDOWPROP Win (QUOTE NCLABELPAIRS)
LabelPairs) (* Put back the prompt window if it exists.)
(if PromptWin
then (ATTACHWINDOW PromptWin Win (QUOTE TOP)
(QUOTE LEFT)
(QUOTE HERE))
(WINDOWPROP Win (QUOTE PROMPTWINDOW)
MainWinPromptInfo))
(MOVEW Win (MAKEWITHINREGION (WINDOWREGION Win)
WHOLESCREEN)) (* For some reason, the above MOVEW tends to leave the
prompt window open.)
(if (OPENWP PromptWin)
then (CLOSEW PromptWin))
(if NC.LinkDashingInBrowser
then (NC.LinksLegendRepaintFn MenuWin NIL))
NIL)))
(NC.LinksLegendRepaintFn
(LAMBDA (Win Region) (* rht: "23-Sep-85 15:47")
(* * Repaint the right-hand column dashing in the browser's links legend menu.)
(* * rht 7/15/85: Added bail out for case of screwy 1.1 files.)
(PROG ((Menu (CAR (WINDOWPROP Win (QUOTE MENU))))
Items
(LabelPairs (WINDOWPROP (MAINWINDOW Win)
(QUOTE NCLABELPAIRS))))
(SETQ Items (fetch (MENU ITEMS) of Menu)) (* This little bail out is for case of 1.1 files where
label pairs are screwed up and so are menu items.)
(if (NULL (CAR Items))
then (RETURN NIL))
(for Item in (CDR Items) by (CDDR Item) as LabelPair in LabelPairs bind ItemRegion
do (SETQ ItemRegion (MENUITEMREGION Item Menu))
(DRAWLINE (IPLUS 4 (fetch (REGION LEFT) of ItemRegion))
(IPLUS (QUOTIENT (fetch (REGION HEIGHT) of ItemRegion)
2)
(fetch (REGION BOTTOM) of ItemRegion))
(IDIFFERENCE (IPLUS (fetch (REGION WIDTH) of ItemRegion)
(fetch (REGION LEFT) of ItemRegion))
4)
(IPLUS (QUOTIENT (fetch (REGION HEIGHT) of ItemRegion)
2)
(fetch (REGION BOTTOM) of ItemRegion))
1 NIL Win NIL (CAR (FNTH NC.DashingStyles (CDR LabelPair))))))))
(NC.BrowserDrawLinkFn
(LAMBDA (X1 Y1 X2 Y2 Width Operation Win Color Dashing ParamList)
(* rht: "27-Aug-85 03:01")
(* * This is called by grapher to draw a link. If there's no NODEID param then just one link to draw.
Check the dashing global var and draw it. Otherwise, there are multiple links so we need to draw a flower
arrangement. Note the ugliness that NC.LinkDashingInBrowser being off means that flowers won't get drawn.
If the arrow heads global var is on, then draw arrow head at one end.)
(BLOCK)
(PROG (NodeID DestNodeID MidpointFlg ClippingRegion)
(COND
(NC.LinkDashingInBrowser (COND
((SETQ NodeID (LISTGET ParamList (QUOTE NODEID)))
(* Multiple links. Have to draw a flower of spline
curves for the links.)
(RETURN (NC.DrawFlowerLinks NodeID (SETQ DestNodeID
(LISTGET ParamList
(QUOTE DESTNODEID)))
X1 Y1 X2 Y2 Width Operation Win
Color)))))
(T (SETQ Dashing NIL)))
(COND
((NOT (REGIONSINTERSECTP (CREATEREGION (MIN X1 X2)
(MIN Y1 Y2)
(ABS (DIFFERENCE X1 X2))
(ABS (DIFFERENCE Y1 Y2)))
(CREATEREGION (DIFFERENCE (fetch (REGION LEFT)
of (SETQ ClippingRegion
(DSPCLIPPINGREGION NIL Win)))
NC.ArrowHeadLength)
(DIFFERENCE (fetch (REGION BOTTOM) of
ClippingRegion)
NC.ArrowHeadLength)
(PLUS (fetch (REGION WIDTH) of ClippingRegion)
NC.ArrowHeadLength NC.ArrowHeadLength)
(PLUS (fetch (REGION HEIGHT) of ClippingRegion)
NC.ArrowHeadLength NC.ArrowHeadLength))))
(RETURN)))
(DRAWLINE X1 Y1 X2 Y2 Width Operation Win Color Dashing)
(COND
((NEQ NC.ArrowHeadsInBrowser (QUOTE None))
(SETQ MidpointFlg (EQ NC.ArrowHeadsInBrowser (QUOTE AtMidpoint)))
(COND
((LISTGET ParamList (QUOTE BACKWARDFLG))
(NC.DrawArrowHead X2 Y2 X1 Y1 Width Operation Win Color MidpointFlg))
(T (NC.DrawArrowHead X1 Y1 X2 Y2 Width Operation Win Color MidpointFlg))))))))
(NC.DrawFlowerLinks
(LAMBDA (NodeID1 NodeID2 X1 Y1 X2 Y2 Width Operation Stream Color)
(* rht: "10-Mar-85 22:39")
(* * Expects to find a list of pairs on Node1's ID's proplist under the property with name Node2's ID
(or vice versa) These are pairs of label and dashing number. For each one, draw a spline with one knot using given
dashing number. The more we draw, the farther each gets from the center line. The very first is along the center
line. Subsequent splines alternate on either side of the center line.)
(* * rht 3/9/85: Now draws first the forward links and then the backward links.)
(PROG ((Count -1))
(for Pair in (GETPROP NodeID1 NodeID2) do (NC.DrawFlowerLink X1 Y1 X2 Y2
(LIST (QUOTE ROUND)
Width Color)
(CAR (FNTH NC.DashingStyles
(CDR Pair)))
(SETQ Count (ADD1 Count))
Stream Width Operation Color))
(for Pair in (GETPROP NodeID2 NodeID1) do (NC.DrawFlowerLink X2 Y2 X1 Y1
(LIST (QUOTE ROUND)
Width Color)
(CAR (FNTH NC.DashingStyles
(CDR Pair)))
(SETQ Count (ADD1 Count))
Stream Width Operation Color)))
))
(NC.DrawFlowerLink
(LAMBDA (X1 Y1 X2 Y2 Brush Dashing Num Win Width Operation Color)
(* fgh: " 1-Oct-85 15:28")
(* * Draw one link between given points according to given Dashing. If Num is 0, then draw straight line.
Otherwise, draw curves above for odd Num and below for even Num, getting wider for bigger values of Num.)
(PROG ((MidpointX (QUOTIENT (IPLUS X1 X2)
2))
(MidpointY (QUOTIENT (IPLUS Y1 Y2)
2))
XOffset YOffset Scale)
(COND
((ZEROP Num)
(DRAWLINE X1 Y1 X2 Y2 Width Operation Win Color Dashing)
(AND (NEQ NC.ArrowHeadsInBrowser (QUOTE None))
(NC.DrawArrowHead X1 Y1 X2 Y2 Width Operation Win Color T)))
(T (* Check slope of line. If < 45 degrees, then make
spline nodes be vertically removed, otherwise
horizontally removed.)
(COND
((GREATERP (ABS (DIFFERENCE X2 X1))
(ABS (DIFFERENCE Y2 Y1)))
(SETQ YOffset (COND
((ODDP Num)
(TIMES NC.GraphFlowerLinkSeparation (QUOTIENT (ADD1 Num)
2)))
(T (MINUS (TIMES NC.GraphFlowerLinkSeparation (QUOTIENT (ADD1 Num)
2))))))
(SETQ XOffset 0))
(T (SETQ XOffset (COND
((ODDP Num)
(TIMES NC.GraphFlowerLinkSeparation (QUOTIENT (ADD1 Num)
2)))
(T (MINUS (TIMES NC.GraphFlowerLinkSeparation (QUOTIENT (ADD1 Num)
2))))))
(SETQ YOffset 0)))
(SETQ Scale (DSPSCALE NIL Win))
(SETQ XOffset (FIXR (TIMES XOffset Scale)))
(SETQ YOffset (FIXR (TIMES YOffset Scale)))
(DRAWLINE X1 Y1 (PLUS MidpointX XOffset)
(PLUS MidpointY YOffset)
Width Operation Win NIL Dashing)
(DRAWLINE (PLUS MidpointX XOffset)
(PLUS MidpointY YOffset)
X2 Y2 Width Operation Win NIL Dashing)
(AND (NEQ NC.ArrowHeadsInBrowser (QUOTE None))
(NC.DrawArrowHead X1 Y1 (PLUS MidpointX XOffset)
(PLUS MidpointY YOffset)
Width Operation Win Color NIL)))))))
(NC.LinksLegendReshapeFn
(LAMBDA (Window OldImage OldRegion) (* rht: " 7-Dec-84 12:15")
(* * Called when main window is reshaped. Just redisplays the links legend.)
(REDISPLAYW Window)))
(NC.DrawArrowHead
(LAMBDA (X1 Y1 X2 Y2 Width Operation Stream Color MidpointFlg XOffset YOffset)
(* rht: " 2-Oct-85 17:01")
(* * Draw an arrowhead on the end of the line segment from X1,Y1 to X2,Y2.)
(* * rht 8/12/85: Added check for whether point is inside clipping region before computing arrow head.)
(PROG ((XDiff (FLOAT (IDIFFERENCE X1 X2)))
(YDiff (FLOAT (IDIFFERENCE Y1 Y2)))
LineLength A11 A12 A21 A22 Tmp1 Tmp2 ClippingRegion (WindowFlg (WINDOWP Stream))
(Scale (DSPSCALE NIL Stream))
ArrowHeadXVal ArrowHeadYVal ArrowHeadLength)
(OR XOffset (SETQ XOffset 0))
(OR YOffset (SETQ YOffset 0))
(SETQ ArrowHeadXVal (FIXR (TIMES NC.ArrowHeadXVal Scale)))
(SETQ ArrowHeadYVal (FIXR (TIMES NC.ArrowHeadYVal Scale)))
(SETQ ArrowHeadLength (FIXR (TIMES NC.ArrowHeadLength Scale)))
(COND
(MidpointFlg (SETQ XOffset (PLUS XOffset (DIFFERENCE (QUOTIENT (IPLUS X1 X2)
2)
X2)))
(SETQ YOffset (PLUS YOffset (DIFFERENCE (QUOTIENT (IPLUS Y1 Y2)
2)
Y2)))))
(* If the point at which the arrow head will be drawn
isn't inside the clipping region together with a
border, then bail out.)
(SETQ ClippingRegion (DSPCLIPPINGREGION NIL Stream))
(COND
((AND ClippingRegion (NOT (INSIDEP (CREATEREGION (DIFFERENCE (fetch (REGION LEFT)
of ClippingRegion)
ArrowHeadLength)
(DIFFERENCE (fetch (REGION BOTTOM)
of ClippingRegion)
ArrowHeadLength)
(PLUS (fetch (REGION WIDTH)
of ClippingRegion)
ArrowHeadLength ArrowHeadLength)
(PLUS (fetch (REGION HEIGHT)
of ClippingRegion)
ArrowHeadLength ArrowHeadLength))
(PLUS X2 XOffset)
(PLUS Y2 YOffset))))
(RETURN)))
(SETQ LineLength (SQRT (PLUS (TIMES XDiff XDiff)
(TIMES YDiff YDiff))))
(SETQ A11 (QUOTIENT (FLOAT XDiff)
LineLength))
(SETQ A21 (QUOTIENT (FLOAT YDiff)
LineLength))
(SETQ A12 (MINUS A21))
(SETQ A22 A11)
(SETQ Tmp1 (TIMES A11 ArrowHeadXVal))
(SETQ Tmp2 (TIMES A21 ArrowHeadXVal))
(SETQ X2 (PLUS X2 XOffset))
(SETQ Y2 (PLUS Y2 YOffset))
(DRAWLINE X2 Y2 (PLUS X2 Tmp1 (TIMES A12 ArrowHeadYVal))
(PLUS Y2 Tmp2 (TIMES A22 ArrowHeadYVal))
Width Operation Stream Color)
(DRAWLINE X2 Y2 (PLUS X2 Tmp1 (TIMES A12 (MINUS ArrowHeadYVal)))
(PLUS Y2 Tmp2 (TIMES A22 (MINUS ArrowHeadYVal)))
Width Operation Stream Color))))
)
(* * Miscellaneous)
(DEFINEQ
(NC.GraphLinkIconUpdateCheck
(LAMBDA (GraphID Window Graph UpdateIfNullCacheFlg) (* rht: "11-Sep-85 11:37")
(* * Check current values of link icon default display global params against values cached on Window.
If changed, then fix link icon sizes in graph. Return non-nil if we had to fix graph nodes.)
(LET ((OldGlobalParams (NC.GetProp GraphID (QUOTE CachedGlobalParams)))
(CurGlobalParams (LIST NC.LinkIconShowTitleFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconAttachBitmapFlg))
DidWorkFlg)
(if (NOT (EQUAL OldGlobalParams CurGlobalParams))
then (if (OR OldGlobalParams UpdateIfNullCacheFlg)
then (for Node in (fetch (GRAPH GRAPHNODES) of Graph) do (
NC.GraphNodeLinkIconUpdate Window Node))
(SETQ DidWorkFlg T))
(NC.PutProp GraphID (QUOTE CachedGlobalParams)
CurGlobalParams))
DidWorkFlg)))
(NC.BrowserRepaintFn
(LAMBDA (Window Region) (* rht: "11-Sep-85 11:43")
(* * Check if cached global params have changed. If so, fix graph nodes before redisplaying.)
(NC.GraphLinkIconUpdateCheck (NC.IDFromWindow Window)
Window
(WINDOWPROP Window (QUOTE GRAPH))
NIL)))
(NC.CoerceToGraphNodeID
(LAMBDA (NodeOrNodeID) (* rht: "12-Apr-85 16:05")
(* * Extract the graph node ID from a graph node, a virtual node, or a Link params thingie.)
(COND
((EQ (CAR NodeOrNodeID)
LINKPARAMS)
(SETQ NodeOrNodeID (CADR NodeOrNodeID))))
(SETQ NodeOrNodeID (OR (CAAR NodeOrNodeID)
(CAR NodeOrNodeID)
NodeOrNodeID))
(AND (NC.IDFromGraphNodeID NodeOrNodeID)
NodeOrNodeID)))
(NC.CoerceToGraphNodeIDOrLabel
(LAMBDA (GraphNode) (* rht: "20-Sep-85 12:54")
(* * This is like NC.CoerceToGraphNodeID except that it returns the label if the node is a label node.
Coerces virtual label node ids to labels.)
(if (NC.CoerceToGraphNodeID GraphNode)
else (LET ((NodeID (fetch (GRAPHNODE NODEID) of GraphNode)))
(if (LISTP NodeID)
then (CAR NodeID)
else NodeID)))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.ArrowHeadLength NC.ArrowHeadAngle NC.ArrowHeadXVal NC.ArrowHeadYVal)
)
(RPAQQ NC.ArrowHeadLength 7)
(RPAQQ NC.ArrowHeadAngle 20)
(RPAQ NC.ArrowHeadXVal (TIMES NC.ArrowHeadLength (COS NC.ArrowHeadAngle)))
(RPAQ NC.ArrowHeadYVal (TIMES NC.ArrowHeadLength (SIN NC.ArrowHeadAngle)))
(DEFINEQ
(NC.AddBrowserCard
(LAMBDA NIL (* rht: "15-Mar-85 19:09")
(NC.AddCardType (QUOTE Browser)
(QUOTE Graph)
(QUOTE GRAPH)
(BQUOTE ((MakeCardFn , (FUNCTION NC.MakeBrowserCard))
(EditCardFn , (FUNCTION NC.BringUpBrowserCard))))
(BQUOTE ((LinkDisplayMode Title)
(DefaultHeight 350)
(DefaultWidth 500)
(CardDisplayedInMenuFlg , T))))))
)
(NC.AddBrowserCard)
(PUTPROPS NCBROWSERCARD COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (10045 18384 (NC.MakeBrowserCard 10055 . 16777) (NC.BringUpBrowserCard 16779 . 18382)) (
18385 70576 (NC.GrowLinkLattice 18395 . 25878) (NC.UpdateBrowserCard 25880 . 35004) (
NC.ReorderVirtualGraphNodes 35006 . 35664) (NC.RelayoutBrowserCard 35666 . 41433) (
NC.ConnectNodesInBrowser 41435 . 47455) (NC.UnconnectNodesInBrowser 47457 . 49969) (
NC.ExpandBrowserNode 49971 . 58114) (NC.NotBrowserHookP 58116 . 58374) (NC.AskBrowserSpecs 58376 .
62460) (NC.ChangeBrowserSpecs 62462 . 63765) (NC.AskSpecialBrowserSpecs 63767 . 64887) (
NC.IDFromGraphNodeID 64889 . 65191) (NC.BrowserFlipRoots 65193 . 65586) (NC.SelectGraphNode 65588 .
66260) (NC.GraphEdgesInconsistentP 66262 . 67469) (NC.DisplayGraphLinksBetween 67471 . 68215) (
NC.RebuildFromNodesInGraph 68217 . 69044) (NC.RemoveDuplicateNodesFromGraph 69046 . 70574)) (70733
110891 (NC.GetGraphEditMenu 70743 . 72463) (NC.BrowserRightButtonFn 72465 . 72995) (
NC.GraphEditMenuWhenSelectedFn 72997 . 73361) (NC.BrowserCreateCardFn 73363 . 73818) (
NC.BrowserAddLabelFn 73820 . 74269) (NC.BrowserAddNodeFn 74271 . 74740) (NC.BrowserCreateLinkFn 74742
. 75086) (NC.BrowserCreateGlobalLinkFn 75088 . 75453) (NC.BrowserAddLink 75455 . 81805) (
NC.BrowserAddGlobalLink 81807 . 82084) (NC.BrowserAddEdgeFn 82086 . 82418) (NC.BrowserDeleteCardFn
82420 . 82813) (NC.BrowserRemoveNodeFn 82815 . 83207) (NC.BrowserDeleteLinkFn 83209 . 83558) (
NC.BrowserRemoveEdgeFn 83560 . 83908) (NC.BrowserShrinkLabelFn 83910 . 84142) (NC.BrowserGrowLabelFn
84144 . 84375) (NC.BrowserMoveNodeFn 84377 . 84625) (NC.BrowserFixGraphEditMenuFn 84627 . 85561) (
NC.BrowserCreateCard 85563 . 86623) (NC.BrowserCreateLink 86625 . 88272) (NC.BrowserDeleteCard 88274
. 90206) (NC.BrowserDeleteLink 90208 . 96552) (NC.BrowserAddNode 96554 . 98454) (NC.BrowserAddLabel
98456 . 98733) (NC.BrowserAddEdge 98735 . 99724) (NC.BrowserRemoveNode 99726 . 104492) (
NC.DelBrowserContentsLink 104494 . 105228) (NC.BrowserRemoveEdge 105230 . 109392) (NC.GraphRemoveNode
109394 . 110889)) (110930 133335 (NC.MakeLinksLegend 110940 . 119526) (NC.MakeLinksLegendMenu 119528
. 122116) (NC.LinksLegendRepaintFn 122118 . 123640) (NC.BrowserDrawLinkFn 123642 . 126100) (
NC.DrawFlowerLinks 126102 . 127557) (NC.DrawFlowerLink 127559 . 129907) (NC.LinksLegendReshapeFn
129909 . 130153) (NC.DrawArrowHead 130155 . 133333)) (133362 135761 (NC.GraphLinkIconUpdateCheck
133372 . 134344) (NC.BrowserRepaintFn 134346 . 134710) (NC.CoerceToGraphNodeID 134712 . 135240) (
NC.CoerceToGraphNodeIDOrLabel 135242 . 135759)) (136111 136599 (NC.AddBrowserCard 136121 . 136597))))
)
STOP