(FILECREATED "29-May-87 16:49:26" {QV}<NOTECARDS>1.3K>NEXT>RHTPATCH270.;1 12693
changes to: (VARS RHTPATCH270COMS))
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT RHTPATCH270COMS)
(RPAQQ RHTPATCH270COMS ((* * Fix to bug reported by John Tang. Again this is another half-link
problem introduced by the changes in RGPATCH041.)
(* * Change to NCCARDS)
(FNS NC.RetrieveFromLinks NC.RetrieveToLinks NC.RetrieveGlobalLinks
NC.SeverExternalLinks)
(* * Change to NCPROGINT)
(FNS NCP.GetLinks)))
(* * Fix to bug reported by John Tang. Again this is another half-link problem introduced by
the changes in RGPATCH041.)
(* * Change to NCCARDS)
(DEFINEQ
(NC.RetrieveFromLinks
(LAMBDA (Card LeaveCachedFlg) (* rht: "29-May-87 16:27")
(* Get or Fetch the from links for the card ID)
(* * rht 11/10/85: Updated to handle new CardID and hash array scheme.)
(* * fgh 11/11/85: Updated to handle CardInfo objects.)
(* * fgh 11/13/85 Updated to handle Card object.)
(* * rht&pmi 5/29/87: Change to functionality. Default is now to not leave links cached if they weren't when we
came in. If LeaveCachedFlg is non-nil, then get old functionality.)
(LET ((LinksWereCachedFlg (NC.LinksCachedP Card)))
(if (NOT LinksWereCachedFlg)
then (NC.GetLinks Card))
(PROG1 (NC.FetchFromLinks Card)
(if (AND (NOT LinksWereCachedFlg)
(NOT LeaveCachedFlg))
then (NC.UncacheLinks Card))))))
(NC.RetrieveToLinks
(LAMBDA (Card LeaveCachedFlg) (* rht: "29-May-87 16:26")
(* Get or Fetch the from links for the card ID)
(* * rht 11/10/85: Updated to handle new CardID and hasharray scheme.)
(* * fgh 11/11/85: Updated to handle Card object.)
(* * rht&pmi 5/29/87: Change to functionality. Default is now to not leave links cached if they weren't when we
came in. If LeaveCachedFlg is non-nil, then get old functionality.)
(LET ((LinksWereCachedFlg (NC.LinksCachedP Card)))
(if (NOT LinksWereCachedFlg)
then (NC.GetLinks Card))
(PROG1 (NC.FetchToLinks Card)
(if (AND (NOT LinksWereCachedFlg)
(NOT LeaveCachedFlg))
then (NC.UncacheLinks Card))))))
(NC.RetrieveGlobalLinks
(LAMBDA (Card LeaveCachedFlg) (* rht: "29-May-87 16:28")
(* * Fetch or get the global links of ID)
(* * rht 11/10/85: Updated to handle new CardID and hasharray scheme.)
(* * fgh 11/11/85: Updated to handle Card object.)
(* * rht&pmi 5/29/87: Change to functionality. Default is now to not leave links cached if they weren't when we
came in. If LeaveCachedFlg is non-nil, then get old functionality.)
(LET ((LinksWereCachedFlg (NC.LinksCachedP Card)))
(if (NOT LinksWereCachedFlg)
then (NC.GetLinks Card))
(PROG1 (NC.FetchGlobalLinks Card)
(if (AND (NOT LinksWereCachedFlg)
(NOT LeaveCachedFlg))
then (NC.UncacheLinks Card))))))
(NC.SeverExternalLinks
(LAMBDA (ListOfCards QuietFlg InterestedWindow) (* rht: "29-May-87 16:44")
(* * 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.)
(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 (for Link in (NC.RetrieveToLinks Card T)
unless (NC.UIDGetProp
(fetch (Card UID)
of (fetch (Link DestinationCard)
of Link))
(QUOTE 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))
(QUOTE 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)))
(QUOTE 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)))
(QUOTE 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
" ..."))
(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))
(QUOTE AboutToBeDeletedFlg))
then (SETQ ExtCardIsSourceFlg T)
(fetch (Link SourceCard) of Link)
else (fetch (Link DestinationCard) of Link)))
(if (NOT (NC.SameCardP ExtCard PreviousExtCard))
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.)
(NC.CardSaveFn PreviousExtCard T)
(NC.QuitCard PreviousExtCard NIL T NIL NIL
NIL T)
else (NC.PutLinks 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.)
(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 (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.)
(NC.CardSaveFn PreviousExtCard T)
(NC.QuitCard PreviousExtCard NIL T NIL NIL NIL T)
else (NC.PutLinks PreviousExtCard)))))))
)
(* * Change to NCPROGINT)
(DEFINEQ
(NCP.GetLinks
(LAMBDA (Cards DestinationCards Labels NoteFile) (* rht: "29-May-87 16:48")
(* * Returns a list of all links from Cards to DestinationCards whose link label is one of Labels.
Labels can be nil, in which case all such links are returned. Cards and DestinationCards can each be atomic.
Each can also be nil. For example, if DestinationCards is nil, then all links pointing from Cards to anywhere with
given labels are returned. Note that if both Cards and DestinationCards are nil, then will return all links whose
label is one of Labels. If all three args are nil, then return all links in the current notefile.)
(* * rht 11/17/85: Updated to handle new card and notefile objects.)
(* * rht 8/29/86: Now blocks in loops and checks whether links cached before retrieving.)
(* * rht 11/16/86: Changed call to NCP.ReportError)
(* * rht&pmi 5/29/87: No longer has to uncache links because of change to NC.RetrieveFromLinks and
NC.RetrieveToLinks.)
(LET (ValidCards ValidDestinationCards)
(SETQ Labels (MKLIST Labels))
(SETQ ValidCards (for Card in (MKLIST Cards) eachtime (BLOCK)
unless (COND
((NOT (NC.ValidCardP Card))
(NCP.ReportError (QUOTE NCP.GetLinks)
(CONCAT Card
" not an existing card or box."))
T))
collect Card))
(SETQ ValidDestinationCards (for Card in (MKLIST DestinationCards) eachtime
(BLOCK)
unless (COND
((NOT (NC.ValidCardP Card))
(NCP.ReportError (QUOTE NCP.GetLinks)
(CONCAT Card
" not an existing card or box."))
T))
collect Card))
(COND
(Cards (for Card in ValidCards eachtime (BLOCK)
join (for Link in (NC.RetrieveToLinks Card)
when (COND
(DestinationCards (FMEMB (fetch (Link DestinationCard)
of Link)
ValidDestinationCards))
(T T))
when (COND
(Labels (FMEMB (fetch (Link Label) of Link)
Labels))
(T T))
collect Link)))
(DestinationCards (for Card in ValidDestinationCards eachtime (BLOCK)
join (for Link in (NC.RetrieveFromLinks Card)
when (COND
(Labels (FMEMB (fetch (Link Label)
of Link)
Labels))
(T T))
collect Link)))
(T (NCP.MapLinks NoteFile (FUNCTION PROG1)
(FUNCTION (LAMBDA (Link)
(if Labels
then (FMEMB (fetch (Link Label) of Link)
Labels)
else T)))))))))
)
(PUTPROPS RHTPATCH270 COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (744 9637 (NC.RetrieveFromLinks 754 . 1746) (NC.RetrieveToLinks 1748 . 2663) (
NC.RetrieveGlobalLinks 2665 . 3534) (NC.SeverExternalLinks 3536 . 9635)) (9670 12611 (NCP.GetLinks
9680 . 12609)))))
STOP