From 08df7f2c0e152ebcde1ce143fafbf092b3a8f533 Mon Sep 17 00:00:00 2001 From: Daiki 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 + + * 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 * 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) -- 2.25.1