(DE ISLIST (B) (IF (ATOM B) (NULL B) (ISLIST (CDR B)))) (DE LEN (L) (COND ((NULL L) 2) ((ATOM L) (LENGTH (EXPLODE L))) ((AND (EQ (1 L) QUOTE) (NULL (CDDR L))) (ADD1 (LEN (2 L)))) ((EQ (1 L) 'LIST) (LEN (CDR L))) ((ISLIST L) (SETQ S 1) (MAPC (LAMBDA (X) (SETQ S (+ 1 S (LEN X)))) L) S) (T (+ 5 (LEN (CAR L)) (LEN (CDR L)))))) (DE TO-BIG (L) (LT (- CPOS (LMARGIN)) (LEN L))) (DE INSER (X L) (COND ((NULL L) (SETQ L [X])) ((LE (CADR X) (CADAR L)) (NEWL L X)) (T (SETQ L (CONS (CAR L) (INSER X (CDR L))))))) (DE PTLIST (L1) (COND ((NOT MLINES) (NEXTL L1) (WHILE L1 (PRINCH " ") (PT (NEXTL L1) PNUM))) ((EQ 1 (SETQ FORMAT (2 (ASSQ (NEXTL L1) '((IF 2) (IFN 2) (WHILE 2) (UNTIL 2) (LAMBDA 2) (SETQ 1)))))) (WHILE L1 (OUTPOS (+ (LMARGIN) 3)) (PT (NEXTL L1) PNUM T) (LMARGIN (+ (LMARGIN) 12)) (OUTPOS (IF (LT (OUTPOS) (LMARGIN)) (LMARGIN) (ADD1 (OUTPOS)))) (PT (NEXTL L1) PNUM T) (LMARGIN (- (LMARGIN) 12)) (IF L1 (TERP)))) ((EQ 2 FORMAT) (PRINCH " ") (SETQ LEFTSV (LMARGIN)) (LMARGIN (OUTPOS)) (PT (NEXTL L1) PNUM T) (LMARGIN LEFTSV) (WHILE L1 (TERP) (PT (NEXTL L1) PNUM T))) (T (WHILE L1 (TERP) (PT (NEXTL L1) PNUM T))))) (DE PT (L PNM MLINES BRAK) (IF MLINES (SETQ MLINES (TO-BIG L))) (COND ((NULL L) (PRINCH "(") (PRINCH ")")) ((ATOM L) (PRIN L) (IF (AND (BOUNDP 'COMFLAG) COMFLAG) (GETCOM L))) ((AND (EQ (1 L) QUOTE) (NULL (CDDR L))) (PRINCH "'") (PT (2 L) PNUM MLINES)) ((EQ (1 L) 'LIST) (PT (CDR L) PNUM MLINES T)) (T (COND ((NEQ PNM 96) (IF PAR (SETQ LRP (INSER [PNM (OUTPOS)] LRP))) (PRINCH (IF BRAK "[" "(")))) (CHANGEP 1) (IF (AND MLINES (CDR L)) (LMARGIN (+ (LMARGIN) 3))) (PT (CAR L) PNUM MLINES) (IF (ISLIST L) (PTLIST L) (PROGN (PRINCH " ") (PRINCH ".") (PRINCH " ")) (PT (CDR L) PNUM MLINES)) (IF (AND PAR (NEQ PNM 96)) (SETQ LRP (INSER [PNM (OUTPOS)] LRP))) (PRINCH (IF BRAK "]" ")")) (IF MLINES (LMARGIN (- (LMARGIN) 3)))))) (DE TERP () (IFN COMT (TERPRA) (STATUS PRINT 1) (PRINL1 (NEXTL COMLI))) (COND ((AND PAR LRP) (RINNER2) (IFN LRP (CHANGEP -1) (RINNER2) (IF LRP (PROGN (SETQ A4 (COPY A3)) (RINNER2) (TERP2) (TERP3 A4) (IFN LRP (CHANGEP -3) (MAPC (LAMBDA (X) (OUTBUF (2 X) (1 X))) LRP) (SETQ LRP ())) (TERP4)) (CHANGEP -2) (IF (OR (CDR A3) (GE (- (2 (CAR A3)) (1 (CAR A3))) 30)) (PROGN (TERP2) (TERP4))))))) (COND (COMT (MAPC 'PRINL1 COMLI) (SETQ COMLI () COMT ()) (STATUS PRINT 7)))) (DE TERPRA () (TERPRI) (INCR LINECNT)) (DE TERP2 () (SETQ SVLEFT (LMARGIN)) (LMARGIN 0) (OUTPOS (RMARGIN)) (OUTBUF 0 ";") (TERP3 A3)) (DE TERP3 (L) (MAPC (LAMBDA (X) (SETQ I (1 X) J (2 X)) (IF (EQ (OUTBUF I) ".") (SETQ SYM1 "?" SYM2 ":") (SETQ SYM1 "!" SYM2 ".")) (OUTBUF I SYM1) (OUTBUF J SYM1) (INCR I) (WHILE (LT I J) (OUTBUF I SYM2) (INCR I))) L)) (DE TERP4 () (UNTIL (NEQ (OUTBUF (SUB1 (OUTPOS))) " ") (OUTPOS (SUB1 (OUTPOS)))) (LMARGIN SVLEFT) (IF (AND COMT COMLI) (PRINL1 (NEXTL COMLI) T) (SETQ JPOS (IF (LT (OUTPOS) CPOS) CPOS (OUTPOS))) (OUTPOS (ADD1 JPOS)) (OUTBUF JPOS ";") (TERPRA))) (DE RINNER2 () (SETQ A1 () A3 ()) (RINNER)) (DE RINNER () (IFN LRP (SETQ LRP (FREVERSE A1)) (IFN (EQ (1 (1 LRP)) (1 (2 LRP))) (NEWL A1 (CAR LRP)) (NEWL A3 [(2 (1 LRP)) (2 (2 LRP))]) (NEXTL LRP)) (NEXTL LRP) (RINNER))) (DE CHANGEP (X) (SETQ PNUM (+ PNUM X)) (IF (EQ PNUM 123) (SETQ PNUM 65)) (IF (LT PNUM 65) (CHANGEP 58)) (IF (EQ PNUM 91) (SETQ PNUM 97)) (IF (AND (LE PNUM 96) (GE PNUM 92)) (CHANGEP -6))) (DF PRETTY (L) (EVAL (CONS 'PRET L))) (DF PRET (L NAME LINECNT XTYPE SVR SVL THISPOS) (IFN (BOUNDP 'CPOS) (SETQ CPOS 68)) (SETQ SVR (RMARGIN) SVL (LMARGIN)) (SETQ NAME (1 L) PAR (2 L) LINECNT 0) (SETQ XTYPE (CDR (ASSQ (FTYPE NAME) '((EXPR . DE) (FEXPR . DF) (MACRO . DM))))) (PROGN (LMARGIN 0) (RMARGIN 127) (TERPRA)) (COND (XTYPE (STATUS PRINT 1) (LMARGIN 3) (PRIN "(" XTYPE " " NAME " ") (PRIN (COND ((CAR (FVAL NAME))) (T "()")) " ") (COND ((AND (BOUNDP 'COMFLAG) COMFLAG) (PRIN "; ") (READLN) (SETQ THISPOS (OUTPOS)) (WHILE LIN (PROGN (OUTPOS THISPOS) (PRINL LIN) (READLN)) (IF LIN (TERPRA))) (PRIN " ;") (READLN))) (TERPRA) (STATUS PRINT 7) (SETQ PNUM 96 LRP () COMT () COMLI ()) (PT (CDR (FVAL NAME)) PNUM T) (TERP))) (PROGN (STATUS PRINT 0) (RMARGIN SVR) (LMARGIN SVL)) (SETQ LIN ()) LINECNT) (DE SAVEINI () (SETQ CPOS 77) (SAVE ISLIST LEN TO-BIG INSER PTLIST PT TERP TERPRA TERP2 TERP3 TERP4 RINNER2 RINNER CHANGEP PRETTY PRET SAVEINI))