* gettext.el (bind-text-domain): Implement a catalog probe mechanism.

(Implemented by YAMASHITA Junji <ysjj@unixuser.org>)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 01b7abe..a1494c4 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2002-02-17  OHASHI Akira  <bg66@koka-in.org>
+
+       * gettext.el (bind-text-domain): Implement a catalog probe mechanism.
+       (Implemented by YAMASHITA Junji <ysjj@unixuser.org>)
+
 2002-02-12  Daiki Ueno  <ueno@unixuser.org>
 
        * liece-modules.el (liece-modules-to-compile): Add `liece-coding'.

diff --git a/lisp/gettext.el b/lisp/gettext.el
index a23a7d5..cee7312 100644 (file)
--- a/lisp/gettext.el
+++ b/lisp/gettext.el
@@ -233,9 +233,30 @@ Here's how the path to message files is constructed under SunOS 5.0:
   {pathname}/{LANG}/LC_MESSAGES/{domain}.mo
 \[XEmacs I18N level 3 emulating function]"
     (let* ((lang (getenv "LANG"))
+          (language (progn
+                      (string-match "\\([^_.]+\\)\\(_[^.]+\\)?\\(\\.[^@]+\\)?"
+                                    lang)
+                      (match-string 1 lang)))
+          (territory (match-string 2 lang))
+          (code-set (match-string 3 lang))
+          (lang-path (if lang
+                         (delq nil (list language
+                                         (if code-set
+                                             (concat language code-set))
+                                         (if territory
+                                             (concat language territory))
+                                         (if (and territory code-set)
+                                             (concat language territory code-set))))))
+          
           (file (concat domain ".mo"))
-          (catalog (expand-file-name
-                    file (concat pathname "/" lang "/LC_MESSAGES"))))
+          catalog)
+      (while (and (setq lang (car lang-path))
+                 (setq catalog
+                       (expand-file-name file
+                                         (concat pathname
+                                                 "/" lang "/LC_MESSAGES")))
+                 (not (file-exists-p catalog)))
+       (setq lang-path (cdr lang-path)))
       (when (file-exists-p catalog)
        ;;(file-exists-p (setq catalog (expand-file-name file pathname)))
        (push (cons domain catalog) gettext-message-domain-to-catalog-alist))))