From: yamaoka Date: Thu, 10 Feb 2005 10:48:25 +0000 (+0000) Subject: Synch to No Gnus 200502101047. X-Git-Tag: t-gnus-6_17_4-quimby-~567 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ba3652f54971c4703e80496ad869cbb900c8827f;p=elisp%2Fgnus.git- Synch to No Gnus 200502101047. --- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 436b46b..a78c223 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,24 @@ +2005-02-10 Katsumi Yamaoka + + * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): Remove; + merge in into mm-decompress-buffer. + (gnus-mime-copy-part): Use the MIME part charset, the value which + a user specified or gnus-newsgroup-charset for decoding, like + gnus-mime-inline-part does; set buffer-file-coding-system to tell + save-buffer what was used. Suggested by Kevin Ryde + . + (gnus-mime-inline-part): Allow the name parameter as well as the + filename parameter; force decompressing of compressed data; always + display contents being not decoded as unibyte. + + * mm-view.el (mm-display-inline-fontify): Allow the name parameter + as well as the filename parameter. + + * mm-util.el (mm-decompress-buffer): Merge + gnus-mime-jka-compr-maybe-uncompress. + (mm-find-buffer-file-coding-system): Doc fix; force decompressing + of compressed data. + 2005-02-08 Simon Josefsson * imap.el (imap-log): Doc fix. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 9741c62..0878c59 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -4597,60 +4597,58 @@ 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 (mm-with-unibyte-buffer + (mm-insert-part handle) + (or (mm-decompress-buffer filename) + (buffer-string)))) + charset coding-system) + (setq filename (if filename + (file-name-nondirectory filename) + "*decoded*")) + (cond + ((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))))) @@ -4681,7 +4679,8 @@ 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) (unless handle @@ -4695,19 +4694,21 @@ are decompressed." (mm-with-unibyte-buffer (mm-insert-part handle) (setq contents - (or (mm-decompress-buffer (mail-content-type-get - (mm-handle-disposition handle) - 'filename)) + (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) (unless (setq charset (mail-content-type-get (mm-handle-type handle) 'charset)) - (if (setq coding-system (mm-with-unibyte-buffer - (insert contents) - (mm-find-buffer-file-coding-system))) - (setq contents (mm-decode-coding-string contents - coding-system)) + (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) @@ -4718,16 +4719,17 @@ are decompressed." (mm-read-coding-system "Charset: ")))) (t (if (mm-handle-undisplayer handle) - (mm-remove-part handle)) - (setq contents (mm-string-to-multibyte contents)))) + (mm-remove-part handle)))) (forward-line 2) (mm-insert-inline handle - (if (and charset - (setq coding-system (mm-charset-to-coding-system charset)) - (not (eq charset 'ascii))) + (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) - contents)) + (mm-string-to-multibyte contents))) (goto-char b))))) (defun gnus-mime-view-part-as-charset (&optional handle arg) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index f604d1e..f5d4be0 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -954,44 +954,68 @@ To make this function work with XEmacs, the APEL package is required." (fboundp 'coding-system-to-mime-charset))) (coding-system-to-mime-charset coding-system))))) -(defun mm-decompress-buffer (filename &optional inplace) - "Decompress buffer's contents according to the extension of FILENAME. -If INPLACE is nil, return a decompressed string or nil, and the buffer -will not be modified. Otherwise, replace the buffer's contents with -the decompressed one. Decompression is done only when the extension -is \".gz\" or \".bz2\" which does not follow \".tar\"." - (let ((decomp (cond ((or (not filename) - (string-match "\\.tar\\.[^.]+\\'" filename)) - nil) - ((string-match "\\.gz\\'" filename) - '("gzip" "-c" "-d" "-q")) - ((string-match "\\.bz2\\'" filename) - '("bzip2" "-d"))))) - (when decomp - (let ((coding-system-for-read mm-binary-coding-system) - (coding-system-for-write mm-binary-coding-system) - cur mod) - (if inplace - (prog1 - nil - (setq cur (buffer-string) - mod (buffer-modified-p)) - (condition-case nil - (apply 'call-process-region (point-min) (point-max) - (car decomp) t t nil (cdr decomp)) - (error - (erase-buffer) - (insert cur) - (set-buffer-modified-p mod)))) - (setq cur (current-buffer)) - (mm-with-unibyte-buffer +(eval-when-compile + (require 'jka-compr)) + +(defun mm-decompress-buffer (filename &optional inplace force) + "Decompress buffer's contents, depending on jka-compr. +Only when FORCE is non-nil or `auto-compression-mode' is enabled and +FILENAME agrees with `jka-compr-compression-info-list', decompression +is done. If INPLACE is nil, return decompressed data or nil without +modifying the buffer. Otherwise, replace the buffer's contents with +the decompressed data. The buffer's multibyteness must be turned off." + (when (and filename + (if force + (prog1 t (require 'jka-compr)) + (and (fboundp 'jka-compr-installed-p) + (jka-compr-installed-p)))) + (let ((info (jka-compr-get-compression-info filename))) + (when info + (let ((prog (jka-compr-info-uncompress-program info)) + (args (jka-compr-info-uncompress-args info)) + (msg (format "%s %s..." + (jka-compr-info-uncompress-message info) + filename)) + (err-file (jka-compr-make-temp-name)) + (cur (current-buffer)) + (coding-system-for-read mm-binary-coding-system) + (coding-system-for-write mm-binary-coding-system) + retval err-msg) + (message "%s" msg) + (with-temp-buffer (insert-buffer-substring cur) - (condition-case nil + (condition-case err (progn - (apply 'call-process-region (point-min) (point-max) - (car decomp) t t nil (cdr decomp)) - (buffer-string)) - (error nil)))))))) + (unless (memq (apply 'call-process-region + (point-min) (point-max) + prog t (list t err-file) nil args) + jka-compr-acceptable-retval-list) + (erase-buffer) + (insert (mapconcat + 'identity + (delete "" (split-string + (prog2 + (insert-file-contents err-file) + (buffer-string) + (erase-buffer)))) + " ") + "\n") + (setq err-msg + (format "Error while executing \"%s %s < %s\"" + prog (mapconcat 'identity args " ") + filename))) + (setq retval (buffer-string))) + (error + (setq err-msg (error-message-string err))))) + (when (file-exists-p err-file) + (ignore-errors (jka-compr-delete-temp-file err-file))) + (when inplace + (unless err-msg + (delete-region (point-min) (point-max)) + (insert retval)) + (setq retval nil)) + (message "%s" (or err-msg (concat msg "done"))) + retval))))) (eval-when-compile (unless (fboundp 'coding-system-name) @@ -1005,11 +1029,12 @@ is \".gz\" or \".bz2\" which does not follow \".tar\"." "Find coding system used to decode the contents of the current buffer. This function looks for the coding system magic cookie or examines the coding system specified by `file-coding-system-alist' being associated -with FILENAME which defaults to `buffer-file-name'." +with FILENAME which defaults to `buffer-file-name'. Data compressed by +gzip, bzip2, etc. are allowed." (unless filename (setq filename buffer-file-name)) (save-excursion - (let ((decomp (mm-decompress-buffer filename))) + (let ((decomp (mm-decompress-buffer filename nil t))) (when decomp (set-buffer (let (default-enable-multibyte-characters) (generate-new-buffer " *temp*"))) diff --git a/lisp/mm-view.el b/lisp/mm-view.el index c76789b..f3e2f79 100644 --- a/lisp/mm-view.el +++ b/lisp/mm-view.el @@ -466,10 +466,10 @@ (unless (eq charset 'gnus-decoded) (mm-with-unibyte-buffer (mm-insert-part handle) - (mm-decompress-buffer (mail-content-type-get - (mm-handle-disposition handle) - 'filename) - t) + (mm-decompress-buffer + (or (mail-content-type-get (mm-handle-disposition handle) 'name) + (mail-content-type-get (mm-handle-disposition handle) 'filename)) + t t) (unless charset (setq coding-system (mm-find-buffer-file-coding-system))) (setq text (buffer-string)))) diff --git a/texi/ChangeLog b/texi/ChangeLog index d9a4d5b..37025a6 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,8 @@ +2005-02-10 Katsumi Yamaoka + + * gnus.texi (Using MIME): gnus-mime-copy-part supports the charset + stuff; gnus-mime-inline-part does the automatic decompression. + 2005-02-08 Teodor Zlatanov * gnus.texi (Spam ELisp Package Configuration Examples):