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

[riece] / lisp / riece-mcat.el

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)
          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)
       (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
       (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)
 
 (provide 'riece-mcat)