Synch to No Gnus 200401141432.
[elisp/gnus.git-] / lisp / gnus-art.el
index b90f400..57f481f 100644 (file)
@@ -304,7 +304,7 @@ asynchronously.      The compressed face will be piped to this command."
                         '(function-item
                           x-face-mule-gnus-article-display-x-face))
                     'function))))
-  ;;:version "21.1"
+  :version "21.1"
   :group 'gnus-picon
   :group 'gnus-article-washing)
 
@@ -951,8 +951,7 @@ See Info node `(gnus)Customizing Articles' for details."
 
 (defcustom gnus-treat-emphasize
   (and (or window-system
-          (featurep 'xemacs)
-          (>= (string-to-number emacs-version) 21))
+          (featurep 'xemacs))
        50000)
   "Emphasize text.
 Valid values are nil, t, `head', `last', an integer or a predicate.
@@ -1205,7 +1204,7 @@ See Info node `(gnus)Customizing Articles' for details."
   :type gnus-article-treat-custom)
 (put 'gnus-treat-overstrike 'highlight t)
 
-(defcustom gnus-treat-ansi-sequences t
+(defcustom gnus-treat-ansi-sequences (if (locate-library "ansi-color") t)
   "Treat ANSI SGR control sequences.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
@@ -1233,7 +1232,7 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)X-Face' for details."
   :group 'gnus-article-treat
-  ;;:version "21.1"
+  :version "21.1"
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
   :type gnus-article-treat-head-custom
@@ -1260,10 +1259,9 @@ See Info node `(gnus)Customizing Articles' and Info node
   (not (or (featurep 'xemacs)
           (gnus-image-type-available-p 'xpm)
           (gnus-image-type-available-p 'pbm)))
-  "If non-nil, gnus uses `smiley-mule' for displaying smileys rather than
-`smiley'.  It defaults to t when Emacs 20 or earlier is running.
+  "Non-nil means use `smiley-mule' to show smileys rather than `smiley'.
 `smiley-mule' is boundled in BITMAP-MULE package.  You can set it to t
-even if you are using Emacs 21+.  It has no effect on XEmacs."
+even if your Emacs supports images.  It has no effect on XEmacs."
   :group 'gnus-article-various
   :type 'boolean
   :get (lambda (symbol)
@@ -1320,7 +1318,7 @@ Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Smileys' for details."
   :group 'gnus-article-treat
-  ;;:version "21.1"
+  :version "21.1"
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)Smileys")
   :type gnus-article-treat-custom)
@@ -2053,8 +2051,7 @@ unfolded."
   "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
   (interactive)
   (unless (featurep 'xemacs)
-    (when (and (>= emacs-major-version 21)
-              (not gnus-article-should-use-smiley-mule)
+    (when (and (not gnus-article-should-use-smiley-mule)
               gnus-article-smiley-mule-loaded-p)
       (load "smiley" nil t)
       (setq gnus-article-smiley-mule-loaded-p nil))
@@ -2275,14 +2272,12 @@ unfolded."
 (defun article-decode-mime-words ()
   "Decode all MIME-encoded words in the article."
   (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (gnus-with-article-buffer
     (let ((inhibit-point-motion-hooks t)
-         buffer-read-only
          (mail-parse-charset gnus-newsgroup-charset)
          (mail-parse-ignored-charsets
-          (save-excursion (set-buffer gnus-summary-buffer)
-                          gnus-newsgroup-ignored-charsets)))
+          (with-current-buffer gnus-summary-buffer
+            gnus-newsgroup-ignored-charsets)))
       (mail-decode-encoded-word-region (point-min) (point-max)))))
 
 (defun article-decode-charset (&optional prompt)
@@ -2655,11 +2650,9 @@ always hide."
   "Translate article using an online translation service."
   (interactive)
   (require 'babel)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (gnus-with-article-buffer
     (when (article-goto-body)
-      (let* ((buffer-read-only nil)
-            (start (point))
+      (let* ((start (point))
             (end (point-max))
             (orig (buffer-substring start end))
             (trans (babel-as-string orig)))
@@ -4275,9 +4268,6 @@ General format specifiers can also be used.  See Info node
 
 (defvar gnus-mime-button-map
   (let ((map (make-sparse-keymap)))
-    (unless (>= (string-to-number emacs-version) 21)
-      ;; XEmacs doesn't care.
-      (set-keymap-parent map gnus-article-mode-map))
     (define-key map gnus-mouse-2 'gnus-article-push-button)
     (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
     (dolist (c gnus-mime-button-commands)
@@ -4304,8 +4294,7 @@ General format specifiers can also be used.  See Info node
 (defun gnus-mime-view-all-parts (&optional handles)
   "View all the MIME parts."
   (interactive)
-  (save-current-buffer
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer
     (let ((handles (or handles gnus-article-mime-handles))
          (mail-parse-charset gnus-newsgroup-charset)
          (mail-parse-ignored-charsets
@@ -4668,8 +4657,8 @@ specified charset."
         (mm-inlined-types nil)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets
-         (save-excursion (set-buffer gnus-summary-buffer)
-                         gnus-newsgroup-ignored-charsets)))
+         (with-current-buffer gnus-summary-buffer
+           gnus-newsgroup-ignored-charsets)))
     (when handle
       (if (mm-handle-undisplayer handle)
          (mm-remove-part handle)
@@ -4685,8 +4674,8 @@ If no internal viewer is available, use an external viewer."
         (mm-inline-large-images t)
         (mail-parse-charset gnus-newsgroup-charset)
         (mail-parse-ignored-charsets
-         (save-excursion (set-buffer gnus-summary-buffer)
-                         gnus-newsgroup-ignored-charsets))
+         (with-current-buffer gnus-summary-buffer
+           gnus-newsgroup-ignored-charsets))
         buffer-read-only)
     (when handle
       (if (mm-handle-undisplayer handle)
@@ -4703,8 +4692,7 @@ If no internal viewer is available, use an external viewer."
        (funcall (cdr action-pair)))))
 
 (defun gnus-article-part-wrapper (n function)
-  (save-current-buffer
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer
     (when (> n (length gnus-article-mime-handle-alist))
       (error "No such part"))
     (gnus-article-goto-part n)
@@ -4770,8 +4758,7 @@ N is the numerical prefix."
 (defun gnus-article-view-part (&optional n)
   "View MIME part N, which is the numerical prefix."
   (interactive "P")
-  (save-current-buffer
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer
     (or (numberp n) (setq n (gnus-article-mime-match-handle-first
                             gnus-article-mime-match-handle-function)))
     (when (> n (length gnus-article-mime-handle-alist))
@@ -4799,8 +4786,7 @@ N is the numerical prefix."
              (mail-parse-charset gnus-newsgroup-charset)
              (mail-parse-ignored-charsets
               (if (gnus-buffer-live-p gnus-summary-buffer)
-                  (save-excursion
-                    (set-buffer gnus-summary-buffer)
+                  (with-current-buffer gnus-summary-buffer
                     gnus-newsgroup-ignored-charsets)
                 nil)))
          (save-excursion
@@ -5189,8 +5175,8 @@ If displaying \"text/html\" is discouraged \(see
              (gnus-display-mime preferred)
            (let ((mail-parse-charset gnus-newsgroup-charset)
                  (mail-parse-ignored-charsets
-                  (save-excursion (set-buffer gnus-summary-buffer)
-                                  gnus-newsgroup-ignored-charsets)))
+                  (with-current-buffer gnus-summary-buffer
+                    gnus-newsgroup-ignored-charsets)))
              (mm-display-part preferred)
              ;; Do highlighting.
              (save-excursion
@@ -5242,8 +5228,7 @@ is the string to use when it is inactive.")
 
 (defun gnus-article-wash-status ()
   "Return a string which display status of article washing."
-  (save-excursion
-    (set-buffer gnus-article-buffer)
+  (with-current-buffer gnus-article-buffer
     (let ((cite (memq 'cite gnus-article-wash-types))
          (headers (memq 'headers gnus-article-wash-types))
          (boring (memq 'boring-headers gnus-article-wash-types))
@@ -5293,8 +5278,8 @@ is the string to use when it is inactive.")
   "Hide unwanted headers if `gnus-have-all-headers' is nil.
 Provided for backwards compatibility."
   (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))
-                (not (save-excursion (set-buffer gnus-summary-buffer)
-                                     gnus-have-all-headers)))
+                (not (with-current-buffer gnus-summary-buffer
+                       gnus-have-all-headers)))
             (not gnus-inhibit-hiding))
     (gnus-article-hide-headers)))
 
