Synch to Gnus 200308070200.

[elisp/gnus.git-] / lisp / gnus-art.el

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 9c5399e..1103eea 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -253,8 +253,8 @@ regexp.  If it matches, the text in question is not a signature."
   :type 'sexp
   :group 'gnus-article-hiding)
 
   :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
   (cond
    (noninteractive
 (defcustom gnus-article-x-face-command
   (cond
    (noninteractive

@@ -680,7 +680,9 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
      (:foreground "MidnightBlue" :italic t))
     (t
      (:italic t)))
      (:foreground "MidnightBlue" :italic t))
     (t
      (:italic t)))

-  "Face used for displaying newsgroups headers."
+  "Face used for displaying newsgroups headers.
+In the default setup this face is only used for crossposted
+articles."

   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
 
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
 

@@ -715,17 +717,17 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
     ("Subject" nil gnus-header-subject-face)
     ("Newsgroups:.*," nil gnus-header-newsgroups-face)
     ("" gnus-header-name-face gnus-header-content-face))
     ("Subject" nil gnus-header-subject-face)
     ("Newsgroups:.*," nil gnus-header-newsgroups-face)
     ("" gnus-header-name-face gnus-header-content-face))

-  "*Controls highlighting of article header.
+  "*Controls highlighting of article headers.

 
 An alist of the form (HEADER NAME CONTENT).
 
 
 An alist of the form (HEADER NAME CONTENT).
 

-HEADER is a regular expression which should match the name of an
-header header and NAME and CONTENT are either face names or nil.
+HEADER is a regular expression which should match the name of a
+header and NAME and CONTENT are either face names or nil.

 
 The name of each header field will be displayed using the face
 
 The name of each header field will be displayed using the face

-specified by the first element in the list where HEADER match the
-header name and NAME is non-nil.  Similarly, the content will be
-displayed by the first non-nil matching CONTENT face."
+specified by the first element in the list where HEADER matches
+the header name and NAME is non-nil.  Similarly, the content will
+be displayed by the first non-nil matching CONTENT face."

   :group 'gnus-article-headers
   :group 'gnus-article-highlight
   :type '(repeat (list (regexp :tag "Header")
   :group 'gnus-article-headers
   :group 'gnus-article-highlight
   :type '(repeat (list (regexp :tag "Header")

@@ -1034,7 +1036,7 @@ See Info node `(gnus)Customizing Articles' for details."
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
 
   :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
                        "This option is obsolete in Gnus 5.10.")
 
 (defcustom gnus-treat-strip-pem nil

@@ -1433,7 +1435,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))
   "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
   "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

@@ -2118,20 +2121,40 @@ unfolded."
 (defun article-display-face ()
   "Display any Face headers in the header."
   (interactive)
 (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."
 
 (defun article-display-x-face (&optional force)
   "Look for an X-Face header and display it if present."

@@ -2141,7 +2164,8 @@ unfolded."
       ;; Delete the old process, if any.
       (when (process-status "article-x-face")
        (delete-process "article-x-face"))
       ;; 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)
          ;; We have already displayed X-Faces, so we remove them
          ;; instead.
          (gnus-delete-images 'xface)

@@ -2251,7 +2275,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
          (mm-decode-body
           charset (and cte (intern (downcase
                                     (gnus-strip-whitespace cte))))
          (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."
 
 (defun article-decode-encoded-words ()
   "Remove encoded-word encoding from headers."

@@ -2408,8 +2432,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)))
       (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)
 
 
 (defun article-wash-html (&optional read-charset)

@@ -3402,7 +3426,7 @@ 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))
 
       (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 
+(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)
                            default-value)
   "Like `read-string' but allow for older XEmacsen that don't have the 5th arg."
   (if (and (featurep 'xemacs)

@@ -4485,7 +4509,7 @@ The uncompress method used is derived from `buffer-file-name'."
               (message "%s %s..." message basename))
           (unwind-protect
               (unless (memq (apply 'call-process-region
               (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)
                                    prog
                                    t (list t err-file) nil
                                    args)

@@ -4900,7 +4924,7 @@ If no internal viewer is available, use an external viewer."
 (defcustom gnus-mime-display-multipart-as-mixed nil
   "Display \"multipart\" parts as  \"multipart/mixed\".
 
 (defcustom gnus-mime-display-multipart-as-mixed nil
   "Display \"multipart\" parts as  \"multipart/mixed\".
 

-If `t', it overrides `nil' values of
+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
 `gnus-mime-display-multipart-alternative-as-mixed' and
 `gnus-mime-display-multipart-related-as-mixed'."
   :group 'gnus-article-mime

@@ -4916,7 +4940,7 @@ If `t', it overrides `nil' values of
 
 If displaying \"text/html\" is discouraged \(see
 `mm-discouraged-alternatives'\) images or other material inside a
 
 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'."
+\"multipart/related\" part might be overlooked when this variable is nil."

   :group 'gnus-article-mime
   :type 'boolean)
 
   :group 'gnus-article-mime
   :type 'boolean)
 

@@ -5222,7 +5246,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))
   "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)))
 
     (setq gnus-article-image-alist (delq entry gnus-article-image-alist))
     (gnus-delete-wash-type category)))
 

@@ -6258,7 +6282,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
   "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"))))
   :group 'gnus-article-buttons
   :type '(repeat (cons (number :tag "Rate")
                       (regexp :tag "Regexp"))))

@@ -6437,7 +6461,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
   "*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
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
   :group 'gnus-article-buttons

@@ -6448,7 +6472,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
   "*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
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
   :group 'gnus-article-buttons

@@ -6459,7 +6483,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
   "*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
 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

@@ -6585,9 +6609,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
 
 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,
 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.
 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.

@@ -7200,7 +7224,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
 
 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:
 whose names match REGEXP.
 
 For example: