[Cl-darcs-cvs] r58 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Mon Oct 16 04:39:52 2006
New Revision: 58

Modified:
   cl-darcs/trunk/patch-core.lisp
   cl-darcs/trunk/unreadable-stream.lisp
Log:
Use print-unreadable-object.


Modified: cl-darcs/trunk/patch-core.lisp
==============================================================================
--- cl-darcs/trunk/patch-core.lisp	(original)
+++ cl-darcs/trunk/patch-core.lisp	Mon Oct 16 04:39:52 2006
@@ -24,10 +24,8 @@
 	    :documentation "List of patches making up the composite patch.")))
 
 (defmethod print-object ((patch composite-patch) stream)
-  (if *print-readably*
-      (call-next-method)
-      (format stream "#<~A: ~W>"
-	      (type-of patch) (patches patch))))
+  (print-unreadable-object (patch stream :type t)
+    (write (patches patch) :stream stream)))
 
 (defclass split-patch (patch)
   ((patches :accessor patches :initarg :patches :initform ())))
@@ -37,8 +35,8 @@
   (:documentation "Base class for patches affecting a single file."))
 
 (defmethod print-object ((patch file-patch) stream)
-  (if *print-readably* (call-next-method)
-      (format stream "#<~A: ~A>" (type-of patch) (patch-filename patch))))
+  (print-unreadable-object (patch stream :type t)
+    (princ (patch-filename patch) stream)))
 
 (defclass hunk-patch (file-patch)
   ((line-number :accessor hunk-line-number :initarg :line-number
@@ -50,12 +48,12 @@
   (:documentation "A single patch \"hunk\"."))
 
 (defmethod print-object ((patch hunk-patch) stream)
-  (if *print-readably* (call-next-method)
-      (format stream "#<~A: ~A ~A~[~:;~:*-~A~]~[~:;~:*+~A~]>"
-	      (type-of patch) (patch-filename patch)
-	      (hunk-line-number patch)
-	      (length (hunk-old-lines patch))
-	      (length (hunk-new-lines patch)))))
+  (print-unreadable-object (patch stream :type t)
+    (format stream "~A ~A~[~:;~:*-~A~]~[~:;~:*+~A~]"
+	    (patch-filename patch)
+	    (hunk-line-number patch)
+	    (length (hunk-old-lines patch))
+	    (length (hunk-new-lines patch)))))
 
 (defclass add-file-patch (file-patch)
   ()
@@ -81,18 +79,19 @@
   (:documentation "A patch that replaces one token with another."))
 
 (defmethod print-object ((patch token-replace-patch) stream)
-  (if *print-readably* (call-next-method)
-      (format stream "#<~A: ~A: s/~A/~A/ (~S)>" (type-of patch) (patch-filename patch)
-	      (old-token patch) (new-token patch)
-	      (token-regexp patch))))
+  (print-unreadable-object (patch stream :type t)
+    (format stream "~A: s/~A/~A/ (~S)"
+	    (patch-filename patch)
+	    (old-token patch) (new-token patch)
+	    (token-regexp patch))))
 
 (defclass directory-patch (patch)
   ((directory :accessor patch-directory :initarg :directory))
   (:documentation "Base class for patches affecting a directory."))
 
 (defmethod print-object ((patch directory-patch) stream)
-  (if *print-readably* (call-next-method)
-      (format stream "#<~A: ~A>" (type-of patch) (patch-directory patch))))
+  (print-unreadable-object (patch stream :type t)
+    (princ (patch-directory patch) stream)))
 
 (defclass add-dir-patch (directory-patch)
   ()
@@ -112,14 +111,12 @@
   (:documentation "A named patch."))	;XXX: what does that mean?
 
 (defmethod print-object ((patch named-patch) stream)
-  (if *print-readably*
-      (call-next-method)
-      (let ((patchinfo (named-patch-patchinfo patch)))
-	(format stream "#<~A: ~A ~A: ~<~W~:>>"
-		(type-of patch)
-		(patchinfo-date patchinfo)
-		(patchinfo-name patchinfo)
-		(named-patch-patch patch)))))
+  (print-unreadable-object (patch stream :type t)
+    (let ((patchinfo (named-patch-patchinfo patch)))
+      (format stream "~A ~A: ~<~W~:>"
+	      (patchinfo-date patchinfo)
+	      (patchinfo-name patchinfo)
+	      (named-patch-patch patch)))))
 
 (defclass change-pref-patch (patch)
   ((pref :initarg :pref :accessor change-pref-which)
@@ -128,13 +125,11 @@
   (:documentation "A patch for changing a preference."))
 
 (defmethod print-object ((patch change-pref-patch) stream)
-  (if *print-readably*
-      (call-next-method)
-      (format stream "#<~A: ~A: s/~S/~S/>"
-	      (type-of patch)
-	      (change-pref-which patch)
-	      (change-pref-from patch)
-	      (change-pref-to patch))))
+  (print-unreadable-object (patch stream :type t)
+    (format stream "~A: s/~S/~S/"
+	    (change-pref-which patch)
+	    (change-pref-from patch)
+	    (change-pref-to patch))))
 
 (defclass move-patch (patch)
   ((from :initarg :from :accessor patch-move-from)
@@ -142,12 +137,10 @@
   (:documentation "A patch that moves a file."))
 
 (defmethod print-object ((patch move-patch) stream)
-  (if *print-readably*
-      (call-next-method)
-      (format stream "#<~A: ~A -> ~A>"
-	      (type-of patch)
-	      (patch-move-from patch)
-	      (patch-move-to patch))))
+  (print-unreadable-object (patch stream :type t)
+    (format stream "~A -> ~A"
+	    (patch-move-from patch)
+	    (patch-move-to patch))))
 
 ;; XXX: this class is probably incorrect and insufficient.
 (defclass merger-patch (patch)
@@ -159,14 +152,12 @@
    (unwindings :initarg :unwindings :accessor merger-unwindings)))
 
 (defmethod print-object ((patch merger-patch) stream)
-  (if *print-readably*
-      (call-next-method)
-      (format stream "#<~A ~:[(inverted) ~;~]~A: ~A ~A>"
-	      (type-of patch)
-	      (merger-inverted patch)
-	      (merger-version patch)
-	      (merger-first patch)
-	      (merger-second patch))))
+  (print-unreadable-object (patch stream :type t)
+    (format stream "~:[(inverted) ~;~]~A: ~A ~A"
+	    (merger-inverted patch)
+	    (merger-version patch)
+	    (merger-first patch)
+	    (merger-second patch))))
 
 ;; There are more kinds of patches... let's implement them when need
 ;; arises.

Modified: cl-darcs/trunk/unreadable-stream.lisp
==============================================================================
--- cl-darcs/trunk/unreadable-stream.lisp	(original)
+++ cl-darcs/trunk/unreadable-stream.lisp	Mon Oct 16 04:39:52 2006
@@ -190,5 +190,5 @@
 	(push (list 0 (length line) line :line) buffer))))
 
 (defmethod print-object ((object unreadable-stream) stream)
-  (if *print-readably* (call-next-method)
-      (format stream "#<~A ~A ~A>" (type-of object) (slot-value object 'buffer) (slot-value object 'stream))))
+  (print-unreadable-object (object stream :type t)
+    (format stream "~A ~A" (slot-value object 'buffer) (slot-value object 'stream))))