X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-view.el;h=57f070c79c11d945036c4287cb64ec952b2c3179;hb=d52a22861beba8d4eb3c41c6a41601da7c138554;hp=6372b107684a7cdcf35d29ffdf31ff0cd24a07a7;hpb=04c6dc0e53a29e69babe13d6a24efcd4c4ac10d1;p=elisp%2Fsemi.git diff --git a/mime-view.el b/mime-view.el index 6372b10..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.63 $ +;; 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.63 1997-03-17 17:16:17 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)) @@ -339,17 +339,35 @@ Please redefine this function if you want to change default setting." ;;; @@@ 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,7 +394,8 @@ Please redefine this function if you want to change default setting." ;;; @@ 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")) @@ -426,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 ;;; @@ -448,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) ) @@ -469,18 +476,14 @@ 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-view-display-entity (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-view-display-entity (content cinfo ibuf obuf) "Display entity from content-info CONTENT." @@ -535,16 +538,12 @@ The compressed face will be piped to this command.") rcnum cinfo ctype params subj encoding) )) (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) - ))) + (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 @@ -676,24 +675,6 @@ 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 ;;; @@ -764,7 +745,7 @@ The compressed face will be piped to this command.") (define-key mime-view-mode-map "\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 @@ -843,48 +824,22 @@ 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-view-play-current-entity "mime-play" "Play current entity." t) (defun mime-view-extract-current-entity () @@ -905,118 +860,135 @@ It decodes current entity to call internal or external method as (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) @@ -1147,12 +1119,12 @@ If reached to (point-min), it calls function registered in variable ) (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)) )))