(FILECREATED "13-Mar-85 00:52:13" {PHYLUM}<NOTECARDS>RELEASE1.2>NCLINKINDEXCARD.;2 9071
changes to: (VARS NCLINKINDEXCARDCOMS)
(FNS NC.AddLinkIndexCard)
previous date: "12-Feb-85 23:10:38" {PHYLUM}<NOTECARDS>RELEASE1.2>NCLINKINDEXCARD.;1)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCLINKINDEXCARDCOMS)
(RPAQQ NCLINKINDEXCARDCOMS ((E (SETQ NC.SystemDate (DATE))
(UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS)))
(VARS NC.SystemDate)
(P (UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS)))
(* * Link Index functions)
(FILES NCTEXTSUBSTANCE NCTEXTCARD)
(FNS NC.MakeLinkIndex NC.AppendLinkIndexEntry NC.LinkIndexCompareFn)
(FNS NC.AddLinkIndexCard)
(P (NC.AddLinkIndexCard))))
(RPAQQ NC.SystemDate "13-Mar-85 00:52:15")
(UNMARKASCHANGED (QUOTE NC.SystemDate)
(QUOTE VARS))
(* * Link Index functions)
(FILESLOAD NCTEXTSUBSTANCE NCTEXTCARD)
(DEFINEQ
(NC.MakeLinkIndex
(LAMBDA (ID Title NoDisplayFlg SpecialArgsList) (* rht: "31-Jan-85 21:23")
(* * Gather all instances of a given set of linktypes, printing the titles of cards at the from and to ends of the
link.)
(* * rht 10/24/84: Now callable from Programmer's interface. If NoDisplayFlg it non-nil, then will build LinkIndex
invisibly. If SpecialArgsList is non-nil, then should be list of (<linklabels> <backpointersP> <sortP>))
(PROG (IndexCardID Window WindowOrID LinkLabels BackLinksP Stream SortedWinners LastID)
(SPAWN.MOUSE)
(SETQ WindowOrID (NC.MakeNoteCard (QUOTE Text)
"Link Index" NoDisplayFlg NIL ID))
(COND
(NoDisplayFlg (SETQ Window NIL)
(SETQ IndexCardID WindowOrID))
(T (SETQ Window WindowOrID)
(SETQ IndexCardID (NC.IDFromWindow Window))))
(SETQ LinkLabels (COND
(SpecialArgsList (CAR SpecialArgsList))
(T (NC.AskLinkLabel Window T T NIL NIL T))))
(COND
((NULL LinkLabels)
(NC.PrintMsg Window T "No link labels to search for.")
(RETURN NIL)))
(SETQ BackLinksP (COND
(SpecialArgsList (CADR SpecialArgsList))
(T (NC.YesP (NC.AskUser "Build back links to cards and boxes? " "--" NIL NIL Window T)))
))
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(SETQ Stream (NC.FetchSubstance IndexCardID))
(NC.AppendStringToStream Stream (CONCAT "Sorted link index compiled on: "
(DATE)
(CHARACTER 13)
" for linktypes: "
(CAR LinkLabels)))
(for Label in (CDR LinkLabels) do (NC.AppendStringToStream Stream
(CONCAT ", " Label)))
(NC.AppendStringToStream Stream (CONCAT (CHARACTER 13)
(CHARACTER 13)))
(SETQ LastID (SUB1 (SUBATOM (NC.GetNewID PSA.Database T)
3))) (* Subtract one more so that this LinkIndex's ID isn't
counted.)
(SETQ LastID (SUB1 LastID))
(NC.PrintMsg Window T "Gathering links ... ")
(* * Find all ID's with instances of a desired link label, record whether they were active, sort them, print their
titles to the stream, and deactivate the ones that weren't active.)
(SETQ SortedWinners (SORT (for ID# from 1 to LastID bind ID ActiveP
when (PROGN (SETQ ID (NC.IDFromNumber ID#))
(SETQ ActiveP (NC.ActiveCardP ID))
(PUTPROP ID (QUOTE WasActiveFlg)
ActiveP)
(OR ActiveP (NC.GetLinks ID PSA.Database)
)
(OR (for Link in (NC.FetchToLinks ID)
thereis (NC.LinkLabelP Link
LinkLabels))
(for Link in (NC.FetchFromLinks
ID)
thereis (NC.ReverseLinkLabelP
Link LinkLabels))))
collect (CONS (NC.FetchTitle ID)
ID))
T))
(for WinnerPair in SortedWinners bind ID
do (SETQ ID (CDR WinnerPair))
(NC.AppendLinkIndexEntry Stream IndexCardID ID (CAR WinnerPair)
LinkLabels BackLinksP))
(for ID# from 1 to LastID bind ID
do (SETQ ID (NC.IDFromNumber ID#))
(OR (GETP ID (QUOTE WasActiveFlg))
(NC.DeactivateCard ID))
(REMPROP ID (QUOTE WasActiveFlg)))
(NC.PrintMsg Window NIL "Done!" (CHARACTER 13)))
(COND
((NOT NoDisplayFlg)
(BLOCK 250)
(NC.ClearMsg Window T)))
(RETURN IndexCardID))))
(NC.AppendLinkIndexEntry
(LAMBDA (Stream IndexCardID ID Title LinkLabels BackLinksP)
(* rht: "21-Nov-84 15:40")
(* * Build a link index entry consisting of all instances of links from or to ID with a label in LinkLabels.
Append these to the end of Stream.)
(PROG (FromLinks ToLinks ToLinkPairs FromLinkPairs (SortArg (FUNCTION NC.LinkIndexCompareFn)))
(SETQ ToLinks (NC.FetchToLinks ID))
(SETQ FromLinks (NC.FetchFromLinks ID))
(* * Find all winning links.)
(SETQ ToLinkPairs (SORT (for Link in ToLinks bind Label when (SETQ Label (NC.LinkLabelP
Link LinkLabels))
collect (CONS Label Link))
SortArg))
(SETQ FromLinkPairs (SORT (for Link in FromLinks bind Label when (SETQ Label
(NC.ReverseLinkLabelP
Link LinkLabels))
collect (CONS Label Link))
SortArg))
(* * Print the title of ID if there were any wins.)
(COND
((OR ToLinkPairs FromLinkPairs)
(NC.AppendStringToStream Stream Title)
(COND
(BackLinksP (NC.AppendStringToStream Stream " ")
(NC.AppendLinkToText IndexCardID ID NC.LinkIndexBackPtrLinkLabel
(QUOTE Icon))))
(NC.AppendStringToStream Stream (CONCAT (CHARACTER 13)))))
(* * Print the winning links from the ID card.)
(for LinkPair in ToLinkPairs bind OldLabel Label DestID
do (SETQ Label (CAR LinkPair))
(SETQ DestID (fetch (NOTECARDLINK DESTINATIONID) of (CDR LinkPair)))
(COND
((NEQ OldLabel Label)
(NC.AppendStringToStream Stream (CONCAT " <" Label "> TO" (CHARACTER 13)))
(SETQ OldLabel Label)))
(NC.AppendStringToStream Stream " ")
(NC.AppendStringToStream Stream (NC.FetchTitle DestID))
(COND
(BackLinksP (NC.AppendStringToStream Stream " ")
(NC.AppendLinkToText IndexCardID DestID NC.LinkIndexBackPtrLinkLabel
(QUOTE Icon))))
(NC.AppendStringToStream Stream (CONCAT (CHARACTER 13))))
(for LinkPair in FromLinkPairs bind OldLabel Label DestID
do (SETQ Label (CAR LinkPair))
(SETQ DestID (fetch (NOTECARDLINK SOURCEID) of (CDR LinkPair)))
(COND
((NEQ OldLabel Label)
(NC.AppendStringToStream Stream (CONCAT " <" Label "> FROM" (CHARACTER 13)))
(SETQ OldLabel Label)))
(NC.AppendStringToStream Stream " ")
(NC.AppendStringToStream Stream (NC.FetchTitle DestID))
(COND
(BackLinksP (NC.AppendStringToStream Stream " ")
(NC.AppendLinkToText IndexCardID DestID NC.LinkIndexBackPtrLinkLabel
(QUOTE Icon))))
(NC.AppendStringToStream Stream (CONCAT (CHARACTER 13)))))))
(NC.LinkIndexCompareFn
(LAMBDA (Pair1 Pair2) (* rht: " 5-Sep-84 15:31")
(* * Used when sorting cons pairs of link labels and links. Sort on label and then title of link.)
(COND
((EQ (CAR Pair1)
(CAR Pair2))
(ALPHORDER (NC.FetchTitle (fetch (NOTECARDLINK DESTINATIONID) of (CDR Pair1)))
(NC.FetchTitle (fetch (NOTECARDLINK DESTINATIONID) of (CDR Pair2)))))
(T (ALPHORDER (CAR Pair1)
(CAR Pair2))))))
)
(DEFINEQ
(NC.AddLinkIndexCard
(LAMBDA NIL (* fgh: "15-Feb-85 13:09")
(NC.AddCardType (QUOTE LinkIndex)
(QUOTE Text)
(QUOTE TEXT)
(BQUOTE ((MakeCardFn , (FUNCTION NC.MakeLinkIndex))))
(BQUOTE ((LinkDisplayMode Title)
(CardDisplayedInMenuFlg , T))))))
)
(NC.AddLinkIndexCard)
(PUTPROPS NCLINKINDEXCARD COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1002 8589 (NC.MakeLinkIndex 1012 . 4939) (NC.AppendLinkIndexEntry 4941 . 8027) (
NC.LinkIndexCompareFn 8029 . 8587)) (8590 8963 (NC.AddLinkIndexCard 8600 . 8961)))))
STOP