Revision: miles@gnu.org--gnu-2005/gnus--devo--0--patch-37
[gnus] / lisp / gnus-art.el
index 6a30529..ea588c9 100644 (file)
@@ -214,7 +214,7 @@ By default, if you set this t, then Gnus will display citations and
 signatures, but will never scroll down to show you a page consisting
 only of boring text.  Boring text is controlled by
 `gnus-article-boring-faces'."
-  :version "21.4"
+  :version "22.1"
   :type 'boolean
   :group 'gnus-article-hiding)
 
@@ -321,7 +321,7 @@ advertisements.  For example:
                   (symbol :tag "Item in `gnus-article-banner-alist'" none)
                   regexp
                   (const :tag "None" nil))))
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-washing)
 
 (defmacro gnus-emphasis-custom-with-format (&rest body)
@@ -816,7 +816,7 @@ If set, this variable overrides `gnus-unbuttonized-mime-types'.
 To see e.g. security buttons you could set this to
 `(\"multipart/signed\")'.
 This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-mime
   :type '(repeat regexp))
 
@@ -825,7 +825,7 @@ This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
 When nil (the default value), then some MIME parts do not get buttons,
 as described by the variables `gnus-buttonized-mime-types' and
 `gnus-unbuttonized-mime-types'."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-mime
   :type 'boolean)
 
@@ -833,7 +833,7 @@ as described by the variables `gnus-buttonized-mime-types' and
   "String used to delimit header and body.
 This variable is used by `gnus-article-treat-body-boundary' which can
 be controlled by `gnus-treat-body-boundary'."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-various
   :type '(choice (item :tag "None" :value nil)
                 string))
@@ -843,7 +843,7 @@ be controlled by `gnus-treat-body-boundary'."
   "Defines the location of the faces database.
 For information on obtaining this database of pretty pictures, please
 see http://www.cs.indiana.edu/picons/ftp/index.html"
-  :version "21.4"
+  :version "22.1"
   :type '(repeat directory)
   :link '(url-link :tag "download"
                   "http://www.cs.indiana.edu/picons/ftp/index.html")
@@ -983,7 +983,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Remove carriage returns.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -992,7 +992,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Remove newlines from within URLs.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1001,7 +1001,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Remove leading whitespace in headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1121,7 +1121,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Display the Date in a format that can be read aloud in English.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-head-custom)
@@ -1197,7 +1197,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Unfold folded header lines.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1206,7 +1206,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Fold headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1215,7 +1215,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Fold the Newsgroups and Followup-To headers.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1289,7 +1289,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.4"
+  :version "22.1"
   :link '(custom-manual "(gnus)Customizing Articles")
   :link '(custom-manual "(gnus)X-Face")
   :type gnus-article-treat-head-custom)
@@ -1320,7 +1320,7 @@ See Info node `(gnus)Customizing Articles' and Info node
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :group 'gnus-picon
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1336,7 +1336,7 @@ See Info node `(gnus)Customizing Articles' and Info node
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :group 'gnus-picon
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1352,7 +1352,7 @@ See Info node `(gnus)Customizing Articles' and Info node
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' and Info node
 `(gnus)Picons' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :group 'gnus-picon
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1369,7 +1369,7 @@ See Info node `(gnus)Customizing Articles' and Info node
   "Draw a boundary at the end of the headers.
 Valid values are nil and `head'.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-head-custom)
