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 3.0 1995/12/07 11:22:08 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          (encoding (cdr (assq 'encoding cal)))
  21          (file-coding-system *noconv*)
  22          (filename
  23           (if name
  24               (expand-file-name name
  25                                 (call-interactively
  26                                  (function
  27                                   (lambda (dir)
  28                                     (interactive "DDirectory: ")
  29                                     dir))))
  30             (call-interactively
  31              (function
  32               (lambda (file)
  33                 (interactive "FFilename: ")
  34                 (expand-file-name file))))))
  35          (the-buf (current-buffer))
  36          (tmp-buf (generate-new-buffer (file-name-nondirectory filename)))
  37          )
  38     (goto-char beg)
  39     (re-search-forward "\n\n")
  40     (append-to-buffer tmp-buf (match-end 0) end)
  41     (save-excursion
  42       (set-buffer tmp-buf)
  43       (mime/decode-region encoding (point-min)(point-max))
  44       (let ((file-coding-system *noconv*)
  45             jka-compr-compression-info-list
  46             jam-zcat-filename-list)
  47         (write-file filename)
  48         )
  49       (kill-buffer tmp-buf)
  50       )))
  51
  52
  53 ;;; @ setup
  54 ;;;
  55
  56 (set-atype 'mime/content-decoding-condition
  57            '((mode . "extract")
  58              (method . mime-article/extract-file)
  59              ))
  60
  61 (set-atype 'mime/content-decoding-condition
  62            '((type . "application/octet-stream")
  63              (method . mime-article/extract-file)
  64              ))
  65
  66
  67 ;;; @ end
  68 ;;;
  69
  70 (provide 'tm-file)