X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=mime-view.el;h=8bf441722f6f77612156d543d0b143a1efb0a8b0;hb=d6d3723c7cbc3fa0884b534ba67d08d518449675;hp=3c97161de3d9edcaa7a3ecc5cb36efd8b55a810d;hpb=3aeffbba533e6eb1f08720f700c5f5569b6f5099;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index 3c97161..8bf4417 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.24 $ +;; Version: $Revision: 0.59 $ ;; Keywords: MIME, multimedia, mail, news ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). @@ -40,7 +40,7 @@ ;;; (defconst mime-view-RCS-ID - "$Id: mime-view.el,v 0.24 1997-03-15 22:20:20 morioka Exp $") + "$Id: mime-view.el,v 0.59 1997-03-17 16:17:40 morioka Exp $") (defconst mime-view-version (get-version-string mime-view-RCS-ID)) @@ -137,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")) @@ -167,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) @@ -194,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) @@ -212,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 @@ -225,15 +217,14 @@ 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 (cdr (assoc "x-part-number" params)) (if (consp rcnum) (mapconcat (function @@ -257,64 +248,61 @@ Each elements are regexp of field-name. [mime-view.el]") ))) ) (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) - )))) + (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-content)) + (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) ) @@ -331,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") @@ -355,13 +344,6 @@ Each elements are regexp of field-name. [mime-view.el]") (defvar mime::article/preview-buffer nil) (make-variable-buffer-local 'mime::article/preview-buffer) -(defvar mime-raw::text-decoder nil - "Function to decode text in current buffer. -Interface of the function is (CHARSET &optional ENCODING). -CHARSET is symbol of MIME charset and ENCODING is value of -Content-Transfer-Encoding.") -(make-variable-buffer-local 'mime-raw::text-decoder) - ;;; @@@ in view buffer ;;; @@ -380,8 +362,9 @@ Content-Transfer-Encoding.") ;;; (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) @@ -488,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)) )) @@ -498,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)) @@ -523,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) @@ -533,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) @@ -547,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) @@ -595,7 +580,7 @@ The compressed face will be piped to this command.") (narrow-to-region be be) (insert mime-view-announcement-for-message/partial) (mime-add-button (point-min)(point-max) - (function mime-view-play-content)) + (function mime-view-play-current-entity)) ))) (defun mime-article/get-uu-filename (param &optional encoding) @@ -714,14 +699,14 @@ 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) - (next "Move to next content" mime-view-next-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-move-to-next) (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) + (scroll-up "Scroll to next content" mime-view-scroll-up-entity) + (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") @@ -752,17 +737,17 @@ 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)) + "n" (function mime-view-move-to-next)) (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)) + "\t" (function mime-view-move-to-next)) (define-key mime-view-mode-map - " " (function mime-view-scroll-up-content)) + " " (function mime-view-scroll-up-entity)) (define-key mime-view-mode-map "\M- " (function mime-view-scroll-down-content)) (define-key mime-view-mode-map @@ -772,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 @@ -899,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) @@ -1041,74 +1024,64 @@ 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 () +(defun mime-view-move-to-next () + "Move to next entity. +If there is no previous entity, it calls function registered in +variable `mime-view-over-to-next-method-alist'." (interactive) - (let ((pcl mime::preview/content-list) - (p (point)) - beg) - (catch 'tag - (while pcl - (setq beg (mime::preview-content-info/point-min (car pcl))) - (if (< p beg) - (throw 'tag (goto-char beg)) - ) - (setq pcl (cdr pcl)) - ) + (let ((point (next-single-property-change (point) 'mime-view-cinfo))) + (if point + (goto-char point) (let ((f (assq mime::preview/original-major-mode mime-view-over-to-next-method-alist))) (if f (funcall (cdr f)) )) - ) - )) + ))) -(defun mime-view-scroll-up-content (&optional h) +(defun mime-view-scroll-up-entity (&optional h) + "Scroll up current entity." (interactive) (or h (setq h (- (window-height) 1)) @@ -1136,7 +1109,6 @@ button-2 Move to point under the mouse cursor (if (> (point) np) (goto-char np) ) - ;;(show-subtree) )) ) @@ -1174,7 +1146,7 @@ button-2 Move to point under the mouse cursor (defun mime-view-next-line-content () (interactive) - (mime-view-scroll-up-content 1) + (mime-view-scroll-up-entity 1) ) (defun mime-view-previous-line-content ()