(FILECREATED " 3-Aug-85 13:56:53" {ERIS}<LISPCORE>LIBRARY>PPLISTFILE.;9
 8547   

      changes to:  (FNS PRINT.*)

      previous date: " 1-Aug-85 18:14:57" {ERIS}<LISPCORE>LIBRARY>PPLISTFILE.;8)


(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT PPLISTFILECOMS)

(RPAQQ PPLISTFILECOMS
 ((FNS CENTERPRINT COPYALLBYTES FILEPRINT LISTFILES1 PRETTYDEF.FROMFILE 
PPLISTFILE PRINT.BLACKLINE PRINT.* PRINT.DECLARE: PRINT.FILECREATED PRINT.DEFINEQ PRINT.VAR 
PRINT.DEFUN PRINTQUOTE) (P (CHANGENAME (QUOTE PRINTFNDEF) (QUOTE PFCOPYBYTES) (QUOTE 
PRETTYDEF.FROMFILE))) (PROP PRINT-TO-FILE RECORD TYPERECORD PROGN PROPRECORD HASHLINK ACCESSFN 
ACCESSFNS HASHRECORD ATOMRECORD ARRAYRECORD DATATYPE BLOCKRECORD ASSOCRECORD CACCESSFNS ARRAYBLOCK 
SYNONYM DEFINEQ DEFMACRO DEFUN RPAQ RPAQ? RPAQQ DECLARE: PUTPROPS * FILECREATED) (ADDVARS (
MAKEFILEFORMS (RESETSAVE PRETTYFLG NIL)))))
(DEFINEQ

(CENTERPRINT

(LAMBDA (STR TOSTREAM) (* lmm "19-Mar-85 12:59") (DSPXPOSITION (PLUS (DSPLEFTMARGIN NIL TOSTREAM) (
QUOTIENT (DIFFERENCE (DIFFERENCE (DSPRIGHTMARGIN NIL TOSTREAM) (DSPLEFTMARGIN NIL TOSTREAM)) (
STRINGWIDTH STR TOSTREAM)) 2)) TOSTREAM) (PRIN1 STR TOSTREAM) (TERPRI TOSTREAM)))

(COPYALLBYTES

(LAMBDA (FROMFILE TOFILE) (* lmm "28-Mar-85 15:33") (if (LISPSOURCEFILEP FROMFILE) then (PPLISTFILE 
FROMFILE (OR TOFILE T)) else (RESETLST (PROG (INF OUTF PTR) (COND (FROMFILE (RESETSAVE NIL (LIST (
QUOTE CLOSEF) (SETQ INF (OPENSTREAM FROMFILE (QUOTE INPUT))))) (OR (ZEROP (GETFILEPTR INF)) (
SETFILEPTR INF 0))) (T (SETQ INF (INPUT)))) (* close the files only if I opened them) (COND ((NULL 
TOFILE) (SETQ OUTF (OUTPUT))) ((NULL (SETQ OUTF (OPENP TOFILE (QUOTE OUTPUT)))) (RESETSAVE NIL (LIST (
QUOTE CLOSEF) (SETQ OUTF (OPENSTREAM TOFILE (QUOTE OUTPUT))))))) (COPYBYTES INF OUTF))))))

(FILEPRINT

(LAMBDA (EXPR) (* lmm "30-Jul-85 20:58") (LET ((MACRO (GETPROP (CAR EXPR) (QUOTE PRINT-TO-FILE)))) (if
 (AND MACRO (NEQ EXPR (SETQ EXPR (APPLY* MACRO EXPR)))) else (NEWPRINTDEF EXPR)))))

(LISTFILES1

(LAMBDA (FILE PRINTOPTIONS) (* lmm "28-Mar-85 15:19") (if (LISPSOURCEFILEP FILE) then (PPLISTFILE FILE
 NIL NIL PRINTOPTIONS) else (SEND.FILE.TO.PRINTER FILE NIL PRINTOPTIONS))))

(PRETTYDEF.FROMFILE

(LAMBDA (SRC DST START END) (* lmm "27-Mar-85 15:29") (SETFILEPTR SRC START) (RESETFORM (OUTPUT DST) (
FILEPRINT (LIST (QUOTE DEFINEQ) (READ SRC FILERDTBL))))))

(PPLISTFILE

(LAMBDA (FILE TOSTREAM TYPE PRINTOPTIONS) (* lmm "30-Jul-85 22:00") (RESETLST (RESETSAVE PRETTYFLG T) 
(LET* (FN STR) (AND (NOT (LISTP FILE)) (SETQ FN (FULLNAME (SETQ STR (OPENSTREAM FILE (QUOTE INPUT) NIL
 NIL (QUOTE ((SEQUENTIAL T)))))))) (RESETSAVE (OUTPUT (COND ((NOT TOSTREAM) (OPENIMAGESTREAM (QUOTE 
{CORE}TEMP) (OR TYPE (PRINTERTYPE)))) (T (SETQ TOSTREAM (GETSTREAM TOSTREAM (QUOTE OUTPUT))))))) (
RESETSAVE **COMMENT**FLG) (PROGN (AND TOSTREAM (RESETSAVE NIL (LIST (FUNCTION (LAMBDA (X) (CLOSEF? X) 
(AND RESETSTATE (DELFILE X)))) TOSTREAM))) (RESETSAVE NIL (LIST (QUOTE CLOSEF?) STR))) (DSPFONT 
DEFAULTFONT) (bind INDEX EXPR while (if STR then (NEQ (QUOTE STOP) (SETQ EXPR (READ STR FILERDTBL))) 
else (PROG1 FILE (SETQ EXPR (pop FILE)))) do (FILEPRINT EXPR) (RPTQ 2 (TERPRI)) finally (
PRINT.BLACKLINE) (if INDEX then (DSPNEWPAGE) (DSPFONT BOLDFONT) (LET ((DT (GETFILEINFO STR (QUOTE 
CREATIONDATE)))) (CENTERPRINT (if DT then (CONCAT FN "		" DT) else FN))) (DSPFONT DEFAULTFONT) (
CENTERPRINT (CONCAT "-- Listed on " (DATE) " --")) (TERPRI) (* Create and print index for each type. 
Print only one index per type, even when there are multiple "find" methods for each type.) (for TYPE 
in (bind (TYPES ← (LIST (QUOTE FNS))) for X in INDEX do (for (Y ← TYPES) by (CDR Y) repeatwhile (CDR Y
) when (EQ (CADR X) (CAR Y)) do (RETURN) finally (RPLACD Y (LIST (CADR X)))) finally (RETURN TYPES)) 
do (PrintOneTypeIndex TYPE INDEX)) (PRINT.BLACKLINE)) (RETURN STR)) (OR TOSTREAM (PROGN (
SEND.FILE.TO.PRINTER (CLOSEF (OUTPUT)) NIL (LIST* (QUOTE DOCUMENT.NAME) FN PRINTOPTIONS)) (QUOTE 
printed)))))))

(PRINT.BLACKLINE

(LAMBDA NIL (* lmm " 1-Apr-85 01:47") (TERPRI) (DRAWLINE (DSPLEFTMARGIN) (DSPYPOSITION) (
DSPRIGHTMARGIN) (DSPYPOSITION) (ADD1 (QUOTIENT (DSPLINEFEED) -4)) (QUOTE PAINT) NIL BLACKSHADE) (
TERPRI)))

(PRINT.*

(LAMBDA (EXPR) (* lmm " 1-Aug-85 17:47") (COND ((EQ (CADR EXPR) (QUOTE *)) (* Form-feed if 
super-comment indicated. Use * no matter what current COMMENTFLG is.) (DSPNEWPAGE)) (T (TERPRI))) (
RESETVARS ((COMMENTFONT BOLDFONT)) (NEWPRINTDEF EXPR NIL T)) (TERPRI)))

(PRINT.DECLARE:

(LAMBDA (EXPR) (* lmm "30-Jul-85 21:22") (if (match EXPR with ('DECLARE: 'DONTCOPY ('FILEMAP --) --)) 
then NIL else (PRIN1 "(") (bind LASTX for X in EXPR do (COND ((NLISTP X) (PRIN1 (SETQ LASTX X)) (
SPACES 1)) ((STRPOS "@WHEN" LASTX) (NEWPRINTDEF X NIL T)) (T (TERPRI) (FILEPRINT X)))) (printout NIL 
")" T))))

(PRINT.FILECREATED

(LAMBDA (FC) (* lmm "21-Mar-85 14:00") (printout NIL .FONT DEFAULTFONT "(" .P2 (pop FC) , .P2 (pop FC)
 , .FONT LAMBDAFONT .P2 (pop FC) , .FONT DEFAULTFONT) (if (FIXP (CAR FC)) then (PRIN2 (pop FC))) (if 
FC then (TERPRI) (bind (MARGIN ← (DSPLEFTMARGIN)) while FC do (SELECTQ (CAR FC) ((changes previous) (
DSPLEFTMARGIN MARGIN) (printout NIL T -6 (pop FC) , (pop FC) ,) (DSPLEFTMARGIN (DSPXPOSITION))) (if (
LISTP (CAR FC)) then (PRINT (pop FC)) else (PRIN2 (pop FC)) (SPACES 1))) finally (DSPLEFTMARGIN MARGIN
))) (PRIN1 ")") (TERPRI)))

(PRINT.DEFINEQ

(LAMBDA (EXPR) (* lmm "30-Jul-85 21:22") (printout NIL "(DEFINEQ" T) (for Y in (CDR EXPR) do (PROGN (
TERPRI NIL) (PRIN1 "(" NIL) (CHANGEFONT LAMBDAFONT NIL) (PRIN1 (CAR Y) NIL) (TERPRI NIL) (CHANGEFONT 
DEFAULTFONT NIL) (NEWPRINTDEF (CDR Y) T T T NIL NIL) (PRIN1 ")" NIL) (TERPRI NIL))) (printout NIL ")" 
T)))

(PRINT.VAR

(LAMBDA (VAREXP) (* lmm "30-Jul-85 21:22") (PROG (TEM (LASTCOL (DSPRIGHTMARGIN))) (TERPRI) (PROGN (
PRIN1 "(") (PRIN1 (CAR VAREXP)) (SPACES 1) (DSPFONT PRETTYCOMFONT) (PRIN2 (CADR VAREXP)) (DSPFONT 
DEFAULTFONT) (SPACES 1) (NEWPRINTDEF (CDDR VAREXP) T NIL T NIL NIL) (PRIN1 ")") (TERPRI)))))

(PRINT.DEFUN

(LAMBDA (DEFEXP) (* lmm "30-Jul-85 21:21") (RESETVARS ((PRETTYPRINTMACROS (for X in (QUOTE (BQUOTE \, 
\,@)) collect (CONS X (QUOTE PRINTQUOTE))))) (PROG (TEM (LASTCOL (DSPRIGHTMARGIN))) (PRINTOUT NIL T 
"(" (pop DEFEXP) , .FONT PRETTYCOMFONT .P2 (pop DEFEXP) .FONT DEFAULTFONT , # (NEWPRINTDEF (pop DEFEXP
) T T) # (if (OR (STRINGP (CAR DEFEXP)) (EQ (CAR (LISTP (CAR DEFEXP))) COMMENTFLG)) then (SPACES 1) (
NEWPRINTDEF (pop DEFEXP) T T)) T ,,, # (NEWPRINTDEF DEFEXP T T T) ")" T)))))

(PRINTQUOTE

(LAMBDA (EXPR) (* lmm "30-Jul-85 21:19") (* PRETTYPRINTMACRO to pretty print form EXPR. Regrettably, 
there are some character contexts in which this routine will fail. Not easy to fix. *) (COND ((AND (
LISTP (CDR EXPR)) (NULL (CDDR EXPR))) (* OK to prettyprint this EXPR. *) (PRIN1 (SELECTQ (CAR EXPR) (
QUOTE "'") (BQUOTE "`") (\, ",") (\,@ ",@") (SHOULDNT))) (* Let PRETTYPRINT handle (CADR EXPR) *) (OR 
(CADR EXPR) (PRIN2 NIL))) (T EXPR))))
)
(CHANGENAME (QUOTE PRINTFNDEF) (QUOTE PFCOPYBYTES) (QUOTE PRETTYDEF.FROMFILE))

(PUTPROPS RECORD PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS TYPERECORD PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS PROGN PRINT-TO-FILE
 PRINT.DECLARE:)

(PUTPROPS PROPRECORD PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS HASHLINK PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS ACCESSFN PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS ACCESSFNS PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS HASHRECORD PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS ATOMRECORD PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS ARRAYRECORD PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS DATATYPE PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS BLOCKRECORD PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS ASSOCRECORD PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS CACCESSFNS PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS ARRAYBLOCK PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS SYNONYM PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS DEFINEQ PRINT-TO-FILE
 PRINT.DEFINEQ)

(PUTPROPS DEFMACRO PRINT-TO-FILE
 PRINT.DEFUN)

(PUTPROPS DEFUN PRINT-TO-FILE
 PRINT.DEFUN)

(PUTPROPS RPAQ PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS RPAQ? PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS RPAQQ PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS DECLARE: PRINT-TO-FILE
 PRINT.DECLARE:)

(PUTPROPS PUTPROPS PRINT-TO-FILE
 PRINT.VAR)

(PUTPROPS * PRINT-TO-FILE
 PRINT.*)

(PUTPROPS FILECREATED PRINT-TO-FILE
 PRINT.FILECREATED)

(ADDTOVAR MAKEFILEFORMS
 (RESETSAVE PRETTYFLG NIL))
(PUTPROPS PPLISTFILE COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (913 7035 (CENTERPRINT 923 . 1216) (COPYALLBYTES 1218 . 1823) (FILEPRINT 1825 . 2026) (
LISTFILES1 2028 . 2222) (PRETTYDEF.FROMFILE 2224 . 2408) (PPLISTFILE 2410 . 4031) (PRINT.BLACKLINE 
4033 . 4251) (PRINT.* 4253 . 4529) (PRINT.DECLARE: 4531 . 4863) (PRINT.FILECREATED 4865 . 5426) (
PRINT.DEFINEQ 5428 . 5758) (PRINT.VAR 5760 . 6066) (PRINT.DEFUN 6068 . 6570) (PRINTQUOTE 6572 . 7033))
)))
STOP