Fixed.

[riece] / lisp / riece-mcat.el

diff --git a/lisp/riece-mcat.el b/lisp/riece-mcat.el
index 5babb5f..3155b5c 100644 (file)
--- a/lisp/riece-mcat.el
+++ b/lisp/riece-mcat.el
@@ -1,14 +1,41 @@
-(defvar riece-mcat-alist
-  '(("Japanese" . riece-mcat-japanese)))
+;;; riece-mcat.el --- message catalog
+;; Copyright (C) 2007 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+
+;; This file is part of Riece.
+
+;; 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., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Code:
+
+(require 'pp)
 
 (defun riece-mcat (string)
-  (let ((entry (assoc current-language-environment riece-mcat-alist)))
-    (when entry
-      (require (cdr entry))
-      (or (cdr (assoc string (symbol-value (intern
-                                           (concat (symbol-name (cdr entry))
-                                                   "-alist")))))
-         string))))
+  "Translate STRING in the current language environment."
+  (let ((feature (get-language-info current-language-environment
+                                   'riece-mcat-feature)))
+    (if feature
+       (progn
+         (require feature)
+         (or (cdr (assoc string
+                         (symbol-value
+                          (intern (concat (symbol-name feature) "-alist")))))
+             string))
+      string)))
 
 (defun riece-mcat-extract-from-form (form)
   (if (and form (listp form) (listp (cdr form)))
@@ -17,7 +44,7 @@
        (delq nil (apply #'nconc
                         (mapcar #'riece-mcat-extract-from-form form))))))
 
-(defun riece-mcat-extract (files alist)
+(defun riece-mcat-extract (files)
   (save-excursion
     (let (message-list)
       (while files
@@ -34,36 +61,53 @@
                         (riece-mcat-extract-from-form
                          (read (current-buffer)))))))
        (setq files (cdr files)))
-      (setq message-list (sort message-list #'string-lessp))
-      (while message-list
-       (if (equal (car message-list)
-                  (nth 1 message-list))
-           (setq message-list (nthcdr 2 message-list))
-         (unless (assoc (car message-list) alist)
-           (setq alist (cons (list (car message-list)) alist)))
-         (setq message-list (cdr message-list))))
-      alist)))
-
-(defun riece-mcat-update (files mcat-file mcat-alist)
-  (let (alist)
+      (setq message-list (sort message-list #'string-lessp)
+           pointer message-list)
+      (while pointer
+       (if (member (car pointer) (cdr pointer))
+           (setcar pointer nil))
+       (setq pointer (cdr pointer)))
+      (delq nil message-list))))
+
+(defun riece-mcat-update (files mcat-file mcat-alist-symbol)
+  "Update MCAT-FILE."
+  (let ((pp-escape-newlines t)
+       alist)
     (save-excursion
       (set-buffer (find-file-noselect mcat-file))
       (goto-char (point-min))
-      (re-search-forward (concat "^\\s-*(\\(defvar\\|defconst\\)\\s-+"
-                                (regexp-quote (symbol-name mcat-alist))))
-      (goto-char (match-beginning 0))
-      (save-excursion
-       (eval (read (current-buffer))))
-      (setq alist (riece-mcat-extract files (symbol-value mcat-alist)))
-      (delete-region (point) (progn (forward-sexp) (point)))
-      (insert "(defconst " (symbol-name mcat-alist) "\n  '(")
+      (if (re-search-forward (concat "^\\s-*(\\(defvar\\|defconst\\)\\s-+"
+                                    (regexp-quote (symbol-name
+                                                   mcat-alist-symbol)))
+                            nil t)
+         (progn
+           (goto-char (match-beginning 0))
+           (save-excursion
+             (eval (read (current-buffer))))
+           (delete-region (point) (progn (forward-sexp) (point))))
+       (set mcat-alist-symbol nil))
+      (setq alist (mapcar (lambda (message)
+                           (or (assoc message (symbol-name mcat-alist-symbol))
+                               (list message)))
+                         (riece-mcat-extract files)))
+      (insert "(defconst " (symbol-name mcat-alist-symbol) "\n  '(")
       (while alist
-       (insert "(" (prin1-to-string (car (car alist))) " . "
-               (prin1-to-string (cdr (car alist))) ")")
+       (insert "(" (pp-to-string (car (car alist))) " . "
+               (pp-to-string (cdr (car alist))) ")")
        (if (cdr alist)
-           (insert "\n   "))
+           (insert "\n    "))
        (setq alist (cdr alist)))
       (insert "))")
       (save-buffer))))
 
+(defconst riece-mcat-description "Translate messages")
+
+(defun riece-mcat-insinuate ()
+  (set-language-info "Japanese" 'riece-mcat-feature 'riece-mcat-japanese))
+
+(defun riece-mcat-uninstall ()
+  (set-language-info "Japanese" 'riece-mcat-feature nil))
+
 (provide 'riece-mcat)
+
+;;; riece-mcat.el ends here