(quoted-printable-decode-region): Don't error out on
[gnus] / lisp / gnus-art.el
index bfbd71a..6de8990 100644 (file)
@@ -26,7 +26,9 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
+(eval-when-compile
+  (require 'cl)
+  (defvar tool-bar-map))
 
 (require 'gnus)
 (require 'gnus-sum)
@@ -558,8 +560,7 @@ The following additional specs are available:
   :type 'hook
   :group 'gnus-article-various)
 
-(defvar gnus-article-hide-pgp-hook nil)
-(make-obsolete-variable 'gnus-article-hide-pgp-hook 
+(make-obsolete-variable 'gnus-article-hide-pgp-hook
                        "This variable is obsolete in Gnus 5.10.")
 
 (defcustom gnus-article-button-face 'bold
@@ -1323,13 +1324,18 @@ It is a string, such as \"PGP\". If nil, ask user."
   "Function used for converting HTML into text.")
 
 (defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
-                             (fboundp 'coding-system-p)
-                             (coding-system-p 'utf-8))
+                             (mm-coding-system-p 'utf-8)
+                             (executable-find idna-program))
   "Whether IDNA decoding of headers is used when viewing messages.
 This requires GNU Libidn, and by default only enabled if it is found."
   :group 'gnus-article-headers
   :type 'boolean)
 
+(defcustom gnus-article-over-scroll nil
+  "If non-nil, allow scrolling the article buffer even when there no more text."
+  :group 'gnus-article
+  :type 'boolean)
+
 ;;; Internal variables
 
 (defvar gnus-english-month-names
@@ -1660,15 +1666,18 @@ always hide."
                     (message-fetch-field "newsgroups"))
                (gnus-article-hide-header "followup-to")))
             ((eq elem 'reply-to)
-             (let ((from (message-fetch-field "from"))
-                   (reply-to (message-fetch-field "reply-to")))
-               (when (and
-                      from reply-to
-                      (ignore-errors
-                        (gnus-string-equal
-                         (nth 1 (mail-extract-address-components from))
-                         (nth 1 (mail-extract-address-components reply-to)))))
-                 (gnus-article-hide-header "reply-to"))))
+             (if (gnus-group-find-parameter
+                  gnus-newsgroup-name 'broken-reply-to)
+                 (gnus-article-hide-header "reply-to")
+               (let ((from (message-fetch-field "from"))
+                     (reply-to (message-fetch-field "reply-to")))
+                 (when (and
+                        from reply-to
+                        (ignore-errors
+                          (gnus-string-equal
+                           (nth 1 (mail-extract-address-components from))
+                           (nth 1 (mail-extract-address-components reply-to)))))
+                   (gnus-article-hide-header "reply-to")))))
             ((eq elem 'date)
              (let ((date (message-fetch-field "date")))
                (when (and date
@@ -1916,7 +1925,8 @@ unfolded."
          (while (not (eobp))
            (end-of-line)
            (when (>= (current-column) (min fill-column width))
-             (narrow-to-region (min (1+ (point)) (point-max)) (gnus-point-at-bol))
+             (narrow-to-region (min (1+ (point)) (point-max))
+                               (gnus-point-at-bol))
               (let ((goback (point-marker)))
                 (fill-paragraph nil)
                 (goto-char (marker-position goback)))
@@ -2026,7 +2036,7 @@ unfolded."
            ;; We display the face.
            (if (symbolp gnus-article-x-face-command)
                ;; The command is a lisp function, so we call it.
-               (if (gnus-functionp gnus-article-x-face-command)
+               (if (functionp gnus-article-x-face-command)
                    (funcall gnus-article-x-face-command face)
                  (error "%s is not a function" gnus-article-x-face-command))
              ;; The command is a string, so we interpret the command
@@ -2099,7 +2109,7 @@ If PROMPT (the prefix), prompt for a coding system to use."
        (mm-decode-body
         charset (and cte (intern (downcase
                                   (gnus-strip-whitespace cte))))
-        (car ctl) prompt))))))
+        (car ctl)))))))
 
 (defun article-decode-encoded-words ()
   "Remove encoded-word encoding from headers."
@@ -2127,23 +2137,23 @@ If PROMPT (the prefix), prompt for a coding system to use."
        (article-narrow-to-head)
        (with-current-buffer gnus-original-article-buffer
          (goto-char (point-min)))
-       (while (re-search-forward "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
-                                 nil t)
+       (while (re-search-forward
+               "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
          (replace-match (save-match-data
-                            (gnus-decode-newsgroups
-                             ;; XXX how to use data in article buffer?
-                             (with-current-buffer gnus-original-article-buffer
-                               (re-search-forward
-                                "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
-                                nil t)
-                               (match-string 1))
-                             gnus-newsgroup-name method))
+                          (gnus-decode-newsgroups
+                           ;; XXX how to use data in article buffer?
+                           (with-current-buffer gnus-original-article-buffer
+                             (re-search-forward
+                              "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
+                              nil t)
+                             (match-string 1))
+                           gnus-newsgroup-name method))
                         t t nil 1))
        (goto-char (point-min))
        (with-current-buffer gnus-original-article-buffer
          (goto-char (point-min)))
-       (while (re-search-forward "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
-                                 nil t)
+       (while (re-search-forward
+               "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
          (replace-match (save-match-data
                           (gnus-decode-newsgroups
                            ;; XXX how to use data in article buffer?
@@ -2262,8 +2272,8 @@ If READ-CHARSET, ask for a coding system."
       (while (re-search-forward
              "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
        (replace-match "\\1\\3" t)))
-    (when (and gnus-display-mime-function (interactive-p))
-      (funcall gnus-display-mime-function))))
+    (when (interactive-p)
+      (gnus-treat-article nil))))
 
 
 (defun article-wash-html (&optional read-charset)
@@ -2296,7 +2306,7 @@ If READ-CHARSET, ask for a coding system."
            (when entry
              (setq func (cdr entry)))
            (cond
-            ((gnus-functionp func)
+            ((functionp func)
              (funcall func))
             (t
              (apply (car func) (cdr func))))))))))
@@ -2570,7 +2580,7 @@ Point is left at the beginning of the narrowed-to region."
                       (< (- (point-max) (point)) limit))
                  (and (floatp limit)
                       (< (count-lines (point) (point-max)) limit))
-                 (and (gnus-functionp limit)
+                 (and (functionp limit)
                       (funcall limit))
                  (and (stringp limit)
                       (not (re-search-forward limit nil t))))
@@ -2772,7 +2782,7 @@ should replace the \"Date:\" one, or should be added below it."
                                  gnus-article-time-format)
                              (error nil))
                            gnus-article-time-format)))
