(DF PPD (NAME)		% Pretty-Print an atom's definition
,  (PROG (GOTD TY DFN)
,  ,  (SETQ GOTD (GETD (CAR NAME)))
,  ,  (COND
,  ,  ,  ((NULL GOTD)
,  ,  ,  ,  (RETURN NIL)
,  ,  ,  ,,,)
,  ,  ,,,)
,  ,  (SETQ TY (CAR GOTD))
,  ,  (SETQ DFN (CADR GOTD))
,  ,  (COND
,  ,  ,  ((EQUAL TY 'EXPR)
,  ,  ,  ,  (SETQ TY 'DE)
,  ,  ,  ,,,)
,  ,  ,  ((EQUAL TY 'FEXPR)
,  ,  ,  ,  (SETQ TY 'DF)
,  ,  ,  ,,,)
,  ,  ,  ((EQUAL TY 'MACRO)
,  ,  ,  ,  (SETQ TY 'MACRO)
,  ,  ,  ,,,)
,  ,  ,  (
,  ,  ,  ,  (OR (EQUAL TY 'SUBR)
,  ,  ,  ,  ,  (EQUAL TY 'FSUBR)
,  ,  ,  ,  ,  (EQUAL TY 'LSUBR)
,  ,  ,  ,  ,,,)
,  ,  ,  ,  (ERROR "PPD - Compiled definitions can't be displayed"
,  ,  ,  ,  ,  (CONS 'PPD NAME)
,  ,  ,  ,  ,,,)
,  ,  ,  ,,,)
,  ,  ,,,)
,  ,  (PRIN2 "(")
,  ,  (PRIN1 TY)
,  ,  (PRIN2 " ")
,  ,  (PRIN1 (CAR NAME))
,  ,  (PRIN2 " ")
,  ,  (PPI (CADR DFN) (POSN))
,  ,  (LOOP
,  ,  ,  (INITIAL EXP (CDDR DFN))
,  ,  ,  (WHILE EXP)
,  ,  ,  (DO (PPI (POP EXP) 3))
,  ,  ,,,)
,  ,  (PRIN2 ")")
,  ,  (TERPRI)
,  ,,,)
,,,)
 
(DF PPPL (NAME)		% Pretty-Print an atom's property list
,  (PROG (PL PN PV)
,  ,  (SETQ PL (CDAR NAME))
,  ,  (PRIN2 "(DEFPROP ")
,  ,  (PRIN1 (CAR NAME))
,  ,  (REPEAT
,  ,  ,  WHILE PL
,  ,  ,  (SETQ PN (POP PL))
,  ,  ,  (SETQ PV (POP PL))
,  ,  ,  (PPI PV 3)
,  ,  ,  (PPI PN 3)
,  ,  ,,,)
,  ,  (PRIN2 ")")
,  ,  (TERPRI)
,  ,,,)
,,,)
 
(DF PPP (A)		% Pretty-Print an atom's property list
,  (PP (CDAR A))
,,,)
 
(DE PPI (S COL)		% Pretty-Print Indented
,  (PPAUX S COL 0 (LESSP COL (POSN)))
,,,)
 
(DE PP (S)		% Pretty-Print a symbolic expression
,  (PPAUX S 0 0 (LESSP 0 (POSN)))
,,,)
 
(DE PPAUX (S_EXP S_EXP_START LP_COUNT NEWLINE) % Aux function for pretty-printin
,  (PROG (ARG_START)
,  ,  (COND (NEWLINE		% do carriage return?
,  ,  ,  (TERPRI)
,  ,  ,,,))
,  ,  (PRIN2 (FILLSTR " " 	% move out to starting place
,  ,  ,  (DIFFERENCE S_EXP_START (POSN))
,  ,  ,,,))
,  ,  (COND
,  ,  ,  ((ATOM S_EXP)		% if S is an atom, print it
,  ,  ,  ,  (PRIN1 S_EXP)
,  ,  ,  ,,,)
,  ,  ,  ( 			% else, it's a list
,  ,  ,  ,  (AND
,  ,  ,  ,  ,  (NOT (MEMBER
,  ,  ,  ,  ,  ,  (CAR S_EXP)
,  ,  ,  ,  ,  ,  '(COND DO INITIAL LET PROG)
,  ,  ,  ,  ,  ,,,))
,  ,  ,  ,  ,  (LESSP		% will it fit on this line?
,  ,  ,  ,  ,  ,  (PLUS (POSN) (PRLENGTH S_EXP) LP_COUNT LP_COUNT)
,  ,  ,  ,  ,  ,  (LINELENGTH)
,  ,  ,  ,  ,  ,,,)
,  ,  ,  ,  ,,,)
,  ,  ,  ,   
,  ,  ,  ,  (PRIN1 S_EXP)
,  ,  ,  ,,,)
,  ,  ,  ( T
,  ,  ,  ,  (PRIN2 "(")		% start with left paren
,  ,  ,  ,  (SETQ LP_COUNT (ADD1 LP_COUNT))
,  ,  ,  ,  (SETQ ARG_START (PLUS (POSN) 2))
,  ,  ,  ,  (PPAUX (CAR S_EXP) (POSN) LP_COUNT NIL) % pretty-print first element
,  ,  ,  ,  (COND				% more?
,  ,  ,  ,  ,  ((CDR S_EXP)
,  ,  ,  ,  ,  ,  (MAPCAR				 % and the rest
,  ,  ,  ,  ,  ,  ,  (CDR S_EXP)
,  ,  ,  ,  ,  ,  ,  '(LAMBDA (EXP)
,  ,  ,  ,  ,  ,  ,  ,  (PPAUX EXP ARG_START LP_COUNT T) % on new lines
,  ,  ,  ,  ,  ,  ,  ,,,)
,  ,  ,  ,  ,  ,  ,,,)
,  ,  ,  ,  ,  ,,,)
,  ,  ,  ,  ,,,)
,  ,  ,  ,  (PRIN2 ")")			% end with right paren
,  ,  ,  ,  (SETQ LP_COUNT (SUB1 LP_COUNT))
,  ,  ,  ,,,)
,  ,  ,,,)
,  ,  (RETURN)
,  ,,,)
,,,)
 
(DF E (FILE)	% Edit a file
,  (SSPAWN
,  ,  (STRCONS "E " (CAR FILE))
,  ,,,)
,,,)