(FILECREATED "21-Apr-87 19:07:11" {QV}<NOTECARDS>1.3K>NEXT>NCLINKINDEXCARD.;29 19637
changes to: (FNS NC.MakeLinkIndex)
previous date: " 5-Apr-87 20:01:09" {QV}<NOTECARDS>1.3K>NEXT>NCLINKINDEXCARD.;28)
(* Copyright (c) 1986, 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCLINKINDEXCARDCOMS)
(RPAQQ NCLINKINDEXCARDCOMS ((* * Link Index stuff)
(FILES NCTEXTCARD)
(GLOBALVARS NC.LinkIndexExtraMenuItems NC.LinkIndexSpecsStylesheet)
(VARS [NC.LinkIndexExtraMenuItems
(QUOTE ((Recompute% Link% Index (FUNCTION NC.RecomputeLinkIndex)
"Recompute this link index throwing away current contents.")
(Change% Link% Index% Specs (FUNCTION
NC.ChangeLinkIndexSpecs
"Change some or all of Link Index specs."]
(NC.LinkIndexSpecsStylesheet (CREATE.STYLE (QUOTE ITEMS)
(LIST (create MENU
ITEMS ← T)
(create MENU
ITEMS ← T)
(create MENU
ITEMS ← T)
)
(QUOTE SELECTIONS)
(QUOTE (T T T))
(QUOTE ITEM.TITLES)
(QUOTE (Forward% Links
Backward% Links
Create% Back% Links?))
(QUOTE ITEM.TITLE.FONT)
(FONTCOPY
MENUFONT
(QUOTE WEIGHT)
(QUOTE BOLD))
(QUOTE
NEED.NOT.FILL.IN)
(QUOTE (MULTI MULTI
NIL))
(QUOTE TITLE)
"Link Index Specs?")))
(* * Link Index functions)
(FNS NC.MakeLinkIndex NC.BringUpLinkIndexCard NC.ComputeLinkIndex
NC.RecomputeLinkIndex NC.AskLinkIndexSpecs NC.ChangeLinkIndexSpecs
NC.AppendLinkIndexEntry NC.LinkIndexCompareFn)
(FNS NC.AddLinkIndexCard)
(P (NC.AddLinkIndexCard))
(FNS NCAddStub.LinkIndexCard)))
(* * Link Index stuff)
(FILESLOAD NCTEXTCARD)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.LinkIndexExtraMenuItems NC.LinkIndexSpecsStylesheet)
)
(RPAQQ NC.LinkIndexExtraMenuItems ((Recompute% Link% Index (FUNCTION NC.RecomputeLinkIndex)
"Recompute this link index throwing away current contents.")
(Change% Link% Index% Specs (FUNCTION NC.ChangeLinkIndexSpecs
"Change some or all of Link Index specs."))))
(RPAQ NC.LinkIndexSpecsStylesheet (CREATE.STYLE (QUOTE ITEMS)
(LIST (create MENU ITEMS ← T)
(create MENU ITEMS ← T)
(create MENU ITEMS ← T))
(QUOTE SELECTIONS)
(QUOTE (T T T))
(QUOTE ITEM.TITLES)
(QUOTE (Forward% Links Backward% Links
Create% Back% Links?))
(QUOTE ITEM.TITLE.FONT)
(FONTCOPY MENUFONT (QUOTE WEIGHT)
(QUOTE BOLD))
(QUOTE NEED.NOT.FILL.IN)
(QUOTE (MULTI MULTI NIL))
(QUOTE TITLE)
"Link Index Specs?"))
(* * Link Index functions)
(DEFINEQ
(NC.MakeLinkIndex
[LAMBDA (Card Title NoDisplayFlg SpecialArgsList) (* rht: "17-Apr-87 20:01")
(* * 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>))
(* * rht 9/21/85: Now uses stylesheet for LinkIndexSpecs. Broke out workhorse code into the function
NC.ComputeLinkIndex)
(* * fgh 11/17/85 Updated to handle Card objects.)
(* * rht 4/11/86: Took out call to NCP.AddTitleBarMenuItems. Now done in NC.AddLinkIndexCard.
Also changed to call NC.ApplySuper.)
(* * rht 9/5/86: Now bails out properly if user aborts in stylesheet.)
(* * rht 9/19/86: Now passes IndexCard rather than Window to NC.AskLinkIndexSpecs. Added call to NC.HoldTTYProcess
to keep linkindexspecs on top.)
(* * rg 3/16/87 NC.DeleteNoteCards -> NC.DeleteNoteCard)
(PROG ((LinkLabels (CAR SpecialArgsList))
(BackLinksFlg (CADR SpecialArgsList))
Window LinkIndexSpecs)
(SPAWN.MOUSE)
(SETQ Window (WINDOWP (NC.ApplySupersFn MakeFn Card (CONCAT "Link Index: "
(DATE))
NoDisplayFlg)))
(if (NOT NoDisplayFlg)
then (NC.HoldTTYProcess)
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Card LinkLabels BackLinksFlg T))
(if (NULL LinkIndexSpecs)
then (NC.DeleteNoteCard Card NIL T)
(RETURN NIL))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs)))
(NC.ComputeLinkIndex Card LinkLabels BackLinksFlg)
(RETURN (if NoDisplayFlg
then Card
else (NC.ClearMsg Window T)
Window])
(NC.BringUpLinkIndexCard
(LAMBDA (Card Substance Region/Position) (* rht: "11-Apr-86 21:58")
(* * Given a link index substance, open a link index window set up properly.)
(* * rht 4/11/86: Removed stuff that adds items to title bar left menu. Now done at card type defn time.)
(NC.BringUpTEditCard Card Substance Region/Position)))
(NC.ComputeLinkIndex
(LAMBDA (IndexCard LinkLabels BackLinksFlg) (* kirk: " 9-Sep-86 15:13")
(* * This is the workhorse. Walks through all links, gathering those with label in LinkLabels and creating back
links if BackLinksP is non-nil.)
(* * kirk 9/9/86 Deleted obsolete param from NC.RetrieveToLinks)
(LET ((Window (NC.FetchWindow IndexCard))
(NoteFile (fetch (Card NoteFile) of IndexCard))
TextStream SortedWinners LastCard)
(RESETLST (RESETSAVE (CURSOR WAITINGCURSOR))
(SETQ TextStream (NC.FetchSubstance IndexCard))
(NC.AppendStringToStream TextStream (CONCAT
"Sorted link index compiled on: "
(DATE)
(CHARACTER 13)
" for linktypes: "
(CAR LinkLabels)))
(COND
(LinkLabels (for Label in (CDR LinkLabels)
do (NC.AppendStringToStream TextStream (CONCAT ", " Label)
))
(NC.AppendStringToStream TextStream (CONCAT (CHARACTER
13)
(CHARACTER
13)))
(NC.PrintMsg Window T "Gathering links ... ")
(* * Find all cards 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 (NC.MapCards
NoteFile
(FUNCTION (LAMBDA (Card PredicateResult)
(LIST (NC.RetrieveTitle Card)
Card PredicateResult)))
(FUNCTION (LAMBDA (Card)
(LET (ToLinks FromLinks)
(if (OR (for Link
in (SETQ ToLinks
(NC.RetrieveToLinks
Card))
thereis (NC.LinkLabelP
Link LinkLabels))
(for Link
in (SETQ FromLinks
(NC.RetrieveFromLinks
Card))
thereis (
NC.ReverseLinkLabelP
Link LinkLabels)))
then (LIST ToLinks FromLinks))))))
T))
(for WinnerList in SortedWinners
do (NC.AppendLinkIndexEntry TextStream IndexCard WinnerList
LinkLabels BackLinksFlg))
(NC.PrintMsg Window NIL "Done!" (CHARACTER 13))))
(NC.PutProp IndexCard (QUOTE LinkIndexLinkLabels)
(LIST LinkLabels))
(NC.PutProp IndexCard (QUOTE LinkIndexBackLinksFlg)
BackLinksFlg)
(NC.SetPropListDirtyFlg IndexCard T)))))
(NC.RecomputeLinkIndex
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel " 4-Mar-87 14:31")
(* * Recompute the contents of the link index card. Modeled after NC.UpdateBrowserCard.)
(* * fgh 11/17/85 Updated to handle Card object.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard WindowOrTextStream))
Window LinkLabels BackLinksFlg PropList BrowserSpecs TextStream)
(NC.ProtectedCardOperation Card "Recompute LinkIndex" NIL (SETQ Window (NC.FetchWindow
Card))
(SETQ TextStream (TEXTSTREAM WindowOrTextStream))
(SETQ PropList (NC.FetchPropList Card))
[SETQ LinkLabels (CAR (LISTGET PropList (QUOTE
LinkIndexLinkLabels]
(SETQ BackLinksFlg (LISTGET PropList (QUOTE
LinkIndexBackLinksFlg)))
(NC.PrintMsg Window T "Clearing old contents of link index ..."
(CHARACTER 13))
[TEDIT.DELETE TextStream (TEDIT.SETSEL TextStream 1
(fetch (TEXTOBJ
TEXTLEN)
of (TEXTOBJ
TextStream]
(NC.PrintMsg Window NIL "Done." (CHARACTER 13))
(NC.ComputeLinkIndex Card LinkLabels BackLinksFlg)
(NC.ClearMsg Window T])
(NC.AskLinkIndexSpecs
[LAMBDA (Card OldLinkLabels OldBackLinksFlg CreatingLinkIndexFlg)
(* pmi: " 2-Apr-87 11:23")
(* * Puts up the stylesheet asking user about link types, and whether to create back links.
This is modeled on NC.AskBrowserSpecs.)
(* * fgh 11/17/85 Updated to use NoteFile rather than PSA.Database)
(* * rht 9/19/86: Now takes Card arg rather than MainWindow.)
(* * pmi 4/2/87: Added NC.MenuFont to all menus.)
(DECLARE (GLOBALVARS NC.MenuFont))
(LET ((MainWindow (NC.FetchWindow Card))
(NoteFile (fetch (Card NoteFile) of Card))
LinkLabels Position Choices ReverseFlg)
(SETQ LinkLabels (NC.RetrieveLinkLabels NoteFile T))
[SETQ Position (AND (WINDOWP MainWindow)
(create POSITION
XCOORD ← (fetch (REGION LEFT)
of (WINDOWPROP MainWindow (QUOTE REGION))
)
YCOORD ← (fetch (REGION TOP) of (WINDOWREGION
MainWindow]
(* The stylesheet is in a global var.
We only need to provide its position, items, and
selections.)
(STYLE.PROP NC.LinkIndexSpecsStylesheet (QUOTE POSITION)
Position)
(STYLE.PROP NC.LinkIndexSpecsStylesheet (QUOTE ITEMS)
(LIST (create MENU
ITEMS ← LinkLabels
MENUFONT ← NC.MenuFont)
(create MENU
ITEMS ← (for Link in LinkLabels
collect (PACK* (QUOTE ←)
Link))
MENUFONT ← NC.MenuFont)
(create MENU
ITEMS ← (QUOTE (Yes No))
MENUFONT ← NC.MenuFont)))
[STYLE.PROP NC.LinkIndexSpecsStylesheet (QUOTE SELECTIONS)
(LIST (for Label in OldLinkLabels when (NEQ (NTHCHAR Label 1)
(QUOTE ←))
collect Label)
(for Label in OldLinkLabels when (EQ (NTHCHAR Label 1)
(QUOTE ←))
collect Label)
(COND
(OldBackLinksFlg (QUOTE Yes))
(T (QUOTE No]
(SETQ Choices (STYLESHEET NC.LinkIndexSpecsStylesheet))
(COND
[Choices (LIST (APPEND (CAR Choices)
(CADR Choices))
(COND
((EQ (CADDR Choices)
(QUOTE Yes))
T)
(T NIL]
(CreatingLinkIndexFlg NIL)
(T (LIST OldLinkLabels OldBackLinksFlg])
(NC.ChangeLinkIndexSpecs
[LAMBDA (WindowOrTextStream) (* Randy.Gobbel " 4-Mar-87 14:32")
(* * Change the values of the various link index specs including link types and back links flag.)
(* * rht 9/19/86: Changed to pass Card rather than Window to NC.AskLinkIndexSpecs.)
(* * rht 11/1/86: Added NC.ProtectedCardOperation wrapper and check for ops in progress.)
(* * rg 3/4/87 rewritten for new version of NC.ProtectedCardOperation, removed DontCheckOpInProgressFlg)
(LET ((Card (NC.CoerceToCard WindowOrTextStream))
LinkLabels BackLinksFlg PropList LinkIndexSpecs)
(NC.ProtectedCardOperation Card "LinkIndex Specs" NIL (SETQ PropList (NC.FetchPropList
Card))
[SETQ LinkLabels (CAR (LISTGET PropList (QUOTE
LinkIndexLinkLabels]
(SETQ BackLinksFlg (LISTGET PropList (QUOTE
LinkIndexBackLinksFlg)))
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Card LinkLabels
BackLinksFlg))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs))
(NC.SetPropListDirtyFlg Card T)
(NC.PutProp Card (QUOTE LinkIndexLinkLabels)
(LIST LinkLabels))
(NC.PutProp Card (QUOTE LinkIndexBackLinksFlg)
BackLinksFlg)
(NC.ClearMsg (NC.FetchWindow Card)
T])
(NC.AppendLinkIndexEntry
(LAMBDA (TextStream IndexCard WinnerList LinkLabels BackLinksP)
(* kirk: "22-Sep-86 17:21")
(* * 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.)
(* * fgh 11/17/85 Updated to handle Card objects. Also changed how information is passed down from calling
functions. All info about relevant cards is now passed in the WinnerList arg.)
(* * rht 12/9/85: Changed calls to NC.AppendLinkToText to be NCP.LocalGlobalLink.)
(* * kirk 12/9/85: Changed calls to NC.AppendLinkToText to be NCP.LocalGlobalLink. for backlinks)
(LET ((Title (CAR WinnerList))
(Card (CADR WinnerList))
(ToLinks (CAR (CADDR WinnerList)))
(FromLinks (CADR (CADDR WinnerList)))
(SortArg (FUNCTION NC.LinkIndexCompareFn))
FromLinkPairs ToLinkPairs)
(* * 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 TextStream Title)
(COND
(BackLinksP (NC.AppendStringToStream TextStream " ")
(NCP.LocalGlobalLink NC.LinkIndexBackPtrLinkLabel IndexCard Card NIL
(QUOTE Icon))))
(NC.AppendStringToStream TextStream (CONCAT (CHARACTER 13)))))
(* * Print the winning links from the ID card.)
(for LinkPair in ToLinkPairs bind OldLabel Label DestCard
do (SETQ Label (CAR LinkPair))
(SETQ DestCard (fetch (Link DestinationCard) of (CDR LinkPair)))
(COND
((NEQ OldLabel Label)
(NC.AppendStringToStream TextStream (CONCAT " <" Label "> TO" (CHARACTER
13)))
(SETQ OldLabel Label)))
(NC.AppendStringToStream TextStream " ")
(NC.AppendStringToStream TextStream (NC.RetrieveTitle DestCard))
(COND
(BackLinksP (NC.AppendStringToStream TextStream " ")
(NCP.LocalGlobalLink NC.LinkIndexBackPtrLinkLabel IndexCard DestCard
NIL (create LINKDISPLAYMODE
ATTACHBITMAPFLG ← T))))
(NC.AppendStringToStream TextStream (CONCAT (CHARACTER 13))))
(for LinkPair in FromLinkPairs bind OldLabel Label DestCard
do (SETQ Label (CAR LinkPair))
(SETQ DestCard (fetch (Link SourceCard) of (CDR LinkPair)))
(COND
((NEQ OldLabel Label)
(NC.AppendStringToStream TextStream (CONCAT " <" Label "> FROM"
(CHARACTER 13)))
(SETQ OldLabel Label)))
(NC.AppendStringToStream TextStream " ")
(NC.AppendStringToStream TextStream (NC.RetrieveTitle DestCard))
(COND
(BackLinksP (NC.AppendStringToStream TextStream " ")
(NCP.LocalGlobalLink NC.LinkIndexBackPtrLinkLabel IndexCard DestCard
(create LINKDISPLAYMODE
ATTACHBITMAPFLG ← T))))
(NC.AppendStringToStream TextStream (CONCAT (CHARACTER 13)))))))
(NC.LinkIndexCompareFn
(LAMBDA (Pair1 Pair2) (* fgh: "17-Nov-85 16:20")
(* * 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.RetrieveTitle (fetch (Link DestinationCard) of (CDR Pair1)))
(NC.RetrieveTitle (fetch (Link DestinationCard) of (CDR Pair2)))))
(T (ALPHORDER (CAR Pair1)
(CAR Pair2))))))
)
(DEFINEQ
(NC.AddLinkIndexCard
(LAMBDA NIL (* rht: "11-Apr-86 21:58")
(* * fgh 11/14/85 Updated toremove substance type param to add card type.)
(NC.AddCardType (QUOTE LinkIndex)
(QUOTE Text)
(BQUOTE ((MakeFn , (FUNCTION NC.MakeLinkIndex))
(EditFn , (FUNCTION NC.BringUpLinkIndexCard))))
(BQUOTE ((LinkDisplayMode Title)
(DefaultHeight 350)
(DefaultWidth 350)
(DisplayedInMenuFlg , T)
(LeftButtonMenuItems , (APPEND (NC.GetCardTypeField
LeftButtonMenuItems
(QUOTE
Text))
NC.LinkIndexExtraMenuItems)))))))
)
(NC.AddLinkIndexCard)
(DEFINEQ
(NCAddStub.LinkIndexCard
(LAMBDA NIL (* rht: " 8-Nov-86 19:20")
(* * kirk 18Jun86 Add the LinkIndex card stub)
(* * rht 11/7/86: Now passes down a \\FILLME// field.)
(NC.AddCardTypeStub (QUOTE LinkIndex)
(QUOTE Text)
(QUOTE NCLINKINDEXCARD)
NIL
(QUOTE ((DisplayedInMenuFlg T)))
(QUOTE (LinkIconAttachedBitMap)))))
)
(PUTPROPS NCLINKINDEXCARD COPYRIGHT ("Xerox Corporation" 1986 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3024 18329 (NC.MakeLinkIndex 3034 . 5103) (NC.BringUpLinkIndexCard 5105 . 5506) (
NC.ComputeLinkIndex 5508 . 8244) (NC.RecomputeLinkIndex 8246 . 9803) (NC.AskLinkIndexSpecs 9805 .
12471) (NC.ChangeLinkIndexSpecs 12473 . 13985) (NC.AppendLinkIndexEntry 13987 . 17767) (
NC.LinkIndexCompareFn 17769 . 18327)) (18330 19054 (NC.AddLinkIndexCard 18340 . 19052)) (19077 19546 (
NCAddStub.LinkIndexCard 19087 . 19544)))))
STOP