CMUCL commit: src (3 files)

[Raymond Toy]

    Date: Tuesday, July 13, 2010 @ 23:13:20
  Author: rtoy
    Path: /project/cmucl/cvsroot/src

Modified: bootfiles/20a/boot-2010-07-1.lisp code/intl.lisp code/signal.lisp

Oops.  Previous implementation of with-textdomain didn't actually
work.  Use this new one.

code/intl.lisp:
o New WITH-TEXTDOMAIN.

code/signal.lisp:
o Update uses of WITH-TEXTDOMAIN.

bootfiles/20a/boot-2010-07-1.lisp:
o Update with new WITH-TEXTDOMAIN.


-----------------------------------+
 bootfiles/20a/boot-2010-07-1.lisp |   12 ++++--------
 code/intl.lisp                    |   13 +++++++------
 code/signal.lisp                  |   26 +++++++++++++-------------
 3 files changed, 24 insertions(+), 27 deletions(-)


Index: src/bootfiles/20a/boot-2010-07-1.lisp
diff -u src/bootfiles/20a/boot-2010-07-1.lisp:1.2 src/bootfiles/20a/boot-2010-07-1.lisp:1.3
--- src/bootfiles/20a/boot-2010-07-1.lisp:1.2	Tue Jul 13 19:43:39 2010
+++ src/bootfiles/20a/boot-2010-07-1.lisp	Tue Jul 13 23:13:20 2010
@@ -26,13 +26,9 @@
 
 (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)
+(defmacro with-textdomain ((old-domain new-domain) &body body)
+  `(progn
+     (intl:textdomain ,new-domain)
      , at body
-     (setf intl::*default-domain* "cmucl")))
+     (intl:textdomain ,old-domain)))
 )
Index: src/code/intl.lisp
diff -u src/code/intl.lisp:1.7 src/code/intl.lisp:1.8
--- src/code/intl.lisp:1.7	Tue Jul 13 19:43:39 2010
+++ src/code/intl.lisp	Tue Jul 13 23:13:20 2010
@@ -1,6 +1,6 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*-
 
-;;; $Revision: 1.7 $
+;;; $Revision: 1.8 $
 ;;; 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.7 2010-07-13 23:43:39 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.8 2010-07-14 03:13:20 rtoy Exp $")
 
 (in-package "INTL")
 
@@ -527,10 +527,11 @@
 
 ;; 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 with-textdomain ((old-domain new-domain) &body body)
+  `(progn
+     (intl:textdomain ,new-domain)
+     , at body
+     (intl:textdomain ,old-domain)))
 
 (defmacro gettext (string)
   "Look up STRING in the current message domain and return its translation."
Index: src/code/signal.lisp
diff -u src/code/signal.lisp:1.40 src/code/signal.lisp:1.41
--- src/code/signal.lisp:1.40	Tue Jul 13 19:43:39 2010
+++ src/code/signal.lisp	Tue Jul 13 23:13:20 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.40 2010-07-13 23:43:39 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/signal.lisp,v 1.41 2010-07-14 03:13:20 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -103,9 +103,9 @@
 (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")
+(intl::with-textdomain ("cmucl" #+linux "cmucl-linux-os"
+				#+sparc "cmucl-sparc-svr4"
+				#+bsd "cmucl-bsd-os")
 #-linux
 (def-unix-signal :SIGEMT 7 "Emt instruction"))
 
@@ -114,18 +114,18 @@
 (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")
+(intl::with-textdomain ("cmucl" #+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 :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")
+(intl::with-textdomain ("cmucl" #+linux "cmucl-linux-os"
+				#+sparc "cmucl-sparc-svr4"
+				#+bsd "cmucl-bsd-os")
 #+linux
 (def-unix-signal :SIGSTKFLT 16 "Stack fault on coprocessor"))
 
@@ -162,9 +162,9 @@
   #+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")
+(intl::with-textdomain ("cmucl" #+linux "cmucl-linux-os"
+				#+sparc "cmucl-sparc-svr4"
+				#+bsd "cmucl-bsd-os")
 #+svr4
 (def-unix-signal :SIGWAITING 32 "Process's lwps are blocked"))