Plaster

text
CL-USER> (defun pprint-defclass (stream object) (flet ((pprint-function-call (stream object) (pprint-logical-block (stream object :prefix "(" :suffix ")") (pprint-exit-if-list-exhausted) (write (pprint-pop) :stream stream) (pprint-exit-if-list-exhausted) (write-char #\Space stream) (pprint-indent :current 0 stream) (loop (write (pprint-pop) :stream stream) (pprint-exit-if-list-exhausted) (write-char #\Space stream) (pprint-newline :fill stream))))) (pprint-logical-block (stream object :prefix "(" :suffix ")") (pprint-exit-if-list-exhausted) (write (pprint-pop) :stream stream) (pprint-exit-if-list-exhausted) (pprint-indent :block 3 stream) (write-char #\Space stream) (pprint-newline :miser stream) (write (pprint-pop) :stream stream) ;; superclasses (pprint-exit-if-list-exhausted) (write-char #\Space stream) (pprint-newline :fill stream) (pprint-fill stream (pprint-pop) t) (pprint-exit-if-list-exhausted) (pprint-indent :block 1 stream) (write-char #\Space stream) (pprint-newline :linear stream) ;; slots (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")") (pprint-exit-if-list-exhausted) (loop do (pprint-function-call stream (pprint-pop)) (pprint-exit-if-list-exhausted) (write-char #\Space stream) (pprint-newline :linear stream))) ;; options (pprint-exit-if-list-exhausted) (pprint-newline :linear stream) (loop do (pprint-function-call stream (pprint-pop)) (pprint-exit-if-list-exhausted) (write-char #\Space stream) (pprint-newline :linear stream))))) PPRINT-DEFCLASS CL-USER> (set-pprint-dispatch '(cons (eql defclass)) #'pprint-defclass 10) NIL CL-USER> (pprint '(defclass panel-search (clog-panel) ((search-button :reader search-button) (grep-input :reader grep-input) (dir-input :reader dir-input) (result-box :reader result-box) (result-grid :reader result-grid)))) (DEFCLASS PANEL-SEARCH (CLOG-PANEL) ((SEARCH-BUTTON :READER SEARCH-BUTTON) (GREP-INPUT :READER GREP-INPUT) (DIR-INPUT :READER DIR-INPUT) (RESULT-BOX :READER RESULT-BOX) (RESULT-GRID :READER RESULT-GRID))) ; No value