From 3a4480a9fb662a026ac483803df00a076b9d5750 Mon Sep 17 00:00:00 2001 From: morioka Date: Mon, 18 May 1998 16:20:55 +0000 Subject: [PATCH] Sync up with remi-1_4_0_9. --- ChangeLog | 90 ++++++++++++++++++++++++++++++++ mime-parse.el | 129 +++++++++++++++++++++++++-------------------- mime-play.el | 64 ++++++++++++++--------- mime-setup.el | 4 +- mime-view.el | 162 +++++++++++++++------------------------------------------ semi-def.el | 2 +- 6 files changed, 246 insertions(+), 205 deletions(-) diff --git a/ChangeLog b/ChangeLog index c905f70..3d0e1f2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,93 @@ +1998-05-17 MORIOKA Tomohiko + + * mime-setup.el: Avoid warning message of byte-compiler. + +1998-05-17 MORIOKA Tomohiko + + * 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 + + * mime-view.el (mime-view-display-message): fixed. + +1998-05-16 MORIOKA Tomohiko + + * 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 + + * 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 + + * mime-view.el (mime-view-display-entity): fixed. + + * mime-parse.el (mime-parse-multipart): Change interface. + +1998-05-15 MORIOKA Tomohiko + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * mime-play.el (mime-activate-mailcap-method): Regard + 'mime-temp-directory. + +1998-05-14 MORIOKA Tomohiko + + * 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. + + 1998-05-13 MORIOKA Tomohiko * WEMI: Version 1.4.3 (Hiratsuka) released. diff --git a/mime-parse.el b/mime-parse.el index b389222..2741a04 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -122,6 +122,10 @@ and return parsed it. Format of return value is as same as "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 ;;; @@ -160,6 +164,14 @@ and return parsed it." "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 ;;; @@ -184,27 +196,36 @@ If is is not found, return DEFAULT-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)) @@ -216,7 +237,7 @@ If is is not found, return DEFAULT-ENCODING." ))) (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) )) @@ -231,7 +252,7 @@ If is is not found, return DEFAULT-ENCODING." (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)) @@ -241,55 +262,51 @@ If is is not found, return DEFAULT-ENCODING." (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 diff --git a/mime-play.el b/mime-play.el index 20991eb..7e50479 100644 --- a/mime-play.el +++ b/mime-play.el @@ -123,14 +123,10 @@ is selected from variable `mime-acting-condition'. If MODE is 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)) @@ -139,11 +135,9 @@ specified, play as it. Default MODE is \"play\"." (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)) ) @@ -188,38 +182,54 @@ specified, play as it. Default MODE is \"play\"." (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 @@ -332,8 +342,10 @@ window.") (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 diff --git a/mime-setup.el b/mime-setup.el index cee4616..dae2871 100644 --- a/mime-setup.el +++ b/mime-setup.el @@ -26,12 +26,12 @@ (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.")) ) diff --git a/mime-view.el b/mime-view.el index 349155c..e0bd137 100644 --- a/mime-view.el +++ b/mime-view.el @@ -727,7 +727,11 @@ 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") - (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) @@ -736,94 +740,12 @@ The compressed face will be piped to this command.") (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) @@ -835,18 +757,18 @@ The compressed face will be piped to this command.") ) (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 @@ -902,33 +824,33 @@ The compressed face will be piped to this command.") (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)) "")) diff --git a/semi-def.el b/semi-def.el index 03dc72a..ec35a03 100644 --- a/semi-def.el +++ b/semi-def.el @@ -29,7 +29,7 @@ (eval-when-compile (require 'cl)) -(defconst mime-module-version '("WEMI" "Hiratsuka" 1 4 3) +(defconst mime-module-version '("WEMI" ",DR(Biso" 1 4 4) "Implementation name, version name and numbers of MIME-kernel package.") (autoload 'mule-caesar-region "mule-caesar" -- 1.7.10.4