* gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed
[gnus] / lisp / gnus-msg.el
index 204aa66..11292bd 100644 (file)
@@ -116,32 +116,45 @@ the second with the current group name."
 See Info node `(gnus)Posting Styles'."
   :group 'gnus-message
   :type '(repeat (cons (choice (regexp)
-                              (function)
                               (variable)
+                              (list (const header)
+                                    (string :tag "Header")
+                                    (regexp :tag "Regexp"))
+                              (function)
                               (sexp))
                       (repeat (list
                                (choice (const signature)
                                        (const signature-file)
                                        (const organization)
                                        (const address)
+                                       (const x-face-file)
                                        (const name)
                                        (const body)
+                                       (symbol)
                                        (string :tag "Header"))
                                (choice (string)
                                        (function)
                                        (variable)
                                        (sexp)))))))
 
-(defcustom gnus-inews-mark-gcc-as-read nil
+(defcustom gnus-gcc-mark-as-read nil
   "If non-nil, automatically mark Gcc articles as read."
+  :version "21.1"
   :group 'gnus-message
   :type 'boolean)
 
+(defvar gnus-inews-mark-gcc-as-read nil
+  "Obsolete variable. Use `gnus-gcc-mark-as-read' instead.")
+
+(make-obsolete-variable 'gnus-inews-mark-gcc-as-read 
+                       'gnus-gcc-mark-as-read)
+
 (defcustom gnus-gcc-externalize-attachments nil
-  "Should local-file attachments be included as external parts?
+  "Should local-file attachments be included as external parts in Gcc copies?
 If it is `all', attach files as external parts;
 if a regexp and matches the Gcc group name, attach files as external parts;
 If nil, attach files as normal parts."
+  :version "21.1"
   :group 'gnus-message
   :type '(choice (const nil :tag "None")
                 (const all :tag "Any")
@@ -179,6 +192,33 @@ use this option with care."
                                  (symbol :tag "Charset")))))
   :group 'gnus-charset)
 
+(defcustom gnus-debug-files
+  '("gnus.el" "gnus-sum.el" "gnus-group.el"
+    "gnus-art.el" "gnus-start.el" "gnus-async.el"
+    "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
+    "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
+    "mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
+  "Files whose variables will be reported in `gnus-bug'."
+  :version "21.1"
+  :group 'gnus-message
+  :type '(repeat (string :tag "File")))
+
+(defcustom gnus-debug-exclude-variables 
+  '(mm-mime-mule-charset-alist 
+    nnmail-split-fancy message-minibuffer-local-map)
+  "Variables that should not be reported in `gnus-bug'."
+  :version "21.1"
+  :group 'gnus-message
+  :type '(repeat (symbol :tab "Variable")))
+
+(defcustom gnus-discouraged-post-methods 
+  '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
+  "A list of back ends that are not used in \"real\" newsgroups.
+This variable is used only when `gnus-post-method' is `current'."
+  :version "21.3"
+  :group 'gnus-group-foreign
+  :type '(repeat (symbol :tab "Back end")))
+
 ;;; Internal variables.
 
 (defvar gnus-inhibit-posting-styles nil
@@ -238,7 +278,7 @@ Thank you for your help in stamping out bugs.
   "w" gnus-summary-wide-reply
   "W" gnus-summary-wide-reply-with-original
   "v" gnus-summary-very-wide-reply
-  "W" gnus-summary-very-wide-reply-with-original
+  "V" gnus-summary-very-wide-reply-with-original
   "n" gnus-summary-followup-to-mail
   "N" gnus-summary-followup-to-mail-with-original
   "m" gnus-summary-mail-other-window
@@ -560,12 +600,19 @@ a news."
 
 (defun gnus-summary-followup (yank &optional force-news)
   "Compose a followup to an article.
-If prefix argument YANK is non-nil, original article is yanked automatically."
+If prefix argument YANK is non-nil, the original article is yanked
+automatically.
+YANK is a list of elements, where the car of each element is the
+article number, and the two following numbers is the region to be
+yanked."
   (interactive
    (list (and current-prefix-arg
              (gnus-summary-work-articles 1))))
   (when yank
-    (gnus-summary-goto-subject (car yank)))
+    (gnus-summary-goto-subject
+     (if (listp (car yank))
+        (caar yank)
+       (car yank))))
   (save-window-excursion
     (gnus-summary-select-article))
   (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
@@ -593,18 +640,21 @@ If prefix argument YANK is non-nil, original article is yanked automatically."
   (gnus-summary-followup (gnus-summary-work-articles arg) t))
 
 (defun gnus-inews-yank-articles (articles)
-  (let (beg article)
+  (let (beg article yank-string)
     (message-goto-body)
     (while (setq article (pop articles))
+      (when (listp article)
+       (setq yank-string (nth 1 article)
+             article (nth 0 article)))
       (save-window-excursion
        (set-buffer gnus-summary-buffer)
        (gnus-summary-select-article nil nil nil article)
        (gnus-summary-remove-process-mark article))
-      (gnus-copy-article-buffer)
+      (gnus-copy-article-buffer nil yank-string)
       (let ((message-reply-buffer gnus-article-copy)
            (message-reply-headers
+            ;; The headers are decoded.
             (with-current-buffer gnus-article-copy
-              ;; The headers are decoded.
               (nnheader-parse-head t))))
        (message-yank-original)
        (setq beg (or beg (mark t))))
@@ -622,7 +672,7 @@ post using the current select method."
   (let ((articles (gnus-summary-work-articles n))
        (message-post-method
         `(lambda (arg)
-           (gnus-post-method (not (eq symp 'a)) ,gnus-newsgroup-name)))
+           (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
        article)
     (while (setq article (pop articles))
       (when (gnus-summary-select-article t nil nil article)
@@ -654,7 +704,7 @@ header line with the old Message-ID."
 
 \f
 
-(defun gnus-copy-article-buffer (&optional article-buffer)
+(defun gnus-copy-article-buffer (&optional article-buffer yank-string)
   ;; make a copy of the article buffer with all text properties removed
   ;; this copy is in the buffer gnus-article-copy.
   ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
@@ -681,9 +731,14 @@ header line with the old Message-ID."
            (widen)
            (copy-to-buffer gnus-article-copy (point-min) (point-max))
            (set-buffer gnus-article-copy)
+           (when yank-string
+             (message-goto-body)
+             (delete-region (point) (point-max))
+             (insert yank-string))
            (gnus-article-delete-text-of-type 'annotation)
            (gnus-remove-text-with-property 'gnus-prev)
            (gnus-remove-text-with-property 'gnus-next)
+           (gnus-remove-text-with-property 'gnus-decoration)
            (insert
             (prog1
                 (buffer-substring-no-properties (point-min) (point-max))
@@ -693,8 +748,8 @@ header line with the old Message-ID."
            (goto-char (point-min))
            (while (looking-at message-unix-mail-delimiter)
              (forward-line 1))
-           (setq beg (point))
-           (setq end (or (message-goto-body) beg))
+           (setq beg (point)
+                 end (or (message-goto-body) beg))
            ;; Delete the headers from the displayed articles.
            (set-buffer gnus-article-copy)
            (delete-region (goto-char (point-min))
@@ -845,7 +900,7 @@ If SILENT, don't prompt the user."
          method-alist))))
      ;; Override normal method.
      ((and (eq gnus-post-method 'current)
-          (not (eq (car group-method) 'nndraft))
+          (not (memq (car group-method) gnus-discouraged-post-methods))
           (gnus-get-function group-method 'request-post t))
       (assert (not arg))
       group-method)
@@ -902,11 +957,15 @@ If VERY-WIDE, make a very wide reply."
   (interactive
    (list (and current-prefix-arg
              (gnus-summary-work-articles 1))))
-  ;; Stripping headers should be specified with mail-yank-ignored-headers.
-  (when yank
-    (gnus-summary-goto-subject (car yank)))
-  (let ((gnus-article-reply (or yank (gnus-summary-article-number)))
-       (headers ""))
+  (let* ((article
+         (if (listp (car yank))
+             (caar yank)
+           (car yank)))
+        (gnus-article-reply (or article (gnus-summary-article-number)))
+        (headers ""))
+    ;; Stripping headers should be specified with mail-yank-ignored-headers.
+    (when yank
+      (gnus-summary-goto-subject article))
     (gnus-setup-message (if yank 'reply-yank 'reply)
       (if (not very-wide)
          (gnus-summary-select-article)
@@ -1021,7 +1080,11 @@ For the `inline' alternatives, also see the variable
         (let ((gnus-article-reply (gnus-summary-article-number)))
           (gnus-setup-message 'forward
             (gnus-summary-select-article)
-            (let ((mail-parse-charset gnus-newsgroup-charset)
+            (let ((mail-parse-charset
+                  (or (and (gnus-buffer-live-p gnus-article-buffer)
+                           (with-current-buffer gnus-article-buffer
+                             gnus-article-charset))
+                      gnus-newsgroup-charset))
                   (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
               (set-buffer gnus-original-article-buffer)
               (message-forward post)))))
@@ -1030,7 +1093,14 @@ For the `inline' alternatives, also see the variable
 (defun gnus-summary-resend-message (address n)
   "Resend the current article to ADDRESS."
   (interactive
-   (list (message-read-from-minibuffer "Resend message(s) to: ")
+   (list (message-read-from-minibuffer 
+         "Resend message(s) to: "
+         (when (gnus-buffer-live-p gnus-original-article-buffer)
+           ;; If some other article is currently selected, the
+           ;; initial-contents is wrong. Whatever, it is just the
+           ;; initial-contents.
+           (with-current-buffer gnus-original-article-buffer
+             (nnmail-fetch-field "to"))))
         current-prefix-arg))
   (let ((articles (gnus-summary-work-articles n))
        article)
@@ -1217,7 +1287,7 @@ If YANK is non-nil, include the original article."
        (erase-buffer)
        (gnus-debug)
        (setq text (buffer-string)))
-      (insert "<#part type=application/x-emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
+      (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
     (goto-char (point-min))
     (search-forward "Subject: " nil t)
     (message "")))
@@ -1243,10 +1313,7 @@ If YANK is non-nil, include the original article."
   "Attempts to go through the Gnus source file and report what variables have been changed.
 The source file has to be in the Emacs load path."
   (interactive)
-  (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el"
-                "gnus-art.el" "gnus-start.el" "gnus-async.el"
-                "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
-                "nnmail.el" "message.el"))
+  (let ((files gnus-debug-files)
        (point (point))
        file expr olist sym)
     (gnus-message 4 "Please wait while we snoop your variables...")
@@ -1269,6 +1336,7 @@ The source file has to be in the Emacs load path."
                (and (or (eq (car expr) 'defvar)
                         (eq (car expr) 'defcustom))
                     (stringp (nth 3 expr))
+                    (not (memq (nth 1 expr) gnus-debug-exclude-variables))
                     (or (not (boundp (nth 1 expr)))
                         (not (equal (eval (nth 2 expr))
                                     (symbol-value (nth 1 expr)))))
@@ -1406,7 +1474,9 @@ this is a reply."
                (gnus-message 1 "Couldn't store article in group %s: %s"
                              group (gnus-status-message method))
                (sit-for 2))
-             (when (and group-art gnus-inews-mark-gcc-as-read)
+             (when (and group-art 
+                        (or gnus-gcc-mark-as-read
+                            gnus-inews-mark-gcc-as-read))
                (gnus-group-mark-article-read group (cdr group-art)))
              (kill-buffer (current-buffer)))))))))
 
@@ -1527,6 +1597,7 @@ this is a reply."
                ;; Regexp string match on the group name.
                (string-match match group))
               ((eq match 'header)
+               ;; Obsolete format of header match.
                (and (gnus-buffer-live-p gnus-article-copy)
                     (with-current-buffer gnus-article-copy
                       (let ((header (message-fetch-field (pop style))))
@@ -1542,8 +1613,17 @@ this is a reply."
                  ;; Variable to be checked.
                  (symbol-value match))))
               ((listp match)
-               ;; This is a form to be evaled.
-               (eval match)))
+               (cond
+                ((eq (car match) 'header)
+                 ;; New format of header match.
+                 (and (gnus-buffer-live-p gnus-article-copy)
+                      (with-current-buffer gnus-article-copy
+                        (let ((header (message-fetch-field (nth 1 match))))
+                          (and header
+                               (string-match (nth 2 match) header))))))
+                (t
+                 ;; This is a form to be evaled.
+                 (eval match)))))
          ;; We have a match, so we set the variables.
          (dolist (attribute style)
            (setq element (pop attribute)
@@ -1572,13 +1652,20 @@ this is a reply."
                   ((listp value)
                    (eval value))))
            ;; Translate obsolescent value.
-           (when (eq element 'signature-file)
+           (cond
+            ((eq element 'signature-file)
              (setq element 'signature
                    filep t))
+            ((eq element 'x-face-file)
+             (setq element 'x-face
+                   filep t)))
            ;; Get the contents of file elems.
            (when (and filep v)
              (setq v (with-temp-buffer
                        (insert-file-contents v)
+                       (goto-char (point-max))
+                       (while (bolp)
+                         (delete-char -1))
                        (buffer-string))))
            (setq results (delq (assoc element results) results))
            (push (cons element v) results))))