+1998-05-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-setup.el: Avoid warning message of byte-compiler.
+
+1998-05-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-view.el (mime-view-setup-buffers): Use
+ 'mime-view-display-entity; abolish 'mime-view-display-message.
+ (mime-view-display-entity): fixed.
+
+1998-05-17 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-view.el (mime-view-display-message): fixed.
+
+1998-05-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-view.el (mime-raw-get-subject): Use
+ 'mime-content-disposition-filename.
+
+ * mime-parse.el (mime-content-type-parameter): New function.
+
+ * mime-parse.el (mime-content-disposition-parameter): New
+ function.
+ (mime-content-disposition-filename): New function.
+
+1998-05-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-play.el (mime-raw-get-original-filename): Abolish optional
+ argument 'encoding; modify for 'mime-raw-get-uu-filename.
+
+ * mime-view.el (mime-raw-get-uu-filename): Change interface; don't
+ check encoding.
+ (mime-raw-get-subject): Change interface; new implementation.
+
+1998-05-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-view.el (mime-view-display-entity): fixed.
+
+ * mime-parse.el (mime-parse-multipart): Change interface.
+
+1998-05-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-parse.el (make-mime-entity): Add 'content-disposition.
+ (mime-entity-content-disposition): New function.
+ (mime-parse-multipart): Modify for 'make-mime-entity.
+ (mime-parse-message): Modify for 'make-mime-entity.
+
+1998-05-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-play.el (mime-raw-play-entity): Don't use
+ 'mime-entity-media-type, 'mime-entity-media-subtype and
+ 'mime-entity-parameters.
+
+1998-05-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-view.el (mime-view-display-entity): Don't use
+ 'mime-entity-media-type, 'mime-entity-media-subtype and
+ 'mime-entity-parameters.
+
+1998-05-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-view.el (mime-view-display-message): Don't use
+ 'mime-entity-media-type, 'mime-entity-media-subtype and
+ 'mime-entity-parameters.
+
+1998-05-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-play.el (mime-mailcap-method-filename-alist): New variable.
+ (mime-mailcap-method-sentinel): New function.
+ (mime-activate-mailcap-method): Use 'mime-mailcap-method-sentinel;
+ don't use 'mime-show-echo-buffer.
+
+1998-05-14 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-play.el (mime-activate-mailcap-method): Regard
+ 'mime-temp-directory.
+
+1998-05-14 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-parse.el (make-mime-entity): Change interface and
+ data-format.
+ (mime-entity-content-type): New access function.
+ (mime-entity-media-type): New implementation.
+ (mime-entity-subtype): New implementation.
+ (mime-entity-parameters): New implementation.
+ (mime-parse-multipart): Change interface; modify for
+ 'make-mime-entity.
+ (mime-parse-message): Modify for 'make-mime-entity.
+
+\f
1998-05-13 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* WEMI: Version 1.4.3 (Hiratsuka) released.
"Return primary-type of CONTENT-TYPE."
(cddr content-type))
+(defsubst mime-content-type-parameter (content-type parameter)
+ "Return PARAMETER value of CONTENT-TYPE."
+ (cdr (assoc parameter (mime-content-type-parameters content-type))))
+
;;; @ Content-Disposition
;;;
"Return disposition-parameters of CONTENT-DISPOSITION."
(cdr content-disposition))
+(defsubst mime-content-disposition-parameter (content-disposition parameter)
+ "Return PARAMETER value of CONTENT-DISPOSITION."
+ (cdr (assoc parameter (cdr content-disposition))))
+
+(defsubst mime-content-disposition-filename (content-disposition)
+ "Return filename of CONTENT-DISPOSITION."
+ (mime-content-disposition-parameter content-disposition "filename"))
+
;;; @ Content-Transfer-Encoding
;;;
(defsubst make-mime-entity (node-id
point-min point-max
- media-type media-subtype parameters
- encoding children)
+ content-type content-disposition encoding
+ children)
(vector node-id point-min point-max
- media-type media-subtype parameters encoding children))
-
-(defsubst mime-entity-node-id (entity-info) (aref entity-info 0))
-(defsubst mime-entity-point-min (entity-info) (aref entity-info 1))
-(defsubst mime-entity-point-max (entity-info) (aref entity-info 2))
-(defsubst mime-entity-media-type (entity-info) (aref entity-info 3))
-(defsubst mime-entity-media-subtype (entity-info) (aref entity-info 4))
-(defsubst mime-entity-parameters (entity-info) (aref entity-info 5))
-(defsubst mime-entity-encoding (entity-info) (aref entity-info 6))
-(defsubst mime-entity-children (entity-info) (aref entity-info 7))
-
+ content-type content-disposition encoding children))
+
+(defsubst mime-entity-node-id (entity) (aref entity 0))
+(defsubst mime-entity-point-min (entity) (aref entity 1))
+(defsubst mime-entity-point-max (entity) (aref entity 2))
+(defsubst mime-entity-content-type (entity) (aref entity 3))
+(defsubst mime-entity-content-disposition (entity) (aref entity 4))
+(defsubst mime-entity-encoding (entity) (aref entity 5))
+(defsubst mime-entity-children (entity) (aref entity 6))
+
+(defsubst mime-entity-media-type (entity)
+ (mime-content-type-primary-type (mime-entity-content-type entity)))
+(defsubst mime-entity-media-subtype (entity)
+ (mime-content-type-subtype (mime-entity-content-type entity)))
+(defsubst mime-entity-parameters (entity)
+ (mime-content-type-parameters (mime-entity-content-type entity)))
(defsubst mime-entity-type/subtype (entity-info)
(mime-type/subtype-string (mime-entity-media-type entity-info)
(mime-entity-media-subtype entity-info)))
-(defun mime-parse-multipart (boundary primtype subtype params encoding rcnum)
+(defun mime-parse-multipart (content-type content-disposition encoding node-id)
(goto-char (point-min))
- (let* ((dash-boundary (concat "--" boundary))
+ (let* ((dash-boundary
+ (concat "--"
+ (std11-strip-quoted-string
+ (cdr (assoc "boundary"
+ (mime-content-type-parameters content-type))))))
(delimiter (concat "\n" (regexp-quote dash-boundary)))
(close-delimiter (concat delimiter "--[ \t]*$"))
(beg (point-min))
)))
(rsep (concat delimiter "[ \t]*\n"))
(dc-ctl
- (if (eq subtype 'digest)
+ (if (eq (mime-content-type-subtype content-type) 'digest)
(make-mime-content-type 'message 'rfc822)
(make-mime-content-type 'text 'plain)
))
(setq ncb (match-end 0))
(save-restriction
(narrow-to-region cb ce)
- (setq ret (mime-parse-message dc-ctl "7bit" (cons i rcnum)))
+ (setq ret (mime-parse-message dc-ctl "7bit" (cons i node-id)))
)
(setq children (cons ret children))
(goto-char (mime-entity-point-max ret))
(setq ce (point-max))
(save-restriction
(narrow-to-region cb ce)
- (setq ret (mime-parse-message dc-ctl "7bit" (cons i rcnum)))
+ (setq ret (mime-parse-message dc-ctl "7bit" (cons i node-id)))
)
(setq children (cons ret children))
)
- (make-mime-entity rcnum beg (point-max)
- primtype subtype params encoding
+ (make-mime-entity node-id beg (point-max)
+ content-type content-disposition encoding
(nreverse children))
))
-(defun mime-parse-message (&optional default-ctl default-encoding rcnum)
+(defun mime-parse-message (&optional default-ctl default-encoding node-id)
"Parse current-buffer as a MIME message.
DEFAULT-CTL is used when an entity does not have valid Content-Type
field. Its format must be as same as return value of
mime-{parse|read}-Content-Type."
- (setq default-ctl (or (mime-read-Content-Type) default-ctl))
- (let ((primtype (mime-content-type-primary-type default-ctl))
- (subtype (mime-content-type-subtype default-ctl))
- (params (mime-content-type-parameters default-ctl))
- (encoding (mime-read-Content-Transfer-Encoding default-encoding)))
- (let ((boundary (assoc "boundary" params)))
- (cond (boundary
- (setq boundary (std11-strip-quoted-string (cdr boundary)))
- (mime-parse-multipart
- boundary
- primtype subtype params encoding rcnum)
- )
- ((and (eq primtype 'message)
- (memq subtype '(rfc822 news))
- )
- (goto-char (point-min))
- (make-mime-entity rcnum (point-min) (point-max)
- primtype subtype params encoding
- (save-restriction
- (narrow-to-region
- (if (re-search-forward "^$" nil t)
- (1+ (match-end 0))
- (point-min)
- )
- (point-max))
- (list (mime-parse-message
- nil nil (cons 0 rcnum)))
- ))
- )
- (t
- (make-mime-entity rcnum (point-min) (point-max)
- primtype subtype params encoding
- nil)
- ))
- )))
+ (let* ((content-type (or (mime-read-Content-Type) default-ctl))
+ (content-disposition (mime-read-Content-Disposition))
+ (primary-type (mime-content-type-primary-type content-type))
+ (encoding (mime-read-Content-Transfer-Encoding default-encoding)))
+ (cond ((eq primary-type 'multipart)
+ (mime-parse-multipart content-type content-disposition encoding
+ node-id)
+ )
+ ((and (eq primary-type 'message)
+ (memq (mime-content-type-subtype content-type)
+ '(rfc822 news)
+ ))
+ (goto-char (point-min))
+ (make-mime-entity node-id (point-min) (point-max)
+ content-type content-disposition encoding
+ (save-restriction
+ (narrow-to-region
+ (if (re-search-forward "^$" nil t)
+ (1+ (match-end 0))
+ (point-min)
+ )
+ (point-max))
+ (list (mime-parse-message
+ nil nil (cons 0 node-id)))
+ ))
+ )
+ (t
+ (make-mime-entity node-id (point-min) (point-max)
+ content-type content-disposition encoding nil)
+ ))
+ ))
;;; @ utilities
specified, play as it. Default MODE is \"play\"."
(let ((beg (mime-entity-point-min entity-info))
(end (mime-entity-point-max entity-info))
- (c-type (mime-entity-media-type entity-info))
- (c-subtype (mime-entity-media-subtype entity-info))
- (params (mime-entity-parameters entity-info))
- (encoding (mime-entity-encoding entity-info))
- )
- (or c-type
- (setq c-type 'text
- c-subtype 'plain))
+ (content-type (mime-entity-content-type entity-info))
+ (encoding (mime-entity-encoding entity-info)))
+ (or content-type
+ (setq content-type (make-mime-content-type 'text 'plain)))
;; Check for VM
(if (< beg (point-min))
(setq beg (point-min))
(setq end (point-max))
)
(let (method cal ret)
- (setq cal (list* (cons 'type c-type)
- (cons 'subtype c-subtype)
+ (setq cal (list* (cons 'major-mode major-mode)
(cons 'encoding encoding)
- (cons 'major-mode major-mode)
- params))
+ content-type))
(if mode
(setq cal (cons (cons 'mode mode) cal))
)
(t
(mime-show-echo-buffer
"No method are specified for %s\n"
- (mime-type/subtype-string c-type c-subtype))
- ))
- )
- ))
+ (mime-type/subtype-string
+ (mime-content-type-primary-type content-type)
+ (mime-content-type-subtype content-type))
+ )))
+ )))
;;; @ external decoder
;;;
+(defvar mime-mailcap-method-filename-alist nil)
+
(defun mime-activate-mailcap-method (start end situation)
(save-excursion
(save-restriction
(narrow-to-region start end)
(goto-char start)
(let ((method (cdr (assoc 'method situation)))
- (name (mime-raw-get-filename situation)))
+ (name (expand-file-name (mime-raw-get-filename situation)
+ mime-temp-directory)))
(mime-write-decoded-region (if (re-search-forward "^$" end t)
(1+ (match-end 0))
(point-min))
end name
(cdr (assq 'encoding situation)))
(message "External method is starting...")
- (let ((command
- (mailcap-format-command
- method
- (cons (cons 'filename name) situation))))
- (start-process command mime-echo-buffer-name
- shell-file-name shell-command-switch command)
+ (let ((process
+ (let ((command
+ (mailcap-format-command
+ method
+ (cons (cons 'filename name) situation))))
+ (start-process command mime-echo-buffer-name
+ shell-file-name shell-command-switch command)
+ )))
+ (set-alist 'mime-mailcap-method-filename-alist process name)
+ (set-process-sentinel process 'mime-mailcap-method-sentinel)
)
- (mime-show-echo-buffer)
+ ;;(mime-show-echo-buffer)
))))
+(defun mime-mailcap-method-sentinel (process event)
+ (let ((file (cdr (assq process mime-mailcap-method-filename-alist))))
+ (if (file-exists-p file)
+ (delete-file file)
+ ))
+ (remove-alist 'mime-mailcap-method-filename-alist process)
+ (message (format "%s %s" process event)))
+
(defun mime-activate-external-method (beg end cal)
(save-excursion
(save-restriction
(concat (regexp-* mime-view-file-name-char-regexp)
"\\(\\." mime-view-file-name-char-regexp "+\\)*"))
-(defun mime-raw-get-original-filename (param &optional encoding)
- (or (mime-raw-get-uu-filename param encoding)
+(defun mime-raw-get-original-filename (param)
+ (or (if (member (cdr (assq 'encoding param))
+ mime-view-uuencode-encoding-name-list)
+ (mime-raw-get-uu-filename))
(let (ret)
(or (if (or (and (setq ret (mime-read-Content-Disposition))
(setq ret
(load "mail-mime-setup")
-(condition-case err
+(condition-case nil
(load "gnus-mime-setup")
(error (message "gnus-mime-setup is not found."))
)
-(condition-case err
+(condition-case nil
(load "emh-setup")
(error (message "emh-setup is not found."))
)
(setq mime-preview-original-major-mode mode)
(setq major-mode 'mime-view-mode)
(setq mode-name "MIME-View")
- (mime-view-display-message message-info the-buf obuf)
+ (mime-view-display-entity message-info message-info
+ the-buf obuf
+ '((entity-button . invisible)
+ (header . visible)
+ ))
(set-buffer-modified-p nil)
)
(setq buffer-read-only t)
(setq mime-preview-buffer obuf)
)
-(defun mime-view-display-message (message-info ibuf obuf)
- (let* ((start (mime-entity-point-min message-info))
- (end (mime-entity-point-max message-info))
- (media-type (mime-entity-media-type message-info))
- (media-subtype (mime-entity-media-subtype message-info))
- (params (mime-entity-parameters message-info))
- (encoding (mime-entity-encoding message-info))
- end-of-header e nb ne subj)
- (set-buffer ibuf)
- (goto-char start)
- (setq end-of-header (if (re-search-forward "^$" nil t)
- (1+ (match-end 0))
- end))
- (if (> end-of-header end)
- (setq end-of-header end)
- )
- (save-restriction
- (narrow-to-region start end)
- (setq subj
- (eword-decode-string
- (mime-raw-get-subject params encoding)))
- )
- (set-buffer obuf)
- (setq nb (point))
- (narrow-to-region nb nb)
- ;; Insert message-header
- (save-restriction
- (narrow-to-region (point)(point))
- (insert-buffer-substring mime-raw-buffer start end-of-header)
- (let ((f (cdr (assq mime-preview-original-major-mode
- mime-view-content-header-filter-alist))))
- (if (functionp f)
- (funcall f)
- (mime-view-default-content-header-filter)
- ))
- (run-hooks 'mime-view-content-header-filter-hook)
- )
- (let* ((situation
- (ctree-match-calist mime-preview-condition
- (list* (cons 'type media-type)
- (cons 'subtype media-subtype)
- (cons 'encoding encoding)
- (cons 'major-mode major-mode)
- params)))
- (message-button
- (cdr (assq 'message-button situation)))
- (body-presentation-method
- (cdr (assq 'body-presentation-method situation))))
- (when (eq message-button 'visible)
- (goto-char (point-max))
- (mime-view-insert-entity-button message-info message-info subj)
- )
- (cond ((eq body-presentation-method 'with-filter)
- (let ((body-filter (cdr (assq 'body-filter situation))))
- (save-restriction
- (narrow-to-region (point-max)(point-max))
- (insert-buffer-substring mime-raw-buffer end-of-header end)
- (funcall body-filter situation)
- )))
- ((functionp body-presentation-method)
- (funcall body-presentation-method situation)
- )
- ((null (mime-entity-children message-info))
- (goto-char (point-max))
- (mime-view-insert-entity-button message-info message-info subj)
- ))
- (setq ne (point-max))
- (widen)
- (put-text-property nb ne 'mime-view-raw-buffer ibuf)
- (put-text-property nb ne 'mime-view-entity message-info)
- (goto-char ne)
- (let ((children (mime-entity-children message-info))
- (default-situation
- (cdr (assq 'childrens-situation situation))))
- (while children
- (mime-view-display-entity (car children) message-info ibuf obuf
- default-situation)
- (setq children (cdr children))
- )))))
-
(defun mime-view-display-entity (entity message-info ibuf obuf
default-situation)
(let* ((start (mime-entity-point-min entity))
(end (mime-entity-point-max entity))
- (media-type (mime-entity-media-type entity))
- (media-subtype (mime-entity-media-subtype entity))
- (params (mime-entity-parameters entity))
- (encoding (mime-entity-encoding entity))
+ (content-type (mime-entity-content-type entity))
+ (encoding (mime-entity-encoding entity))
end-of-header e nb ne subj)
(set-buffer ibuf)
(goto-char start)
)
(save-restriction
(narrow-to-region start end)
- (setq subj
- (eword-decode-string
- (mime-raw-get-subject params encoding)))
+ (setq subj (eword-decode-string (mime-raw-get-subject entity)))
)
(let* ((situation
- (ctree-match-calist mime-preview-condition
- (list* (cons 'type media-type)
- (cons 'subtype media-subtype)
- (cons 'encoding encoding)
- (cons 'major-mode major-mode)
- (append params
- default-situation))))
+ (or
+ (ctree-match-calist mime-preview-condition
+ (append
+ (or content-type
+ (make-mime-content-type 'text 'plain))
+ (list* (cons 'encoding encoding)
+ (cons 'major-mode major-mode)
+ default-situation)))
+ default-situation))
(button-is-invisible
(eq (cdr (assq 'entity-button situation)) 'invisible))
(header-is-visible
(setq children (cdr children))
)))))
-(defun mime-raw-get-uu-filename (param &optional encoding)
- (if (member (or encoding
- (cdr (assq 'encoding param))
- )
- mime-view-uuencode-encoding-name-list)
- (save-excursion
- (or (if (re-search-forward "^begin [0-9]+ " nil t)
- (if (looking-at ".+$")
- (buffer-substring (match-beginning 0)(match-end 0))
- ))
- ""))
- ))
+(defun mime-raw-get-uu-filename ()
+ (save-excursion
+ (if (re-search-forward "^begin [0-9]+ " nil t)
+ (if (looking-at ".+$")
+ (buffer-substring (match-beginning 0)(match-end 0))
+ ))))
-(defun mime-raw-get-subject (param &optional encoding)
+(defun mime-raw-get-subject (entity)
(or (std11-find-field-body '("Content-Description" "Subject"))
- (let (ret)
- (if (or (and (setq ret (mime-read-Content-Disposition))
- (setq ret
- (assoc "filename"
- (mime-content-disposition-parameters ret)))
- )
- (setq ret (assoc "name" param))
- (setq ret (assoc "x-name" param))
- )
- (std11-strip-quoted-string (cdr ret))
- ))
- (mime-raw-get-uu-filename param encoding)
+ (let ((ret (mime-entity-content-disposition entity)))
+ (and ret
+ (setq ret (mime-content-disposition-filename ret))
+ (std11-strip-quoted-string ret)
+ ))
+ (let ((ret (mime-entity-content-type entity)))
+ (and ret
+ (setq ret
+ (cdr
+ (let ((param (mime-content-type-parameters ret)))
+ (or (assoc "name" param)
+ (assoc "x-name" param))
+ )))
+ (std11-strip-quoted-string ret)
+ ))
+ (if (member (mime-entity-encoding entity)
+ mime-view-uuencode-encoding-name-list)
+ (mime-raw-get-uu-filename))
""))
(eval-when-compile (require 'cl))
-(defconst mime-module-version '("WEMI" "Hiratsuka" 1 4 3)
+(defconst mime-module-version '("WEMI" "\e,DR\e(Biso" 1 4 4)
"Implementation name, version name and numbers of MIME-kernel package.")
(autoload 'mule-caesar-region "mule-caesar"
projects / elisp / semi.git / commitdiff