(FILECREATED "23-May-85 16:36:23" {PHYLUM}<NOTECARDS>RELEASE1.2>NCBROWSERCARD.;49 123479 changes to: (FNS NC.UpdateBrowserCard NC.ExpandBrowserNode NC.MakeBrowserCard NC.BrowserCreateCard) previous date: "22-May-85 16:23:46" {PHYLUM}<NOTECARDS>RELEASE1.2>NCBROWSERCARD.;47) (* Copyright (c) 1985 by Xerox Corporation. All rights reserved.) (PRETTYCOMPRINT NCBROWSERCARDCOMS) (RPAQQ NCBROWSERCARDCOMS ((E (SETQ NC.SystemDate (DATE)) (UNMARKASCHANGED (QUOTE NC.SystemDate) (QUOTE VARS))) (VARS NC.SystemDate) (P (UNMARKASCHANGED (QUOTE NC.SystemDate) (QUOTE VARS))) (* * 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) (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.") (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 EDITMOVENODE "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.RelayoutBrowserCard NC.ConnectNodesInBrowser NC.UnconnectNodesInBrowser NC.ExpandBrowserNode NC.NotBrowserHookP NC.AskBrowserSpecs NC.ChangeBrowserSpecs NC.AskSpecialBrowserSpecs NC.IDFromGraphNodeID NC.BrowserFlipRoots NC.CoerceToGraphNodeID NC.SelectGraphNode NC.GraphEdgesInconsistentP NC.DisplayGraphLinksBetween NC.RebuildFromNodesInGraph) (RECORDS SPECIALBROWSERSPECS) (* * Graph editor menu functions.) (FNS NC.GetGraphEditMenu NC.BrowserRightButtonFn NC.GraphEditMenuWhenSelectedFn NC.BrowserCreateCardFn NC.BrowserAddLabelFn NC.BrowserAddNodeFn NC.BrowserCreateLinkFn NC.BrowserAddLink NC.BrowserAddEdgeFn NC.BrowserDeleteCardFn NC.BrowserRemoveNodeFn NC.BrowserDeleteLinkFn NC.BrowserRemoveEdgeFn NC.BrowserShrinkLabelFn NC.BrowserGrowLabelFn 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) (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)))) (RPAQQ NC.SystemDate "23-May-85 16:36:28") (UNMARKASCHANGED (QUOTE NC.SystemDate) (QUOTE VARS)) (* * 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) ) (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.") (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 EDITMOVENODE "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: "23-May-85 13:16") (* 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)))) (SETQ RootIDs (OR RootIDs (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 (AND ParamList (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 NIL (CHARACTER 13) "Computing browser graph. Please wait. ...")) (* Compute lattice incrementally for each root in the forest.) (SETQ RootNodes (for RootID in RootIDs collect (SETQ Lattice (NC.GrowLinkLattice RootID Lattice ListOfLinkLabels ID PSA.Database Depth)) (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 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))) (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))) (replace (GRAPH GRAPH.ADDNODEFN) of Graph with (FUNCTION NC.GraphAddNodeFn)) (replace (GRAPH GRAPH.MOVENODEFN) of Graph with (FUNCTION NC.GraphMoveNodeFn)) (replace (GRAPH GRAPH.FONTCHANGEFN) of Graph with (FUNCTION NC.GraphFontChangeFn)) (AND Graph (SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn) (FUNCTION NC.GraphCardMiddleButtonFn) NIL T)) (* Disable the old-style right button grapher editor menu.) (WINDOWPROP Window (QUOTE RIGHTBUTTONFN) (FUNCTION NC.BrowserRightButtonFn)) (NC.SetupTitleBarMenu Window ID (QUOTE Browser)) (NC.ClearMsg Window T) (RETURN Window)))) (NC.BringUpBrowserCard (LAMBDA (ID Substance Region/Position) (* rht: "12-Apr-85 19:02") (* * 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.) (PROG (Window) (SETQ 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)) (RETURN Window)))) ) (DEFINEQ (NC.GrowLinkLattice (LAMBDA (RootIDOrNode CurrentGraph ListOfLinkLabels GraphID DatabaseStream RemainingSearchDepth) (* rht: "12-Apr-85 14:16") (* 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.) (PROG (RootID ToLinks FromLinks DestinationIDs GraphRootID (StartingIDChar (ADD1 (NCHARS GraphID)) ) ExpandingFlg) (SETQ ExpandingFlg (NOT (NC.IDP RootIDOrNode))) (if ExpandingFlg then (SETQ GraphRootID (fetch (GRAPHNODE NODEID) of RootIDOrNode)) (OR (SETQ RootID (NC.IDFromGraphNodeID GraphRootID)) (RETURN CurrentGraph)) (* Remove any proplist record of links to this node ID, since we need to start off fresh.) (for GraphNode in CurrentGraph bind NodeID do (SETQ NodeID (fetch (GRAPHNODE NODEID) of GraphNode)) (REMPROP (OR (CAR NodeID) NodeID) GraphRootID)) else (SETQ RootID RootIDOrNode) (SETQ GraphRootID (PACK* GraphID RootID))) (COND ((AND (NOT ExpandingFlg) (FASSOC GraphRootID CurrentGraph)) (RETURN CurrentGraph)) ((NC.ActiveCardP RootID) (SETQ ToLinks (NC.FetchToLinks RootID)) (SETQ FromLinks (NC.FetchFromLinks RootID))) (T (WITH.MONITOR (NC.FetchMonitor DatabaseStream "NC.GrowLinkLattice") (NC.GetLinks RootID DatabaseStream) (SETQ ToLinks (NC.FetchToLinks RootID)) (SETQ FromLinks (NC.FetchFromLinks RootID))))) (* Crush the ID's proplist.) (if (NOT (GETPROP GraphRootID (QUOTE TouchedFlg))) then (SETPROPLIST GraphRootID NIL) (PUTPROP GraphRootID (QUOTE TouchedFlg) T)) (if (IGREATERP RemainingSearchDepth 0) then (SETQ DestinationIDs (NCONC (for Link in ToLinks bind DestID InGraphFlg DestTouchedFlg ThisWayLinkFlg OtherWayLinkFlg eachtime (SETQ DestID (PACK* GraphID (fetch (NOTECARDLINK DESTINATIONID) of Link))) (SETQ InGraphFlg (FASSOC DestID CurrentGraph)) (SETQ DestTouchedFlg (GETPROP DestID (QUOTE TouchedFlg))) (SETQ ThisWayLinkFlg (NC.LinkLabelP Link ListOfLinkLabels)) (SETQ OtherWayLinkFlg (NC.ReverseLinkLabelP Link ListOfLinkLabels)) (if (OR ThisWayLinkFlg (AND InGraphFlg (NOT DestTouchedFlg) OtherWayLinkFlg)) then (ADDPROP GraphRootID DestID (fetch (NOTECARDLINK LINKLABEL) of Link) T)) when ThisWayLinkFlg unless (AND InGraphFlg DestTouchedFlg OtherWayLinkFlg) collect DestID) (for Link in FromLinks bind DestID InGraphFlg DestTouchedFlg ThisWayLinkFlg OtherWayLinkFlg eachtime (SETQ DestID (PACK* GraphID (fetch (NOTECARDLINK SOURCEID) of Link))) (SETQ InGraphFlg (FASSOC DestID CurrentGraph)) (SETQ DestTouchedFlg (GETPROP DestID (QUOTE TouchedFlg))) (SETQ ThisWayLinkFlg (NC.ReverseLinkLabelP Link ListOfLinkLabels)) (SETQ OtherWayLinkFlg (NC.LinkLabelP Link ListOfLinkLabels)) (if (OR ThisWayLinkFlg (AND InGraphFlg (NOT DestTouchedFlg) OtherWayLinkFlg)) then (if (AND (NOT DestTouchedFlg) (NOT InGraphFlg)) then (SETPROPLIST DestID NIL) (PUTPROP DestID (QUOTE TouchedFlg) T)) (ADDPROP DestID GraphRootID (fetch (NOTECARDLINK LINKLABEL) of Link) T)) when ThisWayLinkFlg unless (AND InGraphFlg DestTouchedFlg OtherWayLinkFlg) collect DestID))) (SETQ DestinationIDs (INTERSECTION DestinationIDs DestinationIDs))) (* Create new node and add to graph unless we're expanding below an existing node.) (if ExpandingFlg then (replace (GRAPHNODE TONODES) of RootIDOrNode with DestinationIDs) else (SETQ CurrentGraph (NCONC CurrentGraph (LIST (create GRAPHNODE NODEID ← GraphRootID TONODES ← DestinationIDs NODELABEL ← RootID))))) (for DestinationID in DestinationIDs when (NOT (FASSOC DestinationID CurrentGraph)) do (NC.GrowLinkLattice (SUBATOM DestinationID StartingIDChar) CurrentGraph ListOfLinkLabels GraphID DatabaseStream (SUB1 RemainingSearchDepth))) (RETURN CurrentGraph)))) (NC.UpdateBrowserCard (LAMBDA (Window OnlyLayoutFlg) (* rht: "23-May-85 16:34") (* * 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 OldToNodePairs Graph GraphNodes NodeLabel OldNode Link PropList BrowserSpecs BrowserFormat DropVirtualNodesFlg Depth SpecialBrowserSpecs LabelPairs SavedAddNodeFn SavedDeleteNodeFn SavedAddLinkFn SavedDeleteLinkFn SavedMoveNodeFn SavedFontChangeFn OldLabelNodes OldRootIDs) (* Get rid of all attached windows except the graph editor menu if any.) (if (NOT OnlyLayoutFlg) then (for Win in (ATTACHEDWINDOWS Window) unless (WINDOWPROP Win (QUOTE GRAPHEDITMENU)) 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))) )) (if (NOT OnlyLayoutFlg) then (if (OR (NULL RootIDs) (NC.YesP (NC.AskUser "Want to respecify roots? " "--" "No" T Window 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. ...")) (if OnlyLayoutFlg then (* If there aren't any nodes in graph, then get out pronto.) (if (NULL GraphNodes) then (NC.PrintMsg Window T "No nodes to layout.") (DISMISS 1000) (NC.ClearMsg Window T) (RETURN 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 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 SavedAddNodeFn (fetch (GRAPH GRAPH.ADDNODEFN) of Graph)) (SETQ SavedDeleteNodeFn (fetch (GRAPH GRAPH.DELETENODEFN) of Graph)) (SETQ SavedAddLinkFn (fetch (GRAPH GRAPH.ADDLINKFN) of Graph)) (SETQ SavedDeleteLinkFn (fetch (GRAPH GRAPH.DELETELINKFN) of Graph)) (SETQ SavedMoveNodeFn (fetch (GRAPH GRAPH.MOVENODEFN) of Graph)) (SETQ SavedFontChangeFn (fetch (GRAPH GRAPH.FONTCHANGEFN) of Graph)) (* Compute lattice incrementally for each root in the forest.) (SETQ RootNodes (for RootID in RootIDs collect (if (NOT OnlyLayoutFlg) then (SETQ Lattice (NC.GrowLinkLattice RootID Lattice LinkLabels ID PSA.Database Depth))) (PACK* ID RootID))) (if OnlyLayoutFlg then (SETQ Lattice GraphNodes)) (NC.SetPropListDirtyFlg ID T) (if (NOT OnlyLayoutFlg) then (* Remove all links that are in the old browser graph but not in the new one) (for Node in GraphNodes bind NodeID when (PROGN (SETQ NodeID (fetch (GRAPHNODE NODEID) of Node)) (NOT (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 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))) (* 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 do (replace (GRAPHNODE FROMNODES) of OldLabelNode with (for FromNodeID in (fetch (GRAPHNODE FROMNODES) of OldLabelNode) bind FromNode 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 when (SETQ ToNode (FASSOC ToNodeID Lattice)) collect (* If the To node isn't a label node, then add to its FromNode list.) (if (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of ToNode)) then (replace (GRAPHNODE FROMNODES) of ToNode with (CONS (fetch (GRAPHNODE NODEID) of OldLabelNode) (fetch (GRAPHNODE FROMNODES) of ToNode)))) ToNodeID)))) (* Layout graph, including as roots any non-virtual nodes with no from nodes to avoid disconnected graphs.) (SETQ Graph (if (AND Lattice RootNodes) then (LAYOUTGRAPH Lattice (UNION (for Node in Lattice when (NULL (fetch (GRAPHNODE FROMNODES) of Node)) unless (LISTP (fetch (GRAPHNODE NODEID) of Node)) collect (fetch (GRAPHNODE NODEID) of Node)) 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))) (COND (OnlyLayoutFlg (* 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.) (replace (GRAPH GRAPHNODES) of Graph with (for Node in (fetch (GRAPH GRAPHNODES) of Graph) bind AssocPair 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) collect (if (EQ (CAR FromNode) LINKPARAMS) then (CADR FromNode) else FromNode))) Node))) (T (* Build links legend and fix up TONODES in the graph.) (SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg)))) (replace (GRAPH GRAPH.ADDNODEFN) of Graph with SavedAddNodeFn) (replace (GRAPH GRAPH.DELETENODEFN) of Graph with SavedDeleteNodeFn) (replace (GRAPH GRAPH.ADDLINKFN) of Graph with SavedAddLinkFn) (replace (GRAPH GRAPH.DELETELINKFN) of Graph with SavedDeleteLinkFn) (replace (GRAPH GRAPH.MOVENODEFN) of Graph with SavedMoveNodeFn) (replace (GRAPH GRAPH.FONTCHANGEFN) of Graph with SavedFontChangeFn) (SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn) (FUNCTION NC.GraphCardMiddleButtonFn) NIL T) (* Disable the old-style right button grapher editor menu.) (WINDOWPROP Window (QUOTE RIGHTBUTTONFN) (FUNCTION NC.BrowserRightButtonFn)) (NC.SetSubstance ID (WINDOWPROP Window (QUOTE GRAPH))) (NC.MarkCardDirty ID) (if (NOT OnlyLayoutFlg) then (NC.PutProp ID (QUOTE BrowserLinkLabels) (LIST LinkLabels)) (NC.PutProp ID (QUOTE BrowserRoots) (LIST RootIDs)) (NC.PutProp ID (QUOTE BrowserFormat) (LIST BrowserFormat)) (NC.PutProp ID (QUOTE BrowserDepth) Depth) (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.RelayoutBrowserCard (LAMBDA (Window) (* rht: "14-Mar-85 14:36") (* * Called from the middle button of a browser or structeditbrowser card. This lays out and displays the browser, but does not recompute the nodes.) (NC.UpdateBrowserCard Window T))) (NC.ConnectNodesInBrowser (LAMBDA (Window) (* rht: " 1-May-85 22:41") (* * 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))) )) (* 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 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 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 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 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) collect (OR (FASSOC ToNodeID OldToNodeIDs) ToNodeID)) (for ToNodeID in OldToNodeIDs 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) (* Disable the old-style right button grapher editor menu.) (WINDOWPROP Window (QUOTE RIGHTBUTTONFN) (FUNCTION NC.BrowserRightButtonFn)) (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: "12-Apr-85 19:04") (* * 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 (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) (* Disable the old-style right button grapher editor menu.) (WINDOWPROP Window (QUOTE RIGHTBUTTONFN) (FUNCTION NC.BrowserRightButtonFn)) (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: "23-May-85 16:21") (* * 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 SavedAddNodeFn SavedDeleteNodeFn SavedAddLinkFn SavedDeleteLinkFn SavedMoveNodeFn SavedFontChangeFn 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)) (SETQ SavedAddNodeFn (fetch (GRAPH GRAPH.ADDNODEFN) of Graph)) (SETQ SavedDeleteNodeFn (fetch (GRAPH GRAPH.DELETENODEFN) of Graph)) (SETQ SavedAddLinkFn (fetch (GRAPH GRAPH.ADDLINKFN) of Graph)) (SETQ SavedDeleteLinkFn (fetch (GRAPH GRAPH.DELETELINKFN) of Graph)) (SETQ SavedMoveNodeFn (fetch (GRAPH GRAPH.MOVENODEFN) of Graph)) (SETQ SavedFontChangeFn (fetch (GRAPH GRAPH.FONTCHANGEFN) of Graph)) (NC.PrintMsg Window T "Pick node to expand." (CHARACTER 13)) (* Note call to the grapher function READ/NODE to select a graph node.) (SETQ NodeToExpand (READ/NODE GraphNodes Window)) (* Can't expand a label node.) (if (NOT (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of NodeToExpand))) then (NC.PrintMsg NIL T "Sorry, can't expand a label node.") (FLASHW PROMPTWINDOW) (NC.ClearMsg Window T) (RETURN)) (SETQ Depth (MKATOM (NC.AskUser "Depth to expand: " "--" 1 T Window))) (if (NOT (AND (FIXP Depth) (GREATERP Depth 0))) then (NC.PrintMsg Window T "Depth must be an integer greater than 0.") (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) 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 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)) (* 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 collect (if (SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode)) then (* Throw away link parameterlist info.) (* Throw away link dashing info.) (PUTPROP NodeID ToNodeID (for LabelPair in (GETPROP NodeID ToNodeID) collect (OR (CAR LabelPair) LabelPair))) ToNodeID else ToNode)))) (NC.RebuildFromNodesInGraph Lattice) (SETQ Graph (LAYOUTGRAPH Lattice (APPEND (for Node in Lattice when (AND (NULL (fetch (GRAPHNODE FROMNODES) of Node)) (NOT (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of Node)))) collect (OR (NC.CoerceToGraphNodeID Node) (fetch (GRAPHNODE NODEID) of Node))) 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))) (* Build links legend and fix up TONODES in the graph.) (SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg)) (replace (GRAPH GRAPH.ADDNODEFN) of Graph with SavedAddNodeFn) (replace (GRAPH GRAPH.DELETENODEFN) of Graph with SavedDeleteNodeFn) (replace (GRAPH GRAPH.ADDLINKFN) of Graph with SavedAddLinkFn) (replace (GRAPH GRAPH.DELETELINKFN) of Graph with SavedDeleteLinkFn) (replace (GRAPH GRAPH.MOVENODEFN) of Graph with SavedMoveNodeFn) (replace (GRAPH GRAPH.FONTCHANGEFN) of Graph with SavedFontChangeFn) (SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn) (FUNCTION NC.GraphCardMiddleButtonFn) NIL T) (* Disable the old-style right button grapher editor menu.) (WINDOWPROP Window (QUOTE RIGHTBUTTONFN) (FUNCTION NC.BrowserRightButtonFn)) (NC.SetSubstance ID (WINDOWPROP Window (QUOTE GRAPH))) (NC.MarkCardDirty ID) (NC.PutProp ID (QUOTE BrowserLinkLabels) (LIST LinkLabels)) (NC.PutProp ID (QUOTE BrowserFormat) (LIST BrowserFormat)) (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.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: "23-Apr-85 00:08") (* * 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)))))) (GETPROMPTWINDOW MainWindow 3 (FONTCREATE (QUOTE HELVETICA) 10)) (NC.PrintMsg MainWindow T "Select browser specs." (CHARACTER 13)) (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)) (NC.ClearMsg MainWindow T) (RETURN (COND (Choices (LIST (APPEND (CAR Choices) (CADR Choices)) (OR (FIXP (CADDR Choices)) 999999) (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: "15-Mar-85 19:43") (* * 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 T BrowserWindow T)) ) PersonalD ←(FIXP (MKATOM (OR (NC.AskUser "What is the PersoalD for this browser?" " -- " NIL T BrowserWindow T) 10))) FamilyD ←(FIXP (MKATOM (NC.AskUser "What is the FamilyD for this browser?" " -- " 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.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.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: " 1-May-85 21:58") (* * 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 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))))) ) [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.BrowserAddLink (LAMBDA (FromNode ToNode Win Graph) (* rht: "27-Apr-85 17:15") (* * Like grapher's ADD/AND/DISPLAY/LINK except has different checks and builds a real NC Link.) (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)) (* 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 ((ZEROP NumberOfLinks) (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.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.BrowserFixGraphEditMenuFn (LAMBDA (Window) (* rht: "12-Apr-85 18:31") (* * Attach the Graph edit menu to the side of the browser window. Put it below the links legend.) (PROG (GraphEditMenu GraphEditMenuWin) (SETQ GraphEditMenu (create MENU ITEMS ← NC.GraphEditMenuItems TITLE ← "Graph Editor Menu" WHENSELECTEDFN ←(FUNCTION NC.GraphEditMenuWhenSelectedFn))) (PUTMENUPROP GraphEditMenu (QUOTE MAINWINDOW) Window) (SETQ GraphEditMenuWin (OPENW (MENUWINDOW GraphEditMenu T))) (WINDOWPROP GraphEditMenuWin (QUOTE GRAPHEDITMENUFLG) T) (ATTACHWINDOW GraphEditMenuWin Window (QUOTE RIGHT) (QUOTE BOTTOM) (QUOTE LOCALCLOSE))))) (NC.BrowserCreateCard (LAMBDA (Graph Window) (* rht: "23-May-85 13:19") (* * 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)) (if Link then (NC.SetTitle (SETQ ID (fetch (NOTECARDLINK DESTINATIONID) of Link)) (NC.AskUser "Title of new card: " "" NIL T Window)) (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) (* rht: "23-Apr-85 23:52") (* * Called by grapher when user creates a new link.) (PROG ((GraphID (NC.IDFromWindow Window)) SourceID SourceType DestinationID LinkLabel StartingIDChar) (NC.MarkCardDirty GraphID) (SETQ StartingIDChar (ADD1 (NCHARS GraphID))) (SETQ SourceID (SUBATOM (fetch (GRAPHNODE NODEID) of FromNode) StartingIDChar)) (SETQ DestinationID (SUBATOM (fetch (GRAPHNODE NODEID) of ToNode) StartingIDChar)) (SETQ LinkLabel (COND ((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)))) (RETURN (AND LinkLabel (COND ((EQ (NCP.CardTypeSubstance SourceType) (QUOTE TEXT)) (NCP.LocalGlobalLink LinkLabel SourceID DestinationID)) (T (NCP.GlobalGlobalLink LinkLabel SourceID DestinationID)))))))) (NC.BrowserDeleteCard (LAMBDA (Node Graph Window) (* rht: "25-Apr-85 21:53") (* * 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))) (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: "26-Apr-85 16:35") (* * 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)) 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))) (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: "27-Apr-85 17:14") (* * Called by grapher when user adds a new edge. Will only allow edge addition if there are currently no edges between the two nodes.) (PROG ((GraphID (NC.IDFromWindow Window)) SourceID SourceType DestinationID StartingIDChar) (NC.MarkCardDirty GraphID) (RETURN (if (OR (MEMBTONODES (fetch (GRAPHNODE NODEID) of ToNode) (fetch (GRAPHNODE TONODES) of FromNode)) (MEMBTONODES (fetch (GRAPHNODE NODEID) of FromNode) (fetch (GRAPHNODE TONODES) of ToNode))) then (NC.PrintMsg NIL T "There is already an edge between those two nodes.") (FLASHW PROMPTWINDOW) NIL else (ADD/AND/DISPLAY/LINK FromNode ToNode Window Graph) NIL))))) (NC.BrowserRemoveNode (LAMBDA (Graph Window DeleteCardFlg) (* rht: "22-May-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.CoerceToGraphNodeID 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))) 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.CoerceToGraphNodeID 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))))) 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) (* rht: " 1-May-85 22:27") (* * 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)) VirtualNodesToKeep) (for Node in (fetch (GRAPH GRAPHNODES) of Graph) bind NodeID (LabelNum ← 0) when (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of Node)) 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)) (replace (GRAPHNODE TONODES) of Node with (for DestNode in (fetch (GRAPHNODE TONODES) of Node) 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 (CDAR (GETPROP NodeID DestNodeID)) (CDAR (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 (* First, may want to keep this virtual node.) (if (LISTP NewDestNode) then (SETQ VirtualNodesToKeep (CONS NewDestNode VirtualNodesToKeep))) (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))))) elseif (NOT NotLabelNodeFlg) then (LIST DestNodeID) else NIL)))) (* Delete all virtual nodes except the ones we marked as necessary to keep.) (* * 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.) (replace (GRAPH GRAPHNODES) of Graph with (for Node in (fetch (GRAPH GRAPHNODES) of Graph) bind NodeID when (OR (NOT (LISTP (SETQ NodeID (fetch (GRAPHNODE NODEID) of Node)))) (FMEMB NodeID VirtualNodesToKeep)) collect Node)) (SETQ LabelPairs (DREVERSE LabelPairs)) (AND Win (NC.MakeLinksLegendMenu Win LabelPairs)) (RETURN LabelPairs)))) (NC.MakeLinksLegendMenu (LAMBDA (Win LabelPairs) (* rht: "23-Apr-85 20:47") (* * 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)))) (SETQ MenuWin (MENUWINDOW Menu)) (WINDOWADDPROP MenuWin (QUOTE REPAINTFN) (QUOTE NC.LinksLegendRepaintFn)) (WINDOWADDPROP MenuWin (QUOTE RESHAPEFN) (QUOTE NC.LinksLegendReshapeFn)) (WINDOWADDPROP MenuWin (QUOTE LINKSLEGENDWINP) T) (WINDOWPROP Win (QUOTE NCLABELPAIRS) LabelPairs) (* Detach the prompt window for a second, saving the prompt window info from the main win's props.) (COND ((SETQ PromptWin (GETPROMPTWINDOW Win NIL NIL T)) (SETQ MainWinPromptInfo (WINDOWPROP Win (QUOTE PROMPTWINDOW))) (DETACHWINDOW PromptWin))) (* Stick the links legend window at lower right corner.) (ATTACHWINDOW MenuWin Win (QUOTE RIGHT) (QUOTE TOP) (QUOTE LOCALCLOSE)) (* Put back the prompt window if it exists.) (COND (PromptWin (ATTACHWINDOW PromptWin Win (QUOTE TOP) (QUOTE LEFT) (QUOTE HERE)) (WINDOWPROP Win (QUOTE PROMPTWINDOW) MainWinPromptInfo))) (* These CLOSEFNs added to get around a problem with ATTACHEDWINDOW package.) (for AttachedWin in (ATTACHEDWINDOWS Win) do (WINDOWADDPROP AttachedWin (QUOTE CLOSEFN) (QUOTE DETACHWINDOW))) (OPENW MenuWin) (MOVEW Win (MAKEWITHINREGION (WINDOWREGION Win) WHOLESCREEN)) (AND NC.LinkDashingInBrowser (NC.LinksLegendRepaintFn MenuWin NIL)) NIL))) (NC.LinksLegendRepaintFn (LAMBDA (Win Region) (* rht: " 6-Mar-85 13:09") (* * Repaint the right-hand column dashing in the browser's links legend menu.) (PROG ((Menu (CAR (WINDOWPROP Win (QUOTE MENU)))) Items (LabelPairs (WINDOWPROP (MAINWINDOW Win) (QUOTE NCLABELPAIRS)))) (SETQ Items (fetch (MENU ITEMS) of Menu)) (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 (LRSH (fetch (REGION HEIGHT) of ItemRegion) 1) (fetch (REGION BOTTOM) of ItemRegion)) (IDIFFERENCE (IPLUS (fetch (REGION WIDTH) of ItemRegion) (fetch (REGION LEFT) of ItemRegion)) 4) (IPLUS (LRSH (fetch (REGION HEIGHT) of ItemRegion) 1) (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: "15-Mar-85 17:51") (* * 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.) (PROG (NodeID DestNodeID MidpointFlg) (if NC.LinkDashingInBrowser then (if (SETQ NodeID (LISTGET ParamList (QUOTE NODEID))) then (* 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))) else (SETQ Dashing NIL)) (DRAWLINE X1 Y1 X2 Y2 Width Operation Win Color Dashing) (if (NEQ NC.ArrowHeadsInBrowser (QUOTE None)) then (SETQ MidpointFlg (EQ NC.ArrowHeadsInBrowser (QUOTE AtMidpoint))) (if (LISTGET ParamList (QUOTE BACKWARDFLG)) then (NC.DrawArrowHead X2 Y2 X1 Y1 Width Operation Win Color MidpointFlg) else (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) (* rht: "15-Mar-85 17:51") (* * 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 (LRSH (IPLUS X1 X2) 1)) (MidpointY (LRSH (IPLUS Y1 Y2) 1)) XOffset YOffset) (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.) (if (GREATERP (ABS (DIFFERENCE X2 X1)) (ABS (DIFFERENCE Y2 Y1))) then (SETQ YOffset (COND ((ODDP Num) (TIMES NC.GraphFlowerLinkSeparation (LRSH (ADD1 Num) 1))) (T (MINUS (TIMES NC.GraphFlowerLinkSeparation (LRSH (ADD1 Num) 1)))))) (SETQ XOffset 0) else (SETQ XOffset (COND ((ODDP Num) (TIMES NC.GraphFlowerLinkSeparation (LRSH (ADD1 Num) 1))) (T (MINUS (TIMES NC.GraphFlowerLinkSeparation (LRSH (ADD1 Num) 1)))))) (SETQ YOffset 0)) (DRAWCURVE (LIST (CONS X1 Y1) (CONS (PLUS MidpointX XOffset) (PLUS MidpointY YOffset)) (CONS X2 Y2)) NIL Brush Dashing Win) (AND (NEQ NC.ArrowHeadsInBrowser (QUOTE None)) (NC.DrawArrowHead X1 Y1 X2 Y2 Width Operation Win Color T XOffset YOffset))))))) (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: "15-Mar-85 17:23") (* * Draw an arrowhead on the end of the line segment from X1,Y1 to X2,Y2.) (PROG ((XDiff (IDIFFERENCE X1 X2)) (YDiff (IDIFFERENCE Y1 Y2)) LineLength A11 A12 A21 A22 Tmp1 Tmp2) (OR XOffset (SETQ XOffset 0)) (OR YOffset (SETQ YOffset 0)) (if MidpointFlg then (SETQ XOffset (PLUS XOffset (DIFFERENCE (LRSH (IPLUS X1 X2) 1) X2))) (SETQ YOffset (PLUS YOffset (DIFFERENCE (LRSH (IPLUS Y1 Y2) 1) Y2)))) (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 NC.ArrowHeadXVal)) (SETQ Tmp2 (TIMES A21 NC.ArrowHeadXVal)) (SETQ X2 (PLUS X2 XOffset)) (SETQ Y2 (PLUS Y2 YOffset)) (DRAWLINE X2 Y2 (PLUS X2 Tmp1 (TIMES A12 NC.ArrowHeadYVal)) (PLUS Y2 Tmp2 (TIMES A22 NC.ArrowHeadYVal)) Width Operation Stream Color) (DRAWLINE X2 Y2 (PLUS X2 Tmp1 (TIMES A12 (MINUS NC.ArrowHeadYVal))) (PLUS Y2 Tmp2 (TIMES A22 (MINUS NC.ArrowHeadYVal))) Width Operation Stream Color)))) ) (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 (9528 17402 (NC.MakeBrowserCard 9538 . 16513) (NC.BringUpBrowserCard 16515 . 17400)) ( 17403 66403 (NC.GrowLinkLattice 17413 . 23605) (NC.UpdateBrowserCard 23607 . 37379) ( NC.RelayoutBrowserCard 37381 . 37717) (NC.ConnectNodesInBrowser 37719 . 43209) ( NC.UnconnectNodesInBrowser 43211 . 45462) (NC.ExpandBrowserNode 45464 . 54718) (NC.NotBrowserHookP 54720 . 54978) (NC.AskBrowserSpecs 54980 . 59281) (NC.ChangeBrowserSpecs 59283 . 60586) ( NC.AskSpecialBrowserSpecs 60588 . 61739) (NC.IDFromGraphNodeID 61741 . 62043) (NC.BrowserFlipRoots 62045 . 62438) (NC.CoerceToGraphNodeID 62440 . 62968) (NC.SelectGraphNode 62970 . 63642) ( NC.GraphEdgesInconsistentP 63644 . 64851) (NC.DisplayGraphLinksBetween 64853 . 65597) ( NC.RebuildFromNodesInGraph 65599 . 66401)) (66560 104809 (NC.GetGraphEditMenu 66570 . 68290) ( NC.BrowserRightButtonFn 68292 . 68822) (NC.GraphEditMenuWhenSelectedFn 68824 . 69188) ( NC.BrowserCreateCardFn 69190 . 69645) (NC.BrowserAddLabelFn 69647 . 70096) (NC.BrowserAddNodeFn 70098 . 70567) (NC.BrowserCreateLinkFn 70569 . 70913) (NC.BrowserAddLink 70915 . 76987) ( NC.BrowserAddEdgeFn 76989 . 77321) (NC.BrowserDeleteCardFn 77323 . 77716) (NC.BrowserRemoveNodeFn 77718 . 78110) (NC.BrowserDeleteLinkFn 78112 . 78461) (NC.BrowserRemoveEdgeFn 78463 . 78811) ( NC.BrowserShrinkLabelFn 78813 . 79045) (NC.BrowserGrowLabelFn 79047 . 79278) ( NC.BrowserFixGraphEditMenuFn 79280 . 80140) (NC.BrowserCreateCard 80142 . 81008) (NC.BrowserCreateLink 81010 . 82257) (NC.BrowserDeleteCard 82259 . 84181) (NC.BrowserDeleteLink 84183 . 90507) ( NC.BrowserAddNode 90509 . 92409) (NC.BrowserAddLabel 92411 . 92688) (NC.BrowserAddEdge 92690 . 93621) (NC.BrowserRemoveNode 93623 . 98410) (NC.DelBrowserContentsLink 98412 . 99146) (NC.BrowserRemoveEdge 99148 . 103310) (NC.GraphRemoveNode 103312 . 104807)) (104848 122537 (NC.MakeLinksLegend 104858 . 111545) (NC.MakeLinksLegendMenu 111547 . 114230) (NC.LinksLegendRepaintFn 114232 . 115456) ( NC.BrowserDrawLinkFn 115458 . 117092) (NC.DrawFlowerLinks 117094 . 118549) (NC.DrawFlowerLink 118551 . 120583) (NC.LinksLegendReshapeFn 120585 . 120829) (NC.DrawArrowHead 120831 . 122535)) (122887 123375 (NC.AddBrowserCard 122897 . 123373))))) STOP