]> code.delx.au - gnu-emacs/blobdiff - lisp/gnus/gnus-art.el
Publicize cl--generic-all-functions
[gnu-emacs] / lisp / gnus / gnus-art.el
index 5de4b5829ce1cfbd0f10105545019e7c89980a74..66b1e38da2efe09141af42cc3fb9c9268aa953ed 100644 (file)
@@ -1,6 +1,6 @@
 ;;; gnus-art.el --- article mode commands for Gnus
 
-;; Copyright (C) 1996-2015 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2016 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -50,6 +50,7 @@
 (autoload 'ansi-color-apply-on-region "ansi-color")
 (autoload 'mm-url-insert-file-contents-external "mm-url")
 (autoload 'mm-extern-cache-contents "mm-extern")
+(autoload 'url-expand-file-name "url-expand")
 
 (defgroup gnus-article nil
   "Article display."
@@ -194,16 +195,16 @@ this list."
   "Headers that are only to be displayed if they have interesting data.
 Possible values in this list are:
 
-  'empty       Headers with no content.
-  'newsgroups  Newsgroup identical to Gnus group.
-  'to-address  To identical to To-address.
-  'to-list     To identical to To-list.
-  'cc-list     CC identical to To-list.
-  'followup-to Followup-to identical to Newsgroups.
-  'reply-to    Reply-to identical to From.
-  'date        Date less than four days old.
-  'long-to     To and/or Cc longer than 1024 characters.
-  'many-to     Multiple To and/or Cc."
+  `empty'       Headers with no content.
+  `newsgroups'  Newsgroup identical to Gnus group.
+  `to-address'  To identical to To-address.
+  `to-list'     To identical to To-list.
+  `cc-list'     CC identical to To-list.
+  `followup-to' Followup-to identical to Newsgroups.
+  `reply-to'    Reply-to identical to From.
+  `date'        Date less than four days old.
+  `long-to'     To and/or Cc longer than 1024 characters.
+  `many-to'     Multiple To and/or Cc."
   :type '(set (const :tag "Headers with no content." empty)
              (const :tag "Newsgroups identical to Gnus group." newsgroups)
              (const :tag "To identical to To-address." to-address)
@@ -254,14 +255,12 @@ This can also be a list of the above values."
   :group 'gnus-article-signature)
 
 (defcustom gnus-hidden-properties
-  (if (featurep 'xemacs)
-      ;; `intangible' is evil, but I keep it here in case it's useful.
-      '(invisible t intangible t)
-    ;; Emacs's command loop moves point out of invisible text anyway, so
-    ;; `intangible' is clearly not needed there.
-    '(invisible t))
+  ;; We use to have `intangible' here as well, but Emacs's command loop moves
+  ;; point out of invisible text anyway, so `intangible' is clearly not
+  ;; needed there.  And XEmacs doesn't handle `intangible' anyway.
+  '(invisible t)
   "Property list to use for hiding text."
-  :type 'sexp
+  :type 'plist
   :group 'gnus-article-hiding)
 
 ;; Fixme: This isn't the right thing for mixed graphical and non-graphical
@@ -331,7 +330,7 @@ to match a mail address in the From: header, BANNER is one of a symbol
 If ADDRESS matches author's mail address, it will remove things like
 advertisements.  For example:
 
-\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
+\((\"@yoo-hoo\\\\.co\\\\.jp\\\\\\='\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
 "
   :type '(repeat
          (cons
@@ -400,7 +399,7 @@ advertisements.  For example:
   "*Alist that says how to fontify certain phrases.
 Each item looks like this:
 
-  (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
+  (\"_\\\\(\\\\w+\\\\)_\" 0 1 \\='underline)
 
 The first element is a regular expression to be matched.  The second
 is a number that says what regular expression grouping used to find
@@ -528,6 +527,12 @@ each invocation of the saving commands."
                 (item :tag "never" nil)
                 (sexp :tag "once" :format "%t\n" :value t)))
 
+(defcustom gnus-article-show-cursor nil
+  "If non-nil, show the cursor in the Article buffer even when not selected."
+  :version "25.1"
+  :group 'gnus-article
+  :type 'bool)
+
 (defcustom gnus-saved-headers gnus-visible-headers
   "Headers to keep if `gnus-save-all-headers' is nil.
 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
@@ -662,7 +667,7 @@ For instance, if you would like to save articles related to Gnus in
 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
 you could set this variable to something like:
 
'((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
 ((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
 
 This variable is an alist where the key is the match and the
@@ -887,12 +892,12 @@ Here are examples:
 
 ;; Specify the altitude of Face images in the From header.
 \(setq gnus-face-properties-alist
-      '((pbm . (:face gnus-x-face :ascent 80))
+      \\='((pbm . (:face gnus-x-face :ascent 80))
        (png . (:ascent 80))))
 
 ;; Show Face images as pressed buttons.
 \(setq gnus-face-properties-alist
-      '((pbm . (:face gnus-x-face :relief -2))
+      \\='((pbm . (:face gnus-x-face :relief -2))
        (png . (:relief -2))))
 
 See the manual for the valid properties for various image types.
@@ -1023,7 +1028,7 @@ on parts -- for instance, adding Vcard info to a database."
 
 (defcustom gnus-article-date-headers '(combined-lapsed)
   "A list of Date header formats to display.
-Valid formats are `ut' (universal time), `local' (local time
+Valid formats are `ut' (Universal Time), `local' (local time
 zone), `english' (readable English), `lapsed' (elapsed time),
 `combined-lapsed' (both the original date and the elapsed time),
 `original' (the original date header), `iso8601' (ISO8601
@@ -1257,7 +1262,7 @@ how to control what it hides."
   :type gnus-article-treat-custom)
 
 (defcustom gnus-treat-strip-list-identifiers 'head
-  "Strip list identifiers from `gnus-list-identifiers`.
+  "Strip list identifiers from `gnus-list-identifiers'.
 Valid values are nil, t, `head', `first', `last', an integer or a
 predicate.  See Info node `(gnus)Customizing Articles'."
   :version "21.1"
@@ -1628,8 +1633,11 @@ It is a string, such as \"PGP\". If nil, ask user."
 
 (defvar idna-program)
 
-(defcustom gnus-use-idna (and (condition-case nil (require 'idna) (file-error))
-                             (mm-coding-system-p 'utf-8)
+(defcustom gnus-use-idna (and (mm-coding-system-p 'utf-8)
+                             (condition-case nil
+                                 (require 'idna)
+                               (file-error)
+                               (invalid-operation))
                              idna-program
                              (executable-find idna-program))
   "Whether IDNA decoding of headers is used when viewing messages.
@@ -1657,7 +1665,9 @@ called with the group name as the parameter, and should return a
 regexp."
   :version "24.1"
   :group 'gnus-art
-  :type '(choice regexp function))
+  :type '(choice (const :tag "Allow all" nil)
+                 (regexp :tag "Regular expression")
+                 (function :tag "Use a function")))
 
 ;;; Internal variables
 
@@ -1733,7 +1743,7 @@ regexp."
     (modify-syntax-entry ?` " " table)
     table)
   "Syntax table used in article mode buffers.
-Initialized from `text-mode-syntax-table.")
+Initialized from `text-mode-syntax-table'.")
 
 (defvar gnus-save-article-buffer nil)
 
@@ -1771,19 +1781,12 @@ Initialized from `text-mode-syntax-table.")
   (re-search-forward (concat "^\\(" header "\\):") nil t))
 
 (defsubst gnus-article-hide-text (b e props)
-  "Set text PROPS on the B to E region, extending `intangible' 1 past B."
-  (gnus-add-text-properties-when 'article-type nil b e props)
-  (when (memq 'intangible props)
-    (put-text-property
-     (max (1- b) (point-min))
-     b 'intangible (cddr (memq 'intangible props)))))
+  "Set text PROPS on the B to E region."
+  (gnus-add-text-properties-when 'article-type nil b e props))
 
 (defsubst gnus-article-unhide-text (b e)
   "Remove hidden text properties from region between B and E."
-  (remove-text-properties b e gnus-hidden-properties)
-  (when (memq 'intangible gnus-hidden-properties)
-    (put-text-property (max (1- b) (point-min))
-                      b 'intangible nil)))
+  (remove-text-properties b e gnus-hidden-properties))
 
 (defun gnus-article-hide-text-type (b e type)
   "Hide text of TYPE between B and E."
@@ -1795,10 +1798,7 @@ Initialized from `text-mode-syntax-table.")
   "Unhide text of TYPE between B and E."
   (gnus-delete-wash-type type)
   (remove-text-properties
-   b e (cons 'article-type (cons type gnus-hidden-properties)))
-  (when (memq 'intangible gnus-hidden-properties)
-    (put-text-property (max (1- b) (point-min))
-                      b 'intangible nil)))
+   b e (cons 'article-type (cons type gnus-hidden-properties))))
 
 (defun gnus-article-delete-text-of-type (type)
   "Delete text of TYPE in the current buffer."
@@ -2264,8 +2264,7 @@ This only works if the article in question is HTML."
     (save-restriction
       (widen)
       (if (eq mm-text-html-renderer 'w3m)
-         (let ((mm-inline-text-html-with-images nil))
-           (w3m-toggle-inline-images))
+         (w3m-toggle-inline-images)
        (dolist (region (gnus-find-text-property-region (point-min) (point-max)
                                                        'image-displayer))
          (destructuring-bind (start end function) region
@@ -2328,7 +2327,7 @@ long lines if and only if arg is positive."
       (goto-char (point-max))
       (let ((start (point)))
        (insert "X-Boundary: ")
-       (gnus-add-text-properties start (point) '(invisible t intangible t))
+       (gnus-add-text-properties start (point) gnus-hidden-properties)
        (insert (let (str (max (window-width)))
                  (if (featurep 'xemacs)
                      (setq max (1- max)))
@@ -2436,7 +2435,7 @@ long lines if and only if arg is positive."
              (unless (setq from (gnus-article-goto-header "from"))
                (insert "From:")
                (setq from (point))
-               (insert " [no `from' set]\n"))
+               (insert " [no 'from' set]\n"))
              (while faces
                (when (setq png (gnus-convert-face-to-png (pop faces)))
                  (setq image
@@ -2778,7 +2777,7 @@ summary buffer."
       (cond ((file-directory-p file)
             (when (or (not (eq how 'file))
                       (gnus-y-or-n-p
-                       (format
+                       (gnus-format-message
                         "Delete temporary HTML file(s) in directory `%s'? "
                         (file-name-as-directory file))))
               (gnus-delete-directory file)))
@@ -2792,10 +2791,9 @@ summary buffer."
     (setq gnus-article-browse-html-temp-list nil))
   gnus-article-browse-html-temp-list)
 
-(defun gnus-article-browse-html-save-cid-content (cid handles directory abs)
+(defun gnus-article-browse-html-save-cid-content (cid handles directory)
   "Find CID content in HANDLES and save it in a file in DIRECTORY.
-Return absolute file name if ABS is non-nil, otherwise relative to
-the parent of DIRECTORY."
+Return file name relative to the parent of DIRECTORY."
   (save-match-data
     (let (file afile)
       (catch 'found
@@ -2807,7 +2805,7 @@ the parent of DIRECTORY."
           ((not (or (bufferp (car handle)) (stringp (car handle)))))
           ((equal (mm-handle-media-supertype handle) "multipart")
            (when (setq file (gnus-article-browse-html-save-cid-content
-                             cid handle directory abs))
+                             cid handle directory))
              (throw 'found file)))
           ((equal (concat "<" cid ">") (mm-handle-id handle))
            (setq file (or (mm-handle-filename handle)
@@ -2817,11 +2815,9 @@ the parent of DIRECTORY."
                                         mailcap-mime-extensions))))
                  afile (expand-file-name file directory))
            (mm-save-part-to-file handle afile)
-           (throw 'found (if abs
-                             afile
-                           (concat (file-name-nondirectory
-                                    (directory-file-name directory))
-                                   "/" file))))))))))
+           (throw 'found (concat (file-name-nondirectory
+                                  (directory-file-name directory))
+                                 "/" file)))))))))
 
 (defun gnus-article-browse-html-parts (list &optional header)
   "View all \"text/html\" parts from LIST.
@@ -2857,13 +2853,32 @@ message header will be added to the bodies of the \"text/html\" parts."
               (insert content)
               ;; resolve cid contents
               (let ((case-fold-search t)
-                    abs st cid-file)
+                    st base regexp cid-file)
                 (goto-char (point-min))
-                (when (re-search-forward "<head[\t\n >]" nil t)
-                  (setq st (match-end 0)
-                        abs (or
-                             (not (re-search-forward "</head[\t\n >]" nil t))
-                             (re-search-backward "<base[\t\n >]" st t))))
+                (when (and (re-search-forward "<head[\t\n >]" nil t)
+                           (progn
+                             (setq st (match-end 0))
+                             (re-search-forward "</head[\t\n >]" nil t))
+                           (re-search-backward "<base\
+\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+href=\"\\([^\"]+\\)\"[^>]*>" st t))
+                  (setq base (match-string 1))
+                  (replace-match "<!--\\&-->")
+                  (setq st (point))
+                  (dolist (tag '(("a" . "href") ("form" . "action")
+                                 ("img" . "src")))
+                    (setq regexp (concat "<" (car tag)
+                                         "\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+"
+                                         (cdr tag) "=\"\\([^\"]+\\)"))
+                    (while (re-search-forward regexp nil t)
+                      (insert (prog1
+                                  (condition-case nil
+                                      (save-match-data
+                                        (url-expand-file-name (match-string 1)
+                                                              base))
+                                    (error (match-string 1)))
+                                (delete-region (match-beginning 1)
+                                               (match-end 1)))))
+                    (goto-char st)))
                 (while (re-search-forward "\
 <img[\t\n ]+\\(?:[^\t\n >]+[\t\n ]+\\)*src=\"\\(cid:\\([^\"]+\\)\\)\""
                                           nil t)
@@ -2877,18 +2892,7 @@ message header will be added to the bodies of the \"text/html\" parts."
                                (match-string 2)
                                (with-current-buffer gnus-article-buffer
                                  gnus-article-mime-handles)
-                               cid-dir abs))
-                    (when abs
-                      (setq cid-file
-                            (if (eq system-type 'cygwin)
-                                (concat "file:///"
-                                        (substring
-                                         (with-output-to-string
-                                           (call-process "cygpath" nil
-                                                         standard-output
-                                                         nil "-m" cid-file))
-                                         0 -1))
-                              (concat "file://" cid-file))))
+                               cid-dir))
                     (replace-match cid-file nil nil nil 1))))
               (unless content (setq content (buffer-string))))
             (when (or charset header (not file))
@@ -4523,7 +4527,8 @@ commands:
   (set (make-local-variable 'nobreak-char-display) nil)
   ;; Enable `gnus-article-remove-images' to delete images shr.el renders.
   (set (make-local-variable 'shr-put-image-function) 'gnus-shr-put-image)
-  (setq cursor-in-non-selected-windows nil)
+  (unless gnus-article-show-cursor
+    (setq cursor-in-non-selected-windows nil))
   (gnus-set-default-directory)
   (buffer-disable-undo)
   (setq buffer-read-only t
@@ -4930,25 +4935,30 @@ General format specifiers can also be used.  See Info node
                (vector (caddr c) (car c) :active t))
              gnus-url-button-commands)))
 
-(defmacro gnus-bind-safe-url-regexp (&rest body)
-  "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'."
-  `(let ((mm-w3m-safe-url-regexp
-         (let ((group (if (and (derived-mode-p 'gnus-article-mode)
-                               (gnus-buffer-live-p
-                                gnus-article-current-summary))
-                          (with-current-buffer gnus-article-current-summary
-                            gnus-newsgroup-name)
-                        gnus-newsgroup-name)))
-           (if (cond ((not group)
-                      ;; Maybe we're in a mml-preview buffer
-                      ;; and no group is selected.
-                      t)
-                     ((stringp gnus-safe-html-newsgroups)
-                      (string-match gnus-safe-html-newsgroups group))
-                     ((consp gnus-safe-html-newsgroups)
-                      (member group gnus-safe-html-newsgroups)))
-               nil
-             mm-w3m-safe-url-regexp))))
+(defmacro gnus-bind-mm-vars (&rest body)
+  "Bind some mm-* variables and execute BODY."
+  `(let (mm-html-inhibit-images
+        mm-html-blocked-images
+        (mm-w3m-safe-url-regexp mm-w3m-safe-url-regexp))
+     (with-current-buffer
+        (cond ((derived-mode-p 'gnus-article-mode)
+               (if (gnus-buffer-live-p gnus-article-current-summary)
+                   gnus-article-current-summary
+                 ;; Maybe we're in a mml-preview buffer
+                 ;; and no group is selected.
+                 (current-buffer)))
+              ((gnus-buffer-live-p gnus-summary-buffer)
+               gnus-summary-buffer)
+              (t (current-buffer)))
+       (setq mm-html-inhibit-images gnus-inhibit-images
+            mm-html-blocked-images (gnus-blocked-images))
+       (when (or (not gnus-newsgroup-name)
+                (and (stringp gnus-safe-html-newsgroups)
+                     (string-match gnus-safe-html-newsgroups
+                                   gnus-newsgroup-name))
+                (and (consp gnus-safe-html-newsgroups)
+                     (member gnus-newsgroup-name gnus-safe-html-newsgroups)))
+        (setq mm-w3m-safe-url-regexp nil)))
      ,@body))
 
 (defun gnus-mime-button-menu (event prefix)
@@ -4976,7 +4986,7 @@ General format specifiers can also be used.  See Info node
        (or (search-forward "\n\n") (goto-char (point-max)))
        (let ((inhibit-read-only t))
          (delete-region (point) (point-max))
-         (gnus-bind-safe-url-regexp (mm-display-parts handles)))))))
+         (gnus-bind-mm-vars (mm-display-parts handles)))))))
 
 (defun gnus-article-jump-to-part (n)
   "Jump to MIME part N."
@@ -5406,9 +5416,9 @@ Compressed files like .gz and .bz2 are decompressed."
                                    'gnus-undeletable t))))
          ;; We're in the article header.
          (delete-char -1)
-         (dolist (ovl (gnus-overlays-in btn (point)))
-           (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
-           (gnus-overlay-put ovl 'face nil))
+         (dolist (ovl (overlays-in btn (point)))
+           (overlay-put ovl 'gnus-button-attachment-extra t)
+           (overlay-put ovl 'face nil))
          (save-restriction
            (message-narrow-to-field)
            (let ((gnus-treatment-function-alist
@@ -5515,11 +5525,10 @@ If no internal viewer is available, use an external viewer."
         (gnus-mime-view-part-as-type
          nil (lambda (type) (mm-inlinable-p handle type)))
       (when handle
-       (gnus-bind-safe-url-regexp
-        (mm-display-part handle nil t))))))
+       (gnus-bind-mm-vars (mm-display-part handle nil t))))))
 
 (defun gnus-mime-action-on-part (&optional action)
-  "Do something with the MIME attachment at \(point\)."
+  "Do something with the MIME attachment at (point)."
   (interactive
    (list (gnus-completing-read "Action" (mapcar 'car gnus-mime-action-alist) t)))
   (gnus-article-check-buffer)
@@ -5746,7 +5755,7 @@ all parts."
                                 (mm-inlined-p handle)
                                 t)
                            (with-temp-buffer
-                             (gnus-bind-safe-url-regexp
+                             (gnus-bind-mm-vars
                               (setq retval (mm-display-part handle)))
                              (unless (zerop (buffer-size))
                                (buffer-string))))))
@@ -5801,9 +5810,9 @@ all parts."
                                    'gnus-undeletable t))))
          ;; We're in the article header.
          (delete-char -1)
-         (dolist (ovl (gnus-overlays-in point (point)))
-           (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
-           (gnus-overlay-put ovl 'face nil))
+         (dolist (ovl (overlays-in point (point)))
+           (overlay-put ovl 'gnus-button-attachment-extra t)
+           (overlay-put ovl 'face nil))
          (save-restriction
            (message-narrow-to-field)
            (let ((gnus-treatment-function-alist
@@ -5892,8 +5901,8 @@ all parts."
                (1- (point))
              (point)))
     (when gnus-article-button-face
-      (gnus-overlay-put (gnus-make-overlay b e nil t)
-                       'face gnus-article-button-face))
+      (overlay-put (make-overlay b e nil t)
+                  'face gnus-article-button-face))
     (widget-convert-button
      'link b e
      :mime-handle handle
@@ -5995,7 +6004,7 @@ If t, it overrides nil values of
   "Display \"multipart/related\" parts as  \"multipart/mixed\".
 
 If displaying \"text/html\" is discouraged \(see
-`mm-discouraged-alternatives'\) images or other material inside a
+`mm-discouraged-alternatives') images or other material inside a
 \"multipart/related\" part might be overlooked when this variable is nil."
   :version "22.1"
   :group 'gnus-article-mime
@@ -6107,7 +6116,7 @@ If nil, don't show those extra buttons."
                                       (set-buffer gnus-summary-buffer)
                                     (error))
                                   gnus-newsgroup-ignored-charsets)))
-             (gnus-bind-safe-url-regexp (mm-display-part handle t))))
+             (gnus-bind-mm-vars (mm-display-part handle t))))
           ((and text not-attachment)
            (mm-display-inline handle)))
          (goto-char (point-max))
@@ -6237,7 +6246,7 @@ If nil, don't show those extra buttons."
                  (mail-parse-ignored-charsets
                   (with-current-buffer gnus-summary-buffer
                     gnus-newsgroup-ignored-charsets)))
-             (gnus-bind-safe-url-regexp (mm-display-part preferred))
+             (gnus-bind-mm-vars (mm-display-part preferred))
              ;; Do highlighting.
              (save-excursion
                (save-restriction
@@ -6455,9 +6464,9 @@ in the body.  Use `gnus-header-face-alist' to highlight buttons."
                  (insert "\n")
                  (end-of-line)))
              (insert "\n")
-             (dolist (ovl (gnus-overlays-in (point-min) (point)))
-               (gnus-overlay-put ovl 'gnus-button-attachment-extra t)
-               (gnus-overlay-put ovl 'face nil))
+             (dolist (ovl (overlays-in (point-min) (point)))
+               (overlay-put ovl 'gnus-button-attachment-extra t)
+               (overlay-put ovl 'face nil))
              (let ((gnus-treatment-function-alist
                     '((gnus-treat-highlight-headers
                        gnus-article-highlight-headers))))
@@ -6874,11 +6883,13 @@ KEY is a string or a vector."
       (with-current-buffer gnus-article-current-summary
        (setq unread-command-events
              (if (featurep 'xemacs)
-                 (append key nil)
-               (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
-                                       (list 'meta (- x 128))
-                                     x))
-                       key)))
+                 (append key unread-command-events)
+               (nconc
+                (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+                                        (list 'meta (- x 128))
+                                      x))
+                        key)
+                unread-command-events)))
        (let ((cursor-in-echo-area t)
              gnus-pick-mode)
          (describe-key (read-key-sequence nil t))))
@@ -6896,11 +6907,13 @@ KEY is a string or a vector."
       (with-current-buffer gnus-article-current-summary
        (setq unread-command-events
              (if (featurep 'xemacs)
-                 (append key nil)
-               (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
-                                       (list 'meta (- x 128))
-                                     x))
-                       key)))
+                 (append key unread-command-events)
+               (nconc
+                (mapcar (lambda (x) (if (and (integerp x) (>= x 128))
+                                        (list 'meta (- x 128))
+                                      x))
+                        key)
+                unread-command-events)))
        (let ((cursor-in-echo-area t)
              gnus-pick-mode)
          (describe-key-briefly (read-key-sequence nil t) insert)))
@@ -7030,8 +7043,7 @@ If given a prefix, show the hidden text instead."
     (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
     (gnus-request-group gnus-newsgroup-name t)))
 
-(eval-when-compile
-  (autoload 'nneething-get-file-name "nneething"))
+(declare-function nneething-get-file-name "nneething" (id))
 
 (defun gnus-request-article-this-buffer (article group)
   "Get an article and insert it into this buffer."
@@ -7210,6 +7222,8 @@ If given a prefix, show the hidden text instead."
          (set-buffer buf))))))
 
 (defun gnus-block-private-groups (group)
+  "Allows images in newsgroups to be shown, blocks images in all
+other groups."
   (if (or (gnus-news-group-p group)
          (gnus-member-of-valid 'global group))
       ;; Block nothing in news groups.
@@ -7543,7 +7557,7 @@ must return `mid', `mail', `invalid' or `ask'."
     (10.0  . "^[^0-9]+@")
     (3.0   . "^[^0-9]+[0-9][0-9]?[0-9]?@")
     ;;      ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part
-    (3.0   . "\@stud")
+    (3.0   . "@stud")
     ;;
     (2.0   . "[a-z][a-z][._-][A-Z][a-z].*@")
     ;;
@@ -7551,7 +7565,7 @@ must return `mid', `mail', `invalid' or `ask'."
     (0.5   . "^[A-Z][a-z][a-z]")
     (1.5   . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3}
     (2.0   . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4}
-  "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
+  "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."
@@ -7610,9 +7624,9 @@ address, `ask' if unsure and `invalid' if the string is invalid."
          (gnus-message
           9 "Many digits in `%s', rate `%s', result `%s'."
           mid-or-mail rate result))
-        ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@"
+        ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*@"
                        mid-or-mail)
-         ;; Too few vowels [^aeiouy]{4,}.*\@
+         ;; Too few vowels [^aeiouy]{4,}.*@
          (setq result (+ result -5.0))
          (gnus-message
           9 "Few vowels in `%s', rate `%s', result `%s'."
@@ -7722,7 +7736,7 @@ Calls `describe-variable' or `describe-function'."
   "Call `locate-library' when pushing the corresponding URL button."
   (gnus-message 9 "url=`%s'" url)
   (let* ((lib (locate-library url))
-        (file (gnus-replace-in-string (or lib "") "\.elc" ".el")))
+        (file (gnus-replace-in-string (or lib "") "\\.elc" ".el")))
     (if (not lib)
        (gnus-message 1 "Cannot locale library `%s'." url)
       (find-file-read-only file))))
@@ -7829,11 +7843,11 @@ positives are possible."
     ("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
      ;; Exclude [.?] for URLs in gmane.emacs.cvs
      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
-    ("`\\([a-z][-a-z0-9]+\\.el\\)'"
+    ("['`‘]\\([a-z][-a-z0-9]+\\.el\\)['’]"
      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
-    ("`\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+    ("['`‘]\\([a-z][a-z0-9]+-[a-z0-9]+-[-a-z0-9]*[a-z]\\|\\(gnus\\|message\\)-[-a-z]+\\)['’]"
      0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
-    ("`\\([a-z][a-z0-9]+-[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)
@@ -7843,7 +7857,7 @@ positives are possible."
      0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
     ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET\\>"
      0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
-    ("`\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'"
+    ("['`‘]\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^'’]+\\)\\)['’]"
      ;; Unlike the other regexps we really have to require quoting
      ;; here to determine where it ends.
      1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
@@ -8035,8 +8049,8 @@ It does this by highlighting everything after
       (save-restriction
        (when (and gnus-signature-face
                   (gnus-article-narrow-to-signature))
-         (gnus-overlay-put (gnus-make-overlay (point-min) (point-max) nil t)
-                           'face gnus-signature-face)
+         (overlay-put (make-overlay (point-min) (point-max) nil t)
+                      'face gnus-signature-face)
          (widen)
          (gnus-article-search-signature)
          (let ((start (match-beginning 0))
@@ -8111,7 +8125,7 @@ url is put as the `gnus-button-url' overlay property on the button."
                                              (< (match-end 0) start))
                                     (regexp-quote (match-string 0)))
                                   "\
-\[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*"
+[\t ]*\\(?:\\([^\t\n \">]+\\)[\t ]*$\\|\\([^\t\n \">]*\\)[\t ]*"
                                   delim "\\)"))
                     (while (progn
                              (forward-line 1)
@@ -8134,12 +8148,12 @@ url is put as the `gnus-button-url' overlay property on the button."
                                       'gnus-button-push
                                       (list beg (assq 'gnus-button-url-regexp
                                                       gnus-button-alist)))))
-         (let ((overlay (gnus-make-overlay start end)))
-           (gnus-overlay-put overlay 'evaporate t)
-           (gnus-overlay-put overlay 'gnus-button-url
-                             (list (mapconcat 'identity (nreverse url) "")))
+         (let ((overlay (make-overlay start end)))
+           (overlay-put overlay 'evaporate t)
+           (overlay-put overlay 'gnus-button-url
+                        (list (mapconcat 'identity (nreverse url) "")))
            (when gnus-article-mouse-face
-             (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face)))
+             (overlay-put overlay 'mouse-face gnus-article-mouse-face)))
          t)
       (goto-char opoint))))
 
@@ -8178,8 +8192,8 @@ url is put as the `gnus-button-url' overlay property on the button."
 (defun gnus-article-add-button (from to fun &optional data text)
   "Create a button between FROM and TO with callback FUN and data DATA."
   (when gnus-article-button-face
-    (gnus-overlay-put (gnus-make-overlay from to nil t)
-                     'face gnus-article-button-face))
+    (overlay-put (make-overlay from to nil t)
+                'face gnus-article-button-face))
   (gnus-add-text-properties
    from to
    (nconc (and gnus-article-mouse-face
@@ -8518,8 +8532,8 @@ url is put as the `gnus-button-url' overlay property on the button."
                (1- (point))
              (point)))
     (when gnus-article-button-face
-      (gnus-overlay-put (gnus-make-overlay b e nil t)
-                        'face gnus-article-button-face))
+      (overlay-put (make-overlay b e nil t)
+                  'face gnus-article-button-face))
     (widget-convert-button
      'link b e
      :action 'gnus-button-prev-page
@@ -8554,8 +8568,8 @@ url is put as the `gnus-button-url' overlay property on the button."
                (1- (point))
              (point)))
     (when gnus-article-button-face
-      (gnus-overlay-put (gnus-make-overlay b e nil t)
-                        'face gnus-article-button-face))
+      (overlay-put (make-overlay b e nil t)
+                  'face gnus-article-button-face))
     (widget-convert-button
      'link b e
      :action 'gnus-button-next-page
@@ -8950,8 +8964,8 @@ For example:
                (1- (point))
              (point)))
     (when gnus-article-button-face
-      (gnus-overlay-put (gnus-make-overlay b e nil t)
-                        'face gnus-article-button-face))
+      (overlay-put (make-overlay b e nil t)
+                  'face gnus-article-button-face))
     (widget-convert-button
      'link b e
      :mime-handle handle