1 ;;; mime-play.el --- Playback processing module for mime-view.el
3 ;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc.
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Created: 1995/9/26 (separated from tm-view.el)
7 ;; Renamed: 1997/2/21 from tm-play.el
8 ;; Keywords: MIME, multimedia, mail, news
10 ;; This file is part of SEMI (Secretariat of Emacs MIME Interfaces).
12 ;; This program is free software; you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation; either version 2, or (at
15 ;; your option) any later version.
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25 ;; Boston, MA 02111-1307, USA.
33 (eval-when-compile (require 'mime-text))
39 (defvar mime-preview-after-decoded-position nil)
41 (defun mime-preview-play-current-entity (&optional mode)
43 It decodes current entity to call internal or external method. The
44 method is selected from variable `mime-acting-condition'.
45 If MODE is specified, play as it. Default MODE is \"play\"."
49 (let ((entity-info (get-text-property (point) 'mime-view-entity)))
51 (let ((the-buf (current-buffer))
52 (raw-buffer (get-text-property (point) 'mime-view-raw-buffer)))
53 (setq mime-preview-after-decoded-position (point))
54 (set-buffer raw-buffer)
55 (mime-raw-play-entity entity-info mode)
56 (when (eq (current-buffer) raw-buffer)
58 (goto-char mime-preview-after-decoded-position)
61 (defun mime-raw-play-entity (entity-info &optional mode)
62 "Play entity specified by ENTITY-INFO.
63 It decodes the entity to call internal or external method. The method
64 is selected from variable `mime-acting-condition'. If MODE is
65 specified, play as it. Default MODE is \"play\"."
66 (let ((beg (mime-entity-point-min entity-info))
67 (end (mime-entity-point-max entity-info))
68 (c-type (mime-entity-media-type entity-info))
69 (c-subtype (mime-entity-media-subtype entity-info))
70 (params (mime-entity-parameters entity-info))
71 (encoding (mime-entity-encoding entity-info))
77 (if (< beg (point-min))
78 (setq beg (point-min))
80 (if (< (point-max) end)
81 (setq end (point-max))
84 (setq cal (list* (cons 'type c-type)
85 (cons 'subtype c-subtype)
86 (cons 'encoding encoding)
87 (cons 'major-mode major-mode)
90 (setq cal (cons (cons 'mode mode) cal))
92 (setq ret (ctree-find-calist mime-acting-condition cal 'all))
94 (setq ret (select-menu-alist
100 (cdr (assq 'method situation)))
105 (setq method (cdr (assq 'method ret)))
106 (cond ((and (symbolp method)
108 (funcall method beg end ret)
110 ((and (listp method)(stringp (car method)))
111 (mime-activate-external-method beg end ret)
114 (mime-show-echo-buffer
115 "No method are specified for %s\n"
116 (mime-type/subtype-string c-type c-subtype))
122 ;;; @ external decoder
125 (defun mime-activate-external-method (beg end cal)
128 (narrow-to-region beg end)
130 (let ((method (cdr (assoc 'method cal)))
131 (name (mime-raw-get-filename cal))
134 (let ((file (make-temp-name
135 (expand-file-name "TM" mime-temp-directory)))
140 (if (re-search-forward "^$" nil t)
146 (write-region b end file)
147 (message "External method is starting...")
149 'name (replace-as-filename name) cal))
150 (setq cal (put-alist 'file file cal))
153 mime-echo-buffer-name (car method)
155 (mime-make-external-method-args
156 cal (cdr (cdr method)))
158 (apply (function start-process) args)
159 (mime-show-echo-buffer)
163 (defun mime-make-external-method-args (cal format)
168 (let* ((item (eval arg))
169 (ret (cdr (assoc item cal)))
173 (if (eq item 'encoding)
180 (defvar mime-echo-window-is-shared-with-bbdb t
181 "*If non-nil, mime-echo window is shared with BBDB window.")
183 (defvar mime-echo-window-height
186 (/ (window-height) 5)
188 "*Size of mime-echo window.
189 It allows function or integer. If it is function,
190 `mime-show-echo-buffer' calls it to get height of mime-echo window.
191 Otherwise `mime-show-echo-buffer' uses it as height of mime-echo
194 (defun mime-show-echo-buffer (&rest forms)
195 "Show mime-echo buffer to display MIME-playing information."
196 (get-buffer-create mime-echo-buffer-name)
197 (let ((the-win (selected-window))
198 (win (get-buffer-window mime-echo-buffer-name))
201 (if (and mime-echo-window-is-shared-with-bbdb
202 (boundp 'bbdb-buffer-name)
203 (setq win (get-buffer-window bbdb-buffer-name))
205 (set-window-buffer win mime-echo-buffer-name)
206 (select-window (get-buffer-window mime-preview-buffer))
207 (setq win (split-window-vertically
209 (if (functionp mime-echo-window-height)
210 (funcall mime-echo-window-height)
211 mime-echo-window-height)
213 (set-window-buffer win mime-echo-buffer-name)
216 (goto-char (point-max))
218 (insert (apply (function format) forms))
220 (select-window the-win)
227 (defvar mime-view-file-name-char-regexp "[A-Za-z0-9+_-]")
229 (defvar mime-view-file-name-regexp-1
230 (concat mime-view-file-name-char-regexp "+\\."
231 mime-view-file-name-char-regexp "+"))
233 (defvar mime-view-file-name-regexp-2
234 (concat (regexp-* mime-view-file-name-char-regexp)
235 "\\(\\." mime-view-file-name-char-regexp "+\\)*"))
237 (defun mime-raw-get-original-filename (param &optional encoding)
238 (or (mime-raw-get-uu-filename param encoding)
240 (or (if (or (and (setq ret (mime/Content-Disposition))
241 (setq ret (assoc "filename" (cdr ret)))
243 (setq ret (assoc "name" param))
244 (setq ret (assoc "x-name" param))
246 (std11-strip-quoted-string (cdr ret))
249 (std11-find-field-body '("Content-Description"
251 (if (or (string-match mime-view-file-name-regexp-1 ret)
252 (string-match mime-view-file-name-regexp-2 ret))
253 (substring ret (match-beginning 0)(match-end 0))
258 (defun mime-raw-get-filename (param)
259 (replace-as-filename (mime-raw-get-original-filename param))
263 ;;; @ file extraction
266 (defun mime-method-to-save (beg end cal)
270 (narrow-to-region beg end)
271 (mime-raw-get-filename cal)
273 (encoding (or (cdr (assq 'encoding cal)) "7bit"))
275 (if (and name (not (string-equal name "")))
276 (expand-file-name name
277 (save-window-excursion
281 (interactive "DDirectory: ")
283 (save-window-excursion
287 (interactive "FFilename: ")
288 (expand-file-name file)))))))
290 (if (file-exists-p filename)
291 (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
293 (re-search-forward "\n\n")
294 (mime-write-decoded-region (match-end 0) end filename encoding)
298 ;;; @ mail/news message
301 (defun mime-preview-quitting-method-for-mime-show-message-mode ()
302 "Quitting method for mime-view.
303 It is registered to variable `mime-preview-quitting-method-alist'."
304 (let ((mother mime-mother-buffer)
305 (win-conf mime-preview-original-window-configuration)
307 (kill-buffer mime-raw-buffer)
308 (mime-preview-kill-buffer)
309 (set-window-configuration win-conf)
310 (pop-to-buffer mother)
313 (defun mime-method-to-display-message/rfc822 (beg end cal)
314 (let* ((cnum (mime-raw-point-to-entity-number beg))
315 (new-name (format "%s-%s" (buffer-name) cnum))
316 (mother mime-preview-buffer)
318 (cdr (or (assq major-mode mime-text-decoder-alist)
319 (assq t mime-text-decoder-alist))))
321 (setq str (buffer-substring beg end))
322 (switch-to-buffer new-name)
325 (goto-char (point-min))
326 (if (re-search-forward "^\n" nil t)
327 (delete-region (point-min) (match-end 0))
329 (setq major-mode 'mime-show-message-mode)
330 (setq mime-text-decoder text-decoder)
331 (mime-view-mode mother)
335 ;;; @ message/partial
338 (defun mime-raw-write-region (start end filename)
339 "Write current region into specified file.
340 When called from a program, takes three arguments:
341 START, END and FILENAME. START and END are buffer positions.
342 It refer `mime-raw-buffer-coding-system-alist' to choose coding-system
344 (let ((coding-system-for-write
346 (or (assq major-mode mime-raw-buffer-coding-system-alist)
347 (assq t mime-raw-buffer-coding-system-alist)
349 (write-region start end filename)
352 (defun mime-method-to-store-message/partial (beg end cal)
356 (concat "m-prts-" (user-login-name)) mime-temp-directory))
357 (id (cdr (assoc "id" cal)))
358 (number (cdr (assoc "number" cal)))
359 (total (cdr (assoc "total" cal)))
361 (mother mime-preview-buffer)
363 (or (file-exists-p root-dir)
364 (make-directory root-dir)
366 (setq id (replace-as-filename id))
367 (setq root-dir (concat root-dir "/" id))
368 (or (file-exists-p root-dir)
369 (make-directory root-dir)
371 (setq file (concat root-dir "/FULL"))
372 (if (file-exists-p file)
373 (let ((full-buf (get-buffer-create "FULL"))
374 (pwin (or (get-buffer-window mother)
375 (get-largest-window)))
377 (save-window-excursion
378 (set-buffer full-buf)
380 (as-binary-input-file (insert-file-contents file))
381 (setq major-mode 'mime-show-message-mode)
382 (mime-view-mode mother)
384 (set-window-buffer pwin
386 (set-buffer full-buf)
387 mime-preview-buffer))
390 (re-search-forward "^$")
391 (goto-char (1+ (match-end 0)))
392 (setq file (concat root-dir "/" number))
393 (mime-raw-write-region (point) end file)
394 (let ((total-file (concat root-dir "/CT")))
398 (or (file-exists-p total-file)
401 (get-buffer-create mime-temp-buffer-name))
404 (write-region (point-min)(point-max) total-file)
405 (kill-buffer (current-buffer))
407 (string-to-number total)
409 (and (file-exists-p total-file)
411 (set-buffer (find-file-noselect total-file))
413 (and (re-search-forward "[0-9]+" nil t)
415 (buffer-substring (match-beginning 0)
418 (kill-buffer (current-buffer))
421 (if (and total (> total 0))
424 (set-buffer (get-buffer-create mime-temp-buffer-name))
425 (let ((full-buf (current-buffer)))
429 (setq file (concat root-dir "/" (int-to-string i)))
430 (or (file-exists-p file)
433 (as-binary-input-file (insert-file-contents file))
434 (goto-char (point-max))
437 (as-binary-output-file
438 (write-region (point-min)(point-max)
439 (expand-file-name "FULL" root-dir)))
442 (let ((file (format "%s/%d" root-dir i)))
443 (and (file-exists-p file)
448 (let ((file (expand-file-name "CT" root-dir)))
449 (and (file-exists-p file)
452 (save-window-excursion
453 (setq major-mode 'mime-show-message-mode)
454 (mime-view-mode mother)
456 (let ((pwin (or (get-buffer-window mother)
459 (pbuf (save-excursion
460 (set-buffer full-buf)
461 mime-preview-buffer)))
462 (set-window-buffer pwin pbuf)
468 ;;; @ message/external-body
471 (defvar mime-raw-dired-function
472 (if mime/use-multi-frame
473 (function dired-other-frame)
474 (function mime-raw-dired-function-for-one-frame)
477 (defun mime-raw-dired-function-for-one-frame (dir)
478 (let ((win (or (get-buffer-window mime-preview-buffer)
479 (get-largest-window))))
484 (defun mime-method-to-display-message/external-ftp (beg end cal)
485 (let* ((site (cdr (assoc "site" cal)))
486 (directory (cdr (assoc "directory" cal)))
487 (name (cdr (assoc "name" cal)))
488 ;;(mode (cdr (assoc "mode" cal)))
489 (pathname (concat "/anonymous@" site ":" directory))
491 (message (concat "Accessing " (expand-file-name name pathname) "..."))
492 (funcall mime-raw-dired-function pathname)
493 (goto-char (point-min))
494 (search-forward name)
501 (defun mime-method-to-display-caesar (start end cal)
502 "Internal method for mime-view to display ROT13-47-48 message."
503 (let* ((cnum (mime-raw-point-to-entity-number start))
504 (new-name (format "%s-%s" (buffer-name) cnum))
505 (the-buf (current-buffer))
506 (mother mime-preview-buffer)
507 (charset (cdr (assoc "charset" cal)))
508 (encoding (cdr (assq 'encoding cal)))
511 (let ((pwin (or (get-buffer-window mother)
512 (get-largest-window)))
513 (buf (get-buffer-create new-name))
515 (set-window-buffer pwin buf)
519 (setq buffer-read-only nil)
521 (insert-buffer-substring the-buf start end)
522 (goto-char (point-min))
523 (if (re-search-forward "^\n" nil t)
524 (delete-region (point-min) (match-end 0))
526 (let ((m (cdr (or (assq mode mime-text-decoder-alist)
527 (assq t mime-text-decoder-alist)))))
529 (funcall m charset encoding)
531 (mule-caesar-region (point-min) (point-max))
532 (set-buffer-modified-p nil)
534 (view-buffer new-name)
543 ;;; mime-play.el ends here