;;; mime-view.el --- interactive MIME viewer for GNU Emacs
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Created: 1994/07/13
;; Renamed: 1997/02/19 from tm-view.el
;; Keywords: MIME, multimedia, mail, news
-;; This file is part of SEMI (Sophisticated Emacs MIME Interfaces).
+;; This file is part of SEMI (Sample of Elastic MIME Interfaces).
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;;; Code:
+(require 'emu)
(require 'mime)
(require 'semi-def)
(require 'calist)
;;;
(defconst mime-view-version
- (eval-when-compile
- (concat (mime-product-name mime-user-interface-product) " MIME-View "
- (mapconcat #'number-to-string
- (mime-product-version mime-user-interface-product) ".")
- " (" (mime-product-code-name mime-user-interface-product) ")")))
+ (concat (mime-product-name mime-user-interface-product) " MIME-View "
+ (mapconcat #'number-to-string
+ (mime-product-version mime-user-interface-product) ".")
+ " (" (mime-product-code-name mime-user-interface-product) ")"))
;;; @ variables
;;; @ entity information
;;;
-(defun mime-entity-situation (entity)
+(defun mime-entity-situation (entity &optional situation)
"Return situation of ENTITY."
- (append (or (mime-entity-content-type entity)
- (make-mime-content-type 'text 'plain))
- (let ((d (mime-entity-content-disposition entity)))
- (cons (cons 'disposition-type
- (mime-content-disposition-type d))
- (mapcar (function
- (lambda (param)
- (let ((name (car param)))
- (cons (cond ((string= name "filename")
- 'filename)
- ((string= name "creation-date")
- 'creation-date)
- ((string= name "modification-date")
- 'modification-date)
- ((string= name "read-date")
- 'read-date)
- ((string= name "size")
- 'size)
- (t (cons 'disposition (car param))))
- (cdr param)))))
- (mime-content-disposition-parameters d))
- ))
- (list (cons 'encoding (mime-entity-encoding entity))
- (cons 'major-mode
- (save-excursion
- (set-buffer (mime-entity-buffer entity))
- major-mode)))
- ))
+ (let (rest param name)
+ ;; Content-Type
+ (unless (assq 'type situation)
+ (setq rest (or (mime-entity-content-type entity)
+ (make-mime-content-type 'text 'plain))
+ situation (cons (car rest) situation)
+ rest (cdr rest))
+ )
+ (unless (assq 'subtype situation)
+ (or rest
+ (setq rest (or (cdr (mime-entity-content-type entity))
+ '((subtype . plain)))))
+ (setq situation (cons (car rest) situation)
+ rest (cdr rest))
+ )
+ (while rest
+ (setq param (car rest))
+ (or (assoc (car param) situation)
+ (setq situation (cons param situation)))
+ (setq rest (cdr rest)))
+
+ ;; Content-Disposition
+ (setq rest nil)
+ (unless (assq 'disposition-type situation)
+ (setq rest (mime-entity-content-disposition entity))
+ (if rest
+ (setq situation (cons (cons 'disposition-type
+ (mime-content-disposition-type rest))
+ situation)
+ rest (mime-content-disposition-parameters rest))
+ ))
+ (while rest
+ (setq param (car rest)
+ name (car param))
+ (if (cond ((string= name "filename")
+ (if (assq 'filename situation)
+ nil
+ (setq name 'filename)))
+ ((string= name "creation-date")
+ (if (assq 'creation-date situation)
+ nil
+ (setq name 'creation-date)))
+ ((string= name "modification-date")
+ (if (assq 'modification-date situation)
+ nil
+ (setq name 'modification-date)))
+ ((string= name "read-date")
+ (if (assq 'read-date situation)
+ nil
+ (setq name 'read-date)))
+ ((string= name "size")
+ (if (assq 'size situation)
+ nil
+ (setq name 'size)))
+ (t (setq name (cons 'disposition name))
+ (if (assoc name situation)
+ nil
+ name)))
+ (setq situation
+ (cons (cons name (cdr param))
+ situation)))
+ (setq rest (cdr rest)))
+
+ ;; Content-Transfer-Encoding
+ (or (assq 'encoding situation)
+ (setq situation
+ (cons (cons 'encoding (or (mime-entity-encoding entity)
+ "7bit"))
+ situation)))
+ ;; major-mode
+ (or (assq 'major-mode situation)
+ (setq situation
+ (cons (cons 'major-mode
+ (with-current-buffer (mime-entity-buffer entity)
+ major-mode))
+ situation)))
+
+ situation))
(defun mime-view-entity-title (entity)
(or (mime-read-field 'Content-Description entity)
num subject access-type (cdr server))
(let ((site (cdr (assoc "site" params)))
(dir (cdr (assoc "directory" params)))
+ (url (cdr (assoc "url" params)))
)
- (format "%s %s ([%s] %s:%s)"
- num subject access-type site dir)
+ (if url
+ (format "%s %s ([%s] %s)"
+ num subject access-type url)
+ (format "%s %s ([%s] %s:%s)"
+ num subject access-type site dir))
)))
)
(t
;;; @@@ predicate function
;;;
+(in-calist-package 'mime-view)
+
(defun mime-calist::field-match-method-as-default-rule (calist
field-type field-value)
(let ((s-field (assq field-type calist)))
(setq preview-buffer (current-buffer)))
(let* ((raw-buffer (mime-entity-buffer entity))
(start (mime-entity-point-min entity))
- e nb ne)
+ e nb ne nhb nbb)
(set-buffer raw-buffer)
(goto-char start)
+ (in-calist-package 'mime-view)
(or situation
(setq situation
(or (ctree-match-calist mime-preview-condition
(mime-view-insert-entity-button entity)
))
(when header-is-visible
+ (setq nhb (point))
(if header-presentation-method
(funcall header-presentation-method entity situation)
(mime-insert-header entity
mime-view-ignored-field-list
mime-view-visible-field-list))
+ (run-hooks 'mime-display-header-hook)
+ (put-text-property nhb (point-max) 'mime-view-entity-header entity)
(goto-char (point-max))
(insert "\n")
- (run-hooks 'mime-display-header-hook)
)
+ (setq nbb (point))
(cond (children)
((functionp body-presentation-method)
(funcall body-presentation-method entity situation)
(setq ne (point-max))
(widen)
(put-text-property nb ne 'mime-view-entity entity)
+ (put-text-property nbb ne 'mime-view-entity-body entity)
(goto-char ne)
(if children
(if (functionp body-presentation-method)
(defvar mime-view-redisplay nil)
+;;;###autoload
(defun mime-display-message (message &optional preview-buffer
mother default-keymap-or-function)
+ "View MESSAGE in MIME-View mode.
+
+Optional argument PREVIEW-BUFFER specifies the buffer of the
+presentation. It must be either nil or a name of preview buffer.
+
+Optional argument MOTHER specifies mother-buffer of the 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."
(mime-maybe-hide-echo-buffer)
(let ((win-conf (current-window-configuration))
(raw-buffer (mime-entity-buffer message)))
)))))
)))
+;;;###autoload
(defun mime-view-buffer (&optional raw-buffer preview-buffer mother
default-keymap-or-function
representation-type)
(let* ((p-beg
(previous-single-property-change (point) 'mime-view-entity))
p-end
+ ph-end
(entity-node-id (mime-entity-node-id entity))
(len (length entity-node-id))
)
(setq p-end (point-max))
))
))
+ (setq ph-end
+ (previous-single-property-change p-end 'mime-view-entity-header))
+ (if (or (null ph-end)
+ (< ph-end p-beg))
+ (setq ph-end p-beg)
+ )
(let* ((mode (mime-preview-original-major-mode 'recursive))
(new-name
(format "%s-%s" (buffer-name) (reverse entity-node-id)))
(save-excursion
(set-buffer (setq new-buf (get-buffer-create new-name)))
(erase-buffer)
- (insert-buffer-substring the-buf p-beg p-end)
+ (insert-buffer-substring the-buf ph-end p-end)
+ (when (= ph-end p-beg)
+ (goto-char (point-min))
+ (insert ?\n))
(goto-char (point-min))
(let ((entity-node-id (mime-entity-node-id entity)) ci str)
(while (progn
(concat "^"
(apply (function regexp-or) fields)
":") ""))))
- (if (and
- (eq (mime-entity-media-type ci) 'message)
- (eq (mime-entity-media-subtype ci) 'rfc822))
+ (if (and (eq (mime-entity-media-type ci) 'message)
+ (eq (mime-entity-media-subtype ci) 'rfc822))
nil
(if str
(insert str)
If there is no previous entity, it calls function registered in
variable `mime-preview-over-to-next-method-alist'."
(interactive)
- (while (null (get-text-property (point) 'mime-view-entity))
+ (while (and (not (eobp))
+ (null (get-text-property (point) 'mime-view-entity)))
(forward-char)
)
(let ((point (next-single-property-change (point) 'mime-view-entity)))
projects / elisp / semi.git / blobdiff