X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-art.el;h=ea588c9633314fd69b53286119e9a2ac94e84c23;hb=e405b22c6b46721607c5e6c712a4705c23dee751;hp=885b33d40114d95af2aeb5d8a703338b97aaacc0;hpb=412d98be82fc63bc693b49700c61a88188912459;p=gnus diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 885b33d40..ea588c963 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -1,5 +1,5 @@ ;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -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 @@ -3774,14 +3776,19 @@ commands: (mm-enable-multibyte) (setq major-mode 'gnus-original-article-mode) (make-local-variable 'gnus-original-article)) - (if (get-buffer name) + (if (and (get-buffer name) + (with-current-buffer name + (if gnus-article-edit-mode + (if (y-or-n-p "Article mode edit in progress; discard? ") + (progn + (set-buffer-modified-p nil) + (gnus-kill-buffer name) + (message "") + nil) + (error "Action aborted")) + t))) (save-excursion (set-buffer name) - (when (and gnus-article-edit-mode - (buffer-modified-p) - (not - (y-or-n-p "Article mode edit in progress; discard? "))) - (error "Action aborted")) (set (make-local-variable 'gnus-article-edit-mode) nil) (when gnus-article-mime-handles (mm-destroy-parts gnus-article-mime-handles) @@ -4222,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))))) @@ -4306,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) @@ -4669,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) @@ -4679,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) @@ -5781,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) @@ -5789,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")) @@ -5800,7 +5830,7 @@ man page." If the default site is too slow, try to find a CTAN mirror, see . 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/") @@ -5811,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"))) @@ -5832,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) @@ -5842,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) @@ -5854,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) @@ -5918,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")))) @@ -6103,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) @@ -6115,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) @@ -6127,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) @@ -6137,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) @@ -6146,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) @@ -6648,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)))