X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=ffd2579467fe8629da4f4a8e7c2da1d9d13286a3;hb=92dd6d4d1179ba5ddb7b9693b4491b940f0db911;hp=19b2c5f007bf55270fff1ae5b460744398866ddb;hpb=5ca0e06429861149372d2e3b4bab3cabac529d70;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index 19b2c5f..ffd2579 100644 --- a/mime-view.el +++ b/mime-view.el @@ -27,8 +27,7 @@ ;;; Code: -(require 'std11) -(require 'mime-lib) +(require 'mime) (require 'semi-def) (require 'calist) (require 'alist) @@ -71,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) @@ -89,35 +78,9 @@ 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. If optional argument MESSAGE-INFO is not specified, @@ -175,17 +138,6 @@ mother-buffer." ;;; @ entity information ;;; -(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) @@ -218,42 +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) - (let ((ret (mime-entity-content-disposition entity))) - (and ret - (setq ret (mime-content-disposition-filename ret)) - (std11-strip-quoted-string ret) - )) - (let ((ret (mime-entity-content-type entity))) - (and ret - (setq ret - (cdr - (let ((param (mime-content-type-parameters ret))) - (or (assoc "name" param) - (assoc "x-name" param)) - ))) - (std11-strip-quoted-string ret) - )) - )) - (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) "")) @@ -547,10 +466,11 @@ Each elements are regexp of field-name.") MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." :group 'mime-view :type '(repeat (cons (choice :tag "Media-Type" - (item :tag "Type/Subtype" - (cons symbol symbol)) - (item :tag "Type" symbol) - (item :tag "Default" t)) + (cons :tag "Type/Subtype" + (symbol :tag "Primary-type") + (symbol :tag "Subtype")) + (symbol :tag "Type") + (const :tag "Default" t)) integer))) (defun mime-display-multipart/alternative (entity situation) @@ -680,7 +600,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 @@ -715,38 +642,6 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." '("From")) -;;; @ X-Face -;;; - -;; hack from Gnus 5.0.4. - -(defvar mime-view-x-face-to-pbm-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm") - -(defvar mime-view-x-face-command - (concat mime-view-x-face-to-pbm-command - " | xv -quit -") - "String to be executed to display an X-Face field. -The command will be executed in a sub-shell asynchronously. -The compressed face will be piped to this command.") - -(defun mime-view-x-face-function () - "Function to display X-Face field. You can redefine to customize." - ;; 1995/10/12 (c.f. tm-eng:130) - ;; fixed by Eric Ding - (save-restriction - (narrow-to-region (point-min) (re-search-forward "^$" nil t)) - ;; end - (goto-char (point-min)) - (if (re-search-forward "^X-Face:[ \t]*" nil t) - (let ((beg (match-end 0)) - (end (std11-field-end)) - ) - (call-process-region beg end "sh" nil 0 nil - "-c" mime-view-x-face-command) - )))) - - ;;; @ buffer setup ;;; @@ -785,15 +680,9 @@ The compressed face will be piped to this command.") (when header-is-visible (if header-presentation-method (funcall header-presentation-method entity situation) - (mime-insert-decoded-header - entity - mime-view-ignored-field-list mime-view-visible-field-list - (save-excursion - (set-buffer raw-buffer) - (if (eq (cdr (assq major-mode mime-raw-representation-type-alist)) - 'binary) - default-mime-charset) - ))) + (mime-insert-decoded-header entity + mime-view-ignored-field-list + mime-view-visible-field-list)) (goto-char (point-max)) (insert "\n") (run-hooks 'mime-display-header-hook) @@ -838,7 +727,6 @@ The compressed face will be piped to this command.") (play "Play current entity" mime-preview-play-current-entity) (extract "Extract current entity" mime-preview-extract-current-entity) (print "Print current entity" mime-preview-print-current-entity) - (x-face "Show X Face" mime-preview-display-x-face) ) "Menu for MIME Viewer") @@ -970,10 +858,9 @@ The compressed face will be piped to this command.") (setq preview-buffer (concat "*Preview-" (buffer-name raw-buffer) "*"))) (set-buffer raw-buffer) - (mime-parse-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) @@ -996,19 +883,47 @@ The compressed face will be piped to this command.") (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 @@ -1037,13 +952,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 @@ -1052,22 +981,22 @@ button-2 Move to point under the mouse cursor (autoload 'mime-preview-play-current-entity "mime-play" "Play current entity." t) -(defun mime-preview-extract-current-entity () +(defun mime-preview-extract-current-entity (&optional ignore-examples) "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-acting-condition'." - (interactive) - (mime-preview-play-current-entity "extract") + (interactive "P") + (mime-preview-play-current-entity ignore-examples "extract") ) -(defun mime-preview-print-current-entity () +(defun mime-preview-print-current-entity (&optional ignore-examples) "Print current entity (maybe). It decodes current entity to call internal or external method as \"print\" mode. The method is selected from variable `mime-acting-condition'." - (interactive) - (mime-preview-play-current-entity "print") + (interactive "P") + (mime-preview-play-current-entity ignore-examples "print") ) @@ -1148,9 +1077,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) @@ -1203,17 +1131,6 @@ It calls following-method selected from variable )))) -;;; @@ X-Face -;;; - -(defun mime-preview-display-x-face () - (interactive) - (save-window-excursion - (set-buffer mime-raw-buffer) - (mime-view-x-face-function) - )) - - ;;; @@ moving ;;; @@ -1226,9 +1143,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