diff --git a/bootfiles/20a/boot-2010-07-1.lisp b/bootfiles/20a/boot-2010-07-1.lisp index 557ded2661b28f976e684bf27e673452556bbf9f..a7d1c710024f038fec13314cd6beba49d99a3941 100644 --- a/bootfiles/20a/boot-2010-07-1.lisp +++ b/bootfiles/20a/boot-2010-07-1.lisp @@ -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) + ,@body + (setf intl::*default-domain* "cmucl"))) +) diff --git a/code/exports.lisp b/code/exports.lisp index 465582e29e93dc17bcc98a4d05a81375cc0912b9..e40aaf3c095f683b975c11f24ea9e4700045c654 100644 --- a/code/exports.lisp +++ b/code/exports.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.298 2010/07/12 13:58:42 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/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") diff --git a/code/intl.lisp b/code/intl.lisp index 414dc5f4e981580e729ae664b4afed015b2e76e8..804af7a1638a5035d579cebc4739072a540e99f3 100644 --- a/code/intl.lisp +++ b/code/intl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*- -;;; $Revision: 1.6 $ +;;; $Revision: 1.7 $ ;;; Copyright 1999-2010 Paul Foley (mycroft@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: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/intl.lisp,v 1.6 2010/04/20 17:57:44 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/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)) + ,@body))) + (defmacro gettext (string) "Look up STRING in the current message domain and return its translation." `(dgettext ,*default-domain* ,string)) diff --git a/code/signal.lisp b/code/signal.lisp index 30156af91107df1aa08330e1ef229bd22df76c73..1f42660d50399360f1cafa19a29b03b5470e5bb8 100644 --- a/code/signal.lisp +++ b/code/signal.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.39 2010/04/20 17:57:45 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/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 ;;;