@@ -1387,7 +1387,7 @@ See Info node `(gnus)Customizing Articles' for details."
   "Format as HTML.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :link '(custom-manual "(gnus)Customizing Articles")
   :type gnus-article-treat-custom)
@@ -1423,7 +1423,7 @@ See Info node `(gnus)Customizing Articles' for details."
 To automatically treat X-PGP-Sig, set it to head.
 Valid values are nil, t, `head', `last', an integer or a predicate.
 See Info node `(gnus)Customizing Articles' for details."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-treat
   :group 'mime-security
   :link '(custom-manual "(gnus)Customizing Articles")
@@ -1437,7 +1437,7 @@ See Info node `(gnus)Customizing Articles' for details."
 (defcustom gnus-article-encrypt-protocol "PGP"
   "The protocol used for encrypt articles.
 It is a string, such as \"PGP\". If nil, ask user."
-  :version "21.4"
+  :version "22.1"
   :type 'string
   :group 'mime-security)
 
@@ -1449,13 +1449,13 @@ It is a string, such as \"PGP\". If nil, ask user."
                              (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."
-  :version "21.4"
+  :version "22.1"
   :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."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article
   :type 'boolean)
 
@@ -3741,6 +3741,8 @@ commands:
   (make-local-variable 'gnus-article-image-alist)
   (make-local-variable 'gnus-article-charset)
   (make-local-variable 'gnus-article-ignored-charsets)
+  ;; Prevent recent Emacsen from displaying non-break space as "\ ".
+  (set (make-local-variable 'show-nonbreak-escape) nil)
   (gnus-set-default-directory)
   (buffer-disable-undo)
   (setq buffer-read-only t
@@ -4227,60 +4229,63 @@ Deleting parts may malfunction or destroy the article; continue? ")
            (mm-merge-handles gnus-article-mime-handles handle))
       (gnus-mm-display-part handle))))
 
-(eval-when-compile
-  (require 'jka-compr))
-
-;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days
-;; emacs can do that itself.
-;;
-(defun gnus-mime-jka-compr-maybe-uncompress ()
-  "Uncompress the current buffer if `auto-compression-mode' is enabled.
-The uncompress method used is derived from `buffer-file-name'."
-  (when (and (fboundp 'jka-compr-installed-p)
-             (jka-compr-installed-p))
-    (let ((info (jka-compr-get-compression-info buffer-file-name)))
-      (when info
-        (let ((basename (file-name-nondirectory buffer-file-name))
-              (args     (jka-compr-info-uncompress-args    info))
-              (prog     (jka-compr-info-uncompress-program info))
-              (message  (jka-compr-info-uncompress-message info))
-              (err-file (jka-compr-make-temp-name)))
-          (if message
-              (message "%s %s..." message basename))
-          (unwind-protect
-              (unless (memq (apply 'call-process-region
-                                   (point-min) (point-max)
-                                   prog
-                                   t (list t err-file) nil
-                                   args)
-                            jka-compr-acceptable-retval-list)
-                (jka-compr-error prog args basename message err-file))
-            (jka-compr-delete-temp-file err-file)))))))
-
-(defun gnus-mime-copy-part (&optional handle)
+(defun gnus-mime-copy-part (&optional handle arg)
   "Put the MIME part under point into a new buffer.
 If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
 are decompressed."
-  (interactive)
+  (interactive (list nil current-prefix-arg))
   (gnus-article-check-buffer)
-  (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-        (contents (and handle (mm-get-part handle)))
-        (base (and handle
-                   (file-name-nondirectory
-                    (or
-                     (mail-content-type-get (mm-handle-type handle) 'name)
-                     (mail-content-type-get (mm-handle-disposition handle)
-                                            'filename)
-                     "*decoded*"))))
-        (buffer (and base (generate-new-buffer base))))
-    (when contents
-      (switch-to-buffer buffer)
-      (insert contents)
+  (unless handle
+    (setq handle (get-text-property (point) 'gnus-data)))
+  (when handle
+    (let ((filename (or (mail-content-type-get (mm-handle-disposition handle)
+                                              'name)
+                       (mail-content-type-get (mm-handle-disposition handle)
+                                              'filename)))
+         contents dont-decode charset coding-system)
+      (mm-with-unibyte-buffer
+       (mm-insert-part handle)
+       (setq contents (or (condition-case nil
+                              (mm-decompress-buffer filename nil 'sig)
+                            (error
+                             (setq dont-decode t)
+                             nil))
+                          (buffer-string))))
+      (setq filename (cond (filename (file-name-nondirectory filename))
+                          (dont-decode "*raw data*")
+                          (t "*decoded*")))
+      (cond
+       (dont-decode)
+       ((not arg)
+       (unless (setq charset (mail-content-type-get
+                              (mm-handle-type handle) 'charset))
+         (unless (setq coding-system (mm-with-unibyte-buffer
+                                       (insert contents)
+                                       (mm-find-buffer-file-coding-system)))
+           (setq charset gnus-newsgroup-charset))))
+       ((numberp arg)
+       (setq charset (or (cdr (assq arg
+                                    gnus-summary-show-article-charset-alist))
+                         (mm-read-coding-system "Charset: ")))))
+      (switch-to-buffer (generate-new-buffer filename))
+      (if (or coding-system
+             (and charset
+                  (setq coding-system (mm-charset-to-coding-system charset))
+                  (not (eq charset 'ascii))))
+         (progn
+           (mm-enable-multibyte)
+           (insert (mm-decode-coding-string contents coding-system))
+           (setq buffer-file-coding-system
+                 (if (boundp 'last-coding-system-used)
+                     (symbol-value 'last-coding-system-used)
+                   coding-system)))
+       (mm-disable-multibyte)
+       (insert contents)
+       (setq buffer-file-coding-system mm-binary-coding-system))
       ;; We do it this way to make `normal-mode' set the appropriate mode.
       (unwind-protect
          (progn
-           (setq buffer-file-name (expand-file-name base))
-           (gnus-mime-jka-compr-maybe-uncompress)
+           (setq buffer-file-name (expand-file-name filename))
            (normal-mode))
        (setq buffer-file-name nil))
       (goto-char (point-min)))))
@@ -4311,37 +4316,57 @@ are decompressed."
          (ps-despool filename)))))
 
 (defun gnus-mime-inline-part (&optional handle arg)
-  "Insert the MIME part under point into the current buffer."
+  "Insert the MIME part under point into the current buffer.
+Compressed files like .gz and .bz2 are decompressed."
   (interactive (list nil current-prefix-arg))
   (gnus-article-check-buffer)
-  (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
-        contents charset
-        (b (point))
-        (inhibit-read-only t))
-    (when handle
+  (unless handle
+    (setq handle (get-text-property (point) 'gnus-data)))
+  (when handle
+    (let ((b (point))
+         (inhibit-read-only t)
+         contents charset coding-system)
       (if (and (not arg) (mm-handle-undisplayer handle))
          (mm-remove-part handle)
-       (setq contents (mm-get-part handle))
+       (mm-with-unibyte-buffer
+         (mm-insert-part handle)
+         (setq contents
+               (or (mm-decompress-buffer
+                    (or (mail-content-type-get (mm-handle-disposition handle)
+                                               'name)
+                        (mail-content-type-get (mm-handle-disposition handle)
+                                               'filename))
+                    nil t)
+                   (buffer-string))))
        (cond
         ((not arg)
-         (setq charset (or (mail-content-type-get
-                            (mm-handle-type handle) 'charset)
-                           gnus-newsgroup-charset)))
+         (unless (setq charset (mail-content-type-get
+                                (mm-handle-type handle) 'charset))
+           (unless (setq coding-system
+                         (mm-with-unibyte-buffer
+                           (insert contents)
+                           (mm-find-buffer-file-coding-system)))
+             (setq charset gnus-newsgroup-charset))))
         ((numberp arg)
          (if (mm-handle-undisplayer handle)
              (mm-remove-part handle))
          (setq charset
                (or (cdr (assq arg
                               gnus-summary-show-article-charset-alist))
-                   (mm-read-coding-system "Charset: ")))))
+                   (mm-read-coding-system "Charset: "))))
+        (t
+         (if (mm-handle-undisplayer handle)
+             (mm-remove-part handle))))
        (forward-line 2)
-       (mm-insert-inline handle
-                         (if (and charset
-                                  (setq charset (mm-charset-to-coding-system
-                                                 charset))
-                                  (not (eq charset 'ascii)))
-                             (mm-decode-coding-string contents charset)
-                           contents))
+       (mm-insert-inline
+        handle
+        (if (or coding-system
+                (and charset
+                     (setq coding-system
+                           (mm-charset-to-coding-system charset))
+                     (not (eq charset 'ascii))))
+            (mm-decode-coding-string contents coding-system)
+          (mm-string-to-multibyte contents)))
        (goto-char b)))))
 
 (defun gnus-mime-view-part-as-charset (&optional handle arg)
@@ -4674,7 +4699,7 @@ If t, it overrides nil values of
 
 (defcustom gnus-mime-display-multipart-alternative-as-mixed nil
   "Display \"multipart/alternative\" parts as  \"multipart/mixed\"."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-mime
   :type 'boolean)
 
@@ -4684,7 +4709,7 @@ If t, it overrides nil values of
 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."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-mime
   :type 'boolean)
 
@@ -5786,7 +5811,7 @@ groups."
 (defcustom gnus-button-valid-fqdn-regexp
   message-valid-fqdn-regexp
   "Regular expression that matches a valid FQDN."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'regexp)
 
@@ -5794,7 +5819,7 @@ groups."
   "Function to use for displaying man pages.
 The function must take at least one argument with a string naming the
 man page."
-  :version "21.4"
+  :version "22.1"
   :type '(choice (function-item :tag "Man" manual-entry)
                 (function-item :tag "Woman" woman)
                 (function :tag "Other"))
@@ -5805,7 +5830,7 @@ man page."
 If the default site is too slow, try to find a CTAN mirror, see
 <URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>.  See also
 the variable `gnus-button-handle-ctan'."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type '(choice (const "http://www.tex.ac.uk/tex-archive/")
@@ -5816,14 +5841,14 @@ the variable `gnus-button-handle-ctan'."
 (defcustom gnus-button-ctan-handler 'browse-url
   "Function to use for displaying CTAN links.
 The function must take one argument, the string naming the URL."
-  :version "21.4"
+  :version "22.1"
   :type '(choice (function-item :tag "Browse Url" browse-url)
                 (function :tag "Other"))
   :group 'gnus-article-buttons)
 
 (defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
   "Bogus strings removed from CTAN URLs."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :type '(choice (const "^/?tex-archive/\\|/")
                 (regexp :tag "Other")))
@@ -5837,7 +5862,7 @@ The function must take one argument, the string naming the URL."
    "\\)")
   "Regular expression for ctan directories.
 It should match all directories in the top level of `gnus-ctan-url'."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'regexp)
 
@@ -5847,7 +5872,7 @@ It should match all directories in the top level of `gnus-ctan-url'."
          gnus-button-valid-fqdn-regexp
          ">?\\)\\b")
   "Regular expression that matches a message ID or a mail address."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'regexp)
 
@@ -5859,7 +5884,7 @@ 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'."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :type '(choice (function-item :tag "Heuristic function"
                                gnus-button-mid-or-mail-heuristic)
@@ -5923,7 +5948,7 @@ must return `mid', `mail', `invalid' or `ask'."
 
 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."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :type '(repeat (cons (number :tag "Rate")
                       (regexp :tag "Regexp"))))
@@ -6108,7 +6133,7 @@ positives are possible.  Note that you can set this variable local to
 specific groups.  Setting it higher in TeX groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type 'integer)
@@ -6120,7 +6145,7 @@ positives are possible.  Note that you can set this variable local to
 specific groups.  Setting it higher in Unix groups is probably a good idea.
 See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
 how to set variables in specific groups."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type 'integer)
@@ -6132,7 +6157,7 @@ positives are possible.  Note that you can set this variable local to
 specific groups.  Setting it higher in Emacs or Gnus related groups is
 probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
 `gnus-parameters' on how to set variables in specific groups."
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :link '(custom-manual "(gnus)Group Parameters")
   :type 'integer)
@@ -6142,7 +6167,7 @@ probably a good idea.  See Info node `(gnus)Group Parameters' and the variable
 The higher the number, the more buttons will appear and the more false
 positives are possible."
   ;; mail addresses, MIDs, URLs for news, ...
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'integer)
 
@@ -6151,7 +6176,7 @@ positives are possible."
 The higher the number, the more buttons will appear and the more false
 positives are possible."
   ;; stuff handled by `browse-url' or `gnus-button-embedded-url'
-  :version "21.4"
+  :version "22.1"
   :group 'gnus-article-buttons
   :type 'integer)
 
@@ -6653,10 +6678,10 @@ specified by `gnus-button-alist'."
   (if (string-match "\\([^#]+\\)#?\\(.*\\)" url)
       (gnus-info-find-node
        (concat "("
-              (gnus-url-unhex-string 
+              (gnus-url-unhex-string
                 (match-string 1 url))
               ")"
-              (or (gnus-url-unhex-string 
+              (or (gnus-url-unhex-string
                    (match-string 2 url))
                   "Top")))
     (error "Can't parse %s" url)))