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