(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED " 3-Aug-88 12:22:56" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH329.;1 8021
changes to%: (VARS RHTPATCH329COMS))
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RHTPATCH329COMS)
(RPAQQ RHTPATCH329COMS
((DECLARE%: DONTCOPY (PROPS (RHTPATCH329 MAKEFILE-ENVIRONMENT)
(RHTPATCH329 FILETYPE)))
[DECLARE%: FIRST (P (NC.LoadFileFromDirectories 'NCBROWSERCARD]
(* ;; "Fixes bug whereby removing a node from a browser which happens to be a root wasn't removing it from the roots list.")
(* ;; "Change to NCBROWSERCARD")
(FNS NC.BrowserRemoveNode)))
(DECLARE%: DONTCOPY
(PUTPROPS RHTPATCH329 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS RHTPATCH329 FILETYPE :TCOMPL)
)
(DECLARE%: FIRST
(NC.LoadFileFromDirectories 'NCBROWSERCARD)
)
(* ;;
"Fixes bug whereby removing a node from a browser which happens to be a root wasn't removing it from the roots list."
)
(* ;; "Change to NCBROWSERCARD")
(DEFINEQ
(NC.BrowserRemoveNode
[LAMBDA (Graph Window DeleteCardFlg NodeToRemove QuietFlg) (* ; "Edited 3-Aug-88 12:20 by Trigg")
(* ;; "Called by grapher when user removes a node.")
(* ;; "rht 11/17/85: Updated to handle new card and notefile formats.")
(* ;; "rht 2/7/86: Changed to use NC.SetBrowserRoots instead of NC.PutProp")
(* ;; "rht 4/30/86: Now takes optional NodeToRemove and QuietFlg argument.")
(* ;; "rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard")
(* ;; "pmi 8/7/87: Now passes DeleteCardFlg arg to NC.DelBrowserContentsLink. Also turned off confirmation in NC.DeleteNoteCard.")
(* ;; "rht 1/19/88: Now returns nil if NC.SelectGraphNode returns nil.")
(* ;; "rht 8/3/88: Ripped out this piece of code that bailed out early in case when NodeToRemove had no edges.")
(DECLARE (GLOBALVARS PROMPTWINDOW))
(PROG ((GraphCard (NC.CoerceToCard Window))
Card NodeToRemoveID RootCards NodesToRemove NumVirtuals)
(OR NodeToRemove (SETQ NodeToRemove (NC.SelectGraphNode Window Graph
(if DeleteCardFlg
then "Choose node of card to delete."
else "Choose node to remove.")))
(RETURN NIL))
(SETQ NodeToRemoveID (NC.CoerceToGraphNodeIDOrLabel NodeToRemove))
(SETQ Card (NC.CardFromBrowserNodeID NodeToRemoveID))
(* ;; "If we're supposed to be deleting a card, then check that node represents a card and that user confirms.")
(if DeleteCardFlg
then (if (NC.ValidCardP Card)
then (if (NOT (NC.AskYesOrNo (CONCAT "Are you sure you want to delete the "
(NC.RetrieveTitle Card)
" card? ")
"--"
'Yes T Window NIL NIL))
then (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)))
(AND (NC.ValidCardP GraphCard)
(NC.MarkCardDirty GraphCard))
(* ;; "We require that all virtual nodes for this node must be removed at once if this one has any link edges to or from it.")
(SETQ NodesToRemove (for Node in (fetch (GRAPH GRAPHNODES) of Graph)
when (EQ NodeToRemoveID (NC.CoerceToGraphNodeIDOrLabel Node))
collect Node)) (* ;
"If there are companion virtual nodes, ask for user confirmation.")
(if [AND (NOT DeleteCardFlg)
(GREATERP (SETQ NumVirtuals (LENGTH NodesToRemove))
1)
(NOT (PROGN (NC.PrintMsg Window T NumVirtuals
" virtual companion nodes will be removed." (CHARACTER 13))
(NC.YesP (NC.AskUser "Still want to remove? " "--" 'Yes NIL Window NIL
NIL T]
then (FLIPNODE NodeToRemove Window)
(RETURN NIL)) (* ;
"Delete the browsercontents link from the browser.")
(AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard)
(NC.DelBrowserContentsLink GraphCard Card DeleteCardFlg))
(* ;
"Delete all record of links to and from this node on prop lists.")
(NC.SmashGraphNodeIDProps NodeToRemoveID)
(for Node in (fetch (GRAPH GRAPHNODES) of Graph) eachtime (BLOCK) bind UID
when (type? UID (SETQ UID (NC.CoerceToGraphNodeID Node))) do (NC.GraphNodeIDRemProp
UID NodeToRemoveID))
(if (AND (NC.ValidCardP Card)
(NC.ValidCardP GraphCard))
then (* ; "Remove from the root ids list.")
(SETQ RootCards (NC.FetchBrowserRoots GraphCard))
(if (for RootCard in RootCards eachtime (BLOCK) thereis (NC.SameCardP Card
RootCard))
then (NC.SetBrowserRoots GraphCard (for RootCard in RootCards
eachtime (BLOCK)
unless (NC.SameCardP Card RootCard)
collect RootCard)))
(* ;
"Remove entry for this node from browser hash array.")
(NC.RemoveBrowserNodeHashArrayEntry GraphCard Card))
(* ;
"Get rid of node and its virtual buddies from graph.")
(AND Window (FLIPNODE NodeToRemove Window))
(for Node in NodesToRemove do (NC.GraphRemoveNode Node Graph Window))
(* ; "Delete card if we're supposed to.")
(if DeleteCardFlg
then (NC.PrintMsg NIL T "Deleting " Card " ... ")
(NC.DeleteNoteCard Card NIL T)
(NC.PrintMsg NIL T "Done." (CHARACTER 13)))
(AND Window (REDISPLAYW Window))
(OR QuietFlg (NC.PrintMsg NIL T "Nodes: " [CONCATLIST
(for Node in NodesToRemove
collect (PACK* (fetch (GRAPHNODE NODEID)
of Node)
'% ]
"removed."])
)
(PUTPROPS RHTPATCH329 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1183 7938 (NC.BrowserRemoveNode 1193 . 7936)))))
STOP