(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Nov-88 15:26:25" {QV}<NOTECARDS>1.3MNEXT>NCBROWSERCARD.;2 289479
changes to%: (FNS NC.AskBrowserSpecs NC.MakeBrowserCard NC.RelayoutBrowserCard
NC.ShowBrowserGraph NC.BrowserAddLink)
previous date%: "13-Oct-88 19:25:51" {QV}<NOTECARDS>1.3MNEXT>NCBROWSERCARD.;1)
(* "
Copyright (c) 1985, 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT NCBROWSERCARDCOMS)
(RPAQQ NCBROWSERCARDCOMS
(
(* ;;; "Stuff for the Notecards browser.")
[DECLARE%: DONTEVAL@LOAD FIRST (P (NC.LoadFileFromDirectories 'NCGRAPHCARD]
(FNS NCAddStub.BrowserCard)
(GLOBALVARS NC.SelectingBrowserSourceMenu NC.SpecialBrowserSpecsFlg
NC.BrowserContentsLinkLabel NC.SubBoxLinkLabel NC.FiledCardLinkLabel
NC.SelectingCardMenu NC.DashingStyles NC.GraphFlowerLinkSeparation
NC.LinkDashingInBrowser NC.ArrowHeadsInBrowser NC.BrowserFormatOptions
NC.*Graph*BrowserFormat NC.GraphEditMenuItems NC.GraphEditUnfixedMenuItems
NC.LinkIconShowTitleFlg NC.LinkIconShowLinkTypeFlg NC.LinkIconAttachBitmapFlg
NC.BrowserHashArraySize NC.UseDeletedLinkIconIndicatorsFlg)
[INITVARS (NC.LinkDashingInBrowser NIL)
(NC.ArrowHeadsInBrowser 'None)
(NC.BrowserHashArraySize 2000)
[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]
(NC.GraphFlowerLinkSeparation 8)
[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."
]
(NC.*Graph*BrowserFormat '*GRAPH*)
[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."
(SUBITEMS (|Move Single Node| NC.BrowserMoveNodeFn
"Move a browser node.")
(|Move Node & Subtree| NC.BrowserMoveSubtreeFn
"Move a subtree of nodes following the movement of the root."
)
(Move% Region NC.BrowserMoveNodesInRegionFn
"Move all nodes within a specified region to another region."
)))
(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 '((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.LayoutNewBrowserNodes
NC.ConnectNodesInBrowser NC.UnconnectNodesInBrowser NC.ExpandBrowserNode
NC.AskBrowserSpecs NC.ChangeBrowserSpecs NC.AskSpecialBrowserSpecs NC.BrowserFlipRoots
NC.ChangeBrowserRoots NC.RespecifyBrowserRoots NC.SelectGraphNode
NC.DisplayGraphLinksBetween NC.RebuildFromNodesInGraph NC.RemoveDuplicateNodesFromGraph
NC.ShowBrowserGraph)
(* ;;; "Graph editor menu functions.")
(FNS NC.SetUpGraphEditMenus 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.CursorInsideGraphNodeP NC.BrowserMoveNodesInRegionFn NC.BrowserMoveSubtreeFn
NC.BrowserFixGraphEditMenuFn NC.BrowserCreateCard NC.BrowserCreateLink
NC.BrowserDeleteLink NC.BrowserAddNode NC.BrowserAddLabel NC.BrowserAddEdge
NC.BrowserRemoveNode NC.DelBrowserContentsLink NC.BrowserRemoveEdge)
(* ;;; "Grapher hacks for browser")
(FNS NC.MakeLinksLegend NC.MakeLinksLegendMenu NC.LinksLegendRepaintFn NC.BrowserDrawLinkFn
NC.DrawFlowerLinks NC.DrawFlowerLink NC.LinksLegendReshapeFn NC.DrawArrowHead)
(* ;;; "for making and manipulating the tiny attached shrunken browser window.")
(INITVARS (NC.BrowserOverviewDefaultWidth 75)
(NC.BrowserOverviewDefaultHeight 75)
(NC.LeastScaleForGraphNodeShrinking 0.3))
(GLOBALVARS NC.BrowserOverviewDefaultWidth NC.BrowserOverviewDefaultHeight
NC.LeastScaleForGraphNodeShrinking NC.BrowserOverviewSpecsStylesheet
NC.DefaultWhereToAttachOverviewWin NC.DefaultBrowserOverviewMode
NC.OverviewWinMode.Compress NC.OverviewWinMode.Expand)
[INITVARS (NC.OverviewWinMode.Compress '|Compress Overview Win|)
(NC.OverviewWinMode.Expand 'Expand% Overview)
(NC.DefaultBrowserOverviewMode 'Neither)
(NC.DefaultWhereToAttachOverviewWin '(LEFT . TOP))
(NC.BrowserOverviewSpecsStylesheet (CREATE.STYLE 'TITLE
"Choose browser overview specs"
'ITEM.TITLES '(Edge |Position on Edge| Mode)
'ITEM.TITLE.FONT
(FONTCOPY MENUFONT 'WEIGHT 'BOLD)
'ITEMS
(LIST [create MENU ITEMS ←
'((LEFT LEFT
"Position along left edge."
)
(TOP TOP
"Position along top edge."
)
(RIGHT RIGHT
"Position along right edge."
)
(BOTTOM BOTTOM
"Position along bottom edge."
]
[create MENU ITEMS ←
'((TOP/RIGHT TOP
"Position at top or right end of edge."
)
(CENTER CENTER
"Position at center of edge."
)
(BOTTOM/LEFT BOTTOM
"Position at bottom or left of edge."
]
(create MENU ITEMS ←
'((|Compress Overview Win|
|Compress Overview Win|
"Compress the overview window to exactly fit the overview contents."
)
(Expand% Overview
Expand% Overview
"Expand the overview contents to exactly fill the overview window."
)
(Neither Neither
"Neither expand the overview contents nor compress the overview window."
]
(FNS NC.MakeBrowserOverviewWin NC.AskBrowserOverviewSpecs)
(FNS NC.DRAWBOX NC.ShrinkGraphToWindow NC.ScaleGraphNode NC.ComputeOverviewScale
NC.RedrawBrowserOverviewWin NC.DrawWireFrameInOverviewWin NC.CompressOverviewWin
NC.ReattachBrowserOverviewWin NC.BrowserScrollFn NC.BrowserReshapeFn
NC.BrowserOverviewWinRepaintFn NC.BrowserOverviewWinReshapeFn
NC.BrowserOverviewWinMINSIZEFn NC.BrowserOverviewWinButtonEventFn NC.BrowserCardQuitFn
NC.MakeBrowserCardReadOnly NC.MakeBrowserCardReadWrite)
(* ;;; "Miscellaneous")
(FNS NC.DelReferencesToCardFromBrowser NC.NewBrowserNodeUIDFromOldUID NC.GetBrowserSubstance
NC.ComputeBrowserSavedLinkingInfo NC.ComputeBrowserSavedLinkingInfoForNode)
(FNS NC.FetchBrowserRootsInfo NC.FetchBrowserLinkLabels NC.FetchBrowserFormat
NC.FetchSpecialBrowserSpecs NC.FetchBrowserDepth NC.FetchBrowserSavedLinkingInfo
NC.FetchBrowserLinksLegend)
(FNS NC.SetBrowserRootsInfo NC.SetBrowserLinkLabels NC.SetBrowserFormat
NC.SetSpecialBrowserSpecs NC.SetBrowserDepth NC.SetBrowserSavedLinkingInfo
NC.SetBrowserLinksLegend)
(FNS NC.ReadBrowserRootsInfo NC.ReadBrowserLinkLabels NC.ReadBrowserFormat
NC.ReadSpecialBrowserSpecs NC.ReadBrowserDepth NC.ReadBrowserSavedLinkingInfo
NC.ReadBrowserSavedLinkingInfoForNode NC.ReadBrowserLinksLegend)
(FNS NC.WriteBrowserRootsInfo NC.WriteBrowserLinkLabels NC.WriteBrowserFormat
NC.WriteSpecialBrowserSpecs NC.WriteBrowserDepth NC.WriteBrowserSavedLinkingInfo
NC.WriteBrowserSavedLinkingInfoForNode NC.WriteBrowserLinksLegend)
(FNS NC.GraphLinkIconUpdateCheck NC.BrowserRepaintFn NC.CoerceToGraphNodeID
NC.CoerceToGraphNodeIDOrLabel NC.GetBrowserNodeID NC.MakeBrowserNodeUID
NC.GetBrowserHashArray NC.RemoveBrowserNodeHashArrayEntry NC.HashArrayFromBrowserCard
NC.CardFromBrowserNodeID NC.CardFromBrowserNode NC.SmashGraphNodeIDProps
NC.PutBrowserSubstance NC.FetchBrowserRoots NC.SetBrowserRoots)
(FNS NC.GraphNodeIDGetProp NC.GraphNodeIDPutProp NC.GraphNodeIDRemProp)
(GLOBALVARS NC.ArrowHeadLength NC.ArrowHeadAngle NC.ArrowHeadXVal NC.ArrowHeadYVal)
[INITVARS (NC.ArrowHeadLength 7)
(NC.ArrowHeadAngle 20)
(NC.ArrowHeadXVal (TIMES NC.ArrowHeadLength (COS NC.ArrowHeadAngle)))
(NC.ArrowHeadYVal (TIMES NC.ArrowHeadLength (SIN NC.ArrowHeadAngle]
(* ;;; "init")
(FNS NC.AddBrowserCard)
(DECLARE%: DONTEVAL@LOAD (P (NC.AddBrowserCard)))
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
NCBROWSERCARD)))
(* ;;; "Stuff for the Notecards browser.")
(DECLARE%: DONTEVAL@LOAD FIRST
(NC.LoadFileFromDirectories 'NCGRAPHCARD)
)
(DEFINEQ
(NCAddStub.BrowserCard
(LAMBDA NIL (* rht%: " 8-Nov-86 19:21")
(* * kirk 18Jun86 Add the Browser card stub)
(* * rht 11/7/86%: Now passes down a \\FILLME// field.)
(NC.AddCardTypeStub 'Browser 'Graph 'NCBROWSERCARD NIL '((DisplayedInMenuFlg T)) '(
LinkIconAttachedBitMap
))))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.SelectingBrowserSourceMenu NC.SpecialBrowserSpecsFlg NC.BrowserContentsLinkLabel
NC.SubBoxLinkLabel NC.FiledCardLinkLabel NC.SelectingCardMenu NC.DashingStyles
NC.GraphFlowerLinkSeparation NC.LinkDashingInBrowser NC.ArrowHeadsInBrowser
NC.BrowserFormatOptions NC.*Graph*BrowserFormat NC.GraphEditMenuItems
NC.GraphEditUnfixedMenuItems NC.LinkIconShowTitleFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconAttachBitmapFlg NC.BrowserHashArraySize NC.UseDeletedLinkIconIndicatorsFlg)
)
(RPAQ? NC.LinkDashingInBrowser NIL)
(RPAQ? NC.ArrowHeadsInBrowser 'None)
(RPAQ? NC.BrowserHashArraySize 2000)
(RPAQ? 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)))
(RPAQ? NC.GraphFlowerLinkSeparation 8)
(RPAQ? 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."
)))
(RPAQ? NC.*Graph*BrowserFormat '*GRAPH*)
(RPAQ? 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." (SUBITEMS (|Move Single Node|
NC.BrowserMoveNodeFn
"Move a browser node."
)
(|Move Node & Subtree|
NC.BrowserMoveSubtreeFn
"Move a subtree of nodes following the movement of the root."
)
(Move% Region
NC.BrowserMoveNodesInRegionFn
"Move all nodes within a specified region to another region."
)))
(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 '((FIX% MENU
NC.BrowserFixGraphEditMenuFn
"Attach this menu to edge of browser window."
])
(* ;;; "BROWSER mechanisms")
(DEFINEQ
(NC.MakeBrowserCard
[LAMBDA (Card Title NoDisplayFlg ParamList InterestedWindow RegionOrPosition)
(* ; "Edited 29-Sep-88 13:13 by jrc")
(* ;; "Make a browser card with id Card 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.")
(* ;; "rht 11/17/85: Updated to handle new card and notefile objects.")
(* ;; "rht 2/7/86: Now gets browser format, etc. via fetch/set fns.")
(* ;; "rht 5/6/86: Took out call to NC.SetupTitleBarMenu.")
(* ;; "rht 5/8/86: Added calls to rig title bar properly.")
(* ;; "rht 7/10/86: Now passes ListOfLinkLabels to NC.AskBrowserSpecs.")
(* ;; "rht 9/19/86: Mod to above fix. Now calls NC.MakeNewCardWindow a new fn that creates window and hangs Card off windowprop.")
(* ;; "pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection. Also added GLOBALVARS statement.")
(* ;; "pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.")
(* ;; "rht 12/16/86: Now checks that NC.MakeLink succeeded before creating a real link icon. If not, then make a standin for a cross file link icon.")
(* ;; "rg 3/18/87 added NC.CardSelectionOperation wrapper")
(* ;; "rht 3/20/87: Removed needless call to NC.ActivateCard.")
(* ;; "rg 4/2/87 changed wrapper to NCP.WithLockedCards and added NC.IfAllCardsFree wrapper")
(* ;; "rht 5/26/87: Now handles cross-file links properly, i.e. uses cross-file link standin in cases when GrowLinkLattice wasn't able to follow into the remote notefile.")
(* ;; "dwm 1/19/88 Sets ReadOnly prop based upon current NF ReadOnly status")
(* ;; "pmi 2/29/88: Now asks for specs only if none are specified coming in. A browser created from a browser now prompts for everything. Also added InterestedWindow argument.")
(* ;; "rht 6/9/88: Added RegionOrPosition arg and passed to NC.MakeNewCardWindow.")
(* ;; "jrc 29-sep-88. Added WINDOWPROP calls at end of function -- in the old days, NC.RelayoutBrowserCard added these props, but NC.RelayoutBrowserCard now only preserves the props that are already on the window. The WINDOWPROP calls are copied from NC.BringUpBrowserCard.")
(DECLARE (GLOBALVARS NC.SubBoxLinkLabel NC.BrowserContentsLinkLabel NC.SpecialBrowserSpecsFlg
NC.*Graph*BrowserFormat NC.SelectingBrowserSourceMenu))
(NCP.WithLockedCards
(PROG ([RootCards (MKLIST (LISTGET ParamList 'ROOTCARDS]
(ListOfLinkLabels (LISTGET ParamList 'LINKTYPES))
(BrowserFormat (LISTGET ParamList 'FORMAT))
(Depth (LISTGET ParamList 'DEPTH))
(CardType (NC.RetrieveType Card))
(Don'tAskForRoots (FMEMB 'ROOTCARDS ParamList))
(Don'tAskForSpecs (OR (FMEMB 'LINKTYPES ParamList)
(FMEMB 'FORMAT ParamList)
(FMEMB 'DEPTH ParamList)))
Lattice RootNodes Window Graph SpecialBrowserSpecs BrowserSpecs DropVirtualNodesFlg)
(NC.IfAllCardsFree
(NC.LockListOfCards RootCards "Make Browser Card")
(if (NOT NoDisplayFlg)
then (SETQ Window (NC.MakeNewCardWindow Card (OR Title "Untitled")
NIL NIL RegionOrPosition))
(WINDOWADDPROP Window 'SHRINKFN (FUNCTION NC.GraphCardShrinkFn))
(SETQ InterestedWindow Window))
(OR Don'tAskForRoots (SETQ RootCards (NC.SelectNoteCards NIL NIL
NC.SelectingBrowserSourceMenu
InterestedWindow
"Please shift-select the Cards and/or Boxes the browser should start from."
T)))
(COND
((EQ RootCards 'DON'T)
(NC.DeactivateCard Card)
(CLOSEW Window)
(RETURN)))
(NC.HoldTTYProcess)
[SETQ BrowserSpecs (NC.AskBrowserSpecs InterestedWindow Card ListOfLinkLabels Depth
BrowserFormat T (if Don'tAskForSpecs
then 'DONTASK]
(COND
((NULL BrowserSpecs)
(NC.DeactivateCard Card)
(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
InterestedWindow))
(T (create SPECIALBROWSERSPECS]
(OR NoDisplayFlg (NC.PrintMsg InterestedWindow T (CHARACTER 13)
"Computing browser graph. Please wait. ..."))
(* ; "Create new browser hash array")
(NC.GetBrowserHashArray Card) (* ;
"Compute lattice breakdth-first starting from roots.")
(SETQ Lattice (NC.GrowLinkLattice RootCards NIL ListOfLinkLabels Card Depth))
(SETQ RootNodes (if RootCards
then (for RootCard in RootCards
collect (NC.GetBrowserNodeID Card RootCard))
else NIL))
(* ;;
"Link destination id information stored in NodeLabel field into a LinkIcon for display")
(for Node in Lattice bind NodeID (CrossFileLinkModePropList
←
(LIST (fetch (Card NoteFile)
of Card)
NIL)) eachtime (BLOCK)
do [replace (GRAPHNODE NODELABEL) of Node
with (LET (NewLink)
(if [AND (NOT (NC.CrossFileLinkCardP (fetch
(GRAPHNODE NODELABEL
)
of Node)))
(SETQ NewLink
(NC.MakeLink InterestedWindow
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
Card NIL NIL NIL NIL NIL
(NC.ComputeCrossFileLinkMode
(fetch (GRAPHNODE NODELABEL)
of Node)
CrossFileLinkModePropList
InterestedWindow]
then (NC.MakeLinkIcon NewLink)
else (NC.MakeCrossFileLinkIconStandIn
(fetch (GRAPHNODE NODELABEL) of Node]
(* ;
"Untouch each graph node so that next Recompute will put fresh values on proplist.")
(SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(NC.GraphNodeIDRemProp (NC.CoerceToGraphNodeID NodeID)
'TouchedFlg)
(NC.GraphNodeIDRemProp (NC.CoerceToGraphNodeID NodeID)
'VisitedFlg))
(SETQ Graph (if (AND Lattice RootNodes)
then (LAYOUTGRAPH Lattice RootNodes (SUBST '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)))
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph Window
DropVirtualNodesFlg))
(OR NoDisplayFlg (NC.PrintMsg InterestedWindow NIL "Done!"))
(NC.SetSubstance Card Graph)
(NC.SetBrowserLinkLabels Card (OR ListOfLinkLabels (LIST NC.SubBoxLinkLabel)))
(NC.SetBrowserRoots Card RootCards)
(NC.SetBrowserFormat Card BrowserFormat)
(NC.SetBrowserDepth Card Depth)
(NC.SetSpecialBrowserSpecs Card SpecialBrowserSpecs)
(NC.SetUserDataProp Card 'ReadOnly (NC.CardReadOnlyOpenP Card))
(COND
(NoDisplayFlg (RETURN Card)))
(WINDOWPROP Window 'GRAPH Graph)
(NC.InstallTitleBarLeftMenu Window CardType)
(NC.InstallTitleBarMiddleMenu Window CardType)
(NC.RelayoutBrowserCard Window)
(WINDOWPROP Window 'RIGHTBUTTONFN (FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window 'SHRINKFN (FUNCTION NC.GraphCardShrinkFn))
(* ;; "SHOWGRAPH changes this REPAINTFN to REDISPLAYGRAPH, but since NC.RelayoutBrowserCard (now) only preserves props that were already there, it has to be added here.")
(WINDOWPROP Window 'REPAINTFN (FUNCTION REDISPLAYGRAPH))
(WINDOWADDPROP Window 'REPAINTFN (FUNCTION NC.BrowserRepaintFn)
T)
(WINDOWPROP Window 'SCROLLFN (FUNCTION NC.BrowserScrollFn))
(WINDOWPROP Window 'RESHAPEFN (FUNCTION NC.BrowserReshapeFn))
(RETURN Window])
(NC.BringUpBrowserCard
[LAMBDA (Card Substance Region/Position) (* ; "Edited 11-May-88 23:51 by Trigg")
(* ;; "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.")
(* ;; "rht 11/17/85: Now handles new card and Notefile objects.")
(* ;; "rht 2/1/86: Now restores any saved UID user data info stashed on card's prop list.")
(* ;; "fgh 2/5/86 Added call to NC.ApplySupersFn")
(* ;; "rht 2/14/86: Now rebuilds browser hash array.")
(* ;; "rht 2/28/86: Added WINDOWPROP for SCROLLFN and RESHAPEFN.")
(* ;; "rht 3/2/86: Took out call to NC.FetchBrowserHashArray.")
(* ;;
"rht 4/5/86: Now only replaces graphnodes' TONODES' NODEID and DESTNODEID if they're non-nil.")
(* ;; "rht 5/5/86: Took out call to NC.SetupTitleBarMenu.")
(* ;; "rht&pmi 2/6/87: Moved call to NC.GraphLinkIconUpdateCheck in front of call to GraphCard's EditFn so as to remove 'double display' problem.")
(* ;; "rht 1/16/88: Had to replace the ApplySuperTypeFn call with grungy apply* to prevent infinite recursive calls.")
(* ;; "rht 5/11/88: Sped up things significantly by ripping out the conversion of old UIDs to new UID objects. This enabled by changes to reading of UIDs so that all versions of same UID read in will be eq.")
(DECLARE (GLOBALVARS NC.GlobalUIDHashArray))
(LET ((GraphNodes (fetch (GRAPH GRAPHNODES) of Substance))
Window)
(* ;; "Restore any saved UID user data info stashed on card UID's prop list.")
[for BrowserSavedLinkingInfoForNode in (NC.FetchBrowserSavedLinkingInfo Card)
do (LET ((SourceUID (CAR BrowserSavedLinkingInfoForNode)))
(for SavedLinkingInfo on (CDR BrowserSavedLinkingInfoForNode)
by (CDDR SavedLinkingInfo) eachtime (BLOCK) do (NC.GraphNodeIDPutProp
SourceUID
(CAR SavedLinkingInfo)
(CADR SavedLinkingInfo]
(NC.SetBrowserSavedLinkingInfo Card NIL)
(* ;;
"For each graph node corresponding to a notecard, hang the card object off the node id's prop list.")
[for GraphNode in GraphNodes bind LinkIcon DestCard eachtime (BLOCK)
when (NC.LinkIconImageObjP (SETQ LinkIcon (fetch (GRAPHNODE NODELABEL) of GraphNode)))
do (NC.GraphNodeIDPutProp (NC.CoerceToGraphNodeID GraphNode)
'CardObject
(SETQ DestCard (fetch (Link DestinationCard) of (NC.FetchLinkFromLinkIcon
LinkIcon]
(* ;; "Make a new browser hash array with the new graph node UIDs.")
(NC.SetUserDataProp Card 'BrowserHashArray NIL)
(NC.GetBrowserHashArray Card Substance)
(* ;; "For each graph node, fix the NODEID and DESTNODEID fields of each of its TONODES LinkParameters. While we're at it, smash the entry in the global uid hash array for each node's uid.")
[for GraphNode in GraphNodes eachtime (BLOCK)
do (LET ((ThisNodeID (NC.CoerceToGraphNodeID GraphNode)))
(if (type? UID ThisNodeID)
then (PUTHASH ThisNodeID NIL NC.GlobalUIDHashArray))
(for ToNode in (fetch (GRAPHNODE TONODES) of GraphNode) eachtime (BLOCK)
when (EQ (CAR ToNode)
LINKPARAMS) do (AND (LISTGET ToNode 'NODEID)
(LISTPUT ToNode 'NODEID ThisNodeID))
(AND (LISTGET ToNode 'DESTNODEID)
(LISTPUT ToNode 'DESTNODEID (
NC.CoerceToGraphNodeID
(CADR ToNode]
(* ;; "Bring up card and mess with its window.")
(NC.GraphLinkIconUpdateCheck Card NIL Substance T)
(SETQ Window (APPLY* (NCP.CardTypeFn 'Graph 'EditFn)
Card Substance Region/Position))
(* ;; "I have to hang notecard's Card on window now in case REDISPLAYW runs and tries to get Card from window.")
(WINDOWPROP Window 'NoteCardObject Card)
(NC.MakeLinksLegendMenu Window (NC.FetchBrowserLinksLegend Card))
(* ;
"Disable the old-style right button grapher editor menu.")
(WINDOWPROP Window 'RIGHTBUTTONFN (FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window 'SHRINKFN (FUNCTION NC.GraphCardShrinkFn))
(WINDOWADDPROP Window 'REPAINTFN (FUNCTION NC.BrowserRepaintFn)
T)
(WINDOWPROP Window 'SCROLLFN (FUNCTION NC.BrowserScrollFn))
(WINDOWPROP Window 'RESHAPEFN (FUNCTION NC.BrowserReshapeFn))
(* ;; "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 Card Window Substance T) then (REDISPLAYW Window)")
Window])
)
(DEFINEQ
(NC.GrowLinkLattice
(LAMBDA (RootCardsList CurrentGraph ListOfLinkLabels GraphCard RemainingSearchDepth)
(* pmi%: "30-Nov-87 12:48")
(* 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 Card 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.)
(* * rht 11/17/85%: Handles new card and notefile objects.)
(* * rht 5/26/87%: Now tries to follow cross-file links.)
(* * rht 10/26/87%: Now deactivates cards at the end that we had to NC.GetLinks
for.)
(* * rht&pmi 11/30/87%: No longer allows following backlinks if they go to this
browser.)
(LET
(CardsAndDepthsQueue CardsNeedingDeactivation)
(* Make the queue contain pairs of root Card and depth remaining to search.)
(SETQ CardsAndDepthsQueue (for Card in RootCardsList collect (CONS Card RemainingSearchDepth)))
(* Make it a TCONC list for fast appending to the end.)
(SETQ CardsAndDepthsQueue (CONS CardsAndDepthsQueue (LAST CardsAndDepthsQueue)))
(* * Do breadth-first search using the queue IDsAndDepthsQueue.)
(for bind CardAndDepth Card RemainingSearchDepth ToLinks FromLinks DestinationIDs GraphNodeID
GraphNode eachtime (BLOCK) (* Grab and take apart 1st pair on
queue.)
(SETQ CardAndDepth (CAAR CardsAndDepthsQueue))
(SETQ Card (CAR CardAndDepth))
(SETQ RemainingSearchDepth (CDR CardAndDepth))
(* Remove the front pair from the
queue.)
(RPLACA CardsAndDepthsQueue (CDAR CardsAndDepthsQueue))
(* If that was the last pair, then start queue over fresh.)
(if (NULL (CAR CardsAndDepthsQueue))
then (SETQ CardsAndDepthsQueue NIL)) while Card
unless (NC.SameCardP Card GraphCard)
do
(SETQ GraphNodeID (NC.GetBrowserNodeID GraphCard Card))
(* Go grab this ID's links.)
(if (NC.ActiveCardP Card)
then (SETQ ToLinks (NC.FetchToLinks Card))
(SETQ FromLinks (NC.FetchFromLinks Card))
else (NC.GetLinks Card)
(SETQ ToLinks (NC.FetchToLinks Card))
(SETQ FromLinks (NC.FetchFromLinks Card))
(push CardsNeedingDeactivation Card))
(if (IGREATERP RemainingSearchDepth 0)
then (* Crush the ID's proplist.)
(if (NOT (NC.GraphNodeIDGetProp GraphNodeID 'TouchedFlg))
then (NC.SmashGraphNodeIDProps GraphNodeID)
(NC.GraphNodeIDPutProp GraphNodeID 'TouchedFlg T))
(SETQ DestinationIDs
(NCONC
(for Link in ToLinks bind DestID DestVisitedFlg DestTouchedFlg ThisWayLinkFlg
OtherWayLinkFlg
eachtime (BLOCK)
(if (SETQ ThisWayLinkFlg (NC.LinkLabelP Link ListOfLinkLabels))
then (SETQ DestID (NC.GetBrowserNodeID
GraphCard
(LET ((DestCard (fetch (Link DestinationCard)
of Link)))
(if (NC.CrossFileLinkCardP DestCard)
then (OR (NC.GetCrossFileLinkDestCard DestCard
)
DestCard)
else DestCard))))
(SETQ DestVisitedFlg (NC.GraphNodeIDGetProp DestID 'VisitedFlg))
(SETQ DestTouchedFlg (NC.GraphNodeIDGetProp DestID 'TouchedFlg))
(SETQ OtherWayLinkFlg (NC.ReverseLinkLabelP Link ListOfLinkLabels)))
when ThisWayLinkFlg unless (AND DestVisitedFlg OtherWayLinkFlg)
collect (* Record presence of this link.)
(NC.UIDAddProp GraphNodeID DestID (fetch (Link Label) of Link)
T)
DestID)
(for Link in FromLinks bind DestID DestTouchedFlg DestVisitedFlg ThisWayLinkFlg
OtherWayLinkFlg LinkFromUsFlg SourceCard
eachtime
(BLOCK)
(if (AND (SETQ ThisWayLinkFlg (NC.ReverseLinkLabelP Link ListOfLinkLabels))
(NOT (SETQ LinkFromUsFlg (NC.SameCardP
GraphCard
(SETQ SourceCard
(LET ((SrcCard (fetch (Link SourceCard)
of Link)))
(if (NC.CrossFileLinkCardP SrcCard)
then (OR (NC.GetCrossFileLinkDestCard
SrcCard)
SrcCard)
else SrcCard)))))))
then (SETQ DestID (NC.GetBrowserNodeID GraphCard SourceCard))
(SETQ DestVisitedFlg (NC.GraphNodeIDGetProp DestID 'VisitedFlg))
(SETQ DestTouchedFlg (NC.GraphNodeIDGetProp DestID 'TouchedFlg))
(SETQ OtherWayLinkFlg (NC.LinkLabelP Link ListOfLinkLabels))) when
ThisWayLinkFlg
unless (OR LinkFromUsFlg (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 (NC.GraphNodeIDRemProp DestID GraphNodeID)
else (NC.SmashGraphNodeIDProps DestID)
(NC.GraphNodeIDPutProp DestID 'TouchedFlg T)))
(* Record presence of this link.)
(NC.UIDAddProp DestID GraphNodeID (fetch (Link Label) of Link)
T)
DestID)))
(SETQ DestinationIDs (DREMOVE (NC.GetBrowserNodeID GraphCard GraphCard)
(INTERSECTION DestinationIDs DestinationIDs)))
else (SETQ DestinationIDs NIL))
(NC.GraphNodeIDPutProp GraphNodeID '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 ← Card)))))
(* * Attach new IDs to end of queue.)
(for DestinationID in DestinationIDs bind DestCard eachtime (BLOCK)
(SETQ DestCard (
NC.CardFromBrowserNodeID
DestinationID))
unless (OR (NC.GraphNodeIDGetProp DestinationID 'VisitedFlg)
(for CardAndDepth in (CAR CardsAndDepthsQueue) eachtime (BLOCK)
thereis (NC.SameCardP DestCard (CAR CardAndDepth))))
do (SETQ CardsAndDepthsQueue (TCONC CardsAndDepthsQueue (CONS DestCard (SUB1
RemainingSearchDepth
))))))
(for Card in CardsNeedingDeactivation do (NC.DeactivateCard Card))
CurrentGraph)))
(NC.UpdateBrowserCard
[LAMBDA (Window) (* ; "Edited 29-Jul-88 20:26 by Trigg")
(* ;; "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.")
(* ;; "rht 11/17/85: updated to handle new card and notefile objects.")
(* ;; "kirk 23Jan86 Changed to use NC.AskYesOrNo")
(* ;; "rht 2/7/86: Now gets and sets browser format, etc. via fetch/set fns.")
(* ;; "rht 3/7/86: Now only closes the Links legend menu attached window.")
(* ;; "rht 6/10/86: Moved code to delete links legend menu and code to make new browser hash array to after questioning user about respecifying roots.")
(* ;; "rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.")
(* ;; "pmi 12/5/86: Modified message to NC.SelectNoteCards to mention SHIFT-selection.")
(* ;; "pmi 12/12/86: Removed obsolete ReturnLinksFlg argument in call to NC.SelectNoteCards.")
(* ;; "rht 12/16/86: Now checks that NC.MakeLink succeeded before creating a real link icon. If not, then make a standin for a cross file link icon.")
(* ;;
"rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg")
(* ;; "rg 3/18/87 added NC.CardSelectionOperation wrapper")
(* ;; "rht 3/19/87: Fixed the part that calls NC.MakeLink so it really only rebuilds links if they've changed.")
(* ;; "rg 4/1/87 changed CANCELLED to DON'T")
(* ;; "rht 5/26/87: Now handles cross-file links properly, i.e. uses cross-file link standin in cases when GrowLinkLattice wasn't able to follow into the remote notefile.")
(* ;; "rht 7/29/88: Replaced code that lets user respecify roots by call to NC.RespecifyBrowserRoots. Also no longer calls NC.SetPropListDirtyFlg")
(LET
((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Recompute Browser Card" NIL
(NCP.WithLockedCards
(PROG (LinkLabels RootCards RootNodes Lattice LinkIcon Graph GraphNodes NodeLabel BrowserSpecs
BrowserFormat DropVirtualNodesFlg Depth SpecialBrowserSpecs OldLabelNodes
OldRootCards)
(SETQ RootCards (NC.FetchBrowserRoots Card))
(NC.IfAllCardsFree
(NC.LockListOfCards RootCards "Update Browser Card")
(SETQ LinkLabels (NC.FetchBrowserLinkLabels Card))
[SETQ BrowserFormat (OR (NC.FetchBrowserFormat Card)
'(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 (NC.FetchBrowserDepth Card)
999999))
(SETQ SpecialBrowserSpecs (OR (NC.FetchSpecialBrowserSpecs Card)
(create SPECIALBROWSERSPECS)))
[SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP Window
'GRAPH]
(* ; "Get new roots.")
[if (OR (NULL RootCards)
(NC.AskYesOrNo "Want to respecify roots? " "--" "No" T Window T NIL))
then (SETQ RootCards (NC.RespecifyBrowserRoots Card RootCards GraphNodes Window))
(COND
((EQ RootCards 'DON'T)
(RETURN] (* ;
"Get rid of the links legend menu attached window.")
(for Win in (ATTACHEDWINDOWS Window) when (WINDOWPROP Win 'LINKSLEGENDWINP)
do (DETACHWINDOW Win)
(CLOSEW Win)) (* ;
"Smash the current hash array, putting a fresh one in its place.")
(NC.GetBrowserHashArray Card)
(NC.PrintMsg Window T (CHARACTER 13)
"Computing browser graph. Please wait. ...")
(* ;
"Compute lattice breadth-first from the roots.")
(SETQ Lattice (NC.GrowLinkLattice RootCards NIL LinkLabels Card Depth))
(SETQ RootNodes (for RootCard in RootCards collect (NC.GetBrowserNodeID Card RootCard))
) (* ;
"Remove all links that are in the old browser graph but not in the new one")
[for Node in GraphNodes eachtime (BLOCK)
unless [for LatticeNode in Lattice bind (CardForNode ← (NC.CardFromBrowserNodeID
(NC.CoerceToGraphNodeID
Node)))
thereis (NC.SameCardP CardForNode (NC.CardFromBrowserNodeID (
NC.CoerceToGraphNodeID
LatticeNode]
do (LET ((NodeLabel (fetch (GRAPHNODE NODELABEL) of Node)))
(COND
((NC.LinkIconImageObjP NodeLabel)
(NC.DeleteLink (NC.FetchLinkFromLinkIcon NodeLabel)
T T))
((STRINGP NodeLabel) (* ;
"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 eachtime (BLOCK) bind (CrossFileLinkModePropList
←
(LIST (fetch (Card NoteFile) of Card)
NIL))
do
(LET
[(NodeID (fetch (GRAPHNODE NODEID) of Node))
(OldNode (for GraphNode in GraphNodes bind (CardForNode ← (
NC.CardFromBrowserNodeID
(NC.CoerceToGraphNodeID
Node)))
when (NC.SameCardP CardForNode (NC.CardFromBrowserNodeID (
NC.CoerceToGraphNodeID
GraphNode)))
do (RETURN GraphNode]
[if OldNode
then (replace (GRAPHNODE NODELABEL) of Node with (fetch (GRAPHNODE NODELABEL)
of OldNode))
else (replace (GRAPHNODE NODELABEL) of Node
with (LET (NewLink)
(if [AND (NOT (NC.CrossFileLinkCardP (fetch (GRAPHNODE
NODELABEL)
of Node)))
(SETQ NewLink (NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
Card NIL NIL NIL NIL NIL
(NC.ComputeCrossFileLinkMode
(fetch (GRAPHNODE NODELABEL)
of Node)
CrossFileLinkModePropList Window
]
then (NC.MakeLinkIcon NewLink)
else (NC.MakeCrossFileLinkIconStandIn (fetch (GRAPHNODE
NODELABEL)
of Node]
(* ;
"Untouch each graph node so that next Recompute will put fresh values on proplist.")
(NC.GraphNodeIDRemProp NodeID 'TouchedFlg)
(NC.GraphNodeIDRemProp NodeID '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 '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.")
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(NC.SetBrowserRoots Card RootCards)
(NC.SetBrowserDepth Card Depth)
(WINDOWPROP Window 'GRAPH Graph)
(NC.RelayoutBrowserCard Window])
(NC.RelayoutBrowserCard
[LAMBDA (Window) (* ; "Edited 28-Sep-88 18:45 by jrc")
(* ;;; "Called from the middle button of a browser or structeditbrowser card. This lays out and displays the browser, but does not recompute the nodes.")
(* ;; "rht 11/17/85: updated to handle new notefile and card objects.")
(* ;; "rht 2/7/86: Now gets browser format, etc. via fetch/set fns.")
(* ;; "rht 2/28/86: Added WINDOWPROP for SCROLLFN and RESHAPEFN.")
(* ;; "rht 5/8/86: Added calls to rig title bar properly.")
(* ;; "fgh 6/30/86 Added NC.GRAPHERCOPYBUTTONEVENTFN to SHOWGRAPH call")
(* ;; "rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.")
(* ;;
"rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg")
(* ;; "rht 7/29/88: No longer calls NC.SetPropListDirtyFlg")
(* ;; " jrc 28-sep-88: Saves various WINDOWPROPs that SHOWGRAPH seems to smash. The original code made assumptions about what the value of each of the WINDOWPROPs was.")
(LET
((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Relayout Browser Card" NIL
(PROG (RootCards RootNodeIDs OldToNodePairs Graph GraphNodes BrowserFormat DropVirtualNodesFlg
SpecialBrowserSpecs OldRepaintFn OldRightButtonFn OldScrollFn OldReshapeFn)
(NC.PrintMsg Window T "Laying out graph ...")
(SETQ RootCards (NC.FetchBrowserRoots Card))
[SETQ BrowserFormat (OR (NC.FetchBrowserFormat Card)
'(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 (NC.FetchSpecialBrowserSpecs Card))
(create SPECIALBROWSERSPECS)))
[SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP
Window
'GRAPH]
(* ;
"Create hash array if haven't already.")
(NC.GetBrowserHashArray Card Graph) (* ;
"check graph node size against image box size.")
(NC.GraphLinkIconUpdateCheck Card 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 RootNodeIDs (for RootCard in RootCards collect (NC.GetBrowserNodeID
Card RootCard)))
(* ;; "Layout graph, including as roots any non-virtual nodes with no from nodes to avoid disconnected graphs.")
(SETQ Graph (if GraphNodes
then (LAYOUTGRAPH
GraphNodes
(for Node in GraphNodes bind NodeID
eachtime (BLOCK)
(SETQ NodeID (fetch (GRAPHNODE NODEID)
of Node))
when (OR (AND (NULL (fetch (GRAPHNODE FROMNODES)
of Node))
(NOT (LISTP NodeID)))
(FMEMB NodeID RootNodeIDs)) collect NodeID)
(SUBST '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)))
(* ;;; "have to preserve windowprops since SHOWGRAPH messes with them")
(SETQ OldRepaintFn (WINDOWPROP Window 'REPAINTFN))
(SETQ OldRightButtonFn (WINDOWPROP Window 'RIGHTBUTTONFN))
(SETQ OldScrollFn (WINDOWPROP Window 'SCROLLFN))
(SETQ OldReshapeFn (WINDOWPROP Window 'RESHAPEFN))
(SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T (FUNCTION NC.GRAPHERCOPYBUTTONEVENTFN))
(* ;;; "Have to reset windowprops since SHOWGRAPH messes with them.")
(* ;
"Disable the old-style right button grapher editor menu.")
(WINDOWPROP Window 'RIGHTBUTTONFN OldRightButtonFn)
(WINDOWPROP Window 'REPAINTFN OldRepaintFn)
(WINDOWPROP Window 'SCROLLFN OldScrollFn)
(WINDOWPROP Window 'RESHAPEFN OldReshapeFn)
(NC.SetSubstance Card (WINDOWPROP Window 'GRAPH))
(NC.MarkCardDirty Card)
(NC.InstallTitleBarButtonEventFn Window (FUNCTION NC.TitleBarButtonEventFn))
(NC.InstallCopyButtonEventFn Window)
(NC.ClearMsg Window T])
(NC.LayoutNewBrowserNodes
(LAMBDA (RootNode NewNodes BrowserFormat SpecialBrowserSpecs)
(* rht%: " 5-Nov-86 17:41")
(* * Hold onto old location of RootNode.
Then layout the subgraph having root RootNode and lattice NewNodes.
Finally, translate the locations of NewNodes using old loc of RootNode.)
(* * rht 8/21/86%: LAYOUTGRAPH destroys FROMNODES of root node.
Now we save and restore these after LAYOUTGRAPH is called.)
(* * rht 11/5/86%: Now replaces ToNodes of each node with a subset consisting
only of nodes in NewNodes so LAYOUTGRAPH won't break.
Afterwards, puts the original list back.)
(DECLARE (GLOBALVARS NC.*Graph*BrowserFormat))
(LET ((OldRootNodePos (fetch (GRAPHNODE NODEPOSITION) of RootNode))
(Lattice (CONS RootNode NewNodes))
(FromNodes (fetch (GRAPHNODE FROMNODES) of RootNode))
NewRootNodePos)
(* Stash old ToNodes and replace with intersection of original ToNodes and
NewNodes.)
(for Node in Lattice do (LET ((NodeID (NC.CoerceToGraphNodeID Node))
(ToNodes (fetch (GRAPHNODE TONODES) of Node)))
(NC.GraphNodeIDPutProp NodeID 'OldToNodes ToNodes)
(replace (GRAPHNODE TONODES) of Node
with (for Node in ToNodes when (FASSOC Node Lattice)
collect Node))))
(LAYOUTGRAPH Lattice (LIST (fetch (GRAPHNODE NODEID) of RootNode))
(SUBST '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))
(* Restore FROMNODES of RootNode.)
(replace (GRAPHNODE FROMNODES) of RootNode with FromNodes)
(SETQ NewRootNodePos (fetch (GRAPHNODE NODEPOSITION) of RootNode))
(for Node in Lattice bind (XOffset ← (DIFFERENCE (fetch XCOORD of OldRootNodePos)
(fetch XCOORD of NewRootNodePos)))
(YOffset ← (DIFFERENCE (fetch YCOORD of OldRootNodePos)
(fetch YCOORD of NewRootNodePos)))
do (* Recover old list of ToNodes.)
(replace (GRAPHNODE TONODES) of Node with (NC.GraphNodeIDGetProp (
NC.CoerceToGraphNodeID
Node)
'OldToNodes))
(LET ((NodePos (fetch (GRAPHNODE NODEPOSITION) of Node)))
(replace (GRAPHNODE NODEPOSITION) of Node
with (create POSITION
XCOORD ← (PLUS XOffset (fetch XCOORD of NodePos))
YCOORD ← (PLUS YOffset (fetch YCOORD of NodePos)))))))))
(NC.ConnectNodesInBrowser
(LAMBDA (Window) (* rht%: "29-May-87 00:13")
(* * Draw any links, from the current link set, between any pairs of nodes
currently being shown in the browser.)
(* * rht 2/7/86%: Now gets and sets browser format, etc.
via fetch/set fns. Also fixed one last old call to GETPROPLIST on a NodeID.)
(* * rht 3/2/86%: Added WINDOWPROP for SCROLLFN and RESHAPEFN.)
(* * fgh |5/21/86| Updated reinstallation of title bar menus after SHOWGRAPH to
use new title bar menu mechanism.)
(* * rht 6/10/86%: Now calls NC.ShowBrowserGraph.)
(* * rht 11/1/86%: Added NC.ProtectedCardOperation wrapper and check for ops in
progress.)
(* * rg |3/4/87| rewritten for new version of NC.ProtectedCardOperation,
removed DontCheckOpInProgressFlg)
(* * rht 5/28/87%: Modified to handle cross-file links.)
(LET
((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Reconnect Browser Card" NIL
(PROG (LinkLabels Graph GraphNodes BrowserFormat DropVirtualNodesFlg NodeIDs)
(SETQ LinkLabels (NC.FetchBrowserLinkLabels Card))
(SETQ BrowserFormat (NC.FetchBrowserFormat Card))
(* 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 'GRAPH))))
(* Create hash array if haven't
already.)
(NC.GetBrowserHashArray Card Graph) (* check graph node size against image
box size.)
(NC.GraphLinkIconUpdateCheck Card 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 (NC.SmashGraphNodeIDProps (SETQ NodeID (NC.CoerceToGraphNodeID
Node)))
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 RealCard
do (for Link in (NC.RetrieveToLinks (SETQ RealCard (NC.CardFromBrowserNodeID NodeID)))
bind DestNodeID eachtime (BLOCK) when (NC.LinkLabelP Link LinkLabels)
when (LET ((DestCard (fetch (Link DestinationCard) of Link)))
(SETQ DestNodeID (NC.GetBrowserNodeID Card
(if (NC.CrossFileLinkCardP DestCard)
then (OR (NC.GetCrossFileLinkDestCard
DestCard Window)
DestCard)
else DestCard)))
(SETQ DestNodeID (for ID in NodeIDs when (NC.SameUIDP DestNodeID ID)
do (RETURN ID))))
do (NC.UIDAddProp NodeID DestNodeID (fetch (Link Label) of Link)
T))
(for Link in (NC.RetrieveFromLinks RealCard) bind SourceNodeID eachtime (BLOCK)
when (AND (NC.ReverseLinkLabelP Link LinkLabels)
(NOT (NC.LinkLabelP Link LinkLabels)))
when (LET ((SourceCard (fetch (Link SourceCard) of Link)))
(SETQ SourceNodeID (NC.GetBrowserNodeID
Card
(if (NC.CrossFileLinkCardP SourceCard)
then (OR (NC.GetCrossFileLinkDestCard
SourceCard Window)
SourceCard)
else SourceCard)))
(SETQ SourceNodeID (for ID in NodeIDs when (NC.SameUIDP SourceNodeID
ID)
do (RETURN ID))))
do (NC.UIDAddProp SourceNodeID NodeID (fetch (Link Label) 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 on (NC.ComputeBrowserSavedLinkingInfoForNode NodeID)
by (CDDR ToNodeID) eachtime (BLOCK)
collect (OR (for OldToNodeID in OldToNodeIDs
thereis (AND (LISTP OldToNodeID)
(EQ (CAR ToNodeID)
(CAR OldToNodeID))
OldToNodeID))
(CAR ToNodeID)))
(for ToNodeID in OldToNodeIDs eachtime (BLOCK)
unless (NC.SameCardP Card (NC.CardFromBrowserNodeID (
NC.CoerceToGraphNodeID
ToNodeID)))
collect ToNodeID))))
(NC.RebuildFromNodesInGraph GraphNodes)
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(* Display the graph.)
(NC.ShowBrowserGraph Graph Window)
(NC.SetSubstance Card (WINDOWPROP Window 'GRAPH))
(NC.MarkCardDirty Card)
(NC.ClearMsg Window T))))))
(NC.UnconnectNodesInBrowser
(LAMBDA (Window) (* Randy.Gobbel " 4-Mar-87 13:51")
(* * Remove all the links in the browser.)
(* * rht 11/17/85%: Now handles new card and notefile objects.)
(* * rht 2/7/86%: Now gets and sets browser format, etc.
via fetch/set fns.)
(* * fgh |5/21/86| Updated reinstallation of title bar menus after SHOWGRAPH to
use new title bar menu mechanism.)
(* * rht 6/10/86%: Now calls NC.ShowBrowserGraph.)
(* * rht 11/1/86%: Added NC.ProtectedCardOperation wrapper and check for ops in
progress.)
(* * rg |3/4/87| rewritten for new version of NC.ProtectedCardOperation,
removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation Card "Unconnect Browser Card" NIL
(PROG (Graph GraphNodes BrowserFormat DropVirtualNodesFlg)
(SETQ BrowserFormat (NC.FetchBrowserFormat Card))
(* 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
'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 (NC.SmashGraphNodeIDProps NodeID)
(replace (GRAPHNODE TONODES) of Node with NIL)
(replace (GRAPHNODE FROMNODES) of Node with NIL))
(NC.MakeLinksLegend Graph Window DropVirtualNodesFlg)
(* Display the graph.)
(NC.ShowBrowserGraph Graph Window)
(NC.SetSubstance Card (WINDOWPROP Window 'GRAPH))
(NC.MarkCardDirty Card)
(NC.SetBrowserLinksLegend Card NIL)
(NC.ClearMsg Window T))))))
(NC.ExpandBrowserNode
[LAMBDA (Window) (* ; "Edited 29-Jul-88 20:25 by Trigg")
(* ;;; "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.")
(* ;; "rht 2/7/86: Now gets and sets browser format, etc. via fetch/set fns.")
(* ;; "rht 6/10/86: No longer does relayout after expand. Uses NC.LayoutNewBrowserNodes to compute proper locations of new nodes. Also calls NC.ShowBrowserGraph.")
(* ;; "rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.")
(* ;;
"rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg")
(* ;; "rht 5/26/87: Now handles cross-file links properly, i.e. uses cross-file link standin in cases when GrowLinkLattice wasn't able to follow into the remote notefile.")
(* ;; "rht 7/29/88: No longer calls NC.SetPropListDirtyFlg")
(LET
((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Expand Node of Browser Card" NIL
(PROG (NodeToExpand LinkLabels RootCards RootNodes Lattice LinkIcon OldToNodePairs Graph
GraphNodes NodeLabel OldNode Link BrowserSpecs BrowserFormat DropVirtualNodesFlg
Depth SpecialBrowserSpecs SavedLabelNodes NewNodes)
(SETQ RootCards (NC.FetchBrowserRoots Card))
(SETQ LinkLabels (NC.FetchBrowserLinkLabels Card))
(SETQ BrowserFormat (NC.FetchBrowserFormat Card))(* ;
"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 (NC.FetchSpecialBrowserSpecs Card)
(create SPECIALBROWSERSPECS)))
[SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP Window 'GRAPH]
(* ;
"If there aren't any nodes in graph, then get out pronto.")
(if (NULL GraphNodes)
then (NC.PrintMsg Window T "No nodes to expand.")
(DISMISS 1000)
(NC.ClearMsg Window T)
(RETURN NIL)) (* ;
"Create hash array if haven't already.")
(NC.GetBrowserHashArray Card Graph)
(NC.PrintMsg Window T "Pick node to expand." (CHARACTER 13))
(* ;
"Note call to the grapher function READ/NODE to select a graph node.")
(SETQ NodeToExpand (READ/NODE GraphNodes Window))(* ; "Can't expand a label node.")
(if (NOT (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of NodeToExpand)))
then (NC.PrintMsg NIL T "Sorry, can't expand a label node.")
(FLASHW PROMPTWINDOW)
(NC.ClearMsg Window T)
(RETURN))
(SETQ Depth (MKATOM (NC.AskUser "Depth to expand (type integer or INF): " "--" 1 T Window
NIL NIL T)))
(COND
((EQ Depth 'INF)
(SETQ Depth MAX.FIXP))
((NOT (AND (FIXP Depth)
(GREATERP Depth 0)))
(NC.PrintMsg Window T "Depth must be an integer greater than 0 or INF.")
(RETURN)))
(NC.PrintMsg Window T (CHARACTER 13)
"Augmenting browser graph. Please wait. ...")
(* ;; "Save the nodes pointed to by the chosen node that are label nodes. GrowLinkLattice will trash those, so we restore afterwards.")
(SETQ SavedLabelNodes (for ToNode in (fetch (GRAPHNODE TONODES) of NodeToExpand)
eachtime (BLOCK) when (AND (NOT (EQ (CAR ToNode)
LINKPARAMS))
(NOT (NC.LinkIconImageObjP ToNode)))
collect ToNode)) (* ;
"Increase link lattice from chosen node to given depth.")
(SETQ Lattice (NC.GrowLinkLattice (LIST (NC.CardFromBrowserNodeID (fetch (GRAPHNODE
NODEID)
of NodeToExpand)))
(APPEND GraphNodes)
LinkLabels Card Depth))
[AND SavedLabelNodes (replace (GRAPHNODE TONODES) of NodeToExpand
with (APPEND SavedLabelNodes (fetch (GRAPHNODE TONODES)
of NodeToExpand]
(SETQ RootNodes (for RootCard in RootCards collect (NC.GetBrowserNodeID Card RootCard)))
(* ;
"Create Links for all nodes in the new browser graph but not in the old one.")
[for Node in Lattice bind NodeID (CrossFileLinkModePropList ← (LIST (fetch (Card NoteFile
)
of Card)
NIL))
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 (LET (NewLink)
(if [AND (NOT (NC.CrossFileLinkCardP (fetch (GRAPHNODE NODELABEL
)
of Node)))
(SETQ NewLink (NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
Card NIL NIL NIL NIL NIL
(NC.ComputeCrossFileLinkMode
(fetch (GRAPHNODE NODELABEL)
of Node)
CrossFileLinkModePropList Window]
then (NC.MakeLinkIcon NewLink)
else (NC.MakeCrossFileLinkIconStandIn (fetch (GRAPHNODE
NODELABEL)
of Node]
(* ; "Make a list of all new nodes.")
(push NewNodes Node))) (* ; "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.")
(NC.GraphNodeIDRemProp NodeID 'TouchedFlg)
(NC.GraphNodeIDRemProp NodeID '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.")
(NC.GraphNodeIDPutProp NodeID ToNodeID
(for LabelPair in (NC.GraphNodeIDGetProp NodeID
ToNodeID)
collect (OR (CAR LabelPair)
LabelPair)))
(NC.GraphNodeIDPutProp ToNodeID NodeID
(for LabelPair in (NC.GraphNodeIDGetProp
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)
(AND NewNodes (NC.LayoutNewBrowserNodes NodeToExpand NewNodes BrowserFormat
SpecialBrowserSpecs))
(replace (GRAPH GRAPHNODES) of Graph with Lattice)
(* ;
"Build links legend and fix up TONODES in the graph.")
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(WINDOWPROP Window 'GRAPH Graph) (* ; "Display the graph.")
(NC.ShowBrowserGraph Graph Window)
(NC.SetSubstance Card Graph)
(NC.MarkCardDirty Card)
(NC.ClearMsg Window T])
(NC.AskBrowserSpecs
[LAMBDA (MainWindow BrowserCard OldLinkLabels OldDepth OldFormat CreatingBrowserFlg Don'tAskFlg)
(* ; "Edited 21-Oct-88 14:12 by RAR")
(* ;; "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.")
(* ;; "rht 11/17/85: Updated for new card and notefile objects.")
(* ;; "pmi 4/2/87: Added NC.MenuFont to all menus.")
(* ;; "rht 1/23/88: Now uses OmitLinkLabelsFlg taken off user data props to decide whether link choices appear in stylesheet.")
(* ;; "RAR 10/21/88 Fixed so that if you can pass ALL or ←ALL (and it actually works like the documentation says...)")
(DECLARE (GLOBALVARS NC.MenuFont MENUFONT NC.BrowserFormatOptions))
(PROG ((LinkLabels (NC.RetrieveLinkLabels (fetch (Card NoteFile) of BrowserCard)
T))
(OmitLinkLabelsFlg (NC.FetchUserDataProp BrowserCard 'OmitLinkLabelsFromBrowserSpecsFlg))
Position Choices ReverseFlg DepthMenu FormatMenu OrientationMenu DepthSelection
FormatSelection OrientationSelection) (* ;
"Replace ALL and/or ←ALL with the actual lists of linklabels and backlinklabels in oldLinkLabels. ")
(SETQ OldLinkLabels (LSUBST LinkLabels 'ALL (LSUBST (NCP.ReverseLinkTypes
(fetch (Card NoteFile)
of BrowserCard))
'←ALL
OldLinkLabels)))
[if Don'tAskFlg
then (RETURN (LIST (OR OldLinkLabels LinkLabels)
(OR OldDepth 99999)
(OR OldFormat '(LATTICE]
[SETQ Position (AND (WINDOWP MainWindow)
(create POSITION
XCOORD ← (fetch (REGION LEFT) of (WINDOWPROP
MainWindow
'REGION))
YCOORD ← (fetch (REGION TOP) of (WINDOWREGION MainWindow
]
(if CreatingBrowserFlg
then (SETQ OldLinkLabels LinkLabels))
(SETQ ReverseFlg (EQ (CADDR OldFormat)
'REVERSE))
(SETQ DepthMenu (create MENU
ITEMS ←
'(0 1 2 3 4 5 6 7 8 9 INF)
MENUFONT ← NC.MenuFont))
(SETQ DepthSelection (if (OR (NOT (FIXP OldDepth))
(IGREATERP OldDepth 9)
(ILESSP OldDepth 0))
then 'INF
else OldDepth))
(SETQ FormatMenu (create MENU
ITEMS ← NC.BrowserFormatOptions
MENUFONT ← NC.MenuFont))
(SETQ FormatSelection (OR (CAR (FASSOC (CAR OldFormat)
NC.BrowserFormatOptions))
'LATTICE))
(SETQ OrientationMenu (create MENU
ITEMS ← '(Horizontal Vertical Reverse/Horizontal
Reverse/Vertical)
MENUFONT ← NC.MenuFont))
[SETQ OrientationSelection (if (EQ (CADR OldFormat)
'VERTICAL)
then (if ReverseFlg
then 'Reverse/Vertical
else 'Vertical)
else (if ReverseFlg
then 'Reverse/Horizontal
else 'Horizontal]
[SETQ Choices (COND
(OmitLinkLabelsFlg (STYLESHEET (CREATE.STYLE 'ITEMS (LIST DepthMenu
FormatMenu
OrientationMenu)
'SELECTIONS
(LIST DepthSelection FormatSelection
OrientationSelection)
'ITEM.TITLES
'(Depth Format Orientation)
'NEED.NOT.FILL.IN
'(NIL NIL NIL)
'POSITION Position 'ITEM.TITLE.FONT
(FONTCOPY MENUFONT 'WEIGHT
'BOLD)
'TITLE "Browser Specs?")))
(T (STYLESHEET (CREATE.STYLE
'ITEMS
(LIST (create MENU
ITEMS ← LinkLabels
MENUFONT ← NC.MenuFont)
(create MENU
ITEMS ← (for Link in LinkLabels
collect (PACK* '← Link))
MENUFONT ← NC.MenuFont)
DepthMenu FormatMenu OrientationMenu)
'SELECTIONS
(LIST (for Label in OldLinkLabels
when (NEQ (NTHCHAR Label 1)
'←) collect Label)
(for Label in OldLinkLabels
when (EQ (NTHCHAR Label 1)
'←) collect Label)
DepthSelection FormatSelection OrientationSelection)
'ITEM.TITLES
'(Forward% Links Backward% Links Depth Format Orientation)
'NEED.NOT.FILL.IN
'(MULTI MULTI NIL NIL NIL)
'POSITION Position 'ITEM.TITLE.FONT (FONTCOPY MENUFONT
'WEIGHT
'BOLD)
'TITLE "Browser Specs?"]
[if (AND OmitLinkLabelsFlg Choices)
then (SETQ Choices `(,OldLinkLabels NIL ,@Choices]
(RETURN (COND
[Choices (LIST (APPEND (CAR Choices)
(CADR Choices))
(OR (FIXP (CADDR Choices))
MAX.FIXP)
(CONS (CADDDR Choices)
(SELECTQ (CADDDR (CDR Choices))
(Horizontal (LIST 'HORIZONTAL 'REVERSE/DAUGHTERS))
(Vertical (LIST 'VERTICAL NIL))
(Reverse/Horizontal
(LIST 'HORIZONTAL 'REVERSE 'REVERSE/DAUGHTERS))
(Reverse/Vertical
(LIST 'VERTICAL 'REVERSE))
NIL]
(CreatingBrowserFlg NIL)
(T (LIST OldLinkLabels OldDepth OldFormat])
(NC.ChangeBrowserSpecs
[LAMBDA (Window) (* ; "Edited 29-Jul-88 20:25 by Trigg")
(* ;;; "Change the values of the various browser specs including link types, browser format, search depth, etc.")
(* ;; "rht 11/17/85: Updated for new card and notefile objects.")
(* ;; "rht 2/7/86: Now sets and gets browser link labels, etc. via fetch/set fns.")
(* ;; "rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.")
(* ;;
"rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg")
(* ;; "rht 7/29/88: No longer calls NC.SetPropListDirtyFlg")
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation Card "Browser Specs" NIL (PROG (LinkLabels RootNodes BrowserSpecs
BrowserFormat Depth)
(SETQ LinkLabels (
NC.FetchBrowserLinkLabels
Card))
(SETQ BrowserFormat (
NC.FetchBrowserFormat
Card))
(SETQ Depth (NC.FetchBrowserDepth
Card))
(SETQ BrowserSpecs
(NC.AskBrowserSpecs Window Card
LinkLabels Depth
BrowserFormat))
(SETQ LinkLabels (CAR BrowserSpecs
))
(SETQ Depth (CADR BrowserSpecs))
(SETQ BrowserFormat (CADDR
BrowserSpecs
))
(NC.SetBrowserLinkLabels Card
LinkLabels)
(NC.SetBrowserFormat Card
BrowserFormat)
(NC.SetBrowserDepth Card 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.BrowserFlipRoots
(LAMBDA (Window GraphCard GraphNodes RootCards) (* rht%: "18-Nov-85 21:08")
(* * Flip to reverse video for each root node in the graph.)
(* * rht 11/17/85%: updated to handle new card and notefile objects.)
(for RootCard in RootCards bind RootNode do (SETQ RootNode (FASSOC (NC.GetBrowserNodeID GraphCard
RootCard)
GraphNodes))
(AND RootNode (FLIPNODE RootNode Window)))))
(NC.ChangeBrowserRoots
[LAMBDA (Window) (* ; "Edited 29-Jul-88 20:12 by Trigg")
(* ;; "Change which nodes in the browser are considered roots, e.g. for purposes of recompute.")
(LET ((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation Card "Respecify browser roots" NIL
(LET (NewRootCards)
(SETQ NewRootCards (NC.RespecifyBrowserRoots Card (NC.FetchBrowserRoots Card)
(fetch (GRAPH GRAPHNODES) of (WINDOWPROP Window
'GRAPH))
Window))
(if (LISTP NewRootCards)
then (NC.SetBrowserRoots Card NewRootCards)
(NC.MarkCardDirty Card))
NewRootCards])
(NC.RespecifyBrowserRoots
[LAMBDA (BrowserCard CurrentRootCards GraphNodes Window) (* ; "Edited 29-Jul-88 20:31 by Trigg")
(* ;; "Let user select a new set of root nodes in the browser.")
(DECLARE (GLOBALVARS NC.SelectingBrowserSourceMenu))
(NC.BrowserFlipRoots Window BrowserCard GraphNodes CurrentRootCards)
(PROG1 (NC.SelectNoteCards NIL NIL NC.SelectingBrowserSourceMenu Window (CONCAT
"Please shift-select the Cards and/or Boxes the browser should start from."
(CHARACTER 13)
"(Current roots are highlighted.)"
)
T)
(NC.BrowserFlipRoots Window BrowserCard GraphNodes CurrentRootCards])
(NC.SelectGraphNode
[LAMBDA (Window Graph Mess) (* ; "Edited 22-Jan-88 18:04 by Trigg")
(* ;; "User selects a node from the browser. The node is inverted and returned.")
(* ;; "rht 1/19/88: Now prints message to window and also checks to make sure that cursor is inside region of node before pronouncing it a valid selection.")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(CLRPROMPT)
(PROG (NODE)
(COND
((NOT (fetch (GRAPH GRAPHNODES) of Graph))
(PROMPTPRINT " No nodes in graph.")
(RETURN)))
(NC.PrintMsg Window T Mess)
(SETQ NODE (READ/NODE (fetch (GRAPH GRAPHNODES) of Graph)
Window))
(NC.ClearMsg Window T)
(if (NC.CursorInsideGraphNodeP NODE Window)
then (FLIPNODE NODE Window)
(RETURN NODE)
else (RETURN NIL])
(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%: " 6-Jul-86 17:28")
(* * There should be no virtual nodes or link param thingies.
This removes duplicate nodes coalescing their TONODES.)
(LET (DeletedNodeIDs)
(SETQ GraphNodes (for Node in GraphNodes bind NodeID AlreadyVisitedFlg
eachtime (BLOCK)
(SETQ NodeID (NC.CoerceToGraphNodeIDOrLabel Node))
(if (AND (SETQ AlreadyVisitedFlg (NC.GraphNodeIDGetProp
NodeID
'AlreadyVisitedFlg))
(NOT (FMEMB NodeID DeletedNodeIDs)))
then (push DeletedNodeIDs NodeID))
(NC.GraphNodeIDPutProp NodeID 'CumulativeToNodesList
(UNION (NC.GraphNodeIDGetProp NodeID 'CumulativeToNodesList
)
(fetch (GRAPHNODE TONODES) of Node))) unless
AlreadyVisitedFlg
collect (NC.GraphNodeIDPutProp NodeID 'AlreadyVisitedFlg T)
Node))
(for NodeID in DeletedNodeIDs bind GraphNode do (SETQ GraphNode (FASSOC NodeID GraphNodes))
(replace (GRAPHNODE TONODES) of GraphNode
with (NC.GraphNodeIDGetProp NodeID
'CumulativeToNodesList)))
(for Node in GraphNodes bind NodeID do (NC.GraphNodeIDRemProp (SETQ NodeID (
NC.CoerceToGraphNodeIDOrLabel
Node))
'CumulativeToNodesList)
(NC.GraphNodeIDRemProp NodeID 'AlreadyVisitedFlg))
GraphNodes)))
(NC.ShowBrowserGraph
[LAMBDA (Graph Window) (* ; "Edited 29-Sep-88 10:59 by jrc")
(* * SHOWGRAPH Graph in Window.)
(* * rht 5/13/87%: Added call to NC.InstallCopyButtonEventFn.)
(* * rht 10/13/87%: Added COPYBUTTONEVENTFN arg to SHOWGRAPH to fix bug reported
by John Tang.)
(* * jrc 28-sep-88 Saves various WINDOWPROPs that SHOWGRAPH seems to smash.
The original code made assumptions about what the value of each of the
WINDOWPROPs was.)
(LET [(OldRepaintFn (WINDOWPROP Window 'REPAINTFN))
(OldRightButtonFn (WINDOWPROP Window 'RIGHTBUTTONFN))
(OldScrollFn (WINDOWPROP Window 'SCROLLFN))
(OldReshapeFn (WINDOWPROP Window 'RESHAPEFN]
(SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T (FUNCTION NC.GRAPHERCOPYBUTTONEVENTFN))
(* * Have to reset windowprops since SHOWGRAPH messes with them.)
(* Disable the old-style right button
grapher editor menu.)
(WINDOWPROP Window 'RIGHTBUTTONFN OldRightButtonFn)
(WINDOWPROP Window 'REPAINTFN OldRepaintFn)
(WINDOWPROP Window 'SCROLLFN OldScrollFn)
(WINDOWPROP Window 'RESHAPEFN OldReshapeFn)
(NC.InstallTitleBarButtonEventFn Window (FUNCTION NC.TitleBarButtonEventFn))
(NC.InstallCopyButtonEventFn Window])
)
(* ;;; "Graph editor menu functions.")
(DEFINEQ
(NC.SetUpGraphEditMenus
[LAMBDA (Window) (* ; "Edited 13-May-88 21:52 by Trigg")
(* ;; "Create the %"fixed%" and %"unfixed%" menus for browser cards and set them up on the window unless they already exist.")
(DECLARE (GLOBALVARS NC.MenuFont NC.GraphEditMenuItems NC.GraphEditUnfixedMenuItems))
(* ; "Edited 13-May-88 21:48 by Trigg")
(LET [(GraphEditUnfixableMenu (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU))
(GraphEditFixableMenu (WINDOWPROP Window 'GRAPHEDITFIXABLEMENU]
[OR GraphEditUnfixableMenu (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU
(SETQ GraphEditUnfixableMenu
(create MENU
ITEMS ← NC.GraphEditMenuItems
TITLE ← "Editor Menu"
WHENSELECTEDFN ← (FUNCTION
NC.GraphEditMenuWhenSelectedFn)
CHANGEOFFSETFLG ← T
CENTERFLG ← T
MENUOFFSET ← (CONS -1 0)
MENUFONT ← NC.MenuFont
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont
'HEIGHT)
1]
(OR GraphEditFixableMenu (WINDOWPROP Window 'GRAPHEDITFIXABLEMENU
(SETQ GraphEditFixableMenu
(create MENU using GraphEditUnfixableMenu ITEMS ←
NC.GraphEditUnfixedMenuItems])
(NC.GetGraphEditMenu
[LAMBDA (Window) (* ; "Edited 13-May-88 21:55 by Trigg")
(* ;; "Create, if necessary, and bring up the graph editor menu.")
(* ;; "pmi 3/25/87: Added NC.MenuFont to all menus")
(* ;; "rht 1/14/88: Now ensures that both menus are computed rather than just the one needed.")
(* ;; "dwm 1/27/88: Added ReadOnly stuff")
(* ;; "rht 3/3/88: Fixed bug in dwm fix. Card var was unbound.")
(* ;; "rht 5/13/88: Now calls NC.SetUpGraphEditMenus to build menus and stash on window rather than doing it in line.")
(NC.SetUpGraphEditMenus Window)
(LET ((GraphEditUnfixableMenu (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU))
(GraphEditFixableMenu (WINDOWPROP Window 'GRAPHEDITFIXABLEMENU))
(Card (NC.CoerceToCard Window))
GraphEditUnfixableMenu GraphEditFixableMenu GraphEditFixedMenuWin)
(* ;; "If menu is already up, then put up a menu without the FIXMENU option, otherwise, allow user to fix menu.")
(if [SETQ GraphEditFixedMenuWin (for Win in (ATTACHEDWINDOWS Window)
thereis (AND (OPENWP Win)
(WINDOWPROP Win 'GRAPHEDITMENUFLG]
then (if (NC.FetchUserDataProp Card 'ReadOnly)
then (REMOVEWINDOW GraphEditFixedMenuWin)
(WINDOWPROP Window 'RIGHTBUTTONFN NIL)
else (PUTMENUPROP GraphEditUnfixableMenu 'MAINWINDOW Window)
(MENU GraphEditUnfixableMenu))
else (if (NC.FetchUserDataProp Card 'ReadOnly)
then (WINDOWPROP Window 'RIGHTBUTTONFN NIL)
else (PUTMENUPROP GraphEditFixableMenu 'MAINWINDOW Window)
(MENU GraphEditFixableMenu])
(NC.BrowserRightButtonFn
(LAMBDA (Window) (* rht%: "17-Nov-85 21:18")
(* * Causes grapher editor menu to come up on right button.
If menu is already fixed then brings up menu without FIXMENU item.)
(if (INSIDE? (DSPCLIPPINGREGION NIL Window)
(LASTMOUSEX Window)
(LASTMOUSEY Window))
then (NC.GetGraphEditMenu Window)
else (DOWINDOWCOM Window))))
(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 '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 '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 '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 'GRAPH) with (FUNCTION NC.BrowserAddNode))
(EDITADDNODE Window)))
(NC.BrowserCreateLinkFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:49")
(* * Called from graph edit menu to create link and edge.)
(* * rht 4/20/87%: No longer calls EDITAPPLYTOLINK if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITAPPLYTOLINK (FUNCTION NC.BrowserAddLink)
'added
(WINDOWPROP Window 'GRAPH)
Window)
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't create links: graph has no nodes.")))))
(NC.BrowserCreateGlobalLinkFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:50")
(* * Called from graph edit menu to create a global link and edge.)
(* * rht 4/20/87%: No longer calls EDITAPPLYTOLINK if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITAPPLYTOLINK (FUNCTION NC.BrowserAddGlobalLink)
'added
(WINDOWPROP Window 'GRAPH)
Window)
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't create global links: graph has no nodes.")))))
(NC.BrowserAddLink
[LAMBDA (FromNode ToNode Win Graph GlobalLinkFlg LinkType) (* ; "Edited 28-Sep-88 18:54 by jrc")
(* ;;
"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.")
(* ;; "rht 11/17/85: updated for new card and notefile object format.")
(* ;; "rht 2/7/86: Now sets and gets browser link labels, etc. via fetch/set fns.")
(* ;; "rht 1/14/88: Now takes extra LinkType argument and passes to NC.BrowserCreateLink.")
(* ;; "jrc 8/sep/88: returns link, if one is created. ")
(PROG ((MaxDashingStylesNum (LENGTH NC.DashingStyles))
Link Card LabelPairs LabelPair 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 LinkType))
(* ;
"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 Card (NC.CoerceToCard Win))
(SETQ LabelPairs (NC.FetchBrowserLinksLegend Card))
(SETQ LinkType (fetch (Link Label) 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 LinkType LabelPairs)))
then [SETQ LabelPairs (APPEND LabelPairs
(LIST (SETQ LabelPair
(CONS LinkType (COND
((ILESSP (SETQ LabelNum
(LENGTH
LabelPairs
))
MaxDashingStylesNum
)
(SETQ LabelNum
(ADD1 LabelNum)))
(T LabelNum]
(NC.SetBrowserLinksLegend Card LabelPairs)
(NC.MakeLinksLegendMenu Win LabelPairs))
(SETQ FromNodeID (NC.CoerceToGraphNodeID FromNode))
(SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode))
[SETQ NumberOfLinks (PLUS (LENGTH (NC.GraphNodeIDGetProp FromNodeID ToNodeID))
(LENGTH (NC.GraphNodeIDGetProp 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)
'DRAWLINKFN
(FUNCTION NC.BrowserDrawLinkFn)
'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 'NODEID FromNodeID '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 'NODEID ToNodeID 'DESTNODEID FromNodeID]
(NC.UIDAddProp 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 Link])
(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%: "20-Apr-87 12:51")
(* * Called from graph edit menu to create edge.)
(* * rht 4/20/87%: No longer calls EDITAPPLYTOLINK if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITAPPLYTOLINK (FUNCTION NC.BrowserAddEdge)
'added
(WINDOWPROP Window 'GRAPH)
Window)
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't add edges: graph has no nodes.")))))
(NC.BrowserDeleteCardFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:35")
(* * Called from graph edit menu to delete card and node.)
(* * rht 4/20/87%: No longer calls NC.BrowserRemoveNode if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(replace (GRAPH GRAPH.DELETENODEFN) of Graph with NIL)
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (NC.BrowserRemoveNode Graph Window T)
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't delete card/node: graph has no nodes.")))))
(NC.BrowserRemoveNodeFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:35")
(* * Called from graph edit menu to delete a browser node.)
(* * rht 4/20/87%: No longer calls NC.BrowserRemoveNode if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(replace (GRAPH GRAPH.DELETENODEFN) of Graph with NIL)
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (NC.BrowserRemoveNode Graph Window)
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't remove node: graph has no nodes.")))))
(NC.BrowserDeleteLinkFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:39")
(* * Called from graph edit menu to delete link and edge.)
(* * rht 4/20/87%: No longer calls EDITMOVENODE if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITAPPLYTOLINK (FUNCTION NC.BrowserDeleteLink)
'deleted
(WINDOWPROP Window 'GRAPH)
Window)
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't delete link/edge: graph has no nodes.")))))
(NC.BrowserRemoveEdgeFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:39")
(* * Called from graph edit menu to remove browser edge.)
(* * rht 4/20/87%: No longer calls EDITAPPLYTOLINK if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITAPPLYTOLINK (FUNCTION NC.BrowserRemoveEdge)
'removed
(WINDOWPROP Window 'GRAPH)
Window)
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't remove edges: graph has no nodes.")))))
(NC.BrowserShrinkLabelFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:52")
(* * Shrink a browser label font.)
(* * rht 4/20/87%: No longer calls EDITCHANGEFONT if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITCHANGEFONT 'SMALLER Window)
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't shrink label: graph has no nodes.")))))
(NC.BrowserGrowLabelFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:52")
(* * Increase a browser label font.)
(* * rht 4/20/87%: No longer calls EDITCHANGEFONT if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITCHANGEFONT 'LARGER Window)
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't expand label: graph has no nodes.")))))
(NC.BrowserMoveNodeFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:36")
(* * Move a browser node)
(* * rht 4/20/87%: No longer calls EDITMOVENODE if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITMOVENODE Window)
(NC.MarkCardDirty (NC.CoerceToCard Window))
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't move nodes: graph has no nodes.")))))
(NC.CursorInsideGraphNodeP
[LAMBDA (GraphNode Window) (* ; "Edited 19-Jan-88 18:58 by Trigg")
(* ;; "Return non-nil if current cursor position is inside the region of GraphNode.")
(LET ((NodePosition (fetch (GRAPHNODE NODEPOSITION) of GraphNode))
(NodeHeight (fetch (GRAPHNODE NODEHEIGHT) of GraphNode))
(NodeWidth (fetch (GRAPHNODE NODEWIDTH) of GraphNode)))
(INSIDEP (CREATEREGION (DIFFERENCE (fetch (POSITION XCOORD) of NodePosition)
(LRSH NodeWidth 1))
(DIFFERENCE (fetch (POSITION YCOORD) of NodePosition)
(LRSH NodeHeight 1))
NodeWidth NodeHeight)
(CURSORPOSITION NIL Window])
(NC.BrowserMoveNodesInRegionFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:45")
(* * Move all the browser nodes in a region.)
(* * rht 4/20/87%: No longer calls EDITMOVEREGION if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITMOVEREGION Window)
(NC.MarkCardDirty (NC.CoerceToCard Window))
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't move nodes: graph has no nodes.")))))
(NC.BrowserMoveSubtreeFn
(LAMBDA (Window) (* rht%: "20-Apr-87 12:45")
(* * Move a browser node and all its descendents.)
(* * rht 4/20/87%: No longer calls EDITMOVESUBTREE if graph has no nodes.)
(LET ((Graph (WINDOWPROP Window 'GRAPH)))
(if (fetch (GRAPH GRAPHNODES) of Graph)
then (EDITMOVESUBTREE Window)
(NC.MarkCardDirty (NC.CoerceToCard Window))
else (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "Can't move nodes: graph has no nodes.")))))
(NC.BrowserFixGraphEditMenuFn
[LAMBDA (Window) (* ; "Edited 14-Jan-88 20:50 by Trigg")
(* ;;
"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.")
(* ;; "rht 3/3/86: Now does some 'random' WINDOWPROPS to make reshaping browser not screw up the attached menu.")
(* ;; "rht 3/7/86: Uses ATTACHMENU to attach the menu.")
(* ;; "pmi 3/25/87: Added NC.MenuFont to all menus")
(* ;;
"rht 1/14/88: Now copies existing menu hung off window rather than building new one from scratch.")
(DECLARE (GLOBALVARS NC.MenuFont))
(LET (GraphEditMenu GraphEditMenuWin)
[SETQ GraphEditMenu (create MENU using (WINDOWPROP Window 'GRAPHEDITUNFIXABLEMENU]
(PUTMENUPROP GraphEditMenu 'MAINWINDOW Window)
(SETQ GraphEditMenuWin (ATTACHMENU GraphEditMenu Window 'RIGHT 'BOTTOM))
(* ;
"Rig so that close of menu won't close browser.")
(WINDOWDELPROP GraphEditMenuWin 'PASSTOMAINCOMS 'CLOSEW)
(WINDOWPROP GraphEditMenuWin 'GRAPHEDITMENUFLG T)
(WINDOWADDPROP GraphEditMenuWin 'CLOSEFN [FUNCTION (LAMBDA (W)
(DETACHWINDOW W]
T])
(NC.BrowserCreateCard
(LAMBDA (Graph Window) (* rht%: "20-Apr-87 15:03")
(* * Called from grapher ADDNODE fn. Used to create a new card and
corresponding browser node.)
(* * Rht 11/17/85%: updated for new card and notefile objects.)
(* * rht 4/30/86%: Now only computes title if got a link.)
(* * rht 4/20/87%: Added ProtectedCardOperation wrapper and call to
ALLOW.BUTTON.EVENTS.)
(LET ((GraphCard (NC.CoerceToCard Window))
Link GraphNodeID Card Title)
(NC.ProtectedCardOperation GraphCard "Create card from browser" Window
(SETQ Link (NC.MakeLink Window NC.BrowserContentsLinkLabel '*New% Card* GraphCard NIL
NIL NIL T))
(if Link
then (SETQ Title (NC.RetrieveTitle (SETQ Card (fetch (Link DestinationCard)
of Link))))
(ALLOW.BUTTON.EVENTS)
(NC.SetTitle Card (OR (NC.AskUser "Title of new card: " NIL
(if (STREQUAL "Untitled" Title)
then NIL
else Title)
T Window)
"Untitled")) (* Create hash array if haven't
already.)
(NC.GetBrowserHashArray GraphCard Graph)
(SETQ GraphNodeID (NC.GetBrowserNodeID GraphCard Card))
(NC.MarkCardDirty GraphCard)
(NODECREATE GraphNodeID (NC.MakeLinkIcon Link)
(CURSORPOSITION NIL Window))
else NIL)))))
(NC.BrowserCreateLink
[LAMBDA (FromNode ToNode Graph Window GlobalLinkFlg LinkType)
(* ; "Edited 11-May-88 23:03 by Trigg")
(* ;; "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.")
(* ;; "rht 11/17/85: Updated to hancdle new card and notefile formats.")
(* ;; "rht 1/14/88: Now takes extra LinkType argument.")
(* ;; "rht 5/11/88: Now checks whether link was successfully created before returning it.")
(DECLARE (GLOBALVARS PROMPTWINDOW NC.FiledCardLinkLabel NC.SubBoxLinkLabel))
(LET ((GraphCard (NC.CoerceToCard Window))
SourceCard DestinationCard Link)
(if (EQ FromNode ToNode)
then (NC.PrintMsg NIL T "Can't create a link from node to itself.")
(FLASHW PROMPTWINDOW)
NIL
else (NC.MarkCardDirty GraphCard)
(SETQ SourceCard (NC.CardFromBrowserNodeID (NC.CoerceToGraphNodeID FromNode)))
(SETQ DestinationCard (NC.CardFromBrowserNodeID (NC.CoerceToGraphNodeID ToNode)))
[OR LinkType (SETQ LinkType (COND
((AND (NOT GlobalLinkFlg)
(NC.FileBoxP SourceCard T))
(COND
((NC.FileBoxP DestinationCard T)
NC.SubBoxLinkLabel)
(T NC.FiledCardLinkLabel)))
(T (NC.AskLinkLabel Window NIL NIL T T]
(AND LinkType [NC.ValidLinkP (SETQ Link (COND
((AND (NOT GlobalLinkFlg)
(NC.TEditBasedP SourceCard))
(NCP.LocalGlobalLink LinkType SourceCard
DestinationCard 'END))
(T (NCP.GlobalGlobalLink LinkType
SourceCard DestinationCard]
Link])
(NC.BrowserDeleteLink
(LAMBDA (FromNode ToNode Window Graph) (* ; "Edited 3-Dec-87 19:01 by rht:")
(* * Called by grapher when user deletes a link.)
(* * rht 11/17/85%: updated to handle new card and notefile formats.)
(* * pmi 3/25/87%: Added NC.MenuFont to all menus)
(DECLARE (GLOBALVARS NC.MenuFont))
(PROG ((GraphCard (NC.CoerceToCard Window))
SourceCard SourceType DestinationCard LinkLabel 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 SourceCard (NC.CardFromBrowserNodeID (SETQ FromNodeID (NC.CoerceToGraphNodeID
FromNode))))
(SETQ DestinationCard (NC.CardFromBrowserNodeID (SETQ ToNodeID (NC.CoerceToGraphNodeID
ToNode))))
(SETQ Links (NCP.GetLinks SourceCard DestinationCard))
(SETQ LabelPairs (NC.GraphNodeIDGetProp FromNodeID ToNodeID))
(SETQ ExistingLabels (for Link in Links collect (fetch (Link Label) of Link)))
(NC.MarkCardDirty GraphCard)
(* 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 (Link Label)
of Link))
LabelPairs))
collect (LIST LinkLabel `'(,Link ,LabelPair)))
(for LabelPair in LabelPairs unless (FMEMB (CAR LabelPair)
ExistingLabels)
collect (LIST (CAR LabelPair)
`'(,NIL ,LabelPair)))))
(SETQ LinkAndLabelPair
(COND
((CDR MenuItems)
(MENU (create MENU
ITEMS ← MenuItems
TITLE ← "Which link to delete?"
MENUFONT ← NC.MenuFont
CENTERFLG ← T
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont 'HEIGHT)
1))))
(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.AskYesOrNo (CONCAT "Want to delete the " (fetch (Link Label) of Link)
" link between "
(NC.RetrieveTitle SourceCard)
" and "
(NC.RetrieveTitle DestinationCard)
"? ")
"--"
'Yes T Window NIL NIL)
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? ")
"- -"
'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.)
(NC.GraphNodeIDPutProp 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 (NC.GraphNodeIDGetProp FromNodeID ToNodeID))
(NULL (NC.GraphNodeIDGetProp 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) (* Randy.Gobbel " 2-Apr-87 15:38")
(* * Called by grapher when user creates a new node.
Returns new node or nil.)
(* * rht 11/17/85%: updated to handle new card and notefile formats.)
(* * pmi 12/5/86%: Modified message to NC.SelectNoteCards to mention
SHIFT-selection. Also added GLOBALVARS statement.)
(* * pmi 12/12/86%: Removed obsolete ReturnLinksFlg argument in call to
NC.SelectNoteCards.)
(* * rg |3/18/87| added NC.ProtectedCardOperation and NC.CardSelectionOperation
wrappers)
(* * rg |4/2/87| changed NC.CardSelectionOperation to NCP.WithLockedCards)
(DECLARE (GLOBALVARS NC.BrowserContentsLinkLabel))
(NC.ProtectedCardOperation (NC.CoerceToCard Window)
"Add Node" Window (NCP.WithLockedCards
(PROG ((GraphCard (NC.CoerceToCard Window))
Link GraphNodeID Card)
(* Get user to select an existing card. Not allowed to create a new one.)
(SETQ Card (NC.SelectNoteCards T
[FUNCTION (LAMBDA (SelectedCard)
(COND
((NOT (NC.SameCardP SelectedCard
GraphCard))
T)
(T (NC.PrintMsg Window T
"The browser can't link to itself."
(CHARACTER 13)
"Selection ignored."
(CHARACTER 13))
NIL]
NC.SelectingCardMenu GraphCard
"Shift-select a card or box to include in browser."
))
(if (NULL Card)
then (RETURN NIL)) (* Make link from browser to new card.)
(SETQ Link (NC.MakeLink Window NC.BrowserContentsLinkLabel Card
GraphCard NIL NIL NIL T))
(* Check that it doesn't already exist. If not, create a browser node.)
(COND
(Link (* Create hash array if haven't
already.)
(NC.GetBrowserHashArray GraphCard Graph)
[SETQ GraphNodeID (NC.GetBrowserNodeID
GraphCard
(SETQ Card (fetch (Link
DestinationCard
)
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.RetrieveTitle
Card)
"' already in graph.")
(NCP.DeleteLinks Link)
(RETURN NIL)))
(NC.MarkCardDirty GraphCard)
(RETURN (NODECREATE GraphNodeID (NC.MakeLinkIcon Link)
(CURSORPOSITION NIL Window])
(NC.BrowserAddLabel
(LAMBDA (Graph Window) (* pmi%: "23-Jun-87 17:32")
(* * This builds a label node in the default grapher style except that we force
non-boxed nodes.)
(* * pmi 6/23/87%: Added call to NC.MarkCardDirty to make sure substance is
marked dirty when nodes are created.)
(NC.MarkCardDirty (NC.CoerceToCard Window))
(DEFAULT.ADDNODEFN Graph Window NIL)))
(NC.BrowserAddEdge
(LAMBDA (FromNode ToNode Window Graph) (* rht%: "17-Nov-85 21:45")
(* * 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 ((GraphCard (NC.CoerceToCard Window)))
(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 GraphCard)
(ADD/AND/DISPLAY/LINK FromNode ToNode Window Graph)))
NIL)))
(NC.BrowserRemoveNode
[LAMBDA (Graph Window DeleteCardFlg NodeToRemove QuietFlg) (* ; "Edited 3-Aug-88 12:20 by Trigg")
(* ;; "Called by grapher when user removes a node.")
(* ;; "rht 11/17/85: Updated to handle new card and notefile formats.")
(* ;; "rht 2/7/86: Changed to use NC.SetBrowserRoots instead of NC.PutProp")
(* ;; "rht 4/30/86: Now takes optional NodeToRemove and QuietFlg argument.")
(* ;; "rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard")
(* ;; "pmi 8/7/87: Now passes DeleteCardFlg arg to NC.DelBrowserContentsLink. Also turned off confirmation in NC.DeleteNoteCard.")
(* ;; "rht 1/19/88: Now returns nil if NC.SelectGraphNode returns nil.")
(* ;; "rht 8/3/88: Ripped out this piece of code that bailed out early in case when NodeToRemove had no edges.")
(* ;; "pmi & rar 8/26/88: No longer calls FLIPNODE if Window is NIL.")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(PROG ((GraphCard (NC.CoerceToCard Window))
Card NodeToRemoveID RootCards NodesToRemove NumVirtuals)
(OR NodeToRemove (SETQ NodeToRemove (NC.SelectGraphNode Window Graph
(if DeleteCardFlg
then "Choose node of card to delete."
else "Choose node to remove.")))
(RETURN NIL))
(SETQ NodeToRemoveID (NC.CoerceToGraphNodeIDOrLabel NodeToRemove))
(SETQ Card (NC.CardFromBrowserNodeID NodeToRemoveID))
(* ;; "If we're supposed to be deleting a card, then check that node represents a card and that user confirms.")
(if DeleteCardFlg
then (if (NC.ValidCardP Card)
then (if (NOT (NC.AskYesOrNo (CONCAT "Are you sure you want to delete the "
(NC.RetrieveTitle Card)
" card? ")
"--"
'Yes T Window NIL NIL))
then (AND Window (FLIPNODE NodeToRemove Window))
(RETURN (NC.PrintMsg NIL T "Card & Node delete aborted.")))
else (NC.PrintMsg NIL T "No card for that node.")
(FLASHW PROMPTWINDOW)
(AND Window (FLIPNODE NodeToRemove Window))
(RETURN NIL)))
(AND (NC.ValidCardP GraphCard)
(NC.MarkCardDirty GraphCard))
(* ;; "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 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? " "--" 'Yes NIL Window NIL
NIL T]
then (AND Window (FLIPNODE NodeToRemove Window))
(RETURN NIL)) (* ;
"Delete the browsercontents link from the browser.")
(AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard)
(NC.DelBrowserContentsLink GraphCard Card DeleteCardFlg))
(* ;
"Delete all record of links to and from this node on prop lists.")
(NC.SmashGraphNodeIDProps NodeToRemoveID)
(for Node in (fetch (GRAPH GRAPHNODES) of Graph) eachtime (BLOCK) bind UID
when (type? UID (SETQ UID (NC.CoerceToGraphNodeID Node))) do (NC.GraphNodeIDRemProp
UID NodeToRemoveID))
(if (AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard))
then (* ; "Remove from the root ids list.")
(SETQ RootCards (NC.FetchBrowserRoots GraphCard))
(if (for RootCard in RootCards eachtime (BLOCK) thereis (NC.SameCardP Card
RootCard))
then (NC.SetBrowserRoots GraphCard (for RootCard in RootCards
eachtime (BLOCK)
unless (NC.SameCardP Card RootCard)
collect RootCard)))
(* ;
"Remove entry for this node from browser hash array.")
(NC.RemoveBrowserNodeHashArrayEntry GraphCard Card))
(* ;
"Get rid of node and its virtual buddies from graph.")
(AND Window (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 " Card " ... ")
(NC.DeleteNoteCard Card NIL T)
(NC.PrintMsg NIL T "Done." (CHARACTER 13)))
(AND Window (REDISPLAYW Window))
(OR QuietFlg (NC.PrintMsg NIL T "Nodes: " [CONCATLIST
(for Node in NodesToRemove
collect (PACK* (fetch (GRAPHNODE NODEID)
of Node)
'% ]
"removed."])
(NC.DelBrowserContentsLink
(LAMBDA (GraphCard DestCard DeleteCardFlg) (* pmi%: " 7-Aug-87 18:09")
(* * Delete the browsercontents link connecting GraphCard and DestID.)
(* * rht 11/17/85%: updated to handle new card and notefile formats.)
(* * rht 4/30/86%: Now checks to make sure there's a link to delete.)
(* * rht 5/26/87%: Now handles cross-file browsercontents links.)
(* * pmi 8/7/87%: Added DeleteCardFlg arg so we won't create orphans if
DestCard is about to be deleted.)
(DECLARE (GLOBALVARS NC.BrowserContentsLinkLabel))
(LET ((Links (NCP.GetLinks GraphCard DestCard NC.BrowserContentsLinkLabel)))
(if (CDR Links)
then (NC.ReportError "NC.DelBrowserContentsLink" (CONCAT
"Multiple browser contents links between "
(NC.FetchTitle GraphCard)
" and "
(NC.FetchTitle DestCard)))
NIL)
(if Links
then
(* Don't create an orphan if this card is about to be deleted.)
(NC.DeleteLink (CAR Links)
DeleteCardFlg T)
else (* Could be that it's a cross file
browsercontents link.)
(for Link in (NCP.GetLinks GraphCard NIL NC.BrowserContentsLinkLabel)
bind CrossFileLinkCard (DestCardUID ← (fetch (Card UID) of DestCard))
when (AND (NC.CrossFileLinkCardP (SETQ CrossFileLinkCard (fetch (Link
DestinationCard
)
of Link)))
(NC.SameUIDP DestCardUID (fetch (CrossFileLinkSubstance
CrossFileLinkDestCardUID)
of (NCP.CardSubstance CrossFileLinkCard))))
do (RETURN (NC.DeleteLink Link T T)))))))
(NC.BrowserRemoveEdge
(LAMBDA (FromNode ToNode Window Graph) (* ; "Edited 3-Dec-87 19:01 by rht:")
(* * Called by grapher when user deletes an edge.
This code is just like NC.BrowserDeleteLink except we don't affect any
notecards links.)
(* * rht 11/17/85%: upadted to handle new card and notefile formats.)
(* * pmi 3/25/87%: Added NC.MenuFont to all menus)
(DECLARE (GLOBALVARS NC.MenuFont))
(PROG ((GraphCard (NC.CoerceToCard 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 (NC.GraphNodeIDGetProp FromNodeID ToNodeID))
(if (AND (NULL LabelPairs)
(NULL (NC.GraphNodeIDGetProp 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 GraphCard)
(* Let user choose among all edges from FromNode to ToNode.)
(SETQ MenuItems (for LabelPair in LabelPairs collect (LIST (CAR LabelPair)
`',LabelPair)))
(SETQ LabelPairToRemove
(if (CDR MenuItems)
then (MENU (create MENU
ITEMS ← MenuItems
TITLE ← "Which edge to delete?"
MENUFONT ← NC.MenuFont
CENTERFLG ← T
ITEMHEIGHT ← (IPLUS (FONTPROP NC.MenuFont 'HEIGHT)
1)))
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.)
(NC.GraphNodeIDPutProp 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 (NC.GraphNodeIDGetProp FromNodeID ToNodeID))
(NULL (NC.GraphNodeIDGetProp 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)))))
)
(* ;;; "Grapher hacks for browser")
(DEFINEQ
(NC.MakeLinksLegend
(LAMBDA (Graph Win DropVirtualNodesFlg) (* rht%: " 6-Jul-86 17:28")
(* * 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.)
(* * rht 11/17/85%: updated to handle new card and notefile formats.)
(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))
(NC.GraphNodeIDPutProp (SETQ UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node)
NodeID))
'NumAppearances
(if (SETQ OldNumAppearances (NC.GraphNodeIDGetProp UnderlyingNodeID '
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.CardFromBrowserNodeID DestNodeID))
(* Turn forward labels into pairs by
adding dashing numbers.)
(SETQ NewLabelPairs
(if (AND NotLabelNodeFlg (NOT (OR (LISTP (CAR (NC.GraphNodeIDGetProp NodeID
DestNodeID)))
(LISTP (CAR (NC.GraphNodeIDGetProp
DestNodeID NodeID))))))
then
(* Okay to continue since we haven't visited this pair already.)
(APPEND (if (SETQ Labels (NC.GraphNodeIDGetProp NodeID DestNodeID))
then (NC.GraphNodeIDPutProp
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 (NC.GraphNodeIDGetProp DestNodeID NodeID))
then (NC.GraphNodeIDPutProp
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 'DRAWLINKFN
(FUNCTION NC.BrowserDrawLinkFn)
'NODEID NodeID '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 (NC.GraphNodeIDGetProp NodeID DestNodeID)
then (LIST LINKPARAMS NewDestNode 'DRAWLINKFN
(FUNCTION NC.BrowserDrawLinkFn)
'DASHING
(CAR (FNTH NC.DashingStyles (CDAR
NewLabelPairs
))))
else (LIST LINKPARAMS NewDestNode 'DRAWLINKFN
(FUNCTION NC.BrowserDrawLinkFn)
'DASHING
(CAR (FNTH NC.DashingStyles (CDAR
NewLabelPairs
)))
'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 (NC.GraphNodeIDGetProp UnderlyingNodeID '
NumAppearances)))
(if (OR (fetch (GRAPHNODE TONODES) of Node)
(FMEMB (fetch (GRAPHNODE NODEID) of Node)
ReferencedNodes)
(EQ NumAppearances 1))
else (* This node is getting deleted.)
(NC.GraphNodeIDPutProp UnderlyingNodeID '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 (NC.GraphNodeIDGetProp UnderlyingNodeID 'NumAppearances))
then (replace (GRAPHNODE NODEBORDER) of Node with NIL))
(NC.GraphNodeIDRemProp UnderlyingNodeID 'NumAppearances)))
(SETQ LabelPairs (DREVERSE LabelPairs))
(AND Win (NC.MakeLinksLegendMenu Win LabelPairs))
(RETURN LabelPairs))))
(NC.MakeLinksLegendMenu
[LAMBDA (Win LabelPairs) (* ; "Edited 18-Aug-88 19:07 by pmi")
(* ;; "Build a links legend menu and attach to Win")
(* ;; "rht 1/10/85: Before starting, kill any old links legend menus for Win.")
(* ;; "rht 1/13/86: Now holds onto value of PASSTOMAINCOMS windowprop of prompt win and restores after reattaching.")
(* ;; "rht 1/15/86: Added windowprops MINSIZE and MAXSIZE to fix the bug where reshaping browser screws up links legend menu.")
(* ;;
"rht 3/7/86: Now closes prompt window before attaching menu. Uses ATTACHMENU to attach the menu.")
(* ;; "rht 4/5/86: Took out call to NC.MoveWindowOntoScreen. For big browsers it causes redraw of window which is too high a price to pay.")
(* ;; "rht 3/20/87: Changed so that ATTACHMENU call is inside of NC.WithWindowsUnattached macro. Also took out closing of prompt window, as it's no longer necessary.")
(* ;; "rht 1/16/88: Now does nothing if card has non-nil OmitLinksLegendFlg user data prop.")
(* ;; "pmi 8/18/88: No longer puts up a link legend if the browser does not have any links.")
(DECLARE (GLOBALVARS NC.LinkDashingInBrowser))
(OR (NCP.CardUserDataProp (NCP.WhichCard Win)
'OmitLinksLegendFlg)
(LET (Menu MenuWin PromptWin MainWinPromptInfo PromptWinPASSTOMAINCOMS)
(for AttachedWin in (ATTACHEDWINDOWS Win) when (WINDOWPROP AttachedWin 'LINKSLEGENDWINP)
do (REMOVEWINDOW AttachedWin))
(if LabelPairs
then [SETQ Menu (COND
(NC.LinkDashingInBrowser
(create MENU
ITEMS ← [for Pair in LabelPairs
join (LIST (CAR Pair)
(LIST '" "]
TITLE ← 'Links
MENUCOLUMNS ← 2))
(T (create MENU
ITEMS ← (for Pair in LabelPairs
collect (CAR Pair))
TITLE ← 'Links
MENUCOLUMNS ← 1]
(* ;
"Stick the links legend window at upper right corner.")
[NC.WithTopWindowsUnattached Win (SETQ MenuWin (ATTACHMENU Menu Win
'RIGHT
'TOP]
(* ;
"Rig so that close of menu won't close browser.")
(WINDOWDELPROP MenuWin 'PASSTOMAINCOMS 'CLOSEW)
(WINDOWADDPROP MenuWin 'CLOSEFN [FUNCTION (LAMBDA (W)
(DETACHWINDOW W]
T)
(WINDOWADDPROP MenuWin 'REPAINTFN 'NC.LinksLegendRepaintFn)
(WINDOWADDPROP MenuWin 'RESHAPEFN 'NC.LinksLegendReshapeFn)
(WINDOWADDPROP MenuWin 'LINKSLEGENDWINP T)
(WINDOWPROP Win 'NCLABELPAIRS LabelPairs)
(if NC.LinkDashingInBrowser
then (NC.LinksLegendRepaintFn MenuWin 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 'MENU)))
Items
(LabelPairs (WINDOWPROP (MAINWINDOW Win)
'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 'NODEID))
(* Multiple links. Have to draw a flower of spline curves for the links.)
(RETURN (NC.DrawFlowerLinks NodeID (SETQ DestNodeID
(LISTGET ParamList
'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 'None)
(SETQ MidpointFlg (EQ NC.ArrowHeadsInBrowser 'AtMidpoint))
(COND
((LISTGET ParamList '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%: " 6-Jul-86 17:27")
(* * 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 (NC.GraphNodeIDGetProp NodeID1 NodeID2)
do (NC.DrawFlowerLink X1 Y1 X2 Y2 (LIST 'ROUND Width Color)
(CAR (FNTH NC.DashingStyles (CDR Pair)))
(SETQ Count (ADD1 Count))
Stream Width Operation Color))
(for Pair in (NC.GraphNodeIDGetProp NodeID2 NodeID1)
do (NC.DrawFlowerLink X2 Y2 X1 Y1 (LIST '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%: " 1-May-87 14:55")
(* * 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.)
(* * rht 3/21/86%: Now checks for WINDOWPROP of Scale for when we're in a
browser overview window.)
(* * rht 5/1/87%: Changed bogus mention of "Stream" to "Win.")
(DECLARE (GLOBALVARS NC.ArrowHeadsInBrowser NC.GraphFlowerLinkSeparation))
(PROG ((MidpointX (QUOTIENT (IPLUS X1 X2)
2))
(MidpointY (QUOTIENT (IPLUS Y1 Y2)
2))
XOffset YOffset Scale Window WindowScale)
(COND
((ZEROP Num)
(DRAWLINE X1 Y1 X2 Y2 Width Operation Win Color Dashing)
(AND (NEQ NC.ArrowHeadsInBrowser '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 Window (AND (DISPLAYSTREAMP Win)
(WINDOWP (WFROMDS Win))))
(if (AND Window (SETQ WindowScale (WINDOWPROP Window 'Scale)))
then (SETQ Scale (FTIMES Scale WindowScale)))
(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 '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%: "26-Mar-86 15:45")
(* * 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.)
(* * rht 2/28/86%: Now checks for Scale WINDOWPROP on the window.
If so, then multiply that in with Scale.
We're probably in a shrunken browser in that case.)
(PROG ((XDiff (FLOAT (IDIFFERENCE X1 X2)))
(YDiff (FLOAT (IDIFFERENCE Y1 Y2)))
(Window (AND (DISPLAYSTREAMP Stream)
(WINDOWP (WFROMDS Stream))))
(Scale (DSPSCALE NIL Stream))
WindowScale LineLength A11 A12 A21 A22 Tmp1 Tmp2 ClippingRegion ArrowHeadXVal
ArrowHeadYVal ArrowHeadLength)
(OR XOffset (SETQ XOffset 0))
(OR YOffset (SETQ YOffset 0))
(if (AND Window (SETQ WindowScale (WINDOWPROP Window 'Scale)))
then (SETQ Scale (FTIMES Scale WindowScale)))
(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))))
)
(* ;;; "for making and manipulating the tiny attached shrunken browser window.")
(RPAQ? NC.BrowserOverviewDefaultWidth 75)
(RPAQ? NC.BrowserOverviewDefaultHeight 75)
(RPAQ? NC.LeastScaleForGraphNodeShrinking 0.3)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.BrowserOverviewDefaultWidth NC.BrowserOverviewDefaultHeight
NC.LeastScaleForGraphNodeShrinking NC.BrowserOverviewSpecsStylesheet
NC.DefaultWhereToAttachOverviewWin NC.DefaultBrowserOverviewMode NC.OverviewWinMode.Compress
NC.OverviewWinMode.Expand)
)
(RPAQ? NC.OverviewWinMode.Compress '|Compress Overview Win|)
(RPAQ? NC.OverviewWinMode.Expand 'Expand% Overview)
(RPAQ? NC.DefaultBrowserOverviewMode 'Neither)
(RPAQ? NC.DefaultWhereToAttachOverviewWin '(LEFT . TOP))
(RPAQ? NC.BrowserOverviewSpecsStylesheet
[CREATE.STYLE 'TITLE "Choose browser overview specs" 'ITEM.TITLES '(Edge |Position on Edge|
Mode)
'ITEM.TITLE.FONT
(FONTCOPY MENUFONT 'WEIGHT 'BOLD)
'ITEMS
(LIST [create MENU ITEMS ← '((LEFT LEFT "Position along left edge.")
(TOP TOP "Position along top edge.")
(RIGHT RIGHT "Position along right edge.")
(BOTTOM BOTTOM "Position along bottom edge."]
[create MENU ITEMS ← '((TOP/RIGHT TOP "Position at top or right end of edge.")
(CENTER CENTER "Position at center of edge.")
(BOTTOM/LEFT BOTTOM "Position at bottom or left of edge."]
(create MENU ITEMS ← '((|Compress Overview Win| |Compress Overview Win|
"Compress the overview window to exactly fit the overview contents."
)
(Expand% Overview Expand% Overview
"Expand the overview contents to exactly fill the overview window."
)
(Neither Neither
"Neither expand the overview contents nor compress the overview window."
])
(DEFINEQ
(NC.MakeBrowserOverviewWin
(LAMBDA (BrowserWin Region) (* Randy.Gobbel " 4-Mar-87 13:57")
(* * Make and attach a little window to contain a shrunken bitmap of the entire
browser. If Region arg is passed then use that as size for overview win, else
use defaults.)
(* * rht 3/7/86%: Now uses stylesheet to figure out where to attach.)
(* * rht 11/1/86%: Added NC.ProtectedCardOperation wrapper and check for ops in
progress.)
(* * rg |3/4/87| rewritten for new version of NC.ProtectedCardOperation,
removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard BrowserWin)))
(NC.ProtectedCardOperation Card "Build Browser Overview" NIL
(LET ((OverviewWinWidth (if Region
then (fetch (REGION WIDTH) of Region)
else (OR (WINDOWPROP BrowserWin 'OverviewWinWidth)
NC.BrowserOverviewDefaultWidth)))
(OverviewWinHeight (if Region
then (fetch (REGION HEIGHT) of Region)
else (OR (WINDOWPROP BrowserWin 'OverviewWinHeight)
NC.BrowserOverviewDefaultHeight)))
(OverviewWin (OPENWP (WINDOWPROP BrowserWin 'BrowserOverviewWin)))
(WhereToAttach (OR (WINDOWPROP BrowserWin 'WHERETOATTACHOVERVIEWWIN)
NC.DefaultWhereToAttachOverviewWin)))
(if OverviewWin
else (* Make a new overview window.)
(SETQ OverviewWin (CREATEW (CREATEREGION (fetch (POSITION XCOORD)
of NC.OffScreenPosition)
(fetch (POSITION YCOORD) of
NC.OffScreenPosition
)
OverviewWinWidth OverviewWinHeight)))
(WINDOWPROP BrowserWin 'BrowserOverviewWin OverviewWin))
(NC.ReattachBrowserOverviewWin OverviewWin BrowserWin WhereToAttach)
(NC.RedrawBrowserOverviewWin OverviewWin BrowserWin))))))
(NC.AskBrowserOverviewSpecs
(LAMBDA (BrowserWin) (* Randy.Gobbel " 4-Mar-87 14:00")
(* * Put up stylesheet to get mode and where to attach overview win.)
(* * rht 11/1/86%: Added NC.ProtectedCardOperation wrapper and check for ops in
progress.)
(* * rg |3/4/87| rewritten for new version of NC.ProtectedCardOperation,
removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard BrowserWin)))
(NC.ProtectedCardOperation Card "Browser Overview Specs" NIL
(LET ((WhereLastAttached (OR (WINDOWPROP BrowserWin 'WHERETOATTACHOVERVIEWWIN)
NC.DefaultWhereToAttachOverviewWin))
(LastMode (OR (WINDOWPROP BrowserWin 'OVERVIEWWINMODE)
NC.DefaultBrowserOverviewMode))
OverviewSpecsResults)
(STYLE.PROP NC.BrowserOverviewSpecsStylesheet 'SELECTIONS
(LIST (CAR WhereLastAttached)
(SELECTQ (CDR WhereLastAttached)
((TOP RIGHT)
'TOP/RIGHT)
((LEFT BOTTOM)
'BOTTOM/LEFT)
'CENTER)
LastMode))
(STYLE.PROP NC.BrowserOverviewSpecsStylesheet 'POSITION
(create POSITION
XCOORD ← (fetch (REGION LEFT) of (WINDOWPROP BrowserWin
'REGION))
YCOORD ← (fetch (REGION TOP) of (WINDOWREGION BrowserWin))))
(if (SETQ OverviewSpecsResults (STYLESHEET NC.BrowserOverviewSpecsStylesheet))
then (WINDOWPROP BrowserWin 'WHERETOATTACHOVERVIEWWIN (CONS (CAR
OverviewSpecsResults
)
(CADR
OverviewSpecsResults
)))
(WINDOWPROP BrowserWin 'OVERVIEWWINMODE (CADDR OverviewSpecsResults))
else NIL))))))
)
(DEFINEQ
(NC.DRAWBOX
(LAMBDA (Left Bottom Width Height LineWidth Operation Stream)
(* rht%: "27-Feb-86 22:34")
(* * This really SHOULD be in Interlisp.
The one in Koto takes no Operation arg.)
(DRAWLINE Left Bottom (PLUS Left Width)
Bottom LineWidth Operation Stream)
(DRAWLINE (PLUS Left Width)
Bottom
(PLUS Left Width)
(PLUS Bottom Height)
LineWidth Operation Stream)
(DRAWLINE (PLUS Left Width)
(PLUS Bottom Height)
Left
(PLUS Bottom Height)
LineWidth Operation Stream)
(DRAWLINE Left (PLUS Bottom Height)
Left Bottom LineWidth Operation Stream)))
(NC.ShrinkGraphToWindow
(LAMBDA (Graph Window) (* ; "Edited 3-Dec-87 19:01 by rht:")
(* * Bitblt's into Window a shrunken bitmap of the graph just big enough to
fit.)
(* * rht 3/18/86%: Now does more intelligent copy of Graph structure,
preserving virtual node eq-ness.)
(* * rht 3/21/86%: Now handles XScale and YScale.)
(* * rg |11/19/86| Ref. to undef var BrowserWin --> GraphWindow
(\, added) GLOBALVARS)
(DECLARE (GLOBALVARS NC.OverviewWinMode.Expand))
(LET ((GraphWindow (MAINWINDOW Window))
(Scales (NC.ComputeOverviewScale Graph Window))
(ShrunkenGraph (create GRAPH using Graph))
Scale XScale YScale)
(if (EQ (WINDOWPROP GraphWindow 'OVERVIEWWINMODE)
NC.OverviewWinMode.Expand)
then (SETQ XScale (CAR Scales))
(SETQ YScale (CDR Scales))
(SETQ Scale (FMIN XScale YScale))
else (SETQ Scale (SETQ XScale (SETQ YScale (FMIN (CAR Scales)
(CDR Scales))))))
(* Shrink the graphnodes.)
(replace (GRAPH GRAPHNODES) of ShrunkenGraph
with (for GraphNode in (fetch (GRAPH GRAPHNODES) of ShrunkenGraph) eachtime (BLOCK)
collect (NC.ScaleGraphNode (create GRAPHNODE using GraphNode)
Scale XScale YScale GraphWindow)))
(* Display the graph, but temporarily scale the arrowhead global vars.
Will this work compiled?)
(SHOWGRAPH ShrunkenGraph Window)
(WINDOWPROP Window 'Scale Scale)
(WINDOWPROP Window 'XScale XScale)
(WINDOWPROP Window 'YScale YScale)
(WINDOWPROP Window 'GRAPH ShrunkenGraph))))
(NC.ScaleGraphNode
[LAMBDA (GraphNode Scale XScale YScale BrowserWin) (* ; "Edited 29-Apr-88 11:52 by pmi")
(* ;; "Change the position and node label according to Scale.")
(* ;; "rht 3/14/86: Now smashes NODELABEL field of graph node with bitmap rather than NODELABELBITMAP field.")
(* ;; "rht 3/18/86: Now returns GraphNode.")
(* ;; "rht 3/21/86: Now scales position using XScale and YScale. But note that new node size still governed by Scale. This is because SCALEBITMAP only takes single scale.")
(* ;; "pmi 4/29/88: Now uses the DisplayFn of the ImageObj instead of calling NC.LinkIconDisplayFn, which didn't work for Deleted Link ImageObj's.")
(LET ((OldWidth (fetch (GRAPHNODE NODEWIDTH) of GraphNode))
(OldHeight (fetch (GRAPHNODE NODEHEIGHT) of GraphNode))
(OldPosition (fetch (GRAPHNODE NODEPOSITION) of GraphNode))
NewWidth NewHeight NewBitmap OldBitmap NodeLabel)
[replace (GRAPHNODE NODEWIDTH) of GraphNode with (SETQ NewWidth (FIX (FTIMES Scale OldWidth]
[replace (GRAPHNODE NODEHEIGHT) of GraphNode with (SETQ NewHeight (FIX (FTIMES Scale
OldHeight]
[replace (GRAPHNODE NODEPOSITION) of GraphNode
with (create POSITION
XCOORD ← (FIX (FTIMES XScale (fetch (POSITION XCOORD) of OldPosition)))
YCOORD ← (FIX (FTIMES YScale (fetch (POSITION YCOORD) of OldPosition]
(if (LESSP Scale NC.LeastScaleForGraphNodeShrinking)
then (* ;
"At this scale no need to shrink node label. Just show shaded box.")
(SETQ NewBitmap (BITMAPCREATE NewWidth NewHeight))
(BLTSHADE GRAYSHADE NewBitmap NIL NIL NewWidth NewHeight)
else (* ; "Shrink node label.")
[if (SETQ OldBitmap (fetch (GRAPHNODE NODELABELBITMAP) of GraphNode))
else (SETQ OldBitmap (BITMAPCREATE OldWidth OldHeight))
(SETQ NodeLabel (fetch (GRAPHNODE NODELABEL) of GraphNode))
(* ;
"Apply the appropriate DisplayFn to the imageobj")
(if (IMAGEOBJP NodeLabel)
then (APPLY* (IMAGEOBJPROP NodeLabel 'DISPLAYFN)
NodeLabel
(DSPCREATE OldBitmap))
else (PRIN1 NodeLabel (DSPCREATE OldBitmap]
(SETQ NewBitmap (SCALEBITMAP OldBitmap Scale)))
(replace (GRAPHNODE NODELABEL) of GraphNode with NewBitmap)
(replace (GRAPHNODE NODELABELBITMAP) of GraphNode with NIL)
GraphNode])
(NC.ComputeOverviewScale
(LAMBDA (Graph OverviewWin) (* rht%: "21-Mar-86 00:13")
(* * Figure out the scale necessary to shrink Graph into OverviewWin.)
(* * rht 3/21/86%: Now returns both XScale and YScale.)
(LET ((GraphRegion (GRAPHREGION Graph)))
(CONS (FMIN (FQUOTIENT (WINDOWPROP OverviewWin 'WIDTH)
(fetch (REGION WIDTH) of GraphRegion))
1)
(FMIN (FQUOTIENT (WINDOWPROP OverviewWin 'HEIGHT)
(fetch (REGION HEIGHT) of GraphRegion))
1)))))
(NC.RedrawBrowserOverviewWin
(LAMBDA (OverviewWin BrowserWin) (* rht%: " 8-May-86 11:29")
(* * The contents of the browser window have changed.
Redraw the overview win.)
(* * rht 3/20/86%: Now compresses to fit overview if necessary.)
(* * rht 5/8/86%: Now smashes SCROLLFN)
(NC.ShrinkGraphToWindow (WINDOWPROP BrowserWin 'GRAPH)
OverviewWin)
(if (EQ (WINDOWPROP BrowserWin 'OVERVIEWWINMODE)
NC.OverviewWinMode.Compress)
then (WINDOWPROP OverviewWin 'RESHAPEFN NIL)
(NC.CompressOverviewWin OverviewWin BrowserWin))
(WINDOWPROP OverviewWin 'REPAINTFN (FUNCTION NC.BrowserOverviewWinRepaintFn))
(WINDOWPROP OverviewWin 'RESHAPEFN (FUNCTION NC.BrowserOverviewWinReshapeFn))
(WINDOWPROP OverviewWin 'BUTTONEVENTFN (FUNCTION NC.BrowserOverviewWinButtonEventFn))
(WINDOWPROP OverviewWin 'SCROLLFN NIL)
(NC.DrawWireFrameInOverviewWin OverviewWin BrowserWin)))
(NC.DrawWireFrameInOverviewWin
(LAMBDA (OverviewWin BrowserWin) (* rht%: "21-Mar-86 00:35")
(* * Draw a wire frame in the overview win whose size and position within the
overview correspond to the size and position of BrowserWin relative to entire
graph.)
(* * rht 3/21/86%: Now handles XScale and YScale.)
(LET ((BrowserClippingRegion (DSPCLIPPINGREGION NIL BrowserWin))
(XScale (WINDOWPROP OverviewWin 'XScale))
(YScale (WINDOWPROP OverviewWin 'YScale))
WireFrame)
(SETQ WireFrame (CREATEREGION (FIX (FTIMES XScale (fetch (REGION LEFT) of
BrowserClippingRegion
)))
(FIX (FTIMES YScale (fetch (REGION BOTTOM) of BrowserClippingRegion))
)
(FIX (FTIMES XScale (fetch (REGION WIDTH) of BrowserClippingRegion)))
(FIX (FTIMES YScale (fetch (REGION HEIGHT) of BrowserClippingRegion))
))) (* Draw the wire frame out on the
overview window.)
(NC.DRAWBOX (fetch (REGION LEFT) of WireFrame)
(fetch (REGION BOTTOM) of WireFrame)
(fetch (REGION WIDTH) of WireFrame)
(fetch (REGION HEIGHT) of WireFrame)
1
'INVERT OverviewWin) (* Stash the new wire frame on
windowprop.)
(WINDOWPROP OverviewWin 'LastWireFrame WireFrame))))
(NC.CompressOverviewWin
(LAMBDA (OverviewWin GraphWin) (* rht%: "21-Mar-86 16:03")
(* * Reshape OverviewWin so it just holds its contents plus the wire frame.)
(* * rht 3/21/86%: Massive rewrite. Notice ugly use of constant 7 in width of
NewRegion. This seems necessary empirically to keep overview from shrinking
with successive redisplays.)
(LET ((CurCLIPPINGRegion (DSPCLIPPINGREGION NIL OverviewWin))
(CurRegion (WINDOWREGION OverviewWin))
(WireFrameRegion (WINDOWPROP OverviewWin 'LastWireFrame))
(GraphRegion (GRAPHREGION (WINDOWPROP OverviewWin 'GRAPH)))
(OverviewWinBorder (WINDOWPROP OverviewWin 'BORDER))
NewRegion)
(SETQ NewRegion (create REGION using GraphRegion WIDTH ← (PLUS 7 (fetch (REGION WIDTH)
of GraphRegion))))
(if (OR (NULL WireFrameRegion)
(AND (NOT (EQUAL NewRegion CurCLIPPINGRegion))
(REGIONSINTERSECTP WireFrameRegion NewRegion))
(PROG1 (SUBREGIONP CurCLIPPINGRegion WireFrameRegion)
(SETQ NewRegion (EXTENDREGION NewRegion (INTERSECTREGIONS WireFrameRegion
CurCLIPPINGRegion)))))
then (SHAPEW OverviewWin (CREATEREGION (fetch (REGION LEFT) of CurRegion)
(fetch (REGION BOTTOM) of CurRegion)
(PLUS (TIMES 2 OverviewWinBorder)
(fetch (REGION WIDTH) of NewRegion))
(PLUS (TIMES 2 OverviewWinBorder)
(fetch (REGION HEIGHT) of NewRegion))))
(NC.ReattachBrowserOverviewWin OverviewWin GraphWin (WINDOWPROP GraphWin
'
WHERETOATTACHOVERVIEWWIN
))))))
(NC.ReattachBrowserOverviewWin
(LAMBDA (OverviewWin BrowserWin WhereToAttach) (* rht%: "24-Jul-87 19:10")
(* * Check to see if OverviewWin is attached at correct place.
If not, detach and reattach.)
(* * rht 3/7/86%: No longer checks. Just reattaches.)
(* * rht 4/2/87%: Changed WINDOWDELPROP of PASSTOMAINCOMS to just smash them.
Otherwise Shrager's special SHAPEW.POP, etc.
crud hangs around.)
(* * rht 7/24/87%: Took SHAPEW off of list of PASSTOMAINCOMS.)
(LET ((Width (fetch (REGION WIDTH) of (WINDOWREGION OverviewWin)))
(Height (fetch (REGION HEIGHT) of (WINDOWREGION OverviewWin))))
(DETACHWINDOW OverviewWin)
(ATTACHWINDOW OverviewWin BrowserWin (OR (CAR WhereToAttach)
'LEFT)
(OR (CDR WhereToAttach)
'TOP)
'LOCALCLOSE)
(WINDOWPROP OverviewWin 'PASSTOMAINCOMS '(MOVEW SHRINKW BURYW))
(WINDOWPROP BrowserWin 'OverviewWinWidth Width)
(WINDOWPROP BrowserWin 'OverviewWinHeight Height)
(WINDOWPROP OverviewWin 'MINSIZE (FUNCTION NC.BrowserOverviewWinMINSIZEFn))
(WINDOWPROP OverviewWin 'MAXSIZE (CONS Width Height)))))
(NC.BrowserScrollFn
(LAMBDA (WINDOW XDELTA YDELTA CONTINUOUSFLG) (* rht%: "27-Feb-86 22:49")
(* * If there's an overview win, then update its wire frame.)
(LET ((OverviewWin (WINDOWPROP WINDOW 'BrowserOverviewWin)))
(if (OPENWP OverviewWin)
then (NC.DrawWireFrameInOverviewWin OverviewWin WINDOW)
(SCROLLBYREPAINTFN WINDOW XDELTA YDELTA CONTINUOUSFLG)
(NC.DrawWireFrameInOverviewWin OverviewWin WINDOW)
else (SCROLLBYREPAINTFN WINDOW XDELTA YDELTA CONTINUOUSFLG)))))
(NC.BrowserReshapeFn
(LAMBDA (Window OldWinBitmap OldWinRegion) (* rht%: "27-Feb-86 22:48")
(* * If there's an overview win, then update its wire frame.)
(LET ((OverviewWin (WINDOWPROP Window 'BrowserOverviewWin)))
(if (OPENWP OverviewWin)
then (NC.DrawWireFrameInOverviewWin OverviewWin Window)
(RESHAPEBYREPAINTFN Window OldWinBitmap OldWinRegion)
(NC.DrawWireFrameInOverviewWin OverviewWin Window)
else (RESHAPEBYREPAINTFN Window OldWinBitmap OldWinRegion)))))
(NC.BrowserOverviewWinRepaintFn
(LAMBDA (OverviewWin Region) (* rht%: " 3-Mar-86 17:57")
(* * Recomputes overview.)
(NC.RedrawBrowserOverviewWin OverviewWin (MAINWINDOW OverviewWin))))
(NC.BrowserOverviewWinReshapeFn
(LAMBDA (OverviewWin OldWinBitmap OldWinRegion) (* rht%: "20-Mar-87 14:33")
(* * When overview win is reshaped, we need to recompute its contents from
scratch. We detach and reattach in case user pulled it away from browser edge.)
(* * rht 3/20/87%: Now instead of deleting SHAPEW from PASSTOMAINCOMS, it
replaces whole list. This is because Shrager's WDWHACKS package adds screwy
SHAPEW.mumble things to PASSTOMAINCOMS.)
(LET ((BrowserWin (MAINWINDOW OverviewWin))
(WhereAttached (WINDOWPROP OverviewWin 'WHEREATTACHED)))
(DETACHWINDOW OverviewWin)
(ATTACHWINDOW OverviewWin BrowserWin (OR (CAR WhereAttached)
'LEFT)
(OR (CDR WhereAttached)
'TOP)
'LOCALCLOSE)
(WINDOWPROP OverviewWin 'PASSTOMAINCOMS '(MOVEW SHRINKW BURYW))
(WINDOWPROP BrowserWin 'OverviewWinWidth (fetch (REGION WIDTH) of (WINDOWREGION OverviewWin)
))
(WINDOWPROP BrowserWin 'OverviewWinHeight (fetch (REGION HEIGHT) of (WINDOWREGION
OverviewWin)))
(WINDOWPROP OverviewWin 'MAXSIZE (CONS (fetch (REGION WIDTH) of (WINDOWREGION OverviewWin))
(fetch (REGION HEIGHT) of (WINDOWREGION OverviewWin))
))
(NC.RedrawBrowserOverviewWin OverviewWin BrowserWin))))
(NC.BrowserOverviewWinMINSIZEFn
(LAMBDA (OverviewWin) (* rht%: "21-Mar-86 15:17")
(* * This horrible kludge is so that ATTACHEDWINDOWS sees a different value for
MINSIZE depending on whether we're reshaping the whole browser or just the
overview win. In the former case, we want the MINSIZE to be the current size of
the overview win. In the latter, we want it at some small value so user can
reduce size of overview win.)
(LET (Stkpos)
(PROG1 (if (OR (NULL (SETQ Stkpos (STKPOS 'SHAPEW)))
(NEQ OverviewWin (STKARG 'WINDOW 'SHAPEW))
(SETQ Stkpos (STKPOS 'RESHAPEALLWINDOWS NIL NIL Stkpos)))
then (LET ((BrowserWin (MAINWINDOW OverviewWin)))
(CONS (WINDOWPROP BrowserWin 'OverviewWinWidth)
(WINDOWPROP BrowserWin 'OverviewWinHeight)))
else '(5 . 5))
(RELSTK Stkpos)))))
(NC.BrowserOverviewWinButtonEventFn
(LAMBDA (OverviewWin) (* rht%: "21-Mar-86 00:43")
(* * Called when user buttons in browser overview window.
bring cursor to nearest corner of wire frame and let him reposition wire frame.)
(* * rht |3/15/86| Now allows moves of wire frame that increase scrolling
region.)
(* * rht 3/21/86%: Now handles XScale and YScale.)
(LET ((LastWireFrame (WINDOWPROP OverviewWin 'LastWireFrame))
NewRegion XScaleReciprocal YScaleReciprocal BrowserWin OldDisplayRegion NewLeft NewBottom)
(SETQ NewRegion (GETBOXREGION (fetch (REGION WIDTH) of LastWireFrame)
(fetch (REGION HEIGHT) of LastWireFrame)
(PLUS (DSPXOFFSET NIL OverviewWin)
(fetch (REGION LEFT) of LastWireFrame))
(PLUS (DSPYOFFSET NIL OverviewWin)
(fetch (REGION BOTTOM) of LastWireFrame))
OverviewWin "Please position browser overview wire frame."))
(if (REGIONSINTERSECTP NewRegion (DSPCLIPPINGREGION NIL OverviewWin))
then (SETQ BrowserWin (MAINWINDOW OverviewWin))
(SETQ XScaleReciprocal (FQUOTIENT 1 (WINDOWPROP OverviewWin 'XScale)))
(SETQ YScaleReciprocal (FQUOTIENT 1 (WINDOWPROP OverviewWin 'YScale)))
(* Where browser used to be.)
(SETQ OldDisplayRegion (DSPCLIPPINGREGION NIL BrowserWin))
(* First make sure browser win's
EXTENT is big enough.)
(WINDOWPROP BrowserWin 'EXTENT (UNIONREGIONS
(WINDOWPROP BrowserWin 'EXTENT)
(CREATEREGION (SETQ NewLeft
(FIX (FTIMES (fetch (REGION LEFT)
of NewRegion)
XScaleReciprocal)))
(SETQ NewBottom
(FIX (FTIMES (fetch (REGION BOTTOM)
of NewRegion)
YScaleReciprocal)))
(fetch (REGION WIDTH) of OldDisplayRegion)
(fetch (REGION HEIGHT) of OldDisplayRegion))
)) (* Scroll browser to new region.)
(SCROLLW BrowserWin (DIFFERENCE (fetch (REGION LEFT) of OldDisplayRegion)
NewLeft)
(DIFFERENCE (fetch (REGION BOTTOM) of OldDisplayRegion)
NewBottom))))))
(NC.BrowserCardQuitFn
[LAMBDA (Card) (* ; "Edited 15-Jan-88 20:00 by Trigg")
(* ;; "This clears all UserData fields of Graph node UIDs. I ONLY HAVE TO DO THIS BECAUSE INTERLISP WON'T GC CYCLES!")
(* ;; "rht 1/15/88: Had to replace the NCP.ApplySuperTypeFn call with grungy apply* to prevent infinite recursive calls.")
[for GraphNode in (fetch (GRAPH GRAPHNODES) of (NC.FetchSubstance Card))
do (LET ((GraphNodeID (NC.CoerceToGraphNodeIDOrLabel GraphNode)))
(AND (type? UID GraphNodeID)
(NC.UIDSetPropList GraphNodeID NIL]
(APPLY* (NCP.CardTypeFn 'Graph 'QuitFn)
Card])
(NC.MakeBrowserCardReadOnly
[LAMBDA (Card) (* ; "Edited 27-Jan-88 14:54 by MacDonald")
(* * Make a BrowserCard Read-Only.)
(DECLARE (GLOBALVARS NC.ShowPropListMenu))
(LET ((Window (NC.FetchWindow Card))
PropListEditor)
(NC.ProtectedCardOperation Card "Make Read-Only" Window (if (NC.CardSomehowDirtyP Card)
then (NC.SaveOrRevertGraphCard
Card Window))
(NC.SetUserDataProp Card 'ReadOnly T)
(NC.GetGraphEditMenu Window)
(SETQ NC.BrowserSafeItems '(Show% Links Show% Info Designate% FileBoxes
|Close and Save| |Browser Overview Win|))
(SETQ NC.BrowserSafeSubItems '(|Close and Save| |Close w/o Saving| |Save in NoteFile|
Indicate% NoteFile))
(if (WINDOWP (SETQ PropListEditor (NC.PropListEditorOpenP Window)))
then (NC.MakeTEditReadOnly Window)
(WINDOWPROP PropListEditor 'TEDIT.MENU NC.ShowPropListMenu))
(NC.MakeMenusReadOnly Window NC.BrowserSafeItems NC.BrowserSafeSubItems])
(NC.MakeBrowserCardReadWrite
[LAMBDA (Card) (* ; "Edited 27-Jan-88 14:56 by MacDonald")
(* * dwm |1/6/88| coerce Read/Write on a browser card)
(DECLARE (GLOBALVARS NC.EditPropListMenu))
(LET ((Window (NC.FetchWindow Card))
PropListEditor)
(NC.ProtectedCardOperation Card "Make Read-Write" Window (if (WINDOWP (SETQ PropListEditor
(
NC.PropListEditorOpenP
Window)))
then (NC.MakeTEditReadWrite
PropListEditor)
(WINDOWPROP PropListEditor
'TEDIT.MENU
NC.EditPropListMenu
))
(NC.SetUserDataProp Card 'ReadOnly NIL)
(WINDOWPROP Window 'RIGHTBUTTONFN (FUNCTION NC.BrowserRightButtonFn))
(NC.MakeMenusReadWrite Window])
)
(* ;;; "Miscellaneous")
(DEFINEQ
(NC.DelReferencesToCardFromBrowser
(LAMBDA (SourceCard LinkOrDestinationCard Don'tCreateDeletedImageObjFlg)
(* rht%: "10-Jun-87 15:37")
(* * Delete from the browser specified by SourceCard all link icon nodes whose
DESTINATIONID is eq to DestinationID. This just checks the case of the
SourceCard being a browser root and then passes off to GRAPHCARD's
DelReferencesFn.)
(* * rht 4/30/86%: No longer passes control up to Super's DeleteLinksFn.
Work is now done here.)
(* * rht 9/2/86%: Now sets dirtyflg of substance if change was made.)
(* * rht 11/4/86%: Now takes Don'tCreateDeletedImageObjFlg arg.)
(* * rht 6/10/87%: Now cleans up better in case when we're replacing node by
deleted link icon.)
(DECLARE (GLOBALVARS NC.UseDeletedLinkIconIndicatorsFlg NC.DeletedLinkImageObject))
(LET ((LinkFlg (type? Link LinkOrDestinationCard))
(ImageBox (NC.DeletedLinkImageBoxFn NC.DeletedLinkImageObject))
LinkIcon Graph DestinationCard BrowserRoots RootCardToDelete UID)
(if LinkFlg
then (OR (NC.CardP SourceCard)
(SETQ SourceCard (fetch (Link SourceCard) of LinkOrDestinationCard)))
(SETQ DestinationCard (fetch (Link DestinationCard) of LinkOrDestinationCard))
else (SETQ DestinationCard LinkOrDestinationCard))
(if (SETQ RootCardToDelete (for RootCard in (SETQ BrowserRoots (NC.FetchBrowserRoots
SourceCard))
eachtime (BLOCK) do (if (NC.SameCardP DestinationCard RootCard
)
then (RETURN RootCard))))
then (NC.SetBrowserRoots SourceCard (DREMOVE RootCardToDelete BrowserRoots)))
(SETQ Graph (NC.FetchSubstance SourceCard))
(for GraphNode in (fetch (GRAPH GRAPHNODES) of Graph)
when (AND (NC.LinkIconImageObjP (SETQ LinkIcon (fetch (GRAPHNODE NODELABEL) of GraphNode)
))
(if LinkFlg
then (NC.SameLinkP LinkOrDestinationCard (NC.FetchLinkFromLinkIcon LinkIcon
))
else (NC.SameCardP (fetch (Link DestinationCard) of (NC.FetchLinkFromLinkIcon
LinkIcon))
DestinationCard)))
do (if (AND NC.UseDeletedLinkIconIndicatorsFlg (NOT Don'tCreateDeletedImageObjFlg))
then (replace (GRAPHNODE NODELABEL) of GraphNode with NC.DeletedLinkImageObject)
(replace (GRAPHNODE NODEWIDTH) of GraphNode with (fetch (IMAGEBOX XSIZE)
of ImageBox))
(replace (GRAPHNODE NODEHEIGHT) of GraphNode with (fetch (IMAGEBOX YSIZE)
of ImageBox))
(NC.RemoveBrowserNodeHashArrayEntry SourceCard DestinationCard)
(if (type? UID (SETQ UID (fetch (GRAPHNODE NODEID) of GraphNode)))
then (NC.UIDSetPropList UID NIL))
(NC.SetSubstanceDirtyFlg SourceCard T)
else (NC.BrowserRemoveNode Graph (NC.FetchWindow SourceCard)
NIL GraphNode T)))
(if (AND (NC.ActiveCardP SourceCard)
(NC.FetchWindow SourceCard))
then (REDISPLAYGRAPH (NC.FetchWindow SourceCard))))))
(NC.NewBrowserNodeUIDFromOldUID
(LAMBDA (OldUID GraphNodes HashArray) (* rht%: " 1-Feb-86 15:59")
(* * Find and return the NodeID UID in GraphNodes that is SameUIDP to OldUID.
Use hash table for caching.)
(OR (GETHASH OldUID HashArray)
(for GraphNode in GraphNodes bind NewUID eachtime (BLOCK)
when (NC.SameUIDP OldUID (SETQ NewUID (fetch (GRAPHNODE NODEID) of GraphNode)))
do (RETURN (PUTHASH OldUID NewUID HashArray))))))
(NC.GetBrowserSubstance
(LAMBDA (Card Length Stream VersionNum) (* rht%: " 4-May-87 20:16")
(* * Go get all the browser-specific info and then get the graph that is the
browser's substance.)
(* * rht 2/14/86%: Added call to NC.ApplySupersFn)
(* * rht 2/28/86%: Added special handling for old version -1 style.
I.e. pre |1.3k.|)
(* * fgh |5/1/86| Can't have negative versions, so changed old style to be 255
255.0 Also added defaults for old style browser specs.)
(* * fgh |5/25/86| Undid preceeding change w.r.t.
the 255 versus -1 Turns out -1 never came from file, only from converter as an
arg.)
(* * rht 5/4/87%: Changed call from NC.ApplySupersFn to APPLY* because
otherwise we generate stack overflow for cards that specialize browser card
type.)
(if (NOT (EQP VersionNum -1))
then (NC.SetBrowserRootsInfo Card (NC.ReadBrowserRootsInfo Stream))
(NC.SetBrowserLinkLabels Card (NC.ReadBrowserLinkLabels Stream))
(NC.SetBrowserFormat Card (NC.ReadBrowserFormat Stream))
(NC.SetSpecialBrowserSpecs Card (NC.ReadSpecialBrowserSpecs Stream))
(NC.SetBrowserDepth Card (NC.ReadBrowserDepth Stream))
(NC.SetBrowserLinksLegend Card (NC.ReadBrowserLinksLegend Stream))
(NC.SetBrowserSavedLinkingInfo Card (NC.ReadBrowserSavedLinkingInfo Stream))
else (NC.SetBrowserRootsInfo Card NIL)
(NC.SetBrowserLinkLabels Card NIL)
(NC.SetBrowserFormat Card NIL)
(NC.SetSpecialBrowserSpecs Card NIL)
(NC.SetBrowserDepth Card 0)
(NC.SetBrowserLinksLegend Card NIL)
(NC.SetBrowserSavedLinkingInfo Card NIL))
(APPLY* (NCP.CardTypeFn 'Graph 'GetFn)
Card Length Stream VersionNum)))
(NC.ComputeBrowserSavedLinkingInfo
(LAMBDA (Card) (* rht%: "30-Apr-86 15:30")
(* * Search the graph nodeIDs of Card's substance for special linking info for
multiple links between same pair of nodes.)
(for GraphNode in (fetch (GRAPH GRAPHNODES) of (NC.FetchSubstance Card)) bind
SavedLinkingInfoForNode
UID
eachtime (BLOCK) when (AND (type? UID (SETQ UID (fetch (GRAPHNODE NODEID) of GraphNode)))
(SETQ SavedLinkingInfoForNode (
NC.ComputeBrowserSavedLinkingInfoForNode
UID))) collect (CONS UID
SavedLinkingInfoForNode
))))
(NC.ComputeBrowserSavedLinkingInfoForNode
(LAMBDA (UID) (* rht%: " 7-Feb-86 00:43")
(* * Return list of DestUIDs and link dashing info.)
(for UserData on (NC.UIDGetPropList UID) by (CDDR UserData) when (type? UID (CAR UserData))
join (LIST (CAR UserData)
(CADR UserData)))))
)
(DEFINEQ
(NC.FetchBrowserRootsInfo
(LAMBDA (Card) (* rht%: "11-Feb-86 23:28")
(* * Return the browser roots UID pairs for this browser card.)
(NC.FetchUserDataProp Card 'BrowserRootsInfo)))
(NC.FetchBrowserLinkLabels
(LAMBDA (Card) (* rht%: "11-Feb-86 23:28")
(* * Return the browser link labels for this browser card.)
(NC.FetchUserDataProp Card 'BrowserLinkLabels)))
(NC.FetchBrowserFormat
(LAMBDA (Card) (* rht%: "11-Feb-86 23:28")
(* * Return the browser format for this browser card.)
(NC.FetchUserDataProp Card 'BrowserFormat)))
(NC.FetchSpecialBrowserSpecs
(LAMBDA (Card) (* rht%: "11-Feb-86 23:28")
(* * Return the special browser specs for this browser card.)
(NC.FetchUserDataProp Card 'SpecialBrowserSpecs)))
(NC.FetchBrowserDepth
(LAMBDA (Card) (* rht%: "11-Feb-86 23:27")
(* * Return the browser depth for this browser card.)
(NC.FetchUserDataProp Card 'BrowserDepth)))
(NC.FetchBrowserSavedLinkingInfo
(LAMBDA (Card) (* rht%: "11-Feb-86 23:27")
(* * Return the special linking info for this browser card.)
(NC.FetchUserDataProp Card 'BrowserSavedLinkingInfo)))
(NC.FetchBrowserLinksLegend
(LAMBDA (Card) (* rht%: "11-Feb-86 23:27")
(* * Return the links legend label pairs for this browser card.)
(NC.FetchUserDataProp Card 'BrowserLinksLegend)))
)
(DEFINEQ
(NC.SetBrowserRootsInfo
(LAMBDA (Card BrowserRootsInfo) (* rht%: "11-Feb-86 23:30")
(* * Set the browser card's browser roots pairs.)
(NC.SetUserDataProp Card 'BrowserRootsInfo BrowserRootsInfo)))
(NC.SetBrowserLinkLabels
(LAMBDA (Card BrowserLinkLabels) (* rht%: "11-Feb-86 23:30")
(* * Set the browser card's link labels.)
(NC.SetUserDataProp Card 'BrowserLinkLabels BrowserLinkLabels)))
(NC.SetBrowserFormat
(LAMBDA (Card BrowserFormat) (* rht%: "11-Feb-86 23:30")
(* * Set the browser card's format.)
(NC.SetUserDataProp Card 'BrowserFormat BrowserFormat)))
(NC.SetSpecialBrowserSpecs
(LAMBDA (Card SpecialBrowserSpecs) (* rht%: "11-Feb-86 23:30")
(* * Set the browser card's special browser specs.)
(NC.SetUserDataProp Card 'SpecialBrowserSpecs SpecialBrowserSpecs)))
(NC.SetBrowserDepth
(LAMBDA (Card BrowserDepth) (* rht%: "11-Feb-86 23:29")
(* * Set the browser card's depth.)
(NC.SetUserDataProp Card 'BrowserDepth BrowserDepth)))
(NC.SetBrowserSavedLinkingInfo
(LAMBDA (Card BrowserSavedLinkingInfo) (* rht%: "20-Feb-86 11:44")
(* * Set the browser special linking info.)
(* * rht 2/20/86%: Now returns the value we set to.)
(NC.SetUserDataProp Card 'BrowserSavedLinkingInfo BrowserSavedLinkingInfo)
BrowserSavedLinkingInfo))
(NC.SetBrowserLinksLegend
(LAMBDA (Card BrowserLinksLegend) (* rht%: "11-Feb-86 23:29")
(* * Set the browser card's links legend label pairs.)
(NC.SetUserDataProp Card 'BrowserLinksLegend BrowserLinksLegend)))
)
(DEFINEQ
(NC.ReadBrowserRootsInfo
(LAMBDA (Stream) (* rht%: "20-Feb-86 14:34")
(* * Read pairs of UIDs corresponding to card and notefile UIDs for each
browser root. These pairs are bounded by left and right parens.)
(LET (CharRead)
(if (NEQ (SETQ CharRead (CHARACTER (BIN Stream)))
'%()
then (NC.ReportError "NC.ReadBrowserRootsInfo" (CONCAT
"Expected to read left paranthesis. Saw: "
CharRead)))
(PROG1 (while (NEQ (CHARACTER (\PEEKBIN Stream))
'%)) eachtime (BLOCK) collect (CONS (NC.ReadUID Stream)
(NC.ReadUID Stream)))
(BIN Stream)))))
(NC.ReadBrowserLinkLabels
(LAMBDA (Stream) (* rht%: " 1-Nov-86 15:43")
(* * Read list of link labels from notefile.)
(* * rht 11/1/86%: Now uses our readtable when reading.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PROG1 (READ Stream NC.OrigReadTable)
(BIN Stream))))
(NC.ReadBrowserFormat
(LAMBDA (Stream) (* rht%: " 1-Nov-86 15:43")
(* * Read browser format from notefile.)
(* * rht 11/1/86%: Now uses our readtable when reading.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PROG1 (READ Stream NC.OrigReadTable)
(BIN Stream))))
(NC.ReadSpecialBrowserSpecs
(LAMBDA (Stream) (* rht%: " 1-Nov-86 15:44")
(* * Read special browser specs from notefile.)
(* * rht 11/1/86%: Now uses our readtable when reading.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PROG1 (READ Stream NC.OrigReadTable)
(BIN Stream))))
(NC.ReadBrowserDepth
(LAMBDA (Stream) (* rht%: " 1-Nov-86 15:44")
(* * Read depth from notefile.)
(* * rht 11/1/86%: Now uses our readtable when reading.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(LET ((ThingRead (READ Stream NC.OrigReadTable)))
(if (NOT (FIXP ThingRead))
then (NC.ReportError "NC.ReadBrowserFormat" (CONCAT "Expected to read a number. Saw: "
ThingRead)))
(* Skip CR)
(BIN Stream)
ThingRead)))
(NC.ReadBrowserSavedLinkingInfo
(LAMBDA (Stream) (* rht%: "20-Feb-86 14:36")
(* * Read lists of info on multiple links between nodes.
Each list consists of a UID cons'ed to a prop list of destination UIDs and link
dashing info.)
(LET (CharRead)
(if (NEQ (SETQ CharRead (CHARACTER (BIN Stream)))
'%()
then (NC.ReportError "NC.ReadBrowserSavedLinkingInfo" (CONCAT
"Expected to read left paranthesis. Saw: "
CharRead)))
(PROG1 (while (NEQ (CHARACTER (\PEEKBIN Stream))
'%)) eachtime (BLOCK) collect (NC.ReadBrowserSavedLinkingInfoForNode
Stream))
(* Skip RightParen)
(BIN Stream)))))
(NC.ReadBrowserSavedLinkingInfoForNode
[LAMBDA (Stream) (* ; "Edited 11-May-88 22:14 by Trigg")
(* ;;; "Read list of info on multiple links for a particular node. In form of a source UID cons'ed to a prop list of destination UIDs and link dashing info.")
(* ;; "rht 11/1/86: Now uses our readtable when reading.")
(* ;; "rht 5/11/88: Now passes non-nil second arg to NC.ReadUID so as to reuse old equivalent UID objects if any.")
(DECLARE (GLOBALVARS NC.OrigReadTable))
(LET (CharRead SourceUID)
(if (NEQ (SETQ CharRead (CHARACTER (BIN Stream)))
'%()
then (NC.ReportError "NC.ReadBrowserSavedLinkingInfoForNode" (CONCAT
"Expected to read left paranthesis. Saw: "
CharRead)))
(PROG1 [CONS (NC.ReadUID Stream T)
(while (NEQ (CHARACTER (\PEEKBIN Stream))
'%)) eachtime (BLOCK) join (PROG1 (LIST (NC.ReadUID Stream T)
(READ Stream
NC.OrigReadTable))
(* ; "Skip CR")
(BIN Stream))]
(* ; "Skip RightParen")
(BIN Stream))])
(NC.ReadBrowserLinksLegend
(LAMBDA (Stream) (* rht%: " 1-Nov-86 15:44")
(* * Read links legend from notefile.)
(* * rht 11/1/86%: Now uses our readtable when reading.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PROG1 (READ Stream NC.OrigReadTable)
(BIN Stream))))
)
(DEFINEQ
(NC.WriteBrowserRootsInfo
(LAMBDA (Stream BrowserRootUIDPairs) (* rht%: " 6-Feb-86 23:30")
(* * Write pairs of UIDs corresponding to card and notefile UIDs for each
browser root. These pairs are bounded by left and right parens.)
(PRIN1 '%( Stream)
(for BrowserRootUIDPair in BrowserRootUIDPairs eachtime (BLOCK) do (NC.WriteUID Stream
(CAR BrowserRootUIDPair
))
(NC.WriteUID Stream
(CDR BrowserRootUIDPair
)))
(PRIN1 '%) Stream)))
(NC.WriteBrowserLinkLabels
(LAMBDA (Stream LinkLabels) (* rht%: " 1-Nov-86 15:37")
(* * Write list of link labels from notefile.)
(* * rht 11/1/86%: Now uses our readtable when printing.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PRINT LinkLabels Stream NC.OrigReadTable)))
(NC.WriteBrowserFormat
(LAMBDA (Stream Format) (* rht%: " 1-Nov-86 15:37")
(* * Write browser format to notefile.)
(* * rht 11/1/86%: Now uses our readtable when printing.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PRINT Format Stream NC.OrigReadTable)))
(NC.WriteSpecialBrowserSpecs
(LAMBDA (Stream LinkLabels) (* rht%: " 1-Nov-86 15:38")
(* * Write special browser specs to notefile.)
(* * rht 11/1/86%: Now uses our readtable when printing.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PRINT LinkLabels Stream NC.OrigReadTable)))
(NC.WriteBrowserDepth
(LAMBDA (Stream Depth) (* rht%: " 1-Nov-86 15:38")
(* * Write depth to notefile.)
(* * rht 11/1/86%: Now uses our readtable when printing.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PRINT Depth Stream NC.OrigReadTable)))
(NC.WriteBrowserSavedLinkingInfo
(LAMBDA (Stream BrowserSavedLinkingInfo) (* rht%: " 7-Feb-86 00:29")
(* * Write lists of info on multiple links between nodes.
Each list consists of a UID cons'ed to a prop list of destination UIDs and link
dashing info.)
(PRIN1 '%( Stream)
(for BrowserSavedLinkingInfoForNode in BrowserSavedLinkingInfo eachtime (BLOCK)
do (NC.WriteBrowserSavedLinkingInfoForNode Stream BrowserSavedLinkingInfoForNode))
(PRIN1 '%) Stream)))
(NC.WriteBrowserSavedLinkingInfoForNode
(LAMBDA (Stream BrowserSavedLinkingInfoForNode) (* rht%: " 1-Nov-86 15:39")
(* * Write list of info on multiple links for a particular node.
In form of a source UID cons'ed to a prop list of destination UIDs and link
dashing info.)
(* * rht 11/1/86%: Now uses our readtable when printing.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PRIN1 '%( Stream)
(NC.WriteUID Stream (CAR BrowserSavedLinkingInfoForNode))
(for SavedLinkInfo on (CDR BrowserSavedLinkingInfoForNode) by (CDDR SavedLinkInfo)
eachtime (BLOCK) do (NC.WriteUID Stream (CAR SavedLinkInfo))
(PRINT (CADR SavedLinkInfo)
Stream NC.OrigReadTable))
(PRIN1 '%) Stream)))
(NC.WriteBrowserLinksLegend
(LAMBDA (Stream LinksLegend) (* rht%: " 1-Nov-86 15:38")
(* * Write links legend to notefile.)
(* * rht 11/1/86%: Now uses our readtable when printing.)
(DECLARE (GLOBALVARS NC.OrigReadTable))
(PRINT LinksLegend Stream NC.OrigReadTable)))
)
(DEFINEQ
(NC.GraphLinkIconUpdateCheck
[LAMBDA (GraphCard Window Graph UpdateIfNullCacheFlg) (* ; "Edited 28-Jan-88 18:08 by pmi")
(* ;; "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.")
(* ;; "rht 2/20/86: Changed to use card's user data area instead of props.")
(* ;; "pmi 1/28/88: Added more global params (NC.LinkIconFont NC.LinkIconMultiLineMode NC.LinkIconMaxWidth and NC.LinkIconBorderWidth) to be cached and checked.")
(DECLARE (GLOBALVARS NC.LinkIconShowTitleFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconAttachBitmapFlg NC.LinkIconFont NC.LinkIconMultiLineMode
NC.LinkIconMaxWidth NC.LinkIconBorderWidth))
(LET ((OldGlobalParams (NC.FetchUserDataProp GraphCard 'CachedGlobalParams))
(CurGlobalParams (LIST NC.LinkIconShowTitleFlg NC.LinkIconShowLinkTypeFlg
NC.LinkIconAttachBitmapFlg NC.LinkIconFont NC.LinkIconMultiLineMode
NC.LinkIconMaxWidth NC.LinkIconBorderWidth))
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.SetUserDataProp GraphCard 'CachedGlobalParams CurGlobalParams))
DidWorkFlg])
(NC.BrowserRepaintFn
(LAMBDA (Window Region) (* rht%: "15-Nov-85 16:05")
(* * Check if cached global params have changed.
If so, fix graph nodes before redisplaying.)
(NC.GraphLinkIconUpdateCheck (NC.CoerceToCard Window)
Window
(WINDOWPROP Window 'GRAPH)
NIL)))
(NC.CoerceToGraphNodeID
(LAMBDA (NodeOrNodeID) (* rht%: "26-Nov-85 01:25")
(* * Extract the graph node ID from a graph node, a virtual node, or a Link
params thingie.)
(if (AND (LISTP NodeOrNodeID)
(EQ (CAR NodeOrNodeID)
LINKPARAMS))
then (SETQ NodeOrNodeID (CADR NodeOrNodeID)))
(if (LISTP NodeOrNodeID)
then (SETQ NodeOrNodeID (CAR NodeOrNodeID)))
(if (LISTP NodeOrNodeID)
then (SETQ NodeOrNodeID (CAR NodeOrNodeID)))
(AND (type? UID 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)))))
(NC.GetBrowserNodeID
[LAMBDA (BrowserCard NodeCard) (* DSJ%: "11-Nov-87 20:55")
(* * Create a browser node atom from a new UID.
Hang the card object off as a property for those who need it.)
(* * rht 11/18/85%: Now checks to see if NodeCard already appears in graph
before creating a new GraphNodeID. Use the browser hash array to do the lookup.)
(* * rht 6/1/87%: Changed hash array to map from card UIDs to graph node ids
rather than from card objects to graph node ids.)
(* * dsj. |11/12/87.| Changed so won't break if NodeCard if NIL.
It may be in certain 1.2 --> 1.3 conversion cases.)
(LET ((HashArray (NC.HashArrayFromBrowserCard BrowserCard))
(NodeCardUID (AND NodeCard (fetch (Card UID) of NodeCard)))
NewUID)
(if (GETHASH NodeCardUID HashArray)
else (NC.GraphNodeIDPutProp (SETQ NewUID (NC.MakeBrowserNodeUID))
'CardObject NodeCard)
(PUTHASH NodeCardUID NewUID HashArray)
NewUID])
(NC.MakeBrowserNodeUID
(LAMBDA NIL (* rht%: "18-Nov-85 21:29")
(* * Create a standard UID, but make sure it's an atom.)
(NC.MakeUID)))
(NC.GetBrowserHashArray
(LAMBDA (BrowserCard Graph) (* rht%: "10-Jun-87 22:41")
(* * Build and install a hash array mapping cards to browsernode UIDs, unless
one's already there. If Graph argument is nil, then make a new hash array
smashing any existin one.)
(* * rht 4/30/86%: Now makes sure we're not working with a label node instead
of a card node.)
(* * rht 6/1/87%: Changed hash array to map from card UIDs to graph node ids
rather than from card objects to graph node ids.)
(* * rht 6/10/87%: Now checks that CardObject on GraphNodeID is valid card
before stashing in hash array.)
(DECLARE (GLOBALVARS NC.BrowserHashArraySize))
(if (AND Graph (NC.HashArrayFromBrowserCard BrowserCard))
else (LET ((HashArray (NC.CreateUIDHashArray NC.BrowserHashArraySize)))
(NC.SetUserDataProp BrowserCard 'BrowserHashArray HashArray)
(AND Graph (for GraphNode in (fetch (GRAPH GRAPHNODES) of Graph) bind GraphNodeID
eachtime (BLOCK) when (SETQ GraphNodeID (NC.CoerceToGraphNodeID
GraphNode))
do (LET ((CardObject (NC.GraphNodeIDGetProp GraphNodeID 'CardObject)))
(if (NC.ValidCardP CardObject)
then (PUTHASH (fetch (Card UID) of CardObject)
GraphNodeID HashArray)))))))))
(NC.RemoveBrowserNodeHashArrayEntry
(LAMBDA (BrowserCard NodeCard) (* rht%: " 1-Jun-87 21:40")
(* * Remove the entry for given card from given browser's hash array.)
(* * rht 6/1/87%: Now expects hash array to map from card UIDs to graph node
ids rather than from card objects to graph node ids.)
(LET ((HashArray (NC.HashArrayFromBrowserCard BrowserCard)))
(if HashArray
then (PUTHASH (fetch (Card UID) of NodeCard)
NIL HashArray)))))
(NC.HashArrayFromBrowserCard
(LAMBDA (BrowserCard) (* rht%: "18-Nov-85 22:39")
(* * Return the browser hash array for this browser.)
(NC.FetchUserDataProp BrowserCard 'BrowserHashArray)))
(NC.CardFromBrowserNodeID
(LAMBDA (BrowserNodeID) (* rht%: " 6-Jul-86 17:27")
(* * Extract the card from a browser nodeID.)
(* * rht 6/10/86%: Now checks first for valid UID.)
(AND (type? UID BrowserNodeID)
(NC.GraphNodeIDGetProp BrowserNodeID 'CardObject))))
(NC.CardFromBrowserNode
[LAMBDA (GraphNode) (* ; "Edited 21-Jan-88 22:37 by Trigg")
(* ;; "If this is a graph node that corresponds to a valid notecard, then return the card.")
(LET [(Card (NC.CardFromBrowserNodeID (NC.CoerceToGraphNodeID GraphNode]
(if (NCP.ValidCardP Card)
then Card])
(NC.SmashGraphNodeIDProps
(LAMBDA (GraphNodeID) (* rht%: " 5-Jun-87 15:34")
(* * Smash the prop list of GraphNodeID except be sure to save the CardObject
prop if there is one.)
(* * rht 6/5/87%: Now checks to make sure GraphNodeID is a UID before trying to
clear its proplist.)
(LET ((Card (NC.CardFromBrowserNodeID GraphNodeID)))
(AND (type? UID GraphNodeID)
(NC.UIDSetPropList GraphNodeID NIL))
(AND Card (NC.GraphNodeIDPutProp GraphNodeID 'CardObject Card)))))
(NC.PutBrowserSubstance
(LAMBDA (Card Stream) (* rht%: " 4-May-87 20:14")
(* * For each BrowserUID, clear its UID prop list.
Otherwise HPRINT will die in PutGraphSubstance.)
(* * rht 1/23/86%: Now takes Stream as arg)
(* * rht 2/1/86%: Now saves old UID information on card's proplist for
restoring when card is brought up again.
Note that this info will only exist for nodes connected to some other node with
multiple links.)
(* * fgh |2/5/86| Added call to NC.ApplySupersFn)
(* * rht 2/6/86%: Now writes down all browser info to substance rather than
letting it live on prop list.)
(* * rht 2/20/86%: Now checks to see if saved linking info is cached before
recomputing it.)
(* * fgh |5/25/86| Added default depth paramter.)
(* * rht 5/4/87%: Changed call from NC.ApplySupersFn to APPLY* because
otherwise we generate stack overflow for cards that specialize browser card
type.)
(NC.WriteBrowserRootsInfo Stream (NC.FetchBrowserRootsInfo Card))
(NC.WriteBrowserLinkLabels Stream (NC.FetchBrowserLinkLabels Card))
(NC.WriteBrowserFormat Stream (NC.FetchBrowserFormat Card))
(NC.WriteSpecialBrowserSpecs Stream (NC.FetchSpecialBrowserSpecs Card))
(NC.WriteBrowserDepth Stream (OR (NC.FetchBrowserDepth Card)
0))
(NC.WriteBrowserLinksLegend Stream (NC.FetchBrowserLinksLegend Card))
(NC.WriteBrowserSavedLinkingInfo Stream (OR (NC.FetchBrowserSavedLinkingInfo Card)
(NC.SetBrowserSavedLinkingInfo Card (
NC.ComputeBrowserSavedLinkingInfo
Card))))
(APPLY* (NCP.CardTypeFn 'Graph 'PutFn)
Card Stream)))
(NC.FetchBrowserRoots
(LAMBDA (Card) (* rht%: " 7-Feb-86 12:29")
(* * Get roots off Card's UID list and convert them from UID pairs to Card
objects.)
(for BrowserRootUIDPair in (NC.FetchBrowserRootsInfo Card) eachtime (BLOCK)
collect (NC.CardFromUID (CAR BrowserRootUIDPair)
(NC.NoteFileFromNoteFileUID (CDR BrowserRootUIDPair))))))
(NC.SetBrowserRoots
(LAMBDA (Card BrowserRoots) (* rht%: " 6-Feb-87 18:38")
(* * Put the roots on the Card's UID property list in the CardUID/NoteFileUID
pair format.)
(* * rht 2/6/87%: Now checks that BrowserRoots are valid cards.)
(NC.SetBrowserRootsInfo Card (for BrowserRoot in BrowserRoots eachtime (BLOCK)
when (NC.ValidCardP BrowserRoot)
collect (CONS (fetch (Card UID) of BrowserRoot)
(fetch (NoteFile UID) of (fetch (Card NoteFile)
of BrowserRoot)))))))
)
(DEFINEQ
(NC.GraphNodeIDGetProp
(LAMBDA (GraphNodeID PropName) (* rht%: " 6-Jul-86 17:22")
(* * Do a GETPROP either to the UID or to the atom if it's a label.)
(if (type? UID GraphNodeID)
then (NC.UIDGetProp GraphNodeID PropName)
else (GETPROP GraphNodeID PropName))))
(NC.GraphNodeIDPutProp
(LAMBDA (GraphNodeID PropName Value) (* rht%: " 6-Jul-86 17:23")
(* * Do a PUTPROP either to the UID or to the atom if it's a label.)
(if (type? UID GraphNodeID)
then (NC.UIDPutProp GraphNodeID PropName Value)
else (PUTPROP GraphNodeID PropName Value))))
(NC.GraphNodeIDRemProp
(LAMBDA (GraphNodeID PropName) (* rht%: " 6-Jul-86 17:23")
(* * Do a REMPROP either to the UID or to the atom if it's a label.)
(if (type? UID GraphNodeID)
then (NC.UIDRemProp GraphNodeID PropName)
else (REMPROP GraphNodeID PropName))))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.ArrowHeadLength NC.ArrowHeadAngle NC.ArrowHeadXVal NC.ArrowHeadYVal)
)
(RPAQ? NC.ArrowHeadLength 7)
(RPAQ? NC.ArrowHeadAngle 20)
(RPAQ? NC.ArrowHeadXVal (TIMES NC.ArrowHeadLength (COS NC.ArrowHeadAngle)))
(RPAQ? NC.ArrowHeadYVal (TIMES NC.ArrowHeadLength (SIN NC.ArrowHeadAngle)))
(* ;;; "init")
(DEFINEQ
(NC.AddBrowserCard
[LAMBDA NIL (* ; "Edited 29-Jul-88 20:32 by Trigg")
(* ;; "fgh 11/14/85 Updated to handle merge of card and substance types.")
(* ;; "rht 4/7/86: Added middle button menu items.")
(* ;; "rht 4/25/87: Added QuitFn")
(* ;; "rht 7/29/88: Added ChangeBrowserRoots item to middle button menu")
(DECLARE (GLOBALVARS NC.GlobalInsertLinkMenuItem))
(NC.AddCardType 'Browser 'Graph `[(MakeFn ,(FUNCTION NC.MakeBrowserCard))
(EditFn ,(FUNCTION NC.BringUpBrowserCard))
(PutFn ,(FUNCTION NC.PutBrowserSubstance))
(GetFn ,(FUNCTION NC.GetBrowserSubstance))
(DeleteLinksFn ,(FUNCTION NC.DelReferencesToCardFromBrowser))
(QuitFn ,(FUNCTION NC.BrowserCardQuitFn]
`((LinkDisplayMode Title)
(DefaultHeight 350)
(DefaultWidth 500)
(DisplayedInMenuFlg ,T)
[LeftButtonMenuItems ,(for Item in (NC.GetCardTypeField LeftButtonMenuItems 'Graph)
collect (if (EQ (CAR Item)
'Insert% Link)
then NC.GlobalInsertLinkMenuItem
else Item]
(MiddleButtonMenuItems ,'((Recompute% Browser (FUNCTION NC.UpdateBrowserCard)
"Recomputes this browser to show the current state of the NoteFile."
)
(Relayout% Graph (FUNCTION NC.RelayoutBrowserCard)
"Re-layout the browser, but keep same nodes.")
(Reconnect% Nodes (FUNCTION NC.ConnectNodesInBrowser)
"Draw all possible links, from currently selected link types, between pairs of nodes."
)
(Unconnect% Nodes (FUNCTION NC.UnconnectNodesInBrowser)
"Undraw all links in the browser.")
(|Expand Browser Node| (FUNCTION NC.ExpandBrowserNode)
"Expand the graph under one node to a given depth.")
(|Graph Edit Menu| (FUNCTION NC.GetGraphEditMenu)
"Bring up the graph editor menu.")
(|Change Browser Specs| (FUNCTION NC.ChangeBrowserSpecs)
"Make changes to some or all of the browser specs, e.g. link types, depth, etc."
)
(|Change Browser Roots| (FUNCTION NC.ChangeBrowserRoots)
"Change which nodes in the browser are considered roots."
)
(|Browser Overview Win| (FUNCTION NC.MakeBrowserOverviewWin)
"Attach the browser overview window.")
(|Change Overview Specs| (FUNCTION NC.AskBrowserOverviewSpecs)
"Change the browser overview specs: where to attach and what mode."
])
)
(DECLARE%: DONTEVAL@LOAD
(NC.AddBrowserCard)
)
(PUTPROPS NCBROWSERCARD FILETYPE :TCOMPL)
(PUTPROPS NCBROWSERCARD MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP" :BASE 10))
(PUTPROPS NCBROWSERCARD COPYRIGHT ("Xerox Corporation" 1985 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (15659 16212 (NCAddStub.BrowserCard 15669 . 16210)) (21460 40093 (NC.MakeBrowserCard
21470 . 34311) (NC.BringUpBrowserCard 34313 . 40091)) (40094 126687 (NC.GrowLinkLattice 40104 . 51105)
(NC.UpdateBrowserCard 51107 . 66580) (NC.RelayoutBrowserCard 66582 . 75968) (NC.LayoutNewBrowserNodes
75970 . 79713) (NC.ConnectNodesInBrowser 79715 . 88332) (NC.UnconnectNodesInBrowser 88334 . 91109) (
NC.ExpandBrowserNode 91111 . 102727) (NC.AskBrowserSpecs 102729 . 111967) (NC.ChangeBrowserSpecs
111969 . 115234) (NC.AskSpecialBrowserSpecs 115236 . 116819) (NC.BrowserFlipRoots 116821 . 117495) (
NC.ChangeBrowserRoots 117497 . 118465) (NC.RespecifyBrowserRoots 118467 . 119480) (NC.SelectGraphNode
119482 . 120627) (NC.DisplayGraphLinksBetween 120629 . 121587) (NC.RebuildFromNodesInGraph 121589 .
122603) (NC.RemoveDuplicateNodesFromGraph 122605 . 125109) (NC.ShowBrowserGraph 125111 . 126685)) (
126735 186670 (NC.SetUpGraphEditMenus 126745 . 128776) (NC.GetGraphEditMenu 128778 . 130683) (
NC.BrowserRightButtonFn 130685 . 131174) (NC.GraphEditMenuWhenSelectedFn 131176 . 131528) (
NC.BrowserCreateCardFn 131530 . 132033) (NC.BrowserAddLabelFn 132035 . 132470) (NC.BrowserAddNodeFn
132472 . 132915) (NC.BrowserCreateLinkFn 132917 . 133626) (NC.BrowserCreateGlobalLinkFn 133628 .
134365) (NC.BrowserAddLink 134367 . 143399) (NC.BrowserAddGlobalLink 143401 . 143691) (
NC.BrowserAddEdgeFn 143693 . 144387) (NC.BrowserDeleteCardFn 144389 . 145062) (NC.BrowserRemoveNodeFn
145064 . 145731) (NC.BrowserDeleteLinkFn 145733 . 146448) (NC.BrowserRemoveEdgeFn 146450 . 147163) (
NC.BrowserShrinkLabelFn 147165 . 147720) (NC.BrowserGrowLabelFn 147722 . 148276) (NC.BrowserMoveNodeFn
148278 . 148868) (NC.CursorInsideGraphNodeP 148870 . 149722) (NC.BrowserMoveNodesInRegionFn 149724 .
150347) (NC.BrowserMoveSubtreeFn 150349 . 150973) (NC.BrowserFixGraphEditMenuFn 150975 . 152580) (
NC.BrowserCreateCard 152582 . 154617) (NC.BrowserCreateLink 154619 . 157124) (NC.BrowserDeleteLink
157126 . 165745) (NC.BrowserAddNode 165747 . 170659) (NC.BrowserAddLabel 170661 . 171141) (
NC.BrowserAddEdge 171143 . 172186) (NC.BrowserRemoveNode 172188 . 178994) (NC.DelBrowserContentsLink
178996 . 181590) (NC.BrowserRemoveEdge 181592 . 186668)) (186715 217404 (NC.MakeLinksLegend 186725 .
199459) (NC.MakeLinksLegendMenu 199461 . 203192) (NC.LinksLegendRepaintFn 203194 . 204900) (
NC.BrowserDrawLinkFn 204902 . 207912) (NC.DrawFlowerLinks 207914 . 209357) (NC.DrawFlowerLink 209359
. 212947) (NC.LinksLegendReshapeFn 212949 . 213201) (NC.DrawArrowHead 213203 . 217402)) (219860
225302 (NC.MakeBrowserOverviewWin 219870 . 222582) (NC.AskBrowserOverviewSpecs 222584 . 225300)) (
225303 249703 (NC.DRAWBOX 225313 . 226079) (NC.ShrinkGraphToWindow 226081 . 228104) (NC.ScaleGraphNode
228106 . 231191) (NC.ComputeOverviewScale 231193 . 231857) (NC.RedrawBrowserOverviewWin 231859 .
232909) (NC.DrawWireFrameInOverviewWin 232911 . 234813) (NC.CompressOverviewWin 234815 . 237144) (
NC.ReattachBrowserOverviewWin 237146 . 238496) (NC.BrowserScrollFn 238498 . 239099) (
NC.BrowserReshapeFn 239101 . 239701) (NC.BrowserOverviewWinRepaintFn 239703 . 239953) (
NC.BrowserOverviewWinReshapeFn 239955 . 241655) (NC.BrowserOverviewWinMINSIZEFn 241657 . 242727) (
NC.BrowserOverviewWinButtonEventFn 242729 . 246105) (NC.BrowserCardQuitFn 246107 . 246859) (
NC.MakeBrowserCardReadOnly 246861 . 248235) (NC.MakeBrowserCardReadWrite 248237 . 249701)) (249736
258109 (NC.DelReferencesToCardFromBrowser 249746 . 253936) (NC.NewBrowserNodeUIDFromOldUID 253938 .
254486) (NC.GetBrowserSubstance 254488 . 256547) (NC.ComputeBrowserSavedLinkingInfo 256549 . 257705) (
NC.ComputeBrowserSavedLinkingInfoForNode 257707 . 258107)) (258110 259911 (NC.FetchBrowserRootsInfo
258120 . 258376) (NC.FetchBrowserLinkLabels 258378 . 258632) (NC.FetchBrowserFormat 258634 . 258875) (
NC.FetchSpecialBrowserSpecs 258877 . 259137) (NC.FetchBrowserDepth 259139 . 259377) (
NC.FetchBrowserSavedLinkingInfo 259379 . 259646) (NC.FetchBrowserLinksLegend 259648 . 259909)) (259912
261807 (NC.SetBrowserRootsInfo 259922 . 260177) (NC.SetBrowserLinkLabels 260179 . 260429) (
NC.SetBrowserFormat 260431 . 260664) (NC.SetSpecialBrowserSpecs 260666 . 260932) (NC.SetBrowserDepth
260934 . 261163) (NC.SetBrowserSavedLinkingInfo 261165 . 261537) (NC.SetBrowserLinksLegend 261539 .
261805)) (261808 267613 (NC.ReadBrowserRootsInfo 261818 . 262740) (NC.ReadBrowserLinkLabels 262742 .
263123) (NC.ReadBrowserFormat 263125 . 263497) (NC.ReadSpecialBrowserSpecs 263499 . 263884) (
NC.ReadBrowserDepth 263886 . 264573) (NC.ReadBrowserSavedLinkingInfo 264575 . 265622) (
NC.ReadBrowserSavedLinkingInfoForNode 265624 . 267234) (NC.ReadBrowserLinksLegend 267236 . 267611)) (
267614 271748 (NC.WriteBrowserRootsInfo 267624 . 268537) (NC.WriteBrowserLinkLabels 268539 . 268903) (
NC.WriteBrowserFormat 268905 . 269254) (NC.WriteSpecialBrowserSpecs 269256 . 269622) (
NC.WriteBrowserDepth 269624 . 269962) (NC.WriteBrowserSavedLinkingInfo 269964 . 270527) (
NC.WriteBrowserSavedLinkingInfoForNode 270529 . 271387) (NC.WriteBrowserLinksLegend 271389 . 271746))
(271749 283836 (NC.GraphLinkIconUpdateCheck 271759 . 273463) (NC.BrowserRepaintFn 273465 . 273840) (
NC.CoerceToGraphNodeID 273842 . 274489) (NC.CoerceToGraphNodeIDOrLabel 274491 . 275043) (
NC.GetBrowserNodeID 275045 . 276223) (NC.MakeBrowserNodeUID 276225 . 276438) (NC.GetBrowserHashArray
276440 . 278170) (NC.RemoveBrowserNodeHashArrayEntry 278172 . 278766) (NC.HashArrayFromBrowserCard
278768 . 279024) (NC.CardFromBrowserNodeID 279026 . 279390) (NC.CardFromBrowserNode 279392 . 279788) (
NC.SmashGraphNodeIDProps 279790 . 280409) (NC.PutBrowserSubstance 280411 . 282557) (
NC.FetchBrowserRoots 282559 . 283027) (NC.SetBrowserRoots 283029 . 283834)) (283837 284912 (
NC.GraphNodeIDGetProp 283847 . 284196) (NC.GraphNodeIDPutProp 284198 . 284559) (NC.GraphNodeIDRemProp
284561 . 284910)) (285288 289172 (NC.AddBrowserCard 285298 . 289170)))))
STOP