Commit Katsumi Yamaoka's patch.

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 41777b6..81bd8f2 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -30,16 +30,12 @@
 
 ;;; 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)
@@ -1014,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
@@ -1033,12 +1029,12 @@ should be sent in several parts. If it is nil, the size is unlimited."
                  (progn (forward-line ,(or n 1)) (point))))
 
 (defun message-unquote-tokens (elems)
-  "Remove leading and trailing double quotes (\") from quoted strings
-in list."
+  "Remove double quotes (\") from strings in list."
   (mapcar (lambda (item)
-            (if (string-match "^\"\\(.*\\)\"$" item)
-                (match-string 1 item)
-              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)
@@ -1094,8 +1090,8 @@ is used by default."
     (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."
@@ -1150,6 +1146,7 @@ is used by default."
 
 (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 " *\\|"))))
@@ -1489,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.
@@ -1499,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))
@@ -2820,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))
@@ -2842,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)
@@ -3690,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
@@ -3752,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
@@ -4177,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)
@@ -4400,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