X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=95d93e1ba9e6229b757d34ee71fd6a6aa590b955;hb=a97c4852272453a666f1d62a8b393a72ea7df4b2;hp=fcd61209395eca2cab26797dc9fe94062159fe09;hpb=5cad897e59653a2f249a4f499e50fde614ca2d98;p=elisp%2Fsemi.git diff --git a/mime-play.el b/mime-play.el index fcd6120..95d93e1 100644 --- a/mime-play.el +++ b/mime-play.el @@ -1,14 +1,13 @@ -;;; mime-play.el --- decoder for mime-view.el +;;; mime-play.el --- Playback processing module for mime-view.el -;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. +;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Created: 1995/9/26 (separated from tm-view.el) ;; Renamed: 1997/2/21 from tm-play.el -;; Version: $Id: mime-play.el,v 0.8 1997-02-28 02:33:20 tmorioka Exp $ ;; Keywords: MIME, multimedia, mail, news -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). +;; This file is part of SEMI (Secretariat of Emacs MIME Interfaces). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -29,37 +28,109 @@ (require 'mime-view) (require 'alist) +(require 'filename) + +(eval-when-compile (require 'mime-text)) + + +(defvar mime-acting-situation-examples nil) + +(defun mime-save-acting-situation-examples () + (let* ((file mime-acting-situation-examples-file) + (buffer (get-buffer-create " *mime-example*"))) + (unwind-protect + (save-excursion + (set-buffer buffer) + (setq buffer-file-name file) + (erase-buffer) + (insert ";;; " (file-name-nondirectory file) "\n") + (insert "\n;; This file is generated automatically by " + mime-view-version-string "\n\n") + (insert ";;; Code:\n\n") + (pp `(setq mime-acting-situation-examples + ',mime-acting-situation-examples) + (current-buffer)) + (insert "\n;;; " + (file-name-nondirectory file) + " ends here.\n") + (save-buffer)) + (kill-buffer buffer)))) + +(add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples) ;;; @ content decoder ;;; -(defvar mime-preview/after-decoded-position nil) +(defvar mime-preview-after-decoded-position nil) -(defun mime-preview/decode-content () +(defun mime-preview-play-current-entity (&optional mode) + "Play current entity. +It decodes current entity to call internal or external method. The +method is selected from variable `mime-acting-condition'. +If MODE is specified, play as it. Default MODE is \"play\"." (interactive) - (let ((pc (mime-preview/point-pcinfo (point)))) - (if pc - (let ((the-buf (current-buffer))) - (setq mime-preview/after-decoded-position (point)) - (set-buffer (mime::preview-content-info/buffer pc)) - (mime-article/decode-content - (mime::preview-content-info/content-info pc)) - (if (eq (current-buffer) - (mime::preview-content-info/buffer pc)) - (progn - (set-buffer the-buf) - (goto-char mime-preview/after-decoded-position) - )) - )))) - -(defun mime-article/decode-content (cinfo) - (let ((beg (mime::content-info/point-min cinfo)) - (end (mime::content-info/point-max cinfo)) - (ctype (or (mime::content-info/type cinfo) "text/plain")) - (params (mime::content-info/parameters cinfo)) - (encoding (mime::content-info/encoding cinfo)) + (or mode + (setq mode "play")) + (let ((entity-info (get-text-property (point) 'mime-view-entity))) + (if entity-info + (let ((the-buf (current-buffer)) + (raw-buffer (get-text-property (point) 'mime-view-raw-buffer))) + (setq mime-preview-after-decoded-position (point)) + (set-buffer raw-buffer) + (mime-raw-play-entity entity-info mode) + (when (eq (current-buffer) raw-buffer) + (set-buffer the-buf) + (goto-char mime-preview-after-decoded-position) + ))))) + +(defun mime-sort-situation (situation) + (sort situation + #'(lambda (a b) + (let ((a-t (car a)) + (b-t (car b)) + (order '((type . 1) + (subtype . 2) + (mode . 3) + (major-mode . 4))) + a-order b-order) + (if (symbolp a-t) + (let ((ret (assq a-t order))) + (if ret + (setq a-order (cdr ret)) + (setq a-order 5) + )) + (setq a-order 6) + ) + (if (symbolp b-t) + (let ((ret (assq b-t order))) + (if ret + (setq b-order (cdr ret)) + (setq b-order 5) + )) + (setq b-order 6) + ) + (if (= a-order b-order) + (string< (format "%s" a-t)(format "%s" b-t)) + (< a-order b-order)) + ))) + ) + +(defun mime-raw-play-entity (entity-info &optional mode) + "Play entity specified by ENTITY-INFO. +It decodes the entity to call internal or external method. The method +is selected from variable `mime-acting-condition'. If MODE is +specified, play as it. Default MODE is \"play\"." + (let ((beg (mime-entity-point-min entity-info)) + (end (mime-entity-point-max entity-info)) + (c-type (mime-entity-media-type entity-info)) + (c-subtype (mime-entity-media-subtype entity-info)) + (params (mime-entity-parameters entity-info)) + (encoding (mime-entity-encoding entity-info)) ) + (or c-type + (setq c-type 'text + c-subtype 'plain)) ;; Check for VM (if (< beg (point-min)) (setq beg (point-min)) @@ -68,228 +139,98 @@ (setq end (point-max)) ) (let (method cal ret) - (setq cal (list* (cons 'type ctype) + (setq cal (list* (cons 'type c-type) + (cons 'subtype c-subtype) (cons 'encoding encoding) (cons 'major-mode major-mode) params)) - (if mime-view-decoding-mode - (setq cal (cons - (cons 'mode mime-view-decoding-mode) - cal)) + (if mode + (setq cal (cons (cons 'mode mode) cal)) ) - (setq ret (mime/get-content-decoding-alist cal)) + (setq ret + (or (ctree-match-calist mime-acting-situation-examples cal) + (ctree-match-calist-partially mime-acting-situation-examples + cal) + cal)) + (setq ret + (or (ctree-find-calist mime-acting-condition ret + mime-view-find-every-acting-situation) + (ctree-find-calist mime-acting-condition cal + mime-view-find-every-acting-situation) + )) + (cond ((cdr ret) + (setq ret (select-menu-alist + "Methods" + (mapcar (function + (lambda (situation) + (cons + (format "%s" + (cdr (assq 'method situation))) + situation))) + ret))) + (setq ret (mime-sort-situation ret)) + (ctree-set-calist-strictly 'mime-acting-situation-examples ret) + ) + (t + (setq ret (car ret)) + )) (setq method (cdr (assq 'method ret))) (cond ((and (symbolp method) (fboundp method)) (funcall method beg end ret) ) + ((stringp method) + (mime-activate-mailcap-method beg end ret) + ) ((and (listp method)(stringp (car method))) - (mime-article/start-external-method-region beg end ret) + (mime-activate-external-method beg end ret) ) (t - (mime-article/show-output-buffer - "No method are specified for %s\n" ctype) + (mime-show-echo-buffer + "No method are specified for %s\n" + (mime-type/subtype-string c-type c-subtype)) )) ) )) -;;; @ method selector -;;; - -;;; @@ field -;;; - -(defun put-fields (tp c) - (catch 'tag - (let ((r tp) f ret) - (while r - (setq f (car r)) - (if (not (if (setq ret (assoc (car f) c)) - (equal (cdr ret)(cdr f)) - (setq c (cons f c)) - )) - (throw 'tag 'error)) - (setq r (cdr r)) - )) - c)) - - -;;; @@ field unifier -;;; - -(defun field-unifier-for-default (a b) - (let ((ret - (cond ((equal a b) a) - ((null (cdr b)) a) - ((null (cdr a)) b) - ))) - (if ret - (list nil ret nil) - ))) - -(defun field-unifier-for-mode (a b) - (let ((va (cdr a))) - (if (if (consp va) - (member (cdr b) va) - (equal va (cdr b)) - ) - (list nil b nil) - ))) - -(defun field-unify (a b) - (let ((sym (intern (concat "field-unifier-for-" (symbol-value (car a)))))) - (or (fboundp sym) - (setq sym (function field-unifier-for-default)) - ) - (funcall sym a b) - )) - - -;;; @@ type unifier +;;; @ external decoder ;;; -(defun assoc-unify (class instance) - (catch 'tag - (let ((cla (copy-alist class)) - (ins (copy-alist instance)) - (r class) - cell aret ret prev rest) - (while r - (setq cell (car r)) - (setq aret (assoc (car cell) ins)) - (if aret - (if (setq ret (field-unify cell aret)) - (progn - (if (car ret) - (setq prev (put-alist (car (car ret)) - (cdr (car ret)) - prev)) - ) - (if (nth 2 ret) - (setq rest (put-alist (car (nth 2 ret)) - (cdr (nth 2 ret)) - rest)) - ) - (setq cla (put-alist (car cell)(cdr (nth 1 ret)) cla)) - (setq ins (del-alist (car cell) ins)) - ) - (throw 'tag nil) - )) - (setq r (cdr r)) - ) - (setq r (copy-alist ins)) - (while r - (setq cell (car r)) - (setq aret (assoc (car cell) cla)) - (if aret - (if (setq ret (field-unify cell aret)) - (progn - (if (car ret) - (setq prev (put-alist (car (car ret)) - (cdr (car ret)) - prev)) - ) - (if (nth 2 ret) - (setq rest (put-alist (car (nth 2 ret)) - (cdr (nth 2 ret)) - rest)) - ) - (setq cla (del-alist (car cell) cla)) - (setq ins (put-alist (car cell)(cdr (nth 1 ret)) ins)) - ) - (throw 'tag nil) - )) - (setq r (cdr r)) - ) - (list prev (append cla ins) rest) - ))) - -(defun get-unified-alist (db al) - (let ((r db) ret) - (catch 'tag - (while r - (if (setq ret (nth 1 (assoc-unify (car r) al))) - (throw 'tag ret) +(defun mime-activate-mailcap-method (start end situation) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (let ((method (cdr (assoc 'method situation))) + (name (mime-raw-get-filename situation))) + (mime-write-decoded-region (if (re-search-forward "^$" end t) + (1+ (match-end 0)) + (point-min)) + end name + (cdr (assq 'encoding situation))) + (message "External method is starting...") + (let ((command + (mailcap-format-command + method + (cons (cons 'filename name) situation)))) + (start-process command mime-echo-buffer-name + shell-file-name shell-command-switch command) ) - (setq r (cdr r)) + (mime-show-echo-buffer) )))) -(defun delete-atype (atl al) - (let* ((r atl) ret oal) - (setq oal - (catch 'tag - (while r - (if (setq ret (nth 1 (assoc-unify (car r) al))) - (throw 'tag (car r)) - ) - (setq r (cdr r)) - ))) - (delete oal atl) - )) - -(defun remove-atype (sym al) - (and (boundp sym) - (set sym (delete-atype (eval sym) al)) - )) - -(defun replace-atype (atl old-al new-al) - (let* ((r atl) ret oal) - (if (catch 'tag - (while r - (if (setq ret (nth 1 (assoc-unify (car r) old-al))) - (throw 'tag (rplaca r new-al)) - ) - (setq r (cdr r)) - )) - atl))) - -(defun set-atype (sym al &rest options) - (if (null (boundp sym)) - (set sym al) - (let* ((replacement (memq 'replacement options)) - (ignore-fields (car (cdr (memq 'ignore options)))) - (remove (or (car (cdr (memq 'remove options))) - (let ((ral (copy-alist al))) - (mapcar (function - (lambda (type) - (setq ral (del-alist type ral)) - )) - ignore-fields) - ral))) - ) - (set sym - (or (if replacement - (replace-atype (eval sym) remove al) - ) - (cons al - (delete-atype (eval sym) remove) - ) - ))))) - - -;;; @@ main selector -;;; - -(defun mime/get-content-decoding-alist (al) - (get-unified-alist mime/content-decoding-condition al) - ) - - -;;; @ external decoder -;;; - -(defun mime-article/start-external-method-region (beg end cal) +(defun mime-activate-external-method (beg end cal) (save-excursion (save-restriction (narrow-to-region beg end) (goto-char beg) (let ((method (cdr (assoc 'method cal))) - (name (mime-article/get-filename cal)) + (name (mime-raw-get-filename cal)) ) (if method (let ((file (make-temp-name - (expand-file-name "TM" mime/tmp-dir))) + (expand-file-name "TM" mime-temp-directory))) b args) (if (nth 1 method) (setq b beg) @@ -307,17 +248,17 @@ (setq cal (put-alist 'file file cal)) (setq args (nconc (list (car method) - mime/output-buffer-name (car method) + mime-echo-buffer-name (car method) ) - (mime-article/make-method-args cal - (cdr (cdr method))) + (mime-make-external-method-args + cal (cdr (cdr method))) )) (apply (function start-process) args) - (mime-article/show-output-buffer) + (mime-show-echo-buffer) )) )))) -(defun mime-article/make-method-args (cal format) +(defun mime-make-external-method-args (cal format) (mapcar (function (lambda (arg) (if (stringp arg) @@ -334,20 +275,40 @@ )) format)) -(defun mime-article/show-output-buffer (&rest forms) - (get-buffer-create mime/output-buffer-name) +(defvar mime-echo-window-is-shared-with-bbdb t + "*If non-nil, mime-echo window is shared with BBDB window.") + +(defvar mime-echo-window-height + (function + (lambda () + (/ (window-height) 5) + )) + "*Size of mime-echo window. +It allows function or integer. If it is function, +`mime-show-echo-buffer' calls it to get height of mime-echo window. +Otherwise `mime-show-echo-buffer' uses it as height of mime-echo +window.") + +(defun mime-show-echo-buffer (&rest forms) + "Show mime-echo buffer to display MIME-playing information." + (get-buffer-create mime-echo-buffer-name) (let ((the-win (selected-window)) - (win (get-buffer-window mime/output-buffer-name)) + (win (get-buffer-window mime-echo-buffer-name)) ) (or win - (if (and mime/output-buffer-window-is-shared-with-bbdb + (if (and mime-echo-window-is-shared-with-bbdb (boundp 'bbdb-buffer-name) (setq win (get-buffer-window bbdb-buffer-name)) ) - (set-window-buffer win mime/output-buffer-name) - (select-window (get-buffer-window mime::article/preview-buffer)) - (setq win (split-window-vertically (/ (* (window-height) 3) 4))) - (set-window-buffer win mime/output-buffer-name) + (set-window-buffer win mime-echo-buffer-name) + (select-window (get-buffer-window mime-preview-buffer)) + (setq win (split-window-vertically + (- (window-height) + (if (functionp mime-echo-window-height) + (funcall mime-echo-window-height) + mime-echo-window-height) + ))) + (set-window-buffer win mime-echo-buffer-name) )) (select-window win) (goto-char (point-max)) @@ -371,8 +332,8 @@ (concat (regexp-* mime-view-file-name-char-regexp) "\\(\\." mime-view-file-name-char-regexp "+\\)*")) -(defun mime-article/get-original-filename (param &optional encoding) - (or (mime-article/get-uu-filename param encoding) +(defun mime-raw-get-original-filename (param &optional encoding) + (or (mime-raw-get-uu-filename param encoding) (let (ret) (or (if (or (and (setq ret (mime/Content-Disposition)) (setq ret (assoc "filename" (cdr ret))) @@ -392,35 +353,68 @@ )) )) -(defun mime-article/get-filename (param) - (replace-as-filename (mime-article/get-original-filename param)) +(defun mime-raw-get-filename (param) + (replace-as-filename (mime-raw-get-original-filename param)) ) +;;; @ file extraction +;;; + +(defun mime-method-to-save (beg end cal) + (goto-char beg) + (let* ((name + (save-restriction + (narrow-to-region beg end) + (mime-raw-get-filename cal) + )) + (encoding (or (cdr (assq 'encoding cal)) "7bit")) + (filename + (if (and name (not (string-equal name ""))) + (expand-file-name name + (save-window-excursion + (call-interactively + (function + (lambda (dir) + (interactive "DDirectory: ") + dir))))) + (save-window-excursion + (call-interactively + (function + (lambda (file) + (interactive "FFilename: ") + (expand-file-name file))))))) + ) + (if (file-exists-p filename) + (or (yes-or-no-p (format "File %s exists. Save anyway? " filename)) + (error ""))) + (re-search-forward "\n\n") + (mime-write-decoded-region (match-end 0) end filename encoding) + )) + + ;;; @ mail/news message ;;; -(defun mime-view-quitting-method-for-mime/show-message-mode () - (let ((mother mime::preview/mother-buffer) - (win-conf mime::preview/original-window-configuration) +(defun mime-preview-quitting-method-for-mime-show-message-mode () + "Quitting method for mime-view. +It is registered to variable `mime-preview-quitting-method-alist'." + (let ((mother mime-mother-buffer) + (win-conf mime-preview-original-window-configuration) ) - (kill-buffer - (mime::preview-content-info/buffer (car mime::preview/content-list))) - (mime-view-kill-buffer) + (kill-buffer mime-raw-buffer) + (mime-preview-kill-buffer) (set-window-configuration win-conf) (pop-to-buffer mother) - ;;(goto-char (point-min)) - ;;(mime-view-up-content) )) -(defun mime-article/view-message/rfc822 (beg end cal) - (let* ((cnum (mime-article/point-content-number beg)) - (cur-buf (current-buffer)) +(defun mime-method-to-display-message/rfc822 (beg end cal) + (let* ((cnum (mime-raw-point-to-entity-number beg)) (new-name (format "%s-%s" (buffer-name) cnum)) - (mother mime::article/preview-buffer) - (code-converter - (or (cdr (assq major-mode mime-text-decoder-alist)) - 'mime-view-default-code-convert-region)) + (mother mime-preview-buffer) + (text-decoder + (cdr (or (assq major-mode mime-text-decoder-alist) + (assq t mime-text-decoder-alist)))) str) (setq str (buffer-substring beg end)) (switch-to-buffer new-name) @@ -430,8 +424,8 @@ (if (re-search-forward "^\n" nil t) (delete-region (point-min) (match-end 0)) ) - (setq major-mode 'mime/show-message-mode) - (setq mime::article/code-converter code-converter) + (setq major-mode 'mime-show-message-mode) + (setq mime-text-decoder text-decoder) (mime-view-mode mother) )) @@ -439,55 +433,30 @@ ;;; @ message/partial ;;; -(defvar mime-article/coding-system-alist - (list '(mh-show-mode . no-conversion) - (cons t (mime-charset-to-coding-system default-mime-charset)) - )) - -(cond (running-mule-merged-emacs - (defun mime-article::write-region (start end file) - (let ((coding-system-for-write - (cdr - (or (assq major-mode mime-article/coding-system-alist) - (assq t mime-article/coding-system-alist) - )))) - (write-region start end file) - )) - ) - ((or (boundp 'MULE) - running-xemacs-with-mule) - (defun mime-article::write-region (start end file) - (let ((file-coding-system - (cdr - (or (assq major-mode mime-article/coding-system-alist) - (assq t mime-article/coding-system-alist) - )))) - (write-region start end file) - )) - ) - ((boundp 'NEMACS) - (defun mime-article::write-region (start end file) - (let ((kanji-fileio-code - (cdr - (or (assq major-mode mime-article/kanji-code-alist) - (assq t mime-article/kanji-code-alist) - )))) - (write-region start end file) - )) - ) - (t - (defalias 'mime-article::write-region 'write-region) - )) +(defun mime-raw-write-region (start end filename) + "Write current region into specified file. +When called from a program, takes three arguments: +START, END and FILENAME. START and END are buffer positions. +It refer `mime-raw-buffer-coding-system-alist' to choose coding-system +to write." + (let ((coding-system-for-write + (cdr + (or (assq major-mode mime-raw-buffer-coding-system-alist) + (assq t mime-raw-buffer-coding-system-alist) + )))) + (write-region start end filename) + )) -(defun mime-article/decode-message/partial (beg end cal) +(defun mime-method-to-store-message/partial (beg end cal) (goto-char beg) - (let* ((root-dir (expand-file-name - (concat "m-prts-" (user-login-name)) mime/tmp-dir)) + (let* ((root-dir + (expand-file-name + (concat "m-prts-" (user-login-name)) mime-temp-directory)) (id (cdr (assoc "id" cal))) (number (cdr (assoc "number" cal))) (total (cdr (assoc "total" cal))) file - (mother mime::article/preview-buffer) + (mother mime-preview-buffer) ) (or (file-exists-p root-dir) (make-directory root-dir) @@ -507,19 +476,19 @@ (set-buffer full-buf) (erase-buffer) (as-binary-input-file (insert-file-contents file)) - (setq major-mode 'mime/show-message-mode) + (setq major-mode 'mime-show-message-mode) (mime-view-mode mother) ) (set-window-buffer pwin (save-excursion (set-buffer full-buf) - mime::article/preview-buffer)) + mime-preview-buffer)) (select-window pwin) ) (re-search-forward "^$") (goto-char (1+ (match-end 0))) (setq file (concat root-dir "/" number)) - (mime-article::write-region (point) (point-max) file) + (mime-raw-write-region (point) end file) (let ((total-file (concat root-dir "/CT"))) (setq total (if total @@ -527,10 +496,10 @@ (or (file-exists-p total-file) (save-excursion (set-buffer - (get-buffer-create mime/temp-buffer-name)) + (get-buffer-create mime-temp-buffer-name)) (erase-buffer) (insert total) - (write-file total-file) + (write-region (point-min)(point-max) total-file) (kill-buffer (current-buffer)) )) (string-to-number total) @@ -550,7 +519,7 @@ (if (and total (> total 0)) (catch 'tag (save-excursion - (set-buffer (get-buffer-create mime/temp-buffer-name)) + (set-buffer (get-buffer-create mime-temp-buffer-name)) (let ((full-buf (current-buffer))) (erase-buffer) (let ((i 1)) @@ -563,7 +532,9 @@ (goto-char (point-max)) (setq i (1+ i)) )) - (as-binary-output-file (write-file (concat root-dir "/FULL"))) + (as-binary-output-file + (write-region (point-min)(point-max) + (expand-file-name "FULL" root-dir))) (let ((i 1)) (while (<= i total) (let ((file (format "%s/%d" root-dir i))) @@ -577,7 +548,7 @@ (delete-file file) )) (save-window-excursion - (setq major-mode 'mime/show-message-mode) + (setq major-mode 'mime-show-message-mode) (mime-view-mode mother) ) (let ((pwin (or (get-buffer-window mother) @@ -585,45 +556,56 @@ )) (pbuf (save-excursion (set-buffer full-buf) - mime::article/preview-buffer))) + mime-preview-buffer))) (set-window-buffer pwin pbuf) (select-window pwin) ))))) ))) -;;; @ rot13-47 +;;; @ message/external-body ;;; -(require 'view) +(defvar mime-raw-dired-function + (if mime/use-multi-frame + (function dired-other-frame) + (function mime-raw-dired-function-for-one-frame) + )) -(defconst mime-view-text/plain-mode-map (copy-keymap view-mode-map)) -(define-key mime-view-text/plain-mode-map - "q" (function mime-view-text/plain-exit)) +(defun mime-raw-dired-function-for-one-frame (dir) + (let ((win (or (get-buffer-window mime-preview-buffer) + (get-largest-window)))) + (select-window win) + (dired dir) + )) -(defun mime-view-text/plain-mode () - "\\{mime-view-text/plain-mode-map}" - (setq buffer-read-only t) - (setq major-mode 'mime-view-text/plain-mode) - (setq mode-name "MIME-View text/plain") - (use-local-map mime-view-text/plain-mode-map) - ) +(defun mime-method-to-display-message/external-ftp (beg end cal) + (let* ((site (cdr (assoc "site" cal))) + (directory (cdr (assoc "directory" cal))) + (name (cdr (assoc "name" cal))) + ;;(mode (cdr (assoc "mode" cal))) + (pathname (concat "/anonymous@" site ":" directory)) + ) + (message (concat "Accessing " (expand-file-name name pathname) "...")) + (funcall mime-raw-dired-function pathname) + (goto-char (point-min)) + (search-forward name) + )) -(defun mime-view-text/plain-exit () - (interactive) - (kill-buffer (current-buffer)) - ) -(defun mime-article/decode-caesar (beg end cal) - (let* ((cnum (mime-article/point-content-number beg)) - (cur-buf (current-buffer)) +;;; @ rot13-47 +;;; + +(defun mime-method-to-display-caesar (start end cal) + "Internal method for mime-view to display ROT13-47-48 message." + (let* ((cnum (mime-raw-point-to-entity-number start)) (new-name (format "%s-%s" (buffer-name) cnum)) - (mother mime::article/preview-buffer) + (the-buf (current-buffer)) + (mother mime-preview-buffer) (charset (cdr (assoc "charset" cal))) (encoding (cdr (assq 'encoding cal))) (mode major-mode) - str) - (setq str (buffer-substring beg end)) + ) (let ((pwin (or (get-buffer-window mother) (get-largest-window))) (buf (get-buffer-create new-name)) @@ -634,7 +616,7 @@ ) (setq buffer-read-only nil) (erase-buffer) - (insert str) + (insert-buffer-substring the-buf start end) (goto-char (point-min)) (if (re-search-forward "^\n" nil t) (delete-region (point-min) (match-end 0)) @@ -644,13 +626,10 @@ (and (functionp m) (funcall m charset encoding) )) - (save-excursion - (set-mark (point-min)) - (goto-char (point-max)) - (tm:caesar-region) - ) + (mule-caesar-region (point-min) (point-max)) (set-buffer-modified-p nil) - (mime-view-text/plain-mode) + (set-buffer mother) + (view-buffer new-name) )) @@ -659,4 +638,19 @@ (provide 'mime-play) +(let* ((file mime-acting-situation-examples-file) + (buffer (get-buffer-create " *mime-example*"))) + (if (file-readable-p file) + (unwind-protect + (save-excursion + (set-buffer buffer) + (erase-buffer) + (insert-file-contents file) + (eval-current-buffer) + ;; format check + (or (eq (car mime-acting-situation-examples) 'type) + (setq mime-acting-situation-examples nil)) + ) + (kill-buffer buffer)))) + ;;; mime-play.el ends here