CMUCL commit: intl-branch src/pcl (cmucl-documentation.lisp)
Raymond Toy
rtoy at common-lisp.net
Mon Feb 8 23:18:43 CET 2010
Date: Monday, February 8, 2010 @ 17:18:43
Author: rtoy
Path: /project/cmucl/cvsroot/src/pcl
Tag: intl-branch
Modified: cmucl-documentation.lisp
Only do debugging output if the docstring is non-nil.
--------------------------+
cmucl-documentation.lisp | 22 +++++++++++++++-------
1 file changed, 15 insertions(+), 7 deletions(-)
Index: src/pcl/cmucl-documentation.lisp
diff -u src/pcl/cmucl-documentation.lisp:1.16.32.1 src/pcl/cmucl-documentation.lisp:1.16.32.2
--- src/pcl/cmucl-documentation.lisp:1.16.32.1 Mon Feb 8 11:41:41 2010
+++ src/pcl/cmucl-documentation.lisp Mon Feb 8 17:18:42 2010
@@ -4,7 +4,7 @@
;;; the public domain, and is provided 'as is'.
(file-comment
- "$Header: /project/cmucl/cvsroot/src/pcl/cmucl-documentation.lisp,v 1.16.32.1 2010-02-08 16:41:41 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/pcl/cmucl-documentation.lisp,v 1.16.32.2 2010-02-08 22:18:42 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -46,32 +46,40 @@
(simple-program-error "Invalid function name ~s" x))
(if (eq 'setf (cadr x))
(progn
- (format t "Setting function ~S domain to ~A~%"
- (cadr x) intl::*default-domain*)
+ (when new-value
+ (format t "Setting function ~S domain to ~A~%"
+ (cadr x) intl::*default-domain*))
(setf (info setf textdomain (cadr x)) intl::*default-domain*)
(setf (info setf documentation (cadr x)) new-value))
(progn
+ (when new-value
+ (format t "Setting function ~S domain to ~A~%"
+ (cadr x) intl::*default-domain*))
(setf (info function textdomain x) intl::*default-domain*)
(setf (info function documentation x) new-value)))
new-value)
(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'function)))
- (format t "Setting function ~S domain to ~A~%" x intl::*default-domain*)
+ (when new-value
+ (format t "Setting function ~S domain to ~A~%" x intl::*default-domain*))
(setf (info function textdomain x) intl::*default-domain*)
(setf (info function documentation x) new-value))
(defmethod (setf documentation) (new-value (x function) (doc-type (eql 'function)))
- (format t "Setting function ~S domain to ~A~%" x intl::*default-domain*)
+ (when new-value
+ (format t "Setting function ~S domain to ~A~%" x intl::*default-domain*))
(setf (info function textdomain x) intl::*default-domain*)
(setf (info function documentation x) new-value))
(defmethod (setf documentation) (new-value (x function) (doc-type (eql 't)))
- (format t "Setting function ~S domain to ~A~%" x intl::*default-domain*)
+ (when new-value
+ (format t "Setting function ~S domain to ~A~%" x intl::*default-domain*))
(setf (info function textdomain x) intl::*default-domain*)
(setf (info function documentation x) new-value))
(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'setf)))
- (format t "Setting setf function ~S domain to ~A~%" x intl::*default-domain*)
+ (when new-value
+ (format t "Setting setf function ~S domain to ~A~%" x intl::*default-domain*))
(setf (info setf textdomain x) intl::*default-domain*)
(setf (info setf documentation x) new-value))
More information about the cmucl-commit
mailing list