(DEFINE-FILE-INFO PACKAGE "IL" READTABLE "INTERLISP" BASE 10)
(FILECREATED "13-Oct-88 19:41:11" {QV}<NOTECARDS>1.3MNEXT>NCLINKINDEXCARD.;1 23563
previous date%: "13-Aug-88 15:24:19" {QV}<NOTECARDS>1.3LNEXT>NCLINKINDEXCARD.;4)
(* "
Copyright (c) 1986, 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT NCLINKINDEXCARDCOMS)
(RPAQQ NCLINKINDEXCARDCOMS
(
(* ;;; "Link Index stuff")
(DECLARE%: DONTEVAL@LOAD (FILES NCTEXTCARD))
(FNS NCAddStub.LinkIndexCard)
(GLOBALVARS NC.LinkIndexExtraMenuItems NC.LinkIndexSpecsStylesheet)
(INITVARS [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."
]
(NC.LinkIndexSpecsStylesheet (CREATE.STYLE 'ITEMS (LIST (create MENU ITEMS ← T)
(create MENU ITEMS ← T)
(create MENU ITEMS ← T))
'SELECTIONS
'(T T T)
'ITEM.TITLES
'(Forward% Links Backward% Links
|Create Back Links?|)
'ITEM.TITLE.FONT
(FONTCOPY MENUFONT 'WEIGHT 'BOLD)
'NEED.NOT.FILL.IN
'(MULTI MULTI NIL)
'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)
(DECLARE%: DONTEVAL@LOAD (P (NC.AddLinkIndexCard)))
(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
NCLINKINDEXCARD)))
(* ;;; "Link Index stuff")
(DECLARE%: DONTEVAL@LOAD
(FILESLOAD NCTEXTCARD)
)
(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 'LinkIndex 'Text 'NCLINKINDEXCARD NIL '((DisplayedInMenuFlg T)) '(
LinkIconAttachedBitMap
))))
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NC.LinkIndexExtraMenuItems NC.LinkIndexSpecsStylesheet)
)
(RPAQ? 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 'ITEMS (LIST (create MENU ITEMS ← T)
(create MENU ITEMS ← T)
(create MENU ITEMS ← T))
'SELECTIONS
'(T T T)
'ITEM.TITLES
'(Forward% Links Backward% Links |Create Back Links?|)
'ITEM.TITLE.FONT
(FONTCOPY MENUFONT 'WEIGHT 'BOLD)
'NEED.NOT.FILL.IN
'(MULTI MULTI NIL)
'TITLE "Link Index Specs?"))
(* ;;; "Link Index functions")
(DEFINEQ
(NC.MakeLinkIndex
[LAMBDA (Card Title NoDisplayFlg SpecialArgsList InterestedWindow RegionOrPosition)
(* ; "Edited 5-Aug-88 13:53 by Trigg")
(* ;;; "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")
(* ;; "rht 8/5/88: Added RegionOrPosition arg and passed to NC.MakeNewCardWindow. Also added InterestedWindow arg.")
(PROG ((LinkLabels (CAR SpecialArgsList))
(BackLinksFlg (CADR SpecialArgsList))
Window LinkIndexSpecs)
(SPAWN.MOUSE)
(SETQ Window (WINDOWP (NC.ApplySupersFn MakeFn Card (CONCAT "Link Index: " (DATE))
NoDisplayFlg NIL InterestedWindow RegionOrPosition)))
(if (NOT NoDisplayFlg)
then (NC.HoldTTYProcess)
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Card LinkLabels BackLinksFlg T))
(if (NULL LinkIndexSpecs)
then (NC.DeleteNoteCard Card NIL T NIL (OR Window InterestedWindow))
(RETURN NIL))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs)))
(NC.ComputeLinkIndex Card LinkLabels BackLinksFlg)
(RETURN (if NoDisplayFlg
then Card
else (NC.ClearMsg (OR Window InterestedWindow)
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 'LinkIndexLinkLabels (LIST LinkLabels))
(NC.PutProp IndexCard '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 'LinkIndexLinkLabels)))
(SETQ BackLinksFlg (LISTGET PropList '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
'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 'POSITION Position)
(STYLE.PROP NC.LinkIndexSpecsStylesheet 'ITEMS
(LIST (create MENU
ITEMS ← LinkLabels
MENUFONT ← NC.MenuFont)
(create MENU
ITEMS ← (for Link in LinkLabels collect (PACK* '← Link))
MENUFONT ← NC.MenuFont)
(create MENU
ITEMS ← '(Yes No)
MENUFONT ← NC.MenuFont)))
(STYLE.PROP NC.LinkIndexSpecsStylesheet 'SELECTIONS
(LIST (for Label in OldLinkLabels when (NEQ (NTHCHAR Label 1)
'←) collect Label)
(for Label in OldLinkLabels when (EQ (NTHCHAR Label 1)
'←) collect Label)
(COND
(OldBackLinksFlg 'Yes)
(T 'No))))
(SETQ Choices (STYLESHEET NC.LinkIndexSpecsStylesheet))
(COND
(Choices (LIST (APPEND (CAR Choices)
(CADR Choices))
(COND
((EQ (CADDR Choices)
'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 'LinkIndexLinkLabels)))
(SETQ BackLinksFlg (LISTGET PropList 'LinkIndexBackLinksFlg))
(SETQ LinkIndexSpecs (NC.AskLinkIndexSpecs Card LinkLabels BackLinksFlg))
(SETQ LinkLabels (CAR LinkIndexSpecs))
(SETQ BackLinksFlg (CADR LinkIndexSpecs))
(NC.SetPropListDirtyFlg Card T)
(NC.PutProp Card 'LinkIndexLinkLabels (LIST LinkLabels))
(NC.PutProp Card '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
'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 (* ; "Edited 3-Dec-87 19:02 by rht:")
(* * fgh |11/14/85| Updated toremove substance type param to add card type.)
(NC.AddCardType 'LinkIndex 'Text `((MakeFn ,(FUNCTION NC.MakeLinkIndex))
(EditFn ,(FUNCTION NC.BringUpLinkIndexCard)))
`((LinkDisplayMode Title)
(DefaultHeight 350)
(DefaultWidth 350)
(DisplayedInMenuFlg ,T)
(LeftButtonMenuItems ,(APPEND (NC.GetCardTypeField LeftButtonMenuItems 'Text)
NC.LinkIndexExtraMenuItems))))))
)
(DECLARE%: DONTEVAL@LOAD
(NC.AddLinkIndexCard)
)
(PUTPROPS NCLINKINDEXCARD FILETYPE :TCOMPL)
(PUTPROPS NCLINKINDEXCARD MAKEFILE-ENVIRONMENT (:PACKAGE "IL" :READTABLE "INTERLISP" :BASE 10
))
(PUTPROPS NCLINKINDEXCARD COPYRIGHT ("Xerox Corporation" 1986 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2991 3554 (NCAddStub.LinkIndexCard 3001 . 3552)) (4901 22487 (NC.MakeLinkIndex 4911 .
7372) (NC.BringUpLinkIndexCard 7374 . 7788) (NC.ComputeLinkIndex 7790 . 11425) (NC.RecomputeLinkIndex
11427 . 13071) (NC.AskLinkIndexSpecs 13073 . 16041) (NC.ChangeLinkIndexSpecs 16043 . 17609) (
NC.AppendLinkIndexEntry 17611 . 21929) (NC.LinkIndexCompareFn 21931 . 22485)) (22488 23190 (
NC.AddLinkIndexCard 22498 . 23188)))))
STOP