+2005-02-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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
+ <user42@zip.com.au>.
+ (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 <jas@extundo.com>
* imap.el (imap-log): Doc fix.
(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)))))
(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
(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)
(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)
(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)
"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*")))
(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))))
+2005-02-10 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * 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 <tzz@lifelogs.com>
* gnus.texi (Spam ELisp Package Configuration Examples):
projects / elisp / gnus.git- / commitdiff