CMUCL commit: intl-branch src/pcl (cmucl-documentation.lisp)

[Raymond Toy]

    Date: Saturday, February 13, 2010 @ 09:25:00
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/pcl
     Tag: intl-branch

Modified: cmucl-documentation.lisp

Add :AROUND method to translate docstrings.  Translation for compiler
macros is not done, though.


--------------------------+
 cmucl-documentation.lisp |   28 +++++++++++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)


Index: src/pcl/cmucl-documentation.lisp
diff -u src/pcl/cmucl-documentation.lisp:1.16.32.4 src/pcl/cmucl-documentation.lisp:1.16.32.5
--- src/pcl/cmucl-documentation.lisp:1.16.32.4	Fri Feb 12 20:28:04 2010
+++ src/pcl/cmucl-documentation.lisp	Sat Feb 13 09:24:59 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.4 2010-02-13 01:28:04 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/pcl/cmucl-documentation.lisp,v 1.16.32.5 2010-02-13 14:24:59 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -216,6 +216,32 @@
   (set-random-documentation x doc-type new-value)
   new-value)
 
+;;; Define AROUND methods to translate the docstring.
+(macrolet
+    ((frob (dt)
+	`(defmethod documentation :around ((x t) (doc-type (eql ',dt)))
+	   (let ((doc (call-next-method))
+		 (domain (info ,dt :textdomain x)))
+	     (or (intl:dgettext domain doc)
+		 doc)))))
+  (frob function)
+  (frob setf)
+  (frob type)
+  (frob variable))
+
+(defmethod documentation ((x symbol) (doc-type (eql 'structure)))
+  (let ((doc (call-next-method))
+	(domain (cond ((eq (info type kind x) :instance)
+		       (values (info type textdomain x)))
+		      ((info typed-structure info x)
+		       (values (info typed-structure textdomain x)))
+		      (t
+		       nil))))
+    (or (intl:dgettext domain doc)
+	doc)))
+
+  
+
 ;;; Replace the minimal documentation function with the PCL version
 ;;; when loaded.
 (eval-when (:load-toplevel)