cgit.sxemacs.org Git - riece/blob - lisp/riece-mcat.el

   1 ;;; riece-mcat.el --- message catalog
   2 ;; Copyright (C) 2007 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5
   6 ;; This file is part of Riece.
   7
   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)
  11 ;; any later version.
  12
  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.
  17
  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.
  22
  23 ;;; Code:
  24
  25 (require 'pp)
  26
  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))))
  32     (if feature
  33         (progn
  34           (require feature)
  35           (or (cdr (assoc string
  36                           (symbol-value
  37                            (intern (concat (symbol-name feature) "-alist")))))
  38               string))
  39       string)))
  40
  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))))
  46           (cdr form)
  47         (delq nil (apply #'nconc
  48                          (mapcar #'riece-mcat-extract-from-form form))))))
  49
  50 (defun riece-mcat-extract (files)
  51   (save-excursion
  52     (let (message-list pointer)
  53       (while files
  54         (with-temp-buffer
  55           (insert-file-contents (car files))
  56           (goto-char (point-min))
  57           (while (progn
  58                    (while (progn (skip-chars-forward " \t\n\f")
  59                                  (looking-at ";"))
  60                      (forward-line 1))
  61                    (not (eobp)))
  62             (setq message-list
  63                   (nconc message-list
  64                          (riece-mcat-extract-from-form
  65                           (read (current-buffer)))))))
  66         (setq files (cdr files)))
  67       (setq message-list (sort message-list #'string-lessp)
  68             pointer message-list)
  69       (while pointer
  70         (if (member (car pointer) (cdr pointer))
  71             (setcar pointer nil))
  72         (setq pointer (cdr pointer)))
  73       (delq nil message-list))))
  74
  75 (defun riece-mcat-update (files mcat-file mcat-alist-symbol)
  76   "Update MCAT-FILE."
  77   (let ((pp-escape-newlines t)
  78         alist)
  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
  83                                                     mcat-alist-symbol)))
  84                              nil t)
  85           (progn
  86             (goto-char (match-beginning 0))
  87             (save-excursion
  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)
  92                             (or (assoc message
  93                                        (symbol-value mcat-alist-symbol))
  94                                 (list message)))
  95                           (riece-mcat-extract files)))
  96       (insert "(defconst " (symbol-name mcat-alist-symbol) "\n  '(")
  97       (while alist
  98         (insert "(" (pp-to-string (car (car alist))) " . "
  99                 (pp-to-string (cdr (car alist))) ")")
 100         (if (cdr alist)
 101             (insert "\n    "))
 102         (setq alist (cdr alist)))
 103       (insert "))")
 104       (save-buffer))))
 105
 106 (defconst riece-mcat-description "Translate messages.")
 107
 108 (defun riece-mcat-insinuate ()
 109   (set-language-info "Japanese" 'riece-mcat-feature 'riece-mcat-japanese))
 110
 111 (defun riece-mcat-uninstall ()
 112   (set-language-info "Japanese" 'riece-mcat-feature nil))
 113
 114 (provide 'riece-mcat)
 115
 116 ;;; riece-mcat.el ends here