X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-play.el;h=0c89895ddf327708146a6889e7b7a81a06c7b25f;hb=604314557fdef68a1a0267db0d8726de7a2e882f;hp=435aa461e4d20591e2c46ea701da0c6467af099d;hpb=2e2f5b06a5d30fdf57394f764f2a36929f0e5f63;p=elisp%2Fsemi.git diff --git a/mime-play.el b/mime-play.el index 435aa46..0c89895 100644 --- a/mime-play.el +++ b/mime-play.el @@ -1,8 +1,9 @@ ;;; mime-play.el --- Playback processing module for mime-view.el -;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, +;; 2004, 2010 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Created: 1995/9/26 (separated from tm-view.el) ;; Renamed: 1997/2/21 from tm-play.el ;; Keywords: MIME, multimedia, mail, news @@ -21,8 +22,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Code: @@ -30,147 +31,160 @@ (require 'alist) (require 'filename) - +(eval-when-compile + (condition-case nil + (require 'bbdb) + (error (defvar bbdb-buffer-name nil))) + ) + +(defcustom mime-save-directory "~/" + "*Name of the directory where MIME entity will be saved in. +If t, it means current directory." + :group 'mime-view + :type '(choice (const :tag "Current directory" t) + (directory))) + +(defcustom mime-play-delete-file-immediately t + "If non-nil, delete played file immediately." + :group 'mime-view + :type 'boolean) + +(defvar mime-play-find-every-situations t + "*Find every available situations if non-nil.") + +(defvar mime-play-messages-coding-system nil + "Coding system to be used for external MIME playback method.") + + ;;; @ content decoder ;;; -(defvar mime-preview/after-decoded-position nil) - -(defun mime-view-play-current-entity (&optional mode) +;;;###autoload +(defun mime-preview-play-current-entity (&optional ignore-examples mode) "Play current entity. It decodes current entity to call internal or external method. The method is selected from variable `mime-acting-condition'. +If IGNORE-EXAMPLES (C-u prefix) is specified, this function ignores +`mime-acting-situation-example-list'. If MODE is specified, play as it. Default MODE is \"play\"." - (interactive) - (or mode - (setq mode "play") - ) - (let ((cinfo (get-text-property (point) 'mime-view-cinfo))) - (if cinfo - (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-playback-entity cinfo mode) - (if (eq (current-buffer) raw-buffer) - (progn - (set-buffer the-buf) - (goto-char mime-preview/after-decoded-position) - )) + (interactive "P") + (let ((entity (get-text-property (point) 'mime-view-entity))) + (if entity + (let ((situation + (get-text-property (point) 'mime-view-situation))) + (or mode + (setq mode "play")) + (setq situation + (if (assq 'mode situation) + (put-alist 'mode mode (copy-alist situation)) + (cons (cons 'mode mode) + situation))) + (if ignore-examples + (setq situation + (cons (cons 'ignore-examples ignore-examples) + situation))) + (mime-play-entity entity situation) )))) -(defun mime-playback-entity (cinfo &optional mode) - (let ((beg (mime-entity-info-point-min cinfo)) - (end (mime-entity-info-point-max cinfo)) - (c-type (mime-entity-info-media-type cinfo)) - (c-subtype (mime-entity-info-media-subtype cinfo)) - (params (mime-entity-info-parameters cinfo)) - (encoding (mime-entity-info-encoding cinfo)) - ) - (or c-type - (setq c-type 'text - c-subtype 'plain)) - ;; Check for VM - (if (< beg (point-min)) - (setq beg (point-min)) - ) - (if (< (point-max) end) - (setq end (point-max)) - ) - (let (method cal ret) - (setq cal (list* (cons 'type c-type) - (cons 'subtype c-subtype) - (cons 'encoding encoding) - (cons 'major-mode major-mode) - params)) - (if mode - (setq cal (cons (cons 'mode mode) cal)) - ) - (setq ret (mime/get-content-decoding-alist cal)) - (setq method (cdr (assq 'method ret))) - (cond ((and (symbolp method) - (fboundp method)) - (funcall method beg end ret) - ) - ((and (listp method)(stringp (car method))) - (mime-activate-external-method beg end ret) - ) - (t - (mime-show-echo-buffer - "No method are specified for %s\n" ctype) - )) - ) +;;;###autoload +(defun mime-play-entity (entity &optional situation ignored-method) + "Play entity specified by ENTITY. +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 ((ret + (mime-unify-situations (mime-entity-situation entity situation) + mime-acting-condition + mime-acting-situation-example-list + 'method ignored-method + mime-play-find-every-situations)) + method) + (setq mime-acting-situation-example-list (cdr ret) + ret (car ret)) + (cond ((cdr ret) + (setq ret (mime-select-menu-alist + "Methods" + (mapcar (function + (lambda (situation) + (cons + (format "%s" + (cdr (assq 'method situation))) + situation))) + ret))) + (setq ret (mime-sort-situation ret)) + (add-to-list 'mime-acting-situation-example-list (cons ret 0)) + ) + (t + (setq ret (car ret)) + )) + (setq method (cdr (assq 'method ret))) + (cond ((and (symbolp method) + (fboundp method)) + (funcall method entity ret) + ) + ((stringp method) + (mime-activate-mailcap-method entity ret) + ) + ;; ((and (listp method)(stringp (car method))) + ;; (mime-activate-external-method entity ret) + ;; ) + (t + (mime-show-echo-buffer "No method are specified for %s\n" + (mime-type/subtype-string + (cdr (assq 'type situation)) + (cdr (assq 'subtype situation)))) + (if (y-or-n-p "Do you want to save current entity to disk?") + (mime-save-content entity situation)) + )) )) -;;; @ method selector -;;; - -(defun mime/get-content-decoding-alist (al) - (get-unified-alist mime-acting-condition al) - ) - - ;;; @ external decoder ;;; -(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)) - ) - (if method - (let ((file (make-temp-name - (expand-file-name "TM" mime-temp-directory))) - b args) - (if (nth 1 method) - (setq b beg) - (setq b - (if (re-search-forward "^$" nil t) - (1+ (match-end 0)) - (point-min) - )) - ) - (goto-char b) - (write-region b end file) - (message "External method is starting...") - (setq cal (put-alist - 'name (replace-as-filename name) cal)) - (setq cal (put-alist 'file file cal)) - (setq args (nconc - (list (car method) - mime-echo-buffer-name (car method) - ) - (mime-make-external-method-args - cal (cdr (cdr method))) - )) - (apply (function start-process) args) - (mime-show-echo-buffer) - )) - )))) - -(defun mime-make-external-method-args (cal format) - (mapcar (function - (lambda (arg) - (if (stringp arg) - arg - (let* ((item (eval arg)) - (ret (cdr (assoc item cal))) - ) - (if ret - ret - (if (eq item 'encoding) - "7bit" - "")) - )) - )) - format)) - -(defvar mime-echo-window-is-shared-with-bbdb t +(defvar mime-mailcap-method-filename-alist nil) + +(defun mime-activate-mailcap-method (entity situation) + (let ((method (cdr (assoc 'method situation))) + (name (mime-entity-safe-filename entity))) + (setq name (expand-file-name (if (and name (not (string= name ""))) + name + (make-temp-name "EMI")) + (make-temp-file "EMI" 'directory))) + (mime-write-entity-content entity name) + (message "External method is starting...") + (let ((process + (let ((command + (mime-format-mailcap-command + method + (cons (cons 'filename name) situation))) + (coding-system-for-read mime-play-messages-coding-system)) + (start-process command mime-echo-buffer-name + shell-file-name shell-command-switch command)))) + (set-alist 'mime-mailcap-method-filename-alist process name) + (set-process-sentinel process 'mime-mailcap-method-sentinel)))) + +(defun mime-mailcap-method-sentinel (process event) + (when mime-play-delete-file-immediately + (let ((file (cdr (assq process mime-mailcap-method-filename-alist)))) + (when (file-exists-p file) + (ignore-errors + (delete-file file) + (delete-directory (file-name-directory file))))) + (remove-alist 'mime-mailcap-method-filename-alist process)) + (message "%s %s" process event)) + +(defun mime-mailcap-delete-played-files () + (dolist (elem mime-mailcap-method-filename-alist) + (when (file-exists-p (cdr elem)) + (ignore-errors + (delete-file (cdr elem)) + (delete-directory (file-name-directory (cdr elem))))))) + +(add-hook 'kill-emacs-hook 'mime-mailcap-delete-played-files) + +(defvar mime-echo-window-is-shared-with-bbdb + (module-installed-p 'bbdb) "*If non-nil, mime-echo window is shared with BBDB window.") (defvar mime-echo-window-height @@ -188,28 +202,29 @@ window.") "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-echo-buffer-name)) + (win (get-buffer-window mime-echo-buffer-name))) + (unless win + (unless (and mime-echo-window-is-shared-with-bbdb + (condition-case nil + (setq win (get-buffer-window bbdb-buffer-name)) + (error nil))) + (select-window (get-buffer-window (or mime-preview-buffer + (current-buffer)))) + (setq win (split-window-vertically + (- (window-height) + (if (functionp mime-echo-window-height) + (funcall mime-echo-window-height) + mime-echo-window-height) + ))) ) - (or win - (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-echo-buffer-name) - (select-window (get-buffer-window mime-view-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) - )) + (set-window-buffer win mime-echo-buffer-name) + ) (select-window win) (goto-char (point-max)) (if forms - (insert (apply (function format) forms)) - ) + (let ((buffer-read-only nil)) + (insert (apply (function format) forms)) + )) (select-window the-win) )) @@ -227,161 +242,190 @@ window.") (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) - (let (ret) - (or (if (or (and (setq ret (mime/Content-Disposition)) - (setq ret (assoc "filename" (cdr ret))) - ) - (setq ret (assoc "name" param)) - (setq ret (assoc "x-name" param)) - ) - (std11-strip-quoted-string (cdr ret)) - ) - (if (setq ret - (std11-find-field-body '("Content-Description" - "Subject"))) - (if (or (string-match mime-view-file-name-regexp-1 ret) - (string-match mime-view-file-name-regexp-2 ret)) - (substring ret (match-beginning 0)(match-end 0)) - )) - )) - )) - -(defun mime-article/get-filename (param) - (replace-as-filename (mime-article/get-original-filename param)) - ) +(defun mime-entity-safe-filename (entity) + (let ((filename + (or (mime-entity-filename entity) + (let ((subj + (or (mime-entity-read-field entity 'Content-Description) + (mime-entity-read-field entity 'Subject)))) + (if (and subj + (or (string-match mime-view-file-name-regexp-1 subj) + (string-match mime-view-file-name-regexp-2 subj))) + (substring subj (match-beginning 0)(match-end 0)) + ))))) + (if filename + (replace-as-filename filename) + ))) ;;; @ file extraction ;;; -(defun mime-method-to-save (beg end cal) - (goto-char beg) - (let* ((name - (save-restriction - (narrow-to-region beg end) - (mime-article/get-filename cal) - )) - (encoding (cdr (assq 'encoding cal))) - (filename - (if (and name (not (string-equal name ""))) - (expand-file-name name - (call-interactively - (function - (lambda (dir) - (interactive "DDirectory: ") - dir)))) - (call-interactively - (function - (lambda (file) - (interactive "FFilename: ") - (expand-file-name file)))))) - ) +(defun mime-save-content (entity situation) + (let ((name (or (mime-entity-safe-filename entity) + (format "%s" (mime-entity-media-type entity)))) + (dir (if (eq t mime-save-directory) + default-directory + mime-save-directory)) + filename) + (setq filename (read-file-name + (concat "File name: (default " + (file-name-nondirectory name) ") ") + dir + (concat (file-name-as-directory dir) + (file-name-nondirectory name)))) + (if (file-directory-p filename) + (setq filename (concat (file-name-as-directory filename) + (file-name-nondirectory name)))) (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)(point-max) filename encoding) - )) + (or (yes-or-no-p (format "File %s exists. Save anyway? " filename)) + (error ""))) + (mime-write-entity-content entity (expand-file-name filename)) + filename)) + + +;;; @ file detection +;;; + +(defvar mime-magic-type-alist + '(("^\377\330\377[\340\356]..JFIF" image jpeg) + ("^\211PNG" image png) + ("^GIF8[79]" image gif) + ("^II\\*\000" image tiff) + ("^MM\000\\*" image tiff) + ("^MThd" audio midi) + ("^\000\000\001\263" video mpeg) + ) + "*Alist of regexp about magic-number vs. corresponding media-types. +Each element looks like (REGEXP TYPE SUBTYPE). +REGEXP is a regular expression to match against the beginning of the +content of entity. +TYPE is symbol to indicate primary type of media-type. +SUBTYPE is symbol to indicate subtype of media-type.") + +(defun mime-detect-content (entity situation) + (let (type subtype) + (let ((mdata (mime-entity-content entity)) + (rest mime-magic-type-alist)) + (while (not (let ((cell (car rest))) + (if cell + (if (string-match (car cell) mdata) + (setq type (nth 1 cell) + subtype (nth 2 cell)) + ) + t))) + (setq rest (cdr rest)))) + (setq situation (del-alist 'method (copy-alist situation))) + (mime-play-entity entity + (if type + (put-alist 'type type + (put-alist 'subtype subtype + situation)) + situation) + 'mime-detect-content))) ;;; @ mail/news message ;;; -(defun mime-view-quitting-method-for-mime-show-message-mode () +(defun mime-preview-quitting-method-for-mime-show-message-mode () "Quitting method for mime-view. -It is registered to variable `mime-view-quitting-method-alist'." +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-raw-buffer) - (mime-view-kill-buffer) + (win-conf mime-preview-original-window-configuration)) + (if (buffer-live-p mime-view-temp-message-buffer) + (kill-buffer mime-view-temp-message-buffer)) + (mime-preview-kill-buffer) (set-window-configuration win-conf) - (pop-to-buffer mother) - )) - -(defun mime-method-to-display-message/rfc822 (beg end cal) - (let* ((cnum (mime-article/point-content-number beg)) - (new-name (format "%s-%s" (buffer-name) cnum)) - (mother mime-view-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) - (erase-buffer) - (insert str) - (goto-char (point-min)) - (if (re-search-forward "^\n" nil t) - (delete-region (point-min) (match-end 0)) - ) - (setq major-mode 'mime-show-message-mode) - (setq mime-text-decoder text-decoder) - (mime-view-mode mother) - )) + (pop-to-buffer mother))) + +(defun mime-view-message/rfc822 (entity situation) + (let* ((new-name + (format "%s-%s" (buffer-name) (mime-entity-number entity))) + (mother (current-buffer)) + (children (car (mime-entity-children entity))) + (preview-buffer + (mime-display-message + children new-name mother nil + (cdr (assq 'major-mode + (get-text-property (point) 'mime-view-situation)))))) + (or (get-buffer-window preview-buffer) + (let ((m-win (get-buffer-window mother))) + (if m-win + (set-window-buffer m-win preview-buffer) + (switch-to-buffer preview-buffer) + ))))) ;;; @ message/partial ;;; -(defvar mime-article/coding-system-alist - (list '(mh-show-mode . no-conversion) - (cons t (mime-charset-to-coding-system default-mime-charset)) - )) - -(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) - )) - -(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-temp-directory)) - (id (cdr (assoc "id" cal))) - (number (cdr (assoc "number" cal))) - (total (cdr (assoc "total" cal))) - file - (mother mime-view-buffer) - ) +(defun mime-require-safe-directory (dir) + "Create a directory DIR safely. +The permission of the created directory becomes `700' (for the owner only). +If the directory already exists and is writable by other users, an error +occurs." + (let ((attr (file-attributes dir)) + (orig-modes (default-file-modes))) + (if (and attr (eq (car attr) t)) ; directory already exists. + (unless (or (memq system-type '(windows-nt ms-dos OS/2 emx)) + (and (eq (nth 2 attr) (user-real-uid)) + (eq (file-modes dir) 448))) + (error "Invalid owner or permission for %s" dir)) + (unwind-protect + (progn + (set-default-file-modes 448) + (make-directory dir)) + (set-default-file-modes orig-modes))))) + +(defvar mime-view-temp-message-buffer nil) ; buffer local variable + +(defun mime-store-message/partial-piece (entity cal) + (let ((root-dir + (expand-file-name + (concat "m-prts-" (user-login-name)) temporary-file-directory)) + (id (cdr (assoc "id" cal))) + (number (cdr (assoc "number" cal))) + (total (cdr (assoc "total" cal))) + file + (mother (current-buffer)) + (orig-modes (default-file-modes))) + (mime-require-safe-directory root-dir) (or (file-exists-p root-dir) - (make-directory root-dir) - ) + (unwind-protect + (progn + (set-default-file-modes 448) + (make-directory root-dir)) + (set-default-file-modes orig-modes))) (setq id (replace-as-filename id)) (setq root-dir (concat root-dir "/" id)) + (or (file-exists-p root-dir) - (make-directory root-dir) - ) + (unwind-protect + (progn + (set-default-file-modes 448) + (make-directory root-dir)) + (set-default-file-modes orig-modes))) + (setq file (concat root-dir "/FULL")) (if (file-exists-p file) (let ((full-buf (get-buffer-create "FULL")) (pwin (or (get-buffer-window mother) (get-largest-window))) - ) + pbuf) (save-window-excursion (set-buffer full-buf) (erase-buffer) - (as-binary-input-file (insert-file-contents file)) + (binary-insert-encoded-file file) (setq major-mode 'mime-show-message-mode) - (mime-view-mode mother) - ) - (set-window-buffer pwin - (save-excursion - (set-buffer full-buf) - mime-view-buffer)) - (select-window pwin) - ) - (re-search-forward "^$") - (goto-char (1+ (match-end 0))) + (mime-view-buffer (current-buffer) nil mother) + (setq pbuf (current-buffer)) + (make-local-variable 'mime-view-temp-message-buffer) + (setq mime-view-temp-message-buffer full-buf)) + (set-window-buffer pwin pbuf) + (select-window pwin)) (setq file (concat root-dir "/" number)) - (mime-article::write-region (point) end file) + (mime-write-entity-body entity file) (let ((total-file (concat root-dir "/CT"))) (setq total (if total @@ -409,7 +453,9 @@ It is registered to variable `mime-view-quitting-method-alist'." (kill-buffer (current-buffer)) ))) ))) - (if (and total (> total 0)) + (if (and total (> total 0) + (>= (length (directory-files root-dir nil "^[0-9]+$" t)) + total)) (catch 'tag (save-excursion (set-buffer (get-buffer-create mime-temp-buffer-name)) @@ -421,35 +467,30 @@ It is registered to variable `mime-view-quitting-method-alist'." (or (file-exists-p file) (throw 'tag nil) ) - (as-binary-input-file (insert-file-contents file)) + (binary-insert-encoded-file file) (goto-char (point-max)) - (setq i (1+ i)) - )) - (as-binary-output-file - (write-region (point-min)(point-max) - (expand-file-name "FULL" root-dir))) + (setq i (1+ i)))) + (binary-write-decoded-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))) (and (file-exists-p file) - (delete-file file) - )) - (setq i (1+ i)) - )) + (delete-file file))) + (setq i (1+ i)))) (let ((file (expand-file-name "CT" root-dir))) (and (file-exists-p file) - (delete-file file) - )) - (save-window-excursion - (setq major-mode 'mime-show-message-mode) - (mime-view-mode mother) - ) - (let ((pwin (or (get-buffer-window mother) - (get-largest-window) - )) - (pbuf (save-excursion - (set-buffer full-buf) - mime-view-buffer))) + (delete-file file))) + (let ((buf (current-buffer)) + (pwin (or (get-buffer-window mother) + (get-largest-window))) + (pbuf (mime-display-message + (mime-open-entity 'buffer (current-buffer)) + nil mother nil 'mime-show-message-mode))) + (with-current-buffer pbuf + (make-local-variable 'mime-view-temp-message-buffer) + (setq mime-view-temp-message-buffer buf)) (set-window-buffer pwin pbuf) (select-window pwin) ))))) @@ -459,70 +500,58 @@ It is registered to variable `mime-view-quitting-method-alist'." ;;; @ message/external-body ;;; -(defvar mime-article/dired-function - (if mime/use-multi-frame +(defvar mime-raw-dired-function + (if (and (>= emacs-major-version 19) window-system) (function dired-other-frame) - (function mime-article/dired-function-for-one-frame) + (function mime-raw-dired-function-for-one-frame) )) -(defun mime-article/dired-function-for-one-frame (dir) - (let ((win (or (get-buffer-window mime-view-buffer) +(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-method-to-display-message/external-ftp (beg end cal) +(defun mime-view-message/external-anon-ftp (entity 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-article/dired-function pathname) + (pathname (concat "/anonymous@" site ":" directory))) + (message "%s" (concat "Accessing " (expand-file-name name pathname) "...")) + (funcall mime-raw-dired-function pathname) (goto-char (point-min)) (search-forward name) )) +(defvar mime-raw-browse-url-function mime-browse-url-function) + +(defun mime-view-message/external-url (entity cal) + (let ((url (cdr (assoc "url" cal)))) + (message "%s" (concat "Accessing " url "...")) + (funcall mime-raw-browse-url-function url))) + ;;; @ rot13-47 ;;; -(defun mime-method-to-display-caesar (start end cal) +(defun mime-view-caesar (entity situation) "Internal method for mime-view to display ROT13-47-48 message." - (let* ((cnum (mime-article/point-content-number start)) - (new-name (format "%s-%s" (buffer-name) cnum)) - (the-buf (current-buffer)) - (mother mime-view-buffer) - (charset (cdr (assoc "charset" cal))) - (encoding (cdr (assq 'encoding cal))) - (mode major-mode) - ) - (let ((pwin (or (get-buffer-window mother) - (get-largest-window))) - (buf (get-buffer-create new-name)) - ) - (set-window-buffer pwin buf) - (set-buffer buf) - (select-window pwin) + (let ((buf (get-buffer-create + (format "%s-%s" (buffer-name) (mime-entity-number entity))))) + (with-current-buffer buf + (setq buffer-read-only nil) + (erase-buffer) + (mime-insert-text-content entity) + (mule-caesar-region (point-min) (point-max)) + (set-buffer-modified-p nil) ) - (setq buffer-read-only nil) - (erase-buffer) - (insert-buffer-substring the-buf start end) + (let ((win (get-buffer-window (current-buffer)))) + (or (eq (selected-window) win) + (select-window (or win (get-largest-window))) + )) + (view-buffer buf) (goto-char (point-min)) - (if (re-search-forward "^\n" nil t) - (delete-region (point-min) (match-end 0)) - ) - (let ((m (cdr (or (assq mode mime-text-decoder-alist) - (assq t mime-text-decoder-alist))))) - (and (functionp m) - (funcall m charset encoding) - )) - (mule-caesar-region (point-min) (point-max)) - (set-buffer-modified-p nil) - (set-buffer mother) - (view-buffer new-name) ))