(FILECREATED "30-Mar-86 15:56:39" {ERIS}<LISPCORE>BVM>MERGEDFILEINDEX.;2 20311
changes to: (VARS MERGEDFILEINDEXCOMS)
previous date: "30-Mar-86 15:53:28" {ERIS}<LISPCORE>BVM>MERGEDFILEINDEX.;1)
(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MERGEDFILEINDEXCOMS)
(RPAQQ MERGEDFILEINDEXCOMS ((FILES SINGLEFILEINDEX)
(FNS MERGEDFILEINDEX MERGEDFILEINDEX2 MERGEDFILEINDEX1 \SFI.PLURALIZE)
(FNS PrintMergedIndex)
(COMS (* *
"FNS which want to go into the system in either FILEPKG or LOADFNS."
)
(FNS NDINFILECOMS? \NDINFILECOMS1 \SFI.LOADCOMS \SFI.GETFILVARDEF)
(INITVARS (\SFI.GETDEF.HASH NIL)))
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (LOADCOMP)
SINGLEFILEINDEX))))
(FILESLOAD SINGLEFILEINDEX)
(DEFINEQ
(MERGEDFILEINDEX
[LAMBDA (FILES OUTF) (* bvm: "28-Mar-86 17:31")
(* Note how we collect assurance that the files exist before exiting this
process -- this is to insure that the right defaults are used for connected
directory.)
(SETQ FILES (for F inside FILES bind FULL when (COND
((SETQ FULL (FINDFILE F T)))
(T (printout (.ERRORSTREAM.)
T "File " F " not found.")
NIL)) collect FULL))
(COND
(SINGLEFILEINDEX.DONTSPAWN (MERGEDFILEINDEX2 FILES OUTF))
(T (\SFI.Q1UP (FUNCTION MERGEDFILEINDEX2)
FILES OUTF) (* Used to return NIL so that
LISTFILES won't try removing from
NOTLISTEDFILES)
FILES])
(MERGEDFILEINDEX2
[LAMBDA (FILES OUTF) (* bvm: "28-Mar-86 17:44")
(MERGEDFILEINDEX1 FILES (OR OUTF PRINTERDEVICEFILENAME])
(MERGEDFILEINDEX1
[LAMBDA (FILES OUTF) (* bvm: "28-Mar-86 17:35")
(* * Makes a single index to a set of files.
The index is a table of contents which lists all the functions and classes in
alphabetical order, and a fileName -
sequence number pair for where that function or class is in the file.)
(* * FILES must be a non-null list of fullnames)
(DECLARE (GLOBALVARS FILERDTBL USEMAPFLG)
(USEDFREE LINESPERPAGE USEMAPFLG))
(PROG ((LINESPERPAGE LINESPERPAGE)
(LINECOUNT 0)
(PAGECOUNT 0)
(\SFI.GETDEF.HASH NIL)
(types SINGLEFILEINDEX.TYPES)
IndexedList DATE currentItem FULL)
(DECLARE (SPECVARS currentItem FULL LINESPERPAGE LINECOUNT PAGECOUNT \SFI.GETDEF.HASH)
(SPECVARS ROOT COMS MAP))
[RESETSAVE (OUTFILE OUTF)
(QUOTE (PROGN (CLOSEF? (OUTPUT OLDVALUE]
(RESETSAVE (LINELENGTH 1000))
(RESETSAVE (RADIX 10))
(COND
((NULL USEMAPFLG)
(RESETSAVE NIL (QUOTE (SETTOPVAL USEMAPFLG)))
(SETQ USEMAPFLG T))) (* Create index of indexed files.)
(PROGN (\SFI.CENTERPRINT "Indexed Files" T T)
(\SFI.CENTERPRINT (CONCAT "-- Listed on " (DATE)
" --")
NIL T)
(INDEXNEWLINE T)
(for FN in FILES do (SETQ DATE (GETFILEINFO FN (QUOTE WRITEDATE)))
(INDEXNEWLINE T)
(PRIN1 FN)
[PRINTDOTS (IDIFFERENCE FILELINELENGTH (IPLUS 4 (NCHARS FN)
(NCHARS DATE]
(PRIN1 DATE))
(INDEXNEWPAGE T)) (* Index all types.)
(for file ROOT COMS MAP in FILES
do [RESETSAVE (SETQ FULL (OPENFILE file (QUOTE INPUT)
(QUOTE OLD)))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[SETQ MAP (GETFILEMAP FULL (SETQ ROOT (ROOTFILENAME FULL]
(* * Note subsequent call to \SFI.GETFILVARDEF and that FindTypeItems also
calls NDINFILECOMS?)
(SETQ \SFI.GETDEF.HASH)
[COND
((SETQ COMS (\SFI.LOADCOMS (FILECOMS FULL)
FULL MAP))
(for typePair type filepkgtypeP ignoreables in (CONS (QUOTE (FNS))
types)
do [SETQ type (OR (SETQ filepkgtypeP (GETFILEPKGTYPE (CAR typePair)
NIL T))
(\SFI.PLURALIZE (CAR typePair]
(* hack that removes instances that
are methods.)
(SETQ ignoreables (SELECTQ type
(INSTANCES (NDINFILECOMS? NIL (QUOTE METHODS)
FULL COMS MAP
(AND (GETFILEPKGTYPE (QUOTE METHODS
)
NIL T)
(INFILECOMS? NIL (QUOTE
METHODS
)
COMS))))
NIL))
(for item in (NDINFILECOMS? NIL type FULL COMS MAP
(AND filepkgtypeP (INFILECOMS? NIL type COMS)))
when (NOT (MEMBER item ignoreables))
do (push IndexedList (LIST item type ROOT]
(CLOSEF? FULL))
(PrintMergedIndex (SORT IndexedList (FUNCTION UALPHORDERCAR)))
(RETURN FILES])
(\SFI.PLURALIZE
[LAMBDA (X) (* bvm: "15-Mar-86 16:10")
(LET ((LITP (LITATOM X))
(LEN (NCHARS X))
SUFFIX)
(OR LITP (STRINGP X)
(LISPERROR X "ARG NOT LITATOM"))
(SETQ SUFFIX (SELCHARQ (NTHCHARCODE X LEN)
((X S)
"ES")
(H (SELCHARQ (NTHCHARCODE X (SUB1 LEN))
(S "ES")
"S"))
(Y (SETQ X (SUBSTRING X 1 (SUB1 LEN)))
"IES")
"S"))
(COND
(LITP (PACK* X SUFFIX))
(T (CONCAT X SUFFIX])
)
(DEFINEQ
(PrintMergedIndex
[LAMBDA (IndexedList title) (* JonL " 3-Oct-84 01:58")
(* Makes an index to a set of files which have been printed by SINGLEFILEINDEX.
The index is a table of contents which lists all the functions in alphabetical
order, and a fileName -
sequence number pair for where that function is in the file.)
(DECLARE (USEDFREE LINECOUNT LINSEPERPAGE FILELINELENGTH))
(PROG ((FULL NIL)
(currentItem NIL)
(WIDTH 0)
(MAXFWIDTH 0)
(MAXTWOFIELDWIDTH 0)
item type file index NCOLUMNS NROWS LEFT SPACING LastItem)
(DECLARE (SPECVARS FULL currentItem NCOLUMNS LEFT WIDTH SPACING NROWS))
(\SFI.CENTERPRINT (OR title "MERGED INDEX")
T T)
(INDEXNEWLINE T)
[COND
((NULL IndexedList)
(INDEXNEWLINE T)
(printout NIL .FONT BOLDFONT "No printable definitions." .FONT DEFAULTFONT)
(INDEXNEWPAGE T)
(RETURN))
(T (for old item in IndexedList do [SETQ MAXFWIDTH (IMAX MAXFWIDTH (NCHARS (CAR item]
[SETQ MAXTWOFIELDWIDTH
(IMAX MAXTWOFIELDWIDTH (IPLUS MAXFWIDTH
(NCHARS (CADR item]
(SETQ WIDTH (IMAX WIDTH (IPLUS MAXTWOFIELDWIDTH
(NCHARS (CADDR item]
(add MAXTWOFIELDWIDTH 2)
(add WIDTH 6)
(\SFI.PrintIndexFactors IndexedList)
(SETQ NROWS (IMIN NROWS (IDIFFERENCE LINESPERPAGE LINECOUNT)))
[while IndexedList
do (for ROW from 1 to NROWS
do [for COLUMN from 1 to NCOLUMNS
do (COND
([SETQ LastItem (FNTH IndexedList (IPLUS ROW (ITIMES NROWS
(SUB1 COLUMN]
(SETQ item (CAAR LastItem))
(SETQ type (CADAR LastItem))
(SETQ file (CADDAR LastItem))
(PRIN1 item) (* Right justify printing of type
field.)
[PRINTDOTS (IDIFFERENCE MAXTWOFIELDWIDTH (IPLUS (NCHARS item)
(NCHARS type]
(PRIN1 type) (* Right justify printing of file
field.)
[PRINTDOTS (IDIFFERENCE WIDTH (IPLUS MAXTWOFIELDWIDTH (NCHARS file]
(PRIN1 file)
(COND
((NEQ COLUMN NCOLUMNS)
(SPACES SPACING]
(INDEXNEWLINE T))
(COND
((SETQ IndexedList (CDR LastItem))
(INDEXNEWPAGE T]
(RETURN])
)
(* * "FNS which want to go into the system in either FILEPKG or LOADFNS.")
(DEFINEQ
(NDINFILECOMS?
[LAMBDA (NAME TYPE FULL COMS MAP items) (* JonL "17-May-84 01:03")
(DECLARE (SPECVARS NAME TYPE FULL MAP items))
(* * Somewhat like INFILECOMS?, except tries to GETDEF on vars in COMS whose
defs are not loaded. ND prefix means "Non-Destructive")
(* * FULL must be the fullname of an open file;
COMS should not be null, but MAP can be.
"items" is a list onto which to cons the results when NAME is null.)
(OR (OPENP FULL)
(ERRORX (LIST 13 FULL)))
(COND
((AND MAP (EQ TYPE (QUOTE FNS))) (* This is more general than it need
be for now. Mostly we are calling it
with NAME = NIL)
(COND
((EQ NAME T)
(AND (CDR MAP)
T))
((NULL NAME)
[for list in MAP do (for fn in (CDDR list) do (pushnew items (CAR fn]
items)
((find list in MAP suchthat (ASSOC NAME list))
T)))
(T (MAPC COMS (FUNCTION \NDINFILECOMS1)) (* \NDINFILECOMS1 will update items
with the things it finds)
(COND
((NULL NAME)
items)
((NULL items)
NIL)
((OR (EQ NAME T)
(MEMBER NAME items))
T])
(\NDINFILECOMS1
[LAMBDA (COM) (* JonL " 3-Oct-84 02:12")
(DECLARE (USEDFREE COMMENTFLG)
(USEDFREE NAME TYPE MAP FULL items))
(COND
((NLISTP COM))
((EQ (CAR COM)
(QUOTE DECLARE:))
(PROG ((list COM))
LP (pop list)
[COND
((NULL list)
(RETURN))
((NLISTP (CAR list))
(SELECTQ (CAR list)
((COPYWHEN EVAL@COMPILEWHEN EVAL@LOADWHEN COMPILERVARS)
(* get rid of the conditional or
ADDVARS expression.)
(pop list))
NIL))
(T (\NDINFILECOMS1 (CAR list]
(GO LP)))
[(EQ TYPE (CAR COM))
(for item TEM in (COND
[(EQ (CADR COM)
(QUOTE *))
(COND
([AND (LITATOM (CADDR COM))
(NOT (FMEMB (CADDR COM)
(QUOTE (NIL T]
(* Sorry, can't hack general forms
after a *)
[COND
((EQ TYPE (QUOTE VARS))
(pushnew items (CADDR COM]
(\SFI.GETFILVARDEF (CADDR COM)
FULL MAP]
(T (CDR COM))) do (COND
((EQ COMMENTFLG (CAR (LISTP item)))
(* Note how this permits scattering
comments among definitions in the COMS)
)
((NOT (MEMBER (SETQ TEM (COND
((LISTP item)
(CAR item))
(T item)))
items))
(push items TEM]
((AND (EQ TYPE (QUOTE VARS))
(NEQ COMMENTFLG (CAR COM))
(EQ (CADR COM)
(QUOTE *)))
(pushnew items (CADDR COM)))
((EQ (CAR COM)
(QUOTE COMS)) (* Don't do this one before the check
for filevars !)
(PROG (list fileVar)
[SETQ list (COND
((EQ (CADR COM)
(QUOTE *)) (* Note how we can't handle
complicated * cases)
(AND (LITATOM (SETQ fileVar (CADDR COM)))
fileVar
(NEQ fileVar T)
(\SFI.GETFILVARDEF fileVar FULL MAP)))
(T (CDR COM]
(AND list (SETQ items (NDINFILECOMS? NAME TYPE FULL list MAP items])
(\SFI.LOADCOMS
[LAMBDA (COMSNAME INSTREAM MAP) (* bvm: "15-Mar-86 18:12")
(* * INSTREAM is the fullname of an open file;
if MAP is non-null, it is the filemap of a LISPSOURCEP file)
(SETFILEPTR INSTREAM 0)
(PROG ([ERRORTYPELST (QUOTE ((16 (ERROR!]
NEWCOMS)
(* * NLSETQ doesn't suppress the file-closing operation of EOF;
ERROR! bombs out with the file left open.)
[NLSETQ (COND
([AND (EQ (SKIPSEPRS INSTREAM FILERDTBL)
(QUOTE %())
(NOT (find C
in (CHARCODE (%( F I L E C R E A T E D % ))
suchthat (NEQ C (READCCODE INSTREAM FILERDTBL]
(SETFILEPTR INSTREAM 0)
(SKREAD INSTREAM) (* Skips the FILECREATED expression)
(SKREAD INSTREAM) (* Skips the Copyright or
PRETTYCOMPRINT expression)
(to 5 bind TEM do (COND
([AND (LISTP (SETQ TEM (READ INSTREAM FILERDTBL)))
(EQ (CAR TEM)
(QUOTE RPAQQ))
(EQ COMSNAME (CAR (LISTP (CDR TEM]
(RETURN (SETQ NEWCOMS (CADDR TEM]
(RETURN NEWCOMS])
(\SFI.GETFILVARDEF
[LAMBDA (NAME FULL MAP) (* bvm: "15-Mar-86 18:14")
(DECLARE (USEDFREE \SFI.GETDEF.HASH))
(COND
((AND NAME (LITATOM NAME))
(* * Sorry, can't handle forms like (ADDVARS *
(CONS (QUOTE MUMBLE) (LIST SOMEVAR))))
(PROG (VAL)
[COND
((NLISTP \SFI.GETDEF.HASH) (* \SFI.GETDEF.HASH is bound to NIL by
SINGLEFILEINDEX1 and MERGEDFILEINDEX1)
(COND
((EQ \SFI.GETDEF.HASH (QUOTE ERROR))
(RETURN))
((AND (NULL MAP)
(NOT (LISPSOURCEFILEP FULL)))
(* * If there is already a MAP then it probably is a Lisp file but if it isn't
a Lisp file at all, then we quash any further enquiries.)
(SETQ \SFI.GETDEF.HASH (QUOTE ERROR))
(RETURN)))
(SETQ \SFI.GETDEF.HASH (HASHARRAY 30]
(COND
((NULL (SETQ VAL (GETHASH NAME \SFI.GETDEF.HASH)))
(SETQ VAL (GETDEF NAME (QUOTE VARS)
FULL
(QUOTE NOERROR)))
(PUTHASH NAME (OR VAL \SFI.GETDEF.HASH)
\SFI.GETDEF.HASH))
((EQ VAL \SFI.GETDEF.HASH) (* Way to make a NIL entry into the
table)
(SETQ VAL)))
(RETURN VAL])
)
(RPAQ? \SFI.GETDEF.HASH NIL)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (LOADCOMP)
SINGLEFILEINDEX)
)
(PUTPROPS MERGEDFILEINDEX COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1074 7938 (MERGEDFILEINDEX 1084 . 2253) (MERGEDFILEINDEX2 2255 . 2437) (
MERGEDFILEINDEX1 2439 . 7171) (\SFI.PLURALIZE 7173 . 7936)) (7939 11387 (PrintMergedIndex 7949 . 11385
)) (11469 20110 (NDINFILECOMS? 11479 . 13099) (\NDINFILECOMS1 13101 . 16765) (\SFI.LOADCOMS 16767 .
18417) (\SFI.GETFILVARDEF 18419 . 20108)))))
STOP