X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=7e5ab153cc729e0a74a19c798eb0fbadee6f0f8a;hb=cdcaf59c5dccd4af07739100cd300c4b45e8ab4b;hp=f9f381cc65ad0399c7762f76d8acbc10a19f0b15;hpb=c07f64ed6fbcc97ea9980fe5e656c076042ed552;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index f9f381c..7e5ab15 100644 --- a/mime-view.el +++ b/mime-view.el @@ -70,16 +70,6 @@ (make-variable-buffer-local 'mime-preview-buffer) -(defvar mime-raw-representation-type nil - "Representation-type of mime-raw-buffer. -It must be nil, `binary' or `cooked'. -If it is nil, `mime-raw-representation-type-alist' is used as default -value. -Notice that this variable is usually used as buffer local variable in -raw-buffer.") - -(make-variable-buffer-local 'mime-raw-representation-type) - (defvar mime-raw-representation-type-alist '((mime-show-message-mode . binary) (mime-temp-message-mode . binary) @@ -88,34 +78,8 @@ raw-buffer.") "Alist of major-mode vs. representation-type of mime-raw-buffer. Each element looks like (SYMBOL . REPRESENTATION-TYPE). SYMBOL is major-mode or t. t means default. REPRESENTATION-TYPE must be -`binary' or `cooked'. -This value is overridden by buffer local variable -`mime-raw-representation-type' if it is not nil.") - +`binary' or `cooked'.") -(defsubst mime-raw-find-entity-from-node-id (entity-node-id - &optional message-info) - "Return entity from ENTITY-NODE-ID in mime-raw-buffer. -If optional argument MESSAGE-INFO is not specified, -`mime-message-structure' is used." - (mime-raw-find-entity-from-number (reverse entity-node-id) message-info)) - -(defun mime-raw-find-entity-from-number (entity-number &optional message-info) - "Return entity from ENTITY-NUMBER in mime-raw-buffer. -If optional argument MESSAGE-INFO is not specified, -`mime-message-structure' is used." - (or message-info - (setq message-info mime-message-structure)) - (if (eq entity-number t) - message-info - (let ((sn (car entity-number))) - (if (null sn) - message-info - (let ((rc (nth sn (mime-entity-children message-info)))) - (if rc - (mime-raw-find-entity-from-number (cdr entity-number) rc) - )) - )))) (defun mime-raw-find-entity-from-point (point &optional message-info) "Return entity from POINT in mime-raw-buffer. @@ -174,26 +138,6 @@ mother-buffer." ;;; @ entity information ;;; -(defsubst mime-entity-representation-type (entity) - (with-current-buffer (mime-entity-buffer entity) - (or mime-raw-representation-type - (cdr (or (assq major-mode mime-raw-representation-type-alist) - (assq t mime-raw-representation-type-alist)))))) - -(defsubst mime-entity-cooked-p (entity) - (eq (mime-entity-representation-type entity) 'cooked)) - -(defsubst mime-entity-parent (entity &optional message-info) - "Return mother entity of ENTITY. -If optional argument MESSAGE-INFO is not specified, -`mime-message-structure' in buffer of ENTITY is used." - (mime-raw-find-entity-from-node-id - (cdr (mime-entity-node-id entity)) - (or message-info - (save-excursion - (set-buffer (mime-entity-buffer entity)) - mime-message-structure)))) - (defun mime-entity-situation (entity) "Return situation of ENTITY." (append (or (mime-entity-content-type entity) @@ -226,33 +170,9 @@ If optional argument MESSAGE-INFO is not specified, )) -(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode")) - -(defun mime-entity-uu-filename (entity) - (if (member (mime-entity-encoding entity) - mime-view-uuencode-encoding-name-list) - (save-excursion - (set-buffer (mime-entity-buffer entity)) - (goto-char (mime-entity-body-start entity)) - (if (re-search-forward "^begin [0-9]+ " - (mime-entity-body-end entity) t) - (if (looking-at ".+$") - (buffer-substring (match-beginning 0)(match-end 0)) - ))))) - -(defun mime-entity-filename (entity) - (or (mime-entity-uu-filename entity) - (mime-content-disposition-filename - (mime-entity-content-disposition entity)) - (cdr (let ((param (mime-content-type-parameters - (mime-entity-content-type entity)))) - (or (assoc "name" param) - (assoc "x-name" param)) - )))) - (defun mime-view-entity-title (entity) - (or (mime-entity-read-field entity 'Content-Description) - (mime-entity-read-field entity 'Subject) + (or (mime-read-field 'Content-Description entity) + (mime-read-field 'Subject entity) (mime-entity-filename entity) "")) @@ -679,7 +599,14 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." 'mime-acting-condition '((type . message)(subtype . external-body) ("access-type" . "anon-ftp") - (method . mime-view-message/external-ftp) + (method . mime-view-message/external-anon-ftp) + )) + +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . message)(subtype . external-body) + ("access-type" . "url") + (method . mime-view-message/external-url) )) (ctree-set-calist-strictly @@ -754,11 +681,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (funcall header-presentation-method entity situation) (mime-insert-decoded-header entity mime-view-ignored-field-list - mime-view-visible-field-list - (if (mime-entity-cooked-p entity) - nil - default-mime-charset)) - ) + mime-view-visible-field-list)) (goto-char (point-max)) (insert "\n") (run-hooks 'mime-display-header-hook) @@ -936,7 +859,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (set-buffer raw-buffer) (setq mime-preview-buffer preview-buffer) (let ((inhibit-read-only t)) - (switch-to-buffer preview-buffer) + (set-buffer (get-buffer-create preview-buffer)) (widen) (erase-buffer) (setq mime-raw-buffer raw-buffer) @@ -959,19 +882,47 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (search-forward "\n\n" nil t) )) (run-hooks 'mime-view-mode-hook) - )) - (set-buffer-modified-p nil) - (setq buffer-read-only t) - ) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (or (get-buffer-window preview-buffer) + (let ((r-win (get-buffer-window raw-buffer))) + (if r-win + (set-window-buffer r-win preview-buffer) + (let ((m-win (and mother (get-buffer-window mother)))) + (if m-win + (set-window-buffer m-win preview-buffer) + (switch-to-buffer preview-buffer) + ))))) + ))) (defun mime-view-buffer (&optional raw-buffer preview-buffer mother - default-keymap-or-function) + default-keymap-or-function + representation-type) + "View RAW-BUFFER in MIME-View mode. +Optional argument PREVIEW-BUFFER is either nil or a name of preview +buffer. +Optional argument DEFAULT-KEYMAP-OR-FUNCTION is nil, keymap or +function. If it is a keymap, keymap of MIME-View mode will be added +to it. If it is a function, it will be bound as default binding of +keymap of MIME-View mode. +Optional argument REPRESENTATION-TYPE is representation-type of +message. It must be nil, `binary' or `cooked'. If it is nil, +`binary' is used as default." (interactive) + (or raw-buffer + (setq raw-buffer (current-buffer))) + (or representation-type + (setq representation-type + (save-excursion + (set-buffer raw-buffer) + (cdr (or (assq major-mode mime-raw-representation-type-alist) + (assq t mime-raw-representation-type-alist))) + ))) + (if (eq representation-type 'binary) + (setq representation-type 'buffer) + ) (mime-display-message - (save-excursion - (if raw-buffer (set-buffer raw-buffer)) - (mime-parse-message) - ) + (mime-open-entity representation-type raw-buffer) preview-buffer mother default-keymap-or-function)) (defun mime-view-mode (&optional mother ctl encoding @@ -1000,13 +951,27 @@ button-2 Move to point under the mouse cursor and decode current content as `play mode' " (interactive) - (mime-display-message - (save-excursion - (if raw-buffer (set-buffer raw-buffer)) - (or mime-view-redisplay - (mime-parse-message ctl encoding)) - ) - preview-buffer mother default-keymap-or-function)) + (unless mime-view-redisplay + (save-excursion + (if raw-buffer (set-buffer raw-buffer)) + (let ((type + (cdr + (or (assq major-mode mime-raw-representation-type-alist) + (assq t mime-raw-representation-type-alist))))) + (if (eq type 'binary) + (setq type 'buffer) + ) + (setq mime-message-structure (mime-open-entity type raw-buffer)) + (or (mime-entity-content-type mime-message-structure) + (mime-entity-set-content-type-internal + mime-message-structure ctl)) + ) + (or (mime-entity-encoding mime-message-structure) + (mime-entity-set-encoding-internal mime-message-structure encoding)) + )) + (mime-display-message mime-message-structure preview-buffer + mother default-keymap-or-function) + ) ;;; @@ playing @@ -1111,9 +1076,8 @@ It calls following-method selected from variable str (save-excursion (set-buffer a-buf) - (setq - ci - (mime-raw-find-entity-from-node-id entity-node-id)) + (setq ci + (mime-find-entity-from-node-id entity-node-id)) (save-restriction (narrow-to-region (mime-entity-point-min ci) @@ -1178,9 +1142,7 @@ If there is no upper entity, call function `mime-preview-quit'." (get-text-property (point) 'mime-view-entity))) (backward-char) ) - (let ((r (mime-raw-find-entity-from-node-id - (cdr (mime-entity-node-id cinfo)) - (get-text-property 1 'mime-view-entity))) + (let ((r (mime-entity-parent cinfo)) point) (catch 'tag (while (setq point (previous-single-property-change