@@ -5754,16 +5739,14 @@ If given a prefix, show the hidden text instead."
                 gnus-summary-buffer
                 (get-buffer gnus-summary-buffer)
                 (gnus-buffer-exists-p gnus-summary-buffer)
-                (eq (cdr (save-excursion
-                           (set-buffer gnus-summary-buffer)
+                (eq (cdr (with-current-buffer gnus-summary-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)
+                (with-current-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)
@@ -6238,7 +6221,7 @@ The function must take one argument, the string naming the URL."
 
 (defcustom gnus-button-ctan-directory-regexp
   (concat
-   "\\("; Cannot use `\(?: ... \)' (compatibility with Emacs 20).
+   "\\(?:"
    "biblio\\|digests\\|dviware\\|fonts\\|graphics\\|help\\|"
    "indexing\\|info\\|language\\|macros\\|support\\|systems\\|"
    "tds\\|tools\\|usergrps\\|web\\|nonfree\\|obsolete"
@@ -6822,41 +6805,35 @@ do the highlighting.  See the documentation for those functions."
 (defun gnus-article-highlight-headers ()
   "Highlight article headers as specified by `gnus-header-face-alist'."
   (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (save-restriction
-      (let ((alist gnus-header-face-alist)
-           (buffer-read-only nil)
-           (case-fold-search t)
-           (inhibit-point-motion-hooks t)
-           entry regexp header-face field-face from hpoints fpoints)
-       (article-narrow-to-head)
-       (while (setq entry (pop alist))
-         (goto-char (point-min))
-         (setq regexp (concat "^\\("
-                              (if (string-equal "" (nth 0 entry))
-                                  "[^\t ]"
-                                (nth 0 entry))
-                              "\\)")
-               header-face (nth 1 entry)
-               field-face (nth 2 entry))
-         (while (and (re-search-forward regexp nil t)
-                     (not (eobp)))
-           (beginning-of-line)
-           (setq from (point))
-           (unless (search-forward ":" nil t)
-             (forward-char 1))
-           (when (and header-face
-                      (not (memq (point) hpoints)))
-             (push (point) hpoints)
-             (gnus-put-text-property from (point) 'face header-face))
-           (when (and field-face
-                      (not (memq (setq from (point)) fpoints)))
-             (push from fpoints)
-             (if (re-search-forward "^[^ \t]" nil t)
-                 (forward-char -2)
-               (goto-char (point-max)))
-             (gnus-put-text-property from (point) 'face field-face))))))))
+  (gnus-with-article-headers
+    (let ((alist gnus-header-face-alist)
+         entry regexp header-face field-face from hpoints fpoints)
+      (while (setq entry (pop alist))
+       (goto-char (point-min))
+       (setq regexp (concat "^\\("
+                            (if (string-equal "" (nth 0 entry))
+                                "[^\t ]"
+                              (nth 0 entry))
+                            "\\)")
+             header-face (nth 1 entry)
+             field-face (nth 2 entry))
+       (while (and (re-search-forward regexp nil t)
+                   (not (eobp)))
+         (beginning-of-line)
+         (setq from (point))
+         (unless (search-forward ":" nil t)
+           (forward-char 1))
+         (when (and header-face
+                    (not (memq (point) hpoints)))
+           (push (point) hpoints)
+           (gnus-put-text-property from (point) 'face header-face))
+         (when (and field-face
+                    (not (memq (setq from (point)) fpoints)))
+           (push from fpoints)
+           (if (re-search-forward "^[^ \t]" nil t)
+               (forward-char -2)
+             (goto-char (point-max)))
+           (gnus-put-text-property from (point) 'face field-face)))))))
 
 (defun gnus-article-highlight-signature ()
   "Highlight the signature in an article.
@@ -6864,10 +6841,8 @@ It does this by highlighting everything after
 `gnus-signature-separator' using `gnus-signature-face'."
   (interactive)
   (when gnus-signature-face
-    (save-excursion
-      (set-buffer gnus-article-buffer)
-      (let ((buffer-read-only nil)
-           (inhibit-point-motion-hooks t))
+    (gnus-with-article-buffer
+      (let ((inhibit-point-motion-hooks t))
        (save-restriction
          (when (gnus-article-narrow-to-signature)
            (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
@@ -6895,10 +6870,8 @@ It does this by highlighting everything after
 \"External references\" are things like Message-IDs and URLs, as
 specified by `gnus-button-alist'."
   (interactive (list 'force))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-         (inhibit-point-motion-hooks t)
+  (gnus-with-article-buffer
+    (let ((inhibit-point-motion-hooks t)
          (case-fold-search t)
          (alist gnus-button-alist)
          beg entry regexp)
@@ -6939,40 +6912,33 @@ specified by `gnus-button-alist'."
 (defun gnus-article-add-buttons-to-head ()
   "Add buttons to the head of the article."
   (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (save-restriction
-      (let ((buffer-read-only nil)
-           (inhibit-point-motion-hooks t)
-           (case-fold-search t)
-           (alist gnus-header-button-alist)
-           entry beg end)
-       (article-narrow-to-head)
-       (while alist
-         ;; Each alist entry.
-         (setq entry (car alist)
-               alist (cdr alist))
-         (goto-char (point-min))
-         (while (re-search-forward (car entry) nil t)
-           ;; Each header matching the entry.
-           (setq beg (match-beginning 0))
-           (setq end (or (and (re-search-forward "^[^ \t]" nil t)
-                              (match-beginning 0))
-                         (point-max)))
-           (goto-char beg)
-           (while (re-search-forward (eval (nth 1 entry)) end t)
-             ;; Each match within a header.
-             (let* ((entry (cdr entry))
-                    (start (match-beginning (nth 1 entry)))
-                    (end (match-end (nth 1 entry)))
-                    (form (nth 2 entry)))
-               (goto-char (match-end 0))
-               (when (eval form)
-                 (gnus-article-add-button
-                  start end (nth 3 entry)
-                  (buffer-substring (match-beginning (nth 4 entry))
-                                    (match-end (nth 4 entry)))))))
-           (goto-char end)))))))
+  (gnus-with-article-headers
+    (let ((alist gnus-header-button-alist)
+         entry beg end)
+      (while alist
+       ;; Each alist entry.
+       (setq entry (pop alist))
+       (goto-char (point-min))
+       (while (re-search-forward (car entry) nil t)
+         ;; Each header matching the entry.
+         (setq beg (match-beginning 0))
+         (setq end (or (and (re-search-forward "^[^ \t]" nil t)
+                            (match-beginning 0))
+                       (point-max)))
+         (goto-char beg)
+         (while (re-search-forward (eval (nth 1 entry)) end t)
+           ;; Each match within a header.
+           (let* ((entry (cdr entry))
+                  (start (match-beginning (nth 1 entry)))
+                  (end (match-end (nth 1 entry)))
+                  (form (nth 2 entry)))
+             (goto-char (match-end 0))
+             (when (eval form)
+               (gnus-article-add-button
+                start end (nth 3 entry)
+                (buffer-substring (match-beginning (nth 4 entry))
+                                  (match-end (nth 4 entry)))))))
+         (goto-char end))))))
 
 ;;; External functions:
 
@@ -6988,22 +6954,17 @@ specified by `gnus-button-alist'."
          (list 'gnus-callback fun)
          (and data (list 'gnus-data data))))
   (widget-convert-button 'link from to :action 'gnus-widget-press-button
-                        ;; Quote `:button-keymap' for Mule 2.3
-                        ;; but it won't work.
-                        ':button-keymap gnus-widget-button-keymap))
+                        :button-keymap gnus-widget-button-keymap))
 
 ;;; Internal functions:
 
 (defun gnus-article-set-globals ()
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
+  (with-current-buffer gnus-summary-buffer
     (gnus-set-global-variables)))
 
 (defun gnus-signature-toggle (end)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-         (inhibit-point-motion-hooks t)
+  (gnus-with-article-buffer
+    (let ((inhibit-point-motion-hooks t)
          (limit (next-single-property-change end 'mime-view-entity
                                              nil (point-max))))
       (if (text-property-any end limit 'article-type 'signature)
@@ -7141,8 +7102,7 @@ specified by `gnus-button-alist'."
 
 (defun gnus-button-message-id (message-id)
   "Fetch MESSAGE-ID."
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
+  (with-current-buffer gnus-summary-buffer
     (gnus-summary-refer-article message-id)))
 
 (defun gnus-button-fetch-group (address)
@@ -7222,13 +7182,16 @@ specified by `gnus-button-alist'."
 
 (defvar gnus-prev-page-map
   (let ((map (make-sparse-keymap)))
-    (unless (>= emacs-major-version 21)
-      ;; XEmacs doesn't care.
-      (set-keymap-parent map gnus-article-mode-map))
     (define-key map gnus-mouse-2 'gnus-button-prev-page)
     (define-key map "\r" 'gnus-button-prev-page)
     map))
 
+(defvar gnus-next-page-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map gnus-mouse-2 'gnus-button-next-page)
+    (define-key map "\r" 'gnus-button-next-page)
+    map))
+
 (defun gnus-insert-prev-page-button ()
   (let ((b (point))
        (buffer-read-only nil)
@@ -7248,15 +7211,6 @@ specified by `gnus-button-alist'."
      :action 'gnus-button-prev-page
      :button-keymap gnus-prev-page-map)))
 
-(defvar gnus-next-page-map
-  (let ((map (make-sparse-keymap)))
-    (unless (>= emacs-major-version 21)
-      ;; XEmacs doesn't care.
-      (set-keymap-parent map gnus-article-mode-map))
-    (define-key map gnus-mouse-2 'gnus-button-next-page)
-    (define-key map "\r" 'gnus-button-next-page)
-    map))
-
 (defun gnus-button-next-page (&optional args more-args)
   "Go to the next page."
   (interactive)
@@ -7533,8 +7487,6 @@ For example:
 
 (defvar gnus-mime-security-button-map
   (let ((map (make-sparse-keymap)))
-    (unless (>= (string-to-number emacs-version) 21)
-      (set-keymap-parent map gnus-article-mode-map))
     (define-key map gnus-mouse-2 'gnus-article-push-button)
     (define-key map "\r" 'gnus-article-press-button)
     map))