From: keiichi Date: Tue, 23 Feb 1999 13:16:06 +0000 (+0000) Subject: (message-mime-charset-detect-method): Abolished. X-Git-Tag: nana-gnus-6_12_3~1 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=206f363625d4df278215c6d66d0d7ecc4216bc57;p=elisp%2Fgnus.git- (message-mime-charset-detect-method): Abolished. (message-mime-charset-specify-method): Ditto. (message-mime-charset-detect-args): Ditto. (message-maybe-encode-with-specified-charset): Ditto. (message-mime-charset-detect-by-ask): Ditto. (message-mime-charset-specify-none): Ditto. (message-mime-charset-recover-function): New variable. (message-mime-charset-recover-args): Ditto. (message-charsets-mime-charset-alist): Ditto. (message-locale-default): Ditto. (message-locale-detect-for-mail): Ditto. (message-locale-detect-for-news): Ditto. (message-locale-newsgroup-alist): Ditto. (message-locale-mail-address-alist): Ditto. (message-mime-charset-recover-ask-function): Ditto. (message-locale-mime-charsets-alist): Ditto. (message-maybe-encode): New implementation. (message-locale-detect): New function. (message-locale-detect-with-newsgroup-alist): Ditto. (message-locale-detect-with-mail-address-alist): Ditto. (message-mime-charset-recover-by-ask): Ditto. (message-mime-charset-recover-ask-y-or-n): Ditto. (message-mime-charset-recover-ask-charset): Ditto. (message-mime-charset-setup): Ditto. --- diff --git a/lisp/message.el b/lisp/message.el index 3de6b7f..b092b02 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -4533,82 +4533,194 @@ This variable is used by \`message-check-mailing-list-with-function\'." alist) )) -;;; @ for MIME Edit mode +;;; @ for locale specification. ;;; +(defcustom message-mime-charset-recover-function + 'message-mime-charset-recover-by-ask + "A function called to recover \ +when could not found legal MIME charset for sending message." + :type '(radio (function-item message-mime-charset-recover-by-ask) + (function :tag "Other")) + :group 'message-sending) + +(defvar message-mime-charset-recover-args nil) +(defvar message-charsets-mime-charset-alist nil) + (defun message-maybe-encode () (when message-mime-mode - (run-hooks 'mime-edit-translate-hook) - (if (catch 'mime-edit-error - (save-excursion - (mime-edit-translate-body) - )) - (error "Translation error!") - ) - (end-of-invisible) - (run-hooks 'mime-edit-exit-hook) - )) + (run-hooks 'mime-edit-translate-hook)) + (let ((locale-list (message-locale-detect))) + (when message-mime-mode + (let* ((default-mime-charset-detect-method-for-write + (or message-mime-charset-recover-function + default-mime-charset-detect-method-for-write)) + message-mime-charset-recover-args + (charsets-mime-charset-alist charsets-mime-charset-alist) + (message-charsets-mime-charset-alist charsets-mime-charset-alist)) + (message-mime-charset-setup locale-list) + (if (catch 'mime-edit-error + (save-excursion + (mime-edit-translate-body) + )) + (error "Translation error!") + )) + (end-of-invisible) + (run-hooks 'mime-edit-exit-hook) + ))) + +(defcustom message-locale-default nil + "Default locale for sending message." + :group 'message-sending + :type 'symbol) -(defcustom message-mime-charset-detect-method - 'message-mime-charset-detect-by-ask - "*A function called to detect MIME charset for sending message." +(defcustom message-locale-detect-for-mail nil + "*A function called to detect locale from recipient mail address." :group 'message-sending :type 'function) -(defcustom message-mime-charset-specify-method - 'message-mime-charset-specify-none - "*A function called to detect MIME charset for sending message." +(defcustom message-locale-detect-for-news + 'message-locale-detect-with-newsgroup-alist + "*A function called to detect locale from newsgroup." :group 'message-sending :type 'function) -(defvar message-mime-charset-detect-args nil) +(defun message-locale-detect () + (when (or message-locale-detect-for-news + message-locale-detect-for-mail) + (save-excursion + (message-narrow-to-head) + (let (lc dest) + (when message-locale-detect-for-news + (setq lc (mapcar + (lambda (newsgroup) + (funcall message-locale-detect-for-news + (and (string-match "[^ \t]+" newsgroup) + (match-string 0 newsgroup)))) + (message-tokenize-header + (message-fetch-field "newsgroups"))))) + (when message-locale-detect-for-mail + (let ((field-list '("to" "cc" "bcc"))) + (while (car field-list) + (setq lc (append + lc + (mapcar + (lambda (address) + (funcall message-locale-detect-for-mail + (car (cdr (std11-extract-address-components + address))))) + (message-tokenize-header + (message-fetch-field (pop field-list))))))))) + (setq lc (delq nil lc)) + (while lc + (setq dest (cons (car lc) dest) + lc (delq (car lc) lc))) + (or dest + (list message-locale-default)) + )))) + +(defvar message-locale-newsgroup-alist + '(("^fj\\." . fj) + )) -(defun message-maybe-encode-with-specified-charset () - (when message-mime-mode - (let ((default-mime-charset-detect-method-for-write - message-mime-charset-detect-method) - (charsets-mime-charset-alist charsets-mime-charset-alist) - message-mime-charset-detect-args) - (run-hooks 'mime-edit-translate-hook) - (when message-mime-charset-specify-method - (funcall message-mime-charset-specify-method)) - (if (catch 'mime-edit-error - (save-excursion - (mime-edit-translate-body) - )) - (error "Translation error!") - )) - (end-of-invisible) - (run-hooks 'mime-edit-exit-hook) +(defun message-locale-detect-with-newsgroup-alist (newsgroup) + (let ((rest message-locale-newsgroup-alist) + done) + (while (and (not done) + rest) + (when (string-match (car (car rest)) newsgroup) + (setq done (car rest))) + (setq rest (cdr rest))) + (cdr done) + )) + +(defvar message-locale-mail-address-alist nil) + +(defun message-locale-detect-with-mail-address-alist (address) + (let ((rest message-locale-mail-address-alist) + done) + (while (and (not done) + rest) + (when (string-match (car (car rest)) address) + (setq done (car rest))) + (setq rest (cdr rest))) + (cdr done) )) -(defun message-mime-charset-detect-by-ask (type charsets &rest region) - (let* ((charsets-mime-charset-alist - (cdr (assq 'charsets-mime-charset-alist - message-mime-charset-detect-args))) +(defcustom message-mime-charset-recover-ask-function + 'message-mime-charset-recover-ask-y-or-n + "A function called to ask MIME charset. +This funtion will by called from \`message-mime-charset-recover-by-ask\'." + :type '(radio (function-item message-mime-charset-recover-ask-y-or-n) + (function-item message-mime-charset-recover-ask-charset) + (function :tag "Other")) + :group 'message-sending) + +(defun message-mime-charset-recover-by-ask (type charsets &rest args) + (let* ((charsets-mime-charset-alist message-charsets-mime-charset-alist) (default-charset (upcase (symbol-name (or (charsets-to-mime-charset charsets) default-mime-charset-for-write)))) - (mime-charset-list - (mapcar - (lambda (X) - (list (upcase (symbol-name (car X))))) - mime-charset-type-list)) charset) + (save-excursion + (save-restriction + (save-window-excursion + (when (eq type 'region) + (narrow-to-region (car args) (car (cdr args))) + (pop-to-buffer (current-buffer) nil t)) + (if (setq charset (funcall message-mime-charset-recover-ask-function + default-charset charsets)) + (intern (downcase charset)) + (error "Canceled."))))))) + +(defun message-mime-charset-recover-ask-y-or-n (default-charset charsets) + (or (y-or-n-p (format "MIME charset %s is selected. OK? " + default-charset)) + (error "Canceled.")) + default-charset) + +(defun message-mime-charset-recover-ask-charset (default-charset charsets) + (let ((alist (mapcar + (lambda (cs) + (list (upcase (symbol-name cs)))) + (mime-charset-list))) + charset) (while (not charset) (setq charset (completing-read "What MIME charset: " - mime-charset-list nil t default-charset)) + alist nil t default-charset)) (when (string= charset "") (setq charset nil))) - (intern (downcase charset)) - )) + charset)) + +(defvar message-locale-mime-charsets-alist + '((fj . (us-ascii iso-2022-jp iso-2022-jp-2)) + (none . nil) + )) -(defun message-mime-charset-specify-none () - (add-to-list 'message-mime-charset-detect-args - (cons 'charsets-mime-charset-alist charsets-mime-charset-alist)) - (setq charsets-mime-charset-alist nil)) +(defun message-mime-charset-setup (locale-list) + (let (locale-cs) + (while (and charsets-mime-charset-alist + locale-list) + (unless (setq locale-cs + (assq (car locale-list) + message-locale-mime-charsets-alist)) + (error "Unknown locale \`%s\'. Add locale to \`%s\'." + (car locale-list) + 'message-locale-mime-charsets-alist)) + (setq locale-cs (cdr locale-cs) + charsets-mime-charset-alist (delq nil + (mapcar + (lambda (cs) + (and (memq (cdr cs) locale-cs) + cs)) + charsets-mime-charset-alist)) + locale-list (cdr locale-list)) + ))) + +;;; @ for MIME Edit mode +;;; (defun message-mime-insert-article (&optional message) (interactive)