1 ;;; riece-mcat.el --- message catalog -*- lexical-binding: t -*-
2 ;; Copyright (C) 2007 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
6 ;; This file is part of Riece.
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
20 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 ;; Boston, MA 02110-1301, USA.
27 (defun riece-mcat (string)
28 "Translate STRING in the current language environment."
29 (let ((feature (if (featurep 'mule)
30 (get-language-info current-language-environment
31 'riece-mcat-feature))))
35 (or (cdr (assoc string
37 (intern (concat (symbol-name feature) "-alist")))))
41 (defun riece-mcat-extract-from-form (form)
42 (if (and form (listp form) (listp (cdr form)))
43 (if (and (= (length form) 2)
44 (eq (car form) 'riece-mcat)
45 (stringp (car (cdr form))))
47 (delq nil (apply #'nconc
48 (mapcar #'riece-mcat-extract-from-form form))))))
50 (defun riece-mcat-extract (files)
52 (let (message-list pointer)
55 (insert-file-contents (car files))
56 (goto-char (point-min))
58 (while (progn (skip-chars-forward " \t\n\f")
64 (riece-mcat-extract-from-form
65 (read (current-buffer)))))))
66 (setq files (cdr files)))
67 (setq message-list (sort message-list #'string-lessp)
70 (if (member (car pointer) (cdr pointer))
72 (setq pointer (cdr pointer)))
73 (delq nil message-list))))
75 (defun riece-mcat-update (files mcat-file mcat-alist-symbol)
77 (let ((pp-escape-newlines t)
79 (with-current-buffer (find-file-noselect mcat-file)
80 (goto-char (point-min))
81 (if (re-search-forward (concat "^\\s-*(\\(defvar\\|defconst\\)\\s-+"
82 (regexp-quote (symbol-name
86 (goto-char (match-beginning 0))
88 (eval (read (current-buffer))))
89 (delete-region (point) (progn (forward-sexp) (point))))
90 (set mcat-alist-symbol nil))
91 (setq alist (mapcar (lambda (message)
93 (symbol-value mcat-alist-symbol))
95 (riece-mcat-extract files)))
96 (insert "(defconst " (symbol-name mcat-alist-symbol) "\n '(")
98 (insert "(" (pp-to-string (car (car alist))) " . "
99 (pp-to-string (cdr (car alist))) ")")
102 (setq alist (cdr alist)))
106 (defconst riece-mcat-description "Translate messages.")
108 (defun riece-mcat-insinuate ()
109 (set-language-info "Japanese" 'riece-mcat-feature 'riece-mcat-japanese))
111 (defun riece-mcat-uninstall ()
112 (set-language-info "Japanese" 'riece-mcat-feature nil))
114 (provide 'riece-mcat)
116 ;;; riece-mcat.el ends here