tm-file.el

   1 ;;;
   2 ;;; tm-file.el --- tm-view internal method for file extraction
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1995 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;; Version:
   9 ;;;     $Id: tm-file.el,v 2.0 1995/11/06 16:05:29 morioka Exp $
  10 ;;; Keywords: mail, news, MIME, multimedia
  11 ;;;
  12 ;;; This file is part of tm (Tools for MIME).
  13 ;;;
  14
  15 (require 'tm-view)
  16
  17 (defun mime-article/extract-file (beg end cal)
  18   (let* ((name (or (cdr (assoc "name" cal))
  19                    (cdr (assoc "x-name" cal))
  20                    (make-temp-name "tm")))
  21          (encoding (cdr (assq 'encoding cal)))
  22          (dir (call-interactively
  23                (function
  24                 (lambda (dir)
  25                   (interactive "Ddirictory: ")
  26                   dir))))
  27          (file-coding-system *noconv*)
  28          (filename (expand-file-name name dir))
  29          (the-buf (current-buffer))
  30          (tmp-buf (generate-new-buffer name))
  31          )
  32     (goto-char beg)
  33     (re-search-forward "\n\n")
  34     (append-to-buffer tmp-buf (match-end 0) end)
  35     (save-excursion
  36       (set-buffer tmp-buf)
  37       (mime/decode-region encoding (point-min)(point-max))
  38       (let ((file-coding-system *noconv*)
  39             jka-compr-compression-info-list
  40             jam-zcat-filename-list)
  41         (write-file filename)
  42         )
  43       (kill-buffer tmp-buf)
  44       )))
  45
  46
  47 ;;; @ setup
  48 ;;;
  49
  50 (set-atype 'mime/content-decoding-condition
  51            '((mode . "extract")
  52              (method . mime-article/extract-file)
  53              ))
  54
  55 (set-atype 'mime/content-decoding-condition
  56            '((type . "application/octet-stream")
  57              (method . mime-article/extract-file)
  58              ))
  59
  60
  61 ;;; @ end
  62 ;;;
  63
  64 (provide 'tm-file)