(FILECREATED " 4-NOV-83 19:21:36" {PHYLUM}<LISPCORE>SOURCES>COMMENT.;2 54255Q
changes to: (FNS FINDFNDEF)
previous date: "21-SEP-83 22:08:43" {PHYLUM}<LISPCORE>SOURCES>COMMENT.;1)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT COMMENTCOMS)
(RPAQQ COMMENTCOMS [(VARS LCASELST UCASELST ABBREVLST)
[COMS (* * PRINTFN)
(FNS PF PF* PMORE PRINTFN PRINTFNDEF FINDFNDEF FINDBCPLDEF FINDSUBRDEF
SEARCHFILEMAP)
(E (* currently PFDEFAULT has 3 possible settings: COPYBYTES means always
use COPYBYTES to print the functions. - NIL means use the PFCOPYBYTES
function, which prints comments as **COMMENT**FLG, and reduces the
spacing from the left margin by 1/2 and gets rid of the changechar
indicators. - PFDEFAULT=T uses PFCOPYBYTES, but leaves the spacing
as-is))
(INITVARS PFDEFAULT (LASTFNDEF))
(P (MOVD? (QUOTE COPYBYTES)
(QUOTE PFCOPYBYTES)))
(USERMACROS PF)
(PROP MAC SUBR)
(BLOCKS (NIL PRINTFN PF PF* PMORE PRINTFNDEF (LOCALVARS . T)
(GLOBALVARS **COMMENT**FLG LASTFNDEF LASTWORD PFDEFAULT
FILERDTBL))
(NIL FINDFNDEF FINDSUBRDEF FINDBCPLDEF SEARCHFILEMAP
(GLOBALVARS FILERDTBL BUILDMAPFLG ERRORTYPELST USEMAPFLG)
(NOLINKFNS . T]
[COMS (* * FONT)
(FNS FONTSET FONTNAME FONTPROFILE FONTPROFILE1)
(INITVARS (FONTESCAPECHAR (CHARACTER 6))
(FONTFNS)
(FONTWORDS))
(VARS FONTDEFSVARS)
[ADDVARS (FONTSETUPFNS)
(FONTDEFS (STANDARD (FONTCHANGEFLG)
(FILELINELENGTH . 110Q)
(COMMENTLINELENGTH . 110Q)
(LAMBDAFONTLINELENGTH . 110Q)
(FIRSTCOL . 60Q)
(PRETTYLCOM . 16Q)
(LISTFILESTR . "
")
(FONTPROFILE (DEFAULTFONT)
(USERFONT)
(COMMENTFONT)
(LAMBDAFONT)
(SYSTEMFONT)
(CLISPFONT)
(CHANGEFONT)
(PRETTYCOMFONT)
(BIGFONT)
(LITTLEFONT)
(BOLDFONT)))
(SMALL (FONTCHANGEFLG)
(FILELINELENGTH . 140Q)
(COMMENTLINELENGTH . 140Q)
(LAMBDAFONTLINELENGTH . 140Q)
(FIRSTCOL . 74Q)
(PRETTYLCOM . 16Q)
(LISTFILESTR . "
")
(FONTPROFILE (DEFAULTFONT)
(USERFONT)
(COMMENTFONT)
(LAMBDAFONT)
(SYSTEMFONT)
(CLISPFONT)
(CHANGEFONT)
(PRETTYCOMFONT)
(BIGFONT)
(LITTLEFONT)
(BOLDFONT]
[DECLARE: DONTEVAL@LOAD DOCOPY (P (FONTSET (QUOTE STANDARD]
(BLOCKS (NIL FONTSET FONTNAME FONTPROFILE FONTPROFILE1 (LOCALVARS . T)
(GLOBALVARS FONTPROFILE FONTCHANGEFLG FONTESCAPECHAR FONTDEFS
FONTDEFSVARS]
(COMS (* Some prettyprint macros)
(FNS LONGLAMBDA.PPMACRO LONGPROGN.PPMACRO))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA PF* PF)
(NLAML)
(LAMA])
(RPAQQ LCASELST (A ADD AN AND ARRAY ARRAYS AS ATOM ATOMIC ATOMS ATTACH BETWEEN BY CALLS CHARACTER
CHART COLLECT COMMENT CONTROL COPY COUNT CREATE DEFINE DIFFERENCE DISPLAY DIVIDE
DO E EDIT EITHER ELSE EQ EQUAL EQUALS ERROR EVERY FINALLY FIRST FIX FIXED FLOATING
FOR FROM FUNCTION GET GO GREATER HELP IF IN INPUT INTEGER INTEGERS IS JOIN LAST
LENGTH LESS LIST LISTS LITATOM LITATOMS LITERAL MARK MEMB MEMBER MEMBERS MINUS
MIXED MOVE MOVES NEGATIVE NOT NTH NULL NUMBER NUMBERS OF OLD ON OR OUTPUT PLUS
POINT POSITION PRETTY PRINT PUSH PUT QUIT READ REMOVE RESET RESTORE RESULTS RETURN
REVERSE SAVED SET SIDE SKIP SMALL SOME SORT START STRING STRINGS TAIL THAN THE
THEN THRU TIME TIMES TO UNLESS UNTIL USED VARIABLES WHEN WHERE WHILE))
(RPAQQ UCASELST NIL)
(RPAQQ ABBREVLST (ETC. I.E. E.G. etc. i.e. e.g.))
(* * PRINTFN)
(DEFINEQ
(PF
[NLAMBDA FN (* rmk: "18-AUG-81 13:38")
(RESETLST
(* Print from files known to masterscope database before looking at whereis
database. Note, however, that it also prefers the masterscope database to incore
files)
(PROG (OUT OTHERARGS)
[COND
((LISTP FN)
(SETQ OTHERARGS (CDR FN))
(SETQ FN (CAR FN]
(COND
(FN (SETQ LASTWORD FN))
(T (SETQ FN LASTWORD)))
[RESETSAVE (OUTPUT (COND
((CADR OTHERARGS)
(OR (OPENP (CADR OTHERARGS)
(QUOTE OUTPUT))
(PROGN [RESETSAVE (SETQ OUT (OPENFILE (CADR OTHERARGS)
(QUOTE OUTPUT)))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
OUT)))
(T T]
(COND
((CAR OTHERARGS)
(for FILE inside (CAR OTHERARGS) do (PRINTFN FN FILE)))
(T (WHEREIS FN (QUOTE FNS)
T
(FUNCTION PRINTFN])
(PF*
[NLAMBDA FN (* lmm "30-MAR-78 23:40")
(RESETVARS (**COMMENT**FLG)
(APPLY (FUNCTION PF)
FN])
(PMORE
(LAMBDA NIL (* lmm " 9-AUG-78 17:21")
(* lmm "17-MAY-78 15:38")
(PRINTFNDEF (CAR LASTFNDEF)
T
(CADDR LASTFNDEF)
-1
(CADDDR LASTFNDEF))))
(PRINTFN
(LAMBDA (FN FROMFILE TOFILE) (* lmm " 9-AUG-78 17:21")
(PROG ((LOC (FINDFNDEF FN FROMFILE)))
(COND
(LOC (SETQ LASTFNDEF LOC)
(PRINTFNDEF (CAR LOC)
TOFILE
(CADR LOC)
(CADDR LOC)
(CADDDR LOC))
(RETURN FN))))))
(PRINTFNDEF
[LAMBDA (SRCFIL DSTFIL START END TYPE) (* rmk: " 1-MAR-82 15:45"
)
(RESETLST (PROG (TEM)
[COND
((NULL DSTFIL)
(SETQ DSTFIL (OUTPUT)))
((SETQ TEM (OPENP DSTFIL))
(SETQ DSTFIL TEM))
(T (RESETSAVE (SETQ DSTFIL (OPENFILE
DSTFIL
(QUOTE OUTPUT)))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
[COND
((SETQ TEM (OPENP SRCFIL (QUOTE INPUT)))
(RESETSAVE NIL (LIST (QUOTE SETFILEPTR)
TEM
(GETFILEPTR TEM)))
(SETQ SRCFIL TEM))
(T (RESETSAVE (SETQ SRCFIL (OPENFILE
SRCFIL
(QUOTE INPUT)))
(QUOTE (PROGN (CLOSEF? OLDVALUE]
(PRIN1 "{from " DSTFIL)
(PRIN2 SRCFIL DSTFIL T)
(PRIN1 "}
" DSTFIL))
(COND
((OR (NEQ DSTFIL T)
(EQ PFDEFAULT (QUOTE COPYBYTES))
(EQ TYPE (QUOTE MAC)))
(COPYBYTES SRCFIL DSTFIL START END))
(T (PFCOPYBYTES SRCFIL DSTFIL START END PFDEFAULT)))
(TERPRI DSTFIL])
(FINDFNDEF
[LAMBDA (FN FROMFILE) (* bvm: " 4-NOV-83 19:15")
(PROG (FULL ST TEM MAP)
[COND
[(SETQ TEM (GETP FROMFILE (QUOTE MAC)))
(RETURN (FINDSUBRDEF FN (CAR TEM)
(CADR TEM)
(CADDR TEM]
((SETQ TEM (GETP FROMFILE (QUOTE BCPL)))
(RETURN (FINDBCPLDEF FN (CAR TEM)
(CADR TEM)
(CADDR TEM]
(RETURN
(AND
(SETQ FULL (OR [AND [SETQ TEM (LISTP (GETP FROMFILE (QUOTE FILEDATES]
(INFILEP (PACKFILENAME (QUOTE VERSION)
NIL
(QUOTE BODY)
(CDAR TEM]
(FINDFILE FROMFILE T)))
(COND
((AND USEMAPFLG (SETQ MAP (GETP (NAMEFIELD FULL)
(QUOTE FILEMAP)))
(EQ FULL (CAR MAP))) (* quick check when the file already has a map)
(SEARCHFILEMAP FN MAP))
(T
(RESETLST
(RESETSAVE (INPUT))
(INFILE FULL)
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(INPUT)))
(RESETSAVE (SETREADTABLE FILERDTBL))
(SELECTQ (SETQ ST (RATOM))
[%( (* Assume it's a lisp file)
(COND
([AND USEMAPFLG (EQ (RATOM)
(QUOTE FILECREATED))
[PROGN (SKREAD) (* DATE)
(SKREAD) (* NAME)
(FIXP (SETQ ST (RATOM]
[PROGN (SETFILEPTR NIL ST)
(* next expression checks to make sure FILEMAP is valid, e.g. file may have been ftped to dorado.
reason for the errorset is if file map is not valid, may read off of end of file.)
(AND [RESETVARS (ERRORTYPELST)
(RETURN (NLSETQ (PROGN (READC)
(SETQ TEM
(RATOM]
(EQ TEM (QUOTE FILEMAP]
(SETQ ST (FFILEPOS (CONCAT " (" FN " ")
(INPUT)
ST NIL NIL NIL (SEPRCASE)))
(OR (EQ (RATOM)
FN)
(EQ (RATOM)
FN))
(FIXP (SETQ ST (RATOM)))
(EQ (RATOM)
(QUOTE %.))
(FIXP (SETQ TEM (RATOM]
(LIST (INPUT)
ST TEM (QUOTE SCAN)))
((AND BUILDMAPFLG (SETQ MAP (LOADFILEMAP FULL)))
(* will rebuild filemap. rewrite it on file if
updatemapflg is T.)
(SEARCHFILEMAP FN (LIST FULL MAP]
((TITLE Title title)
(FINDSUBRDEF FN))
(SELCHARQ (NTHCHARCODE ST 1)
((; *)
(FINDSUBRDEF FN))
(/ (FINDBCPLDEF FN))
NIL])
(FINDBCPLDEF
[LAMBDA (FN FROMFILES DIRS INDEX) (* rmk: " 5-MAY-81 22:00")
(RESETLST (PROG ((LABEL FN)
TEM BCPLFILE TEM2 INDEXFILE LABLEN)
[SETQ LABLEN (NCHARS (SETQ LABEL (CONCAT " " LABEL "("]
(RETURN (for BC in (OR (LISTP FROMFILES)
(SETQ FROMFILES (LIST FROMFILES)))
do (COND
((SETQ BCPLFILE (FINDFILE (PACKFILENAME (QUOTE BODY)
BC
(QUOTE EXTENSION)
(QUOTE BCPL))
T DIRS))
[RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(INPUT (INFILE BCPLFILE]
(SETFILEPTR BCPLFILE 0)
(COND
([SETQ TEM
(PROG NIL
LP (COND
((SETQ TEM (FFILEPOS LABEL BCPLFILE))
(SETFILEPTR BCPLFILE (SETQ TEM
(IDIFFERENCE TEM 3)))
(COND
[(FMEMB (U-CASE (RATOM BCPLFILE FILERDTBL))
(QUOTE (AND LET)))
(RETURN (LIST BCPLFILE TEM
(PROGN (FFILEPOS "[" BCPLFILE)
(SKREAD BCPLFILE)
(GETFILEPTR BCPLFILE))
(QUOTE BCPL]
(T (SETFILEPTR BCPLFILE (IPLUS TEM LABLEN 3))
(GO LP]
(MOVETOP BC FROMFILES)
(RETURN TEM])
(FINDSUBRDEF
[LAMBDA (FN FROMFILES DIRS INDEX) (* rmk: " 6-JUN-82 15:28"
)
(RESETLST
(PROG ((LABEL FN)
TEM MACFILE TEM2 INDEXFILE)
[COND
((EQ (NTHCHARCODE LABEL -1)
(CHARCODE :)))
((NULL INDEX)
(RETURN))
((AND (CAR INDEX)
(SETQ INDEXFILE (FINDFILE (PACK* (CAR INDEX)
".MAC")
T DIRS))
(FFILEPOS
(CONCAT (CADR INDEX)
LABEL
(CADDR INDEX))
(PROGN [RESETSAVE NIL
(LIST (QUOTE CLOSEF?)
(SETQ INDEXFILE
(INPUT (INFILE
INDEXFILE]
INDEXFILE)
(CADDDR INDEX)
NIL NIL T))
(SETQ TEM (RSTRING INDEXFILE T))
(SELECTQ
(CADDDR (CDR INDEX))
[EXEC
(SETQ LABEL
(COND
((SETQ TEM2 (STRPOS "," TEM))
(SUBSTRING TEM (ADD1 TEM2)
-1))
(T (CONCAT "."
(COND
((NOT (IGREATERP (NCHARS LABEL)
5))
LABEL)
(T (SUBSTRING LABEL 1 5 TEM]
(SETQ LABEL (SUBSTRING TEM 1
(SUB1 (OR (STRPOS "," TEM)
0))
TEM]
[SETQ LABEL (CONCAT "
" LABEL (COND
((EQ (NTHCHARCODE LABEL -1)
(CHARCODE :))
"")
(T (QUOTE :]
(RETURN
(for MC inside (OR FROMFILES (INPUT))
do
[AND (SETQ MACFILE (FINDFILE (PACKFILENAME
(QUOTE BODY)
MC
(QUOTE EXTENSION)
(QUOTE MAC))
T DIRS))
(OR (EQ MACFILE INDEXFILE)
(RESETSAVE NIL (LIST (QUOTE CLOSEF?)
(INPUT (INFILE MACFILE]
(COND
((SETQ TEM (FFILEPOS LABEL MACFILE 0))
(PROG (CR (MAXBEG (IPLUS TEM 2))
(MINBEG 0)
(TRY (IDIFFERENCE TEM 80))
(ENDTRY (IDIFFERENCE TEM 2))
MAXP MINP)
LP (COND
((ILESSP TRY MINBEG)
(SETQ TRY MINBEG)))
(SETQ CR TRY)
[while (SETQ CR
(FFILEPOS "
" MACFILE CR ENDTRY NIL T))
do (SELECTQ (PEEKC MACFILE)
((; *)
(OR MAXP (SETQ MAXP CR)))
(%
)
(PROGN (SETQ MAXP NIL)
(SETQ MINP CR]
(COND
(MAXP (SETQ MAXBEG MAXP)))
(COND
((AND (NULL MINP)
(IGREATERP TRY MINBEG))
(SETQ ENDTRY TRY)
(SETQ TRY (IDIFFERENCE TRY 80))
(GO LP)))
(SETQ TEM2 MAXBEG))
(AND (LISTP FROMFILES)
(MOVETOP MC FROMFILES))
(RETURN
(LIST
MACFILE TEM2
[SUB1
(OR (FFILEPOS (OR (CADDDR (CDDR INDEX))
" ")
MACFILE TEM)
(ADD1 (GETEOFPTR MACFILE]
(QUOTE MAC])
(SEARCHFILEMAP
(LAMBDA (FN MAP) (* lmm " 9-AUG-78 17:20")
(PROG (VALUE)
(AND (SOME (CDADR MAP)
(FUNCTION (LAMBDA (X)
(SETQ VALUE (FASSOC FN X)))))
(RETURN (LIST (CAR MAP)
(CADR VALUE)
(CDDR VALUE)
(QUOTE MAP)))))))
)
(RPAQ? PFDEFAULT NIL)
(RPAQ? LASTFNDEF )
(MOVD? (QUOTE COPYBYTES)
(QUOTE PFCOPYBYTES))
(ADDTOVAR EDITMACROS [PF NIL (ORR [(E (APPLY* (QUOTE PF)
(FIRSTATOM (##]
((E (QUOTE PF?])
(ADDTOVAR EDITCOMSA PF)
(PUTPROPS SUBR MAC ((ATHASH LISP GC SWAP BYTE)
(NEWLISP LISP NETLISP)
(LISP "ATM <" ">," 750220Q LISP)))
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL PRINTFN PF PF* PMORE PRINTFNDEF (LOCALVARS . T)
(GLOBALVARS **COMMENT**FLG LASTFNDEF LASTWORD PFDEFAULT FILERDTBL))
(BLOCK: NIL FINDFNDEF FINDSUBRDEF FINDBCPLDEF SEARCHFILEMAP (GLOBALVARS FILERDTBL BUILDMAPFLG
ERRORTYPELST USEMAPFLG)
(NOLINKFNS . T))
]
(* * FONT)
(DEFINEQ
(FONTSET
[LAMBDA (NAME) (* rmk: "22-NOV-81 14:36")
(PROG (TEM)
(RETURN (COND
((SETQ TEM (FASSOC NAME FONTDEFS)) (* Looks up NAME on FONTSLST and sets
apropriate parameters.
entries are added to fontslst by
FONTNAME.)
[MAPC (CDR TEM)
(FUNCTION (LAMBDA (X)
(/SETATOMVAL (CAR X)
(CDR X]
(FONTPROFILE FONTPROFILE)
(SETQ FONTNAME NAME))
(T (ERROR NAME "not a defined font configuration"])
(FONTNAME
[LAMBDA (NAME) (* lmm "28-MAR-83 12:00")
(* Defines NAME to correspond to current setting of various parameters, and adds
to FONTDEFS)
(PROG [TEM (L (CONS NAME (MAPCAR FONTDEFSVARS (FUNCTION (LAMBDA (X)
(CONS X (GETATOMVAL X]
(RETURN (COND
[(SETQ TEM (FASSOC NAME FONTDEFS))
(/RPLACD TEM (CDR L))
(RETURN (LIST NAME (QUOTE redefined]
(T (/SETATOMVAL (QUOTE FONTDEFS)
(CONS L FONTDEFS))
NAME])
(FONTPROFILE
[LAMBDA (PROFILE) (* rmk: "21-SEP-83 22:08")
(* The user defines a font configurationby setting the variables DEFAULTFONT, CLISPFONT, SYSTEMFONT, USERFONT,
LAMBDAFONT, COMMENTFONT. If non-NIL they define the font to be used on corresonding class of WORDS as follows:
(1 words) CLISPFONT is font to be used on cispwords, USERFONT all members of the list FONTFNS, or if FONTFNS=T, all
members of FILEFNS. USERFONT also applies to all members of FONTWORDS, initially NIL. SYSTEMFONT used for other
functions. COMMENTFONT for printing comments, and LAMBDAFONT for printing the function name before its definition.
The same font name can be given to more than one of th above, although there is a limit on the xgp of 3 fonts.
The psuedo-font UNDERLINE is also avaiaable, e.g. CLISPFONT=UNDERLINE means underline all clispwords.)
(DECLARE (GLOBALVARS FONTSETUPFNS))
[PROG (BASICCLASSES)
(for X in PROFILE
do (PROG (SEEN (NAME (CAR X))
(FONTS X))
LP [COND
((MEMB (CAR FONTS)
SEEN)
(ERROR "Circular font profile specification" X))
(T (push SEEN (CAR FONTS]
[SETQ FONTS (CDR (COND
((OR (NULL (CADR FONTS))
(LISTP (CADR FONTS)))
(* This skips over the now-defunct NIL or list-of-escape
sequence)
(CDR FONTS))
(T FONTS]
[COND
((OR (NLISTP FONTS)
(LITATOM (CAR FONTS))) (* Indirect thru another's font spec)
(AND (SETQ FONTS (ASSOC (SELECTQ (CAR (LISTP FONTS))
((NIL DEFAULTFONT)
(* Don't let DEFAULTFONT loop thru itself)
(AND (NOT (MEMB (QUOTE DEFAULTFONT)
SEEN))
(QUOTE DEFAULTFONT)))
(CAR FONTS))
PROFILE))
(GO LP)))
(T (push BASICCLASSES (CONS NAME FONTS))
(* The CONS is needed to compensate for the old style
specification, with the smash-cell.)
(SETQ FONTS (FONTPROFILE1 NAME FONTS]
(AND NAME (/SETATOMVAL NAME FONTS)) (* NIL for the class-name means just establish the
font-correspondences but don't connect them up with a
pretty class name.)
(RETURN)))
(for SETUP in FONTSETUPFNS
do
(* FONTSETUPFNS supplies device-dependent fontsetup functions. CADDR of the elements on FONTSETUPFNS are executed
after all fonts have been processed. This is used typically to set up inverse mappings between font numbers and
device-dependent fonts The CADR is executed in FONTPROFILE1 on each element to produce individual descriptors.)
(AND (CADDR SETUP)
(APPLY* (CADDR SETUP)
BASICCLASSES]
T])
(FONTPROFILE1
[LAMBDA (NAME FONTLIST) (* rmk: "21-SEP-83 21:49")
(* Internalizes a FONTLIST of user-readable font specifications for various devices. The device-dependent setup
information is obtained from the alist FONTSETUPFNS, which can be initialized to NIL when only symbolic file escape
sequences are specified. Otherwise, the elements of FONTSETUPFNS are of the form (eltnum eltfn inversefn), where
eltnum is the number of the element in FONTLIST for that device, eltfn is applied to that element to produce the
corresponding element in the fontclass, and inversefn is applied to build the inverse mapping from numbers to fonts,
for use by functions that interpret a symbolic file, e.g. PFCOPYBYTES, MAKEINTERPRESS. The results are ordered in
the fontclass according to the eltnums.)
(DECLARE (GLOBALVARS FONTSETUPFNS FONTESCAPECHAR))
(CONS [AND (FIXP (CAR FONTLIST))
(PACK* FONTESCAPECHAR (CHARACTER (CAR FONTLIST]
(for SETUP FONT in (SORT FONTSETUPFNS T) collect (COND
([NULL (SETQ FONT
(CAR (NTH FONTLIST
(CAR SETUP]
(* No spec for this device)
NIL)
((CADR SETUP)
(* NAME enables, e.g., global var declarations.)
(APPLY* (CADR SETUP)
NAME FONT))
((NULL FONT)
(* Now starts the generic setup, suitable only for
symbolic files)
NIL)
(T (ERROR "illegal font specification"
FONT])
)
(RPAQ? FONTESCAPECHAR (CHARACTER 6))
(RPAQ? FONTFNS )
(RPAQ? FONTWORDS )
(RPAQQ FONTDEFSVARS (FONTCHANGEFLG FILELINELENGTH COMMENTLINELENGTH FIRSTCOL PRETTYLCOM LISTFILESTR
FONTPROFILE FONTESCAPECHAR))
(ADDTOVAR FONTSETUPFNS )
(ADDTOVAR FONTDEFS (STANDARD (FONTCHANGEFLG)
(FILELINELENGTH . 110Q)
(COMMENTLINELENGTH . 110Q)
(LAMBDAFONTLINELENGTH . 110Q)
(FIRSTCOL . 60Q)
(PRETTYLCOM . 16Q)
(LISTFILESTR . "
")
(FONTPROFILE (DEFAULTFONT)
(USERFONT)
(COMMENTFONT)
(LAMBDAFONT)
(SYSTEMFONT)
(CLISPFONT)
(CHANGEFONT)
(PRETTYCOMFONT)
(BIGFONT)
(LITTLEFONT)
(BOLDFONT)))
(SMALL (FONTCHANGEFLG)
(FILELINELENGTH . 140Q)
(COMMENTLINELENGTH . 140Q)
(LAMBDAFONTLINELENGTH . 140Q)
(FIRSTCOL . 74Q)
(PRETTYLCOM . 16Q)
(LISTFILESTR . "
")
(FONTPROFILE (DEFAULTFONT)
(USERFONT)
(COMMENTFONT)
(LAMBDAFONT)
(SYSTEMFONT)
(CLISPFONT)
(CHANGEFONT)
(PRETTYCOMFONT)
(BIGFONT)
(LITTLEFONT)
(BOLDFONT))))
(DECLARE: DONTEVAL@LOAD DOCOPY
(FONTSET (QUOTE STANDARD))
)
[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL FONTSET FONTNAME FONTPROFILE FONTPROFILE1 (LOCALVARS . T)
(GLOBALVARS FONTPROFILE FONTCHANGEFLG FONTESCAPECHAR FONTDEFS FONTDEFSVARS))
]
(* Some prettyprint macros)
(DEFINEQ
(LONGLAMBDA.PPMACRO
[LAMBDA (FORM) (* bvm: " 2-MAR-83 15:35")
(* Prettyprintmacro for forms whose CAR is a long word and look like a lambda--first arg wants to be on first
line, others after it)
(COND
((AND (LISTP FORM)
(LISTP (CDR FORM))
(LISTP (CDDR FORM)))
(PROG [(POS (IPLUS 4 (POSITION]
(PRIN1 "(")
(PRIN2 (CAR FORM))
(SPACES 1)
(PRINTDEF (CADR FORM)
(POSITION))
(OR [EQ COMMENTFLG (CAAR (SETQ FORM (CDDR FORM]
(TAB POS 0))
(PRINTDEF FORM POS T T FNSLST)
(PRIN1 ")")
(RETURN NIL)))
(T FORM])
(LONGPROGN.PPMACRO
[LAMBDA (FORM) (* bvm: " 2-MAR-83 15:37")
(* Prettyprintmacro for forms whose CAR is a long word
and look like a progn--all args equal weight, one below
another)
(COND
((AND (LISTP FORM)
(LISTP (CDR FORM)))
(PROG [(POS (IPLUS 4 (POSITION]
(PRIN1 "(")
(PRIN2 (CAR FORM))
(OR [EQ COMMENTFLG (CAAR (SETQ FORM (CDR FORM]
(TAB POS 0))
(PRINTDEF FORM POS T T FNSLST)
(PRIN1 ")")
(RETURN NIL)))
(T FORM])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA PF* PF)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA )
)
(PUTPROPS COMMENT COPYRIGHT ("Xerox Corporation" 3677Q))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7470Q 31425Q (PF 7502Q . 11342Q) (PF* 11344Q . 11602Q) (PMORE 11604Q . 12231Q) (PRINTFN
12233Q . 12731Q) (PRINTFNDEF 12733Q . 14623Q) (FINDFNDEF 14625Q . 21514Q) (FINDBCPLDEF 21516Q .
24024Q) (FINDSUBRDEF 24026Q . 30721Q) (SEARCHFILEMAP 30723Q . 31423Q)) (32733Q 46336Q (FONTSET 32745Q
. 34000Q) (FONTNAME 34002Q . 35044Q) (FONTPROFILE 35046Q . 42744Q) (FONTPROFILE1 42746Q . 46334Q)) (
51260Q 53724Q (LONGLAMBDA.PPMACRO 51272Q . 52523Q) (LONGPROGN.PPMACRO 52525Q . 53722Q)))))
STOP