-(defvar riece-mcat-alist
- '(("Japanese" . riece-mcat-japanese)))
+;;; riece-mcat.el --- message catalog -*- lexical-binding: t -*-
+;; 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 (if (featurep 'mule)
+ (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)))
- (if (eq (car form) 'riece-mcat)
+ (if (and (= (length form) 2)
+ (eq (car form) 'riece-mcat)
+ (stringp (car (cdr form))))
(cdr form)
(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)
+ (let (message-list pointer)
(while files
(with-temp-buffer
(insert-file-contents (car files))
(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)
- (save-excursion
- (set-buffer (find-file-noselect mcat-file))
+ (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)
+ (with-current-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-value 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