(FILECREATED " 8-May-86 11:13:17" {QV}<NOTECARDS>1.3K>RHTPATCH044.;1 13594
changes to: (VARS RHTPATCH044COMS)
(FNS NC.MakeBrowserCard NC.RelayoutBrowserCard))
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH044COMS)
(RPAQQ RHTPATCH044COMS ((* * Changes to NCBROWSERCARD)
(FNS NC.MakeBrowserCard NC.RelayoutBrowserCard)))
(* * Changes to NCBROWSERCARD)
(DEFINEQ
(NC.MakeBrowserCard
(LAMBDA (Card Title NoDisplayFlg ParamList) (* rht: " 8-May-86 11:11")
(* 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.)
(PROG ((RootCards (MKLIST (LISTGET ParamList (QUOTE ROOTCARDS))))
(ListOfLinkLabels (LISTGET ParamList (QUOTE LINKTYPES)))
(BrowserFormat (LISTGET ParamList (QUOTE FORMAT)))
(Depth (LISTGET ParamList (QUOTE DEPTH)))
(CardType (NC.RetrieveType Card))
Lattice RootNodes Window Graph SpecialBrowserSpecs BrowserSpecs DropVirtualNodesFlg)
(NC.ActivateCard Card)
(COND
((NULL NoDisplayFlg)
(SETQ Window (CREATEW (NC.DetermineDisplayRegion Card NIL)
(NC.RetrieveTitle Card)
NIL))
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.GraphCardShrinkFn))
(WINDOWPROP Window (QUOTE NoteCardObject)
Card)))
(if (NULL RootCards)
then (SETQ RootCards (if NoDisplayFlg
then (LIST NIL)
else (NC.SelectNoteCards NIL NIL
NC.SelectingBrowserSourceMenu
Window NIL
"Please select the Cards and/or Boxes the browser should start from."
T))))
(COND
((EQ RootCards (QUOTE CANCELLED))
(NC.DeactivateCard Card)
(CLOSEW Window)
(RETURN)))
(NC.HoldTTYProcess)
(SETQ BrowserSpecs (NC.AskBrowserSpecs Window Card NIL Depth BrowserFormat T
(if (OR ParamList NoDisplayFlg)
then (QUOTE 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 Window))
(T (create SPECIALBROWSERSPECS))))
(OR NoDisplayFlg (NC.PrintMsg Window 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 (for RootCard in RootCards collect (NC.GetBrowserNodeID Card
RootCard)))
(OR NoDisplayFlg (WINDOWPROP Window (QUOTE NoteCardObject)
Card))
(* * Link destination id information stored in NodeLabel field into a LinkIcon for display)
(for Node in Lattice bind NodeID eachtime (BLOCK)
do (replace (GRAPHNODE NODELABEL) of Node
with (NC.MakeLinkIcon (NC.MakeLink Window NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
Card NIL)))
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(NC.UIDRemProp (NC.CoerceToGraphNodeID NodeID)
(QUOTE TouchedFlg))
(NC.UIDRemProp (NC.CoerceToGraphNodeID NodeID)
(QUOTE VisitedFlg)))
(SETQ Graph (if (AND Lattice RootNodes)
then (LAYOUTGRAPH Lattice RootNodes (SUBST (QUOTE LATTICE)
NC.*Graph*BrowserFormat
BrowserFormat)
(fetch (SPECIALBROWSERSPECS Font) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS MotherD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS PersonalD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS FamilyD)
of SpecialBrowserSpecs))
else (create GRAPH)))
(NC.SetBrowserLinksLegend Card (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(OR NoDisplayFlg (NC.PrintMsg Window 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)
(COND
(NoDisplayFlg (RETURN Card)))
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.InstallTitleBarLeftMenu Window CardType)
(NC.InstallGraphTitleBarMiddleMenu Window CardType)
(NC.RelayoutBrowserCard Window)
(RETURN Window))))
(NC.RelayoutBrowserCard
(LAMBDA (Window) (* rht: " 8-May-86 11:11")
(* * 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.)
(PROG (Card RootCards RootNodeIDs OldToNodePairs Graph GraphNodes BrowserFormat
DropVirtualNodesFlg SpecialBrowserSpecs)
(NC.PrintMsg Window T "Laying out graph ...")
(SETQ Card (NC.CoerceToCard Window))
(SETQ RootCards (NC.FetchBrowserRoots Card))
(SETQ BrowserFormat (OR (NC.FetchBrowserFormat Card)
(QUOTE (LATTICE))))
(* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
(SETQ SpecialBrowserSpecs (OR (CAR (NC.FetchSpecialBrowserSpecs Card))
(create SPECIALBROWSERSPECS)))
(SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP
Window
(QUOTE 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)))
(NC.SetPropListDirtyFlg Card T) (* Layout graph, including as roots any non-virtual
nodes with no from nodes to avoid disconnected
graphs.)
(SETQ Graph (if GraphNodes
then (LAYOUTGRAPH GraphNodes
(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 (QUOTE LATTICE)
NC.*Graph*BrowserFormat BrowserFormat)
(fetch (SPECIALBROWSERSPECS Font) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS MotherD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS PersonalD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS FamilyD)
of SpecialBrowserSpecs))
else (create GRAPH)))
(* Replace the TONODES fields of the Graph nodes by their pre-LAYOUTGRAPH values. Also throw away any nodes that
didn't appear in the old graph.)
(if Graph
then (replace (GRAPH GRAPHNODES) of Graph
with (for Node in (fetch (GRAPH GRAPHNODES) of Graph)
bind AssocPair eachtime (BLOCK)
when (SETQ AssocPair (FASSOC (fetch (GRAPHNODE NODEID)
of Node)
OldToNodePairs))
collect (replace (GRAPHNODE TONODES) of Node
with (CDR AssocPair))
(if DropVirtualNodesFlg
then (replace (GRAPHNODE NODEBORDER)
of Node with NIL))
(* Throw away LINKPARAMS junk from the FromNodes that
LAYOUTGRAPH stuck in.)
(replace (GRAPHNODE FROMNODES) of Node
with (for FromNode in (fetch (GRAPHNODE
FROMNODES)
of Node)
eachtime (BLOCK)
collect (if (EQ (CAR FromNode)
LINKPARAMS)
then (CADR FromNode)
else FromNode)))
Node)))
(SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T)
(* * Have to reset windowprops since SHOWGRAPH messes with them.)
(* Disable the old-style right button grapher editor
menu.)
(WINDOWPROP Window (QUOTE RIGHTBUTTONFN)
(FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window (QUOTE REPAINTFN)
(FUNCTION NC.BrowserRepaintFn)
T)
(WINDOWPROP Window (QUOTE SCROLLFN)
(FUNCTION NC.BrowserScrollFn))
(WINDOWPROP Window (QUOTE RESHAPEFN)
(FUNCTION NC.BrowserReshapeFn))
(NC.SetSubstance Card (WINDOWPROP Window (QUOTE GRAPH)))
(NC.MarkCardDirty Card)
(NC.InstallTitleBarButtonEventFn Window (FUNCTION NC.GraphTitleBarButtonEventFn))
(NC.ClearMsg Window T))))
)
(PUTPROPS RHTPATCH044 COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (434 13512 (NC.MakeBrowserCard 444 . 7265) (NC.RelayoutBrowserCard 7267 . 13510)))))
STOP