(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "29-Jul-88 20:32:53" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH328.;2 46153
changes to%: (FNS NC.RespecifyBrowserRoots NC.AddBrowserCard NC.UpdateBrowserCard
NC.ChangeBrowserRoots NC.RelayoutBrowserCard NC.ExpandBrowserNode
NC.ChangeBrowserSpecs)
(VARS RHTPATCH328COMS)
previous date%: "29-Jul-88 20:27:25" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH328.;1)
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RHTPATCH328COMS)
(RPAQQ RHTPATCH328COMS
((DECLARE%: DONTCOPY (PROPS (RHTPATCH328 MAKEFILE-ENVIRONMENT)
(RHTPATCH328 FILETYPE)))
[DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'NCBROWSERCARD]
(* ;; "Adds ChangeRoots option to Browser card middle button menu. Also removed all the archaic calls to NC.SetPropListDirtyFlg dating from the days we stored browser info on the card's proplist. ")
(* ;; "New functions for NCBROWSERCARD")
(FNS NC.ChangeBrowserRoots NC.RespecifyBrowserRoots)
(* ;; "Changes to NCBROWSERCARD")
(FNS NC.UpdateBrowserCard NC.AddBrowserCard NC.RelayoutBrowserCard NC.ExpandBrowserNode
NC.ChangeBrowserSpecs)
(* ;; "Following is just to make the patch file work. PLEASE DON'T PUT IN NCBROWSERCARD.")
(P (NC.AddBrowserCard))))
(DECLARE%: DONTCOPY
(PUTPROPS RHTPATCH328 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS RHTPATCH328 FILETYPE :TCOMPL)
)
(DECLARE%: FIRST
(NC.LoadFileFromDirectories 'NCBROWSERCARD)
)
(* ;;
"Adds ChangeRoots option to Browser card middle button menu. Also removed all the archaic calls to NC.SetPropListDirtyFlg dating from the days we stored browser info on the card's proplist. "
)
(* ;; "New functions for NCBROWSERCARD")
(DEFINEQ
(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])
)
(* ;; "Changes to NCBROWSERCARD")
(DEFINEQ
(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.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."
])
(NC.RelayoutBrowserCard
[LAMBDA (Window) (* ; "Edited 29-Jul-88 20:26 by Trigg")
(* ;;; "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")
(LET
((Card (NC.CoerceToCard Window)))
(NC.ProtectedCardOperation
Card "Relayout Browser Card" NIL
(PROG (RootCards RootNodeIDs OldToNodePairs Graph GraphNodes BrowserFormat DropVirtualNodesFlg
SpecialBrowserSpecs)
(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)))
(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 (FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window 'REPAINTFN (FUNCTION NC.BrowserRepaintFn)
T)
(WINDOWPROP Window 'SCROLLFN (FUNCTION NC.BrowserScrollFn))
(WINDOWPROP Window 'RESHAPEFN (FUNCTION NC.BrowserReshapeFn))
(NC.SetSubstance Card (WINDOWPROP Window 'GRAPH))
(NC.MarkCardDirty Card)
(NC.InstallTitleBarButtonEventFn Window (FUNCTION NC.TitleBarButtonEventFn))
(NC.InstallCopyButtonEventFn Window)
(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.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])
)
(* ;; "Following is just to make the patch file work. PLEASE DON'T PUT IN NCBROWSERCARD.")
(NC.AddBrowserCard)
(PUTPROPS RHTPATCH328 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2023 4002 (NC.ChangeBrowserRoots 2033 . 2993) (NC.RespecifyBrowserRoots 2995 . 4000)) (
4045 45945 (NC.UpdateBrowserCard 4055 . 19424) (NC.AddBrowserCard 19426 . 23298) (
NC.RelayoutBrowserCard 23300 . 31182) (NC.ExpandBrowserNode 31184 . 42712) (NC.ChangeBrowserSpecs
42714 . 45943)))))
STOP