* gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed
[gnus] / lisp / gnus-msg.el
index b1a79d3..11292bd 100644 (file)
@@ -116,16 +116,21 @@ 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)
@@ -134,6 +139,7 @@ See Info node `(gnus)Posting Styles'."
 
 (defcustom gnus-gcc-mark-as-read nil
   "If non-nil, automatically mark Gcc articles as read."
+  :version "21.1"
   :group 'gnus-message
   :type 'boolean)
 
@@ -148,6 +154,7 @@ See Info node `(gnus)Posting Styles'."
 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")
@@ -185,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
@@ -638,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)
@@ -704,6 +738,7 @@ header line with the old Message-ID."
            (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))
@@ -865,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)
@@ -922,14 +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
-     (if (listp (car yank))
-        (caar yank)
-       (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)
@@ -1044,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)))))
@@ -1247,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 "")))
@@ -1273,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...")
@@ -1299,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)))))
@@ -1559,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))))
@@ -1574,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)
@@ -1604,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))))