(message-locale-detect): Fix, when no locale detected.
[elisp/gnus.git-] / lisp / message.el
index 212d8d0..788824c 100644 (file)
@@ -4,7 +4,10 @@
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;;         Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
-;;         Keiichi Suzuki <kei-suzu@mail.wbs.ne.jp>
+;;         Keiichi Suzuki   <kei-suzu@mail.wbs.ne.jp>
+;;         Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
+;;         Katsumi Yamaoka  <yamaoka@jpl.org>
+;;         Kiyokazu SUTO    <suto@merry.xmath.ous.ac.jp>
 ;; Keywords: mail, news, MIME
 
 ;; This file is part of GNU Emacs.
@@ -333,7 +336,7 @@ If t, use `message-user-organization-file'."
   :type 'boolean)
 
 (defcustom message-included-forward-headers
-  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-\\|^MIME-Version:"
+  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:\\|^Content-Transfer-Encoding:\\|^Content-Type:\\|^MIME-Version:"
   "*Regexp matching headers to be included in forwarded messages."
   :group 'message-forwarding
   :type 'regexp)
@@ -546,6 +549,12 @@ nil means use indentation."
   :type 'string
   :group 'message-insertion)
 
+(defcustom message-yank-add-new-references t
+  "*Non-nil means new IDs will be added to \"References\" field when an
+article is yanked by the command `message-yank-original' interactively."
+  :type 'boolean
+  :group 'message-insertion)
+
 (defcustom message-indentation-spaces 3
   "*Number of spaces to insert at the beginning of each cited line.
 Used by `message-yank-original' via `message-yank-cite'."
@@ -614,7 +623,6 @@ If stringp, use this; if non-nil, use no host name (user name only)."
 
 (defvar message-reply-buffer nil)
 (defvar message-reply-headers nil)
-(defvar message-user-agent nil) ; XXX: This symbol is overloaded!  See below.
 (defvar message-sent-message-via nil)
 (defvar message-checksum nil)
 (defvar message-send-actions nil
@@ -655,6 +663,11 @@ articles."
   :group 'message-news
   :type 'message-header-lines)
 
+(defcustom message-mail-follow-up-address-checker nil
+  "A function of check follow up mail address."
+  :group 'message-mail
+  :type 'function)
+
 ;; Note: could use /usr/ucb/mail instead of sendmail;
 ;; options -t, and -v if not interactive.
 (defcustom message-mailer-swallows-blank-line
@@ -1094,12 +1107,12 @@ The cdr of ech entry is a function for applying the face to a region.")
                               (not paren))))
                 (push (buffer-substring beg (point)) elems)
                 (setq beg (match-end 0)))
-               ((= (following-char) ?\")
+               ((eq (char-after) ?\")
                 (setq quoted (not quoted)))
-               ((and (= (following-char) ?\()
+               ((and (eq (char-after) ?\()
                      (not quoted))
                 (setq paren t))
-               ((and (= (following-char) ?\))
+               ((and (eq (char-after) ?\))
                      (not quoted))
                 (setq paren nil))))
        (nreverse elems)))))
@@ -1832,6 +1845,28 @@ However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
          (forward-line 1))))
     (goto-char start)))
 
