Re: IRC client for Emacs

[Daiki Ueno <ueno@unixuser.org>]

[-- Attachment #1: Type: text/plain, Size: 940 bytes --]

>>>>> In <20020821193900.557945.FMU965@piglet.prv.splode.com> 
>>>>>	Noah Friedman <friedman@splode.com> wrote:

> Persistent hashtables might be useful for other things (such as BBDB), so
> they seem worth considering for reasons beyond localization.

Why don't you consider reading *.mo files themselves?  Even now gettext
0.11.5 has a support to Emacs Lisp.  I have used my gettext.el for that
purpose in my IRC client (Liece) for several years.

Here is the example:

;; Before evaluating the following expressions, it is needed to run
;; ./prepare.sh (attached below) to generate prog.mo in the current
;; directory and to type M-x load-file gettext.el (also, attached below).

(setenv "LANG" "fr")
=> "fr"

(bind-text-domain "prog" ".")
=> (("prog" . "/home/ueno/fr/LC_MESSAGES/prog.mo"))

(dgettext "prog" "'Your command, please?', asked the waiter.")
=> "«Votre commande, s'il vous plait», dit le garçon."


[-- Attachment #2: prepare.sh --]
[-- Type: text/plain, Size: 429 bytes --]

cat <<EOF > fr.po
msgid ""
msgstr ""
"Content-Type: text/plain; charset=ISO-8859-1\n"
"Plural-Forms: nplurals=2; plural=(n > 1);\n"

msgid "'Your command, please?', asked the waiter."
msgstr "«Votre commande, s'il vous plait», dit le garçon."

# Reverse the arguments.
#, elisp-format
msgid "%s is replaced by %s."
msgstr "%2$s remplace %1$s."
EOF

mkdir -p fr/LC_MESSAGES
msgfmt -o fr/LC_MESSAGES/prog.mo fr.po

[-- Attachment #3: gettext.el --]
[-- Type: application/octet-stream, Size: 7125 bytes --]

;;; gettext.el --- GNU gettext interface
;; Copyright (C) 1999-2002 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; Keywords: i18n

;; This file is not part of any package.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Code:

(defvar gettext-gmo-endian 1234)
(defvar gettext-message-domain-to-catalog-alist nil)
(defvar gettext-default-message-domain "emacs")
(defvar gettext-default-mime-charset 'x-ctext)
(defvar gettext-default-locale "C")

(defconst gettext-msgid-regexp "msgid\\s-*\"")
(defconst gettext-msgstr-regexp "msgstr\\s-*\"")

(defvar gettext-mime-charset-coding-system-alist
  (let ((coding-systems (coding-system-list 'base-only))
	mime-charset alist)
    (while coding-systems
      (if (and (setq mime-charset
		     (coding-system-get (car coding-systems) 'mime-charset))
	       (not (assq mime-charset alist)))
	  (setq alist (cons (cons mime-charset (car coding-systems)) alist)))
      (setq coding-systems (cdr coding-systems)))
    alist))

(defmacro gettext-hex-char-to-integer (character)
  `(if (and (>= ,character ?0) (<= ,character ?9))
       (- ,character ?0)
     (let ((ch (logior ,character 32)))
       (if (and (>= ch ?a) (<= ch ?f))
	   (- ch (- ?a 10))
	 (error "Invalid hex digit `%c'" ch)))))

(defun gettext-hex-string-to-integer (hex-string)
  (let ((hex-num 0))
    (while (not (equal hex-string ""))
      (setq hex-num (+ (* hex-num 16)
		       (gettext-hex-char-to-integer
			(string-to-char hex-string)))
	    hex-string (substring hex-string 1)))
    hex-num))

(defun gettext-gmo-read-32bit-word ()
  (let ((word (string-to-list (buffer-substring (point) (+ (point) 4)))))
    (forward-char 4)
    (apply #'format "%02x%02x%02x%02x"
	   (mapcar (lambda (ch) (logand 255 ch))
		   (if (= gettext-gmo-endian 1234)
		       (nreverse word)
		     word)))))
    
(defmacro gettext-gmo-header-revision (header)
  `(aref header 0))

(defmacro gettext-gmo-header-nn (header)
  `(aref header 1))

(defmacro gettext-gmo-header-oo (header)
  `(aref header 2))

(defmacro gettext-gmo-header-tt (header)
  `(aref header 3))

(defmacro gettext-gmo-header-ss (header)
  `(aref header 4))

(defmacro gettext-gmo-header-hh (header)
  `(aref header 5))

(defmacro gettext-gmo-read-header ()
  (cons 'vector
	(make-list 6 '(gettext-hex-string-to-integer
		       (gettext-gmo-read-32bit-word)))))

(defun gettext-gmo-collect-strings (nn)
  (let (strings pos len off)
    (dotimes (i nn)
      (setq len (gettext-hex-string-to-integer
		 (gettext-gmo-read-32bit-word))
	    off (gettext-hex-string-to-integer
		 (gettext-gmo-read-32bit-word))
	    pos (point))
      (goto-char (1+ off))
      (push (buffer-substring (point) (+ (point) len))
	    strings)
      (goto-char pos))
    (nreverse strings)))

(defun gettext-read-mime-charset (&optional header)
  "Return the MIME charset of PO file."
  (with-temp-buffer
    (insert header)
    (goto-char (point-min))
    (let ((case-fold-search t))
      (if (re-search-forward
	   "^\"Content-Type: *text/plain;[ \t]*charset=\\([^\\]+\\)"
	   nil t)
	  (intern (downcase
		   (buffer-substring (match-beginning 1) (match-end 1))))))))

(defun gettext-mapcar* (function &rest args)
  "Apply FUNCTION to successive cars of all ARGS.
Return the list of results."
  (let (result)
    (while (not (memq nil args))
      (push (apply function (mapcar #'car args)) result)
      (setq args (mapcar #'cdr args)))
    (nreverse result)))

(defun gettext-load-message-catalogue (file)
  (with-temp-buffer
    (let ((coding-system-for-read 'binary)
	  header strings charset coding-system gettext-obarray oott)
      (insert-file-contents file)
      (set-buffer-multibyte nil)
      (goto-char (point-min))
      (when (looking-at "\x95\x04\x12\xde")
	(setq gettext-gmo-endian 4321))
      (forward-char 4)
      (setq header (gettext-gmo-read-header)
	    strings
	    (gettext-mapcar* #'cons
			     (progn
			       (goto-char (1+ (gettext-gmo-header-oo header)))
			       (gettext-gmo-collect-strings
				(gettext-gmo-header-nn header)))
			     (progn
			       (goto-char (1+ (gettext-gmo-header-tt header)))
			       (gettext-gmo-collect-strings
				(gettext-gmo-header-nn header))))
	    charset (or (gettext-read-mime-charset
			 (cdr (assoc "" strings)))
			gettext-default-mime-charset)
	    gettext-obarray (make-vector
			     (* 2 (gettext-gmo-header-nn header))
			     0))
      (unless (setq coding-system
		    (cdr (assq charset
			       gettext-mime-charset-coding-system-alist)))
	(error "Unknown MIME-charset is used in `%s'" file))
      (while strings
	(set (intern (car (car strings)) gettext-obarray)
	     (decode-coding-string (cdr (car strings)) coding-system))
	(setq strings (cdr strings)))
      gettext-obarray)))

;;;###autoload
(defun dgettext (domain string)
  "Look up STRING in the default message domain and return its translation."
  (let ((oott (assoc domain gettext-message-domain-to-catalog-alist)))
    (when (stringp (cdr oott))
      (setcdr oott (gettext-load-message-catalogue
		    (cdr oott))))
    (or (symbol-value
	 (intern-soft string (or (cdr oott) (make-vector 1 0))))
	string)))

;;;###autoload
(defun gettext (string)
  "Look up STRING in the default message domain and return its translation."
  (dgettext gettext-default-message-domain string))

;;;###autoload
(defun bind-text-domain (domain pathname)
  "Associate a pathname with a message domain."
  (let* ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") (getenv "LANG")
		   gettext-default-locale))
	 (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 (if (and territory code-set)
					    (concat language territory
						    code-set))
					(if territory
					    (concat language territory))
					(if code-set
					    (concat language code-set))
					language))))
	 (file (concat domain ".mo"))
	 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))))

(provide 'gettext)

;;; gettext.el ends here

[-- Attachment #4: Type: text/plain, Size: 15 bytes --]

-- 
Daiki Ueno