X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=51d8cb031e0a3165f045bf5c04b91e6551d16f15;hb=87aeac9cc2f15175460a70f3e66be8879487b546;hp=39efedfdf6cdb4f851f43bdb536744a3fb479fa1;hpb=70c52d77d09e622dc0557aee14bab4e59c5aee73;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index 39efedf..51d8cb0 100644 --- a/mime-view.el +++ b/mime-view.el @@ -6,7 +6,7 @@ ;; Created: 1994/7/13 ;; Renamed: 1994/8/31 from tm-body.el ;; Renamed: 1997/02/19 from tm-view.el -;; Version: $Revision: 0.11 $ +;; Version: $Revision: 0.40 $ ;; Keywords: MIME, multimedia, mail, news ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). @@ -28,10 +28,7 @@ ;;; Code: -(require 'tl-str) -(require 'tl-list) -(require 'tl-atype) -(require 'tl-misc) +(require 'cl) (require 'std11) (require 'mel) (require 'eword-decode) @@ -43,7 +40,7 @@ ;;; (defconst mime-view-RCS-ID - "$Id: mime-view.el,v 0.11 1997-02-24 01:59:28 tmorioka Exp $") + "$Id: mime-view.el,v 0.40 1997-03-17 13:11:10 morioka Exp $") (defconst mime-view-version (get-version-string mime-view-RCS-ID)) @@ -124,6 +121,10 @@ (method . mime-article/decode-message/partial) (mode . "play") ) + ((type . "message/external-body") + ("access-type" . "anon-ftp") + (method . mime-article/decode-message/external-ftp) + ) ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file) (mode . "play") @@ -136,13 +137,16 @@ (defvar mime-view-childrens-header-showing-Content-Type-list '("message/rfc822" "message/news")) -(defvar mime-view-default-showing-Content-Type-list +(defvar mime-view-visible-media-type-list '("text/plain" nil "text/richtext" "text/enriched" + "text/rfc822-headers" "text/x-latex" "application/x-latex" "message/delivery-status" "application/pgp" "text/x-pgp" "application/octet-stream" - "application/x-selection" "application/x-comment")) + "application/x-selection" "application/x-comment") + "*List of media-types to be able to display in MIME-View buffer. +Each elements are string of TYPE/SUBTYPE, e.g. \"text/plain\".") (defvar mime-view-content-button-ignored-ctype-list '("application/x-selection")) @@ -194,12 +198,14 @@ Each elements are regexp of field-name. [mime-view.el]") ;;; (defun mime-view-header-visible-p (rcnum cinfo &optional ctype) + "Return non-nil if header of current entity is visible." (or (null rcnum) (progn - (setq ctype - (mime::content-info/type - (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo) - )) + (or ctype + (setq ctype + (mime::content-info/type + (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo) + ))) (member ctype mime-view-childrens-header-showing-Content-Type-list) ))) @@ -211,7 +217,7 @@ Each elements are regexp of field-name. [mime-view.el]") (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo)) )) ) - (and (member ctype mime-view-default-showing-Content-Type-list) + (and (member ctype mime-view-visible-media-type-list) (if (string-equal ctype "application/octet-stream") (progn (or ccinfo @@ -227,13 +233,12 @@ Each elements are regexp of field-name. [mime-view.el]") ;;; @@ content button ;;; -(defun mime-preview/insert-content-button - (rcnum cinfo ctype params subj encoding) +(defun mime-view-insert-entity-button (rcnum cinfo ctype params subj encoding) + "Insert entity-button." (save-restriction (narrow-to-region (point)(point)) (let ((access-type (assoc "access-type" params)) - (charset (assoc "charset" params)) - (num (or (assoc-value "x-part-number" params) + (num (or (cdr (assoc "x-part-number" params)) (if (consp rcnum) (mapconcat (function (lambda (num) @@ -248,31 +253,31 @@ Each elements are regexp of field-name. [mime-view.el]") (if server (insert (format "[%s %s ([%s] %s)]\n" num subj access-type (cdr server))) - (let ((site (assoc-value "site" params)) - (dir (assoc-value "directory" params)) + (let ((site (cdr (assoc "site" params))) + (dir (cdr (assoc "directory" params))) ) (insert (format "[%s %s ([%s] %s:%s)]\n" num subj access-type site dir)) ))) ) (t - (insert (concat "[" num " " subj)) - (let ((rest - (if (setq charset (cdr charset)) - (if encoding - (format " <%s; %s (%s)>]\n" - ctype charset encoding) - (format " <%s; %s>]\n" ctype charset) - ) - (format " <%s>]\n" ctype) - ))) - (if (>= (+ (current-column)(length rest))(window-width)) - (setq rest (concat "\n\t" rest)) - ) - (insert rest) - )))) - (tm:add-button (point-min)(1- (point-max)) - (function mime-view-play-content)) + (let ((charset (cdr (assoc "charset" params)))) + (insert (concat "[" num " " subj)) + (let ((rest + (concat " <" ctype + (if charset + (concat "; " charset) + (if encoding (concat " (" encoding ")")) + ) + ">]\n"))) + (if (>= (+ (current-column)(length rest))(window-width)) + (insert "\n\t") + ) + (insert rest) + )))) + ) + (mime-add-button (point-min)(1- (point-max)) + (function mime-view-play-current-entity)) )) (defun mime-preview/default-content-button-function @@ -281,7 +286,7 @@ Each elements are regexp of field-name. [mime-view.el]") (not (member ctype mime-view-content-button-ignored-ctype-list))) - (mime-preview/insert-content-button + (mime-view-insert-entity-button rcnum cinfo ctype params subj encoding) )) @@ -314,7 +319,7 @@ Each elements are regexp of field-name. [mime-view.el]") (defun mime-view-default-content-header-filter () (mime-preview/cut-header) - (eword-decode-message-header) + (eword-decode-header) ) (defvar mime-view-content-header-filter-alist nil) @@ -346,18 +351,24 @@ Each elements are regexp of field-name. [mime-view.el]") ;;; @@ buffer local variables ;;; -;; for XEmacs -(defvar mime::article/preview-buffer nil) -(defvar mime::article/code-converter nil) -(defvar mime::preview/article-buffer nil) +;;; @@@ in raw buffer +;;; (make-variable-buffer-local 'mime::article/content-info) + +(defvar mime::article/preview-buffer nil) (make-variable-buffer-local 'mime::article/preview-buffer) -(make-variable-buffer-local 'mime::article/code-converter) + + +;;; @@@ in view buffer +;;; (make-variable-buffer-local 'mime::preview/mother-buffer) (make-variable-buffer-local 'mime::preview/content-list) + +(defvar mime::preview/article-buffer nil) (make-variable-buffer-local 'mime::preview/article-buffer) + (make-variable-buffer-local 'mime::preview/original-major-mode) (make-variable-buffer-local 'mime::preview/original-window-configuration) @@ -519,7 +530,7 @@ The compressed face will be piped to this command.") ctype mime-view-content-button-visible-ctype-list)) (save-excursion (goto-char (point-max)) - (mime-preview/insert-content-button + (mime-view-insert-entity-button rcnum cinfo ctype params subj encoding) )) (cond ((mime-view-body-visible-p rcnum cinfo ctype) @@ -533,7 +544,7 @@ The compressed face will be piped to this command.") (null (mime::content-info/children cinfo)) ) (goto-char (point-max)) - (mime-preview/insert-content-button + (mime-view-insert-entity-button rcnum cinfo ctype params subj encoding) )) (mime-preview/default-content-separator rcnum cinfo ctype params subj) @@ -580,8 +591,8 @@ The compressed face will be piped to this command.") (let ((be (point-max))) (narrow-to-region be be) (insert mime-view-announcement-for-message/partial) - (tm:add-button (point-min)(point-max) - (function mime-view-play-content)) + (mime-add-button (point-min)(point-max) + (function mime-view-play-current-entity)) ))) (defun mime-article/get-uu-filename (param &optional encoding) @@ -705,29 +716,32 @@ The compressed face will be piped to this command.") (next "Move to next content" mime-view-next-content) (scroll-down "Scroll to previous content" mime-view-scroll-down-content) (scroll-up "Scroll to next content" mime-view-scroll-up-content) - (play "Play Content" mime-view-play-content) - (extract "Extract Content" mime-view-extract-content) - (print "Print" mime-view-print-content) + (play "Play Content" mime-view-play-current-entity) + (extract "Extract Content" mime-view-extract-current-entity) + (print "Print" mime-view-print-current-entity) (x-face "Show X Face" mime-view-display-x-face) ) "Menu for MIME Viewer") -(if running-xemacs - (progn - (defvar mime-view-xemacs-popup-menu - (cons mime-view-menu-title - (mapcar (function - (lambda (item) - (vector (nth 1 item)(nth 2 item) t) - )) - mime-view-menu-list))) - (defun mime-view-xemacs-popup-menu (event) - "Popup the menu in the MIME Viewer buffer" - (interactive "e") - (select-window (event-window event)) - (set-buffer (event-buffer event)) - (popup-menu 'mime-view-xemacs-popup-menu)) - )) +(cond (running-xemacs + (defvar mime-view-xemacs-popup-menu + (cons mime-view-menu-title + (mapcar (function + (lambda (item) + (vector (nth 1 item)(nth 2 item) t) + )) + mime-view-menu-list))) + (defun mime-view-xemacs-popup-menu (event) + "Popup the menu in the MIME Viewer buffer" + (interactive "e") + (select-window (event-window event)) + (set-buffer (event-buffer event)) + (popup-menu 'mime-view-xemacs-popup-menu)) + (defvar mouse-button-2 'button2) + ) + (t + (defvar mouse-button-2 [mouse-2]) + )) (defun mime-view-define-keymap (&optional default) (let ((mime-view-mode-map (if (keymapp default) @@ -755,11 +769,11 @@ The compressed face will be piped to this command.") (define-key mime-view-mode-map "\C-\M-m" (function mime-view-previous-line-content)) (define-key mime-view-mode-map - "v" (function mime-view-play-content)) + "v" (function mime-view-play-current-entity)) (define-key mime-view-mode-map - "e" (function mime-view-extract-content)) + "e" (function mime-view-extract-current-entity)) (define-key mime-view-mode-map - "\C-c\C-p" (function mime-view-print-content)) + "\C-c\C-p" (function mime-view-print-current-entity)) (define-key mime-view-mode-map "a" (function mime-view-follow-content)) (define-key mime-view-mode-map @@ -780,7 +794,7 @@ The compressed face will be piped to this command.") )) (if mouse-button-2 (define-key mime-view-mode-map - mouse-button-2 (function tm:button-dispatcher)) + mouse-button-2 (function mime-button-dispatcher)) ) (cond (running-xemacs (define-key mime-view-mode-map @@ -882,27 +896,25 @@ button-2 Move to point under the mouse cursor (setq rpcl (cdr rpcl)) )))) -(autoload 'mime-preview/decode-content "mime-play") - -(defvar mime-view-decoding-mode "play" "MIME body decoding mode") +(autoload 'mime-view-play-current-entity "mime-play" "Play current entity." t) -(defun mime-view-play-content () +(defun mime-view-extract-current-entity () + "Extract current entity into file (maybe). +It decodes current entity to call internal or external method as +\"extract\" mode. The method is selected from variable +`mime/content-decoding-condition'." (interactive) - (let ((mime-view-decoding-mode "play")) - (mime-preview/decode-content) - )) - -(defun mime-view-extract-content () - (interactive) - (let ((mime-view-decoding-mode "extract")) - (mime-preview/decode-content) - )) + (mime-view-play-current-entity "extract") + ) -(defun mime-view-print-content () +(defun mime-view-print-current-entity () + "Print current entity (maybe). +It decodes current entity to call internal or external method as +\"print\" mode. The method is selected from variable +`mime/content-decoding-condition'." (interactive) - (let ((mime-view-decoding-mode "print")) - (mime-preview/decode-content) - )) + (mime-view-play-current-entity "print") + ) (defun mime-view-follow-content () (interactive) @@ -946,9 +958,7 @@ button-2 Move to point under the mouse cursor new-buf (the-buf (current-buffer)) (a-buf mime::preview/article-buffer) - (hb (mime::content-info/point-min cinfo)) - (he (mime::content-info/point-max cinfo)) - fields from to cc reply-to subj mid f) + fields) (save-excursion (set-buffer (setq new-buf (get-buffer-create new-name))) (erase-buffer) @@ -978,8 +988,8 @@ button-2 Move to point under the mouse cursor (concat "^" (apply (function regexp-or) fields) ":") "")))) - (if (string-equal (mime::content-info/type ci) - "message/rfc822") + (if (string= (mime::content-info/type ci) + "message/rfc822") nil (if str (insert str) @@ -1007,7 +1017,7 @@ button-2 Move to point under the mouse cursor )) (setq rest (cdr rest)) )) - (eword-decode-message-header) + (eword-decode-header) ) (let ((f (cdr (assq mode mime-view-following-method-alist)))) (if (functionp f)