X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=a80307001bbdd58434d98e9ce52e7e4ddcbaae4f;hb=a13edb88d69c44f332531b07fd5e8f18dd33c6aa;hp=b3438246ab1cd98241a44f00c292f19b316e6c55;hpb=ff316b5d83984a2444ade9a2f95a101493959c23;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index b343824..a803070 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.13 $ +;; Version: $Revision: 0.56 $ ;; Keywords: MIME, multimedia, mail, news ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). @@ -28,9 +28,7 @@ ;;; Code: -(require 'tl-list) -(require 'tl-atype) -(require 'tl-misc) +(require 'cl) (require 'std11) (require 'mel) (require 'eword-decode) @@ -42,7 +40,7 @@ ;;; (defconst mime-view-RCS-ID - "$Id: mime-view.el,v 0.13 1997-02-24 09:07:52 tmorioka Exp $") + "$Id: mime-view.el,v 0.56 1997-03-17 15:59:51 morioka Exp $") (defconst mime-view-version (get-version-string mime-view-RCS-ID)) @@ -123,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") @@ -135,16 +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")) - -(defvar mime-view-content-button-ignored-ctype-list - '("application/x-selection")) + "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-visible-ctype-list '("application/pgp")) @@ -165,15 +167,9 @@ Each elements are regexp of field-name. [mime-view.el]") (apply (function regexp-or) mime-view-ignored-field-list) ":")) -(defvar mime-view-visible-field-list - '("Dnas.*" "Message-Id") +(defvar mime-view-visible-field-list '("Dnas.*" "Message-Id") "All fields that match this list will be displayed in MIME preview buffer. -Each elements are regexp of field-name. [mime-view.el]") - -(defvar mime-view-visible-field-regexp - (concat "^" - (apply (function regexp-or) mime-view-visible-field-list) - ":")) +Each elements are regexp of field-name.") (defvar mime-view-redisplay nil) @@ -192,15 +188,13 @@ Each elements are regexp of field-name. [mime-view.el]") ;;; @@ predicate functions ;;; -(defun mime-view-header-visible-p (rcnum cinfo &optional ctype) +(defun mime-view-header-visible-p (rcnum cinfo) + "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) - )) - (member ctype mime-view-childrens-header-showing-Content-Type-list) - ))) + (member (mime::content-info/type + (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo)) + mime-view-childrens-header-showing-Content-Type-list) + )) (defun mime-view-body-visible-p (rcnum cinfo &optional ctype) (let (ccinfo) @@ -210,7 +204,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 @@ -223,16 +217,15 @@ Each elements are regexp of field-name. [mime-view.el]") )) -;;; @@ content button +;;; @@ entity 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) @@ -247,72 +240,69 @@ 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 +(defun mime-view-entity-button-function (rcnum cinfo ctype params subj encoding) - (if (and (consp rcnum) - (not (member - ctype - mime-view-content-button-ignored-ctype-list))) - (mime-preview/insert-content-button - rcnum cinfo ctype params subj encoding) - )) - -(defvar mime-preview/content-button-function - (function mime-preview/default-content-button-function)) + "Insert entity button conditionally. +Please redefine this function if you want to change default setting." + (or (null rcnum) + (string= ctype "application/x-selection") + (and (string= ctype "application/octet-stream") + (string= (mime::content-info/type + (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo)) + "multipart/encrypted")) + (mime-view-insert-entity-button rcnum cinfo ctype params subj encoding) + )) ;;; @@ content header filter ;;; -(defun mime-preview/cut-header () +(defsubst mime-view-cut-header () (goto-char (point-min)) - (while (and - (re-search-forward mime-view-ignored-field-regexp nil t) - (let* ((beg (match-beginning 0)) - (end (match-end 0)) - (name (buffer-substring beg end)) - ) - (if (not (string-match mime-view-visible-field-regexp name)) - (delete-region - beg - (save-excursion - (and - (re-search-forward "^\\([^ \t]\\|$\\)" nil t) - (match-beginning 0) - ))) - ) - t))) - ) + (while (re-search-forward mime-view-ignored-field-regexp nil t) + (let* ((beg (match-beginning 0)) + (end (match-end 0)) + (name (buffer-substring beg end)) + ) + (or (member-if (function + (lambda (regexp) + (string-match regexp name) + )) mime-view-visible-field-list) + (delete-region beg + (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t) + (match-beginning 0) + (point-max))) + )))) (defun mime-view-default-content-header-filter () - (mime-preview/cut-header) + (mime-view-cut-header) (eword-decode-header) ) @@ -329,13 +319,14 @@ Each elements are regexp of field-name. [mime-view.el]") )) -;;; @@ content separator +;;; @@ entity separator ;;; -(defun mime-preview/default-content-separator (rcnum cinfo ctype params subj) - (if (and (not (mime-view-header-visible-p rcnum cinfo ctype)) - (not (mime-view-body-visible-p rcnum cinfo ctype)) - ) +(defun mime-view-entity-separator-function (rcnum cinfo ctype params subj) + "Insert entity separator conditionally. +Please redefine this function if you want to change default setting." + (or (mime-view-header-visible-p rcnum cinfo) + (mime-view-body-visible-p rcnum cinfo ctype) (progn (goto-char (point-max)) (insert "\n") @@ -345,18 +336,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) @@ -365,8 +362,9 @@ Each elements are regexp of field-name. [mime-view.el]") ;;; (defvar mime-view-quitting-method-alist - '((mime/show-message-mode - . mime-view-quitting-method-for-mime/show-message-mode))) + '((mime-show-message-mode + . mime-view-quitting-method-for-mime-show-message-mode)) + "Alist of major-mode vs. quitting-method of mime-view.") (defvar mime-view-over-to-previous-method-alist nil) (defvar mime-view-over-to-next-method-alist nil) @@ -473,7 +471,7 @@ The compressed face will be piped to this command.") (let ((drest dest)) (while pcl (setcar drest - (mime-preview/display-content (car pcl) cinfo the-buf obuf)) + (mime-view-display-entity (car pcl) cinfo the-buf obuf)) (setq pcl (cdr pcl) drest (cdr drest)) )) @@ -483,7 +481,8 @@ The compressed face will be piped to this command.") (list obuf dest) )) -(defun mime-preview/display-content (content cinfo ibuf obuf) +(defun mime-view-display-entity (content cinfo ibuf obuf) + "Display entity from content-info CONTENT." (let* ((beg (mime::content-info/point-min content)) (end (mime::content-info/point-max content)) (ctype (mime::content-info/type content)) @@ -508,9 +507,8 @@ The compressed face will be piped to this command.") (set-buffer obuf) (setq nb (point)) (narrow-to-region nb nb) - (funcall mime-preview/content-button-function - rcnum cinfo ctype params subj encoding) - (if (mime-view-header-visible-p rcnum cinfo ctype) + (mime-view-entity-button-function rcnum cinfo ctype params subj encoding) + (if (mime-view-header-visible-p rcnum cinfo) (mime-preview/display-header beg he) ) (if (and (null rcnum) @@ -518,7 +516,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) @@ -532,14 +530,16 @@ 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) + (mime-view-entity-separator-function rcnum cinfo ctype params subj) (prog1 (progn (setq ne (point-max)) (widen) + (put-text-property nb ne 'mime-view-raw-buffer ibuf) + (put-text-property nb ne 'mime-view-cinfo content) (mime::preview-content-info/create nb (1- ne) ibuf content) ) (goto-char ne) @@ -579,8 +579,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) @@ -699,34 +699,37 @@ The compressed face will be piped to this command.") (defconst mime-view-menu-title "MIME-View") (defconst mime-view-menu-list - '((up "Move to upper content" mime-view-up-content) - (previous "Move to previous content" mime-view-previous-content) + '((up "Move to upper content" mime-view-move-to-upper) + (previous "Move to previous content" mime-view-move-to-previous) (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) @@ -734,13 +737,13 @@ The compressed face will be piped to this command.") (make-sparse-keymap) ))) (define-key mime-view-mode-map - "u" (function mime-view-up-content)) + "u" (function mime-view-move-to-upper)) (define-key mime-view-mode-map - "p" (function mime-view-previous-content)) + "p" (function mime-view-move-to-previous)) (define-key mime-view-mode-map "n" (function mime-view-next-content)) (define-key mime-view-mode-map - "\e\t" (function mime-view-previous-content)) + "\e\t" (function mime-view-move-to-previous)) (define-key mime-view-mode-map "\t" (function mime-view-next-content)) (define-key mime-view-mode-map @@ -754,11 +757,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 @@ -779,7 +782,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 @@ -881,27 +884,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) @@ -945,9 +946,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) @@ -977,8 +976,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) @@ -1025,51 +1024,46 @@ button-2 Move to point under the mouse cursor (mime-view-x-face-function) )) -(defun mime-view-up-content () +(defun mime-view-move-to-upper () + "Move to upper entity. +If there is no upper entity, call function `mime-view-quit'." (interactive) - (let* ((pc (mime-preview/point-pcinfo (point))) - (cinfo (mime::preview-content-info/content-info pc)) - (rcnum (mime::content-info/rcnum cinfo)) - ) - (if rcnum - (let ((r (save-excursion - (set-buffer (mime::preview-content-info/buffer pc)) - (mime-article/rcnum-to-cinfo (cdr rcnum)) - )) - (rpcl mime::preview/content-list) - cell) - (while (and - (setq cell (car rpcl)) - (not (eq r (mime::preview-content-info/content-info cell))) - ) - (setq rpcl (cdr rpcl)) + (let (cinfo) + (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo))) + (backward-char) + ) + (let ((r (mime-article/rcnum-to-cinfo + (cdr (mime::content-info/rcnum cinfo)) + (get-text-property 1 'mime-view-cinfo))) + point) + (catch 'tag + (while (setq point (previous-single-property-change + (point) 'mime-view-cinfo)) + (goto-char point) + (if (eq r (get-text-property (point) 'mime-view-cinfo)) + (throw 'tag t) ) - (goto-char (mime::preview-content-info/point-min cell)) ) - (mime-view-quit) - ))) + (mime-view-quit) + )))) -(defun mime-view-previous-content () +(defun mime-view-move-to-previous () + "Move to previous entity. +If there is no previous entity, it calls function registered in +variable `mime-view-over-to-previous-method-alist'." (interactive) - (let* ((pcl mime::preview/content-list) - (p (point)) - (i (- (length pcl) 1)) - beg) - (catch 'tag - (while (> i 0) - (setq beg (mime::preview-content-info/point-min (nth i pcl))) - (if (> p beg) - (throw 'tag (goto-char beg)) - ) - (setq i (- i 1)) - ) + (while (null (get-text-property (point) 'mime-view-cinfo)) + (backward-char) + ) + (let ((point (previous-single-property-change (point) 'mime-view-cinfo))) + (if point + (goto-char point) (let ((f (assq mime::preview/original-major-mode mime-view-over-to-previous-method-alist))) (if f (funcall (cdr f)) )) - ) - )) + ))) (defun mime-view-next-content () (interactive)