CMUCL commit: intl-branch src (3 files)

[Raymond Toy]

    Date: Tuesday, February 9, 2010 @ 18:40:35
  Author: rtoy
    Path: /project/cmucl/cvsroot/src
     Tag: intl-branch

Modified: bootfiles/20a/boot-2010-02-1.lisp code/intl.lisp code/save.lisp

Make the search for the domain file if search lists aren't initialized
yet, since the default locale directories includes search lists.  This
prevents the search from failing if we need to print out an error
message early in the build/load process.

Could this be done in a better/different way?

code/save.lisp:
o Define *ENVIRONMENT-LIST-INITIALIZED*
o Set *ENVIRONMENT-LIST-INITIALIZED* to T after ENVIRONMENT-INIT has
  initialized everything.

code/intl.lisp:
o Make LOCATE-DOMAIN-FILE return NIL if the search lists aren't set up
  yet.  This allows translated strings to just use the non-translated
  version.

bootfiles/20a/boot-2010-02-1.lisp:
o Bootstrap *ENVIRONMENT-LIST-INITIALIZED*


-----------------------------------+
 bootfiles/20a/boot-2010-02-1.lisp |    1 
 code/intl.lisp                    |   42 ++++++++++++++++++++----------------
 code/save.lisp                    |    8 +++++-
 3 files changed, 31 insertions(+), 20 deletions(-)


Index: src/bootfiles/20a/boot-2010-02-1.lisp
diff -u src/bootfiles/20a/boot-2010-02-1.lisp:1.1.2.2 src/bootfiles/20a/boot-2010-02-1.lisp:1.1.2.3
--- src/bootfiles/20a/boot-2010-02-1.lisp:1.1.2.2	Mon Feb  8 11:28:20 2010
+++ src/bootfiles/20a/boot-2010-02-1.lisp	Tue Feb  9 18:40:35 2010
@@ -19,3 +19,4 @@
 (define-info-type typed-structure textdomain (or string null) nil)
 (define-info-type setf textdomain (or string null) nil)
 
+(defvar lisp::*environment-list-initialized* nil)
\ No newline at end of file
Index: src/code/intl.lisp
diff -u src/code/intl.lisp:1.1.2.6 src/code/intl.lisp:1.1.2.7
--- src/code/intl.lisp:1.1.2.6	Tue Feb  9 08:22:58 2010
+++ src/code/intl.lisp	Tue Feb  9 18:40:35 2010
@@ -1,6 +1,6 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*-
 
-;;; $Revision: 1.1.2.6 $
+;;; $Revision: 1.1.2.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/Attic/intl.lisp,v 1.1.2.6 2010-02-09 13:22:58 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/Attic/intl.lisp,v 1.1.2.7 2010-02-09 23:40:35 rtoy Exp $")
 
 (in-package "INTL")
 
@@ -80,22 +80,28 @@
      (the (unsigned-byte 8) (read-byte stream))))
 
 (defun locate-domain-file (domain locale locale-dir)
-  (flet ((path (locale base)
-	   (merge-pathnames (make-pathname :directory (list :relative locale
-							    "LC_MESSAGES")
-					   :name domain :type "mo")
-			    base)))
-    (let ((locale (or (gethash locale *locale-aliases*) locale)))
-      (dolist (base (if (listp locale-dir) locale-dir (list locale-dir)))
-	(let ((probe
-	       (or (probe-file (path locale base))
-		   (let ((dot (position #\. locale)))
-		     (and dot (probe-file (path (subseq locale 0 dot) base))))
-		   (let ((at (position #\@ locale)))
-		     (and at (probe-file (path (subseq locale 0 at) base))))
-		   (let ((us (position #\_ locale)))
-		     (and us (probe-file (path (subseq locale 0 us) base)))))))
-	  (when probe (return probe)))))))
+  ;; The default locale-dir includes search lists.  If we get called
+  ;; before the search lists are initialized, we lose.  The search
+  ;; lists are initialized in environment-init, which sets
+  ;; *environment-list-initialized*.  This way, we return NIL to
+  ;; indicate there's no domain file to use.
+  (when lisp::*environment-list-initialized*
+    (flet ((path (locale base)
+	     (merge-pathnames (make-pathname :directory (list :relative locale
+							      "LC_MESSAGES")
+					     :name domain :type "mo")
+			      base)))
+      (let ((locale (or (gethash locale *locale-aliases*) locale)))
+	(dolist (base (if (listp locale-dir) locale-dir (list locale-dir)))
+	  (let ((probe
+		 (or (probe-file (path locale base))
+		     (let ((dot (position #\. locale)))
+		       (and dot (probe-file (path (subseq locale 0 dot) base))))
+		     (let ((at (position #\@ locale)))
+		       (and at (probe-file (path (subseq locale 0 at) base))))
+		     (let ((us (position #\_ locale)))
+		       (and us (probe-file (path (subseq locale 0 us) base)))))))
+	    (when probe (return probe))))))))
 
 (defun find-encoding (domain)
   (when (null (domain-entry-encoding domain))
Index: src/code/save.lisp
diff -u src/code/save.lisp:1.65.4.1 src/code/save.lisp:1.65.4.2
--- src/code/save.lisp:1.65.4.1	Mon Feb  8 12:15:49 2010
+++ src/code/save.lisp	Tue Feb  9 18:40:35 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/save.lisp,v 1.65.4.1 2010-02-08 17:15:49 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/save.lisp,v 1.65.4.2 2010-02-09 23:40:35 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -38,6 +38,9 @@
 (defvar *environment-list* nil
   "An alist mapping environment variables (as keywords) to either values")
 
+(defvar *environment-list-initialized* nil
+  "Non-NIL if environment-init has been called")
+
 (defvar *editor-lisp-p* nil
   "This is true if and only if the lisp was started with the -edit switch.")
 
@@ -119,7 +122,8 @@
   (setf (search-list "ext-formats:")
 	'("library:ext-formats/"
 	  "target:i18n/"
-	  "target:pcl/simple-streams/external-formats/")))
+	  "target:pcl/simple-streams/external-formats/"))
+  (setq *environment-list-initialized* t))
 
 
 ;;;; SAVE-LISP itself.