1 (defvar riece-mcat-alist
2 '(("Japanese" . riece-mcat-japanese)))
4 (defun riece-mcat (string)
5 (let ((entry (assoc current-language-environment riece-mcat-alist)))
8 (or (cdr (assoc string (symbol-value (intern
9 (concat (symbol-name (cdr entry))
13 (defun riece-mcat-extract-from-form (form)
14 (if (and form (listp form) (listp (cdr form)))
15 (if (eq (car form) 'riece-mcat)
17 (delq nil (apply #'nconc
18 (mapcar #'riece-mcat-extract-from-form form))))))
20 (defun riece-mcat-extract (files alist)
25 (insert-file-contents (car files))
26 (goto-char (point-min))
28 (while (progn (skip-chars-forward " \t\n\f")
34 (riece-mcat-extract-from-form
35 (read (current-buffer)))))))
36 (setq files (cdr files)))
37 (setq message-list (sort message-list #'string-lessp))
39 (if (equal (car message-list)
41 (setq message-list (nthcdr 2 message-list))
42 (unless (assoc (car message-list) alist)
43 (setq alist (cons (list (car message-list)) alist)))
44 (setq message-list (cdr message-list))))
47 (defun riece-mcat-update (files mcat-file mcat-alist)
50 (set-buffer (find-file-noselect mcat-file))
51 (goto-char (point-min))
52 (re-search-forward (concat "^\\s-*(\\(defvar\\|defconst\\)\\s-+"
53 (regexp-quote (symbol-name mcat-alist))))
54 (goto-char (match-beginning 0))
56 (eval (read (current-buffer))))
57 (setq alist (riece-mcat-extract files (symbol-value mcat-alist)))
58 (delete-region (point) (progn (forward-sexp) (point)))
59 (insert "(defconst " (symbol-name mcat-alist) "\n '(")
61 (insert "(" (prin1-to-string (car (car alist))) " . "
62 (prin1-to-string (cdr (car alist))) ")")
65 (setq alist (cdr alist)))