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 (defvar riece-mcat-alist
  26   '(("Japanese" . riece-mcat-japanese)))
  27
  28 (defun riece-mcat (string)
  29   (let ((entry (assoc current-language-environment riece-mcat-alist)))
  30     (when entry
  31       (require (cdr entry))
  32       (or (cdr (assoc string (symbol-value (intern
  33                                             (concat (symbol-name (cdr entry))
  34                                                     "-alist")))))
  35           string))))
  36
  37 (defun riece-mcat-extract-from-form (form)
  38   (if (and form (listp form) (listp (cdr form)))
  39       (if (eq (car form) 'riece-mcat)
  40           (cdr form)
  41         (delq nil (apply #'nconc
  42                          (mapcar #'riece-mcat-extract-from-form form))))))
  43
  44 (defun riece-mcat-extract (files alist)
  45   (save-excursion
  46     (let (message-list)
  47       (while files
  48         (with-temp-buffer
  49           (insert-file-contents (car files))
  50           (goto-char (point-min))
  51           (while (progn
  52                    (while (progn (skip-chars-forward " \t\n\f")
  53                                  (looking-at ";"))
  54                      (forward-line 1))
  55                    (not (eobp)))
  56             (setq message-list
  57                   (nconc message-list
  58                          (riece-mcat-extract-from-form
  59                           (read (current-buffer)))))))
  60         (setq files (cdr files)))
  61       (setq message-list (sort message-list #'string-lessp))
  62       (while message-list
  63         (if (equal (car message-list)
  64                    (nth 1 message-list))
  65             (setq message-list (nthcdr 2 message-list))
  66           (unless (assoc (car message-list) alist)
  67             (setq alist (cons (list (car message-list)) alist)))
  68           (setq message-list (cdr message-list))))
  69       alist)))
  70
  71 (defun riece-mcat-update (files mcat-file mcat-alist)
  72   (let (alist)
  73     (save-excursion
  74       (set-buffer (find-file-noselect mcat-file))
  75       (goto-char (point-min))
  76       (if (re-search-forward (concat "^\\s-*(\\(defvar\\|defconst\\)\\s-+"
  77                                      (regexp-quote (symbol-name mcat-alist)))
  78                              nil t)
  79           (progn
  80             (goto-char (match-beginning 0))
  81             (save-excursion
  82               (eval (read (current-buffer))))
  83             (delete-region (point) (progn (forward-sexp) (point))))
  84         (set mcat-alist nil))
  85       (setq alist (riece-mcat-extract files (symbol-value mcat-alist)))
  86       (insert "(defconst " (symbol-name mcat-alist) "\n  '(")
  87       (while alist
  88         (insert "(" (prin1-to-string (car (car alist))) " . "
  89                 (prin1-to-string (cdr (car alist))) ")")
  90         (if (cdr alist)
  91             (insert "\n    "))
  92         (setq alist (cdr alist)))
  93       (insert "))")
  94       (save-buffer))))
  95
  96 (provide 'riece-mcat)
  97
  98 ;;; riece-mcat.el ends here