(FILECREATED "23-Mar-84 11:51:57" {PHYLUM}<LISPUSERS>SIMPLEFILEINDEX.;2 9782
changes to: (FNS INDEXCOPYBYTES)
(VARS SIMPLEFILEINDEXCOMS)
previous date: "23-Mar-84 11:28:44" {PHYLUM}<LISPUSERS>SIMPLEFILEINDEX.;1)
(* Copyright (c) 1984 by Xerox Corporation)
(PRETTYCOMPRINT SIMPLEFILEINDEXCOMS)
(RPAQQ SIMPLEFILEINDEXCOMS [(FNS SINGLEFILEINDEX INDEXNEWLINE INDEXNEWPAGE PRINTDOTS LISTINGHEADER
CENTERPRINT)
(FNS INDEXCOPYBYTES)
(FNS SFILISTFILES1)
[VARS (PRINTER (SELECTQ (SYSTEMTYPE)
(D (QUOTE {LPT}))
(QUOTE LPT:]
(DECLARE: DOCOPY DONTEVAL@LOAD (P (MOVD? (QUOTE LISTFILES1)
(QUOTE OLDLISTFILES1))
(/MOVD (QUOTE SFILISTFILES1)
(QUOTE LISTFILES1)))
(INITVARS (LINESPERPAGE 65)))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS DefineqList FileMap FnPointer))
(BLOCKS (SINGLEFILEINDEXBLOCK SINGLEFILEINDEX INDEXNEWLINE INDEXNEWPAGE
PRINTDOTS LISTINGHEADER CENTERPRINT
INDEXCOPYBYTES (ENTRIES SINGLEFILEINDEX)
(LOCALFREEVARS LINECOUNT PAGECOUNT CURFN
INUM FULL)
(GLOBALVARS FILELINELENGTH PRINTER
FONTCHANGEFLG DEFAULTFONT
PRETTYCOMFONT])
(DEFINEQ
(SINGLEFILEINDEX
[LAMBDA (INF OUTF NEWPAGEFLG) (* lmm "23-Mar-84 11:22")
(* Makes a indexed file (default is the line printer). The index file will have a table of contents which will
list all the functions in alphabetical order and a sequence number of where that function is in the file.
In the listing the index number will be "highlighted" in the right hand margin. -
NOTE: The index file is not "loadable" into LISP.)
(DECLARE (GLOBALVARS FILERDTBL))
(RESETLST
(PROG [MAP (LINECOUNT 0)
(PAGECOUNT 0)
(LINESPERPAGE LINESPERPAGE)
CURFN
(FULL (OPENFILE INF (QUOTE INPUT)
(QUOTE OLD]
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
FULL))
(OR [SETQ MAP
(CDR (OR (GETFILEMAP FULL INF)
(AND (EQ (SKIPSEPRS FULL FILERDTBL)
(QUOTE %())
(for C
in (QUOTE (%( F I L E C R E A T E D % ))
always (EQ C (READC FULL)))
(LOADFILEMAP FULL]
(PROGN (printout T "Could not get file map for " FULL T)
(RETURN)))
[RESETSAVE [OUTPUT (SETQ OUTF (OPENFILE (OR OUTF PRINTER)
(QUOTE OUTPUT)
(QUOTE NEW]
(QUOTE (PROGN (CLOSEF? (OUTPUT OLDVALUE]
(SELECTQ (SYSTEMTYPE)
[TENEX (COND
((STRPOS "PARC-MAXC" (HOSTNAME))
(PROG [(J (VAG (OPNJFN OUTF]
(ASSEMBLE NIL (* set the "NAME" parameter to be the name of the file)
(CQ (CONCAT FULL (CHARACTER 0)))
(FASTCALL UPATM)
(PUSHN 3)
[CQ (CONSTANT (CONCAT "NAME" (CHARACTER 0]
(FASTCALL UPATM)
(MOVE 2 , 3)
(POPN 3)
(CQ J)
(JSYS 440Q)
(JFCL))
(SETQ LINESPERPAGE (IDIFFERENCE (BITS 4 10 (JS RFMOD
(LOC J)
NIL NIL 2))
3]
(D (SETQ LINESPERPAGE (OR (GETFILEINFO OUTF (QUOTE PAGEHEIGHT))
LINESPERPAGE)))
NIL)
(RESETSAVE (LINELENGTH 1000 OUTF))
(RESETSAVE (RADIX 10))
(PROGN (CENTERPRINT (CONCAT FULL " " (GETFILEINFO FULL (QUOTE WRITEDATE)))
T)
(CENTERPRINT (CONCAT "-- Listed on " (DATE)
" --"))
(INDEXNEWLINE))
[PROG (ILIST (INUM 0)
(MAXFWIDTH 0))
[SETQ ILIST (for DFQ in MAP join (for FNP in (fetch FnsList of DFQ)
collect [SETQ MAXFWIDTH
(IMAX MAXFWIDTH
(NCHARS (fetch FnName
of FNP]
(CONS (fetch FnName of FNP)
(add INUM 1]
(SORT ILIST (FUNCTION UALPHORDER))
[COND
((NOT ILIST)
(INDEXNEWLINE)
(printout NIL .FONT BOLDFONT "No Functions." .FONT DEFAULTFONT)
(INDEXNEWPAGE))
(T (PROG ((WIDTH (IPLUS MAXFWIDTH (NCHARS INUM)
1))
NCOLUMNS NROWS LEFT SPACING LASTFN)
(SETQ NCOLUMNS (IQUOTIENT FILELINELENGTH (IPLUS WIDTH 2)))
(SETQ LEFT (IDIFFERENCE FILELINELENGTH (ITIMES (IPLUS WIDTH 2)
NCOLUMNS)))
(SETQ WIDTH (IPLUS WIDTH (IQUOTIENT (IQUOTIENT LEFT 2)
NCOLUMNS)))
(SETQ SPACING (IPLUS (IQUOTIENT (IQUOTIENT LEFT 2)
(SUB1 NCOLUMNS))
2))
(while ILIST
do (SETQ NROWS (IDIFFERENCE LINESPERPAGE LINECOUNT))
(for ROW from 1 to NROWS
do [for COLUMN from 1 to NCOLUMNS
do (COND
([SETQ LASTFN (FNTH ILIST
(IPLUS ROW (ITIMES NROWS
(SUB1 COLUMN]
(PRIN1 (CAAR LASTFN))
[PRINTDOTS (IDIFFERENCE
(IDIFFERENCE WIDTH
(NCHARS (CAAR LASTFN)))
(NCHARS (CDAR LASTFN]
(PRIN1 (CDAR LASTFN))
(COND
((NEQ COLUMN NCOLUMNS)
(SPACES SPACING]
(INDEXNEWLINE))
(INDEXNEWPAGE)
(SETQ ILIST (CDR LASTFN]
(PROG ((POS 0)
(INUM 0))
[for DFQ in MAP do (for FNP in (fetch FnsList of DFQ)
do (INDEXCOPYBYTES FULL OUTF POS (SETQ POS
(fetch (FnPointer BeginPoint)
of FNP)))
(COND
(NEWPAGEFLG (INDEXNEWPAGE))
(T (INDEXNEWLINE)))
(SETQ INUM (ADD1 INUM))
(COND
((NOT (ILEQ (IPLUS LINECOUNT 3)
LINESPERPAGE))
(INDEXNEWPAGE)))
(printout NIL .SP (IDIFFERENCE FILELINELENGTH
(IPLUS 2
(NCHARS INUM)))
.FONT BOLDFONT "[" INUM "]" .FONT
DEFAULTFONT .RESET)
(PROG ((CURFN (CAR FNP)))
(INDEXCOPYBYTES FULL OUTF POS
(SETQ POS (fetch (FnPointer
EndPoint)
of FNP]
(INDEXCOPYBYTES FULL OUTF POS (GETEOFPTR FULL]
(RETURN FULL])
(INDEXNEWLINE
[LAMBDA NIL (* rmk: " 8-NOV-83 12:18")
(TERPRI)
(COND
((IGREATERP (add LINECOUNT 1)
LINESPERPAGE)
(INDEXNEWPAGE])
(INDEXNEWPAGE
[LAMBDA NIL (* rmk: " 8-NOV-83 12:17")
(PRIN3 (FCHARACTER (CHARCODE FF)))
(POSITION NIL 0)
(SETQ LINECOUNT 0)
(add PAGECOUNT 1)
(LISTINGHEADER])
(PRINTDOTS
[LAMBDA (N) (* lmm "16-DEC-78 19:09")
(FRPTQ (IQUOTIENT N 8)
(PRIN1 "........"))
(FRPTQ (IREMAINDER N 8)
(PRIN1 "."])
(LISTINGHEADER
[LAMBDA NIL (* rrb " 9-JUL-81 12:04")
(PRIN1 FULL)
(COND
(CURFN (printout NIL " (" .P2 CURFN " [" INUM "] cont.)")))
(TAB (IDIFFERENCE FILELINELENGTH 9)
T)
(PRIN1 "Page ")
(PRINTNUM (QUOTE (FIX 4))
PAGECOUNT)
(INDEXNEWLINE)
(INDEXNEWLINE])
(CENTERPRINT
[LAMBDA (STR BOLDFLG) (* lmm " 8-JUN-80 18:10")
(TAB (IQUOTIENT (IDIFFERENCE FILELINELENGTH (NCHARS STR))
2))
(COND
(BOLDFLG (printout NIL .FONT BOLDFONT STR .FONT DEFAULTFONT))
(T (PRIN1 STR)))
(INDEXNEWLINE])
)
(DEFINEQ
(INDEXCOPYBYTES
[LAMBDA (IN OUT START END) (* lmm "23-Mar-84 11:51")
(* This is similar to COPYBYTES except that, INDEXNEWLINE is called whenever an EOL is read, and IndexNewPage is
called whenever a form feed is read)
(SETFILEPTR IN START)
(PROG ((INSTRM (GETSTREAM IN))
(OUTSTRM (GETSTREAM OUT))
CH)
(bind (CNT ←(IDIFFERENCE END START)) while (IGREATERP CNT 0)
do (SELCHARQ (SETQ CH (BIN INSTRM))
[(CR LF)
(COND
((IGREATERP LINECOUNT (IDIFFERENCE LINESPERPAGE 5))
(* double cr near end of page)
(INDEXNEWPAGE))
(T (INDEXNEWLINE)))
(COND
((AND (EQ CH (CHARCODE CR))
(EQ (\PEEKBIN INSTRM)
(CHARCODE LF)))
(BIN INSTRM)
(add CNT -1]
(FF (INDEXNEWPAGE))
(BOUT OUTSTRM CH))
(add CNT -1)))
T])
)
(DEFINEQ
(SFILISTFILES1
[LAMBDA (FILE) (* rmk: "14-JUN-82 23:58")
(PROG ((INF (INFILEP FILE)))
(RETURN (COND
((SINGLEFILEINDEX INF)
(printout T "indexed version of " INF " => " PRINTER T)
(SETQ NOTLISTEDFILES (REMOVE (NAMEFIELD INF T)
NOTLISTEDFILES))
"")
(T (OLDLISTFILES1 FILE])
)
(RPAQ PRINTER (SELECTQ (SYSTEMTYPE)
(D (QUOTE {LPT}))
(QUOTE LPT:)))
(DECLARE: DOCOPY DONTEVAL@LOAD
(MOVD? (QUOTE LISTFILES1)
(QUOTE OLDLISTFILES1))
(/MOVD (QUOTE SFILISTFILES1)
(QUOTE LISTFILES1))
(RPAQ? LINESPERPAGE 65)
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD DefineqList (BeginPoint EndPoint . FnsList))
(RECORD FileMap (NIL . Maps))
(RECORD FnPointer (FnName BeginPoint . EndPoint))
]
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: SINGLEFILEINDEXBLOCK SINGLEFILEINDEX INDEXNEWLINE INDEXNEWPAGE PRINTDOTS LISTINGHEADER
CENTERPRINT INDEXCOPYBYTES (ENTRIES SINGLEFILEINDEX)
(LOCALFREEVARS LINECOUNT PAGECOUNT CURFN INUM FULL)
(GLOBALVARS FILELINELENGTH PRINTER FONTCHANGEFLG DEFAULTFONT PRETTYCOMFONT))
]
(PUTPROPS SIMPLEFILEINDEX COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1259 7495 (SINGLEFILEINDEX 1269 . 6153) (INDEXNEWLINE 6155 . 6366) (INDEXNEWPAGE 6368
. 6611) (PRINTDOTS 6613 . 6814) (LISTINGHEADER 6816 . 7183) (CENTERPRINT 7185 . 7493)) (7496 8483 (
INDEXCOPYBYTES 7506 . 8481)) (8484 8888 (SFILISTFILES1 8494 . 8886)))))
STOP