From 1c2c4a45206860e842df4662125ce02f4c5d87b7 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Tue, 14 Dec 2004 23:57:12 +0000
Subject: [PATCH] Add a pprinter for defgeneric.

---
 code/pprint.lisp | 61 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 60 insertions(+), 1 deletion(-)

diff --git a/code/pprint.lisp b/code/pprint.lisp
index 139e2d42f..f2c0ec6fa 100644
--- a/code/pprint.lisp
+++ b/code/pprint.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.50 2004/10/22 16:56:38 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.51 2004/12/14 23:57:12 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1534,6 +1534,63 @@
        (pprint-newline :mandatory stream)
        (output-object (pprint-pop) stream))))
 
+(defun pprint-defgeneric (stream list &rest noise)
+  (declare (ignore noise))
+  (pprint-logical-block (stream list :prefix "(" :suffix ")")
+    ;; DEFGENERIC
+    (output-object (pprint-pop) stream)
+    (pprint-exit-if-list-exhausted)
+    (pprint-indent :block 2 stream)
+    (write-char #\space stream)
+    ;; Output class-name
+    (output-object (pprint-pop) stream)
+    (pprint-exit-if-list-exhausted)
+    (pprint-newline :fill stream)
+    (write-char #\space stream)
+    ;; Output lambda list
+    (pprint-lambda-list stream (pprint-pop))
+    (pprint-indent :block 1 stream)
+    ;;(pprint-newline :linear stream)
+    ;; Output options and stuff
+    (loop
+       (pprint-exit-if-list-exhausted)
+       (pprint-newline :mandatory stream)
+       (let ((option-or-method (pprint-pop)))
+	 ;; Try to print the various options neatly.  Right now, we
+	 ;; just handle :method
+	 (cond ((and (consp option-or-method)
+		     (eq (car option-or-method) :method))
+		(flet
+		    ((almost-defmethod (stream list)
+		       (pprint-logical-block (stream list :prefix "(" :suffix ")")
+			 ;; :method
+			 (output-object (pprint-pop) stream)
+			 (pprint-exit-if-list-exhausted)
+			 ;; Print out all qualifiers then the lambda list
+			 (loop
+			    (let ((qual-or-lambda (pprint-pop)))
+			      (write-char #\space stream)
+			      (cond ((listp qual-or-lambda)
+				     ;; Print out lambda-list
+				     (pprint-lambda-list stream qual-or-lambda)
+				     (return))
+				    (t
+				     (output-object qual-or-lambda stream)))
+			      (pprint-exit-if-list-exhausted)))
+			 ;; Rest of the forms
+			 (pprint-newline :mandatory stream)
+			 (pprint-indent :block 0 stream)
+			 (loop
+			    (write-char #\space stream)
+			    (output-object (pprint-pop) stream)
+			    (pprint-exit-if-list-exhausted)
+			    (pprint-newline :linear stream)))))
+		  (almost-defmethod stream option-or-method)))
+	       (t
+		(output-object option-or-method stream)))))))
+
+  
+
 (defun pprint-defpackage (stream list &rest noise)
   (declare (ignore noise))
   (funcall (formatter "~:<~W ~W~I~@{~@:_ ~:<~@{~W~^~:I~@{ ~W~^~:_~}~}~:>~}~:>")
@@ -1542,9 +1599,11 @@
 (defun pprint-defmethod (stream list &rest noise)
   (declare (ignore noise))
   (pprint-logical-block (stream list :prefix "(" :suffix ")")
+    ;; DEFMETHOD
     (output-object (pprint-pop) stream)
     (pprint-exit-if-list-exhausted)
     (write-char #\space stream)
+    ;; Method name
     (output-object (pprint-pop) stream)
     (pprint-exit-if-list-exhausted)
     ;; Print out method qualifiers, if any
-- 
GitLab