(FILECREATED "28-MAR-83 12:00:37" <NEWLISP>COMMENT.;1 22415
changes to: (FNS FONTNAME)
previous date: " 9-MAR-83 21:53:07" <LISP>COMMENT.;157)
(* 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 . 72)
(COMMENTLINELENGTH . 72)
(LAMBDAFONTLINELENGTH . 72)
(FIRSTCOL . 48)
(PRETTYLCOM . 14)
(LISTFILESTR . "
")
(FONTPROFILE (DEFAULTFONT)
(USERFONT)
(COMMENTFONT)
(LAMBDAFONT)
(SYSTEMFONT)
(CLISPFONT)
(CHANGEFONT)
(PRETTYCOMFONT)
(BIGFONT)
(LITTLEFONT)
(BOLDFONT)))
(SMALL (FONTCHANGEFLG)
(FILELINELENGTH . 96)
(COMMENTLINELENGTH . 96)
(LAMBDAFONTLINELENGTH . 96)
(FIRSTCOL . 60)
(PRETTYLCOM . 14)
(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) (* rmk: " 1-MAR-82 15:43"
)
(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 (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 <" ">," 250000 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: "23-NOV-81 16:47"
)
(* 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)
[MAPC
PROFILE
(FUNCTION (LAMBDA (X)
(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]
(MAPC FONTSETUPFNS (FUNCTION (LAMBDA (FNS)
(* FONTSETUPFNS supplies device-dependent fontsetup
functions. CAR of the pairs 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 (CADR FNS)
(APPLY* (CADR FNS)
BASICCLASSES]
T])
(FONTPROFILE1
[LAMBDA (NAME FONTLIST) (* rmk: "21-NOV-81 13:56")
(* Internalizes a FONTLIST of user-readable font specifications for various
devices. The device-dependent setup function is obtained from the parallel list
FONTSETUPFNS, which can be initialized to NIL when only symbolic file escape
sequences are specified.)
(DECLARE (GLOBALVARS FONTSETUPFNS FONTESCAPECHAR))
(for FNS in (OR FONTSETUPFNS (QUOTE (NIL))) as FONT in FONTLIST collect (COND
((CAR FNS)
(* NAME enables, e.g., global var
declarations.)
(APPLY* (CAR FNS)
NAME FONT))
((NULL FONT)
(* Now starts the generic setup, suitable
only for symbolic files)
NIL)
((FIXP FONT)
(PACK* FONTESCAPECHAR
(CHARACTER
FONT)))
(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 . 72)
(COMMENTLINELENGTH . 72)
(LAMBDAFONTLINELENGTH . 72)
(FIRSTCOL . 48)
(PRETTYLCOM . 14)
(LISTFILESTR . "
")
(FONTPROFILE (DEFAULTFONT)
(USERFONT)
(COMMENTFONT)
(LAMBDAFONT)
(SYSTEMFONT)
(CLISPFONT)
(CHANGEFONT)
(PRETTYCOMFONT)
(BIGFONT)
(LITTLEFONT)
(BOLDFONT)))
(SMALL (FONTCHANGEFLG)
(FILELINELENGTH . 96)
(COMMENTLINELENGTH . 96)
(LAMBDAFONTLINELENGTH . 96)
(FIRSTCOL . 60)
(PRETTYLCOM . 14)
(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" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3949 13293 (PF 3961 . 4920) (PF* 4924 . 5086) (PMORE 5090 . 5374) (PRINTFN 5378 . 5706)
(PRINTFNDEF 5710 . 6695) (FINDFNDEF 6699 . 9098) (FINDBCPLDEF 9102 . 10358) (FINDSUBRDEF 10362 .
12957) (SEARCHFILEMAP 12961 . 13290)) (14028 19292 (FONTSET 14040 . 14593) (FONTNAME 14597 . 15155) (
FONTPROFILE 15159 . 18164) (FONTPROFILE1 18168 . 19289)) (20829 22188 (LONGLAMBDA.PPMACRO 20841 .
21528) (LONGPROGN.PPMACRO 21532 . 22185)))))
STOP