(FILECREATED "18-Feb-87 15:44:37" {SUMEX-AIM}PS:<TMAX.SOURCES>INDEX.;4 23471
changes to: (FNS INSERT.KNOWN.INDEX)
previous date: "17-Feb-87 14:27:45" {SUMEX-AIM}PS:<GILMURRAY.LISP>INDEX.;5)
(* Copyright (c) 1987 by Leland Stanford Junior University. All rights reserved.)
(PRETTYCOMPRINT INDEXCOMS)
(RPAQQ INDEXCOMS ((* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(FNS INDEXOBJ INDEXOBJP INDEX.DISPLAYFN INDEX.IMAGEBOXFN INDEX.PUTFN INDEX.GETFN
INDEX.BUTTONEVENTINFN CHANGE.INDEX CHANGE.INDEXENTRY INDEX.WHENDELETEDFN)
(FNS ADD.NEW.INDEX INDEX.STRING INSERT.INDEX INSERT.INDEXENTRY
GET.INDEXENTRY.NUMBER INSERT.KNOWN.INDEX INDEX.LIST.REFS
LIST.OF.INDEXENTRIES CREATE.INDEX.FILE VIEW.INDEX.FILE GET.INDEX.FILE
WRITE.INDEX.FILE WRITE.INDEX.PAGENUMBERS)
(RECORDS INDEX.ENTRY.RECORD)))
(* Developed under support from NIH grant RR-00785.)
(* Written by Frank Gilmurray and Sami Shaio.)
(DEFINEQ
(INDEXOBJ
(LAMBDA (KEY INDEXENTRY.PARMS) (* fsg "15-Jan-87 09:53")
(* * Create an instance of an Index or IndexEntry imageobject. The difference between the two is the OBJECTDATUM.
For a simple Index, OBJECTDATUM is NIL. For an IndexEntry, OBJECTDATUM is a record containing the Entry, Entry's
font, and Number option. In either case, the INDEX.KEY property is the hash key and is also the text to index for a
simple Index.)
(LET ((NEWOBJ (IMAGEOBJCREATE INDEXENTRY.PARMS (IMAGEFNSCREATE (FUNCTION INDEX.DISPLAYFN)
(FUNCTION INDEX.IMAGEBOXFN)
(FUNCTION INDEX.PUTFN)
(FUNCTION INDEX.GETFN)
(FUNCTION NILL)
(FUNCTION
INDEX.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION
INDEX.WHENDELETEDFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)))))
(IMAGEOBJPROP NEWOBJ 'INDEX.KEY
KEY)
(IMAGEOBJPROP NEWOBJ 'TYPE
'INDEXOBJ)
NEWOBJ)))
(INDEXOBJP
(LAMBDA (OBJ) (* fsg "15-Jan-87 09:55")
(* * Tests an imageobject to see if it an Index or IndexEntry imageobject. By convention, testing functions for an
imageobject are named <CONCAT type-of-imageobj "P" >.)
(AND OBJ (EQ (IMAGEOBJPROP OBJ 'TYPE)
'INDEXOBJ))))
(INDEX.DISPLAYFN
(LAMBDA (OBJ STREAM) (* fsg "17-Feb-87 10:18")
(* * Display an Index or IndexEntry imageobject. If the output is to the display imagestream, then just type Index
or IndexEntry followed by their args. Otherwise the output is to a hardcopy imagestream. In this case type nothing
and replace the CAR of the hash array entry with a list of page numbers in which this index entry appears.
<CAR FORMATTINGSTATE> is the current TEdit page number iff doing a hardcopy.)
(LET ((WINDOW (CAR (fetch \WINDOW of TEXTOBJ)))
PGS/IMOBJS CURRENT.PAGE)
(SELECTQ (IMAGESTREAMTYPE STREAM)
(DISPLAY (PROGN (DSPFONT GP.DefaultFont STREAM)
(PRIN3 (INDEX.STRING OBJ)
STREAM)))
(PROGN (SETQ PGS/IMOBJS (GETHASH (MKATOM (IMAGEOBJPROP OBJ
'INDEX.KEY))
(WINDOWPROP WINDOW
'TSP.INDEX.ARRAY)))
(SETQ CURRENT.PAGE (CAR FORMATTINGSTATE))
(COND
(PGS/IMOBJS (COND
((LISTP (CAR PGS/IMOBJS))
(OR (MEMBER CURRENT.PAGE (CAR PGS/IMOBJS))
(RPLACA PGS/IMOBJS
(SORT (APPEND (CAR PGS/IMOBJS)
(LIST CURRENT.PAGE)
)
'ILESSP))))
(T (RPLACA PGS/IMOBJS (LIST CURRENT.PAGE)))))
(T (SHOULDNT "No array entry for this INDEX"))))))))
(INDEX.IMAGEBOXFN
(LAMBDA (OBJ STREAM CURRENTX RIGHTMARGIN) (* fsg "15-Feb-87 14:37")
(* * Return the ImageBox for an Index or IndexEntry request.)
(SELECTQ (IMAGESTREAMTYPE STREAM)
(DISPLAY (create IMAGEBOX
XSIZE ←(STRINGWIDTH (INDEX.STRING OBJ)
GP.DefaultFont)
YSIZE ←(FONTPROP GP.DefaultFont 'HEIGHT)
YDESC ←(FONTPROP GP.DefaultFont 'DESCENT)
XKERN ← 0))
(create IMAGEBOX
XSIZE ← 0
YSIZE ← 0
YDESC ← 0
XKERN ← 0))))
(INDEX.PUTFN
(LAMBDA (OBJ STREAM) (* fsg "11-Feb-87 11:07")
(* * Puts the Index or IndexEntry imageobject in a file.)
(LET ((DATUM (fetch OBJECTDATUM of OBJ)))
(PRIN2 (COND
(DATUM (LIST 'IndexEntry
(IMAGEOBJPROP OBJ 'INDEX.KEY)
DATUM))
(T (LIST 'Index
(IMAGEOBJPROP OBJ 'INDEX.KEY))))
STREAM))))
(INDEX.GETFN
(LAMBDA (STREAM) (* fsg "11-Feb-87 10:42")
(* * Create the Index or IndexEntry imageobject when it is read from file.)
(LET* ((INDEX.ARGS (CDR (READ STREAM)))
(NEWOBJ (APPLY 'INDEXOBJ
INDEX.ARGS))
(WINDOW (PROCESSPROP (THIS.PROCESS)
'WINDOW)))
(OR (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)
(TSP.FMMENU (TEXTSTREAM WINDOW)))
(ADD.NEW.INDEX WINDOW (CAR INDEX.ARGS)
NEWOBJ)
NEWOBJ)))
(INDEX.BUTTONEVENTINFN
(LAMBDA (OBJ STREAM SEL RELX RELY WINDOW HOSTSTREAM BUTTON)
(* fsg "15-Jan-87 11:26")
(* * Process the MIDDLE button pressed inside an Index or IndexEntry imageobject. This means the user wants to
Change this index.)
(AND (MOUSESTATE MIDDLE)
(MENU (create MENU
ITEMS ← '((Change 'CHANGE
"Change this Index or IndexEntry"))
CENTERFLG ← T))
(LET* ((OBJDATUM (fetch OBJECTDATUM of OBJ))
(NEW.INDEX (COND
(OBJDATUM (CHANGE.INDEXENTRY OBJ STREAM OBJDATUM))
(T (CHANGE.INDEX OBJ STREAM)))))
(AND (CAR NEW.INDEX)
(PROGN (INDEX.WHENDELETEDFN OBJ STREAM)
(IMAGEOBJPROP OBJ 'INDEX.KEY
(CAR NEW.INDEX))
(AND OBJDATUM (replace OBJECTDATUM of OBJ
with (CADR NEW.INDEX)))
(ADD.NEW.INDEX WINDOW (CAR NEW.INDEX)
OBJ)
'CHANGED))))))
(CHANGE.INDEX
(LAMBDA (OBJ STREAM) (* fsg "15-Jan-87 10:54")
(* * Here when CHANGE buttoned inside an Index ImageObject.)
(LIST (MKATOM (TEDIT.GETINPUT STREAM (CONCAT "Change Index name %""
(IMAGEOBJPROP OBJ 'INDEX.KEY)
"%" to: "))))))
(CHANGE.INDEXENTRY
(LAMBDA (OBJ STREAM OBJDATUM) (* fsg "15-Jan-87 11:17")
(* * Here when CHANGE buttoned inside an IndexEntry ImageObject.)
(LET ((WINDOW (\TEDIT.MAINW STREAM))
NEWINDEX.KEY NEWINDEX.ENTRY NEWINDEX.FONT NEWINDEX.NUMBER)
(COND
((SETQ NEWINDEX.KEY (MKATOM (TEDIT.GETINPUT STREAM (CONCAT
"Change IndexEntry Key %""
(IMAGEOBJPROP
OBJ
'INDEX.KEY)
"%" to: "))))
(SETQ NEWINDEX.ENTRY (OR (MKATOM (TEDIT.GETINPUT STREAM
(CONCAT
"Change IndexEntry Entry %""
(fetch INDEX.ENTRY
of OBJDATUM)
"%" to: ")))
(fetch INDEX.ENTRY of OBJDATUM)))
(TEDIT.PROMPTPRINT STREAM (CONCAT "Change IndexEntry Entry font %""
(ABBREVIATE.FONT (fetch INDEX.ENTRYFONT
of OBJDATUM))
"%" to...")
T)
(until (SETQ NEWINDEX.FONT (GET.TSP.FONT WINDOW (OR (fetch INDEX.ENTRYFONT
of OBJDATUM)
GP.DefaultFont)))
do (TEDIT.PROMPTPRINT STREAM "Invalid font specification...try again." T))
(TEDIT.PROMPTPRINT STREAM (CONCAT "Change IndexEntry Number option %""
(fetch INDEX.NUMBER of OBJDATUM)
"%" to...")
T)
(SETQ NEWINDEX.NUMBER (GET.INDEXENTRY.NUMBER WINDOW (fetch INDEX.NUMBER
of OBJDATUM)))
(TEDIT.PROMPTPRINT STREAM "" T)
(LIST NEWINDEX.KEY (create INDEX.ENTRY.RECORD
INDEX.ENTRY ← NEWINDEX.ENTRY
INDEX.ENTRYFONT ← NEWINDEX.FONT
INDEX.NUMBER ← NEWINDEX.NUMBER)))
(T (LIST NEWINDEX.KEY))))))
(INDEX.WHENDELETEDFN
(LAMBDA (OBJ WINDOW) (* fsg "15-Jan-87 11:30")
(* * Delete the selected Index or IndexEntry imageobject.)
(LET* ((INDEXKEY (IMAGEOBJPROP OBJ 'INDEX.KEY))
(INDEX.ARRAY (WINDOWPROP WINDOW 'TSP.INDEX.ARRAY))
(HASH.VALUE (GETHASH INDEXKEY INDEX.ARRAY)))
(COND
((DREMOVE OBJ (COND
((fetch OBJECTDATUM of OBJ)
(CADDR HASH.VALUE))
(T (CADR HASH.VALUE))))
NIL)
(T (DSUBST NIL (LIST OBJ)
HASH.VALUE)
(PUTHASH INDEXKEY (COND
((OR (CADR HASH.VALUE)
(CADDR HASH.VALUE))
HASH.VALUE)
(T NIL))
INDEX.ARRAY)))
NIL)))
)
(DEFINEQ
(ADD.NEW.INDEX
(LAMBDA (WINDOW INDEXKEY OBJ) (* fsg "28-Jan-87 11:37")
(* * Add an Index or IndexEntry imageobject to our index array. If at least one already exists for this index key,
then just append this imageobject to the list. Otherwise create a new array entry for this imageobject.
The list contains three elements; a string, a list of Index imageobjects, and a list of IndexEntry imageobjects.)
(LET* ((CODE.ARRAY (WINDOWPROP WINDOW 'TSP.INDEX.ARRAY))
(HASH.VALUE (GETHASH INDEXKEY CODE.ARRAY))
(INDEX.OBJS (CADR HASH.VALUE))
(ENTRY.OBJS (CADDR HASH.VALUE)))
(COND
((fetch OBJECTDATUM of OBJ)
(SETQ ENTRY.OBJS (APPEND ENTRY.OBJS (LIST OBJ))))
(T (SETQ INDEX.OBJS (APPEND INDEX.OBJS (LIST OBJ)))))
(PUTHASH INDEXKEY (LIST '"[Pages (?)]"
INDEX.OBJS ENTRY.OBJS)
CODE.ARRAY))))
(INDEX.STRING
(LAMBDA (OBJ) (* fsg "15-Feb-87 14:40")
(* * Returns the display imagestream text for an Index or IndexEntry ImageObject.)
(LET ((OBJDATUM (fetch OBJECTDATUM of OBJ))
INDEXNUMBER)
(COND
(OBJDATUM (CONCAT "[Index Key=" (MKATOM (IMAGEOBJPROP OBJ 'INDEX.KEY))
",Entry="
(fetch INDEX.ENTRY of OBJDATUM)
(COND
((EQ (SETQ INDEXNUMBER (fetch INDEX.NUMBER of OBJDATUM))
'YES)
",Number]")
((NUMBERP INDEXNUMBER)
(CONCAT ",Number=" INDEXNUMBER "]"))
(T "]"))))
(T (CONCAT "[Index " (MKATOM (IMAGEOBJPROP OBJ 'INDEX.KEY))
"]"))))))
(INSERT.INDEX
(LAMBDA (STREAM WINDOW) (* fsg "15-Jan-87 11:37")
(* * Process the "Index" function in the ImageObjects menu.)
(LET ((NEWINDEX.KEY (MKATOM (TEDIT.GETINPUT STREAM "Index Key: "))))
(TEDIT.PROMPTPRINT STREAM "" T)
(AND NEWINDEX.KEY (LET ((NEW.INDEX.OBJ (INDEXOBJ NEWINDEX.KEY)))
(ADD.NEW.INDEX WINDOW NEWINDEX.KEY NEW.INDEX.OBJ)
(TEDIT.INSERT.OBJECT NEW.INDEX.OBJ STREAM))))))
(INSERT.INDEXENTRY
(LAMBDA (STREAM WINDOW) (* fsg "15-Jan-87 11:39")
(* * Process the "IndexEntry" function in the ImageObjects menu.)
(LET ((NEWINDEX.KEY (MKATOM (TEDIT.GETINPUT STREAM "IndexEntry Key: ")))
NEWINDEX.ENTRY NEWINDEX.FONT NEWINDEX.NUMBER)
(COND
(NEWINDEX.KEY (SETQ NEWINDEX.ENTRY (OR (MKATOM (TEDIT.GETINPUT STREAM
"IndexEntry Entry: "
(MKSTRING
NEWINDEX.KEY)))
NEWINDEX.KEY))
(TEDIT.PROMPTPRINT STREAM "IndexEntry Entry font..." T)
(until (SETQ NEWINDEX.FONT (GET.TSP.FONT WINDOW GP.DefaultFont))
do (TEDIT.PROMPTPRINT STREAM
"Invalid font specification...try again."
T))
(TEDIT.PROMPTPRINT STREAM "IndexEntry Number option..." T)
(SETQ NEWINDEX.NUMBER (GET.INDEXENTRY.NUMBER WINDOW))
(TEDIT.PROMPTPRINT STREAM "" T)
(LET ((NEW.INDEX.OBJ (INDEXOBJ NEWINDEX.KEY
(create INDEX.ENTRY.RECORD
INDEX.ENTRY ← NEWINDEX.ENTRY
INDEX.ENTRYFONT ← NEWINDEX.FONT
INDEX.NUMBER ← NEWINDEX.NUMBER))))
(ADD.NEW.INDEX WINDOW NEWINDEX.KEY NEW.INDEX.OBJ)
(TEDIT.INSERT.OBJECT NEW.INDEX.OBJ STREAM)))
(T (TEDIT.PROMPTPRINT STREAM "" T))))))
(GET.INDEXENTRY.NUMBER
(LAMBDA (WINDOW DEFAULTNUMBER) (* fsg "15-Jan-87 11:43")
(* * Get the NUMBER argument for an IndexEntry ImageObject. The NUMBER can be "YES", "NO", or an integer.)
(OR (MENU (create MENU
TITLE ← "NUMBER?"
CENTERFLG ← T
ITEMS ← '(YES NO VALUE)
WHENSELECTEDFN ←(FUNCTION (LAMBDA (ITEM)
(COND
((EQ ITEM 'VALUE)
(NUMBERPAD.READ (CREATE.NUMBERPAD.READER "NUMBER value?" NIL
NIL NIL T)))
(T ITEM))))))
DEFAULTNUMBER
'YES)))
(INSERT.KNOWN.INDEX
(LAMBDA (STREAM WINDOW) (* fsg "18-Feb-87 14:48")
(* * Process the "Known Indices" function in the ImageObjects menu. A menu of all the known Indices and
IndexEntries pops up and the user may button one of these to insert the corrsponding Index or IndexEntry.
Any buttoning outside of this menu will make it disappear.)
(LET* ((PREVINDICES (INDEX.LIST.REFS WINDOW))
(NEWINDEX.KEY (COND
(PREVINDICES (LET ((NMENU (create MENU
TITLE ← "Index Keys"
ITEMS ← PREVINDICES))
MENU.SELECTION)
(SETQ MENU.SELECTION (MENU NMENU))
(AND MENU.SELECTION (OR (LISTP MENU.SELECTION)
(LIST MENU.SELECTION)))))
(T (TEDIT.PROMPTPRINT STREAM
"There are no Indicies/IndexEntries in this document."
T)
NIL))))
(AND NEWINDEX.KEY (LET ((NEWINDEX.OBJ (APPLY 'INDEXOBJ
NEWINDEX.KEY)))
(ADD.NEW.INDEX WINDOW (CAR NEWINDEX.KEY)
NEWINDEX.OBJ)
(TEDIT.INSERT.OBJECT NEWINDEX.OBJ STREAM)
(TEDIT.PROMPTPRINT STREAM "" T))))))
(INDEX.LIST.REFS
(LAMBDA (WINDOW) (* fsg "15-Jan-87 11:46")
(* * Return a sorted list of the Index and IndexEntry keys. Simple Index keys are just added to the list.
For an IndexEntry key, there are SUBITEMS for each IndexEntry for this key. This list can be used as the ITEMS
field in the Known Indices menu or for creating the index file.)
(LET ((INDEX.ARRAY (WINDOWPROP WINDOW 'TSP.INDEX.ARRAY))
(INDEX.KEYLIST NIL)
(INDEX.ITEMS (CONS))
INDEX.VALUE)
(MAPHASH INDEX.ARRAY (FUNCTION (LAMBDA (VAL KY)
(SETQ INDEX.KEYLIST (CONS KY INDEX.KEYLIST)))))
(for KEY in (SORT INDEX.KEYLIST 'UALPHORDER)
do (SETQ INDEX.VALUE (GETHASH KEY INDEX.ARRAY))
(AND (CADR INDEX.VALUE)
(NCONC INDEX.ITEMS (LIST KEY)))
(AND (CADDR INDEX.VALUE)
(NCONC INDEX.ITEMS (LIST (LIST KEY NIL "Select an IndexEntry subitem."
(CONS 'SUBITEMS
(LIST.OF.INDEXENTRIES
KEY
(CADDR INDEX.VALUE))))))))
(CDR INDEX.ITEMS))))
(LIST.OF.INDEXENTRIES
(LAMBDA (KEY OBJLIST) (* fsg "15-Jan-87 11:48")
(* * Returns a list of the IndexEntries sorted by Entry)
(LET ((ENTRY.LIST (CONS))
OBJDATUM)
(for OBJ in OBJLIST
do (SETQ OBJDATUM (fetch OBJECTDATUM of OBJ))
(NCONC ENTRY.LIST (LIST (LIST (CONCAT (fetch INDEX.ENTRY of OBJDATUM)
", "
(ABBREVIATE.FONT (fetch
INDEX.ENTRYFONT
of OBJDATUM))
", "
(fetch INDEX.NUMBER of OBJDATUM))
(KWOTE (LIST KEY OBJDATUM))))))
(SORT (INTERSECTION (CDR ENTRY.LIST)
(CDR ENTRY.LIST))
(FUNCTION (LAMBDA (A B)
(UALPHORDER (CAADR (CADADR A))
(CAADR (CADADR B)))))))))
(CREATE.INDEX.FILE
(LAMBDA (STREAM WINDOW) (* fsg "15-Dec-86 13:22")
(* * Writes the indices and their corresponding page numbers or strings to the index file. The indices are sorted
alphabetically regardless of case.)
(LET* ((INDEX.ARRAY (WINDOWPROP WINDOW 'TSP.INDEX.ARRAY))
(INDEX.LIST (INDEX.LIST.REFS WINDOW))
(INDEX.FILE (GET.INDEX.FILE (WINDOWPROP WINDOW 'IMAGEOBJ.MENUW)))
(INDEX.STREAM (AND INDEX.FILE (OPENTEXTSTREAM))))
(COND
((AND INDEX.LIST INDEX.FILE)
(TEDIT.PROMPTPRINT STREAM (CONCAT "Putting indices in: " INDEX.FILE "...")
T)
(WRITE.INDEX.FILE INDEX.STREAM INDEX.LIST INDEX.ARRAY)
(TEDIT.PROMPTPRINT STREAM "done")
(TEDIT.PUT INDEX.STREAM INDEX.FILE)
INDEX.FILE)
(INDEX.LIST (TEDIT.PROMPTPRINT STREAM "Specify a file name for the indices first." T)
NIL)
(T (TEDIT.PROMPTPRINT STREAM "There are no indices in this document." T)
NIL)))))
(VIEW.INDEX.FILE
(LAMBDA (STREAM WINDOW) (* fsg "15-Dec-86 15:22")
(* * Writes out the index file via CREATE.INDEX.FILE and then opens another TEdit window where this new file is
displayed.)
(LET ((INDEX.FILE (CREATE.INDEX.FILE STREAM WINDOW))
(INDEX.FILEW (WINDOWPROP WINDOW 'INDEX.WINDOW)))
(AND INDEX.FILE (COND
((WINDOWP INDEX.FILEW)
(COND
((OPENWP INDEX.FILEW)
(TEDIT.GET (TEXTOBJ INDEX.FILEW)
INDEX.FILE))
((OPENW INDEX.FILEW)
(TEDIT INDEX.FILE INDEX.FILEW))))
(T (WINDOWPROP WINDOW 'INDEX.WINDOW
(SETQ INDEX.FILEW (CREATEW NIL (CONCAT
"Viewing index file: "
INDEX.FILE))))
(TEDIT INDEX.FILE INDEX.FILEW)))))))
(GET.INDEX.FILE
(LAMBDA (MENUW) (* fsg "19-Aug-86 09:09")
(* * Return the user specified index file name.)
(LET* ((ITEM (FM.ITEMFROMID MENUW 'INDEX.FILE))
(FILENAME (FM.ITEMPROP ITEM 'LABEL)))
(COND
((NOT (STREQUAL FILENAME ""))
(MKATOM FILENAME))))))
(WRITE.INDEX.FILE
(LAMBDA (INDEX.STREAM INDEX.LIST INDEX.ARRAY) (* fsg "28-Jan-87 13:31")
(* * Do the output to the index file. For each Index, the Key is printed followed by the list of page numbers in
which this Index Key appears. Each IndexEntry is printed on a separate line and the page number depends on the
IndexEntry Number option. After all indices/indexentries are printed, the array page number list is converted back
to a string. This insures that the next DISPLAYFN call will reconvert the string back to a page number list.)
(DSPFONT (FONTCREATE '(HELVETICA 14 BRR))
INDEX.STREAM)
(PRINTOUT INDEX.STREAM "Index" T T)
(for INDEX.ITEM in INDEX.LIST
do (COND
((LISTP INDEX.ITEM)
(LET ((PGS.AND.IMOBJS (GETHASH (CAR INDEX.ITEM)
INDEX.ARRAY)))
(for INDEX.SUBITEM in (CDR (CADDDR INDEX.ITEM))
do (for (INDEX.ENTRYARGS INDEX.FONT) in (CDR (CADADR INDEX.SUBITEM))
do (DSPFONT (SETQ INDEX.FONT (FONTCREATE (CADR
INDEX.ENTRYARGS)))
INDEX.STREAM)
(PRINTOUT INDEX.STREAM (MKSTRING (CAR INDEX.ENTRYARGS)))
(WRITE.INDEX.PAGENUMBERS INDEX.STREAM PGS.AND.IMOBJS
(CADDR INDEX.ENTRYARGS))
(DSPFONT INDEX.FONT INDEX.STREAM)
(PRINTOUT INDEX.STREAM T)))))
(T (DSPFONT GP.DefaultFont INDEX.STREAM)
(LET ((PGS.AND.IMOBJS (GETHASH INDEX.ITEM INDEX.ARRAY)))
(COND
((CAR PGS.AND.IMOBJS)
(PRINTOUT INDEX.STREAM (MKSTRING INDEX.ITEM))
(WRITE.INDEX.PAGENUMBERS INDEX.STREAM PGS.AND.IMOBJS NIL)
(PRINTOUT INDEX.STREAM T))
(T NIL))))))
(for (INDEX.ITEM PAGES/IMOBJS) in INDEX.LIST
do (SETQ PAGES/IMOBJS (GETHASH (COND
((LISTP INDEX.ITEM)
(CAR INDEX.ITEM))
(T INDEX.ITEM))
INDEX.ARRAY))
(RPLACA PAGES/IMOBJS (COND
((STRINGP (CAR PAGES/IMOBJS))
(CAR PAGES/IMOBJS))
(T (CONCAT "[Pages " (MKSTRING (CAR PAGES/IMOBJS))
"]")))))))
(WRITE.INDEX.PAGENUMBERS
(LAMBDA (STREAM PAGES.AND.IMOBJS NUMBER.OPTION) (* fsg "15-Jan-87 11:53")
(* * Here to write the actual page or pages nubers that this Index or IndexEntry appears in.
NUMBER.OPTION is the Number field of an IndexEntry.)
(DSPFONT GP.DefaultFont STREAM)
(LET ((PAGE.NBRS (COND
(NUMBER.OPTION (SELECTQ NUMBER.OPTION
(NO "")
(YES (CAR PAGES.AND.IMOBJS))
(MKSTRING NUMBER.OPTION)))
(T (CAR PAGES.AND.IMOBJS))))
(PAGE#.STRING " "))
(COND
((LISTP PAGE.NBRS)
(for PAGE in PAGE.NBRS do (SETQ PAGE#.STRING (CONCAT PAGE#.STRING " "
(MKSTRING PAGE)))
finally (PRINTOUT STREAM PAGE#.STRING)))
(T (PRINTOUT STREAM (CONCAT PAGE#.STRING PAGE.NBRS)))))))
)
[DECLARE: EVAL@COMPILE
(RECORD INDEX.ENTRY.RECORD (INDEX.ENTRY INDEX.ENTRYFONT INDEX.NUMBER))
]
(PUTPROPS INDEX COPYRIGHT ("Leland Stanford Junior University" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1056 9971 (INDEXOBJ 1068 . 2331) (INDEXOBJP 2335 . 2718) (INDEX.DISPLAYFN 2722 . 4281)
(INDEX.IMAGEBOXFN 4285 . 4863) (INDEX.PUTFN 4867 . 5325) (INDEX.GETFN 5329 . 5903) (
INDEX.BUTTONEVENTINFN 5907 . 6972) (CHANGE.INDEX 6976 . 7324) (CHANGE.INDEXENTRY 7328 . 9178) (
INDEX.WHENDELETEDFN 9182 . 9968)) (9973 23270 (ADD.NEW.INDEX 9985 . 10986) (INDEX.STRING 10990 . 11779
) (INSERT.INDEX 11783 . 12319) (INSERT.INDEXENTRY 12323 . 13738) (GET.INDEXENTRY.NUMBER 13742 . 14360)
(INSERT.KNOWN.INDEX 14364 . 15630) (INDEX.LIST.REFS 15634 . 16840) (LIST.OF.INDEXENTRIES 16844 .
17764) (CREATE.INDEX.FILE 17768 . 18867) (VIEW.INDEX.FILE 18871 . 19740) (GET.INDEX.FILE 19744 . 20129
) (WRITE.INDEX.FILE 20133 . 22381) (WRITE.INDEX.PAGENUMBERS 22385 . 23267)))))
STOP