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 ;;; modified by KOBAYASHI Shuhei <shuhei-k@jaist.ac.jp>
   9 ;;; Version:
  10 ;;;     $Id: tm-file.el,v 7.5 1996/04/16 18:21:23 morioka Exp $
  11 ;;; Keywords: mail, news, MIME, multimedia
  12 ;;;
  13 ;;; This file is part of tm (Tools for MIME).
  14 ;;;
  15 ;;; This program is free software; you can redistribute it and/or
  16 ;;; modify it under the terms of the GNU General Public License as
  17 ;;; published by the Free Software Foundation; either version 2, or
  18 ;;; (at your option) any later version.
  19 ;;;
  20 ;;; This program is distributed in the hope that it will be useful,
  21 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23 ;;; General Public License for more details.
  24 ;;;
  25 ;;; You should have received a copy of the GNU General Public License
  26 ;;; along with This program.  If not, write to the Free Software
  27 ;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  28 ;;;
  29 ;;; Code:
  30
  31 (require 'tm-view)
  32
  33 (defun mime-article/extract-file (beg end cal)
  34   (goto-char beg)
  35   (let* ((name
  36           (save-restriction
  37             (narrow-to-region beg end)
  38             (mime-article/get-filename cal)
  39             ))
  40          (encoding (cdr (assq 'encoding cal)))
  41          (filename
  42           (if (and name (not (string-equal name "")))
  43               (expand-file-name name
  44                                 (call-interactively
  45                                  (function
  46                                   (lambda (dir)
  47                                     (interactive "DDirectory: ")
  48                                     dir))))
  49             (call-interactively
  50              (function
  51               (lambda (file)
  52                 (interactive "FFilename: ")
  53                 (expand-file-name file))))))
  54          (the-buf (current-buffer))
  55          (tmp-buf (generate-new-buffer (file-name-nondirectory filename)))
  56          )
  57     (if (file-exists-p filename)
  58         (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
  59             (error "")))
  60     (re-search-forward "\n\n")
  61     (append-to-buffer tmp-buf (match-end 0) end)
  62     (save-excursion
  63       (set-buffer tmp-buf)
  64       (mime/decode-region encoding (point-min)(point-max))
  65       (let ((mc-flag nil)                   ; for Mule
  66             (file-coding-system
  67              (if (featurep 'mule) *noconv*))
  68             kanji-flag                      ; for NEmacs
  69             (emx-binary-mode t)             ; for OS/2
  70             jka-compr-compression-info-list ; for jka-compr
  71             jam-zcat-filename-list          ; for jam-zcat
  72             require-final-newline)
  73         (write-file filename)
  74         )
  75       (kill-buffer tmp-buf)
  76       )))
  77
  78
  79 ;;; @ setup
  80 ;;;
  81
  82 (set-atype 'mime/content-decoding-condition
  83            '((mode . "extract")
  84              (method . mime-article/extract-file)
  85              ))
  86
  87 (set-atype 'mime/content-decoding-condition
  88            '((type . "application/octet-stream")
  89              (method . mime-article/extract-file)
  90              ))
  91
  92
  93 ;;; @ end
  94 ;;;
  95
  96 (provide 'tm-file)
  97
  98 ;;; end of tm-file.el