From a735122e2a7e97813fe2184bc364443ea2b0d0c7 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Wed, 14 Apr 2010 16:39:52 +0000 Subject: [PATCH] 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 | 19 ++++++++++--------- tools/build-utils.sh | 2 ++ tools/build-world.sh | 3 +++ 4 files changed, 19 insertions(+), 13 deletions(-) diff --git a/code/exports.lisp b/code/exports.lisp index 0d719df6d..0009d3592 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.294 2010/03/19 15:18:58 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/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") diff --git a/code/intl.lisp b/code/intl.lisp index b899cec5e..3ba665648 100644 --- a/code/intl.lisp +++ b/code/intl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: INTL -*- -;;; $Revision: 1.2 $ +;;; $Revision: 1.3 $ ;;; 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.2 2010/03/19 15:18:59 rtoy Exp $") +(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/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) diff --git a/tools/build-utils.sh b/tools/build-utils.sh index 7c464b101..ac9717109 100755 --- a/tools/build-utils.sh +++ b/tools/build-utils.sh @@ -23,6 +23,8 @@ $TARGET/lisp/lisp \ (setf (ext:search-list "target:") '("$TARGET/" "src/")) +(setf *default-pathname-defaults* (ext:default-directory)) +(intl:install) (load "target:setenv") (pushnew :no-clx *features*) diff --git a/tools/build-world.sh b/tools/build-world.sh index 27201d705..ac9fde74a 100755 --- a/tools/build-world.sh +++ b/tools/build-world.sh @@ -30,6 +30,9 @@ $LISP "$@" -noinit -nositeinit <<EOF ;;(setf lisp::*enable-package-locked-errors* nil) +(setf *default-pathname-defaults* (ext:default-directory)) +(intl::install) + (setf (ext:search-list "target:") '("$TARGET/" "src/")) -- GitLab