From: bg66 <bg66>
Date: Sun, 17 Feb 2002 05:26:15 +0000 (+0000)
Subject: * gettext.el (bind-text-domain): Implement a catalog probe mechanism.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=0ef6dcf18b7c5a81843a3a83b44fcbcbf8b3e714;p=elisp%2Fliece.git

* 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
--- 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
--- 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))))