+(defun message-list-references (refs-list &rest refs-strs)
+  "Add `Message-ID's which appear in REFS-STRS but not in REFS-LIST,
+to REFS-LIST."
+  (let (refs ref id)
+    (while refs-strs
+      (setq refs (car refs-strs)
+           refs-strs (cdr refs-strs))
+      (when refs
+       (setq refs (std11-parse-msg-ids (std11-lexical-analyze refs)))
+       (while refs
+         (setq ref (car refs)
+               refs (cdr refs))
+         (when (eq (car ref) 'msg-id)
+           (setq id (concat "<"
+                            (mapconcat
+                             (function (lambda (p) (cdr p)))
+                             (cdr ref) "")
+                            ">"))
+           (or (member id refs-list)
+               (push id refs-list))))))
+    refs-list))
+
 (defvar gnus-article-copy)
 (defun message-yank-original (&optional arg)
   "Insert the message being replied to, if any.
@@ -1842,14 +1877,45 @@ if `message-yank-prefix' is non-nil, insert that prefix on each line.
 This function uses `message-cite-function' to do the actual citing.
 
 Just \\[universal-argument] as argument means don't indent, insert no
-prefix, and don't delete any headers."
+prefix, and don't delete any headers.
+
+In addition, if `message-yank-add-new-references' is non-nil and this
+command is called interactively, new IDs from the yanked article will
+be added to \"References\" field."
   (interactive "P")
   (let ((modified (buffer-modified-p))
-       (buffer (message-eval-parameter message-reply-buffer)))
+       (buffer (message-eval-parameter message-reply-buffer))
+       refs)
     (when (and buffer
               message-cite-function)
       (delete-windows-on buffer t)
-      (insert-buffer buffer)
+      (insert-buffer buffer) ; mark will be set at the end of article.
+
+      ;; Add new IDs to References field.
+      (when (and message-yank-add-new-references (interactive-p))
+       (save-excursion
+         (save-restriction
+           (narrow-to-region (point) (mark t))
+           (std11-narrow-to-header)
+           (when (setq refs (message-list-references
+                             '()
+                             (or (message-fetch-field "References")
+                                 (message-fetch-field "In-Reply-To"))
+                             (message-fetch-field "Message-ID")))
+             (widen)
+             (message-narrow-to-headers)
+             (goto-char (point-min))
+             (let ((case-fold-search t))
+               (if (re-search-forward "^References:\\([\t ]+.+\n\\)+" nil t)
+                   (replace-match "")
+                 (goto-char (point-max))))
+             (mail-header-format
+              (list (or (assq 'References message-header-format-alist)
+                        '(References . message-fill-references)))
+              (list (cons 'References
+                          (mapconcat 'identity (nreverse refs) " "))))
+             (backward-delete-char 1)))))
+
       (funcall message-cite-function)
       (message-exchange-point-and-mark)
       (unless (bolp)
@@ -2157,11 +2223,56 @@ the user from the mailer."
        (eval (car actions)))))
     (pop actions)))
 
+(defsubst message-maybe-split-and-send-mail ()
+  "Split a message if necessary, and send it via mail.
+Returns nil if sending succeeded, returns any string if sending failed.
+This sub function is for exclusive use of `message-send-mail'."
+  (let ((mime-edit-split-ignored-field-regexp
+        mime-edit-split-ignored-field-regexp)
+       (case-fold-search t)
+       failure)
+    (while (string-match "Message-ID" mime-edit-split-ignored-field-regexp)
+      (setq mime-edit-split-ignored-field-regexp
+           (concat (substring mime-edit-split-ignored-field-regexp
+                              0 (match-beginning 0))
+                   "Hey_MIME-Edit,_there_is_an_inviolable_Message_ID"
+                   "_so_don't_rape_it!"
+                   (substring mime-edit-split-ignored-field-regexp
+                              (match-end 0)))))
+    (setq failure
+         (or
+          (catch 'message-sending-mail-failure
+            (mime-edit-maybe-split-and-send
+             (function
+              (lambda ()
+                (interactive)
+                (save-restriction
+                  (std11-narrow-to-header mail-header-separator)
+                  (goto-char (point-min))
+                  (when (re-search-forward "^Message-ID:" nil t)
+                    (delete-region (match-end 0) (std11-field-end))
+                    (insert " " (message-make-message-id))))
+                (condition-case err
+                    (funcall message-send-mail-function)
+                  (error
+                   (throw 'message-sending-mail-failure err))))))
+            nil)
+          (condition-case err
+              (progn
+                (funcall message-send-mail-function)
+                nil)
+            (error err))))
+    (when failure
+      (if (eq 'error (car failure))
+         (cadr failure)
+       (prin1-to-string failure)))))
+
 (defun message-send-mail (&optional arg)
   (require 'mail-utils)
   (let ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
        (case-fold-search nil)
-       (news (message-news-p)))
+       (news (message-news-p))
+       failure)
     (save-restriction
       (message-narrow-to-headers)
       ;; Insert some headers.
@@ -2176,7 +2287,6 @@ the user from the mailer."
     (if (not (message-check-mail-syntax))
        (progn
          (message "")
-         ;;(message "Posting not performed")
          nil)
       (unwind-protect
          (save-excursion
@@ -2186,25 +2296,24 @@ the user from the mailer."
            ;; Remove some headers.
            (save-restriction
              (message-narrow-to-headers)
+             ;; Remove some headers.
              (message-remove-header message-ignored-mail-headers t))
            (goto-char (point-max))
            ;; require one newline at the end.
-           (or (= (preceding-char) ?\n)
+           (or (eq (char-before) ?\n)
                (insert ?\n))
            (when (and news
                       (or (message-fetch-field "cc")
                           (message-fetch-field "to")))
              (message-insert-courtesy-copy))
-           (mime-edit-maybe-split-and-send
-            (function
-             (lambda ()
-               (interactive)
-               (funcall message-send-mail-function)
-               )))
-           (funcall message-send-mail-function))
+           (setq failure (message-maybe-split-and-send-mail)))
        (kill-buffer tembuf))
       (set-buffer message-edit-buffer)
-      (push 'mail message-sent-message-via))))
+      (if failure
+         (progn
+           (message "Couldn't send message via mail: %s" failure)
+           nil)
+       (push 'mail message-sent-message-via)))))
 
 (defun message-send-mail-with-sendmail ()
   "Send off the prepared buffer with sendmail."
@@ -2358,6 +2467,38 @@ to find out how to use this."
            (error "Sending failed; " result)))
       (error "Sending failed; no recipients"))))
 
+(defsubst message-maybe-split-and-send-news (method)
+  "Split a message if necessary, and send it via news.
+Returns nil if sending succeeded, returns t if sending failed.
+This sub function is for exclusive use of `message-send-news'."
+  (let ((mime-edit-split-ignored-field-regexp
+        mime-edit-split-ignored-field-regexp)
+       (case-fold-search t))
+    (while (string-match "Message-ID" mime-edit-split-ignored-field-regexp)
+      (setq mime-edit-split-ignored-field-regexp
+           (concat (substring mime-edit-split-ignored-field-regexp
+                              0 (match-beginning 0))
+                   "Hey_MIME-Edit,_there_is_an_inviolable_Message_ID"
+                   "_so_don't_rape_it!"
+                   (substring mime-edit-split-ignored-field-regexp
+                              (match-end 0)))))
+    (or
+     (catch 'message-sending-news-failure
+       (mime-edit-maybe-split-and-send
+       (function
+        (lambda ()
+          (interactive)
+          (save-restriction
+            (std11-narrow-to-header mail-header-separator)
+            (goto-char (point-min))
+            (when (re-search-forward "^Message-ID:" nil t)
+              (delete-region (match-end 0) (std11-field-end))
+              (insert " " (message-make-message-id))))
+          (unless (funcall message-send-news-function method)
+            (throw 'message-sending-news-failure t)))))
+       nil)
+     (not (funcall message-send-news-function method)))))
+
 (defun message-send-news (&optional arg)
   (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
        (case-fold-search nil)
@@ -2381,10 +2522,7 @@ to find out how to use this."
       (run-hooks 'message-header-encoded-hook))
     (message-cleanup-headers)
     (if (not (message-check-news-syntax))
-       (progn
-         (message "")
-         ;;(message "Posting not performed")
-         nil)
+       nil
       (unwind-protect
          (save-excursion
            (set-buffer tembuf)
@@ -2398,29 +2536,17 @@ to find out how to use this."
              (message-remove-header message-ignored-news-headers t))
            (goto-char (point-max))
            ;; require one newline at the end.
-           (or (= (preceding-char) ?\n)
+           (or (eq (char-before) ?\n)
                (insert ?\n))
-           (mime-edit-maybe-split-and-send
-            (function
-             (lambda ()
-               (interactive)
-               (save-restriction
-                 (std11-narrow-to-header mail-header-separator)
-                 (goto-char (point-min))
-                 (when (re-search-forward "^Message-Id:" nil t)
-                   (delete-region (match-end 0)(std11-field-end))
-                   (insert (concat " " (message-make-message-id)))
-                   ))
-               (funcall message-send-news-function method)
-               )))
-           (setq result (funcall message-send-news-function method)))
+           (setq result (message-maybe-split-and-send-news method)))
        (kill-buffer tembuf))
       (set-buffer message-edit-buffer)
       (if result
-         (push 'news message-sent-message-via)
-       (message "Couldn't send message via news: %s"
-                (nnheader-get-report (car method)))
-       nil))))
+         (progn
+           (message "Couldn't send message via news: %s"
+                    (nnheader-get-report (car method)))
+           nil)
+       (push 'news message-sent-message-via)))))
 
 ;; 1997-09-29 by MORIOKA Tomohiko
 (defun message-send-news-with-gnus (method)
@@ -2780,8 +2906,8 @@ to find out how to use this."
        (concat "^" (regexp-quote mail-header-separator) "$"))
       (while (not (eobp))
        (when (not (looking-at "[ \t\n]"))
-         (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
-                           (following-char))))
+         (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
+                           (char-after))))
        (forward-char 1)))
     sum))
 
@@ -3194,7 +3320,9 @@ Headers already prepared in the buffer are not modified."
                  (progn
                    ;; The header was found.  We insert a space after the
                    ;; colon, if there is none.
-                   (if (/= (following-char) ? ) (insert " ") (forward-char 1))
+                   (if (eq (char-after) ? )
+                       (forward-char 1)
+                     (insert " "))
                    ;; Find out whether the header is empty...
                    (looking-at "[ \t]*$")))
          ;; So we find out what value we should insert.
@@ -3303,7 +3431,7 @@ Headers already prepared in the buffer are not modified."
       (goto-char (point-min))
       (while (not (eobp))
        (skip-chars-forward "^,\"" (point-max))
-       (if (or (= (following-char) ?,)
+       (if (or (eq (char-after) ?,)
                (eobp))
            (when (not quoted)
              (if (and (> (current-column) 78)
@@ -3375,7 +3503,7 @@ Headers already prepared in the buffer are not modified."
     (search-backward ":" )
     (widen)
     (forward-char 1)
-    (if (= (following-char) ? )
+    (if (eq (char-after) ? )
        (forward-char 1)
       (insert " ")))
    (t
@@ -3584,7 +3712,7 @@ OTHER-HEADERS is an alist of header/value pairs."
        from subject date reply-to to cc
        references message-id follow-to
        (inhibit-point-motion-hooks t)
-       mct never-mct gnus-warning)
+       mct never-mct gnus-warning in-reply-to)
     (save-restriction
       (message-narrow-to-head)
       ;; Allow customizations to have their say.
@@ -3607,6 +3735,12 @@ OTHER-HEADERS is an alist of header/value pairs."
            reply-to (message-fetch-field "reply-to")
            references (message-fetch-field "references")
            message-id (message-fetch-field "message-id" t))
+      ;; Get the references from "In-Reply-To" field if there were
+      ;; no references and "In-Reply-To" field looks promising.
+      (unless references
+       (when (and (setq in-reply-to (message-fetch-field "in-reply-to"))
+                  (string-match "<[^>]+>" in-reply-to))
+         (setq references (match-string 0 in-reply-to))))
       ;; Remove any (buggy) Re:'s that are present and make a
       ;; proper one.
       (when (string-match message-subject-re-regexp subject)
@@ -3657,7 +3791,10 @@ OTHER-HEADERS is an alist of header/value pairs."
                     (message-tokenize-header (buffer-string))))
              (let ((s ccalist))
                (while s
-                 (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
+                 (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))
+             (when (functionp message-mail-follow-up-address-checker)
+               (setq ccalist (funcall message-mail-follow-up-address-checker
+                                      ccalist))))
            (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
            (when ccalist
              (let ((ccs (cons 'Cc (mapconcat
@@ -3970,14 +4107,14 @@ the message."
       (current-buffer)
       (message-narrow-to-head)
       (let ((funcs message-make-forward-subject-function)
-           (subject (if message-wash-forwarded-subjects
-                        (message-wash-subject
-                         (or (nnheader-decode-subject
-                              (message-fetch-field "Subject"))
-                             ""))
-                      (or (nnheader-decode-subject
-                           (message-fetch-field "Subject"))
-                          ""))))
+           (subject (message-fetch-field "Subject")))
+       (setq subject
+             (if subject
+                 (if message-wash-forwarded-subjects
+                     (message-wash-subject
+                      (nnheader-decode-subject subject))
+                   (nnheader-decode-subject subject))
+               "(none)"))
        ;; Make sure funcs is a list.
        (and funcs
             (not (listp funcs))
@@ -4201,7 +4338,7 @@ which specify the range to operate on."
       (goto-char (min start end))
       (while (< (point) end1)
        (or (looking-at "[_\^@- ]")
-           (insert (following-char) "\b"))
+           (insert (char-after) "\b"))
        (forward-char 1)))))
 
 ;;;###autoload
@@ -4215,7 +4352,7 @@ which specify the range to operate on."
       (move-marker end1 (max start end))
       (goto-char (min start end))
       (while (re-search-forward "\b" end1 t)
-       (if (eq (following-char) (char-after (- (point) 2)))
+       (if (eq (char-after) (char-after (- (point) 2)))
            (delete-char -2))))))
 
 (defalias 'message-exchange-point-and-mark 'exchange-point-and-mark)
@@ -4336,22 +4473,257 @@ regexp varstr."
                (cdr local)))))
      locals)))
 
-;;; @ for MIME Edit mode
+;; @ For `message-mail-follow-up-address-checker'.
+
+(defcustom message-mailing-list-address-list nil
+  "*Regexp matching addresses that are mailing lists.
+It must be a simple regexp string or a list of regexp strings.
+This variable is used by \`message-check-mailing-list-with-address-list\'."
+  :group 'message-mail
+  :type '(repeat regexp))
+
+(defun message-check-mailing-list-with-address-list (alist)
+  (let ((s alist)
+       (regexp (if (stringp message-mailing-list-address-list)
+                   message-mailing-list-address-list
+                 (mapconcat
+                  (lambda (x)
+                    x)
+                  message-mailing-list-address-list
+                  "\\|")))
+       address non-mailing-list mailing-list)
+    (while (setq address (car (pop s)))
+      (if (string-match regexp address)
+         (setq mailing-list t)
+       (setq non-mailing-list
+             (append non-mailing-list (list address)))))
+    (if (or (not non-mailing-list)
+           (not mailing-list)
+           (not (y-or-n-p "Do you want to remove private address? ")))
+       alist
+      (setq s non-mailing-list)
+      (while s
+       (setq alist (delq (assoc (pop s) alist) alist)))
+      alist)
+    ))
+
+(defcustom message-mailing-list-address-p nil
+  "*The function return t if address is a mailing list.
+It must be function, and interface is (ADDRESS).
+ADDRESS is a string of mail address.
+This variable is used by \`message-check-mailing-list-with-function\'."
+  :group 'message-mail
+  :type 'function)
+
+(defun message-check-mailing-list-with-function (alist)
+  (let ((s alist)
+       address non-mailing-list mailing-list)
+    (while (setq address (car (pop s)))
+      (if (funcall message-mailing-list-address-p address)
+         (setq mailing-list t)
+       (setq non-mailing-list
+             (append non-mailing-list (list address)))))
+    (if (or (not non-mailing-list)
+           (not mailing-list)
+           (not (y-or-n-p "Do you want to remove private address? ")))
+       alist
+      (setq s non-mailing-list)
+      (while s
+       (setq alist (delq (assoc (pop s) alist) alist)))
+      alist)
+    ))
+
+;;; @ 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-locale-detect-for-mail nil
+  "*A function called to detect locale from recipient mail address."
+  :group 'message-sending
+  :type 'function)
+
+(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)
+
+(defun message-locale-detect ()
+  (when (or message-locale-detect-for-news
+           message-locale-detect-for-mail)
+    (save-excursion
+      (save-restriction
+       (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
+             (and message-locale-default (list message-locale-default)))
+         )))))
+
+(defvar message-locale-newsgroup-alist
+  '(("^fj\\." . fj)
     ))
 
+(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)
+    ))
+
+(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))))
+        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: "
+                            alist nil t default-charset))
+      (when (string= charset "")
+       (setq charset nil)))
+    charset))
+
+(defvar message-locale-mime-charsets-alist
+  '((fj . (us-ascii iso-2022-jp iso-2022-jp-2))
+    (none . 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)
   (let ((message-cite-function 'mime-edit-inserted-message-filter)
@@ -4396,21 +4768,6 @@ regexp varstr."
   (turn-on-mime-edit)
   (add-to-list 'buffer-file-format 'mime-message))
 
-;;; Miscellaneous functions
-
-;; stolen (and renamed) from nnheader.el
-(defun message-replace-chars-in-string (string from to)
-  "Replace characters in STRING from FROM to TO."
-  (let ((string (substring string 0))  ;Copy string.
-       (len (length string))
-       (idx 0))
-    ;; Replace all occurrences of FROM with TO.
-    (while (< idx len)
-      (when (= (aref string idx) from)
-       (aset string idx to))
-      (setq idx (1+ idx)))
-    string))
-
 (run-hooks 'message-load-hook)
 
 (provide 'message)