CMUCL commit: src (3 files)
Raymond Toy
rtoy at common-lisp.net
Wed Jul 14 05:13:20 CEST 2010
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"))
More information about the cmucl-commit
mailing list