Synch with Gnus.

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

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index c65a62f..730f06c 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -216,7 +216,7 @@ regexp.  If it matches, the text in question is not a signature."
    ((and (fboundp 'image-type-available-p)
         (image-type-available-p 'xbm))
     'gnus-article-display-xface)
-   ((and (not gnus-xemacs)
+   ((and (not (featurep 'xemacs))
         window-system
         (module-installed-p 'x-face-mule))
     'x-face-mule-gnus-article-display-x-face)
@@ -631,8 +631,8 @@ displayed by the first non-nil matching CONTENT face."
     ("\223" "``")
     ("\224" "\"")
     ("\225" "*")
-    ("\226" "---")
-    ("\227" "-")
+    ("\226" "-")
+    ("\227" "--")
     ("\231" "(TM)")
     ("\233" ">")
     ("\234" "oe")
@@ -798,6 +798,13 @@ See the manual for details."
   :group 'gnus-article-treat
   :type gnus-article-treat-custom)
 
+(defcustom gnus-treat-hide-citation-maybe nil
+  "Hide cited text.
+Valid values are nil, t, `head', `last', an integer or a predicate.
+See the manual for details."
+  :group 'gnus-article-treat
+  :type gnus-article-treat-custom)
+
 (defcustom gnus-treat-strip-list-identifiers 'head
   "Strip list identifiers from `gnus-list-identifiers`.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -925,7 +932,7 @@ See the manual for details."
 (defcustom gnus-treat-display-xface
   (and (or (and (fboundp 'image-type-available-p)
                (image-type-available-p 'xbm))
-          (and gnus-xemacs (featurep 'xface))
+          (and (featurep 'xemacs) (featurep 'xface))
           (eq 'x-face-mule-gnus-article-display-x-face
               gnus-article-x-face-command))
        'head)
@@ -937,8 +944,11 @@ See the manual for details."
 (put 'gnus-treat-display-xface 'highlight t)
 
 (defcustom gnus-treat-display-smileys
-  (if (or (and gnus-xemacs (featurep 'xpm))
-         (and (not gnus-xemacs)
+  (if (or (and (featurep 'xemacs)
+              (featurep 'xpm))
+         (and (fboundp 'image-type-available-p)
+              (image-type-available-p 'pbm))
+         (and (not (featurep 'xemacs))
               window-system
               (module-installed-p 'gnus-bitmap)))
       t
@@ -950,7 +960,7 @@ See the manual for details."
   :type gnus-article-treat-custom)
 (put 'gnus-treat-display-smileys 'highlight t)
 
-(defcustom gnus-treat-display-picons (if gnus-xemacs 'head nil)
+(defcustom gnus-treat-display-picons (if (featurep 'xemacs) 'head nil)
   "Display picons.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See the manual for details."
@@ -1017,6 +1027,7 @@ See the manual for details."
     (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
     (gnus-treat-hide-signature gnus-article-hide-signature)
     (gnus-treat-hide-citation gnus-article-hide-citation)
+    (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
     (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
     (gnus-treat-strip-pgp gnus-article-hide-pgp)
     (gnus-treat-strip-pem gnus-article-hide-pem)
@@ -1381,7 +1392,7 @@ if given a positive prefix, always hide."
          (narrow-to-region header-start header-end)
          (article-hide-headers)
          ;; Re-display X-Face image under XEmacs.
-         (when (and gnus-xemacs
+         (when (and (featurep 'xemacs)
                     (gnus-functionp gnus-article-x-face-command))
            (let ((func (cadr (assq 'gnus-treat-display-xface
                                    gnus-treatment-function-alist)))
@@ -1695,9 +1706,11 @@ or not."
       (unless charset 
        (setq charset gnus-newsgroup-charset))
       (when (or force
-               (and type (string-match "quoted-printable" (downcase type))))
+               (and type (let ((case-fold-search t))
+                           (string-match "quoted-printable" type))))
        (article-goto-body)
-       (quoted-printable-decode-region (point) (point-max) charset)))))
+       (quoted-printable-decode-region
+        (point) (point-max) (mm-charset-to-coding-system charset))))))
 
 (defun article-de-base64-unreadable (&optional force)
   "Translate a base64 article.
@@ -1720,13 +1733,14 @@ If FORCE, decode the article whether it is marked as base64 not."
       (unless charset 
        (setq charset gnus-newsgroup-charset))
       (when (or force
-               (and type (string-match "base64" (downcase type))))
+               (and type (let ((case-fold-search t))
+                           (string-match "base64" type))))
        (article-goto-body)
        (save-restriction
          (narrow-to-region (point) (point-max))
          (base64-decode-region (point-min) (point-max))
-         (if (mm-coding-system-p charset)
-             (mm-decode-coding-region (point-min) (point-max) charset)))))))
+         (mm-decode-coding-region
+          (point-min) (point-max) (mm-charset-to-coding-system charset)))))))
 
 (eval-when-compile
   (require 'rfc1843))
@@ -3116,6 +3130,7 @@ If ALL-HEADERS is non-nil, no headers are hidden."
              (gnus-set-mode-line 'article))
            (article-goto-body)
            (set-window-point (get-buffer-window (current-buffer)) (point))
+           (gnus-configure-windows 'article)
            t))))))
 
 (defun gnus-article-prepare-mime-display (&optional number)
@@ -3413,9 +3428,13 @@ value of the variable `gnus-show-mime' is non-nil."
                             gnus-summary-show-article-charset-alist))
                  (read-coding-system "Charset: ")))))
       (forward-line 2)
-      (mm-insert-inline handle (if charset 
-                                  (mm-decode-coding-string contents charset)
-                                contents))
+      (mm-insert-inline handle
+                       (if (and charset 
+                                (setq charset (mm-charset-to-coding-system 
+                                               charset))
+                                (not (eq charset 'ascii)))
+                           (mm-decode-coding-string contents charset)
+                         contents))
       (goto-char b))))
 
 (defun gnus-mime-externalize-part (&optional handle)
@@ -3534,6 +3553,11 @@ In no internal viewer is available, use an external viewer."
          (when (eq (gnus-mm-display-part handle) 'internal)
            (gnus-set-window-start)))))))
 
+(defsubst gnus-article-mime-total-parts ()
+  (if (bufferp (car gnus-article-mime-handles))
+      1 ;; single part
+    (1- (length gnus-article-mime-handles))))
+
 (defun gnus-mm-display-part (handle)
   "Display HANDLE and fix MIME button."
   (let ((id (get-text-property (point) 'gnus-part))
@@ -3567,7 +3591,7 @@ In no internal viewer is available, use an external viewer."
                      (narrow-to-region (point) (point-max))
                      (gnus-treat-article
                       nil id
-                      (1- (length gnus-article-mime-handles))
+                      (gnus-article-mime-total-parts)
                       (mm-handle-media-type handle)))))
              (select-window window))))
       (goto-char point)
@@ -3637,8 +3661,8 @@ In no internal viewer is available, use an external viewer."
        ;; window, overlay, position.
        (if (mm-handle-displayed-p
             (if overlay
-                (with-current-buffer (overlay-buffer overlay)
-                  (widget-get (widget-at (overlay-start overlay))
+                (with-current-buffer (gnus-overlay-buffer overlay)
+                  (widget-get (widget-at (gnus-overlay-start overlay))
                               :mime-handle))
               (widget-get widget/window :mime-handle)))
            "hide" "show")
@@ -3755,7 +3779,8 @@ In no internal viewer is available, use an external viewer."
            (setq display t)
          (when (equal (mm-handle-media-supertype handle) "text")
            (setq text t)))
-       (let ((id (1+ (length gnus-article-mime-handle-alist))))
+       (let ((id (1+ (length gnus-article-mime-handle-alist)))
+             beg)
          (push (cons id handle) gnus-article-mime-handle-alist)
          (when (or (not display)
                    (not (gnus-unbuttonized-mime-type-p type)))
@@ -3764,8 +3789,8 @@ In no internal viewer is available, use an external viewer."
             handle id (list (or display (and not-attachment text))))
            (gnus-article-insert-newline)
            ;(gnus-article-insert-newline)
-           (setq move t)))
-       (let ((beg (point)))
+           (setq move t))
+         (setq beg (point))
          (cond
           (display
            (when move
@@ -3791,8 +3816,8 @@ In no internal viewer is available, use an external viewer."
            (save-restriction
              (narrow-to-region beg (point))
              (gnus-treat-article
-              nil (length gnus-article-mime-handle-alist)
-              (1- (length gnus-article-mime-handles))
+              nil id 
+              (gnus-article-mime-total-parts)
               (mm-handle-media-type handle)))))))))
 
 (defun gnus-unbuttonized-mime-type-p (type)
@@ -3894,7 +3919,7 @@ In no internal viewer is available, use an external viewer."
                  (narrow-to-region (car begend) (point-max))
                  (gnus-treat-article
                   nil (length gnus-article-mime-handle-alist)
-                  (1- (length gnus-article-mime-handles))
+                  (gnus-article-mime-total-parts)
                   (mm-handle-media-type handle))))))
          (goto-char (point-max))
          (setcdr begend (point-marker)))))
@@ -4298,10 +4323,10 @@ If given a prefix, show the hidden text instead."
                                gnus-refer-article-method))
                  result
                  (buffer-read-only nil))
-             (setq methods
-                   (if (listp methods)
-                       methods
-                     (list methods)))
+             (if (or (not (listp methods))
+                     (and (symbolp (car methods))
+                          (assq (car methods) nnoo-definition-alist)))
+                 (setq methods (list methods)))
              (when (and (null gnus-override-method)
                         methods)
                (setq gnus-override-method (pop methods)))
@@ -5099,18 +5124,14 @@ forbidden in URL encoding."
        (message-goto-subject)))))
 
 (defun gnus-button-mailto (address)
-  ;; Mail to ADDRESS.
+  "Mail to ADDRESS."
   (set-buffer (gnus-copy-article-buffer))
-  (gnus-setup-message 'reply
-    (message-reply address)))
+  (message-reply address))
 
-(defun gnus-button-reply (address)
-  ;; Reply to ADDRESS.
-  (gnus-setup-message 'reply
-    (message-reply address)))
+(defalias 'gnus-button-reply 'message-reply)
 
 (defun gnus-button-embedded-url (address)
-  "Browse ADDRESS."
+  "Activate ADDRESS with `browse-url'."
   (browse-url (gnus-strip-whitespace address)))
 
 (defun gnus-article-smiley-display ()
@@ -5293,11 +5314,13 @@ For example:
                             'mime-view-entity entity))))))
 
 ;; Dynamic variables.
-(defvar part-number)
-(defvar total-parts)
-(defvar type)
-(defvar condition)
-(defvar length)
+(eval-when-compile
+  (defvar part-number)
+  (defvar total-parts)
+  (defvar type)
+  (defvar condition)
+  (defvar length))
+
 (defun gnus-treat-predicate (val)
   (cond
    ((null val)