(FILECREATED " 9-Aug-85 16:01:20" {ERIS}<LISPCORE>LIBRARY>CMLPRETTY.;2
 9479   

      changes to:  (FNS PPLISTFILE PRINT.DEFUN DSPPAGENUMBER) (VARS CMLPRETTYCOMS) (PROPS (RPAQ 
PRINT-TO-FILE) (DEFSTRUCT PRINT-TO-FILE))

      previous date: " 6-Aug-85 21:57:56" {ERIS}<LISPCORE>LIBRARY>PPLISTFILE.;10)


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

(PRETTYCOMPRINT CMLPRETTYCOMS)

(RPAQQ CMLPRETTYCOMS
 ((FNS CENTERPRINT COPYALLBYTES DSPPAGENUMBER FILEPRINT LISTFILES1 
PRETTYDEF.FROMFILE PPLISTFILE PRINT.BLACKLINE PRINT.* PRINT.DECLARE: PRINT.FILECREATED PRINT.DEFINEQ 
PRINT.VAR PRINT.DEFUN PRINTQUOTE) (PROP PRINT-TO-FILE RECORD TYPERECORD PROGN PROPRECORD HASHLINK 
ACCESSFN ACCESSFNS HASHRECORD ATOMRECORD ARRAYRECORD DATATYPE BLOCKRECORD ASSOCRECORD CACCESSFNS 
ARRAYBLOCK SYNONYM DEFINEQ DEFMACRO DEFSTRUCT DEFUN RPAQ RPAQ? RPAQQ DECLARE: PUTPROPS * FILECREATED))
)
(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))))))

(DSPPAGENUMBER

(LAMBDA (STREAM PAGENUMBER) (* lmm " 9-Aug-85 12:22") (SELECTQ (IMAGESTREAMTYPE (SETQ STREAM (
GETSTREAM STREAM (QUOTE OUTPUT)))) (PRESS (WITH PRESSDATA (FETCH (STREAM IMAGEDATA) OF STREAM) (PROG1 
PRPAGENUM (AND PAGENUMBER (SETQ PRPAGENUM PAGENUMBER))))) (INTERPRESS (WITH INTERPRESSDATA (FETCH 
IMAGEDATA OF STREAM) (PROG1 IPPAGENUM (AND PAGENUMBER (SETQ IPPAGENUM PAGENUMBER))))) (PROG1 (
STREAMPROP STREAM (QUOTE PAGENUMBER)) (AND PAGENUMBER (STREAMPROP STREAM (QUOTE PAGENUMBER) PAGENUMBER
))))))

(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 " 9-Aug-85 16:00") (RESETLST (RESETSAVE PRETTYFLG T) 
(LET (FN STR *FILE-INDEX* (*FILE-INDEX-NUMBER* 0) EXPR) (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)) (LIST (QUOTE HEADING) (
CONCAT (if (AND (LITATOM FN) FN) then "" else FN) " listed on " (DATE))))) (T (SETQ TOSTREAM (
GETSTREAM TOSTREAM (QUOTE OUTPUT))))))) (RESETSAVE PRETTYPRINTMACROS (NCONC (for X in (QUOTE (BQUOTE 
\, \,@ QUOTE)) collect (CONS X (QUOTE PRINTQUOTE))) PRETTYPRINTMACROS)) (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) (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 *FILE-INDEX* then (DSPNEWPAGE) (
DSPFONT DEFAULTFONT) (CENTERPRINT (CONCAT "-- INDEX --")) (TERPRI) (* Create and print index for each 
type. Print only one index per type, even when there are multiple "find" methods for each type.) (SORT
 *FILE-INDEX* (FUNCTION (LAMBDA (X Y) (UALPHORDER (CAR X) (CAR Y))))) (for X in *FILE-INDEX* do (
PRINTOUT NIL (CAR X) 30 (CADR X) 40 (CADDR X) T)) (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 " 6-Aug-85 12:24") (if (match EXPR with ('DECLARE: 'DONTCOPY ('FILEMAP --) --)) 
then NIL else (PRIN1 "(") (bind LASTX for X in EXPR do (COND ((NLISTP X) (PRIN2 (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 " 9-Aug-85 12:37") (LET* ((DEFFER (pop DEFEXP)) (DEFFED (pop DEFEXP)) FIN) (
PRINTOUT NIL T "(" DEFFER ,) (push *FILE-INDEX* (LIST (if (LISTP DEFFED) then (CAR DEFFED) else DEFFED
) DEFFER (OR (DSPPAGENUMBER) (SETQ FIN (CONCAT "[" (SETQ *FILE-INDEX-NUMBER* (ADD1 *FILE-INDEX-NUMBER*
)) "]"))))) (if (LISTP DEFFED) then (PRINTOUT NIL "(" .FONT PRETTYCOMFONT (CAR DEFFED) .FONT 
DEFAULTFONT , # (NEWPRINTDEF (CDR DEFFED) T T T) ")") else (PRINTOUT NIL .FONT PRETTYCOMFONT DEFFED 
.FONT DEFAULTFONT)) (SELECTQ DEFFER ((DEFUN DEFMACRO) (if (LISTP (CAR DEFEXP)) then (SPACES 1) (
NEWPRINTDEF (pop DEFEXP) T NIL))) NIL) (if (OR (STRINGP (CAR DEFEXP)) (EQ (CAR (LISTP (CAR DEFEXP))) 
COMMENTFLG)) then (SPACES 1) (NEWPRINTDEF (pop DEFEXP) T T)) (if FIN then (DSPFONT BOLDFONT) (MOVETO (
DIFFERENCE (DSPRIGHTMARGIN) (STRINGWIDTH FIN)) (DSPYPOSITION)) (PRIN3 FIN) (DSPFONT DEFAULTFONT)) (
PRINTOUT NIL 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))))
)

(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 DEFSTRUCT PRINT-TO-FILE
 PRINT.DEFUN)

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

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

(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)
(PUTPROPS CMLPRETTY COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (905 8049 (CENTERPRINT 915 . 1208) (COPYALLBYTES 1210 . 1815) (DSPPAGENUMBER 1817 . 2337
) (FILEPRINT 2339 . 2540) (LISTFILES1 2542 . 2736) (PRETTYDEF.FROMFILE 2738 . 2922) (PPLISTFILE 2924
 . 4569) (PRINT.BLACKLINE 4571 . 4789) (PRINT.* 4791 . 5067) (PRINT.DECLARE: 5069 . 5401) (
PRINT.FILECREATED 5403 . 5964) (PRINT.DEFINEQ 5966 . 6296) (PRINT.VAR 6298 . 6604) (PRINT.DEFUN 6606
 . 7584) (PRINTQUOTE 7586 . 8047)))))
STOP