Synch to No Gnus 200401080012.
[elisp/gnus.git-] / lisp / gnus-art.el
index c1861d6..3868945 100644 (file)
@@ -60,6 +60,7 @@
 (autoload 'gnus-msg-mail "gnus-msg" nil t)
 (autoload 'gnus-button-mailto "gnus-msg")
 (autoload 'gnus-button-reply "gnus-msg" nil t)
+(autoload 'ansi-color-apply-on-region "ansi-color")
 
 (defgroup gnus-article nil
   "Article display."
@@ -303,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)
 
@@ -950,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.
@@ -1204,6 +1204,14 @@ See Info node `(gnus)Customizing Articles' for details."
   :type gnus-article-treat-custom)
 (put 'gnus-treat-overstrike 'highlight 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."
+  :group 'gnus-article-treat
+  :link '(custom-manual "(gnus)Customizing Articles")
+  :type gnus-article-treat-custom)
+
 (make-obsolete-variable 'gnus-treat-display-xface
                        'gnus-treat-display-x-face)
 
@@ -1224,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
@@ -1251,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)
@@ -1311,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)
@@ -1523,6 +1530,7 @@ This requires GNU Libidn, and by default only enabled if it is found."
     (gnus-treat-strip-multiple-blank-lines
      gnus-article-strip-multiple-blank-lines)
     (gnus-treat-overstrike gnus-article-treat-overstrike)
+    (gnus-treat-ansi-sequences gnus-article-treat-ansi-sequences)
     (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
     (gnus-treat-fold-headers gnus-article-treat-fold-headers)
     ;; Displaying X-Face should be done after unfolding headers
@@ -1760,7 +1768,7 @@ always hide."
              (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
                (forward-line -1)
                (gnus-article-hide-text-type
-                (gnus-point-at-bol)
+                (point-at-bol)
                 (progn
                   (end-of-line)
                   (if (re-search-forward "^[^ \t]" nil t)
@@ -1886,7 +1894,7 @@ always hide."
     (goto-char (point-min))
     (when (re-search-forward (concat "^" header ":") nil t)
       (gnus-article-hide-text-type
-       (gnus-point-at-bol)
+       (point-at-bol)
        (progn
         (end-of-line)
         (if (re-search-forward "^[^ \t]" nil t)
@@ -1907,7 +1915,7 @@ always hide."
        (article-narrow-to-head)
        (while (not (eobp))
          (cond
-          ((< (setq column (- (gnus-point-at-eol) (point)))
+          ((< (setq column (- (point-at-eol) (point)))
               gnus-article-normalized-header-length)
            (end-of-line)
            (insert (make-string
@@ -1918,7 +1926,7 @@ always hide."
             (progn
               (forward-char gnus-article-normalized-header-length)
               (point))
-            (gnus-point-at-eol)
+            (point-at-eol)
             'invisible t))
           (t
            ;; Do nothing.
@@ -1999,6 +2007,14 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")."
              (put-text-property
               (point) end 'face 'underline)))))))))
 
+(defun article-treat-ansi-sequences ()
+  "Translate ANSI SGR control sequences into overlays or extents."
+  (interactive)
+  (save-excursion
+    (when (article-goto-body)
+      (let ((buffer-read-only nil))
+       (ansi-color-apply-on-region (point) (point-max))))))
+
 (defun gnus-article-treat-unfold-headers ()
   "Unfold folded message headers.
 Only the headers that fit into the current window width will be
@@ -2035,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))
@@ -2105,7 +2120,7 @@ unfolded."
            (end-of-line)
            (when (>= (current-column) (min fill-column width))
              (narrow-to-region (min (1+ (point)) (point-max))
-                               (gnus-point-at-bol))
+                               (point-at-bol))
              (let ((goback (point-marker)))
                (fill-paragraph nil)
                (goto-char (marker-position goback)))
@@ -2147,7 +2162,7 @@ unfolded."
         (while (and (not (bobp))
                     (looking-at "^[ \t]*$")
                     (not (gnus-annotation-in-region-p
-                          (point) (gnus-point-at-eol))))
+                          (point) (point-at-eol))))
           (forward-line -1))
         (forward-line 1)
         (point))))))
@@ -2528,11 +2543,14 @@ If READ-CHARSET, ask for a coding system."
                                 "\\`cid:"))
          w3m-force-redisplay)
       (w3m-region (point-min) (point-max)))
-    (when mm-inline-text-html-with-w3m-keymap
+    (when (and mm-inline-text-html-with-w3m-keymap
+              (boundp 'w3m-minor-mode-map)
+              w3m-minor-mode-map)
       (add-text-properties
        (point-min) (point-max)
-       (nconc (mm-w3m-local-map-property)
-             '(mm-inline-text-html-with-w3m t))))))
+       (list 'keymap w3m-minor-mode-map
+            ;; Put the mark meaning this part was rendered by emacs-w3m.
+            'mm-inline-text-html-with-w3m t)))))
 
 (defun article-hide-list-identifiers ()
   "Remove list identifies from the Subject header.
@@ -2918,11 +2936,11 @@ should replace the \"Date:\" one, or should be added below it."
                    (re-search-forward "^Date:[ \t]" nil t)
                    ;; If Date is missing, try again for X-Sent.
                    (re-search-forward "^X-Sent:[ \t]" nil t))
-           (setq bface (get-text-property (gnus-point-at-bol) 'face)
-                 date (or (get-text-property (gnus-point-at-bol)
+           (setq bface (get-text-property (point-at-bol) 'face)
+                 date (or (get-text-property (point-at-bol)
                                              'original-date)
                           date)
-                 eface (get-text-property (1- (gnus-point-at-eol))
+                 eface (get-text-property (1- (point-at-eol))
                                           'face)))
          (let ((buffer-read-only nil))
            ;; Delete any old X-Sent headers.
@@ -2954,7 +2972,7 @@ should replace the \"Date:\" one, or should be added below it."
              (goto-char (point-min)))
            (insert (article-make-date-line date type))
            (when (eq type 'lapsed)
-             (put-text-property (gnus-point-at-bol) (point)
+             (put-text-property (point-at-bol) (point)
                                 'article-date-lapsed t))
            (insert "\n")
            (forward-line -1)
@@ -3131,7 +3149,7 @@ is to run."
     (setq n 1))
   (gnus-stop-date-timer)
   (setq article-lapsed-timer
-       (nnheader-run-at-time 1 n 'article-update-date-lapsed)))
+       (run-at-time 1 n 'article-update-date-lapsed)))
 
 (defun gnus-stop-date-timer ()
   "Stop the X-Sent timer."
@@ -3465,17 +3483,9 @@ 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))
 
-(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)
-          (< emacs-minor-version 2))
-      `(read-string ,prompt ,initial-contents ,history)
-    `(read-string ,prompt ,initial-contents ,history ,default-value)))
-
 (defun gnus-summary-pipe-to-muttprint (&optional command)
   "Pipe this article to muttprint."
-  (setq command (gnus-read-string
+  (setq command (read-string
                 "Print using command: " gnus-summary-muttprint-program
                 nil gnus-summary-muttprint-program))
   (gnus-summary-save-in-pipe command))
@@ -3598,8 +3608,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
                (message-narrow-to-head)
                (goto-char (point-max))
                (forward-line -1)
-               (setq bface (get-text-property (gnus-point-at-bol) 'face)
-                     eface (get-text-property (1- (gnus-point-at-eol)) 'face))
+               (setq bface (get-text-property (point-at-bol) 'face)
+                     eface (get-text-property (1- (point-at-eol)) 'face))
                (message-remove-header "X-Gnus-PGP-Verify")
                (if (re-search-forward "^X-PGP-Sig:" nil t)
                    (forward-line)
@@ -3666,6 +3676,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
      article-monafy
      article-hide-boring-headers
      article-treat-overstrike
+     article-treat-ansi-sequences
      article-fill-long-lines
      article-capitalize-sentences
      article-remove-cr
@@ -3778,6 +3789,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
        ["Hide signature" gnus-article-hide-signature t]
        ["Hide citation" gnus-article-hide-citation t]
        ["Treat overstrike" gnus-article-treat-overstrike t]
+       ["Treat ANSI sequences" gnus-article-treat-ansi-sequences t]
        ["Remove carriage return" gnus-article-remove-cr t]
        ["Remove leading whitespace" gnus-article-remove-leading-whitespace t]
        ["Treat html" gnus-article-wash-html t]
@@ -4260,9 +4272,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)
@@ -4289,8 +4298,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
@@ -4688,8 +4696,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)
@@ -4755,8 +4762,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))
@@ -4853,11 +4859,11 @@ N is the numerical prefix."
     (setq b (point))
     (gnus-eval-format
      gnus-mime-button-line-format gnus-mime-button-line-format-alist
-     `(,@(gnus-local-map-property gnus-mime-button-map)
-        gnus-callback gnus-mm-display-part
-        gnus-part ,gnus-tmp-id
-        article-type annotation
-        gnus-data ,handle))
+     `(keymap ,gnus-mime-button-map
+             gnus-callback gnus-mm-display-part
+             gnus-part ,gnus-tmp-id
+             article-type annotation
+             gnus-data ,handle))
     (setq e (if (bolp)
                ;; Exclude a newline.
                (1- (point))
@@ -5135,7 +5141,7 @@ If displaying \"text/html\" is discouraged \(see
                       ',gnus-article-mime-handle-alist))
               (gnus-mime-display-alternative
                ',ihandles ',not-pref ',begend ,id))
-            ,@(gnus-local-map-property gnus-mime-button-map)
+            keymap ,gnus-mime-button-map
             ,gnus-mouse-face-prop ,gnus-article-mouse-face
             face ,gnus-article-button-face
             gnus-part ,id
@@ -5159,7 +5165,7 @@ If displaying \"text/html\" is discouraged \(see
                         ',gnus-article-mime-handle-alist))
                 (gnus-mime-display-alternative
                  ',ihandles ',handle ',begend ,id))
-              ,@(gnus-local-map-property gnus-mime-button-map)
+              keymap ,gnus-mime-button-map
               ,gnus-mouse-face-prop ,gnus-article-mouse-face
               face ,gnus-article-button-face
               gnus-part ,id
@@ -5446,9 +5452,9 @@ not have a face in `gnus-article-boring-faces'."
   "Read article specified by message-id around point."
   (interactive)
   (save-excursion
-    (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
-    (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
-    (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
+    (re-search-backward "[ \t]\\|^" (point-at-bol) t)
+    (re-search-forward "<?news:<?\\|<" (point-at-eol) t)
+    (if (re-search-forward "[^@ ]+@[^ \t>]+" (point-at-eol) t)
        (let ((msg-id (concat "<" (match-string 0) ">")))
          (set-buffer gnus-summary-buffer)
          (gnus-summary-refer-article msg-id))
@@ -6012,7 +6018,7 @@ groups."
        (car gnus-article-current) (cdr gnus-article-current)))
     ;; We remove all text props from the article buffer.
     (kill-all-local-variables)
-    (gnus-set-text-properties (point-min) (point-max) nil)
+    (set-text-properties (point-min) (point-max) nil)
     (gnus-article-mode)
     (set-window-configuration winconf)
     (set-buffer buf)
@@ -6223,7 +6229,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"
@@ -7026,7 +7032,7 @@ specified by `gnus-button-alist'."
           (fun (nth 3 entry))
           (args (mapcar (lambda (group)
                           (let ((string (match-string group)))
-                            (gnus-set-text-properties
+                            (set-text-properties
                              0 (length string) nil string)
                             string))
                         (nthcdr 4 entry))))
@@ -7207,20 +7213,23 @@ 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)
        (situation (get-text-property (point-min) 'mime-view-situation)))
     (gnus-eval-format
      gnus-prev-page-line-format nil
-     `(,@(gnus-local-map-property gnus-prev-page-map)
+     `(keymap ,gnus-prev-page-map
         gnus-prev t
         gnus-callback gnus-article-button-prev-page
         article-type annotation
@@ -7233,15 +7242,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)
@@ -7263,7 +7263,7 @@ specified by `gnus-button-alist'."
        (buffer-read-only nil)
        (situation (get-text-property (point-min) 'mime-view-situation)))
     (gnus-eval-format gnus-next-page-line-format nil
-                     `(,@(gnus-local-map-property gnus-next-page-map)
+                     `(keymap ,gnus-next-page-map
                          gnus-next t
                          gnus-callback gnus-article-button-next-page
                          article-type annotation
@@ -7518,8 +7518,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))
@@ -7626,7 +7624,7 @@ For example:
     (gnus-eval-format
      gnus-mime-security-button-line-format
      gnus-mime-security-button-line-format-alist
-     `(,@(gnus-local-map-property gnus-mime-security-button-map)
+     `(keymap ,gnus-mime-security-button-map
         gnus-callback gnus-mime-security-press-button
         gnus-line-format ,gnus-mime-security-button-line-format
         gnus-mime-details ,gnus-mime-security-button-pressed