tm-play.el

   1 ;;;
   2 ;;; tm-play.el --- decoder for tm-view.el
   3 ;;;
   4 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
   5 ;;; Copyright (C) 1994,1995 MORIOKA Tomohiko
   6 ;;;
   7 ;;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   8 ;;; Version:
   9 ;;;     $Id: tm-play.el,v 1.2 1995/09/26 11:54:38 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
  18 ;;; @ content decoder
  19 ;;;
  20
  21 (defvar mime-preview/after-decoded-position nil)
  22
  23 (defun mime-preview/decode-content ()
  24   (interactive)
  25   (let ((pc (mime::point-preview-content (point))))
  26     (if pc
  27         (let ((the-buf (current-buffer)))
  28           (setq mime-preview/after-decoded-position (point))
  29           (set-buffer (mime::preview-content-info/buffer pc))
  30           (mime-article/decode-content
  31            (mime::preview-content-info/content-info pc))
  32           (if (eq (current-buffer)
  33                   (mime::preview-content-info/buffer pc))
  34               (progn
  35                 (set-buffer the-buf)
  36                 (goto-char mime-preview/after-decoded-position)
  37                 ))
  38           ))))
  39
  40
  41 (defun mime-article/decode-content (cinfo)
  42   (let ((beg (mime::content-info/point-min cinfo))
  43         (end (mime::content-info/point-max cinfo))
  44         (ctype (mime::content-info/type cinfo))
  45         (params (mime::content-info/parameters cinfo))
  46         (encoding (mime::content-info/encoding cinfo))
  47         )
  48     (if ctype
  49         (let (method cal ret)
  50           (setq cal (append (list (cons 'type ctype)
  51                                   (cons 'encoding encoding)
  52                                   (cons 'major-mode major-mode)
  53                                   )
  54                             params))
  55           (if mime-viewer/decoding-mode
  56               (setq cal (cons
  57                          (cons 'mode mime-viewer/decoding-mode)
  58                          cal))
  59             )
  60           (setq ret (mime/get-content-decoding-alist cal))
  61           (setq method (cdr (assoc 'method ret)))
  62           (cond ((and (symbolp method)
  63                       (fboundp method))
  64                  (funcall method beg end ret)
  65                  )
  66                 ((and (listp method)(stringp (car method)))
  67                  (mime-article/start-external-method-region beg end ret)
  68                  )
  69                 (t
  70                  (mime-article/show-output-buffer
  71                   "No method are specified for %s\n" ctype)
  72                  ))
  73           ))
  74     ))
  75
  76 (defun mime/get-content-decoding-alist (al)
  77   (get-unified-alist mime/content-decoding-condition al)
  78   )
  79
  80
  81 ;;; @ external decoder
  82 ;;;
  83
  84 (defun mime-article/start-external-method-region (beg end cal)
  85   (save-excursion
  86     (save-restriction
  87       (narrow-to-region beg end)
  88       (goto-char beg)
  89       (let ((method (cdr (assoc 'method cal)))
  90             (name (mime-article/get-name cal))
  91             )
  92         (if method
  93             (let ((file (make-temp-name
  94                          (expand-file-name "TM" mime/tmp-dir)))
  95                   b args)
  96               (if (nth 1 method)
  97                   (setq b beg)
  98                 (setq b
  99                       (if (re-search-forward "^$" nil t)
 100                           (1+ (match-end 0))
 101                         (point-min)
 102                         ))
 103                 )
 104               (goto-char b)
 105               (write-region b end file)
 106               (setq cal (put-alist
 107                          'name (replace-as-filename name) cal))
 108               (setq cal (put-alist 'file file cal))
 109               (setq args (nconc
 110                           (list (car method)
 111                                 mime/output-buffer-name (car method)
 112                                 )
 113                           (mime-article/make-method-args cal
 114                                                          (cdr (cdr method)))
 115                           ))
 116               (apply (function start-process) args)
 117               (mime-article/show-output-buffer)
 118               ))
 119         ))))
 120
 121 (defun mime-article/make-method-args (cal format)
 122   (mapcar (function
 123            (lambda (arg)
 124              (if (stringp arg)
 125                  arg
 126                (let ((ret (cdr (assoc (eval arg) cal))))
 127                  (if ret
 128                      ret
 129                    "")
 130                  ))
 131              ))
 132           format))
 133
 134 (defun mime-article/show-output-buffer (&rest forms)
 135   (let ((the-win (selected-window))
 136         (win (get-buffer-window mime/output-buffer-name))
 137         )
 138     (if (null win)
 139         (progn
 140           (setq win (split-window-vertically (/ (* (window-height) 3) 4)))
 141           (set-window-buffer win mime/output-buffer-name)
 142           ))
 143     (select-window win)
 144     (goto-char (point-max))
 145     (if forms
 146         (insert (apply (function format) forms))
 147       )
 148     (select-window the-win)
 149     ))
 150
 151
 152 ;;; @ file name
 153 ;;;
 154
 155 (defvar mime-viewer/file-name-char-regexp "[A-Za-z0-9+_-]")
 156
 157 (defvar mime-viewer/file-name-regexp-1
 158   (concat mime-viewer/file-name-char-regexp "+\\."
 159           mime-viewer/file-name-char-regexp "+"))
 160
 161 (defvar mime-viewer/file-name-regexp-2
 162   (concat (regexp-* mime-viewer/file-name-char-regexp)
 163           "\\(\\." mime-viewer/file-name-char-regexp "+\\)*"))
 164
 165 (defun mime-article/get-name (param)
 166   (let ((str (mime-viewer/get-subject param)))
 167     (if (string-match " " str)
 168         (if (or (string-match mime-viewer/file-name-regexp-1 str)
 169                 (string-match mime-viewer/file-name-regexp-2 str))
 170             (substring str (match-beginning 0)(match-end 0))
 171           )
 172       (replace-as-filename str)
 173       )))
 174
 175
 176 ;;; @ message/partial
 177 ;;;
 178
 179 (defun mime/decode-message/partial-region (beg end cal)
 180   (goto-char beg)
 181   (let* ((root-dir (expand-file-name
 182                     (concat "m-prts-" (user-login-name)) mime/tmp-dir))
 183          (id (cdr (assoc "id" cal)))
 184          (number (cdr (assoc "number" cal)))
 185          (total (cdr (assoc "total" cal)))
 186          (the-buf (current-buffer))
 187          file
 188          (mother mime::article/preview-buffer))
 189     (if (not (file-exists-p root-dir))
 190         (make-directory root-dir)
 191       )
 192     (setq id (replace-as-filename id))
 193     (setq root-dir (concat root-dir "/" id))
 194     (if (not (file-exists-p root-dir))
 195         (make-directory root-dir)
 196       )
 197     (setq file (concat root-dir "/FULL"))
 198     (if (not (file-exists-p file))
 199         (progn
 200           (re-search-forward "^$")
 201           (goto-char (1+ (match-end 0)))
 202           (setq file (concat root-dir "/" number))
 203           (write-region (point) (point-max) file)
 204           (if (get-buffer "*MIME-temp*")
 205               (kill-buffer "*MIME-temp*")
 206             )
 207           (switch-to-buffer "*MIME-temp*")
 208           (let ((i 1)
 209                 (max (string-to-int total))
 210                 )
 211             (catch 'tag
 212               (while (<= i max)
 213                 (setq file (concat root-dir "/" (int-to-string i)))
 214                 (if (not (file-exists-p file))
 215                     (progn
 216                       (switch-to-buffer the-buf)
 217                       (throw 'tag nil)
 218                       ))
 219                 (insert-file-contents file)
 220                 (goto-char (point-max))
 221                 (setq i (1+ i))
 222                 )
 223               (delete-other-windows)
 224               (write-file (concat root-dir "/FULL"))
 225               (setq major-mode 'mime/show-message-mode)
 226               (mime/viewer-mode mother)
 227               (pop-to-buffer (current-buffer))
 228               ))
 229           )
 230       (progn
 231         (delete-other-windows)
 232         (find-file file)
 233         (setq major-mode 'mime/show-message-mode)
 234         (mime/viewer-mode mother)
 235         (pop-to-buffer (current-buffer))
 236         ))
 237     ))
 238
 239
 240 ;;; @ end
 241 ;;;
 242
 243 (provide 'tm-play)