From bf0b283a184a075a88358ed1d305c19ea6338ed5 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Tue, 13 Jul 2010 23:43:39 +0000
Subject: [PATCH] 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 | 32 +++++++++++++++++--------------
 code/exports.lisp                 |  5 +++--
 code/intl.lisp                    | 11 +++++++++--
 code/signal.lisp                  | 27 ++++++++++++++++++++------
 4 files changed, 51 insertions(+), 24 deletions(-)

diff --git a/bootfiles/20a/boot-2010-07-1.lisp b/bootfiles/20a/boot-2010-07-1.lisp
index 557ded266..a7d1c7100 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 465582e29..e40aaf3c0 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 414dc5f4e..804af7a16 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 30156af91..1f42660d5 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
 ;;;
-- 
GitLab