* riece-mcat.el (riece-mcat-update): New function.

* Makefile.am (update-mcat): New target.
* COMPILE (riece-modules): Moved riece-mcat-japanese.el to
riece-mcat-modules.
(riece-mcat-modules): New variable.
(riece-examine-modules): Append riece-mcat-modules.
(riece-update-mcat): New function.

diff --git a/lisp/COMPILE b/lisp/COMPILE
index bf60599..61a65e0 100644 (file)
--- a/lisp/COMPILE
+++ b/lisp/COMPILE
@@ -49,8 +49,10 @@
 
                riece-commands
                riece-irc
-               riece
-               riece-mcat-japanese))))
+               riece))))
+
+(defvar riece-mcat-modules
+  '(riece-mcat-japanese))
 
 (defvar riece-icons
   '("riece-command-quit.xpm"
@@ -147,13 +149,32 @@
 
 (defun riece-examine-modules ()
   (let ((load-path (cons nil load-path)))
+    (require 'riece-mcat)
     (require 'riece-addon-modules)
     (append riece-modules
+           riece-mcat-modules
            (mapcar #'car riece-addon-modules))))
 
 (defun riece-examine ()
   (princ (mapconcat #'symbol-name (riece-examine-modules) " ")))
 
+(defun riece-update-mcat ()
+  (let ((modules (riece-examine-modules))
+       (pointer riece-mcat-modules)
+       files)
+    (while pointer
+      (setq modules (delq (car pointer) modules)
+           pointer (cdr pointer)))
+    (setq files (mapcar (lambda (module)
+                         (concat (symbol-name module) ".el"))
+                       modules)
+         pointer riece-mcat-modules)
+    (while pointer
+      (riece-mcat-update files (concat (symbol-name (car pointer)) ".el")
+                        (intern (concat (symbol-name (car pointer))
+                                        "-alist")))
+      (setq pointer (cdr pointer)))))
+
 (defun riece-compile ()
   (riece-compile-modules (riece-examine-modules)))
 

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 420ecd8..220859b 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2007-01-19  Daiki Ueno  <ueno@unixuser.org>
+
+       * riece-mcat.el (riece-mcat-update): New function.
+       * Makefile.am (update-mcat): New target.
+       * COMPILE (riece-modules): Moved riece-mcat-japanese.el to
+       riece-mcat-modules.
+       (riece-mcat-modules): New variable.
+       (riece-examine-modules): Append riece-mcat-modules.
+       (riece-update-mcat): New function.
+
 2007-01-18  Daiki Ueno  <ueno@unixuser.org>
 
        * riece-mcat.el: New file.

diff --git a/lisp/Makefile.am b/lisp/Makefile.am
index 429f6f2..c01a6be 100644 (file)
--- a/lisp/Makefile.am
+++ b/lisp/Makefile.am
@@ -53,3 +53,6 @@ compile-individually:
                $(EMACS) $(FLAGS) -l COMPILE \
                        -f riece-compile-module $$i; \
        done
+
+update-mcat:
+       $(EMACS) $(FLAGS) -l COMPILE -f riece-update-mcat

diff --git a/lisp/riece-mcat.el b/lisp/riece-mcat.el
index 99cfc9e..c2de26f 100644 (file)
--- a/lisp/riece-mcat.el
+++ b/lisp/riece-mcat.el
@@ -11,37 +11,59 @@
          string))))
 
 (defun riece-mcat-extract-from-form (form)
-  (if (and form (listp form))
+  (if (and form (listp form) (listp (cdr form)))
       (if (eq (car form) 'riece-mcat)
          (cdr form)
        (delq nil (apply #'nconc
                         (mapcar #'riece-mcat-extract-from-form form))))))
 
 (defun riece-mcat-extract (files alist)
-  (let (message-list pointer)
-    (while files
+  (save-excursion
+    (let (message-list)
+      (while files
+       (with-temp-buffer
+         (insert-file-contents (car files))
+         (goto-char (point-min))
+         (while (progn
+                  (while (progn (skip-chars-forward " \t\n\f")
+                                (looking-at ";"))
+                    (forward-line 1))
+                  (not (eobp)))
+           (setq message-list
+                 (nconc message-list
+                        (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))
+      (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
-       (set-buffer (find-file-noselect (car files)))
-       (goto-char (point-min))
-       (while (progn
-            (while (progn (skip-chars-forward " \t\n\f")
-                          (looking-at ";"))
-              (forward-line 1))
-            (not (eobp)))
-         (setq message-list
-               (nconc message-list
-                      (riece-mcat-extract-from-form
-                       (read (current-buffer)))))))
-      (setq files (cdr files)))
-    (setq message-list (sort message-list #'string-lessp)
-         pointer message-list)
-    (while pointer
-      (if (equal (car pointer)
-                (nth 1 pointer))
-         (setcdr pointer (nthcdr 2 pointer))
-       (unless (assoc (car pointer) alist)
-         (setq alist (cons (list (car pointer)) alist))))
-      (setq pointer (cdr pointer)))
-    alist))
+       (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  '(")
+      (while alist
+       (insert "(" (prin1-to-string (car (car alist))) " . "
+               (prin1-to-string (cdr (car alist))) ")")
+       (if (cdr alist)
+           (insert "\n  "))
+       (setq alist (cdr alist)))
+      (insert "))")
+      (save-buffer))))
 
 (provide 'riece-mcat)