From b72fead6a5f1916e114828e9e6a7544abd76612c Mon Sep 17 00:00:00 2001
From: ueno <ueno>
Date: Fri, 19 Jan 2007 05:29:50 +0000
Subject: [PATCH] * 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.

---
 lisp/COMPILE       |   25 ++++++++++++++++--
 lisp/ChangeLog     |   10 ++++++++
 lisp/Makefile.am   |    3 +++
 lisp/riece-mcat.el |   72 ++++++++++++++++++++++++++++++++++------------------
 4 files changed, 83 insertions(+), 27 deletions(-)

diff --git a/lisp/COMPILE b/lisp/COMPILE
index bf60599..61a65e0 100644
--- 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
--- 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
--- 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
--- 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)
-- 
1.7.10.4