Synch with Oort Gnus.
[elisp/gnus.git-] / lisp / gnus-art.el
index 5a29e9a..94849bb 100644 (file)
@@ -278,6 +278,7 @@ asynchronously.      The compressed face will be piped to this command."
                           x-face-mule-gnus-article-display-x-face))
                     'function))))
   ;;:version "21.1"
+  :group 'gnus-picon
   :group 'gnus-article-washing)
 
 (defcustom gnus-article-x-face-too-ugly nil
@@ -754,10 +755,13 @@ be controlled by `gnus-treat-body-boundary'."
                 string))
 
 (defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces")
-  "*Defines the location of the faces database.
+  "Defines the location of the faces database.
 For information on obtaining this database of pretty pictures, please
 see http://www.cs.indiana.edu/picons/ftp/index.html"
-  :type 'directory
+  :type '(repeat directory)
+  :link '(url-link :tag "download" 
+                  "http://www.cs.indiana.edu/picons/ftp/index.html")
+  :link '(custom-manual "(gnus)Picons")
   :group 'gnus-picon)
 
 (defun gnus-picons-installed-p ()
@@ -1190,6 +1194,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
   :group 'gnus-article-treat
+  :group 'gnus-picon
+  :link '(info-link "(gnus)Customizing Articles")
+  :link '(info-link "(gnus)Picons")
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-from-picon 'highlight t)
 
@@ -1202,6 +1209,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
   :group 'gnus-article-treat
+  :group 'gnus-picon
+  :link '(info-link "(gnus)Customizing Articles")
+  :link '(info-link "(gnus)Picons")
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-mail-picon 'highlight t)
 
@@ -1214,6 +1224,9 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
   :group 'gnus-article-treat
+  :group 'gnus-picon
+  :link '(info-link "(gnus)Customizing Articles")
+  :link '(info-link "(gnus)Picons")
   :type gnus-article-treat-head-custom)
 (put 'gnus-treat-newsgroups-picon 'highlight t)
 
@@ -1375,8 +1388,8 @@ It is a string, such as \"PGP\". If nil, ask user."
   (let ((table (copy-syntax-table text-mode-syntax-table)))
     ;; This causes the citation match run O(2^n).
     ;; (modify-syntax-entry ?- "w" table)
-    (modify-syntax-entry ?> ")" table)
-    (modify-syntax-entry ?< "(" table)
+    (modify-syntax-entry ?> ")<" table)
+    (modify-syntax-entry ?< "(>" table)
     table)
   "Syntax table used in article mode buffers.
 Initialized from `text-mode-syntax-table.")
@@ -2283,7 +2296,7 @@ If READ-CHARSET, ask for a coding system."
     (let ((buffer-read-only nil))
       (goto-char (point-min))
       (while (re-search-forward
-             "^\\(\\(https?\\|ftp\\)://\\S-+\\)\n\\(\\S-+\\)" nil t)
+             "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
        (replace-match "\\1\\3" t)))))
 
 (defun article-wash-html (&optional read-charset)
@@ -2327,9 +2340,8 @@ If READ-CHARSET, ask for a coding system."
   (let ((w3-strict-width (window-width))
        (url-standalone-mode t)
        (url-gateway-unplugged t)
-       (w3-honor-stylesheets nil)
-       (w3-delay-image-loads t))
-    (condition-case var
+       (w3-honor-stylesheets nil))
+    (condition-case ()
        (w3-region (point-min) (point-max))
       (error))))
 
@@ -3362,7 +3374,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                   mml2015-use
                   (mml2015-clear-verify-function))
          (with-temp-buffer
-           (insert-buffer gnus-original-article-buffer)
+           (insert-buffer-substring gnus-original-article-buffer)
            (setq items (split-string sig))
            (message-narrow-to-head)
            (let ((inhibit-point-motion-hooks t)
@@ -3861,6 +3873,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                   gnus-article-mime-handle-alist))
              (gnus-set-mode-line 'article))
            (article-goto-body)
+           (unless (bobp)
+             (forward-line -1))
            (set-window-point (get-buffer-window (current-buffer)) (point))
            (gnus-configure-windows 'article)
            t))))))
