Re: gnus-mime-copy-part and jka-compr

[Kevin Ryde <user42@zip.com.au>]

[I posted this to ding@gnus the other day, but it didn't seem to make
it through to gmane.  Apologies to anyone getting a duplicate.]

Lars Magne Ingebrigtsen <larsi@gnus.org> writes:
>
> `c' just puts the bytes in a buffer and calls `normal-mode',
> which will make the right mode appear.  However, for strange modes
> like tar mode, that just doesn't seem to work -- it gets triggered
> even though the file is called .tar.gz, but doesn't seem to accept
> having gzipped contents.

jka-compr puts a dummy into auto-mode-alist to lose the .gz, assuming
that its uncompress will have already been done via
file-name-handler-alist.  Or I think that's what's going on.

> Well, for gzip you can just put the stuff in a buffer, do "gunzip -c"
> in a `shell-command-on-region' and use the output.

I should have followed up earlier.  I had a go myself and came up with
the stuff below.  It uses call-process-region based on info from
jka-compr's setups.

(The only change to gnus-mime-copy-part is the addition of the call to
gnus-mime-jka-compr-maybe-uncompress.  I've got this stuff in my
.gnus.el, hence copying the code to make that insertion.)

> So that can be
> done, but that's avoiding jka-compr altogether and kinda
> re-implementing the entire package on a buffer basis instead of a
> file basis.  Which we don't want to do.

I don't think jka-compr has anything for acting directly on a buffer
as such, it just seems oriented towards file reading and writing, as a
filename handler.


In any case, what I'm not at all sure about below is coding system
issues.

Does call-process-region do enough on its own, or does it want to be
helped by working the notional filename (from the mail message) into
its figurings?

I'm thinking of say .tar wanting raw 8-bit but .txt wanting the usual
emacs inferences.




;; 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)))))))

(require 'gnus-art)
(defun gnus-mime-copy-part (&optional handle)
  "Put the MIME part under point into a new buffer."
  (interactive)
  (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)
      ;; 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)
	    (normal-mode))
	(setq buffer-file-name nil))
      (goto-char (point-min)))))