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