(FILECREATED "27-Nov-85 00:29:07" {QV}<NOTECARDS>1.3K>RHTPATCH009.;3 98788
changes to: (VARS RHTPATCH009COMS)
(FNS NC.RemProp NC.CreateDatabaseFile NC.UIDPutProp)
previous date: "26-Nov-85 02:15:21" {QV}<NOTECARDS>1.3K>RHTPATCH009.;2)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH009COMS)
(RPAQQ RHTPATCH009COMS ((* * These are new functions that belong in NCDATABASE with the other UID
proplist functions like NC.UIDPutProp.)
(FNS NC.UIDSetPropList NC.UIDAddProp)
(* * This new function belongs in NCCARDS.)
(FNS NC.RemProp)
(* * These are new functions that belong in NCBROWSERCARD in the miscellaneous section.)
(FNS NC.PutBrowserSubstance NC.FetchBrowserRoots NC.SetBrowserRoots)
(* * These are functions from NCBROWSERCARD that have been redefined.)
(FNS NC.MakeBrowserCard NC.BringUpBrowserCard NC.RelayoutBrowserCard NC.GrowLinkLattice
NC.UpdateBrowserCard NC.ExpandBrowserNode NC.RemoveDuplicateNodesFromGraph
NC.BrowserAddLink NC.BrowserDeleteCard NC.BrowserDeleteLink NC.BrowserRemoveNode
NC.BrowserRemoveEdge NC.MakeLinksLegend NC.DrawFlowerLinks NC.GetBrowserNodeID
NC.GetBrowserHashArray NC.CardFromBrowserNodeID NC.SmashGraphNodeIDProps
NC.ConnectNodesInBrowser NC.CoerceToGraphNodeID NC.AddBrowserCard NC.BrowserFlipRoots)
(* * This function from NCDATABASE has been redefined.)
(FNS NC.CreateDatabaseFile NC.UIDPutProp)))
(* * These are new functions that belong in NCDATABASE with the other UID proplist functions
like NC.UIDPutProp.)
(DEFINEQ
(NC.UIDSetPropList
(LAMBDA (UID PropList) (* rht: "25-Nov-85 23:38")
(replace (UID UserData) of UID with PropList)))
(NC.UIDAddProp
(LAMBDA (UID Prop New Flg) (* rht: "26-Nov-85 00:12")
(LET ((CurrentPropValue (NC.UIDGetProp UID Prop)))
(if (LISTP CurrentPropValue)
then (NC.UIDPutProp UID Prop (if Flg
then (CONS New CurrentPropValue)
else (NCONC1 CurrentPropValue New)))
else (NC.UIDPutProp UID Prop (LIST New))))))
)
(* * This new function belongs in NCCARDS.)
(DEFINEQ
(NC.RemProp
(LAMBDA (Card Prop) (* rht: "26-Nov-85 21:14")
(* * Remove given property from Card's property list. Someday maybe this could be smarter and save space.)
(NC.PutProp Card Prop NIL)))
)
(* * These are new functions that belong in NCBROWSERCARD in the miscellaneous section.)
(DEFINEQ
(NC.PutBrowserSubstance
(LAMBDA (Card) (* rht: "26-Nov-85 01:13")
(* * For each BrowserUID, clear its UID prop list. Otherwise HPRINT will die in PutGraphSubstance.)
(LET ((Browser (NC.FetchSubstance Card)))
(for GraphNode in (fetch (GRAPH GRAPHNODES) of Browser) eachtime (BLOCK)
when (SETQ NodeID (NC.CoerceToGraphNodeID GraphNode)) do (NC.UIDSetPropList
NodeID NIL))
(APPLY* (NC.PutSubstanceFn (QUOTE Graph))
Card))))
(NC.FetchBrowserRoots
(LAMBDA (Card) (* rht: "26-Nov-85 01:57")
(* * Get roots off Card's prop list and convert them from UID pairs to Card objects.)
(for BrowserRootUIDPair in (NC.GetProp Card (QUOTE BrowserRootUIDPairs)) eachtime
(BLOCK)
collect (NC.CardFromUID (CAR BrowserRootUIDPair)
(NC.NoteFileFromNoteFileUID (CDR BrowserRootUIDPair))))))
(NC.SetBrowserRoots
(LAMBDA (Card BrowserRoots) (* rht: "26-Nov-85 01:57")
(* * Put the roots on the Card's property list in the CardUID/NoteFileUID pair format.)
(NC.PutProp Card (QUOTE BrowserRootUIDPairs)
(for BrowserRoot in BrowserRoots eachtime (BLOCK)
collect (CONS (fetch (Card UID) of Card)
(fetch (NoteFile UID) of (fetch (Card NoteFile)
of Card)))))))
)
(* * These are functions from NCBROWSERCARD that have been redefined.)
(DEFINEQ
(NC.MakeBrowserCard
(LAMBDA (Card Title NoDisplayFlg ParamList) (* rht: "26-Nov-85 02:02")
(* 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.)
(PROG (Lattice Window Graph PropList SpecialBrowserSpecs (RootCards (MKLIST
(LISTGET ParamList
(QUOTE
ROOTCARDS))))
RootNodes
(ListOfLinkLabels (LISTGET ParamList (QUOTE LINKTYPES)))
(BrowserFormat (LISTGET ParamList (QUOTE FORMAT)))
(Depth (LISTGET ParamList (QUOTE DEPTH)))
LabelPairs BrowserSpecs DropVirtualNodesFlg)
(NC.ActivateCard 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)))
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(OR NoDisplayFlg (NC.PrintMsg Window NIL "Done!"))
(NC.SetSubstance Card Graph)
(NC.PutProp Card (QUOTE BrowserLinkLabels)
(LIST (OR ListOfLinkLabels NC.SubBoxLinkLabel)))
(NC.SetBrowserRoots Card RootCards)
(NC.PutProp Card (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.PutProp Card (QUOTE BrowserFormat)
(LIST BrowserFormat))
(NC.PutProp Card (QUOTE BrowserDepth)
Depth)
(NC.PutProp Card (QUOTE SpecialBrowserSpecs)
(LIST SpecialBrowserSpecs))
(NC.SetPropListDirtyFlg Card T)
(COND
(NoDisplayFlg (RETURN Card)))
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.SetupTitleBarMenu Window Card (QUOTE Browser))
(NC.RelayoutBrowserCard Window)
(RETURN Window))))
(NC.BringUpBrowserCard
(LAMBDA (Card Substance Region/Position) (* rht: "26-Nov-85 01:52")
(* * 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.)
(LET ((Window (APPLY* (NC.EditFn (QUOTE Graph))
Card Substance Region/Position)))
(NC.SetupTitleBarMenu Window Card (QUOTE Browser))
(NC.MakeLinksLegendMenu Window (CAR (LISTGET (NC.RetrievePropList Card)
(QUOTE BrowserLinksLegend))))
(* Disable the old-style right button grapher editor
menu.)
(WINDOWPROP Window (QUOTE RIGHTBUTTONFN)
(FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window (QUOTE SHRINKFN)
(FUNCTION NC.GraphCardShrinkFn))
(WINDOWADDPROP Window (QUOTE REPAINTFN)
(FUNCTION NC.BrowserRepaintFn)
T)
(* * I have to hang notecard's Card on window now in case REDISPLAYW runs and tries to get Card from window.)
(WINDOWPROP Window (QUOTE NoteCardObject)
Card) (* 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))
(* * For each graph node corresponding to a notecard, hang the card object off the node id's prop list.)
(for GraphNode in (fetch (GRAPH GRAPHNODES) of Substance) bind LinkIcon
eachtime (BLOCK) when (NC.LinkIconImageObjP (SETQ LinkIcon (fetch
(GRAPHNODE NODELABEL)
of GraphNode)))
do (NC.UIDPutProp (NC.CoerceToGraphNodeID GraphNode)
(QUOTE CardObject)
(fetch (Link DestinationCard) of (NC.FetchLinkFromLinkIcon
LinkIcon))))
Window)))
(NC.RelayoutBrowserCard
(LAMBDA (Window) (* rht: "26-Nov-85 02:03")
(* * 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.)
(PROG (Card RootCards RootNodes OldToNodePairs Graph GraphNodes PropList BrowserFormat
DropVirtualNodesFlg SpecialBrowserSpecs)
(NC.PrintMsg Window T "Laying out graph ...")
(SETQ Card (NC.CoerceToCard Window))
(SETQ RootCards (NC.FetchBrowserRoots Card))
(SETQ PropList (NC.FetchPropList Card))
(SETQ BrowserFormat (OR (CAR (LISTGET PropList (QUOTE BrowserFormat)))
(QUOTE (LATTICE))))
(* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
(SETQ SpecialBrowserSpecs (OR (CAR (LISTGET PropList (QUOTE SpecialBrowserSpecs)
))
(create SPECIALBROWSERSPECS)))
(SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP
Window
(QUOTE GRAPH)))))
(* 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 RootNodes (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
(UNION (for Node in GraphNodes
eachtime (BLOCK)
when (NULL (fetch (GRAPHNODE
FROMNODES)
of Node))
unless (LISTP
(fetch (GRAPHNODE NODEID)
of Node))
collect (fetch (GRAPHNODE NODEID)
of Node))
(INTERSECTION RootNodes GraphNodes))
(SUBST (QUOTE LATTICE)
NC.*Graph*BrowserFormat BrowserFormat)
(fetch (SPECIALBROWSERSPECS Font) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS MotherD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS PersonalD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS FamilyD)
of SpecialBrowserSpecs))
else (create GRAPH)))
(* Replace the TONODES fields of the Graph nodes by their pre-LAYOUTGRAPH values. Also throw away any nodes that
didn't appear in the old graph.)
(if Graph
then (replace (GRAPH GRAPHNODES) of Graph
with (for Node in (fetch (GRAPH GRAPHNODES) of Graph)
bind AssocPair eachtime (BLOCK)
when (SETQ AssocPair (FASSOC (fetch (GRAPHNODE NODEID)
of Node)
OldToNodePairs))
collect (replace (GRAPHNODE TONODES) of Node
with (CDR AssocPair))
(if DropVirtualNodesFlg
then (replace (GRAPHNODE NODEBORDER)
of Node with NIL))
(* Throw away LINKPARAMS junk from the FromNodes that
LAYOUTGRAPH stuck in.)
(replace (GRAPHNODE FROMNODES) of Node
with (for FromNode in (fetch (GRAPHNODE
FROMNODES)
of Node)
eachtime (BLOCK)
collect (if (EQ (CAR FromNode)
LINKPARAMS)
then (CADR FromNode)
else FromNode)))
Node)))
(SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T)
(* * Have to reset windowprops since SHOWGRAPH messes with them.)
(* Disable the old-style right button grapher editor
menu.)
(WINDOWPROP Window (QUOTE RIGHTBUTTONFN)
(FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window (QUOTE REPAINTFN)
(FUNCTION NC.BrowserRepaintFn)
T)
(NC.SetSubstance Card (WINDOWPROP Window (QUOTE GRAPH)))
(NC.MarkCardDirty Card)
(OR (EQ (WINDOWPROP Window (QUOTE BUTTONEVENTFN))
(FUNCTION NC.TitleBarButtonEventFn))
(WINDOWPROP Window (QUOTE OLDBUTTONEVENTFN)
(WINDOWPROP Window (QUOTE BUTTONEVENTFN)
(FUNCTION NC.TitleBarButtonEventFn))))
(NC.ClearMsg Window T))))
(NC.GrowLinkLattice
(LAMBDA (RootCardsList CurrentGraph ListOfLinkLabels GraphCard RemainingSearchDepth)
(* rht: "26-Nov-85 00:14")
(* 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.)
(LET (CardsAndDepthsQueue) (* 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)))
(if (IGREATERP RemainingSearchDepth 0)
then (* Crush the ID's proplist.)
(if (NOT (NC.UIDGetProp GraphNodeID (QUOTE TouchedFlg)))
then (NC.SmashGraphNodeIDProps GraphNodeID)
(NC.UIDPutProp GraphNodeID (QUOTE TouchedFlg)
T))
(SETQ DestinationIDs
(NCONC (for Link in ToLinks bind DestID DestVisitedFlg
DestTouchedFlg ThisWayLinkFlg
OtherWayLinkFlg
eachtime (BLOCK)
(SETQ DestID (NC.GetBrowserNodeID
GraphCard
(fetch (Link DestinationCard)
of Link)))
(SETQ DestVisitedFlg (NC.UIDGetProp
DestID
(QUOTE VisitedFlg)))
(SETQ DestTouchedFlg (NC.UIDGetProp
DestID
(QUOTE TouchedFlg)))
(SETQ ThisWayLinkFlg (NC.LinkLabelP Link
ListOfLinkLabels))
(SETQ OtherWayLinkFlg (NC.ReverseLinkLabelP
Link ListOfLinkLabels))
when ThisWayLinkFlg unless (AND DestVisitedFlg
OtherWayLinkFlg)
collect (* Record presence of this link.)
(NC.UIDAddProp GraphNodeID DestID
(fetch (Link Label)
of Link)
T)
DestID)
(for Link in FromLinks
bind DestID DestTouchedFlg DestVisitedFlg ThisWayLinkFlg
OtherWayLinkFlg SourceCard
eachtime (BLOCK)
(if (NOT (NC.SameCardP
GraphCard
(SETQ SourceCard
(fetch (Link SourceCard)
of Link))))
then (SETQ DestID (NC.GetBrowserNodeID
GraphCard SourceCard))
(SETQ DestVisitedFlg
(NC.UIDGetProp DestID
(QUOTE
VisitedFlg)))
(SETQ DestTouchedFlg
(NC.UIDGetProp DestID
(QUOTE
TouchedFlg)))
(SETQ ThisWayLinkFlg
(NC.ReverseLinkLabelP Link
ListOfLinkLabels))
(SETQ OtherWayLinkFlg
(NC.LinkLabelP Link
ListOfLinkLabels)))
when ThisWayLinkFlg unless (AND DestVisitedFlg
OtherWayLinkFlg)
collect
(* Crush the dest node's prop list if it's never been touched. But if dest node is a fringe node for this search,
don't have to clear the whole proplist.)
(if (NOT DestTouchedFlg)
then (if (EQ 1 RemainingSearchDepth)
then (NC.UIDRemProp DestID
GraphNodeID)
else (NC.SmashGraphNodeIDProps
DestID)
(NC.UIDPutProp
DestID
(QUOTE 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.UIDPutProp GraphNodeID (QUOTE VisitedFlg)
T)
(* * Create new node and add to graph unless we're working on a node already in the graph.)
(if (SETQ GraphNode (FASSOC GraphNodeID CurrentGraph))
then (* If node is in graph, but we won't expand further,
then leave it's destination IDs alone.)
(AND (GREATERP RemainingSearchDepth 0)
(replace (GRAPHNODE TONODES) of GraphNode with
DestinationIDs))
else (SETQ CurrentGraph
(NCONC CurrentGraph
(LIST (create GRAPHNODE
NODEID ← GraphNodeID
TONODES ← DestinationIDs
NODELABEL ← Card)))))
(* * Attach new IDs to end of queue.)
(for DestinationID in DestinationIDs bind DestCard
eachtime (BLOCK)
(SETQ DestCard (NC.CardFromBrowserNodeID DestinationID))
unless (OR (NC.UIDGetProp DestinationID (QUOTE VisitedFlg))
(for CardAndDepth in (CAR CardsAndDepthsQueue)
eachtime (BLOCK) thereis (NC.SameCardP DestCard
(CAR
CardAndDepth))))
do (SETQ CardsAndDepthsQueue (TCONC CardsAndDepthsQueue
(CONS DestCard (SUB1
RemainingSearchDepth)))))
)
CurrentGraph)))
(NC.UpdateBrowserCard
(LAMBDA (Window) (* rht: "26-Nov-85 02:07")
(* * 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.)
(PROG (Card LinkLabels RootCards RootNodes Lattice LinkIcon Graph GraphNodes NodeLabel PropList
BrowserSpecs BrowserFormat DropVirtualNodesFlg Depth SpecialBrowserSpecs LabelPairs
OldLabelNodes OldRootCards) (* Get rid of all attached windows except the graph
editor menu if any.)
(for Win in (ATTACHEDWINDOWS Window) unless (WINDOWPROP Win (QUOTE
GRAPHEDITMENUFLG))
do (DETACHWINDOW Win)
(CLOSEW Win))
(SETQ Card (NC.CoerceToCard Window))
(SETQ RootCards (NC.FetchBrowserRoots Card))
(SETQ PropList (NC.FetchPropList Card))
(SETQ LinkLabels (CAR (LISTGET PropList (QUOTE BrowserLinkLabels))))
(SETQ BrowserFormat (OR (CAR (LISTGET PropList (QUOTE BrowserFormat)))
(QUOTE (LATTICE))))
(* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
(SETQ Depth (OR (LISTGET PropList (QUOTE BrowserDepth))
999999))
(SETQ SpecialBrowserSpecs (OR (CAR (LISTGET PropList (QUOTE SpecialBrowserSpecs)
))
(create SPECIALBROWSERSPECS)))
(SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP
Window
(QUOTE GRAPH)))))
(* Smash the current hash array, putting a fresh one
in its place.)
(NC.GetBrowserHashArray Card) (* Get new roots.)
(if (OR (NULL RootCards)
(NC.YesP (NC.AskUser "Want to respecify roots? " "--" "No" T Window T NIL
T)))
then (NC.BrowserFlipRoots Window Card GraphNodes (SETQ OldRootCards RootCards))
(SETQ RootCards (NC.SelectNoteCards NIL NIL NC.SelectingBrowserSourceMenu
Window NIL (CONCAT
"Please select the Cards and/or Boxes the browser should start from."
(CHARACTER
13)
"(Current roots are highlighted.)")
T))
(NC.BrowserFlipRoots Window Card GraphNodes OldRootCards)
(COND
((EQ RootCards (QUOTE CANCELLED))
(RETURN))))
(NC.PrintMsg Window T (CHARACTER 13)
"Computing browser graph. Please wait. ...")
(* Compute lattice breadth-first from the roots.)
(SETQ Lattice (NC.GrowLinkLattice RootCards NIL LinkLabels Card Depth))
(SETQ RootNodes (for RootCard in RootCards collect (NC.GetBrowserNodeID Card
RootCard)))
(NC.SetPropListDirtyFlg Card T) (* Remove all links that are in the old browser graph
but not in the new one)
(for Node in GraphNodes bind NodeID Link
eachtime (BLOCK)
(SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
unless (FASSOC (OR (CAR NodeID)
NodeID)
Lattice)
do (if (NC.LinkIconImageObjP (SETQ LinkIcon (fetch (GRAPHNODE NODELABEL)
of Node)))
then (NC.DeleteLink (NC.FetchLinkFromLinkIcon LinkIcon)
T T)
else (* Collect the label nodes from the old browser.)
(SETQ OldLabelNodes (CONS Node OldLabelNodes))))
(* Create Links for all nodes in the new browser graph
but not in the old one.)
(for Node in Lattice bind NodeID OldNode eachtime (BLOCK)
do (SETQ NodeID (fetch (GRAPHNODE NODEID) of Node))
(COND
((SETQ OldNode (FASSOC NodeID GraphNodes))
(replace (GRAPHNODE NODELABEL) of Node with (fetch (GRAPHNODE
NODELABEL)
of OldNode)))
(T (replace (GRAPHNODE NODELABEL) of Node
with (NC.MakeLinkIcon (NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
Card)))))
(* Untouch each graph node so that next Recompute will
put fresh values on proplist.)
(NC.UIDRemProp NodeID (QUOTE TouchedFlg))
(NC.UIDRemProp NodeID (QUOTE VisitedFlg)))
(* Throw in the label nodes from the old browser.)
(SETQ Lattice (NCONC Lattice OldLabelNodes))
(* For each old label node, take away nonexistent
fromnodes and save the label nodes that no longer have
any from nodes.)
(for OldLabelNode in OldLabelNodes eachtime (BLOCK)
do (replace (GRAPHNODE FROMNODES) of OldLabelNode
with (for FromNodeID in (fetch (GRAPHNODE FROMNODES) of OldLabelNode)
bind FromNode eachtime (BLOCK) when (SETQ FromNode
(FASSOC FromNodeID
Lattice))
collect (* If the From node isn't a label node, then add to
its Tonode list.)
(if (NC.LinkIconImageObjP (fetch (GRAPHNODE
NODELABEL)
of FromNode))
then (replace (GRAPHNODE TONODES) of FromNode
with (CONS (fetch (GRAPHNODE NODEID)
of OldLabelNode)
(fetch (GRAPHNODE TONODES)
of FromNode))))
FromNodeID)) (* For the old label node's ToNodes, just need to
remove any for ToNodes that no longer exist.)
(replace (GRAPHNODE TONODES) of OldLabelNode
with (for ToNodeID in (fetch (GRAPHNODE TONODES) of OldLabelNode)
bind ToNode eachtime (BLOCK) when (SETQ ToNode
(FASSOC ToNodeID
Lattice))
collect (* If the To node isn't a label node, then add to its
FromNode list.)
(if (NC.LinkIconImageObjP (fetch (GRAPHNODE
NODELABEL)
of ToNode))
then (replace (GRAPHNODE FROMNODES) of ToNode
with (CONS (fetch (GRAPHNODE NODEID)
of OldLabelNode)
(fetch (GRAPHNODE FROMNODES)
of ToNode))))
ToNodeID))) (* Layout graph, including as roots any non-virtual
nodes with no from nodes to avoid disconnected
graphs.)
(SETQ Graph (if (AND Lattice RootNodes)
then (LAYOUTGRAPH Lattice (for Node in Lattice bind NodeID
eachtime
(BLOCK)
(SETQ NodeID
(OR (NC.CoerceToGraphNodeID
Node)
(fetch (GRAPHNODE NODEID)
of Node)))
when
(OR (FMEMB NodeID RootNodes)
(NULL (fetch (GRAPHNODE
FROMNODES)
of Node)))
collect NodeID)
(SUBST (QUOTE LATTICE)
NC.*Graph*BrowserFormat BrowserFormat)
(fetch (SPECIALBROWSERSPECS Font) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS MotherD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS PersonalD)
of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS FamilyD)
of SpecialBrowserSpecs))
else (create GRAPH))) (* Build links legend and fix up TONODES in the
graph.)
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(NC.SetBrowserRoots Card RootCards)
(NC.PutProp Card (QUOTE BrowserDepth)
Depth)
(NC.PutProp Card (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.SetPropListDirtyFlg Card T)
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.RelayoutBrowserCard Window))))
(NC.ExpandBrowserNode
(LAMBDA (Window) (* rht: "26-Nov-85 02:04")
(* * Ask user to choose a node in the browser and recompute the part of the lattice under that node to the given
depth. And relayout the graph. The code is just a modification of the NC.UpdateBrowserCard code.)
(PROG (NodeToExpand Card LinkLabels RootCards RootNodes Lattice LinkIcon OldToNodePairs Graph
GraphNodes NodeLabel OldNode Link PropList BrowserSpecs BrowserFormat
DropVirtualNodesFlg Depth SpecialBrowserSpecs LabelPairs SavedLabelNodes)
(SETQ Card (NC.CoerceToCard Window))
(SETQ RootCards (NC.FetchBrowserRoots Card))
(SETQ PropList (NC.FetchPropList Card))
(SETQ LinkLabels (CAR (LISTGET PropList (QUOTE BrowserLinkLabels))))
(SETQ BrowserFormat (CAR (LISTGET PropList (QUOTE BrowserFormat))))
(* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
(SETQ SpecialBrowserSpecs (OR (CAR (LISTGET PropList (QUOTE SpecialBrowserSpecs)
))
(create SPECIALBROWSERSPECS)))
(SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP
Window
(QUOTE GRAPH)))))
(* If there aren't any nodes in graph, then get out
pronto.)
(if (NULL GraphNodes)
then (NC.PrintMsg Window T "No nodes to expand.")
(DISMISS 1000)
(NC.ClearMsg Window T)
(RETURN NIL)) (* 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 (QUOTE 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)))
(NC.SetPropListDirtyFlg Card T) (* Create Links for all nodes in the new browser graph
but not in the old one.)
(for Node in Lattice bind NodeID
do (COND
((SETQ OldNode (FASSOC (SETQ NodeID (OR (NC.CoerceToGraphNodeID
Node)
(fetch (GRAPHNODE NODEID)
of Node)))
GraphNodes))
(replace (GRAPHNODE NODELABEL) of Node with (fetch (GRAPHNODE
NODELABEL)
of OldNode)))
(T (replace (GRAPHNODE NODELABEL) of Node
with (NC.MakeLinkIcon (NC.MakeLink Window
NC.BrowserContentsLinkLabel
(fetch (GRAPHNODE NODELABEL)
of Node)
Card)))))
(* 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.UIDRemProp NodeID (QUOTE TouchedFlg))
(NC.UIDRemProp NodeID (QUOTE VisitedFlg))
(* Smash all the unnecessary junk off existing nodes,
letting LAYOUTGRAPH and NC.MakeLinksLegend recompute.)
(replace (GRAPHNODE TONODES) of Node
with (for ToNode in (fetch (GRAPHNODE TONODES) of Node)
bind ToNodeID eachtime (BLOCK)
collect (if (SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode))
then (* Throw away link parameterlist info.)
(* Throw away link dashing info.)
(NC.UIDPutProp NodeID ToNodeID
(for LabelPair
in (NC.UIDGetProp
NodeID ToNodeID)
collect
(OR (CAR LabelPair)
LabelPair)))
(NC.UIDPutProp ToNodeID NodeID
(for LabelPair
in (NC.UIDGetProp
ToNodeID NodeID)
collect
(OR (CAR LabelPair)
LabelPair)))
ToNodeID
else ToNode))))
(* LAYOUTGRAPH doesn't like duplicate nodes.
These get created when virtual nodes are turned into
regular nodes.)
(SETQ Lattice (NC.RemoveDuplicateNodesFromGraph Lattice))
(NC.RebuildFromNodesInGraph Lattice)
(SETQ Graph (LAYOUTGRAPH Lattice (for Node in Lattice bind NodeID
eachtime (BLOCK)
when (OR (FMEMB (SETQ NodeID
(
NC.CoerceToGraphNodeIDOrLabel
Node))
RootNodes)
(NULL (fetch (GRAPHNODE
FROMNODES)
of Node)))
collect NodeID)
(SUBST (QUOTE LATTICE)
NC.*Graph*BrowserFormat BrowserFormat)
(fetch (SPECIALBROWSERSPECS Font) of SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS MotherD) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS PersonalD) of
SpecialBrowserSpecs)
(fetch (SPECIALBROWSERSPECS FamilyD) of
SpecialBrowserSpecs)))
(* Build links legend and fix up TONODES in the
graph.)
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(NC.PutProp Card (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.SetPropListDirtyFlg Card T)
(WINDOWPROP Window (QUOTE GRAPH)
Graph)
(NC.RelayoutBrowserCard Window))))
(NC.RemoveDuplicateNodesFromGraph
(LAMBDA (GraphNodes) (* rht: "25-Nov-85 23:52")
(* * 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.UIDGetProp
NodeID
(QUOTE AlreadyVisitedFlg)))
(NOT (FMEMB NodeID DeletedNodeIDs)))
then (push DeletedNodeIDs NodeID))
(NC.UIDPutProp NodeID (QUOTE CumulativeToNodesList)
(UNION (NC.UIDGetProp NodeID
(QUOTE
CumulativeToNodesList))
(fetch (GRAPHNODE TONODES)
of Node)))
unless AlreadyVisitedFlg collect (NC.UIDPutProp NodeID
(QUOTE
AlreadyVisitedFlg)
T)
Node))
(for NodeID in DeletedNodeIDs bind GraphNode
do (SETQ GraphNode (FASSOC NodeID GraphNodes))
(replace (GRAPHNODE TONODES) of GraphNode with (NC.UIDGetProp NodeID
(QUOTE
CumulativeToNodesList))))
(for Node in GraphNodes bind NodeID
do (NC.UIDRemProp (SETQ NodeID (NC.CoerceToGraphNodeIDOrLabel Node))
(QUOTE CumulativeToNodesList))
(NC.UIDRemProp NodeID (QUOTE AlreadyVisitedFlg)))
GraphNodes)))
(NC.BrowserAddLink
(LAMBDA (FromNode ToNode Win Graph GlobalLinkFlg) (* rht: "26-Nov-85 00:14")
(* * 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.)
(PROG (Link LinkLabel Card LabelPairs LabelPair PropList (MaxDashingStylesNum (LENGTH
NC.DashingStyles))
LabelNum ToNodeID FromNodeID OldDestNode LinkParams ReverseLinkParams
SavedDeleteLinkFn NumberOfLinks)
(COND
((NOT (AND (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of FromNode))
(NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of ToNode))))
(NC.PrintMsg NIL T
"Can't create link from or to a label node. Try 'Add Edge' instead.")
(FLASHW PROMPTWINDOW)
(RETURN NIL))
((SETQ Link (NC.BrowserCreateLink FromNode ToNode Graph Win GlobalLinkFlg))
(* We successfully created a link.
Now undraw existing link and redraw with new one
added.)
(* First, check whether label for new link is already
in graph.)
(SETQ Card (NC.CoerceToCard Win))
(SETQ PropList (NC.FetchPropList Card))
(SETQ LabelPairs (CAR (NC.GetProp Card (QUOTE BrowserLinksLegend))))
(SETQ LinkLabel (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 LinkLabel LabelPairs)))
then (SETQ LabelPairs (APPEND LabelPairs
(LIST (SETQ LabelPair
(CONS LinkLabel
(COND
((ILESSP
(SETQ LabelNum
(LENGTH
LabelPairs))
MaxDashingStylesNum)
(SETQ LabelNum
(ADD1 LabelNum)))
(T LabelNum)))))))
(NC.PutProp Card (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(NC.MakeLinksLegendMenu Win LabelPairs))
(SETQ FromNodeID (NC.CoerceToGraphNodeID FromNode))
(SETQ ToNodeID (NC.CoerceToGraphNodeID ToNode))
(SETQ NumberOfLinks (PLUS (LENGTH (NC.UIDGetProp FromNodeID ToNodeID))
(LENGTH (NC.UIDGetProp ToNodeID FromNodeID))))
(SETQ LinkParams (LINKPARAMETERS FromNode ToNode))
(SETQ ReverseLinkParams (LINKPARAMETERS ToNode FromNode))
(COND
((OR (ZEROP NumberOfLinks)
(AND (NULL LinkParams)
(NULL ReverseLinkParams)))
(if (OR (FMEMB (fetch (GRAPHNODE NODEID) of FromNode)
(fetch (GRAPHNODE TONODES) of ToNode))
(FMEMB (fetch (GRAPHNODE NODEID) of ToNode)
(fetch (GRAPHNODE TONODES) of FromNode)))
then (* There are no links, but there is an edge.
Delete it and redisplay.)
(SETQ SavedDeleteLinkFn (fetch (GRAPH GRAPH.DELETELINKFN)
of Graph))
(replace (GRAPH GRAPH.DELETELINKFN) of Graph with NIL)
(DELETE/AND/DISPLAY/LINK FromNode ToNode Win Graph)
(NC.PrintMsg NIL T "Replacing existing edge with new link edge.")
(FLASHW PROMPTWINDOW)) (* This is first link between these two nodes so
compute dashing here.)
(replace (GRAPHNODE TONODES) of FromNode
with (CONS (LIST LINKPARAMS (fetch (GRAPHNODE NODEID) of ToNode)
(QUOTE DRAWLINKFN)
(FUNCTION NC.BrowserDrawLinkFn)
(QUOTE DASHING)
(CAR (FNTH NC.DashingStyles (CDR LabelPair))))
(fetch (GRAPHNODE TONODES) of FromNode)))
(replace (GRAPHNODE FROMNODES) of ToNode with (CONS (fetch
(GRAPHNODE NODEID)
of FromNode)
(fetch
(GRAPHNODE
FROMNODES)
of ToNode))))
(LinkParams (* There are multiple links.
And the link params is on the FromNode.)
(DISPLAYLINK FromNode ToNode
(CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 LinkParams)
(* If there was only one link, then change so
multi-link indicator.)
(if (EQP NumberOfLinks 1)
then (RPLACD (CDR LinkParams)
(LIST (QUOTE NODEID)
FromNodeID
(QUOTE DESTNODEID)
ToNodeID))))
(T (* There are multiple links.
The Link params is on the ToNode.)
(DISPLAYLINK ToNode FromNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Win Graph 1 ReverseLinkParams)
(* If there was only one link, then change so
multi-link indicator.)
(if (EQP NumberOfLinks 1)
then (RPLACD (CDR ReverseLinkParams)
(LIST (QUOTE NODEID)
ToNodeID
(QUOTE DESTNODEID)
FromNodeID)))))
(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 NIL))))))
(NC.BrowserDeleteCard
(LAMBDA (Node Graph Window) (* rht: "26-Nov-85 02:05")
(* * Called by grapher when user deletes a node. Will try to delete the card behind the node as well.)
(* * rht 11/17/85: updated to handle card and notefile object styles.)
(PROG ((GraphCard (NC.CoerceToCard Window))
Card GraphNodeID RootCards)
(SETQ Card (NC.CardFromBrowserNodeID (fetch (GRAPHNODE NODEID) of Node)))
(NC.MarkCardDirty GraphCard) (* Delete all record of links to and from this node on
prop lists.)
(NC.SmashGraphNodeIDProps (SETQ GraphNodeID (NC.CoerceToGraphNodeID Node)))
(for OtherNode in (fetch (GRAPH GRAPHNODES) of Graph) do (NC.UIDRemProp
(
NC.CoerceToGraphNodeID
OtherNode)
GraphNodeID))
(* Does user really want to delete the card behind
this node?)
(COND
((AND (NC.ValidCardP Card)
(NC.YesP (NC.AskUser (CONCAT "Want to delete the " (NC.RetrieveTitle
Card)
" card? ")
"--"
(QUOTE Yes)
T Window NIL NIL T)))
(NC.DeleteNoteCards Card T) (* Redisplay so that the deletedLinkIcon goes away.)
(DISPLAYNODE Node (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph) (* Remove from the root ids list.)
(SETQ RootCards (NC.FetchBrowserRoots GraphCard))
(if (for RootCard in RootCards eachtime (BLOCK) thereis (NC.SameCardP
Card RootCard))
then (NC.PutProp GraphCard (QUOTE BrowserRoots)
(LIST (for RootCard in RootCards eachtime (BLOCK)
unless (NC.SameCardP Card RootCard)
collect RootCard)))))
(T (NC.PrintMsg Window NIL "Card not deleted."))))))
(NC.BrowserDeleteLink
(LAMBDA (FromNode ToNode Window Graph) (* rht: "25-Nov-85 23:52")
(* * Called by grapher when user deletes a link.)
(* * rht 11/17/85: updated to handle new card and notefile formats.)
(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.UIDGetProp 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
(BQUOTE (QUOTE (, Link , LabelPair))))
)
(for LabelPair in LabelPairs unless (FMEMB
(CAR LabelPair)
ExistingLabels)
collect (LIST (CAR LabelPair)
(BQUOTE (QUOTE (, NIL , LabelPair)))))
))
(SETQ LinkAndLabelPair (COND
((CDR MenuItems)
(MENU (create MENU
ITEMS ← MenuItems
TITLE ← "Which link to delete?")))
(T (EVAL (CADAR MenuItems)))))
(COND
((NOT LinkAndLabelPair)
(FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "No link to delete.")
(RETURN NIL))
((SETQ Link (CAR LinkAndLabelPair))
(if (NC.YesP (NC.AskUser (CONCAT "Want to delete the " (fetch (Link Label)
of Link)
" link between "
(NC.RetrieveTitle SourceCard)
" and "
(NC.RetrieveTitle DestinationCard)
"? ")
"--"
(QUOTE Yes)
T Window NIL NIL T))
then (NCP.DeleteLinks Link)
else (RETURN NIL)))
((NOT (NC.YesP (NC.AskUser (CONCAT "Link for that label already deleted."
(CHARACTER 13)
"Want to delete its edge? ")
"- -"
(QUOTE Yes)
T Window NIL NIL T)))
(RETURN NIL))) (* Undisplay the links between the nodes.)
(COND
((SETQ LinkParams (LINKPARAMETERS FromNode ToNode))
(DISPLAYLINK FromNode ToNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph 1 LinkParams))
((SETQ ReverseLinkParams (LINKPARAMETERS ToNode FromNode))
(DISPLAYLINK ToNode FromNode (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
Window Graph 1 ReverseLinkParams)))
(* Remove the first occurrence of the label pair from
the proper prop list.)
(NC.UIDPutProp 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.UIDGetProp FromNodeID ToNodeID))
(NULL (NC.UIDGetProp 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.BrowserRemoveNode
(LAMBDA (Graph Window DeleteCardFlg) (* rht: "26-Nov-85 02:06")
(* * Called by grapher when user removes a node.)
(* * rht 11/17/85: Updated to handle new card and notefile formats.)
(PROG ((GraphCard (NC.CoerceToCard Window))
Card NodeToRemoveID RootCards NodesToRemove NumVirtuals NodeToRemove)
(SETQ NodeToRemove (NC.SelectGraphNode Window Graph (if DeleteCardFlg
then
"Choose node of card to delete."
else "Choose node to remove.")
))
(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.YesP (NC.AskUser (CONCAT
"Want to delete the "
(NC.RetrieveTitle
Card)
" card? ")
"--"
(QUOTE Yes)
T Window NIL NIL T)))
then (FLIPNODE NodeToRemove Window)
(RETURN (NC.PrintMsg NIL T
"Card & Node delete aborted.")))
else (NC.PrintMsg NIL T "No card for that node.")
(FLASHW PROMPTWINDOW)
(FLIPNODE NodeToRemove Window)
(RETURN NIL)))
(NC.MarkCardDirty 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 no edges into or out of this node,
then just delete from graph.)
(if (AND (NOT DeleteCardFlg)
(NULL (fetch (GRAPHNODE FROMNODES) of NodeToRemove))
(NULL (fetch (GRAPHNODE TONODES) of NodeToRemove)))
then (FLIPNODE NodeToRemove Window) (* Delete the browsercontents link from the browser.)
(AND (NC.ValidCardP Card)
(NC.DelBrowserContentsLink GraphCard Card))
(* Remove entry for this node from browser hash
array.)
(NC.RemoveBrowserNodeHashArrayEntry GraphCard Card)
(RETURN (NC.GraphRemoveNode NodeToRemove Graph Window)))
(* If there are companion virtual nodes, ask for user
confirmation.)
(if (AND (NOT DeleteCardFlg)
(GREATERP (SETQ NumVirtuals (LENGTH NodesToRemove))
1)
(NOT (PROGN (NC.PrintMsg Window T NumVirtuals
" virtual companion nodes will be removed."
(CHARACTER 13))
(NC.YesP (NC.AskUser "Still want to remove? " "--"
(QUOTE Yes)
NIL Window NIL NIL T)))))
then (FLIPNODE NodeToRemove Window)
(RETURN NIL)) (* Delete the browsercontents link from the browser.)
(AND (NC.ValidCardP Card)
(NC.DelBrowserContentsLink GraphCard Card))
(* Delete all record of links to and from this node on
prop lists.)
(NC.SmashGraphNodeIDProps NodeToRemoveID)
(for Node in (fetch (GRAPH GRAPHNODES) of Graph) do (NC.UIDRemProp
(NC.CoerceToGraphNodeID
Node)
NodeToRemoveID))
(* 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.PutProp GraphCard (QUOTE BrowserRoots)
(LIST (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.)
(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.DeleteNoteCards Card T)
(NC.PrintMsg NIL T "Done." (CHARACTER 13)))
(REDISPLAYW Window)
(NC.PrintMsg NIL T "Nodes: " (CONCATLIST (for Node in NodesToRemove
collect (PACK* (fetch (GRAPHNODE
NODEID)
of Node)
(QUOTE % ))))
"removed."))))
(NC.BrowserRemoveEdge
(LAMBDA (FromNode ToNode Window Graph) (* rht: "25-Nov-85 23:52")
(* * 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.)
(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.UIDGetProp FromNodeID ToNodeID))
(if (AND (NULL LabelPairs)
(NULL (NC.UIDGetProp 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)
(BQUOTE
(QUOTE ,
LabelPair)))))
(SETQ LabelPairToRemove (if (CDR MenuItems)
then (MENU (create MENU
ITEMS ← MenuItems
TITLE ← "Which edge to delete?"))
else (EVAL (CADAR MenuItems))))
(if (NOT LabelPairToRemove)
then (FLASHW PROMPTWINDOW)
(NC.PrintMsg NIL T "No edge to delete.")
(RETURN NIL))
(SETQ LinkParams (LINKPARAMETERS FromNode ToNode))
(SETQ ReverseLinkParams (LINKPARAMETERS ToNode FromNode))
(* Undisplay the links between the nodes.)
(NC.DisplayGraphLinksBetween FromNode ToNode Window Graph)
(* Remove the first occurrence of the label pair from
the proper prop list.)
(NC.UIDPutProp 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.UIDGetProp FromNodeID ToNodeID))
(NULL (NC.UIDGetProp ToNodeID FromNodeID)))
then (SETQ FromNodeID (fetch (GRAPHNODE NODEID) of FromNode))
(SETQ ToNodeID (fetch (GRAPHNODE NODEID) of ToNode))
(if LinkParams
then (replace (GRAPHNODE TONODES) of FromNode
with (for Node in (fetch (GRAPHNODE TONODES)
of FromNode)
unless (EQ (CADR Node)
ToNodeID)
collect Node))
(replace (GRAPHNODE FROMNODES) of ToNode
with (DFIRSTREMOVE FromNodeID (fetch (GRAPHNODE FROMNODES)
of ToNode)))
else (replace (GRAPHNODE TONODES) of ToNode
with (for Node in (fetch (GRAPHNODE TONODES) of ToNode)
unless (EQ (CADR Node)
FromNodeID)
collect Node))
(replace (GRAPHNODE FROMNODES) of FromNode
with (DFIRSTREMOVE ToNodeID (fetch (GRAPHNODE FROMNODES)
of FromNode))))
else (* Redisplay links between the two nodes.)
(NC.DisplayGraphLinksBetween FromNode ToNode Window Graph)))))
(NC.MakeLinksLegend
(LAMBDA (Graph Win DropVirtualNodesFlg) (* rht: "25-Nov-85 23:52")
(* * 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.UIDPutProp (SETQ UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node)
NodeID))
(QUOTE NumAppearances)
(if (SETQ OldNumAppearances (NC.UIDGetProp UnderlyingNodeID
(QUOTE
NumAppearances)))
then (ADD1 OldNumAppearances)
else 1))
(if (NC.LinkIconImageObjP (fetch (GRAPHNODE NODELABEL) of Node))
then
(replace (GRAPHNODE TONODES) of Node
with
(for DestNode in (fetch (GRAPHNODE TONODES) of Node)
eachtime (BLOCK) bind NewLabelPairs Labels DestNodeID NewDestNode
NotLabelNodeFlg
join (* If already computed a LinkParams list, then rip out
the ID.)
(if (EQ (CAR DestNode)
LINKPARAMS)
then (SETQ DestNode (CADR DestNode)))
(* Check for virtual nodes.)
(SETQ DestNodeID (if (LISTP DestNode)
then (CAR DestNode)
else DestNode))
(SETQ NewDestNode (if DropVirtualNodesFlg
then DestNodeID
else DestNode))
(SETQ NotLabelNodeFlg (NC.CardFromBrowserNodeID DestNodeID))
(* Turn forward labels into pairs by adding dashing
numbers.)
(SETQ NewLabelPairs
(if (AND NotLabelNodeFlg
(NOT (OR (LISTP (CAR (NC.UIDGetProp NodeID
DestNodeID)))
(LISTP (CAR (NC.UIDGetProp DestNodeID
NodeID))))))
then (* Okay to continue since we haven't visited this pair
already.)
(APPEND (if (SETQ Labels (NC.UIDGetProp NodeID DestNodeID)
)
then
(NC.UIDPutProp
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.UIDGetProp DestNodeID NodeID)
)
then
(NC.UIDPutProp
DestNodeID NodeID
(for Label in Labels bind Pair
collect (COND
((NULL (SETQ Pair
(FASSOC Label
LabelPairs)))
(SETQ Pair
(CONS Label
(COND
((ILESSP LabelNum
MaxDashingStylesNum)
(SETQ LabelNum
(ADD1
LabelNum)))
(T LabelNum))))
(SETQ LabelPairs
(CONS Pair LabelPairs))))
Pair))))))
(* Likewise for backward labels.)
(if NewLabelPairs
then (* Stick this dest node on the referenced list since
we know a node points to it.)
(if (NOT (FMEMB NewDestNode ReferencedNodes))
then (push ReferencedNodes NewDestNode))
(LIST (COND
((CDR NewLabelPairs)
(* There are multiple links joining these two nodes so
record nodeids in param list so we can draw flower of
links.)
(LIST LINKPARAMS NewDestNode (QUOTE
DRAWLINKFN)
(FUNCTION NC.BrowserDrawLinkFn)
(QUOTE NODEID)
NodeID
(QUOTE DESTNODEID)
DestNodeID))
(T (* Only one link, so compute dashing style here.)
(* Check whether link is forward or backward and throw
in backward flag if appropriate.)
(if (NC.UIDGetProp NodeID DestNodeID)
then (LIST LINKPARAMS NewDestNode
(QUOTE DRAWLINKFN)
(FUNCTION
NC.BrowserDrawLinkFn)
(QUOTE DASHING)
(CAR (FNTH
NC.DashingStyles
(CDAR
NewLabelPairs))))
else (LIST LINKPARAMS NewDestNode
(QUOTE DRAWLINKFN)
(FUNCTION
NC.BrowserDrawLinkFn)
(QUOTE DASHING)
(CAR (FNTH NC.DashingStyles
(CDAR
NewLabelPairs)))
(QUOTE BACKWARDFLG)
T)))))
else (* Stick this dest node on the referenced list since
we know a node points to it.)
(if (NOT (FMEMB DestNodeID ReferencedNodes))
then (push ReferencedNodes DestNodeID))
(if (NOT NotLabelNodeFlg)
then (LIST DestNodeID)
else NIL))))))
(* * Note that the following loop gains time at the expense of space. The space-efficient version would only
generate cons nodes for nodes to be deleted, but would require in general, several walks through the structure.)
(* Delete all nodes except the ones that either point to something or are pointed to. But keep those unreferenced
nodes that appear exactly once in the graph. They'll wind up being roots.)
(replace (GRAPH GRAPHNODES) of Graph
with (for Node in (fetch (GRAPH GRAPHNODES) of Graph) eachtime (BLOCK)
when (LET* ((UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node)
(fetch (GRAPHNODE NODEID)
of Node)))
(NumAppearances (NC.UIDGetProp UnderlyingNodeID
(QUOTE NumAppearances))))
(if (OR (fetch (GRAPHNODE TONODES) of Node)
(FMEMB (fetch (GRAPHNODE NODEID) of Node)
ReferencedNodes)
(EQ NumAppearances 1))
else (* This node is getting deleted.)
(NC.UIDPutProp UnderlyingNodeID (QUOTE
NumAppearances)
(SUB1 NumAppearances))
NIL))
collect Node)) (* Get rid of node borders for virtual nodes that now
only appear once in the graph.
Also clean off prop list.)
(for Node in (fetch (GRAPH GRAPHNODES) of Graph)
do (LET ((UnderlyingNodeID (OR (NC.CoerceToGraphNodeID Node)
(fetch (GRAPHNODE NODEID) of Node))))
(if (EQ 1 (NC.UIDGetProp UnderlyingNodeID (QUOTE NumAppearances)))
then (replace (GRAPHNODE NODEBORDER) of Node with NIL))
(NC.UIDRemProp UnderlyingNodeID (QUOTE NumAppearances))))
(SETQ LabelPairs (DREVERSE LabelPairs))
(AND Win (NC.MakeLinksLegendMenu Win LabelPairs))
(RETURN LabelPairs))))
(NC.DrawFlowerLinks
(LAMBDA (NodeID1 NodeID2 X1 Y1 X2 Y2 Width Operation Stream Color)
(* rht: "25-Nov-85 23:52")
(* * 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.UIDGetProp NodeID1 NodeID2)
do (NC.DrawFlowerLink X1 Y1 X2 Y2 (LIST (QUOTE ROUND)
Width Color)
(CAR (FNTH NC.DashingStyles (CDR Pair)))
(SETQ Count (ADD1 Count))
Stream Width Operation Color))
(for Pair in (NC.UIDGetProp NodeID2 NodeID1)
do (NC.DrawFlowerLink X2 Y2 X1 Y1 (LIST (QUOTE ROUND)
Width Color)
(CAR (FNTH NC.DashingStyles (CDR Pair)))
(SETQ Count (ADD1 Count))
Stream Width Operation Color)))))
(NC.GetBrowserNodeID
(LAMBDA (BrowserCard NodeCard) (* rht: "25-Nov-85 23:43")
(* * 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.)
(LET ((HashArray (NC.HashArrayFromBrowserCard BrowserCard))
NewUID)
(if (GETHASH NodeCard HashArray)
else (NC.UIDPutProp (SETQ NewUID (NC.MakeBrowserNodeUID))
(QUOTE CardObject)
NodeCard)
(PUTHASH NodeCard NewUID HashArray)
NewUID))))
(NC.GetBrowserHashArray
(LAMBDA (BrowserCard Graph) (* rht: "25-Nov-85 23:52")
(* * 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.)
(if (AND Graph (NC.HashArrayFromBrowserCard BrowserCard))
else (LET ((HashArray (HASHARRAY NC.BrowserHashArraySize)))
(NC.SetUserDataProp BrowserCard (QUOTE BrowserHashArray)
HashArray)
(AND Graph (for GraphNode in (fetch (GRAPH GRAPHNODES) of Graph)
bind GraphNodeID eachtime (BLOCK)
do (SETQ GraphNodeID (NC.CoerceToGraphNodeID GraphNode))
(PUTHASH (NC.UIDGetProp GraphNodeID (QUOTE CardObject))
GraphNodeID HashArray)))))))
(NC.CardFromBrowserNodeID
(LAMBDA (BrowserNodeID) (* rht: "25-Nov-85 23:52")
(* * Extract the card from a browser nodeID.)
(NC.UIDGetProp BrowserNodeID (QUOTE CardObject))))
(NC.SmashGraphNodeIDProps
(LAMBDA (GraphNodeID) (* rht: "25-Nov-85 23:43")
(* * Smash the prop list of GraphNodeID except be sure to save the CardObject prop if there is one.)
(LET ((Card (NC.CardFromBrowserNodeID GraphNodeID)))
(NC.UIDSetPropList GraphNodeID NIL)
(AND Card (NC.UIDPutProp GraphNodeID (QUOTE CardObject)
Card)))))
(NC.ConnectNodesInBrowser
(LAMBDA (Window) (* rht: "26-Nov-85 00:14")
(* * Draw any links, from the current link set, between any pairs of nodes currently being shown in the browser.)
(PROG (Card LinkLabels Graph GraphNodes PropList BrowserFormat DropVirtualNodesFlg LabelPairs
NodeIDs)
(SETQ Card (NC.CoerceToCard Window))
(SETQ PropList (NC.FetchPropList Card))
(SETQ LinkLabels (CAR (LISTGET PropList (QUOTE BrowserLinkLabels))))
(SETQ BrowserFormat (CAR (LISTGET PropList (QUOTE BrowserFormat))))
(* If user wants *GRAPH* format, i.e. virtual nodes
eliminated, then set the flag)
(if (FMEMB NC.*Graph*BrowserFormat BrowserFormat)
then (SETQ DropVirtualNodesFlg T))
(SETQ GraphNodes (fetch (GRAPH GRAPHNODES) of (SETQ Graph (WINDOWPROP
Window
(QUOTE GRAPH)))))
(* 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 (FMEMB (SETQ DestNodeID (NC.GetBrowserNodeID Card
(fetch
(Link
DestinationCard)
of Link)))
NodeIDs)
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 (FMEMB (SETQ SourceNodeID (NC.GetBrowserNodeID
Card
(fetch (Link SourceCard) of Link)))
NodeIDs)
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 in (GETPROPLIST NodeID)
by (CDDR ToNodeID) eachtime (BLOCK)
unless (EQ ToNodeID (QUOTE CardObject))
collect (OR (FASSOC ToNodeID OldToNodeIDs)
ToNodeID))
(for ToNodeID in OldToNodeIDs eachtime (BLOCK)
unless (NC.SameCardP Card (NC.CardFromBrowserNodeID
(NC.CoerceToGraphNodeID
ToNodeID)))
collect ToNodeID))))
(NC.RebuildFromNodesInGraph GraphNodes)
(SETQ LabelPairs (NC.MakeLinksLegend Graph Window DropVirtualNodesFlg))
(SHOWGRAPH Graph Window (FUNCTION NC.GraphCardLeftButtonFn)
(FUNCTION NC.GraphCardMiddleButtonFn)
NIL T)
(* * Have to reset windowprops since SHOWGRAPH messes with them.)
(* Disable the old-style right button grapher editor
menu.)
(WINDOWPROP Window (QUOTE RIGHTBUTTONFN)
(FUNCTION NC.BrowserRightButtonFn))
(WINDOWADDPROP Window (QUOTE REPAINTFN)
(FUNCTION NC.BrowserRepaintFn)
T)
(NC.SetSubstance Card (WINDOWPROP Window (QUOTE GRAPH)))
(NC.MarkCardDirty Card)
(NC.PutProp Card (QUOTE BrowserLinksLegend)
(LIST LabelPairs))
(OR (EQ (WINDOWPROP Window (QUOTE BUTTONEVENTFN))
(FUNCTION NC.TitleBarButtonEventFn))
(WINDOWPROP Window (QUOTE OLDBUTTONEVENTFN)
(WINDOWPROP Window (QUOTE BUTTONEVENTFN)
(FUNCTION NC.TitleBarButtonEventFn))))
(NC.ClearMsg Window T))))
(NC.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.AddBrowserCard
(LAMBDA NIL (* rht: "26-Nov-85 01:58")
(* * fgh 11/14/85 Updated to handle merge of card and substance types.)
(NC.AddCardType (QUOTE Browser)
(QUOTE Graph)
(BQUOTE ((MakeFn , (FUNCTION NC.MakeBrowserCard))
(EditFn , (FUNCTION NC.BringUpBrowserCard))
(PutFn , (FUNCTION NC.PutBrowserSubstance))))
(BQUOTE ((LinkDisplayMode Title)
(DefaultHeight 350)
(DefaultWidth 500)
(DisplayedInMenuFlg , T))))))
(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)))))
)
(* * This function from NCDATABASE has been redefined.)
(DEFINEQ
(NC.CreateDatabaseFile
(LAMBDA (FileName HashArraySize CallingOperationMsg OmitFinalNoteFlg StartingNextFreeIndex)
(* rht: "26-Nov-85 21:57")
(* * Create a NoteCards database on file FileName. Just creates an index HashArraySize entries long, then writes
out the Root and Orphan cards)
(* * rht 8/7/84: Added OmitFinalNoteFlg flag parameter to prevent the final message. Changed parameter name from
NC.IndexSizeInEntries to HashArraySize since the fomer is a global.)
(* * rht 1/30/85: Reserved 3 bytes of the remaining 8 to hold pointer to last checkpointed EOFPTR.)
(* * rht 3/21/85: Added the StartingNextFreeIndex argument which if non-nil, gives a NextID Num to be filled in to
the file before returning. This is useful when compacting.)
(* * fkr 11/8/85: Added check that OPENSTREAM succeeded. Added call to NC.CreateNoteFileObject in which lots of
work is now being done.)
(* * fgh 11/17/85 Wrapped whole thing in ERSETQ to close file if somethinghappens during the create.)
(LET (Stream NoteFile)
(OR (CAR (ERSETQ (PROG NIL
(SETQ CallingOperationMsg (COND
(CallingOperationMsg (CONCAT CallingOperationMsg
(CHARACTER 13)))
(T "")))
(AND (NULL FileName)
(NULL (SETQ FileName (NC.DatabaseFileName
"What is the name of the NoteFile to be created?"
" -- "
T T)))
(RETURN (QUOTE CANCELLED)))
(OR (FIXP HashArraySize)
(SETQ HashArraySize NC.DefaultIndexSizeInEntries))
(COND
((NULL (SETQ Stream
(CAR (ERSETQ (OPENSTREAM
FileName
(QUOTE BOTH)
(QUOTE NEW)
(QUOTE ((TYPE BINARY))))))))
(NC.PrintMsg NIL T "Can't open file: " FileName
(CHARACTER 13)
"Create cancelled."
(CHARACTER 13))
(RETURN (QUOTE CANCELLED))))
(RESETSAVE NIL (BQUOTE (PROGN (CLOSEF , Stream)
(DELFILE (FULLNAME
, Stream)))))
(NC.PrintMsg NIL T CallingOperationMsg "Creating NoteFile "
(FULLNAME Stream)
". Please wait... ")
(SETQ NoteFile
(create NoteFile
UID ←(NC.MakeUID)
Stream ← Stream
FullFileName ←(FULLNAME Stream)
HashArray ←(HASHARRAY HashArraySize)
HashArraySize ← HashArraySize
NextIndexNum ←(OR
(FIXP StartingNextFreeIndex)
(CONSTANT (ADD1 (fetch (NoteFileVersion
NumberOfReservedCards)
of (
NC.FetchCurrentVersionObject)))
))
Version ← NC.VersionNumber
NextLinkNum ← 1
CheckptPtr ←(NC.TotalIndexSize HashArraySize)
MonitorLock ←(CREATE.MONITORLOCK (QUOTE
Creating))))
(* Write the header down to the file.)
(NC.PutNoteFileHeader NoteFile)
(for CTR from 1 to HashArraySize eachtime (BLOCK)
do (AND (ZEROP (IREMAINDER CTR 1000))
(NC.PrintMsg NIL T CallingOperationMsg
"Creating NoteFile."
(CHARACTER 13)
"Processing item " CTR
" out of "
HashArraySize "." (CHARACTER
13)))
(NC.WriteStatus Stream (QUOTE FREE))
(SETFILEPTR
Stream
(PLUS (GETFILEPTR Stream)
(CONSTANT (SUB1 (fetch (
NoteFileVersion NoteFileIndexWidth) of (NC.FetchCurrentVersionObject)))))))
(NC.PrintMsg NIL T CallingOperationMsg "Creating NoteFile "
(FULLNAME Stream)
". Please wait... ")
(* Move NextIndexNum back to the beginning so that
special cards will have the correct index nums.)
(replace (NoteFile NextIndexNum) of NoteFile
with 1)
(NC.InitializeSpecialCards NoteFile)
(NC.CheckpointDatabase NoteFile T)
(NC.ForceDatabaseClose NoteFile)
(SETQ NC.DatabaseFileNameSuggestion (PACKFILENAME
(QUOTE VERSION)
NIL
(QUOTE BODY)
(FULLNAME FileName)))
(COND
(OmitFinalNoteFlg (NC.PrintMsg NIL NIL " Done!"
(CHARACTER 13)))
(T (NC.PrintMsg NIL NIL " Done!" (CHARACTER 13)
"Note that the NoteFile must still"
" be opened before it is used."
(CHARACTER 13))))
(RETURN NoteFile))))
(CLOSEF Stream (DELFILE (FULLNAME Stream)))
(QUOTE CANCELLED)))))
(NC.UIDPutProp
(LAMBDA (UID Prop Value) (* rht: "26-Nov-85 22:25")
(LET ((PropList (fetch (UID UserData) of UID)))
(COND
(PropList (LISTPUT PropList Prop Value))
(T (replace (UID UserData) of UID with (LIST Prop Value)))))))
)
(PUTPROPS RHTPATCH009 COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1593 2216 (NC.UIDSetPropList 1603 . 1781) (NC.UIDAddProp 1783 . 2214)) (2267 2547 (
NC.RemProp 2277 . 2545)) (2643 4269 (NC.PutBrowserSubstance 2653 . 3252) (NC.FetchBrowserRoots 3254 .
3749) (NC.SetBrowserRoots 3751 . 4267)) (4347 93077 (NC.MakeBrowserCard 4357 . 11146) (
NC.BringUpBrowserCard 11148 . 13484) (NC.RelayoutBrowserCard 13486 . 19580) (NC.GrowLinkLattice 19582
. 28029) (NC.UpdateBrowserCard 28031 . 37596) (NC.ExpandBrowserNode 37598 . 45976) (
NC.RemoveDuplicateNodesFromGraph 45978 . 47702) (NC.BrowserAddLink 47704 . 54193) (
NC.BrowserDeleteCard 54195 . 56331) (NC.BrowserDeleteLink 56333 . 62745) (NC.BrowserRemoveNode 62747
. 68242) (NC.BrowserRemoveEdge 68244 . 72473) (NC.MakeLinksLegend 72475 . 81475) (NC.DrawFlowerLinks
81477 . 82833) (NC.GetBrowserNodeID 82835 . 83571) (NC.GetBrowserHashArray 83573 . 84474) (
NC.CardFromBrowserNodeID 84476 . 84723) (NC.SmashGraphNodeIDProps 84725 . 85171) (
NC.ConnectNodesInBrowser 85173 . 91342) (NC.CoerceToGraphNodeID 91344 . 91986) (NC.AddBrowserCard
91988 . 92564) (NC.BrowserFlipRoots 92566 . 93075)) (93140 98706 (NC.CreateDatabaseFile 93150 . 98381)
(NC.UIDPutProp 98383 . 98704)))))
STOP