CMUCL commit: src (4 files)

[Raymond Toy]

    Date: Wednesday, April 14, 2010 @ 12:39:53
  Author: rtoy
    Path: /project/cmucl/cvsroot/src

Modified: code/exports.lisp code/intl.lisp tools/build-utils.sh
          tools/build-world.sh

code/intl.lisp:
o When saving the file name, use *compile-file-truename* instead of
  *compile-file-pathname*.  Also use enough-namestring to make a
  shorter name.  The file names that were placed in the pot file
  included search-lists which aren't understood by anything besides
  CMUCL.
o Don't install the reader macros by default anymore.
o Change INSTALL to accept an optional readtable that is modified with
  the reader macros and such.

code/exports.lisp:
o Export INTL::INSTALL.

tools/build-world.sh:
tools/build-utils.sh:
o Need to install the reader macros when building so we can get
  generate the pot files.
o Set *default-pathname-defaults* to be the (full) current build
  directory so that the pathnames in the pot file are relative to the
  build directory.

These changes fix the main part of Ticket #39.


----------------------+
 code/exports.lisp    |    8 ++++----
 code/intl.lisp       |   16 +++++++---------
 tools/build-utils.sh |    2 ++
 tools/build-world.sh |    3 +++
 4 files changed, 16 insertions(+), 13 deletions(-)


Index: src/code/exports.lisp
diff -u src/code/exports.lisp:1.294 src/code/exports.lisp:1.295
--- src/code/exports.lisp:1.294	Fri Mar 19 11:18:58 2010
+++ src/code/exports.lisp	Wed Apr 14 12:39:51 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/exports.lisp,v 1.294 2010-03-19 15:18:58 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/code/exports.lisp,v 1.295 2010-04-14 16:39:51 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -592,9 +592,9 @@
 
 (defpackage "INTL"
   (:use "COMMON-LISP")
-  (:export "SETLOCALE" "TEXTDOMAIN" "GETTEXT" "DGETTEXT" "NGETTEXT" "DNGETTEXT"
-           "*TRANSLATABLE-DUMP-STREAM*" "READ-TRANSLATABLE-STRING"
-	   "*LOCALE-DIRECTORIES*"))
+  (:export "*LOCALE-DIRECTORIES*" "*TRANSLATABLE-DUMP-STREAM*" "DGETTEXT" "DNGETTEXT"
+	   "GETTEXT" "INSTALL" "NGETTEXT" "READ-TRANSLATABLE-STRING" "SETLOCALE"
+	   "TEXTDOMAIN"))
 
 (defpackage "LISP"
   (:use "COMMON-LISP" "EXTENSIONS" "KERNEL" "SYSTEM" "DEBUG" "BIGNUM" "INTL")
Index: src/code/intl.lisp
diff -u src/code/intl.lisp:1.2 src/code/intl.lisp:1.3
--- src/code/intl.lisp:1.2	Fri Mar 19 11:18:59 2010
+++ src/code/intl.lisp	Wed Apr 14 12:39:52 2010
@@ -1,6 +1,6 @@
 ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*-
 
-;;; $Revision: 1.2 $
+;;; $Revision: 1.3 $
 ;;; 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.2 2010-03-19 15:18:59 rtoy Exp $")
+(ext:file-comment "$Header: /project/cmucl/cvsroot/src/code/intl.lisp,v 1.3 2010-04-14 16:39:52 rtoy Exp $")
 
 (in-package "INTL")
 
@@ -569,7 +569,7 @@
 	   (key (if plural (cons string plural) string))
 	   (val (or (gethash key hash) (cons nil nil))))
       (pushnew *translator-comment* (car val) :test #'equal)
-      (pushnew *compile-file-pathname* (cdr val) :test #'equal)
+      (pushnew (enough-namestring *compile-file-truename*) (cdr val) :test #'equal)
       ;; FIXME: How does this happen?  Need to figure this out and get
       ;; rid of this!
       (unless key
@@ -596,7 +596,6 @@
     (case (peek-char nil stream nil nil t)
       (#\" (let* ((*read-suppress* nil)
 		  (string (read stream t nil t)))
-	     #-runtime
 	     (note-translatable *default-domain* string)
 	     `(gettext ,string)))
       (#\N (read-char stream t nil t)
@@ -676,12 +675,12 @@
 	   (vector-push-extend prev text))))
   (values))
 
-(defun install ()
-  (set-macro-character #\_ #'read-translatable-string t)
+(defun install (&optional (rt *readtable*))
+  (set-macro-character #\_ #'read-translatable-string t rt)
   #-runtime
-  (set-macro-character #\; #'read-comment)
+  (set-macro-character #\; #'read-comment nil rt)
   #-runtime
-  (set-dispatch-macro-character #\# #\| #'read-nested-comment)
+  (set-dispatch-macro-character #\# #\| #'read-nested-comment rt)
   t)
 
 
@@ -812,4 +811,6 @@
 		   (fdefinition 'intl:read-translatable-string)))
     (set-syntax-from-char #\_ #\_)))
 
-(install)
\ No newline at end of file
+;; Don't install the reader macros by default.
+#+(or)
+(install)
Index: src/tools/build-utils.sh
diff -u src/tools/build-utils.sh:1.4 src/tools/build-utils.sh:1.5
--- src/tools/build-utils.sh:1.4	Wed Nov 12 10:04:25 2008
+++ src/tools/build-utils.sh	Wed Apr 14 12:39:52 2010
@@ -23,6 +23,8 @@
 (setf (ext:search-list "target:")
       '("$TARGET/" "src/"))
 
+(setf *default-pathname-defaults* (ext:default-directory))
+(intl:install)
 (load "target:setenv")
 
 (pushnew :no-clx *features*)
Index: src/tools/build-world.sh
diff -u src/tools/build-world.sh:1.5 src/tools/build-world.sh:1.6
--- src/tools/build-world.sh:1.5	Fri Mar 19 11:19:03 2010
+++ src/tools/build-world.sh	Wed Apr 14 12:39:52 2010
@@ -30,6 +30,9 @@
 
 ;;(setf lisp::*enable-package-locked-errors* nil)
 
+(setf *default-pathname-defaults* (ext:default-directory))
+(intl::install)
+
 (setf (ext:search-list "target:")
       '("$TARGET/" "src/"))