Sync up with gnus-5.6.38
[elisp/gnus.git-] / lisp / gnus-art.el
index f408833..6f4d9bf 100644 (file)
@@ -456,12 +456,12 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
 (defface gnus-header-from-face
   '((((class color)
       (background dark))
-     (:foreground "spring green" :bold t))
+     (:foreground "spring green"))
     (((class color)
       (background light))
-     (:foreground "red3" :bold t))
+     (:foreground "red3"))
     (t
-     (:bold t :italic t)))
+     (:italic t)))
   "Face used for displaying from headers."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
@@ -469,10 +469,10 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
 (defface gnus-header-subject-face
   '((((class color)
       (background dark))
-     (:foreground "SeaGreen3" :bold t))
+     (:foreground "SeaGreen3"))
     (((class color)
       (background light))
-     (:foreground "red4" :bold t))
+     (:foreground "red4"))
     (t
      (:bold t :italic t)))
   "Face used for displaying subject headers."
@@ -482,12 +482,12 @@ Obsolete; use the face `gnus-signature-face' for customizations instead."
 (defface gnus-header-newsgroups-face
   '((((class color)
       (background dark))
-     (:foreground "yellow" :bold t :italic t))
+     (:foreground "yellow" :italic t))
     (((class color)
       (background light))
-     (:foreground "MidnightBlue" :bold t :italic t))
+     (:foreground "MidnightBlue" :italic t))
     (t
-     (:bold t :italic t)))
+     (:italic t)))
   "Face used for displaying newsgroups headers."
   :group 'gnus-article-headers
   :group 'gnus-article-highlight)
@@ -588,7 +588,7 @@ Initialized from `text-mode-syntax-table.")
    b e (cons 'article-type (cons type gnus-hidden-properties))))
 
 (defun gnus-article-unhide-text-type (b e type)
-  "Hide text of TYPE between B and E."
+  "Unhide text of TYPE between B and E."
   (remove-text-properties
    b e (cons 'article-type (cons type gnus-hidden-properties)))
   (when (memq 'intangible gnus-hidden-properties)
@@ -907,15 +907,19 @@ characters to translate to."
        (nnheader-narrow-to-headers)
        (setq from (message-fetch-field "from"))
        (goto-char (point-min))
-       (while (and gnus-article-x-face-command
-                   (or force
-                       ;; Check whether this face is censored.
-                       (not gnus-article-x-face-too-ugly)
-                       (and gnus-article-x-face-too-ugly from
-                            (not (string-match gnus-article-x-face-too-ugly
-                                               from))))
-                   ;; Has to be present.
-                   (re-search-forward "^X-Face: " nil t))
+       ;; This used to try to do multiple faces (`while' instead of
+       ;; `when' below), but (a) sending multiple EOFs to xv doesn't
+       ;; work (b) it can crash some versions of Emacs (c) are
+       ;; multiple faces really something to encourage?
+       (when (and gnus-article-x-face-command
+                  (or force
+                      ;; Check whether this face is censored.
+                      (not gnus-article-x-face-too-ugly)
+                      (and gnus-article-x-face-too-ugly from
+                           (not (string-match gnus-article-x-face-too-ugly
+                                              from))))
+                  ;; Has to be present.
+                  (re-search-forward "^X-Face: " nil t))
          ;; We now have the area of the buffer where the X-Face is stored.
          (save-excursion
            (let ((beg (point))
@@ -958,27 +962,25 @@ always hide."
        (goto-char (point-min))
        ;; Hide the "header".
        (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
-         (gnus-article-hide-text-type (1+ (match-beginning 0))
-                                      (match-end 0) 'pgp)
+         (delete-region (1+ (match-beginning 0)) (match-end 0))
          (setq beg (point))
          ;; Hide the actual signature.
          (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
               (setq end (1+ (match-beginning 0)))
-              (gnus-article-hide-text-type
+              (delete-region
                end
                (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
                    (match-end 0)
                  ;; Perhaps we shouldn't hide to the end of the buffer
                  ;; if there is no end to the signature?
-                 (point-max))
-               'pgp))
+                 (point-max))))
          ;; Hide "- " PGP quotation markers.
          (when (and beg end)
            (narrow-to-region beg end)
            (goto-char (point-min))
            (while (re-search-forward "^- " nil t)
-             (gnus-article-hide-text-type
-              (match-beginning 0) (match-end 0) 'pgp))
+             (delete-region
+              (match-beginning 0) (match-end 0)))
            (widen))
          (gnus-run-hooks 'gnus-article-hide-pgp-hook))))))
 
@@ -1086,37 +1088,38 @@ always hide."
 (defun gnus-article-narrow-to-signature ()
   "Narrow to the signature; return t if a signature is found, else nil."
   (widen)
-  (when (and (boundp 'mime::preview/content-list)
-            mime::preview/content-list)
-    ;; We have a MIMEish article, so we use the MIME data to narrow.
-    (let ((pcinfo (car (last mime::preview/content-list))))
-      (ignore-errors
-       (narrow-to-region
-        (funcall (intern "mime::preview-content-info/point-min") pcinfo)
-        (point-max)))))
-
-  (when (gnus-article-search-signature)
-    (forward-line 1)
-    ;; Check whether we have some limits to what we consider
-    ;; to be a signature.
-    (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
-                   (list gnus-signature-limit)))
-         limit limited)
-      (while (setq limit (pop limits))
-       (if (or (and (integerp limit)
-                    (< (- (point-max) (point)) limit))
-               (and (floatp limit)
-                    (< (count-lines (point) (point-max)) limit))
-               (and (gnus-functionp limit)
-                    (funcall limit))
-               (and (stringp limit)
-                    (not (re-search-forward limit nil t))))
-           ()                          ; This limit did not succeed.
-         (setq limited t
-               limits nil)))
-      (unless limited
-       (narrow-to-region (point) (point-max))
-       t))))
+  (let ((inhibit-point-motion-hooks t))
+    (when (and (boundp 'mime::preview/content-list)
+              mime::preview/content-list)
+      ;; We have a MIMEish article, so we use the MIME data to narrow.
+      (let ((pcinfo (car (last mime::preview/content-list))))
+       (ignore-errors
+         (narrow-to-region
+          (funcall (intern "mime::preview-content-info/point-min") pcinfo)
+          (point-max)))))
+
+    (when (gnus-article-search-signature)
+      (forward-line 1)
+      ;; Check whether we have some limits to what we consider
+      ;; to be a signature.
+      (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
+                     (list gnus-signature-limit)))
+           limit limited)
+       (while (setq limit (pop limits))
+         (if (or (and (integerp limit)
+                      (< (- (point-max) (point)) limit))
+                 (and (floatp limit)
+                      (< (count-lines (point) (point-max)) limit))
+                 (and (gnus-functionp limit)
+                      (funcall limit))
+                 (and (stringp limit)
+                      (not (re-search-forward limit nil t))))
+             ()                        ; This limit did not succeed.
+           (setq limited t
+                 limits nil)))
+       (unless limited
+         (narrow-to-region (point) (point-max))
+         t)))))
 
 (defun gnus-article-search-signature ()
   "Search the current buffer for the signature separator.
@@ -1409,7 +1412,7 @@ is to run."
   (unless n
     (setq n 1))
   (gnus-stop-date-timer)
-  (setq article-lapsed-timer 
+  (setq article-lapsed-timer
        (nnheader-run-at-time 1 n 'article-update-date-lapsed)))
 
 (defun gnus-stop-date-timer ()
@@ -1891,9 +1894,9 @@ commands:
   (use-local-map gnus-article-mode-map)
   (gnus-update-format-specifications nil 'article-mode)
   (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
-  (make-local-variable 'gnus-page-broken) 
-  (make-local-variable 'gnus-button-marker-list) 
-  (make-local-variable 'gnus-article-current-summary) 
+  (make-local-variable 'gnus-page-broken)
+  (make-local-variable 'gnus-button-marker-list)
+  (make-local-variable 'gnus-article-current-summary)
   (gnus-set-default-directory)
   (buffer-disable-undo (current-buffer))
   (setq buffer-read-only t)
@@ -1919,23 +1922,20 @@ commands:
        (gnus-set-global-variables)))
     ;; Init original article buffer.
     (save-excursion
-      (set-buffer (get-buffer-create gnus-original-article-buffer))
+      (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
       (buffer-disable-undo (current-buffer))
       (setq major-mode 'gnus-original-article-mode)
-      (gnus-add-current-to-buffer-list)
       (make-local-variable 'gnus-original-article))
     (if (get-buffer name)
        (save-excursion
          (set-buffer name)
          (buffer-disable-undo (current-buffer))
          (setq buffer-read-only t)
-         (gnus-add-current-to-buffer-list)
          (unless (eq major-mode 'gnus-article-mode)
            (gnus-article-mode))
          (current-buffer))
       (save-excursion
-       (set-buffer (get-buffer-create name))
-       (gnus-add-current-to-buffer-list)
+       (set-buffer (gnus-get-buffer-create name))
        (gnus-article-mode)
        (make-local-variable 'gnus-summary-buffer)
        (current-buffer)))))
@@ -2038,9 +2038,10 @@ If ALL-HEADERS is non-nil, no headers are hidden."
                      (message "Message marked for downloading"))
                  (gnus-summary-mark-article article gnus-canceled-mark)
                  (unless (memq article gnus-newsgroup-sparse)
-                   (gnus-error 1 
+                   (gnus-error 1
                     "No such article (may have expired or been canceled)")))))
-         (if (or (eq result 'pseudo) (eq result 'nneething))
+         (if (or (eq result 'pseudo)
+                 (eq result 'nneething))
              (progn
                (save-excursion
                  (set-buffer summary-buffer)
@@ -2119,6 +2120,8 @@ If ALL-HEADERS is non-nil, no headers are hidden."
            (gnus-set-mode-line 'article)
            (gnus-configure-windows 'article)
            (goto-char (point-min))
+           (search-forward "\n\n" nil t)
+           (set-window-point (get-buffer-window (current-buffer)) (point))
            t))))))
 
 (defun gnus-article-wash-status ()
@@ -2143,7 +2146,9 @@ If ALL-HEADERS is non-nil, no headers are hidden."
              (if mime ?m ? )
              (if emphasis ?e ? )))))
 
-(defun gnus-article-hide-headers-if-wanted ()
+(fset 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
+
+(defun gnus-article-maybe-hide-headers ()
   "Hide unwanted headers if `gnus-have-all-headers' is nil.
 Provided for backwards compatibility."
   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
@@ -2454,8 +2459,11 @@ If given a prefix, show the hidden text instead."
                               gnus-newsgroup-name)))
                  (when (and (eq (car method) 'nneething)
                             (vectorp header))
-                   (let ((dir (concat (file-name-as-directory (nth 1 method))
-                                      (mail-header-subject header))))
+                   (let ((dir (concat
+                               (file-name-as-directory
+                                (or (cadr (assq 'nneething-address method))
+                                    (nth 1 method)))
+                               (mail-header-subject header))))
                      (when (file-directory-p dir)
                        (setq article 'nneething)
                        (gnus-group-enter-directory dir))))))))
@@ -2504,6 +2512,26 @@ If given a prefix, show the hidden text instead."
           ;; It was a pseudo.
           (t article)))
 
+      ;; Associate this article with the current summary buffer.
+      (setq gnus-article-current-summary gnus-summary-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 (current-buffer))
+           (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))))
+
       ;; Update sparse articles.
       (when (and do-update-line
                 (or (numberp article)
@@ -2577,6 +2605,7 @@ groups."
   (let ((winconf (current-window-configuration)))
     (set-buffer gnus-article-buffer)
     (gnus-article-edit-mode)
+    (gnus-article-delete-text-of-type 'annotation)
     (gnus-set-text-properties (point-min) (point-max) nil)
     (gnus-configure-windows 'edit-article)
     (setq gnus-article-edit-done-function exit-func)
@@ -2761,6 +2790,7 @@ call it with the value of the `gnus-data' text property."
   (let* ((pos (posn-point (event-start event)))
          (data (get-text-property pos 'gnus-data))
         (fun (get-text-property pos 'gnus-callback)))
+    (goto-char pos)
     (when fun
       (funcall fun data))))
 
@@ -3178,7 +3208,8 @@ forbidden in URL encoding."
     (gnus-eval-format
      gnus-prev-page-line-format nil
      `(gnus-prev t local-map ,gnus-prev-page-map
-                gnus-callback gnus-article-button-prev-page))))
+                gnus-callback gnus-article-button-prev-page
+                gnus-type annotation))))
 
 (defvar gnus-next-page-map nil)
 (unless gnus-next-page-map
@@ -3206,9 +3237,10 @@ forbidden in URL encoding."
 (defun gnus-insert-next-page-button ()
   (let ((buffer-read-only nil))
     (gnus-eval-format gnus-next-page-line-format nil
-                     `(gnus-next t local-map ,gnus-next-page-map
-                                 gnus-callback
-                                 gnus-article-button-next-page))))
+                     `(gnus-next
+                       t local-map ,gnus-next-page-map
+                       gnus-callback gnus-article-button-next-page
+                       gnus-type annotation))))
 
 (defun gnus-article-button-next-page (arg)
   "Go to the next page."