indenting new macros (code indenting via pretty-printer)

[bha <@ada3.ca.boeing.com:bha@gumby.boeing.com>]

> I know about fi:lisp-indent-hook, but I'm looking to modify the code
> generated by the "not-so-pretty" printer, e.g. 
> 
> (with-open-file (stream ...)
>    (write '(defun foo (bletch)
>                 (when *foo*
>                    (let*-non-null ...)))
>      :stream stream
>      :escape t
>      :pretty t))
> 
> where let*-non-null is a locally defined macro. Come to think about it,
> looks like none of the macros (defun, let) get indented right; so maybe
> the answer to this is to write my own code pretty-printer :-(. Well, nobody
> dies, it's just hard to read ;-)
> 
> Thanks for any pointers/clues.
> 
> Brad Miller
> miller@cs.rochester.edu

Have you tried pprint and friends?  Here is something that I hacked
together to pretty print CMU defsystem forms for a defsystem editor
that I hacked together in CLIM.  Just arrange to have the form pretty
printed to you open stream.  For defun and other lisp stuff pprint
should do the trick if you get it setup correctly.

I always wanted a pretty printer that worked on the ASCII source code
rather than the Lisp list data structure.  Preserves case and comments
you know.  Something like the ACL indent region stuff in GNU Emacs but
the ability to get the output to a file.  One could do this with
appropriate GNU Emacs Lisp code and even arrange to use GNU Emacs as a
batch indentation program - just some SMOPS.  Seems as if this would
be a generally useful extension to the fi stuff - eh Franz?

Anyways, here is the pprint code:

================================================================================

;;; Pretty print defsystem forms using CL pprint facility.
;;; This *has* to be done in a fixed pitch font to work correctly.
(defun pprint-defsystem (form &optional (stream *standard-output*))
  (let ((*standard-output* stream))

    (pprint-logical-block (nil form :prefix "(" :suffix ")")

      ;; defsystem
      (write (pprint-pop))
      (pprint-exit-if-list-exhausted)
      (write-char #\space)

      ;; <name>
      (write (pprint-pop))
      (pprint-exit-if-list-exhausted)

      (pprint-indent :block 1)
      (pprint-newline :mandatory)

      ;; system keyword/value pairs...
      (pprint-component1 (cddr form))
      )))

(defun pprint-components (form &optional (stream *standard-output*))
  (let ((*standard-output* stream))

    ;; We are passed a list of component specifications.
    ;; Print each component specification in the list as a block.
    (pprint-logical-block (nil form :prefix "(" :suffix ")")
      (loop
	  do
	    (pprint-component (pprint-pop))

	    ;; No more components to process?
	    (pprint-exit-if-list-exhausted)
	    
	    ;; Each component list starts on a new line.
	    (pprint-newline :mandatory)))))
		     
(defun pprint-component (form &optional (stream *standard-output*))
  (let ((*standard-output* stream))

    ;; Each component specification is a list of keyword/value pairs.
    ;; Print pairs in a block.
    (pprint-logical-block (nil form :prefix "(" :suffix ")")
      (pprint-component1 form stream))))

(defun pprint-component1 (form &optional (stream *standard-output*))
  (let ((*standard-output* stream))
    (pprint-logical-block (nil form)
      (loop
	  with key
	  with value
	  do
	    ;; Keyword...
	    (setf key (pprint-pop))
	    (write key)
	    (pprint-exit-if-list-exhausted) ;in case malformed...
	    (write-char #\space)
	    
	    ;; Value...
	    (setf value (pprint-pop))
	    (if (eq key :components)
		;; Print components list...
		(pprint-components value)
	      (write value))
	    
	    ;; Any more keyword/value pairs to process?
	    (pprint-exit-if-list-exhausted)
	    
	    ;; Each keyword/value pair appears on a new line.
	    (pprint-newline :mandatory)))))
  
;;; ----------------------------------------------------------------------

;;; A test of the pretty printer...

(defun pptest ()
  (pprint-defsystem '(mk:defsystem foo
		      :source-pathname "abc"
		      :binary-pathname "def"
		      :depends-on (a b c)
		      :components ((:file "abc"
				    :source-pathname "abc"
				    :binary-pathname "def"
				    :package mk
				    :components ((:file "xyz"
							:source-pathname "def"
							:binary-pathname "xyz"
							:package mk)
						 (:file "nnn"
							:source-pathname "111"
							:package ids)))
				   (:file "def"
				    :source-pathname "def"
				    :binary-pathname "def"
				    :components ((:file "nnnxyz"
							:source-pathname "nnndef"
							:binary-pathname "nnnxyz"
							:package mk)
						 (:file "nnn"
							:source-pathname "111"
							:package ids))
				    :package mk)))))

================================================================================

ba

Brian H. Anderson                     (206) 234-0881
Boeing Commercial Airplane Co.        bha@gumby.boeing.com
P.O. Box 3707 M.S. 6A-PX
Seattle, Wa. 98124-2207