(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED " 9-Jun-88 18:11:25" {QV}<NOTECARDS>1.3LNEXT>RHTPATCH324.;1 12304
changes to%: (VARS RHTPATCH324COMS))
(* "
Copyright (c) 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT RHTPATCH324COMS)
(RPAQQ RHTPATCH324COMS ((DECLARE%: DONTCOPY (PROPS (RHTPATCH324 MAKEFILE-ENVIRONMENT)
(RHTPATCH324 FILETYPE)))
(* ;; "Fixed the bug reported by John Tang where A points to B and B points to A and we're deleting B results in all of A's fromlinks getting trashed.")
(* ;; "Change to NCCARDS")
(FNS NC.SeverExternalLinks)))
(DECLARE%: DONTCOPY
(PUTPROPS RHTPATCH324 MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS RHTPATCH324 FILETYPE :TCOMPL)
)
(* ;;
"Fixed the bug reported by John Tang where A points to B and B points to A and we're deleting B results in all of A's fromlinks getting trashed."
)
(* ;; "Change to NCCARDS")
(DEFINEQ
(NC.SeverExternalLinks
[LAMBDA (ListOfCards QuietFlg InterestedWindow) (* ; "Edited 9-Jun-88 18:09 by Trigg")
(* ;;; "Delete all links in ListOfCards to or from cards not in ListOfCards. Furthermore, do it efficiently by caching an external card only long enough to delete all the links between it and ListOfCards. Note that we depend on the fact that every card in ListOfCards has its AboutToBeDeletedFlg set.")
(* ;; "rht&pmi 5/29/87: Now passes non-nil LeaveCachedFlg to NC.RetrieveToLinks and NC.RetrieveFromLinks. Not sure if this is really necessary.")
(* ;; "pmi 6/8/87: Added call to NC.GreyCard to grey cards being deleted before deleting all of their links.")
(* ;; "dsj. 10/12/87. Changed to do lazy updating of links and only half-sever links for which this card is the destination: let the other half be severed and updated when and if the source card is invoked.")
(* ;;
"rht 10/31/87: Now uncaches links after call to NC.PutLinks on 'external' source cards.")
(* ;; "pmi 12/10/87: Merged dsj's and rht's changes; see last two comments above.")
(* ;; "rht 6/9/88: Fixed the bug where A points to B and B points to A and we're deleting B results in all of A's fromlinks getting trashed.")
(LET (LinksToSever NumLinksToSever)
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Gathering external links of " (LENGTH
ListOfCards
)
" cards."))
[SETQ LinksToSever (NC.UnionListsOfLinks
(for Card in ListOfCards
join (* ; "Grey the cards being deleted.")
(NC.GreyCard Card)
(for Link in (NC.RetrieveToLinks Card T)
unless (NC.UIDGetProp (fetch (Card UID)
of (fetch (Link DestinationCard)
of Link))
'AboutToBeDeletedFlg) collect Link))
(for Card in ListOfCards
join (for Link in (NC.RetrieveFromLinks Card T)
unless (NC.UIDGetProp (fetch (Card UID)
of (fetch (Link SourceCard)
of Link))
'AboutToBeDeletedFlg) collect Link]
(* ;; "Now sort links so that links with same external anchor card are grouped together. Furthermore, the links having that anchor card has source card are grouped before the ones having that card as destination card.")
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Sorting " (SETQ NumLinksToSever (LENGTH
LinksToSever
))
" links prior to severing."))
[SORT LinksToSever (FUNCTION (LAMBDA (Link1 Link2)
(LET (DestCard1 DestCard2 ExtCard1 ExtCard2
Link1SourceIsExtFlg)
(SETQ ExtCard1
(if (NC.UIDGetProp (fetch (Card UID)
of (SETQ DestCard1
(fetch (Link DestinationCard)
of Link1)))
'AboutToBeDeletedFlg)
then (SETQ Link1SourceIsExtFlg T)
(fetch (Link SourceCard) of Link1)
else DestCard1))
(SETQ ExtCard2
(if (NC.UIDGetProp (fetch (Card UID)
of (SETQ DestCard2
(fetch (Link DestinationCard)
of Link2)))
'AboutToBeDeletedFlg)
then (fetch (Link SourceCard) of Link2)
else DestCard2))
(if (NC.SameCardP ExtCard1 ExtCard2)
then Link1SourceIsExtFlg
else (LESSP (fetch (Card IndexLoc) of ExtCard1)
(fetch (Card IndexLoc) of ExtCard2]
(* ;;
"Now walk down the list of links one by one activating the external anchor cards as needed.")
(OR QuietFlg (NC.PrintMsg InterestedWindow T "Severing links: 1 out of " NumLinksToSever
" ..."))
(* ;; "dsj. Changed to only half-sever links for which this card is the destination: let the other half be severed and updated when and if the source card is invoked.")
(for Link in LinksToSever as i from 1 bind PreviousExtCard WasNotActiveFlg
PreviousExtCardIsSourceFlg eachtime (BLOCK)
when (NC.ValidLinkP Link)
do (OR QuietFlg (if (ZEROP (REMAINDER i 10))
then (NC.PrintMsg InterestedWindow T "Severing links: " i " out of "
NumLinksToSever " ...")))
(LET (ExtCard ExtCardIsSourceFlg)
(SETQ ExtCard (if (NC.UIDGetProp (fetch (Card UID) of (fetch (Link
DestinationCard
) of Link))
'AboutToBeDeletedFlg)
then (SETQ ExtCardIsSourceFlg T)
(fetch (Link SourceCard) of Link)
else (fetch (Link DestinationCard) of Link)))
[if (OR (NOT (NC.SameCardP ExtCard PreviousExtCard))
(NOT (EQ ExtCardIsSourceFlg PreviousExtCardIsSourceFlg)))
then (* ;
"Write down changes to previous external card's substance.")
(if WasNotActiveFlg
then (if PreviousExtCardIsSourceFlg
then (* ; "Have to call NC.CardSaveFn first and then NC.QuitCard with Don'tSaveFlg to avoid insureProperFiling check.")
(* ; "dsj. Disabled this.")
(* ;
"(NC.CardSaveFn PreviousExtCard T) (NC.QuitCard PreviousExtCard NIL T NIL NIL NIL T)")
else (NC.PutLinks PreviousExtCard)
(NC.UncacheLinks PreviousExtCard)))
(* ;
"If ExtCard not active, then cache.")
(if (SETQ WasNotActiveFlg (NOT (NC.ActiveCardP ExtCard)))
then (if ExtCardIsSourceFlg
then (* ;
"Cache whole card if it's the link's source.")
(* ; "dsj. Disabled this.")
(* ; "(NC.GetNoteCard ExtCard)")
else (* ;
"Else only need the links since we're deleting the from link.")
(NC.GetLinks ExtCard]
(* ;
"Delete the appropriate half of the link.")
(if ExtCardIsSourceFlg
then (* ;
"dsj. Now delete TO link only if the card is active on the screen.")
(AND (NOT WasNotActiveFlg)
(NC.DeleteToLink Link))
else (NC.DeleteFromLink Link))
(replace (Link UID) of Link with -1)
(SETQ PreviousExtCard ExtCard)
(SETQ PreviousExtCardIsSourceFlg ExtCardIsSourceFlg))
finally (if (AND WasNotActiveFlg (NC.ValidCardP PreviousExtCard))
then (if PreviousExtCardIsSourceFlg
then (* ; "Have to call NC.CardSaveFn first and then NC.QuitCard with Don'tSaveFlg to avoid insureProperFiling check.")
(* ; "dsj. Disabled this.")
(* ;
"(NC.CardSaveFn PreviousExtCard T) (NC.QuitCard PreviousExtCard NIL T NIL NIL NIL T)")
else (NC.PutLinks PreviousExtCard)
(NC.UncacheLinks PreviousExtCard])
)
(PUTPROPS RHTPATCH324 COPYRIGHT ("Xerox Corporation" 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1166 12221 (NC.SeverExternalLinks 1176 . 12219)))))
STOP