@@ -4248,7 +4262,7 @@ General format specifiers can also be used.  See
   (gnus-article-check-buffer)
   (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
         (contents (and handle (mm-get-part handle)))
-        (file (make-temp-name (expand-file-name "mm." mm-tmp-directory)))
+        (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory)))
         (printer (mailcap-mime-info (mm-handle-type handle) "print")))
     (when contents
        (if printer
@@ -5293,10 +5307,8 @@ If given a prefix, show the hidden text instead."
   (autoload 'nneething-get-file-name "nneething"))
 
 (defun gnus-request-article-this-buffer (article group)
-  "Get an article and insert it into this buffer.
-T-gnus change: Insert an article into `gnus-original-article-buffer'."
+  "Get an article and insert it into this buffer."
   (let (do-update-line sparse-header)
-    ;; The current buffer is `gnus-article-buffer'.
     (prog1
        (save-excursion
          (erase-buffer)
@@ -5349,16 +5361,6 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'."
                                 (file-directory-p dir))
                        (setq article 'nneething)
                        (gnus-group-enter-directory dir))))))))
-         (setq gnus-original-article (cons group article))
-
-         ;; The current buffer is `gnus-original-article-buffer'.
-         (if (get-buffer gnus-original-article-buffer)
-             (set-buffer gnus-original-article-buffer)
-           (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
-           (set-buffer-multibyte nil)
-           (buffer-disable-undo)
-           (setq major-mode 'gnus-original-article-mode)
-           (setq buffer-read-only nil))
 
          (cond
           ;; Refuse to select canceled articles.
@@ -5371,6 +5373,15 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'."
                            (assq article gnus-newsgroup-reads)))
                     gnus-canceled-mark))
            nil)
+          ;; We first check `gnus-original-article-buffer'.
+          ((and (get-buffer gnus-original-article-buffer)
+                (numberp article)
+                (save-excursion
+                  (set-buffer gnus-original-article-buffer)
+                  (and (equal (car gnus-original-article) group)
+                       (eq (cdr gnus-original-article) article))))
+           (insert-buffer-substring gnus-original-article-buffer)
+           'article)
           ;; Check the backlog.
           ((and gnus-keep-backlog
                 (gnus-backlog-request-article group article (current-buffer)))
@@ -5397,6 +5408,8 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'."
            (let ((gnus-override-method gnus-override-method)
                  (methods (and (stringp article)
                                gnus-refer-article-method))
+                 (backend (car (gnus-find-method-for-group
+                                gnus-newsgroup-name)))
                  result
                  (buffer-read-only nil))
              (if (or (not (listp methods))
@@ -5415,7 +5428,8 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'."
                (gnus-kill-all-overlays)
                (let ((gnus-newsgroup-name group))
                  (gnus-check-group-server))
-               (when (gnus-request-article article group (current-buffer))
+               (cond
+                ((gnus-request-article article group (current-buffer))
                  (when (numberp article)
                    (gnus-async-prefetch-next group article
                                              gnus-summary-buffer)
@@ -5423,10 +5437,13 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'."
                      (gnus-backlog-enter-article
                       group article (current-buffer))))
                  (setq result 'article))
-               (if (not result)
-                   (if methods
-                       (setq gnus-override-method (pop methods))
-                     (setq result 'done))))
+                (methods
+                 (setq gnus-override-method (pop methods)))
+                ((not (string-match "^400 "
+                                    (nnheader-get-report backend)))
+                 ;; If we get 400 server disconnect, reconnect and
+                 ;; retry; otherwise, assume the article has expired.
+                 (setq result 'done))))
              (and (eq result 'article) 'article)))
           ;; It was a pseudo.
           (t article)))
@@ -5434,15 +5451,27 @@ T-gnus change: Insert an article into `gnus-original-article-buffer'."
       ;; Associate this article with the current summary buffer.
       (setq gnus-article-current-summary gnus-summary-buffer)
 
-      ;; Copy the requested article from `gnus-original-article-buffer'.
-      (unless (equal (buffer-name (current-buffer))
-                    (buffer-name (get-buffer gnus-original-article-buffer)))
-       (insert-buffer gnus-original-article-buffer))
+      ;; Take the article from the original article buffer
+      ;; and place it in the buffer it's supposed to be in.
+      (when (and (get-buffer gnus-article-buffer)
+                (equal (buffer-name (current-buffer))
+                       (buffer-name (get-buffer gnus-article-buffer))))
+       (save-excursion
+         (if (get-buffer gnus-original-article-buffer)
+             (set-buffer gnus-original-article-buffer)
+           (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
+           (buffer-disable-undo)
+           (setq major-mode 'gnus-original-article-mode)
+           (setq buffer-read-only t))
+         (let (buffer-read-only)
+           (erase-buffer)
+           (insert-buffer-substring gnus-article-buffer))
+         (setq gnus-original-article (cons group article)))
 
-      ;; Decode charsets.
-      (run-hooks 'gnus-article-decode-hook)
-      ;; Mark article as decoded or not.
-      (setq gnus-article-decoded-p gnus-article-decode-hook)
+       ;; Decode charsets.
+       (run-hooks 'gnus-article-decode-hook)
+       ;; Mark article as decoded or not.
+       (setq gnus-article-decoded-p gnus-article-decode-hook))
 
       ;; Update sparse articles.
       (when (and do-update-line
@@ -5549,7 +5578,6 @@ This is an extended text-mode.
        '(message-font-lock-keywords t))
   (set (make-local-variable 'mail-header-separator) "")
   (easy-menu-add message-mode-field-menu message-mode-map)
-  (mml-mode)
   (setq buffer-read-only nil)
   (buffer-enable-undo)
   (widen))
@@ -5596,6 +5624,7 @@ groups."
        (winconf gnus-prev-winconf))
     (remove-hook 'gnus-article-mode-hook
                 'gnus-article-mime-edit-article-unwind)
+    (widen) ;; Widen it in case that users narrowed the buffer.
     (funcall func arg)
     (set-buffer buf)
     ;; The cache and backlog have to be flushed somewhat.
@@ -5629,7 +5658,7 @@ groups."
          (window-start (window-start)))
       (erase-buffer)
       (if (gnus-buffer-live-p gnus-original-article-buffer)
-         (insert-buffer gnus-original-article-buffer))
+         (insert-buffer-substring gnus-original-article-buffer))
       (let ((winconf gnus-prev-winconf))
        (gnus-article-mode)
        (set-window-configuration winconf)
@@ -5699,7 +5728,7 @@ after replacing with the original article."
                             'gnus-article-mime-edit-exit
                             gnus-article-edit-mode-map)
   (erase-buffer)
-  (insert-buffer gnus-original-article-buffer)
+  (insert-buffer-substring gnus-original-article-buffer)
   (let ((ofn (symbol-function 'mime-edit-decode-single-part-in-buffer)))
     (fset 'mime-edit-decode-single-part-in-buffer
          (lambda (&rest args)
@@ -5790,7 +5819,7 @@ after replacing with the original article."
     ;; This is how URLs _should_ be embedded in text...
     ("<URL: *\\([^<>]*\\)>" 1 t gnus-button-embedded-url 1)
     ;; Raw URLs.
-    (,gnus-button-url-regexp 0 t browse-url 0))
+    (gnus-button-url-regexp 0 t browse-url 0))
   "*Alist of regexps matching buttons in article bodies.
 
 Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
@@ -5804,7 +5833,7 @@ PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
 CALLBACK can also be a variable, in that case the value of that
 variable it the real callback function."
   :group 'gnus-article-buttons
-  :type '(repeat (list regexp
+  :type '(repeat (list (choice regexp variable)
                       (integer :tag "Button")
                       (sexp :tag "Form")
                       (function :tag "Callback")
@@ -6032,7 +6061,7 @@ specified by `gnus-button-alist'."
       (article-goto-body)
       (setq beg (point))
       (while (setq entry (pop alist))
-       (setq regexp (car entry))
+       (setq regexp (eval (car entry)))
        (goto-char beg)
        (while (re-search-forward regexp nil t)
          (let* ((start (and entry (match-beginning (nth 1 entry))))
@@ -6141,7 +6170,7 @@ specified by `gnus-button-alist'."
        (entry nil))
     (while alist
       (setq entry (pop alist))
-      (if (looking-at (car entry))
+      (if (looking-at (eval (car entry)))
          (setq alist nil)
        (setq entry nil)))
     entry))