;;; 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)
;;; @ version
;;;
-(defconst mime-view-version-string
- `,(concat (car mime-user-interface-version) " MIME-View "
- (mapconcat #'number-to-string
- (cddr mime-user-interface-version) ".")
- " (" (cadr mime-user-interface-version) ")"))
+(defconst mime-view-version
+ (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
Interface of FUNCTION must be (ENTITY SITUATION).")
(defvar mime-view-ignored-field-list
- '(".*Received" ".*Path" ".*Id" "References"
- "Replied" "Errors-To"
- "Lines" "Sender" ".*Host" "Xref"
- "Content-Type" "Precedence"
- "Status" "X-VM-.*")
+ '(".*Received:" ".*Path:" ".*Id:" "^References:"
+ "^Replied:" "^Errors-To:"
+ "^Lines:" "^Sender:" ".*Host:" "^Xref:"
+ "^Content-Type:" "^Precedence:"
+ "^Status:" "^X-VM-.*:")
"All fields that match this list will be hidden in MIME preview buffer.
Each elements are regexp of field-name.")
-(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.")
;;; @@@ entity presentation
;;;
-(autoload 'mime-display-text/plain "mime-text")
-(autoload 'mime-display-text/enriched "mime-text")
-(autoload 'mime-display-text/richtext "mime-text")
+(defun mime-display-text/plain (entity situation)
+ (save-restriction
+ (narrow-to-region (point-max)(point-max))
+ (mime-insert-text-content entity)
+ (run-hooks 'mime-text-decode-hook)
+ (goto-char (point-max))
+ (if (not (eq (char-after (1- (point))) ?\n))
+ (insert "\n")
+ )
+ (mime-add-url-buttons)
+ (run-hooks 'mime-display-text/plain-hook)
+ ))
+
+(defun mime-display-text/richtext (entity situation)
+ (save-restriction
+ (narrow-to-region (point-max)(point-max))
+ (mime-insert-text-content entity)
+ (run-hooks 'mime-text-decode-hook)
+ (let ((beg (point-min)))
+ (remove-text-properties beg (point-max) '(face nil))
+ (richtext-decode beg (point-max))
+ )))
+
+(defun mime-display-text/enriched (entity situation)
+ (save-restriction
+ (narrow-to-region (point-max)(point-max))
+ (mime-insert-text-content entity)
+ (run-hooks 'mime-text-decode-hook)
+ (let ((beg (point-min)))
+ (remove-text-properties beg (point-max) '(face nil))
+ (enriched-decode beg (point-max))
+ )))
(defvar mime-view-announcement-for-message/partial
(if (and (>= emacs-major-version 19) window-system)
MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default."
:group 'mime-view
:type '(repeat (cons (choice :tag "Media-Type"
- (item :tag "Type/Subtype"
- (cons symbol symbol))
- (item :tag "Type" symbol)
- (item :tag "Default" t))
+ (cons :tag "Type/Subtype"
+ (symbol :tag "Primary-type")
+ (symbol :tag "Subtype"))
+ (symbol :tag "Type")
+ (const :tag "Default" t))
integer)))
(defun mime-display-multipart/alternative (entity situation)
(when header-is-visible
(if header-presentation-method
(funcall header-presentation-method entity situation)
- (mime-insert-decoded-header entity
- mime-view-ignored-field-list
- mime-view-visible-field-list))
+ (mime-insert-header entity
+ mime-view-ignored-field-list
+ mime-view-visible-field-list))
(goto-char (point-max))
(insert "\n")
(run-hooks 'mime-display-header-hook)
)
"Menu for MIME Viewer")
-(cond (running-xemacs
+(cond ((featurep 'xemacs)
(defvar mime-view-xemacs-popup-menu
(cons mime-view-menu-title
(mapcar (function
(define-key mime-view-mode-map
[backspace] (function mime-preview-scroll-down-entity))
(if (functionp default)
- (cond (running-xemacs
+ (cond ((featurep 'xemacs)
(set-keymap-default-binding mime-view-mode-map default)
)
(t
(define-key mime-view-mode-map
mouse-button-2 (function mime-button-dispatcher))
)
- (cond (running-xemacs
+ (cond ((featurep 'xemacs)
(define-key mime-view-mode-map
mouse-button-3 (function mime-view-xemacs-popup-menu))
)
keymap of MIME-View mode.
Optional argument REPRESENTATION-TYPE is representation-type of
message. It must be nil, `binary' or `cooked'. If it is nil,
-`binary' is used as default."
+`cooked' is used as default."
(interactive)
(or raw-buffer
(setq raw-buffer (current-buffer)))
))
(setq rest (cdr rest))
))
- (eword-decode-header)
+ (mime-decode-header-in-buffer)
)
(let ((f (cdr (assq mode mime-preview-following-method-alist))))
(if (functionp f)
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