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))))