;; 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).
;;;
(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))
;;; @@@ 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)
;;; @@ 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"))
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
;;;
(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)
)
(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."
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
)
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
;;;
(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
(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 ()
(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)
)
(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))
)))
projects / elisp / semi.git / blobdiff