-           (if (gnus-functionp format)
+           (if (functionp format)
                (funcall format time)
              (concat "Date: " (format-time-string format time)))))
         ;; ISO 8601.
@@ -3217,9 +3227,17 @@ 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 (read-string
+  (setq command (gnus-read-string
                 "Print using command: " gnus-summary-muttprint-program
                 nil gnus-summary-muttprint-program))
   (gnus-summary-save-in-pipe command))
@@ -3301,7 +3319,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)
@@ -3309,7 +3327,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is
              ;; Don't verify multiple headers.
              (setq headers (mapconcat (lambda (header)
                                         (concat header ": "
-                                                (mail-fetch-field header) "\n"))
+                                                (mail-fetch-field header)
+                                                "\n"))
                                       (split-string (nth 1 items) ",") "")))
            (delete-region (point-min) (point-max))
            (insert "-----BEGIN PGP SIGNED MESSAGE-----\n\n")
@@ -3811,10 +3830,12 @@ General format specifiers can also be used.  See Info node
       (define-key map (cadr c) (car c)))
     map))
 
-(easy-menu-define gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
+(easy-menu-define
+  gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
   `("MIME Part"
     ,@(mapcar (lambda (c)
-               (vector (caddr c) (car c) :enable t)) gnus-mime-button-commands)))
+               (vector (caddr c) (car c) :enable t))
+             gnus-mime-button-commands)))
 
 (eval-when-compile
   (define-compiler-macro popup-menu (&whole form
@@ -3902,9 +3923,7 @@ General format specifiers can also be used.  See Info node
             (let ((mbl1 mml-buffer-list))
               (setq mml-buffer-list mbl)
               (set (make-local-variable 'mml-buffer-list) mbl1))
-            ;; LOCAL argument of add-hook differs between GNU Emacs
-            ;; and XEmacs. make-local-hook makes sure they are local.
-            (make-local-hook 'kill-buffer-hook)
+            (gnus-make-local-hook 'kill-buffer-hook)
             (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
        `(lambda (no-highlight)
          (let ((mail-parse-charset (or gnus-article-charset
@@ -3929,77 +3948,78 @@ General format specifiers can also be used.  See Info node
 Replace it with some information about the removed part."
   (interactive)
   (gnus-article-check-buffer)
-  (let* ((data (get-text-property (point) 'gnus-data))
-        (handles gnus-article-mime-handles)
-        (none "(none)")
-        (description
-         (or
-          (mail-decode-encoded-word-string (or (mm-handle-description data)
-                                               none))))
-        (filename
-         (or (mail-content-type-get (mm-handle-disposition data) 'filename)
-             none))
-        (type (mm-handle-media-type data)))
-    (if (mm-multiple-handles gnus-article-mime-handles)
-       (error "This function is not implemented"))
-    (with-current-buffer (mm-handle-buffer data)
-      (let ((bsize (format "%s" (buffer-size))))
-       (erase-buffer)
-       (insert
-        (concat
-         "<#part type=text/plain nofile=yes disposition=attachment"
-         " description=\"Deleted attachment (" bsize " Byte)\">"
-         ",----\n"
-         "| The following attachment has been deleted:\n"
-         "|\n"
-         "| Type:           " type "\n"
-         "| Filename:       " filename "\n"
-         "| Size (encoded): " bsize " Byte\n"
-         "| Description:    " description "\n"
-         "`----\n"
-         "<#/part>"))
-       (setcdr data
-               (cdr (mm-make-handle nil `("text/plain"))))))
-    (set-buffer gnus-summary-buffer)
-    ;; FIXME: maybe some of the following code (borrowed from
-    ;; `gnus-mime-save-part-and-strip') isn't necessary?
-    (gnus-article-edit-article
-     `(lambda ()
-       (erase-buffer)
-       (let ((mail-parse-charset (or gnus-article-charset
-                                     ',gnus-newsgroup-charset))
-             (mail-parse-ignored-charsets
-              (or gnus-article-ignored-charsets
-                  ',gnus-newsgroup-ignored-charsets))
-             (mbl mml-buffer-list))
-         (setq mml-buffer-list nil)
-         (insert-buffer gnus-original-article-buffer)
-         (mime-to-mml ',handles)
-         (setq gnus-article-mime-handles nil)
-         (let ((mbl1 mml-buffer-list))
-           (setq mml-buffer-list mbl)
-           (set (make-local-variable 'mml-buffer-list) mbl1))
-         ;; LOCAL argument of add-hook differs between GNU Emacs
-         ;; and XEmacs. make-local-hook makes sure they are local.
-         (make-local-hook 'kill-buffer-hook)
-         (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
-     `(lambda (no-highlight)
-       (let ((mail-parse-charset (or gnus-article-charset
-                                     ',gnus-newsgroup-charset))
-             (message-options message-options)
-             (message-options-set-recipient)
-             (mail-parse-ignored-charsets
-              (or gnus-article-ignored-charsets
-                  ',gnus-newsgroup-ignored-charsets)))
-         (mml-to-mime)
-         (mml-destroy-buffers)
-         (remove-hook 'kill-buffer-hook
-                      'mml-destroy-buffers t)
-         (kill-local-variable 'mml-buffer-list))
-       (gnus-summary-edit-article-done
-        ,(or (mail-header-references gnus-current-headers) "")
-        ,(gnus-group-read-only-p)
-        ,gnus-summary-buffer no-highlight))))
+  (unless (and gnus-novice-user
+              (not (gnus-yes-or-no-p
+                    "Really delete attachment forever? ")))
+    (let* ((data (get-text-property (point) 'gnus-data))
+          (handles gnus-article-mime-handles)
+          (none "(none)")
+          (description
+           (or
+            (mail-decode-encoded-word-string (or (mm-handle-description data)
+                                                 none))))
+          (filename
+           (or (mail-content-type-get (mm-handle-disposition data) 'filename)
+               none))
+          (type (mm-handle-media-type data)))
+      (if (mm-multiple-handles gnus-article-mime-handles)
+         (error "This function is not implemented"))
+      (with-current-buffer (mm-handle-buffer data)
+       (let ((bsize (format "%s" (buffer-size))))
+         (erase-buffer)
+         (insert
+          (concat
+           "<#part type=text/plain nofile=yes disposition=attachment"
+           " description=\"Deleted attachment (" bsize " Byte)\">"
+           ",----\n"
+           "| The following attachment has been deleted:\n"
+           "|\n"
+           "| Type:           " type "\n"
+           "| Filename:       " filename "\n"
+           "| Size (encoded): " bsize " Byte\n"
+           "| Description:    " description "\n"
+           "`----\n"
+           "<#/part>"))
+         (setcdr data
+                 (cdr (mm-make-handle nil `("text/plain"))))))
+      (set-buffer gnus-summary-buffer)
+      ;; FIXME: maybe some of the following code (borrowed from
+      ;; `gnus-mime-save-part-and-strip') isn't necessary?
+      (gnus-article-edit-article
+       `(lambda ()
+         (erase-buffer)
+         (let ((mail-parse-charset (or gnus-article-charset
+                                       ',gnus-newsgroup-charset))
+               (mail-parse-ignored-charsets
+                (or gnus-article-ignored-charsets
+                    ',gnus-newsgroup-ignored-charsets))
+               (mbl mml-buffer-list))
+           (setq mml-buffer-list nil)
+           (insert-buffer gnus-original-article-buffer)
+           (mime-to-mml ',handles)
+           (setq gnus-article-mime-handles nil)
+           (let ((mbl1 mml-buffer-list))
+             (setq mml-buffer-list mbl)
+             (set (make-local-variable 'mml-buffer-list) mbl1))
+           (gnus-make-local-hook 'kill-buffer-hook)
+           (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
+       `(lambda (no-highlight)
+         (let ((mail-parse-charset (or gnus-article-charset
+                                       ',gnus-newsgroup-charset))
+               (message-options message-options)
+               (message-options-set-recipient)
+               (mail-parse-ignored-charsets
+                (or gnus-article-ignored-charsets
+                    ',gnus-newsgroup-ignored-charsets)))
+           (mml-to-mime)
+           (mml-destroy-buffers)
+           (remove-hook 'kill-buffer-hook
+                        'mml-destroy-buffers t)
+           (kill-local-variable 'mml-buffer-list))
+         (gnus-summary-edit-article-done
+          ,(or (mail-header-references gnus-current-headers) "")
+          ,(gnus-group-read-only-p)
+          ,gnus-summary-buffer no-highlight)))))
   ;; Not in `gnus-mime-save-part-and-strip':
   (gnus-article-edit-done)
   (gnus-summary-expand-window)
@@ -4499,9 +4519,28 @@ If no internal viewer is available, use an external viewer."
              (narrow-to-region (point-min) (point))
              (gnus-treat-article 'head))))))))
 
-(defvar gnus-mime-display-multipart-as-mixed nil)
-(defvar gnus-mime-display-multipart-alternative-as-mixed nil)
-(defvar gnus-mime-display-multipart-related-as-mixed nil)
+(defcustom gnus-mime-display-multipart-as-mixed nil
+  "Display \"multipart\" parts as  \"multipart/mixed\".
+
+If t, it overrides nil values of
+`gnus-mime-display-multipart-alternative-as-mixed' and
+`gnus-mime-display-multipart-related-as-mixed'."
+  :group 'gnus-article-mime
+  :type 'boolean)
+
+(defcustom gnus-mime-display-multipart-alternative-as-mixed nil
+  "Display \"multipart/alternative\" parts as  \"multipart/mixed\"."
+  :group 'gnus-article-mime
+  :type 'boolean)
+
+(defcustom gnus-mime-display-multipart-related-as-mixed nil
+  "Display \"multipart/related\" parts as  \"multipart/mixed\".
+
+If displaying \"text/html\" is discouraged \(see
+`mm-discouraged-alternatives'\) images or other material inside a
+\"multipart/related\" part might be overlooked when this variable is nil."
+  :group 'gnus-article-mime
+  :type 'boolean)
 
 (defun gnus-mime-display-part (handle)
   (cond
@@ -4873,14 +4912,31 @@ If given a numerical ARG, move forward ARG pages."
 (defun gnus-article-goto-next-page ()
   "Show the next page of the article."
   (interactive)
-  (gnus-eval-in-buffer-window gnus-summary-buffer
-    (gnus-summary-next-page)))
+  (when (gnus-article-next-page)
+    (goto-char (point-min))
+    (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
+
 
 (defun gnus-article-goto-prev-page ()
   "Show the next page of the article."
   (interactive)
-  (gnus-eval-in-buffer-window gnus-summary-buffer
-    (gnus-summary-prev-page)))
+  (if (bobp)
+      (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
+    (gnus-article-prev-page nil)))
+
+;; This is cleaner but currently breaks `gnus-pick-mode':
+;;
+;; (defun gnus-article-goto-next-page ()
+;;   "Show the next page of the article."
+;;   (interactive)
+;;   (gnus-eval-in-buffer-window gnus-summary-buffer
+;;     (gnus-summary-next-page)))
+;;
+;; (defun gnus-article-goto-prev-page ()
+;;   "Show the next page of the article."
+;;   (interactive)
+;;   (gnus-eval-in-buffer-window gnus-summary-buffer
+;;     (gnus-summary-prev-page)))
 
 (defun gnus-article-next-page (&optional lines)
   "Show the next page of the current article.
@@ -4897,19 +4953,25 @@ Argument LINES specifies lines to be scrolled up."
              (save-excursion
                (save-restriction
                  (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
-         t                             ;Nothing more.
+         (progn
+           (when gnus-article-over-scroll
+             (gnus-article-next-page-1 lines))
+           t)                  ;Nothing more.
        (gnus-narrow-to-page 1)         ;Go to next page.
        nil)
     ;; More in this page.
-    (let ((scroll-in-place nil))
-      (condition-case ()
-         (scroll-up lines)
-       (end-of-buffer
-        ;; Long lines may cause an end-of-buffer error.
-        (goto-char (point-max)))))
-    (move-to-window-line 0)
+    (gnus-article-next-page-1 lines)
     nil))
 
+(defun gnus-article-next-page-1 (lines)
+  (let ((scroll-in-place nil))
+    (condition-case ()
+       (scroll-up lines)
+      (end-of-buffer
+       ;; Long lines may cause an end-of-buffer error.
+       (goto-char (point-max)))))
+  (move-to-window-line 0))
+
 (defun gnus-article-prev-page (&optional lines)
   "Show previous page of current article.
 Argument LINES specifies lines to be scrolled down."
@@ -5556,8 +5618,8 @@ groups."
 
 (defcustom gnus-button-url-regexp
   (if (string-match "[[:digit:]]" "1") ;; support POSIX?
-      "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)"
-    "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)")
+      "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)"
+    "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)")
   "Regular expression that matches URLs."
   :group 'gnus-article-buttons
   :type 'regexp)
@@ -5604,16 +5666,13 @@ The function must take one argument, the string naming the URL."
 
 (defcustom gnus-button-ctan-directory-regexp
   (concat
-   "\\b\\(\\("
+   "\\("; Cannot use `\(?: ... \)' (compatibility with Emacs 20).
    "biblio\\|digests\\|dviware\\|fonts\\|graphics\\|help\\|"
    "indexing\\|info\\|language\\|macros\\|support\\|systems\\|"
    "tds\\|tools\\|usergrps\\|web\\|nonfree\\|obsolete"
-   "\\)"
-   ;; Require at least one subdirectory to avoid false positives.
-   "/[-a-z0-9]+/[/-a-z0-9]+\\)")
-  "Regular expression that matches ctan directories.
-The first regexp group has to match the directory relative to
-`gnus-ctan-url'."
+   "\\)")
+  "Regular expression for ctan directories.
+It should match all directories in the top level of `gnus-ctan-url'."
   :group 'gnus-article-buttons
   :type 'regexp)
 
@@ -5629,7 +5688,7 @@ The first regexp group has to match the directory relative to
   "What to do when the button on a string as \"foo123@bar.invalid\" is pushed.
 Strings like this can be either a message ID or a mail address.  If it is one
 of the symbols `mid' or `mail', Gnus will always assume that the string is a
-message ID or a mail address, respectivly.  If this variable is set to the
+message ID or a mail address, respectively.  If this variable is set to the
 symbol `ask', always query the user what do do.  If it is a function, this
 function will be called with the string as it's only argument.  The function
 must return `mid', `mail', `invalid' or `ask'."
@@ -5695,7 +5754,7 @@ must return `mid', `mail', `invalid' or `ask'."
   "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
 
 A negative RATE indicates a message IDs, whereas a positive indicates a mail
-address.  The REGEXP is processed with `case-fold-search' set to `nil'."
+address.  The REGEXP is processed with `case-fold-search' set to nil."
   :group 'gnus-article-buttons
   :type '(repeat (cons (number :tag "Rate")
                       (regexp :tag "Regexp"))))
@@ -5924,10 +5983,10 @@ positives are possible."
      0 (>= gnus-button-message-level 0) gnus-button-handle-news 3)
     ("\\b\\(nntp\\|news\\):\\([^>\n\t ]*@[^>)!;:,\n\t ]*\\)" 0 t
      gnus-button-handle-news 2)
-    ("\\(\\b<\\(url:[>\n\t ]*\\)?news:[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
-     1 (>= gnus-button-message-level 0) gnus-button-fetch-group 4)
-    ("\\bnews:\\(//\\)?\\([^'\">\n\t ]+\\)"
-     0 (>= gnus-button-message-level 0) gnus-button-fetch-group 2)
+    ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
+     1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5)
+    ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)"
+     0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3)
     ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
      2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
     ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
@@ -5937,12 +5996,19 @@ positives are possible."
     ("\\bmailto:\\([^ \n\t]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ;; CTAN
-    ("\\bCTAN:[ \t\n]*\\([^>)!;:,'\n\t ]*\\)"
+    ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\("
+            gnus-button-ctan-directory-regexp
+            "[^][>)!;:,'\n\t ]+\\)")
      0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1)
-    ("\\btex-archive/\\([-/a-z0-9]+\\)"
-     1 (>= gnus-button-tex-level 7) gnus-button-handle-ctan 1)
-    (gnus-button-ctan-directory-regexp
-     1 (>= gnus-button-tex-level 9) gnus-button-handle-ctan 1)
+    ((concat "\\btex-archive/\\("
+            gnus-button-ctan-directory-regexp
+            "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)")
+     1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1)
+    ((concat
+      "\\b\\("
+      gnus-button-ctan-directory-regexp
+      "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)")
+     1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
     ;; This is info
     ("\\binfo:\\(//\\)?\\([^'\">\n\t ]+\\)"
      0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
@@ -5972,9 +6038,9 @@ positives are possible."
      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
     ("`\\([a-z][-a-z0-9]+\\.el\\)'"
      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
-    ("`\\([a-z]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+    ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
      0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
-    ("`\\([a-z]+-[a-z]+\\)'"
+    ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
      0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
     ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
      1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
@@ -6048,8 +6114,8 @@ variable it the real callback function."
      0 (>= gnus-button-browse-level 0) browse-url 0)
     ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
-    ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)"
-     1 (>= gnus-button-message-level 0) gnus-button-message-id 3))
+    ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
+     1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
   "*Alist of headers and regexps to match buttons in article heads.
 
 This alist is very similar to `gnus-button-alist', except that each