(FILECREATED "26-Oct-85 23:03:12" {QV}<NOTECARDS>RELEASE1.2I>NCLINKINDEXCARD.;10 16807
changes to: (FNS NC.AskLinkIndexSpecs NC.MakeLinkIndex)
(VARS NCLINKINDEXCARDCOMS)
previous date: "22-Sep-85 17:11:20" {QV}<NOTECARDS>RELEASE1.2I>NCLINKINDEXCARD.;9)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT NCLINKINDEXCARDCOMS)
(RPAQQ NCLINKINDEXCARDCOMS ((E (SETQ NC.SystemDate (DATE))
(PUTPROP (QUOTE NC.SystemDate)
(QUOTE NewestFile)
(ROOTFILENAME (FULLNAME (OUTPUT)))))
(* * Link Index stuff)
(FILES NCTEXTSUBSTANCE NCTEXTCARD)
(GLOBALVARS NC.LinkIndexExtraMenuItems NC.LinkIndexSpecsStylesheet
PSA.Database)
(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))))
(* * Link Index stuff)
(FILESLOAD NCTEXTSUBSTANCE NCTEXTCARD)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.LinkIndexExtraMenuItems NC.LinkIndexSpecsStylesheet PSA.Database)
)
(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 (ID Title NoDisplayFlg SpecialArgsList) (* rht: "26-Oct-85 22:59")
(* * 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)
(PROG (IndexCardID Window WindowOrID (LinkLabels (CAR SpecialArgsList))
(BackLinksFlg (CADR SpecialArgsList))
LinkIndexSpecs)
(SPAWN.MOUSE)
(SETQ WindowOrID (NC.MakeNoteCard (QUOTE Text)
(CONCAT "Link Index: " (DATE))
NoDisplayFlg NIL ID))
(COND
(NoDisplayFlg (SETQ Window NIL)
(SETQ IndexCardID WindowOrID))
(T (SETQ Window WindowOrID)
(SETQ IndexCardID (NC.IDFromWindow Window))))
(if (NOT NoDisplayFlg)
then (NCP.AddTitleBarMenuItems Window NC.LinkIndexExtraMenuItems)
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Window LinkLabels BackLinksFlg T))
(COND
((NULL LinkIndexSpecs)
(NC.DeleteNoteCards IndexCardID T)
(RETURN NIL)))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs)))
(NC.ComputeLinkIndex IndexCardID LinkLabels BackLinksFlg)
(if NoDisplayFlg
then (RETURN IndexCardID)
else (NC.ClearMsg Window T)
(RETURN Window)))))
(NC.BringUpLinkIndexCard
(LAMBDA (ID Substance Region/Position) (* rht: "21-Sep-85 16:19")
(* * Given a link index substance, open a link index window set up properly.)
(LET ((Window (NC.BringUpTEditCard ID Substance Region/Position)))
(NCP.AddTitleBarMenuItems Window NC.LinkIndexExtraMenuItems)
Window)))
(NC.ComputeLinkIndex
(LAMBDA (IndexCardID LinkLabels BackLinksFlg) (* rht: "22-Sep-85 16:38")
(* * This is the workhorse. Walks through all links, gathering those with label in LinkLabels and creating back
links if BackLinksP is non-nil.)
(LET ((Window (NC.FetchWindow IndexCardID))
Stream SortedWinners LastID)
(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)))
(if LinkLabels
then (for Label in (CDR LinkLabels) do (NC.AppendStringToStream Stream
(CONCAT ", "
Label)))
(NC.AppendStringToStream Stream (CONCAT (CHARACTER 13)
(CHARACTER 13)))
(SETQ LastID (NCP.MaxIDNum)) (* 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 eachtime (BLOCK)
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 BackLinksFlg))
(for ID# from 1 to LastID bind ID eachtime (BLOCK)
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)))
(NC.PutProp IndexCardID (QUOTE LinkIndexLinkLabels)
(LIST LinkLabels))
(NC.PutProp IndexCardID (QUOTE LinkIndexBackLinksFlg)
BackLinksFlg)
(NC.SetPropListDirtyFlg IndexCardID T)))))
(NC.RecomputeLinkIndex
(LAMBDA (WindowOrTextStream) (* rht: "21-Sep-85 16:41")
(* * Recompute the contents of the link index card. Modeled after NC.UpdateBrowserCard.)
(PROG ((ID (NC.CoerceToID WindowOrTextStream))
LinkLabels BackLinksFlg PropList BrowserSpecs Window TextStream)
(SETQ Window (NC.FetchWindow ID))
(SETQ TextStream (TEXTSTREAM WindowOrTextStream))
(SETQ PropList (NC.FetchPropList ID))
(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 ID LinkLabels BackLinksFlg)
(NC.ClearMsg Window T))))
(NC.AskLinkIndexSpecs
(LAMBDA (MainWindow OldLinkLabels OldBackLinksFlg CreatingLinkIndexFlg)
(* rht: "26-Oct-85 22:39")
(* * Puts up the stylesheet asking user about link types, and whether to create back links. This is modeled on
NC.AskBrowserSpecs.)
(LET ((LinkLabels (NC.RetrieveLinkLabels PSA.Database T))
Position Choices ReverseFlg)
(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)
(create MENU
ITEMS ←(for Link in LinkLabels collect (PACK* (QUOTE ←)
Link)))
(create MENU
ITEMS ←(QUOTE (Yes No)))))
(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)
(if OldBackLinksFlg
then (QUOTE Yes)
else (QUOTE No))))
(SETQ Choices (STYLESHEET NC.LinkIndexSpecsStylesheet))
(COND
(Choices (LIST (APPEND (CAR Choices)
(CADR Choices))
(if (EQ (CADDR Choices)
(QUOTE Yes))
then T
else NIL)))
(CreatingLinkIndexFlg NIL)
(T (LIST OldLinkLabels OldBackLinksFlg))))))
(NC.ChangeLinkIndexSpecs
(LAMBDA (WindowOrTextStream) (* rht: "22-Sep-85 16:49")
(* * Change the values of the various link index specs including link types and back links flag.)
(LET ((ID (NC.CoerceToID WindowOrTextStream))
LinkLabels BackLinksFlg PropList LinkIndexSpecs Window)
(SETQ Window (NC.FetchWindow ID))
(SETQ PropList (NC.FetchPropList ID))
(SETQ LinkLabels (CAR (LISTGET PropList (QUOTE LinkIndexLinkLabels))))
(SETQ BackLinksFlg (LISTGET PropList (QUOTE LinkIndexBackLinksFlg)))
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Window LinkLabels BackLinksFlg))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs))
(NC.SetPropListDirtyFlg ID T)
(NC.PutProp ID (QUOTE LinkIndexLinkLabels)
(LIST LinkLabels))
(NC.PutProp ID (QUOTE LinkIndexBackLinksFlg)
BackLinksFlg)
(NC.ClearMsg Window T))))
(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 (* rht: "21-Sep-85 16:14")
(NC.AddCardType (QUOTE LinkIndex)
(QUOTE Text)
(QUOTE TEXT)
(BQUOTE ((MakeCardFn , (FUNCTION NC.MakeLinkIndex))
(EditCardFn , (FUNCTION NC.BringUpLinkIndexCard))))
(BQUOTE ((LinkDisplayMode Title)
(DefaultHeight 350)
(DefaultWidth 350)
(CardDisplayedInMenuFlg , T))))))
)
(NC.AddLinkIndexCard)
(PUTPROPS NCLINKINDEXCARD COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3154 16208 (NC.MakeLinkIndex 3164 . 5002) (NC.BringUpLinkIndexCard 5004 . 5381) (
NC.ComputeLinkIndex 5383 . 8257) (NC.RecomputeLinkIndex 8259 . 9389) (NC.AskLinkIndexSpecs 9391 .
11488) (NC.ChangeLinkIndexSpecs 11490 . 12558) (NC.AppendLinkIndexEntry 12560 . 15646) (
NC.LinkIndexCompareFn 15648 . 16206)) (16209 16699 (NC.AddLinkIndexCard 16219 . 16697)))))
STOP