(spam-summary-prepare-exit): use spam-process-ham-in-spam-groups
[gnus] / lisp / gnus-art.el
index 8c4b986..bc4575c 100644 (file)
@@ -243,8 +243,8 @@ regexp.  If it matches, the text in question is not a signature."
   :type 'sexp
   :group 'gnus-article-hiding)
 
-;; Fixme: This isn't the right thing for mixed graphical and and
-;; non-graphical frames in a session.
+;; Fixme: This isn't the right thing for mixed graphical and non-graphical
+;; frames in a session.
 (defcustom gnus-article-x-face-command
   (if (featurep 'xemacs)
       (if (or (gnus-image-type-available-p 'xface)
@@ -981,7 +981,7 @@ See Info node `(gnus)Customizing Articles' for details."
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
 
-(make-obsolete-variable 'gnus-treat-strip-pgp 
+(make-obsolete-variable 'gnus-treat-strip-pgp
                        "This option is obsolete in Gnus 5.10.")
 
 (defcustom gnus-treat-strip-pem nil
@@ -1324,7 +1324,8 @@ It is a string, such as \"PGP\". If nil, ask user."
   "Function used for converting HTML into text.")
 
 (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
-                             (mm-coding-system-p 'utf-8))
+                             (mm-coding-system-p 'utf-8)
+                             (executable-find idna-program))
   "Whether IDNA decoding of headers is used when viewing messages.
 This requires GNU Libidn, and by default only enabled if it is found."
   :group 'gnus-article-headers
@@ -1975,20 +1976,40 @@ unfolded."
 (defun article-display-face ()
   "Display any Face headers in the header."
   (interactive)
-  (gnus-with-article-headers
-    (let ((face (message-fetch-field "face")))
-      (when face
-       (let ((png (gnus-convert-face-to-png face))
-             image)
-         (when png
-           (setq image (gnus-create-image png 'png t))
-           (gnus-article-goto-header "from")
-           (when (bobp)
-             (insert "From: [no `from' set]\n")
-             (forward-char -17))
-           (gnus-add-wash-type 'face)
-           (gnus-add-image 'face image)
-           (gnus-put-image image)))))))
+  (let ((wash-face-p buffer-read-only))
+    (gnus-with-article-headers
+      ;; When displaying parts, this function can be called several times on
+      ;; the same article, without any intended toggle semantic (as typing `W
+      ;; D d' would have). So face deletion must occur only when we come from
+      ;; an interactive command, that is when the *Article* buffer is
+      ;; read-only.
+      (if (and wash-face-p (memq 'face gnus-article-wash-types))
+         (gnus-delete-images 'face)
+       (let (face faces)
+         (save-excursion
+           (when (and wash-face-p
+                      (progn
+                        (goto-char (point-min))
+                        (not (re-search-forward "^Face:[\t ]*" nil t)))
+                      (gnus-buffer-live-p gnus-original-article-buffer))
+             (set-buffer gnus-original-article-buffer))
+           (save-restriction
+             (mail-narrow-to-head)
+             (while (gnus-article-goto-header "Face")
+               (push (mail-header-field-value) faces))))
+         (while (setq face (pop faces))
+           (let ((png (gnus-convert-face-to-png face))
+                 image)
+             (when png
+               (setq image (gnus-create-image png 'png t))
+               (gnus-article-goto-header "from")
+               (when (bobp)
+                 (insert "From: [no `from' set]\n")
+                 (forward-char -17))
+               (gnus-add-wash-type 'face)
+               (gnus-add-image 'face image)
+               (gnus-put-image image nil 'face))))))
+      )))
 
 (defun article-display-x-face (&optional force)
   "Look for an X-Face header and display it if present."
@@ -1998,7 +2019,8 @@ unfolded."
       ;; Delete the old process, if any.
       (when (process-status "article-x-face")
        (delete-process "article-x-face"))
-      (if (memq 'xface gnus-article-wash-types)
+      ;; See the comment in `article-display-face'.
+      (if (and wash-face-p (memq 'xface gnus-article-wash-types))
          ;; We have already displayed X-Faces, so we remove them
          ;; instead.
          (gnus-delete-images 'xface)
@@ -2035,7 +2057,7 @@ unfolded."
            ;; We display the face.
            (if (symbolp gnus-article-x-face-command)
                ;; The command is a lisp function, so we call it.
-               (if (gnus-functionp gnus-article-x-face-command)
+               (if (functionp gnus-article-x-face-command)
                    (funcall gnus-article-x-face-command face)
                  (error "%s is not a function" gnus-article-x-face-command))
              ;; The command is a string, so we interpret the command
@@ -2108,7 +2130,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
        (mm-decode-body
         charset (and cte (intern (downcase
                                   (gnus-strip-whitespace cte))))
-        (car ctl) prompt))))))
+        (car ctl)))))))
 
 (defun article-decode-encoded-words ()
   "Remove encoded-word encoding from headers."
@@ -2271,8 +2293,8 @@ If READ-CHARSET, ask for a coding system."
       (while (re-search-forward
              "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
        (replace-match "\\1\\3" t)))
-    (when (and gnus-display-mime-function (interactive-p))
-      (funcall gnus-display-mime-function))))
+    (when (interactive-p)
+      (gnus-treat-article nil))))
 
 
 (defun article-wash-html (&optional read-charset)
@@ -2305,7 +2327,7 @@ If READ-CHARSET, ask for a coding system."
            (when entry
              (setq func (cdr entry)))
            (cond
-            ((gnus-functionp func)
+            ((functionp func)
              (funcall func))
             (t
              (apply (car func) (cdr func))))))))))
@@ -2579,7 +2601,7 @@ Point is left at the beginning of the narrowed-to region."
                       (< (- (point-max) (point)) limit))
                  (and (floatp limit)
                       (< (count-lines (point) (point-max)) limit))
-                 (and (gnus-functionp limit)
+                 (and (functionp limit)
                       (funcall limit))
                  (and (stringp limit)
                       (not (re-search-forward limit nil t))))
@@ -2781,7 +2803,7 @@ should replace the \"Date:\" one, or should be added below it."
                                  gnus-article-time-format)
                              (error nil))
                            gnus-article-time-format)))
-           (if (gnus-functionp format)
+           (if (functionp format)
                (funcall format time)
              (concat "Date: " (format-time-string format time)))))
         ;; ISO 8601.
@@ -3226,9 +3248,17 @@ The directory to save in defaults to `gnus-article-save-directory'."
       (shell-command-on-region (point-min) (point-max) command nil)))
   (setq gnus-last-shell-command command))
 
+(defmacro gnus-read-string (prompt &optional initial-contents history
+                           default-value)
+  "Like `read-string' but allow for older XEmacsen that don't have the 5th arg."
+  (if (and (featurep 'xemacs)
+          (< emacs-minor-version 2))
+      `(read-string ,prompt ,initial-contents ,history)
+    `(read-string ,prompt ,initial-contents ,history ,default-value)))
+
 (defun gnus-summary-pipe-to-muttprint (&optional command)
   "Pipe this article to muttprint."
-  (setq command (read-string
+  (setq command (gnus-read-string
                 "Print using command: " gnus-summary-muttprint-program
                 nil gnus-summary-muttprint-program))
   (gnus-summary-save-in-pipe command))
@@ -3914,9 +3944,7 @@ General format specifiers can also be used.  See Info node
             (let ((mbl1 mml-buffer-list))
               (setq mml-buffer-list mbl)
               (set (make-local-variable 'mml-buffer-list) mbl1))
-            ;; LOCAL argument of add-hook differs between GNU Emacs
-            ;; and XEmacs. make-local-hook makes sure they are local.
-            (make-local-hook 'kill-buffer-hook)
+            (gnus-make-local-hook 'kill-buffer-hook)
             (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
        `(lambda (no-highlight)
          (let ((mail-parse-charset (or gnus-article-charset
@@ -3994,9 +4022,7 @@ Replace it with some information about the removed part."
            (let ((mbl1 mml-buffer-list))
              (setq mml-buffer-list mbl)
              (set (make-local-variable 'mml-buffer-list) mbl1))
-           ;; LOCAL argument of add-hook differs between GNU Emacs
-           ;; and XEmacs. make-local-hook makes sure they are local.
-           (make-local-hook 'kill-buffer-hook)
+           (gnus-make-local-hook 'kill-buffer-hook)
            (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
        `(lambda (no-highlight)
          (let ((mail-parse-charset (or gnus-article-charset
@@ -4102,7 +4128,7 @@ The uncompress method used is derived from `buffer-file-name'."
               (message "%s %s..." message basename))
           (unwind-protect
               (unless (memq (apply 'call-process-region
-                                   (point-min) (point-max) 
+                                   (point-min) (point-max)
                                    prog
                                    t (list t err-file) nil
                                    args)
@@ -4514,9 +4540,28 @@ If no internal viewer is available, use an external viewer."
              (narrow-to-region (point-min) (point))
              (gnus-treat-article 'head))))))))
 
-(defvar gnus-mime-display-multipart-as-mixed nil)
-(defvar gnus-mime-display-multipart-alternative-as-mixed nil)
-(defvar gnus-mime-display-multipart-related-as-mixed nil)
+(defcustom gnus-mime-display-multipart-as-mixed nil
+  "Display \"multipart\" parts as  \"multipart/mixed\".
+
+If t, it overrides nil values of
+`gnus-mime-display-multipart-alternative-as-mixed' and
+`gnus-mime-display-multipart-related-as-mixed'."
+  :group 'gnus-article-mime
+  :type 'boolean)
+
+(defcustom gnus-mime-display-multipart-alternative-as-mixed nil
+  "Display \"multipart/alternative\" parts as  \"multipart/mixed\"."
+  :group 'gnus-article-mime
+  :type 'boolean)
+
+(defcustom gnus-mime-display-multipart-related-as-mixed nil
+  "Display \"multipart/related\" parts as  \"multipart/mixed\".
+
+If displaying \"text/html\" is discouraged \(see
+`mm-discouraged-alternatives'\) images or other material inside a
+\"multipart/related\" part might be overlooked when this variable is nil."
+  :group 'gnus-article-mime
+  :type 'boolean)
 
 (defun gnus-mime-display-part (handle)
   (cond
@@ -4817,7 +4862,7 @@ is the string to use when it is inactive.")
   "Delete all images in CATEGORY."
   (let ((entry (assq category gnus-article-image-alist)))
     (dolist (image (cdr entry))
-      (gnus-remove-image image))
+      (gnus-remove-image image category))
     (setq gnus-article-image-alist (delq entry gnus-article-image-alist))
     (gnus-delete-wash-type category)))
 
@@ -4888,14 +4933,31 @@ If given a numerical ARG, move forward ARG pages."
 (defun gnus-article-goto-next-page ()
   "Show the next page of the article."
   (interactive)
-  (gnus-eval-in-buffer-window gnus-summary-buffer
-    (gnus-summary-next-page)))
+  (when (gnus-article-next-page)
+    (goto-char (point-min))
+    (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
+
 
 (defun gnus-article-goto-prev-page ()
   "Show the next page of the article."
   (interactive)
-  (gnus-eval-in-buffer-window gnus-summary-buffer
-    (gnus-summary-prev-page)))
+  (if (bobp)
+      (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
+    (gnus-article-prev-page nil)))
+
+;; This is cleaner but currently breaks `gnus-pick-mode':
+;;
+;; (defun gnus-article-goto-next-page ()
+;;   "Show the next page of the article."
+;;   (interactive)
+;;   (gnus-eval-in-buffer-window gnus-summary-buffer
+;;     (gnus-summary-next-page)))
+;;
+;; (defun gnus-article-goto-prev-page ()
+;;   "Show the next page of the article."
+;;   (interactive)
+;;   (gnus-eval-in-buffer-window gnus-summary-buffer
+;;     (gnus-summary-prev-page)))
 
 (defun gnus-article-next-page (&optional lines)
   "Show the next page of the current article.
@@ -5647,7 +5709,7 @@ It should match all directories in the top level of `gnus-ctan-url'."
   "What to do when the button on a string as \"foo123@bar.invalid\" is pushed.
 Strings like this can be either a message ID or a mail address.  If it is one
 of the symbols `mid' or `mail', Gnus will always assume that the string is a
-message ID or a mail address, respectivly.  If this variable is set to the
+message ID or a mail address, respectively.  If this variable is set to the
 symbol `ask', always query the user what do do.  If it is a function, this
 function will be called with the string as it's only argument.  The function
 must return `mid', `mail', `invalid' or `ask'."
@@ -5713,7 +5775,7 @@ must return `mid', `mail', `invalid' or `ask'."
   "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
 
 A negative RATE indicates a message IDs, whereas a positive indicates a mail
-address.  The REGEXP is processed with `case-fold-search' set to `nil'."
+address.  The REGEXP is processed with `case-fold-search' set to nil."
   :group 'gnus-article-buttons
   :type '(repeat (cons (number :tag "Rate")
                       (regexp :tag "Regexp"))))
@@ -5892,7 +5954,7 @@ Calls `describe-variable' or `describe-function'."
   "*Integer that says how many TeX-related buttons Gnus will show.
 The higher the number, the more buttons will appear and the more false
 positives are possible.  Note that you can set this variable local to
-specifific groups.  Setting it higher in TeX groups is probably a good idea.
+specific groups.  Setting it higher in TeX groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
   :group 'gnus-article-buttons
@@ -5903,7 +5965,7 @@ how to set variables in specific groups."
   "*Integer that says how many man-related buttons Gnus will show.
 The higher the number, the more buttons will appear and the more false
 positives are possible.  Note that you can set this variable local to
-specifific groups.  Setting it higher in Unix groups is probably a good idea.
+specific groups.  Setting it higher in Unix groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
   :group 'gnus-article-buttons
@@ -5914,7 +5976,7 @@ how to set variables in specific groups."
   "*Integer that says how many emacs-related buttons Gnus will show.
 The higher the number, the more buttons will appear and the more false
 positives are possible.  Note that you can set this variable local to
-specifific groups.  Setting it higher in Emacs or Gnus related groups is
+specific groups.  Setting it higher in Emacs or Gnus related groups is
 probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
 `gnus-parameters' on how to set variables in specific groups."
   :group 'gnus-article-buttons
@@ -5955,7 +6017,9 @@ positives are possible."
     ("\\bmailto:\\([^ \n\t]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ;; CTAN
-    ("\\bCTAN:[ \t\n]*\\([^>)!;:,'\n\t ]*\\)"
+    ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\("
+            gnus-button-ctan-directory-regexp
+            "[^][>)!;:,'\n\t ]+\\)")
      0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1)
     ((concat "\\btex-archive/\\("
             gnus-button-ctan-directory-regexp
@@ -5995,9 +6059,9 @@ positives are possible."
      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
     ("`\\([a-z][-a-z0-9]+\\.el\\)'"
      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
-    ("`\\([a-z]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+    ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
      0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
-    ("`\\([a-z]+-[a-z]+\\)'"
+    ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
      0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
     ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
      1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
@@ -6038,9 +6102,9 @@ positives are possible."
 
 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
 REGEXP: is the string (case insensitive) matching text around the button (can
-also be lisp expression evaluating to a string),
+also be Lisp expression evaluating to a string),
 BUTTON: is the number of the regexp grouping actually matching the button,
-FORM: is a lisp expression which must eval to true for the button to
+FORM: is a Lisp expression which must eval to true for the button to
 be added,
 CALLBACK: is the function to call when the user push this button, and each
 PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
@@ -6613,7 +6677,7 @@ specified by `gnus-button-alist'."
 
 This variable is a list of FUNCTION or (REGEXP . FUNCTION).  If item
 is FUNCTION, FUNCTION will be apply to all newsgroups.  If item is a
-\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+\(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups
 whose names match REGEXP.
 
 For example: