Commit Katsumi Yamaoka's patch.
[gnus] / lisp / message.el
index 0df3bc5..81bd8f2 100644 (file)
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl)
+  (defvar gnus-list-identifiers))      ; gnus-sum is required where necessary
 (require 'mailheader)
 (require 'nnheader)
-(require 'easymenu)
-(if (string-match "XEmacs\\|Lucid" emacs-version)
-    (require 'mail-abbrevs)
-  (require 'mailabbrev))
 (require 'mail-parse)
-(require 'mm-bodies)
-(require 'mm-encode)
 (require 'mml)
 
 (defgroup message '((user-mail-address custom-variable)
@@ -170,7 +166,8 @@ long-lines control-chars size new-text redirected-followup signature
 approved sender empty empty-headers message-id from subject
 shorten-followup-to existing-newsgroups buffer-file-name unchanged
 newsgroups."
-  :group 'message-news)
+  :group 'message-news
+  :type '(repeat sexp))
 
 (defcustom message-required-news-headers
   '(From Newsgroups Subject Date Message-ID
@@ -319,7 +316,7 @@ The provided functions are:
   :group 'message-interface
   :type 'regexp)
 
-(defcustom message-forward-ignored-headers "Content-Transfer-Encoding"
+(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
   "*All headers that match this regexp will be deleted when forwarding a message."
   :group 'message-forwarding
   :type '(choice (const :tag "None" nil)
@@ -1013,7 +1010,7 @@ should be sent in several parts. If it is nil, the size is unlimited."
   (autoload 'gnus-open-server "gnus-int")
   (autoload 'gnus-request-post "gnus-int")
   (autoload 'gnus-alive-p "gnus-util")
-  (autoload 'gnus-list-identifiers "gnus-sum")
+  (autoload 'gnus-group-name-charset "gnus-group")
   (autoload 'rmail-output "rmail"))
 
 \f
@@ -1031,9 +1028,19 @@ should be sent in several parts. If it is nil, the size is unlimited."
   `(delete-region (progn (beginning-of-line) (point))
                  (progn (forward-line ,(or n 1)) (point))))
 
+(defun message-unquote-tokens (elems)
+  "Remove double quotes (\") from strings in list."
+  (mapcar (lambda (item)
+            (while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
+              (setq item (concat (match-string 1 item) 
+                                 (match-string 2 item))))
+            item)
+          elems))
+
 (defun message-tokenize-header (header &optional separator)
   "Split HEADER into a list of header elements.
-\",\" is used as the separator."
+SEPARATOR is a string of characters to be used as separators.  \",\"
+is used by default."
   (if (not header)
       nil
     (let ((regexp (format "[%s]+" (or separator ",")))
@@ -1063,7 +1070,7 @@ should be sent in several parts. If it is nil, the size is unlimited."
                ((and (eq (char-after) ?\))
                      (not quoted))
                 (setq paren nil))))
-       (nreverse elems)))))
+        (nreverse elems)))))
 
 (defun message-mail-file-mbox-p (file)
   "Say whether FILE looks like a Unix mbox file."
@@ -1083,8 +1090,8 @@ should be sent in several parts. If it is nil, the size is unlimited."
     (when value
       (while (string-match "\n[\t ]+" value)
        (setq value (replace-match " " t t value)))
-      ;; We remove all text props.
-      (format "%s" value))))
+      (set-text-properties 0 (length value) nil value)
+      value)))
 
 (defun message-narrow-to-field ()
   "Narrow the buffer to the header on the current line."
@@ -1139,6 +1146,7 @@ should be sent in several parts. If it is nil, the size is unlimited."
 
 (defun message-strip-list-identifiers (subject)
   "Remove list identifiers in `gnus-list-identifiers'."
+  (require 'gnus-sum)                  ; for gnus-list-identifiers
   (let ((regexp (if (stringp gnus-list-identifiers)
                    gnus-list-identifiers
                  (mapconcat 'identity gnus-list-identifiers " *\\|"))))
@@ -1478,8 +1486,10 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
   (set (make-local-variable 'message-mime-part) 0)
   ;;(when (fboundp 'mail-hist-define-keys)
   ;;  (mail-hist-define-keys))
-  (when (string-match "XEmacs\\|Lucid" emacs-version)
-    (message-setup-toolbar))
+  (if (featurep 'xemacs)
+      (message-setup-toolbar)
+    (set (make-local-variable 'font-lock-defaults)
+        '(message-font-lock-keywords t)))
   (easy-menu-add message-mode-menu message-mode-map)
   (easy-menu-add message-mode-field-menu message-mode-map)
   ;; Allow mail alias things.
@@ -1488,9 +1498,6 @@ M-RET    message-newline-and-reformat (break the line and reformat)."
        (mail-abbrevs-setup)
       (mail-aliases-setup)))
   (message-set-auto-save-file-name)
-  (unless (string-match "XEmacs" emacs-version)
-    (set (make-local-variable 'font-lock-defaults)
-        '(message-font-lock-keywords t)))
   (make-local-variable 'adaptive-fill-regexp)
   (setq adaptive-fill-regexp
        (concat "[ \t]*[-a-z0-9A-Z]*\\(>[ \t]*\\)+[ \t]*\\|" adaptive-fill-regexp))
@@ -2809,9 +2816,19 @@ to find out how to use this."
        (while (setq file (message-fetch-field "fcc"))
          (push file list)
          (message-remove-header "fcc" nil t)))
+      (message-encode-message-body)
+      (save-restriction
+       (message-narrow-to-headers)
+       (let ((mail-parse-charset message-default-charset)
+             (rfc2047-header-encoding-alist
+              (cons '("Newsgroups" . default)
+                    rfc2047-header-encoding-alist)))
+         (mail-encode-encoded-word-buffer)))
       (goto-char (point-min))
-      (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
-      (replace-match "" t t)
+      (when (re-search-forward
+            (concat "^" (regexp-quote mail-header-separator) "$")
+            nil t)
+       (replace-match "" t t ))
       ;; Process FCC operations.
       (while list
        (setq file (pop list))
@@ -2831,7 +2848,6 @@ to find out how to use this."
                (rmail-output file 1 nil t)
              (let ((mail-use-rfc822 t))
                (rmail-output file 1 t t))))))
-
       (kill-buffer (current-buffer)))))
 
 (defun message-output (filename)
@@ -3679,6 +3695,7 @@ OTHER-HEADERS is an alist of header/value pairs."
 (defun message-reply (&optional to-address wide)
   "Start editing a reply to the article in the current buffer."
   (interactive)
+  (require 'gnus-sum)                  ; for gnus-list-identifiers
   (let ((cur (current-buffer))
        from subject date reply-to to cc
        references message-id follow-to
@@ -3741,6 +3758,7 @@ OTHER-HEADERS is an alist of header/value pairs."
   "Follow up to the message in the current buffer.
 If TO-NEWSGROUPS, use that as the new Newsgroups line."
   (interactive)
+  (require 'gnus-sum)                  ; for gnus-list-identifiers
   (let ((cur (current-buffer))
        from subject date reply-to mct
        references message-id follow-to
@@ -4079,9 +4097,7 @@ Optional DIGEST will use digest to forward."
            (narrow-to-region (point) 
                              (or (search-forward "\n\n" nil t) (point)))
            (delete-region (point-min) (point-max)))
-       (when (and (or message-forward-show-mml
-                      (not message-forward-as-mime))
-                  (not current-prefix-arg)
+       (when (and (not current-prefix-arg)
                   message-forward-ignored-headers)
          (save-restriction
            (narrow-to-region b e)
@@ -4168,6 +4184,8 @@ you."
        (if (re-search-forward "^[^ \n\t]+:" nil t)
           (match-beginning 0)
         (point))))
+    (mm-enable-multibyte)
+    (mime-to-mml)
     (save-restriction
       (message-narrow-to-head)
       (message-remove-header message-ignored-bounced-headers t)
@@ -4391,17 +4409,20 @@ regexp varstr."
 ;;; 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))
+(if (fboundp 'subst-char-in-string)
+    (defsubst message-replace-chars-in-string (string from to)
+      (subst-char-in-string from to string))
+  (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)))
 
 ;;;
 ;;; MIME functions