-(defun riece-mcat-extract (files alist)
- (let (message-list pointer)
- (while files
- (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))
+(defun riece-mcat-extract (files)
+ (save-excursion
+ (let (message-list pointer)
+ (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)
+ pointer message-list)
+ (while pointer
+ (if (member (car pointer) (cdr pointer))
+ (setcar pointer nil))
+ (setq pointer (cdr pointer)))
+ (delq nil message-list))))
+
+(defun riece-mcat-update (files mcat-file mcat-alist-symbol)
+ "Update MCAT-FILE."
+ (let ((pp-escape-newlines t)
+ alist)
+ (save-excursion
+ (set-buffer (find-file-noselect mcat-file))
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^\\s-*(\\(defvar\\|defconst\\)\\s-+"
+ (regexp-quote (symbol-name
+ mcat-alist-symbol)))
+ nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (save-excursion
+ (eval (read (current-buffer))))
+ (delete-region (point) (progn (forward-sexp) (point))))
+ (set mcat-alist-symbol nil))
+ (setq alist (mapcar (lambda (message)
+ (or (assoc message
+ (symbol-value mcat-alist-symbol))
+ (list message)))
+ (riece-mcat-extract files)))
+ (insert "(defconst " (symbol-name mcat-alist-symbol) "\n '(")
+ (while alist
+ (insert "(" (pp-to-string (car (car alist))) " . "
+ (pp-to-string (cdr (car alist))) ")")
+ (if (cdr alist)
+ (insert "\n "))
+ (setq alist (cdr alist)))
+ (insert "))")
+ (save-buffer))))
+
+(defconst riece-mcat-description "Translate messages")
+
+(defun riece-mcat-insinuate ()
+ (set-language-info "Japanese" 'riece-mcat-feature 'riece-mcat-japanese))
+
+(defun riece-mcat-uninstall ()
+ (set-language-info "Japanese" 'riece-mcat-feature nil))