X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=57f070c79c11d945036c4287cb64ec952b2c3179;hb=d52a22861beba8d4eb3c41c6a41601da7c138554;hp=72a96dc76e65d71e8a21841ff461b55f4de5d0b1;hpb=748dacd65438fe626738cdbb433efb791db98ed2;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index 72a96dc..57f070c 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.28 $ +;; Version: $Revision: 0.72 $ ;; 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.28 1997-03-17 04:43:29 morioka Exp $") + "$Id: mime-view.el,v 0.72 1997-03-18 14:40:11 morioka Exp $") (defconst mime-view-version (get-version-string mime-view-RCS-ID)) @@ -113,6 +113,10 @@ ;; (method "xterm" nil ;; "-e" "showexternal" ;; 'file '"access-type" '"name" '"site" '"directory")) + ((type . "message/external-body") + ("access-type" . "anon-ftp") + (method . mime-article/decode-message/external-ftp) + ) ((type . "message/rfc822") (method . mime-article/view-message/rfc822) (mode . "play") @@ -121,10 +125,6 @@ (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") @@ -148,9 +148,6 @@ "*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-ignored-ctype-list - '("application/x-selection")) - (defvar mime-view-content-button-visible-ctype-list '("application/pgp")) @@ -170,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) @@ -197,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) @@ -228,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 @@ -260,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) ) @@ -334,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") @@ -353,17 +339,35 @@ Each elements are regexp of field-name. [mime-view.el]") ;;; @@@ in raw buffer ;;; +(defvar mime::article/content-info + "Information about structure of message. +Please use reference function `mime::content-info/SLOT-NAME' to +reference slot of content-info. Their argument is only content-info. + +Following is a list of slots of the structure: + +rcnum reversed content-number (list) +point-min beginning point of region in raw-buffer +point-max end point of region in raw-buffer +type media-type/subtype (string or nil) +parameters parameter of Content-Type field (association list) +encoding Content-Transfer-Encoding (string or nil) +children entities included in this entity (list of content-infos) + +If a entity includes other entities in its body, such as multipart or +message/rfc822, content-infos of other entities are included in +`children', so content-info become a tree.") (make-variable-buffer-local 'mime::article/content-info) -(defvar mime::article/preview-buffer nil) -(make-variable-buffer-local 'mime::article/preview-buffer) +(defvar mime-view-buffer nil + "MIME View buffer corresponding with the buffer.") +(make-variable-buffer-local 'mime-view-buffer) ;;; @@@ 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) @@ -376,19 +380,22 @@ 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) -(defvar mime-view-show-summary-method nil) +(defvar mime-view-show-summary-method nil + "Alist of major-mode vs. show-summary-method.") ;;; @@ following method ;;; -(defvar mime-view-following-method-alist nil) +(defvar mime-view-following-method-alist nil + "Alist of major-mode vs. following-method of mime-view.") (defvar mime-view-following-required-fields-list '("From")) @@ -438,16 +445,6 @@ The compressed face will be piped to this command.") mime::preview/original-major-mode)) -;;; @ data structures -;;; - -;;; @@ preview-content-info -;;; - -(define-structure mime::preview-content-info - point-min point-max buffer content-info) - - ;;; @ buffer setup ;;; @@ -460,14 +457,12 @@ The compressed face will be piped to this command.") (or mime-view-redisplay (setq mime::article/content-info (mime-parse-message ctl encoding)) ) - (let ((ret (mime-view-make-preview-buffer obuf))) - (setq mime::article/preview-buffer (car ret)) - ret)) + (setq mime-view-buffer (mime-view-make-preview-buffer obuf)) + ) (defun mime-view-make-preview-buffer (&optional obuf) (let* ((cinfo mime::article/content-info) (pcl (mime/flatten-content-info cinfo)) - (dest (make-list (length pcl) nil)) (the-buf (current-buffer)) (mode major-mode) ) @@ -481,20 +476,17 @@ The compressed face will be piped to this command.") (setq mime::preview/original-major-mode mode) (setq major-mode 'mime-view-mode) (setq mode-name "MIME-View") - (let ((drest dest)) - (while pcl - (setcar drest - (mime-preview/display-content (car pcl) cinfo the-buf obuf)) - (setq pcl (cdr pcl) - drest (cdr drest)) - )) + (while pcl + (mime-view-display-entity (car pcl) cinfo the-buf obuf) + (setq pcl (cdr pcl)) + ) (set-buffer-modified-p nil) (setq buffer-read-only t) (set-buffer the-buf) - (list obuf dest) - )) + obuf)) -(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)) @@ -519,9 +511,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) @@ -529,7 +520,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) @@ -543,18 +534,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) - (prog1 - (progn - (setq ne (point-max)) - (widen) - (mime::preview-content-info/create nb (1- ne) ibuf content) - ) - (goto-char ne) - ))) + (mime-view-entity-separator-function rcnum cinfo ctype params subj) + (setq ne (point-max)) + (widen) + (put-text-property nb ne 'mime-view-raw-buffer ibuf) + (put-text-property nb ne 'mime-view-cinfo content) + (goto-char ne) + )) (defun mime-preview/display-header (beg end) (save-restriction @@ -591,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) @@ -686,38 +675,20 @@ The compressed face will be piped to this command.") ) dest)) -(defun mime-preview/point-pcinfo (p &optional pcl) - (or pcl - (setq pcl mime::preview/content-list) - ) - (catch 'tag - (let ((r pcl) cell) - (while r - (setq cell (car r)) - (if (and (<= (mime::preview-content-info/point-min cell) p) - (<= p (mime::preview-content-info/point-max cell)) - ) - (throw 'tag cell) - ) - (setq r (cdr r)) - )) - (car (last pcl)) - )) - ;;; @ MIME viewer mode ;;; (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) - (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) + '((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-entity) + (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") @@ -748,33 +719,33 @@ 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)) + "\M- " (function mime-view-scroll-down-entity)) (define-key mime-view-mode-map - "\177" (function mime-view-scroll-down-content)) + "\177" (function mime-view-scroll-down-entity)) (define-key mime-view-mode-map "\C-m" (function mime-view-next-line-content)) (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)) + "a" (function mime-view-follow-current-entity)) (define-key mime-view-mode-map "q" (function mime-view-quit)) (define-key mime-view-mode-map @@ -853,179 +824,171 @@ button-2 Move to point under the mouse cursor (win-conf (current-window-configuration)) ) (prog1 - (switch-to-buffer (car ret)) + (switch-to-buffer ret) (setq mime::preview/original-window-configuration win-conf) (if mother (progn (setq mime::preview/mother-buffer mother) )) (mime-view-define-keymap default-keymap-or-function) - (setq mime::preview/content-list (nth 1 ret)) - (goto-char - (let ((ce (mime::preview-content-info/point-max - (car mime::preview/content-list) - )) - e) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (setq e (match-end 0)) - (if (<= e ce) - e - ce))) + (let ((point (next-single-property-change (point-min) 'mime-view-cinfo))) + (if point + (goto-char point) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + )) (run-hooks 'mime-view-mode-hook) ))) -(defun mime-preview/point-content-number (point) - (save-window-excursion - (let ((pc (mime-preview/point-pcinfo (point))) - cinfo) - (switch-to-buffer (mime::preview-content-info/buffer pc)) - (setq cinfo (mime::preview-content-info/content-info pc)) - (mime-article/point-content-number (mime::content-info/point-min cinfo)) - ))) - -(defun mime-preview/cinfo-to-pcinfo (cinfo) - (let ((rpcl mime::preview/content-list) cell) - (catch 'tag - (while rpcl - (setq cell (car rpcl)) - (if (eq cinfo (mime::preview-content-info/content-info cell)) - (throw 'tag cell) - ) - (setq rpcl (cdr rpcl)) - )))) - -(autoload 'mime-preview/decode-content "mime-play") - -(defvar mime-view-decoding-mode "play" "MIME body decoding mode") - -(defun mime-view-play-content () - (interactive) - (mime-preview/decode-content "play") - ) +(autoload 'mime-view-play-current-entity "mime-play" "Play current entity." t) -(defun mime-view-extract-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) - (mime-preview/decode-content "extract") + (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) - (mime-preview/decode-content "print") + (mime-view-play-current-entity "print") ) -(defun mime-view-follow-content () +(defun mime-view-follow-current-entity () + "Write follow message to current entity. +It calls following-method selected from variable +`mime-view-following-method-alist'." (interactive) - (let ((root-cinfo - (mime::preview-content-info/content-info - (car mime::preview/content-list))) - pc p-beg p-end cinfo rcnum) - (let ((rest mime::preview/content-list) - b e cell len rc) - (if (catch 'tag - (while (setq cell (car rest)) - (setq b (mime::preview-content-info/point-min cell) - e (mime::preview-content-info/point-max cell)) - (setq rest (cdr rest)) - (if (and (<= b (point))(<= (point) e)) - (throw 'tag cell) - ) - )) - (progn - (setq pc cell - cinfo (mime::preview-content-info/content-info pc) - rcnum (mime::content-info/rcnum cinfo)) - (setq len (length rcnum)) - (setq p-beg (mime::preview-content-info/point-min pc) - p-end (mime::preview-content-info/point-max pc)) - (while (and (setq cell (car rest)) - (progn - (setq rc - (mime::content-info/rcnum - (mime::preview-content-info/content-info - cell))) - (equal rcnum - (nthcdr (- (length rc) len) rc)) - )) - (setq p-end (mime::preview-content-info/point-max cell)) - (setq rest (cdr rest)) - )))) - (if pc - (let* ((mode (mime-preview/get-original-major-mode)) - (new-name (format "%s-%s" (buffer-name) (reverse rcnum))) - new-buf - (the-buf (current-buffer)) - (a-buf mime::preview/article-buffer) - fields) - (save-excursion - (set-buffer (setq new-buf (get-buffer-create new-name))) - (erase-buffer) - (insert-buffer-substring the-buf p-beg p-end) - (goto-char (point-min)) - (if (mime-view-header-visible-p rcnum root-cinfo) - (delete-region (goto-char (point-min)) - (if (re-search-forward "^$" nil t) - (match-end 0) - (point-min))) - ) - (goto-char (point-min)) - (insert "\n") - (goto-char (point-min)) - (let ((rcnum (mime::content-info/rcnum cinfo)) ci str) - (while (progn - (setq str - (save-excursion - (set-buffer a-buf) - (setq ci (mime-article/rcnum-to-cinfo rcnum)) - (save-restriction - (narrow-to-region - (mime::content-info/point-min ci) - (mime::content-info/point-max ci) - ) - (std11-header-string-except - (concat "^" - (apply (function regexp-or) fields) - ":") "")))) - (if (string= (mime::content-info/type ci) - "message/rfc822") - nil - (if str - (insert str) - ) - rcnum)) - (setq fields (std11-collect-field-names) - rcnum (cdr rcnum)) - ) + (let ((root-cinfo (get-text-property (point-min) 'mime-view-cinfo)) + cinfo) + (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo))) + (backward-char) + ) + (let* ((p-beg (previous-single-property-change (point) 'mime-view-cinfo)) + p-end + (rcnum (mime::content-info/rcnum cinfo)) + (len (length rcnum)) + rc) + (cond ((null p-beg) + (setq p-beg + (if (eq (next-single-property-change (point-min) + 'mime-view-cinfo) + (point)) + (point) + (point-min))) + ) + ((eq (next-single-property-change p-beg 'mime-view-cinfo) + (point)) + (setq p-beg (point)) + )) + (setq p-end (next-single-property-change p-beg 'mime-view-cinfo)) + (cond ((null p-end) + (setq p-end (point-max)) + ) + ((null rcnum) + (setq p-end (point-max)) + ) + (t + (save-excursion + (goto-char p-end) + (catch 'tag + (let (e) + (while (setq e + (next-single-property-change + (point) 'mime-view-cinfo)) + (goto-char e) + (let ((rc (mime::content-info/rcnum + (get-text-property (point) + 'mime-view-cinfo)))) + (or (equal rcnum (nthcdr (- (length rc) len) rc)) + (throw 'tag nil) + )) + (setq p-end e) + )) + (setq p-end (point-max)) + )) + )) + (let* ((mode (mime-preview/get-original-major-mode)) + (new-name (format "%s-%s" (buffer-name) (reverse rcnum))) + new-buf + (the-buf (current-buffer)) + (a-buf mime::preview/article-buffer) + fields) + (save-excursion + (set-buffer (setq new-buf (get-buffer-create new-name))) + (erase-buffer) + (insert-buffer-substring the-buf p-beg p-end) + (goto-char (point-min)) + (if (mime-view-header-visible-p rcnum root-cinfo) + (delete-region (goto-char (point-min)) + (if (re-search-forward "^$" nil t) + (match-end 0) + (point-min))) + ) + (goto-char (point-min)) + (insert "\n") + (goto-char (point-min)) + (let ((rcnum (mime::content-info/rcnum cinfo)) ci str) + (while (progn + (setq str + (save-excursion + (set-buffer a-buf) + (setq ci (mime-article/rcnum-to-cinfo rcnum)) + (save-restriction + (narrow-to-region + (mime::content-info/point-min ci) + (mime::content-info/point-max ci) + ) + (std11-header-string-except + (concat "^" + (apply (function regexp-or) fields) + ":") "")))) + (if (string= (mime::content-info/type ci) + "message/rfc822") + nil + (if str + (insert str) + ) + rcnum)) + (setq fields (std11-collect-field-names) + rcnum (cdr rcnum)) ) - (let ((rest mime-view-following-required-fields-list)) - (while rest - (let ((field-name (car rest))) - (or (std11-field-body field-name) - (insert - (format - (concat field-name - ": " - (save-excursion - (set-buffer the-buf) - (set-buffer mime::preview/mother-buffer) - (set-buffer mime::preview/article-buffer) - (std11-field-body field-name) - ) - "\n"))) - )) - (setq rest (cdr rest)) - )) - (eword-decode-header) ) - (let ((f (cdr (assq mode mime-view-following-method-alist)))) - (if (functionp f) - (funcall f new-buf) - (message - (format - "Sorry, following method for %s is not implemented yet." - mode)) + (let ((rest mime-view-following-required-fields-list)) + (while rest + (let ((field-name (car rest))) + (or (std11-field-body field-name) + (insert + (format + (concat field-name + ": " + (save-excursion + (set-buffer the-buf) + (set-buffer mime::preview/mother-buffer) + (set-buffer mime::preview/article-buffer) + (std11-field-body field-name) + ) + "\n"))) + )) + (setq rest (cdr rest)) )) - )))) + (eword-decode-header) + ) + (let ((f (cdr (assq mode mime-view-following-method-alist)))) + (if (functionp f) + (funcall f new-buf) + (message + (format + "Sorry, following method for %s is not implemented yet." + mode)) + )) + )))) (defun mime-view-display-x-face () (interactive) @@ -1034,77 +997,69 @@ 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. +If reached to (point-max), it calls function registered in variable +`mime-view-over-to-next-method-alist'." (interactive) (or h - (setq h (- (window-height) 1)) + (setq h (1- (window-height))) ) (if (= (point) (point-max)) (let ((f (assq mime::preview/original-major-mode @@ -1112,31 +1067,22 @@ button-2 Move to point under the mouse cursor (if f (funcall (cdr f)) )) - (let ((pcl mime::preview/content-list) - (p (point)) - np beg) - (setq np - (or (catch 'tag - (while pcl - (setq beg (mime::preview-content-info/point-min (car pcl))) - (if (< p beg) - (throw 'tag beg) - ) - (setq pcl (cdr pcl)) - )) - (point-max))) + (let ((point + (or (next-single-property-change (point) 'mime-view-cinfo) + (point-max)))) (forward-line h) - (if (> (point) np) - (goto-char np) + (if (> (point) point) + (goto-char point) ) - ;;(show-subtree) - )) - ) + ))) -(defun mime-view-scroll-down-content (&optional h) +(defun mime-view-scroll-down-entity (&optional h) + "Scroll down current entity. +If reached to (point-min), it calls function registered in variable +`mime-view-over-to-previous-method-alist'." (interactive) (or h - (setq h (- (window-height) 1)) + (setq h (1- (window-height))) ) (if (= (point) (point-min)) (let ((f (assq mime::preview/original-major-mode @@ -1144,57 +1090,52 @@ button-2 Move to point under the mouse cursor (if f (funcall (cdr f)) )) - (let ((pcl mime::preview/content-list) - (p (point)) - pp beg) - (setq pp - (or (let ((i (- (length pcl) 1))) - (catch 'tag - (while (> i 0) - (setq beg (mime::preview-content-info/point-min - (nth i pcl))) - (if (> p beg) - (throw 'tag beg) - ) - (setq i (- i 1)) - ))) - (point-min))) + (let (point) + (save-excursion + (catch 'tag + (while (> (point) 1) + (if (setq point + (previous-single-property-change (point) + 'mime-view-cinfo)) + (throw 'tag t) + ) + (backward-char) + ) + (setq point (point-min)) + )) (forward-line (- h)) - (if (< (point) pp) - (goto-char pp) - ))) - ) + (if (< (point) point) + (goto-char point) + )))) (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 () (interactive) - (mime-view-scroll-down-content 1) + (mime-view-scroll-down-entity 1) ) (defun mime-view-quit () + "Quit from MIME-View buffer. +It calls function registered in variable +`mime-view-quitting-method-alist'." (interactive) - (let ((r (save-excursion - (set-buffer (mime::preview-content-info/buffer - (mime-preview/point-pcinfo (point)))) - (assq major-mode mime-view-quitting-method-alist) - ))) + (let ((r (assq mime::preview/original-major-mode + mime-view-quitting-method-alist))) (if r (funcall (cdr r)) ))) (defun mime-view-show-summary () + "Show summary. +It calls function registered in variable +`mime-view-show-summary-method'." (interactive) - (let ((r (save-excursion - (set-buffer - (mime::preview-content-info/buffer - (mime-preview/point-pcinfo (point))) - ) - (assq major-mode mime-view-show-summary-method) - ))) + (let ((r (assq mime::preview/original-major-mode + mime-view-show-summary-method))) (if r (funcall (cdr r)) )))