CMUCL commit: intl-branch src/code (describe.lisp)

Raymond Toy rtoy at common-lisp.net
Tue Feb 9 03:43:38 CET 2010


    Date: Monday, February 8, 2010 @ 21:43:38
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/code
     Tag: intl-branch

Modified: describe.lisp

Translate the docstring in the domain specified by the
symbol/function. 


---------------+
 describe.lisp |   18 +++++++++++++++---
 1 file changed, 15 insertions(+), 3 deletions(-)


Index: src/code/describe.lisp
diff -u src/code/describe.lisp:1.54.2.2 src/code/describe.lisp:1.54.2.3
--- src/code/describe.lisp:1.54.2.2	Mon Feb  8 15:21:44 2010
+++ src/code/describe.lisp	Mon Feb  8 21:43:38 2010
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/code/describe.lisp,v 1.54.2.2 2010-02-08 20:21:44 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/describe.lisp,v 1.54.2.3 2010-02-09 02:43:38 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -225,10 +225,22 @@
 ;;;
 (defun desc-doc (name kind kind-doc)
   (when (and name (typep name '(or symbol cons)))
-    (let ((doc (documentation name kind)))
+    (let ((doc (documentation name kind))
+	  (domain (case kind
+		    (variable
+		     (info variable textdomain name))
+		    (function
+		     (info function textdomain name))
+		    (structure
+		     (info typed-structure textdomain name))
+		    (type
+		     (info type textdomain name))
+		    (setf
+		     (info setf textdomain name)))))
       (when doc
 	(format t _"~&~@(~A documentation:~)~&  ~A"
-		(or kind-doc kind) doc)))))
+		(or kind-doc kind)
+		(dgettext domain doc))))))
 
 
 ;;; DESCRIBE-FUNCTION-NAME  --  Internal



More information about the cmucl-commit mailing list