CMUCL commit: src (4 files)
Raymond Toy
rtoy at common-lisp.net
Wed Jul 14 01:43:39 CEST 2010
Date: Tuesday, July 13, 2010 @ 19:43:39
Author: rtoy
Path: /project/cmucl/cvsroot/src
Modified: bootfiles/20a/boot-2010-07-1.lisp code/exports.lisp code/intl.lisp
code/signal.lisp
Some docstrings in signal.lisp were conditionalized for different
features and causes the translated string to be included or removed
from cmucl.pot. To help make this consistent, we put the
system-dependent strings in the system-dependent pot files.
bootfiles/20a/boot-2010-07-1.lisp:
o Add a fake definition for with-textdomain so we can bootstrap the
changes.
o Removed a defstruct that was already commented out.
code/exports.lisp:
o Export WITH-TEXTDOMAIN.
code/intl.lisp:
o Add macro WITH-TEXTDOMAIN to temporarily bind the textdomain to the
desired domain for the body, and restoring the original domain
afterwards.
code/signal.lisp:
o Wrap the system-specific items in WITH-TEXTDOMAIN so they are placed
in the system-dependent text domain.
-----------------------------------+
bootfiles/20a/boot-2010-07-1.lisp | 14 --------------
code/exports.lisp | 5 +++--
code/intl.lisp | 11 +++++++++--
code/signal.lisp | 27 +++++++++++++++++++++------
4 files changed, 33 insertions(+), 24 deletions(-)
Index: src/bootfiles/20a/boot-2010-07-1.lisp
diff -u src/bootfiles/20a/boot-2010-07-1.lisp:1.1 src/bootfiles/20a/boot-2010-07-1.lisp:1.2
--- src/bootfiles/20a/boot-2010-07-1.lisp:1.1 Mon Jul 12 09:58:42 2010
+++ src/bootfiles/20a/boot-2010-07-1.lisp Tue Jul 13 19:43:39 2010
@@ -4,19 +4,6 @@
(in-package "STREAM")
(ext:without-package-locks
- (handler-bind ((error (lambda (c)
- (declare (ignore c))
- (invoke-restart 'kernel::clobber-it))))
- #+nil
- (defstruct efx
- (octets-to-code #'%efni :type function :read-only t)
- (code-to-octets #'%efni :type function :read-only t)
- (flush-state nil :type (or null function) :read-only t)
- (copy-state nil :type (or null function) :read-only t)
- (cache nil :type (or null simple-vector))
- (min 1 :type kernel:index :read-only t)
- (max 1 :type kernel:index :read-only t)
- (documentation nil :type (or null string) :read-only t)))
(handler-bind ((error (lambda (c)
(declare (ignore c))
@@ -31,4 +18,21 @@
(composingp (ext:required-argument) :type boolean :read-only t)
(slots #() :type simple-vector :read-only t)
(slotd nil :type list :read-only t)
- (documentation nil :type (or null string) :read-only t))))
\ No newline at end of file
+ (documentation nil :type (or null string) :read-only t))))
+
+(in-package "INTL")
+
+(export '(with-textdomain))
+
+(ext:without-package-locks
+
+ ;; Not the same as the definition in intl.lisp, but this works
+ ;; around a bootstrap issue. It's good enough until the real
+ ;; definition is in place.
+
+(defmacro with-textdomain ((new-domain) &body body)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf intl::*default-domain* ,new-domain)
+ , at body
+ (setf intl::*default-domain* "cmucl")))
+)
Index: src/code/exports.lisp
diff -u src/code/exports.lisp:1.298 src/code/exports.lisp:1.299
--- src/code/exports.lisp:1.298 Mon Jul 12 09:58:42 2010
+++ src/code/exports.lisp Tue Jul 13 19:43:39 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/exports.lisp,v 1.298 2010-07-12 13:58:42 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/exports.lisp,v 1.299 2010-07-13 23:43:39 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -594,7 +594,8 @@
(:use "COMMON-LISP")
(:export "*LOCALE-DIRECTORIES*" "DGETTEXT" "DNGETTEXT"
"GETTEXT" "INSTALL" "NGETTEXT" "READ-TRANSLATABLE-STRING" "SETLOCALE"
- "TEXTDOMAIN" "TRANSLATION-ENABLE" "TRANSLATION-DISABLE"))
+ "TEXTDOMAIN" "TRANSLATION-ENABLE" "TRANSLATION-DISABLE"
+ "WITH-TEXTDOMAIN"))
(defpackage "LISP"
(:use "COMMON-LISP" "EXTENSIONS" "KERNEL" "SYSTEM" "DEBUG" "BIGNUM" "INTL")
Index: src/code/intl.lisp
diff -u src/code/intl.lisp:1.6 src/code/intl.lisp:1.7
--- src/code/intl.lisp:1.6 Tue Apr 20 13:57:44 2010
+++ src/code/intl.lisp Tue Jul 13 19:43:39 2010
@@ -1,6 +1,6 @@
;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*-
-;;; $Revision: 1.6 $
+;;; $Revision: 1.7 $
;;; Copyright 1999-2010 Paul Foley (mycroft at actrix.gen.nz)
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining
@@ -23,7 +23,7 @@
;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
;;; DAMAGE.
-(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.6 2010-04-20 17:57:44 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.7 2010-07-13 23:43:39 rtoy Exp $")
(in-package "INTL")
@@ -525,6 +525,13 @@
`(eval-when (:compile-toplevel :execute)
(setf *default-domain* ,domain)))
+;; Set the textdomain to New-Domain for the body and then restore the
+;; domain to the original.
+(defmacro with-textdomain ((new-domain) &body body)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (let ((intl::*default-domain* ,new-domain))
+ , at body)))
+
(defmacro gettext (string)
"Look up STRING in the current message domain and return its translation."
`(dgettext ,*default-domain* ,string))
Index: src/code/signal.lisp
diff -u src/code/signal.lisp:1.39 src/code/signal.lisp:1.40
--- src/code/signal.lisp:1.39 Tue Apr 20 13:57:45 2010
+++ src/code/signal.lisp Tue Jul 13 19:43:39 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/signal.lisp,v 1.39 2010-04-20 17:57:45 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/signal.lisp,v 1.40 2010-07-13 23:43:39 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -103,19 +103,32 @@
(def-unix-signal :SIGTRAP 5 "Trace trap")
(def-unix-signal :SIGIOT 6 "Iot instruction") ; Compatibility
(def-unix-signal :SIGABRT 6 "C abort()")
+(intl::with-textdomain (#+linux "cmucl-linux-os"
+ #+sparc "cmucl-sparc-svr4"
+ #+bsd "cmucl-bsd-os")
#-linux
-(def-unix-signal :SIGEMT 7 "Emt instruction")
+(def-unix-signal :SIGEMT 7 "Emt instruction"))
+
+
(def-unix-signal :SIGFPE 8 "Floating point exception")
(def-unix-signal :SIGKILL 9 "Kill")
(def-unix-signal :SIGBUS #-linux 10 #+linux 7 "Bus error")
(def-unix-signal :SIGSEGV 11 "Segmentation violation")
+(intl::with-textdomain (#+linux "cmucl-linux-os"
+ #+sparc "cmucl-sparc-svr4"
+ #+bsd "cmucl-bsd-os")
#-linux
-(def-unix-signal :SIGSYS 12 "Bad argument to system call")
+(def-unix-signal :SIGSYS 12 "Bad argument to system call"))
+
(def-unix-signal :SIGPIPE 13 "Write on a pipe with no one to read it")
(def-unix-signal :SIGALRM 14 "Alarm clock")
(def-unix-signal :SIGTERM 15 "Software termination signal")
+(intl::with-textdomain (#+linux "cmucl-linux-os"
+ #+sparc "cmucl-sparc-svr4"
+ #+bsd "cmucl-bsd-os")
#+linux
-(def-unix-signal :SIGSTKFLT 16 "Stack fault on coprocessor")
+(def-unix-signal :SIGSTKFLT 16 "Stack fault on coprocessor"))
+
(def-unix-signal :SIGURG #+svr4 21 #-(or hpux svr4 linux) 16 #+hpux 29
#+linux 23 "Urgent condition present on socket")
(def-unix-signal :SIGSTOP #-(or hpux svr4 linux) 17 #+hpux 24 #+svr4 23
@@ -149,9 +162,11 @@
#+linux 12 "User defined signal 2")
;;; SVR4 (or Solaris?) specific signals
+(intl::with-textdomain (#+linux "cmucl-linux-os"
+ #+sparc "cmucl-sparc-svr4"
+ #+bsd "cmucl-bsd-os")
#+svr4
-(def-unix-signal :SIGWAITING 32 "Process's lwps are blocked")
-
+(def-unix-signal :SIGWAITING 32 "Process's lwps are blocked"))
;;; SIGMASK -- Public
;;;
More information about the cmucl-commit
mailing list