X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=a2531e6dabaf8f97b005fbb7328a3ff543c695b5;hb=773c4a97e7e7a5f71b3e93677788640aa11ebd78;hp=9bc32628f928fd08dddd802304379e6ca4d33bef;hpb=316db6586eca55b79e02b785559ef5f9bce7bf33;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index 9bc3262..a2531e6 100644 --- a/mime-view.el +++ b/mime-view.el @@ -134,10 +134,6 @@ message/partial, it is called `mother-buffer'.") "Raw buffer corresponding with the (MIME-preview) buffer.") (make-variable-buffer-local 'mime-raw-buffer) -(defvar mime-preview-original-major-mode nil - "Major-mode of mime-raw-buffer.") -(make-variable-buffer-local 'mime-preview-original-major-mode) - (defvar mime-preview-original-window-configuration nil "Window-configuration before mime-view-mode is called.") (make-variable-buffer-local 'mime-preview-original-window-configuration) @@ -189,17 +185,6 @@ If optional argument MESSAGE-INFO is not specified, (setq children (cdr children))) message-info)))) -(defsubst mime-raw-point-to-entity-node-id (point &optional message-info) - "Return entity-node-id from POINT in mime-raw-buffer. -If optional argument MESSAGE-INFO is not specified, -`mime-raw-message-info' is used." - (mime-entity-node-id (mime-raw-find-entity-from-point point message-info))) - -(defsubst mime-raw-point-to-entity-number (point &optional message-info) - "Return entity-number from POINT in mime-raw-buffer. -If optional argument MESSAGE-INFO is not specified, -`mime-raw-message-info' is used." - (reverse (mime-raw-point-to-entity-node-id point message-info))) (defsubst mime-entity-parent (entity &optional message-info) "Return mother entity of ENTITY. @@ -212,6 +197,62 @@ If optional argument MESSAGE-INFO is not specified, (set-buffer (mime-entity-buffer entity)) mime-raw-message-info)))) +(defsubst mime-entity-situation (entity) + "Return situation of ENTITY." + (append (or (mime-entity-content-type entity) + (make-mime-content-type 'text 'plain)) + (list (cons 'encoding (mime-entity-encoding entity)) + (cons 'major-mode + (save-excursion + (set-buffer (mime-entity-buffer entity)) + major-mode))) + )) + + +(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode")) + +(defun mime-raw-get-uu-filename () + (save-excursion + (if (re-search-forward "^begin [0-9]+ " nil t) + (if (looking-at ".+$") + (buffer-substring (match-beginning 0)(match-end 0)) + )))) + +(defun mime-raw-get-subject (entity) + (or (std11-find-field-body '("Content-Description" "Subject")) + (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) + )) + (if (member (mime-entity-encoding entity) + mime-view-uuencode-encoding-name-list) + (mime-raw-get-uu-filename)) + "")) + + +(defsubst mime-raw-point-to-entity-node-id (point &optional message-info) + "Return entity-node-id from POINT in mime-raw-buffer. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' is used." + (mime-entity-node-id (mime-raw-find-entity-from-point point message-info))) + +(defsubst mime-raw-point-to-entity-number (point &optional message-info) + "Return entity-number from POINT in mime-raw-buffer. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' is used." + (mime-entity-number (mime-raw-find-entity-from-point point message-info))) + (defun mime-raw-flatten-message-info (&optional message-info) "Return list of entity in mime-raw-buffer. If optional argument MESSAGE-INFO is not specified, @@ -510,9 +551,9 @@ Each elements are regexp of field-name.") (while children (mime-view-display-entity (car children) (save-excursion - (set-buffer mime-raw-buffer) + (set-buffer (mime-entity-buffer entity)) mime-raw-message-info) - mime-raw-buffer (current-buffer) + (current-buffer) default-situation) (setq children (cdr children)) ))) @@ -545,13 +586,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (let ((situation (or (ctree-match-calist mime-preview-condition - (append - (or (mime-entity-content-type child) - (make-mime-content-type 'text 'plain)) - (list* (cons 'encoding - (mime-entity-encoding child)) - (cons 'major-mode major-mode) - default-situation))) + (append (mime-entity-situation child) + default-situation)) default-situation))) (if (cdr (assq 'body-presentation-method situation)) (let ((score @@ -578,12 +614,13 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." children))) (setq i 0) (while children - (let ((situation (car situations))) - (mime-view-display-entity (car children) + (let ((child (car children)) + (situation (car situations))) + (mime-view-display-entity child (save-excursion - (set-buffer mime-raw-buffer) + (set-buffer (mime-entity-buffer child)) mime-raw-message-info) - mime-raw-buffer (current-buffer) + (current-buffer) default-situation (if (= i p) situation @@ -782,62 +819,18 @@ The compressed face will be piped to this command.") )))) -;;; @ miscellaneous -;;; - -(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode")) - - ;;; @ buffer setup ;;; -(defvar mime-view-redisplay nil) - -(defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf) - (if ibuf - (progn - (get-buffer ibuf) - (set-buffer ibuf) - )) - (or mime-view-redisplay - (setq mime-raw-message-info (mime-parse-message ctl encoding)) - ) - (let ((message-info mime-raw-message-info) - (the-buf (current-buffer)) - (mode major-mode)) - (or obuf - (setq obuf (concat "*Preview-" (buffer-name the-buf) "*"))) - (set-buffer (get-buffer-create obuf)) - (let ((inhibit-read-only t)) - ;;(setq buffer-read-only nil) - (widen) - (erase-buffer) - (setq mime-raw-buffer the-buf) - (setq mime-preview-original-major-mode mode) - (setq major-mode 'mime-view-mode) - (setq mode-name "MIME-View") - (mime-view-display-entity message-info message-info - the-buf obuf - '((entity-button . invisible) - (header . visible) - )) - (set-buffer-modified-p nil) - ) - (setq buffer-read-only t) - (set-buffer the-buf) - ) - (setq mime-preview-buffer obuf) - ) - -(defun mime-view-display-entity (entity message-info ibuf obuf +(defun mime-view-display-entity (entity message-info obuf default-situation &optional situation) - (let* ((start (mime-entity-point-min entity)) + (let* ((raw-buffer (mime-entity-buffer entity)) + (start (mime-entity-point-min entity)) (end (mime-entity-point-max entity)) - (content-type (mime-entity-content-type entity)) - (encoding (mime-entity-encoding entity)) - end-of-header e nb ne subj) - (set-buffer ibuf) + original-major-mode end-of-header e nb ne subj) + (set-buffer raw-buffer) + (setq original-major-mode major-mode) (goto-char start) (setq end-of-header (if (re-search-forward "^$" nil t) (1+ (match-end 0)) @@ -852,13 +845,8 @@ The compressed face will be piped to this command.") (or situation (setq situation (or (ctree-match-calist mime-preview-condition - (append - (or content-type - (make-mime-content-type - 'text 'plain)) - (list* (cons 'encoding encoding) - (cons 'major-mode major-mode) - default-situation))) + (append (mime-entity-situation entity) + default-situation)) default-situation))) (let ((button-is-invisible (eq (cdr (assq 'entity-button situation)) 'invisible)) @@ -877,8 +865,8 @@ The compressed face will be piped to this command.") (if header-is-visible (save-restriction (narrow-to-region (point)(point)) - (insert-buffer-substring mime-raw-buffer start end-of-header) - (let ((f (cdr (assq mime-preview-original-major-mode + (insert-buffer-substring raw-buffer start end-of-header) + (let ((f (cdr (assq original-major-mode mime-view-content-header-filter-alist)))) (if (functionp f) (funcall f) @@ -890,7 +878,7 @@ The compressed face will be piped to this command.") (let ((body-filter (cdr (assq 'body-filter situation)))) (save-restriction (narrow-to-region (point-max)(point-max)) - (insert-buffer-substring mime-raw-buffer end-of-header end) + (insert-buffer-substring raw-buffer end-of-header end) (funcall body-filter situation) ))) (children) @@ -910,7 +898,6 @@ The compressed face will be piped to this command.") )) (setq ne (point-max)) (widen) - (put-text-property nb ne 'mime-view-raw-buffer ibuf) (put-text-property nb ne 'mime-view-entity entity) (goto-char ne) (if children @@ -920,35 +907,6 @@ The compressed face will be piped to this command.") )) ))) -(defun mime-raw-get-uu-filename () - (save-excursion - (if (re-search-forward "^begin [0-9]+ " nil t) - (if (looking-at ".+$") - (buffer-substring (match-beginning 0)(match-end 0)) - )))) - -(defun mime-raw-get-subject (entity) - (or (std11-find-field-body '("Content-Description" "Subject")) - (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) - )) - (if (member (mime-entity-encoding entity) - mime-view-uuencode-encoding-name-list) - (mime-raw-get-uu-filename)) - "")) - ;;; @ MIME viewer mode ;;; @@ -1086,7 +1044,61 @@ The compressed face will be piped to this command.") (bury-buffer buf) )))) -(defun mime-view-mode (&optional mother ctl encoding ibuf obuf +(defvar mime-view-redisplay nil) + +(defun mime-view-display-message (message &optional preview-buffer + mother default-keymap-or-function) + (mime-maybe-hide-echo-buffer) + (let ((win-conf (current-window-configuration)) + (raw-buffer (mime-entity-buffer message))) + (or preview-buffer + (setq preview-buffer + (concat "*Preview-" (buffer-name raw-buffer) "*"))) + (set-buffer raw-buffer) + (setq mime-raw-message-info (mime-parse-message)) + (setq mime-preview-buffer preview-buffer) + (let ((inhibit-read-only t)) + (switch-to-buffer preview-buffer) + (widen) + (erase-buffer) + (setq mime-raw-buffer raw-buffer) + (if mother + (setq mime-mother-buffer mother) + ) + (setq mime-preview-original-window-configuration win-conf) + (setq major-mode 'mime-view-mode) + (setq mode-name "MIME-View") + (mime-view-display-entity message message + preview-buffer + '((entity-button . invisible) + (header . visible) + )) + (mime-view-define-keymap default-keymap-or-function) + (let ((point + (next-single-property-change (point-min) 'mime-view-entity))) + (if point + (goto-char point) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + )) + (run-hooks 'mime-view-mode-hook) + )) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + ) + +(defun mime-view-buffer (&optional raw-buffer preview-buffer mother + default-keymap-or-function) + (interactive) + (mime-view-display-message + (save-excursion + (if raw-buffer (set-buffer raw-buffer)) + (mime-parse-message) + ) + preview-buffer mother default-keymap-or-function)) + +(defun mime-view-mode (&optional mother ctl encoding + raw-buffer preview-buffer default-keymap-or-function) "Major mode for viewing MIME message. @@ -1112,27 +1124,13 @@ button-2 Move to point under the mouse cursor and decode current content as `play mode' " (interactive) - (mime-maybe-hide-echo-buffer) - (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf)) - (win-conf (current-window-configuration)) - ) - (prog1 - (switch-to-buffer ret) - (setq mime-preview-original-window-configuration win-conf) - (if mother - (progn - (setq mime-mother-buffer mother) - )) - (mime-view-define-keymap default-keymap-or-function) - (let ((point - (next-single-property-change (point-min) 'mime-view-entity))) - (if point - (goto-char point) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - )) - (run-hooks 'mime-view-mode-hook) - ))) + (mime-view-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)) ;;; @@ playing @@ -1163,16 +1161,20 @@ It decodes current entity to call internal or external method as ;;; @@ following ;;; -(defun mime-preview-original-major-mode () +(defun mime-preview-original-major-mode (&optional recursive) "Return major-mode of original buffer. If a current buffer has mime-mother-buffer, return original major-mode of the mother-buffer." - (if mime-mother-buffer + (if (and recursive mime-mother-buffer) (save-excursion (set-buffer mime-mother-buffer) - (mime-preview-original-major-mode) + (mime-preview-original-major-mode recursive) ) - mime-preview-original-major-mode)) + (save-excursion + (set-buffer + (mime-entity-buffer + (get-text-property (point-min) 'mime-view-entity))) + major-mode))) (defun mime-preview-follow-current-entity () "Write follow message to current entity. @@ -1230,7 +1232,7 @@ It calls following-method selected from variable (setq p-end (point-max)) )) )) - (let* ((mode (mime-preview-original-major-mode)) + (let* ((mode (mime-preview-original-major-mode 'recursive)) (new-name (format "%s-%s" (buffer-name) (reverse entity-node-id))) new-buf @@ -1356,7 +1358,7 @@ variable `mime-view-over-to-previous-method-alist'." (goto-char (1- point)) (mime-preview-move-to-previous) ) - (let ((f (assq mime-preview-original-major-mode + (let ((f (assq (mime-preview-original-major-mode) mime-view-over-to-previous-method-alist))) (if f (funcall (cdr f)) @@ -1378,7 +1380,7 @@ variable `mime-view-over-to-next-method-alist'." (if (null (get-text-property point 'mime-view-entity)) (mime-preview-move-to-next) )) - (let ((f (assq mime-preview-original-major-mode + (let ((f (assq (mime-preview-original-major-mode) mime-view-over-to-next-method-alist))) (if f (funcall (cdr f)) @@ -1394,7 +1396,7 @@ If reached to (point-max), it calls function registered in variable (setq h (1- (window-height))) ) (if (= (point) (point-max)) - (let ((f (assq mime-preview-original-major-mode + (let ((f (assq (mime-preview-original-major-mode) mime-view-over-to-next-method-alist))) (if f (funcall (cdr f)) @@ -1417,24 +1419,14 @@ If reached to (point-min), it calls function registered in variable (setq h (1- (window-height))) ) (if (= (point) (point-min)) - (let ((f (assq mime-preview-original-major-mode - mime-view-over-to-previous-method-alist))) + (let ((f (assq (mime-preview-original-major-mode) + mime-view-over-to-previous-method-alist))) (if f (funcall (cdr f)) )) - (let (point) - (save-excursion - (catch 'tag - (while (not (bobp)) - (if (setq point - (previous-single-property-change (point) - 'mime-view-entity)) - (throw 'tag t) - ) - (backward-char) - ) - (setq point (point-min)) - )) + (let ((point + (or (previous-single-property-change (point) 'mime-view-entity) + (point-min)))) (forward-line (- h)) (if (< (point) point) (goto-char point) @@ -1459,7 +1451,7 @@ If reached to (point-min), it calls function registered in variable It calls function registered in variable `mime-preview-quitting-method-alist'." (interactive) - (let ((r (assq mime-preview-original-major-mode + (let ((r (assq (mime-preview-original-major-mode) mime-preview-quitting-method-alist))) (if r (funcall (cdr r)) @@ -1470,7 +1462,7 @@ It calls function registered in variable It calls function registered in variable `mime-view-show-summary-method'." (interactive) - (let ((r (assq mime-preview-original-major-mode + (let ((r (assq (mime-preview-original-major-mode) mime-view-show-summary-method))) (if r (funcall (cdr r))