From: yamaoka Date: Thu, 18 Jun 1998 22:52:50 +0000 (+0000) Subject: Sync up with SEMI 1.7.0. X-Git-Tag: wemi-1_8_4~6 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=de0581ef8dbe76076630d277a41461e57457004e;p=elisp%2Fsemi.git Sync up with SEMI 1.7.0. --- diff --git a/ChangeLog b/ChangeLog index 308f00a..7425746 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,184 @@ +1998-06-19 Katsumi Yamaoka + + * WEMI: Version 1.7.0 (Atami) released. + +1998-06-17 MORIOKA Tomohiko + + * mime-edit.el, mime-view.el, semi-def.el: Rename + `mime-module-version' to `mime-user-interface-version'. + + * mime-parse.el, SEMI-ELS: Move mime-parse.el to FLIM layer. + +1998-06-17 MORIOKA Tomohiko + + * semi-setup.el (call-after-loaded): Moved from semi-def.el. + + * semi-def.el: Move `call-after-loaded' to semi-setup.el. + +1998-06-17 MORIOKA Tomohiko + + * mime-view.el (mime-view-insert-entity-button): Change interface. + +1998-06-17 MORIOKA Tomohiko + + * mime-view.el (mime-entity-filename): Moved from mime-play.el. + (mime-view-entity-title): Use `mime-entity-filename'. + + * mime-play.el: Move `mime-entity-filename' to mime-view.el. + +1998-06-17 MORIOKA Tomohiko + + * mime-play.el (mime-entity-filename): New function; abolish + `mime-raw-get-original-filename'. + (mime-entity-safe-filename): New function; abolish + `mime-raw-get-filename'. + (mime-activate-mailcap-method): Use `mime-entity-safe-filename'. + (mime-save-content): Use `mime-entity-safe-filename'. + (mime-detect-content): Use `mime-entity-safe-filename'. + + * mime-view.el (mime-entity-uu-filename): New function; abolish + `mime-raw-get-uu-filename'. + +1998-06-17 MORIOKA Tomohiko + + * mime-view.el (mime-view-entity-title): Renamed from + `mime-raw-get-subject'; use `mime-entity-read-field'. + +1998-06-17 MORIOKA Tomohiko + + * NEWS (Changes in SEMI 1.7): New chapter. + (Changes in SEMI 1.6): Add description of entity-detection. + +1998-06-17 MORIOKA Tomohiko + + * mime-view.el: Rename `mime-view-following-method-alist' to + `mime-preview-following-method-alist'. + +1998-06-17 MORIOKA Tomohiko + + * semi-setup.el, mime-pgp.el: Rename + `mime-method-to-add-application/pgp-keys' to + `mime-add-application/pgp-keys'. + + * semi-setup.el, mime-pgp.el: Rename + `mime-method-to-decrypt-application/pgp-encrypted' to + `mime-decrypt-application/pgp-encrypted'. + + * semi-setup.el, mime-pgp.el: Rename + `mime-method-to-verify-application/pgp-signature' to + `mime-verify-application/pgp-signature'. + + * semi-setup.el, mime-pgp.el: Rename + `mime-method-to-verify-multipart/signed' to + `mime-verify-multipart/signed'. + + * semi-setup.el, mime-pgp.el: Rename + `mime-method-for-application/pgp' to `mime-view-application/pgp'. + + * SEMI-naming.ol: New file. + +1998-06-16 MORIOKA Tomohiko + + * mime-partial.el: Rename + `mime-method-to-combine-message/partial-pieces' to + `mime-combine-message/partial-pieces-automatically'. + +1998-06-16 MORIOKA Tomohiko + + * mime-play.el, mime-view.el: Rename + `mime-method-to-display-caesar' to `mime-view-caesar'. + + * mime-play.el, mime-view.el: Rename + `mime-method-to-display-message/external-ftp' to + `mime-view-message/external-ftp'. + +1998-06-16 MORIOKA Tomohiko + + * mime-view.el, mime-partial.el, mime-play.el: Rename + `mime-method-to-store-message/partial' to + `mime-store-message/partial-piece'. + +1998-06-16 MORIOKA Tomohiko + + * mime-play.el, mime-view.el: Rename + `mime-method-to-display-message/rfc822' to + `mime-view-message/rfc822'. + +1998-06-16 MORIOKA Tomohiko + + * mime-play.el, mime-view.el: Rename `mime-method-to-detect' to + `mime-detect-content'. + +1998-06-16 MORIOKA Tomohiko + + * mime-view.el (mime-display-entity): Abolish body-filter support. + + * mime-play.el, mime-view.el: Rename `mime-method-to-save' to + `mime-save-content'. + +1998-06-16 MORIOKA Tomohiko + + * mime-play.el (mime-activate-mailcap-method): Fixed. + +1998-06-16 MORIOKA Tomohiko + + * mime-image.el (mime-display-image): New function; abolish + function `mime-preview-filter-for-image'. + + * mime-image.el: Rename `mime-view-content-header-filter-hook' to + `mime-display-header-hook'. + + * mime-view.el (mime-display-entity): Run + `mime-display-header-hook'. + + * mime-text.el, mime-view.el: Rename `mime-preview-text/enriched' + to `mime-display-text/enriched'. + + * mime-text.el, mime-view.el: Rename `mime-preview-text/richtext' + to `mime-display-text/richtext'. + + * mime-text.el, mime-view.el: Rename `mime-preview-text/plain' to + `mime-display-text/plain'. + + * mime-view.el (mime-display-multipart/mixed): Renamed from + `mime-preview-multipart/mixed'. + + * mime-view.el (mime-display-multipart/alternative): Renamed from + `mime-preview-multipart/alternative'. + + * mime-view.el (mime-display-message/partial-button): Renamed from + `mime-preview-message/partial-button'. + + * mime-view.el (mime-display-entity): Renamed from + `mime-view-display-entity'; change interface. + (mime-display-message): Renamed from `mime-view-display-message'. + +1998-06-16 MORIOKA Tomohiko + + * README.en (Required environment): Modify for FLIM 1.4.0. + +1998-06-16 MORIOKA Tomohiko + + * mime-parse.el: Move function `mime-entity-number' to FLIM layer. + +1998-06-16 MORIOKA Tomohiko + + * mime-view.el (mime-header-presentation-method-alist): New + variable; abolish variable + `mime-view-content-header-filter-alist'; abolish function + `mime-view-cut-header'; abolish variable + `mime-view-ignored-field-regexp'. + (mime-view-display-entity): Use + `mime-header-presentation-method-alist'. + + * mime-parse.el: Move definition of structure `mime-entity' to + FLIM layer. + +1998-06-16 MORIOKA Tomohiko + + * mime-parse.el: Change order of `mime-entity'. + + 1998-06-16 Katsumi Yamaoka * WEMI: Version 1.6.0 (Yugawara) released. diff --git a/Makefile b/Makefile index 7242f59..01ba988 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ # Makefile for WEMI. # -VERSION = 1.6.0 +VERSION = 1.7.0 PACKAGE = wemi SHELL = /bin/sh diff --git a/NEWS b/NEWS index 20be678..0352c0c 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,41 @@ SEMI NEWS --- history of major-changes. Copyright (C) 1998 Free Software Foundation, Inc. +* Changes in SEMI 1.7 + +** Header-presentation-method + + Now MIME-View uses header-presentation-method instead of +header-filter. + + - abolish variable `mime-view-content-header-filter-alist' + + - abolish function `mime-view-cut-header' + + - Rename `mime-view-content-header-filter-hook' to + `mime-display-header-hook' + + +** Abolish `mime-view-ignored-field-regexp' + + Now mime-view uses `mime-view-ignored-field-list' directly in +default header-presentation-method. + + +** Abolish body filter support + + Please use body-presentation-method. + + +** Methods for MUAs + + - Rename `mime-view-following-method-alist' to + `mime-preview-following-method-alist' + + - Rename `mime-method-to-combine-message/partial-pieces' to + `mime-combine-message/partial-pieces-automatically' + + * Changes in SEMI 1.6 ** Abolish tm-compatible external method support @@ -17,6 +52,20 @@ method instead of it. encryption. +** New method to detect content of entity + + Now MIME-View can detect content of entity for +application/octet-stream in default setting. + + It uses "file" command to detect. User can customize +`mime-file-content-type-alist' to specify media-type for output of +"file" command. It is an alist of "file" output patterns +vs. corresponding media-types. Each element looks like (REGEXP TYPE +SUBTYPE). REGEXP is pattern for "file" command output. TYPE is +symbol to indicate primary type of media-type. SUBTYPE is symbol to +indicate subtype of media-type. + + ** New interface to display message - Function `mime-view-buffer' diff --git a/README.en b/README.en index a491786..b3ca972 100644 --- a/README.en +++ b/README.en @@ -48,7 +48,7 @@ Required environment nil. (Maybe non mule setting requires to modify emu. In addition, it is better to use terminal-coding-system feature) - SEMI requires APEL (8.7 or later) and FLIM (1.3.0 or later) package. + SEMI requires APEL (8.7 or later) and FLIM (1.4.0 or later) package. Please install them before installing it. APEL package is available at: diff --git a/SEMI-ELS b/SEMI-ELS index c12fb0a..ff195ea 100644 --- a/SEMI-ELS +++ b/SEMI-ELS @@ -6,9 +6,7 @@ (setq semi-modules-to-compile '(signature - semi-def - mime-parse mime-view mime-text mime-play mime-partial - mime-edit + semi-def mime-view mime-text mime-play mime-partial mime-edit semi-setup mail-mime-setup)) (setq semi-modules-not-to-compile nil) diff --git a/VERSION b/VERSION index 8c9e1e8..9d05e9d 100644 --- a/VERSION +++ b/VERSION @@ -56,7 +56,7 @@ 1.5.3 Uozu $(B5{DE(B ; <=> $(BIY;3COJ}E4F;(B 1.5.4 Higashi-Namerikawa $(BEl3j@n(B 1.6.0 Namerikawa $(B3j@n(B ; <=> $(BIY;3COJ}E4F;(B ------ Mizuhashi $(B?e66(B +1.7.0 Mizuhashi $(B?e66(B ----- Higashi-Toyama $(BElIY;3(B ----- Toyama $(BIY;3(B ; = JR $(B9b;3K\@~!"IY;39A@~(B : : : @@ -107,7 +107,7 @@ 1.5.3 Nebukawa $B:,I\@n(B 1.5.4 Manazuru $B??Da(B 1.6.0 Yugawara $BEr2O86(B ------ Atami $(BG.3$(B ; = JR $(B0KEl@~(B +1.7.0 Atami $(BG.3$(B ; = JR $(B0KEl@~(B ;;------------------------------------------------------------------------- ;; Central Japan Railway $(BEl3$N95RE4F;(B ;;------------------------------------------------------------------------- @@ -153,7 +153,7 @@ 1.4.0 Himi $(BI98+(B 1.5.0 Shimao $(BEgHx(B 1.6.0 Amaharashi $(B1+@2(B -------- Ecch-Dþ-Kokubu $(B1[Cf9qJ,(B-A +1.7.0 Ecch-Dþ-Kokubu $(B1[Cf9qJ,(B-A ------- Fushiki $(BIzLZ(B ------- Noumachi $(BG=D.(B ------- Ecch-Dþ-Nakagawa $(B1[CfCf@n(B-A diff --git a/mime-edit.el b/mime-edit.el index 4924c8d..30dee69 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -121,9 +121,10 @@ ;;; (defconst mime-edit-version-string - `,(concat (car mime-module-version) " " - (mapconcat #'number-to-string (cddr mime-module-version) ".") - " - \"" (cadr mime-module-version) "\"")) + `,(concat (car mime-user-interface-version) " " + (mapconcat #'number-to-string + (cddr mime-user-interface-version) ".") + " - \"" (cadr mime-user-interface-version) "\"")) ;;; @ variables diff --git a/mime-image.el b/mime-image.el index a405a4a..f28a08c 100644 --- a/mime-image.el +++ b/mime-image.el @@ -69,7 +69,7 @@ (highlight-headers (point-min) (re-search-forward "^$" nil t) t) ) - (add-hook 'mime-view-content-header-filter-hook + (add-hook 'mime-display-header-hook 'mime-preview-x-face-function-use-highlight-headers) ) @@ -92,7 +92,7 @@ ;; X-Face ;; (if (exec-installed-p uncompface-program exec-path) - (add-hook 'mime-view-content-header-filter-hook + (add-hook 'mime-display-header-hook 'x-face-decode-message-header) ) )) @@ -115,8 +115,7 @@ 'mime-preview-condition (list (cons 'type type)(cons 'subtype subtype) '(body . visible) - '(body-presentation-method . with-filter) - (cons 'body-filter #'mime-preview-filter-for-image) + (cons 'body-presentation-method #'mime-display-image) (cons 'image-format format)) ))))) '((image jpeg jpeg) @@ -136,82 +135,46 @@ ;;; ;; (for XEmacs 19.12 or later) -(defun mime-preview-filter-for-image (situation) - (let ((beg (point-min)) - (end (point-max))) - (remove-text-properties beg end '(face nil)) - (message "Decoding image...") - (mime-decode-region beg end (cdr (assq 'encoding situation))) - (let ((gl (image-normalize (cdr (assq 'image-format situation)) - (buffer-string)))) - (delete-region (point-min)(point-max)) - (cond ((image-invalid-glyph-p gl) - (setq gl nil) - (message "Invalid glyph!") - ) - ((eq (aref gl 0) 'xbm) - (let ((xbm-file - (make-temp-name - (expand-file-name "tm" mime-temp-directory)))) +(defun mime-display-image (entity situation) + (message "Decoding image...") + (let ((gl (image-normalize (cdr (assq 'image-format situation)) + (with-temp-buffer + (insert-buffer-substring + (mime-entity-buffer entity) + (mime-entity-body-start entity) + (mime-entity-body-end entity)) + (mime-decode-region + (point-min)(point-max) + (mime-entity-encoding entity)) + (buffer-string))))) + (cond ((image-invalid-glyph-p gl) + (setq gl nil) + (message "Invalid glyph!") + ) + ((eq (aref gl 0) 'xbm) + (let ((xbm-file + (make-temp-name + (expand-file-name "tm" mime-temp-directory)))) + (with-temp-buffer (insert (aref gl 2)) (write-region (point-min)(point-max) xbm-file) - (message "Decoding image...") - (delete-region (point-min)(point-max)) - (bitmap-insert-xbm-file xbm-file) - (delete-file xbm-file) ) - (message "Decoding image... done") + (message "Decoding image...") + (bitmap-insert-xbm-file xbm-file) + (delete-file xbm-file) ) - (t - (setq gl (make-glyph gl)) - (let ((e (make-extent (point) (point)))) - (set-extent-end-glyph e gl) - ) - (message "Decoding image... done") - )) - ) - (insert "\n") - )) - - -;;; @ content filter for Postscript -;;; -;; (for XEmacs 19.14 or later) - -;; (defvar mime-view-ps-to-gif-command "pstogif") - -;; (defun mime-preview-filter-for-application/postscript (ctype params encoding) -;; (let* ((beg (point-min)) (end (point-max)) -;; (file-base -;; (make-temp-name (expand-file-name "tm" mime-temp-directory))) -;; (ps-file (concat file-base ".ps")) -;; (gif-file (concat file-base ".gif")) -;; ) -;; (remove-text-properties beg end '(face nil)) -;; (message "Decoding Postscript...") -;; (mime-decode-region beg end encoding) -;; (write-region (point-min)(point-max) ps-file) -;; (message "Decoding Postscript...") -;; (delete-region (point-min)(point-max)) -;; (call-process mime-view-ps-to-gif-command nil nil nil ps-file) -;; (set-extent-end-glyph (make-extent (point) (point)) -;; (make-glyph (vector 'gif :file gif-file))) -;; (message "Decoding Postscript... done") -;; (delete-file ps-file) -;; (delete-file gif-file) -;; )) - -;; If you would like to display inline Postscript image, please -;; activate following: - -;; (set-alist 'mime-view-content-filter-alist -;; "application/postscript" -;; (function mime-preview-filter-for-application/postscript)) - -;; (if (featurep 'gif) -;; (add-to-list -;; 'mime-view-visible-media-type-list "application/postscript") -;; ) + (message "Decoding image... done") + ) + (t + (setq gl (make-glyph gl)) + (let ((e (make-extent (point) (point)))) + (set-extent-end-glyph e gl) + ) + (message "Decoding image... done") + )) + ) + (insert "\n") + ) ;;; @ end diff --git a/mime-parse.el b/mime-parse.el deleted file mode 100644 index 213563c..0000000 --- a/mime-parse.el +++ /dev/null @@ -1,348 +0,0 @@ -;;; mime-parse.el --- MIME message parser - -;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Keywords: parse, MIME, multimedia, mail, news - -;; This file is part of SEMI (Spadework for Emacs 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 -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'emu) -(require 'std11) -(require 'mime-def) - - -;;; @ field parser -;;; - -(defconst mime/content-parameter-value-regexp - (concat "\\(" - std11-quoted-string-regexp - "\\|[^; \t\n]*\\)")) - -(defconst mime::parameter-regexp - (concat "^[ \t]*\;[ \t]*\\(" mime-token-regexp "\\)" - "[ \t]*=[ \t]*\\(" mime/content-parameter-value-regexp "\\)")) - -(defun mime-parse-parameter (str) - (if (string-match mime::parameter-regexp str) - (let ((e (match-end 2))) - (cons - (cons (downcase (substring str (match-beginning 1) (match-end 1))) - (std11-strip-quoted-string - (substring str (match-beginning 2) e)) - ) - (substring str e) - )))) - - -;;; @ Content-Type -;;; - -(defsubst make-mime-content-type (type subtype &optional parameters) - (list* (cons 'type type) - (cons 'subtype subtype) - (nreverse parameters)) - ) - -(defun mime-parse-Content-Type (string) - "Parse STRING as field-body of Content-Type field. -Return value is - (PRIMARY-TYPE SUBTYPE (NAME1 . VALUE1)(NAME2 . VALUE2) ...) -or nil. PRIMARY-TYPE and SUBTYPE are symbol and NAME_n and VALUE_n -are string." - (setq string (std11-unfold-string string)) - (if (string-match `,(concat "^\\(" mime-token-regexp - "\\)/\\(" mime-token-regexp "\\)") string) - (let* ((type (downcase - (substring string (match-beginning 1) (match-end 1)))) - (subtype (downcase - (substring string (match-beginning 2) (match-end 2)))) - ret dest) - (setq string (substring string (match-end 0))) - (while (setq ret (mime-parse-parameter string)) - (setq dest (cons (car ret) dest) - string (cdr ret)) - ) - (make-mime-content-type (intern type)(intern subtype) - (nreverse dest)) - ))) - -(defun mime-read-Content-Type () - "Read field-body of Content-Type field from current-buffer, -and return parsed it. Format of return value is as same as -`mime-parse-Content-Type'." - (let ((str (std11-field-body "Content-Type"))) - (if str - (mime-parse-Content-Type str) - ))) - -(defsubst mime-content-type-primary-type (content-type) - "Return primary-type of CONTENT-TYPE." - (cdr (car content-type))) - -(defsubst mime-content-type-subtype (content-type) - "Return primary-type of CONTENT-TYPE." - (cdr (cadr content-type))) - -(defsubst mime-content-type-parameters (content-type) - "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 -;;; - -(defconst mime-disposition-type-regexp mime-token-regexp) - -(defun mime-parse-Content-Disposition (string) - "Parse STRING as field-body of Content-Disposition field." - (setq string (std11-unfold-string string)) - (if (string-match `,(concat "^" mime-disposition-type-regexp) string) - (let* ((e (match-end 0)) - (type (downcase (substring string 0 e))) - ret dest) - (setq string (substring string e)) - (while (setq ret (mime-parse-parameter string)) - (setq dest (cons (car ret) dest) - string (cdr ret)) - ) - (cons (cons 'type (intern type)) - (nreverse dest)) - ))) - -(defun mime-read-Content-Disposition () - "Read field-body of Content-Disposition field from current-buffer, -and return parsed it." - (let ((str (std11-field-body "Content-Disposition"))) - (if str - (mime-parse-Content-Disposition str) - ))) - -(defsubst mime-content-disposition-type (content-disposition) - "Return disposition-type of CONTENT-DISPOSITION." - (cdr (car content-disposition))) - -(defsubst mime-content-disposition-parameters (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 -;;; - -(defun mime-parse-Content-Transfer-Encoding (string) - "Parse STRING as field-body of Content-Transfer-Encoding field." - (if (string-match "[ \t\n\r]+$" string) - (setq string (match-string 0 string)) - ) - (downcase string)) - -(defun mime-read-Content-Transfer-Encoding (&optional default-encoding) - "Read field-body of Content-Transfer-Encoding field from -current-buffer, and return it. -If is is not found, return DEFAULT-ENCODING." - (let ((str (std11-field-body "Content-Transfer-Encoding"))) - (if str - (mime-parse-Content-Transfer-Encoding str) - default-encoding))) - - -;;; @ message parser -;;; - -(defsubst make-mime-entity (buffer - node-id - header-start header-end body-start body-end - content-type content-disposition - encoding children) - (vector buffer - node-id header-start header-end body-start body-end - content-type content-disposition encoding children)) - -(defsubst mime-entity-buffer (entity) (aref entity 0)) -(defsubst mime-entity-node-id (entity) (aref entity 1)) -(defsubst mime-entity-header-start (entity) (aref entity 2)) -(defsubst mime-entity-header-end (entity) (aref entity 3)) -(defsubst mime-entity-body-start (entity) (aref entity 4)) -(defsubst mime-entity-body-end (entity) (aref entity 5)) -(defsubst mime-entity-content-type (entity) (aref entity 6)) -(defsubst mime-entity-content-disposition (entity) (aref entity 7)) -(defsubst mime-entity-encoding (entity) (aref entity 8)) -(defsubst mime-entity-children (entity) (aref entity 9)) - -(defsubst mime-entity-number (entity) - (reverse (mime-entity-node-id entity))) - -(defalias 'mime-entity-point-min 'mime-entity-header-start) -(defalias 'mime-entity-point-max 'mime-entity-body-end) - -(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 (header-start header-end body-start body-end - content-type content-disposition - encoding node-id) - (goto-char (point-min)) - (let* ((dash-boundary - (concat "--" - (std11-strip-quoted-string - (mime-content-type-parameter content-type "boundary")))) - (delimiter (concat "\n" (regexp-quote dash-boundary))) - (close-delimiter (concat delimiter "--[ \t]*$")) - (rsep (concat delimiter "[ \t]*\n")) - (dc-ctl - (if (eq (mime-content-type-subtype content-type) 'digest) - (make-mime-content-type 'message 'rfc822) - (make-mime-content-type 'text 'plain) - )) - cb ce ret ncb children (i 0)) - (save-restriction - (goto-char body-end) - (narrow-to-region header-end - (if (re-search-backward close-delimiter nil t) - (match-beginning 0) - body-end)) - (goto-char header-start) - (re-search-forward rsep nil t) - (setq cb (match-end 0)) - (while (re-search-forward rsep nil t) - (setq ce (match-beginning 0)) - (setq ncb (match-end 0)) - (save-restriction - (narrow-to-region cb ce) - (setq ret (mime-parse-message dc-ctl "7bit" (cons i node-id))) - ) - (setq children (cons ret children)) - (goto-char (mime-entity-point-max ret)) - (goto-char (setq cb ncb)) - (setq i (1+ i)) - ) - (setq ce (point-max)) - (save-restriction - (narrow-to-region cb ce) - (setq ret (mime-parse-message dc-ctl "7bit" (cons i node-id))) - ) - (setq children (cons ret children)) - ) - (make-mime-entity (current-buffer) node-id - header-start header-end body-start body-end - content-type content-disposition encoding - (nreverse children)) - )) - -(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." - (let ((header-start (point-min)) - header-end - body-start - (body-end (point-max)) - content-type content-disposition encoding - primary-type) - (goto-char header-start) - (if (re-search-forward "^$" nil t) - (setq header-end (match-end 0) - body-start (1+ header-end)) - (setq header-end (point-min) - body-start (point-min)) - ) - (save-restriction - (narrow-to-region header-start header-end) - (setq content-type (or (let ((str (std11-fetch-field "Content-Type"))) - (if str - (mime-parse-Content-Type str) - )) - default-ctl) - content-disposition (let ((str (std11-fetch-field - "Content-Disposition"))) - (if str - (mime-parse-Content-Disposition str) - )) - encoding (let ((str (std11-fetch-field - "Content-Transfer-Encoding"))) - (if str - (mime-parse-Content-Transfer-Encoding str) - default-encoding)) - primary-type (mime-content-type-primary-type content-type)) - ) - (cond ((eq primary-type 'multipart) - (mime-parse-multipart header-start header-end - body-start body-end - content-type content-disposition encoding - node-id) - ) - ((and (eq primary-type 'message) - (memq (mime-content-type-subtype content-type) - '(rfc822 news) - )) - (make-mime-entity (current-buffer) node-id - header-start header-end body-start body-end - content-type content-disposition encoding - (save-restriction - (narrow-to-region body-start body-end) - (list (mime-parse-message - nil nil (cons 0 node-id))) - )) - ) - (t - (make-mime-entity (current-buffer) node-id - header-start header-end body-start body-end - content-type content-disposition encoding nil) - )) - )) - - -;;; @ utilities -;;; - -(defsubst mime-root-entity-p (entity) - "Return t if ENTITY is root-entity (message)." - (null (mime-entity-node-id entity))) - - -;;; @ end -;;; - -(provide 'mime-parse) - -;;; mime-parse.el ends here diff --git a/mime-partial.el b/mime-partial.el index c8ef3ed..9401a89 100644 --- a/mime-partial.el +++ b/mime-partial.el @@ -40,7 +40,7 @@ (error "Fatal. Unsupported mode") )))) -(defun mime-method-to-combine-message/partial-pieces (entity cal) +(defun mime-combine-message/partial-pieces-automatically (entity cal) "Internal method for mime-view to combine message/partial messages automatically. This function refers variable `mime-view-partial-message-method-alist' to select function to display @@ -65,7 +65,7 @@ partial messages using mime-view." (if (or (file-exists-p full-file) (not (y-or-n-p "Merge partials?")) ) - (mime-method-to-store-message/partial entity cal) + (mime-store-message/partial-piece entity cal) (let (the-id parameters) (setq subject-id (std11-field-body "Subject")) (if (string-match "[0-9\n]+" subject-id) @@ -78,17 +78,13 @@ partial messages using mime-view." (while t (mime-view-partial-message target) (set-buffer article-buffer) - (setq parameters - (mime-entity-parameters mime-raw-message-info)) + (setq parameters (mime-entity-parameters entity)) (setq the-id (cdr (assoc "id" parameters))) - (if (string= the-id id) - (progn - (mime-method-to-store-message/partial - mime-raw-message-info parameters) - (if (file-exists-p full-file) - (throw 'tag nil) - ) - )) + (when (string= the-id id) + (mime-store-message/partial-piece entity parameters) + (if (file-exists-p full-file) + (throw 'tag nil) + )) (if (not (progn (set-buffer subject-buf) (end-of-line) diff --git a/mime-pgp.el b/mime-pgp.el index b27c314..a37b790 100644 --- a/mime-pgp.el +++ b/mime-pgp.el @@ -41,19 +41,28 @@ ;; by Kazuhiko Yamamoto (1995/10; ;; expired) -;; PGP/MIME and PGP-kazu may be contrary to each other. You should -;; decide which you support (Maybe you should not use PGP-kazu). - ;;; Code: (require 'mime-play) +;;; @ Internal method for multipart/signed +;;; +;;; It is based on RFC 1847 (security-multipart). + +(defun mime-verify-multipart/signed (entity situation) + "Internal method to verify multipart/signed." + (mime-raw-play-entity + (nth 1 (mime-entity-children entity)) ; entity-info of signature + (cdr (assq 'mode situation)) ; play-mode + )) + + ;;; @ internal method for application/pgp ;;; ;;; It is based on draft-kazu-pgp-mime-00.txt (PGP-kazu). -(defun mime-method-for-application/pgp (entity cal) +(defun mime-view-application/pgp (entity situation) (let* ((start (mime-entity-point-min entity)) (end (mime-entity-point-max entity)) (entity-number (mime-raw-point-to-entity-number start)) @@ -107,18 +116,6 @@ )) -;;; @ Internal method for multipart/signed -;;; -;;; It is based on RFC 1847 (security-multipart). - -(defun mime-method-to-verify-multipart/signed (entity cal) - "Internal method to verify multipart/signed." - (mime-raw-play-entity - (nth 1 (mime-entity-children entity)) ; entity-info of signature - (cdr (assq 'mode cal)) ; play-mode - )) - - ;;; @ Internal method for application/pgp-signature ;;; ;;; It is based on RFC 2015 (PGP/MIME). @@ -160,11 +157,11 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (t "Bad signature"))) )))) -(defun mime-method-to-verify-application/pgp-signature (entity cal) +(defun mime-verify-application/pgp-signature (entity situation) "Internal method to check PGP/MIME signature." (let* ((start (mime-entity-point-min entity)) (end (mime-entity-point-max entity)) - (encoding (cdr (assq 'encoding cal))) + (encoding (cdr (assq 'encoding situation))) (entity-node-id (mime-raw-point-to-entity-node-id start)) (mother-node-id (cdr entity-node-id)) (knum (car entity-node-id)) @@ -224,7 +221,7 @@ It should be ISO 639 2 letter language code such as en, ja, ...") ;;; ;;; It is based on RFC 2015 (PGP/MIME). -(defun mime-method-to-decrypt-application/pgp-encrypted (entity cal) +(defun mime-decrypt-application/pgp-encrypted (entity situation) (let* ((entity-node-id (mime-entity-node-id entity)) (mother-node-id (cdr entity-node-id)) (knum (car entity-node-id)) @@ -233,7 +230,7 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (1+ knum))) (oinfo (mime-raw-find-entity-from-node-id (cons onum mother-node-id) mime-raw-message-info))) - (mime-method-for-application/pgp oinfo cal) + (mime-view-application/pgp oinfo situation) )) @@ -241,12 +238,12 @@ It should be ISO 639 2 letter language code such as en, ja, ...") ;;; ;;; It is based on RFC 2015 (PGP/MIME). -(defun mime-method-to-add-application/pgp-keys (entity cal) +(defun mime-add-application/pgp-keys (entity situation) (let* ((start (mime-entity-point-min entity)) (end (mime-entity-point-max entity)) (entity-number (mime-raw-point-to-entity-number start)) (new-name (format "%s-%s" (buffer-name) entity-number)) - (encoding (cdr (assq 'encoding cal))) + (encoding (cdr (assq 'encoding situation))) str) (setq str (buffer-substring start end)) (switch-to-buffer new-name) diff --git a/mime-play.el b/mime-play.el index 45ff40d..8c94c23 100644 --- a/mime-play.el +++ b/mime-play.el @@ -206,8 +206,13 @@ specified, play as it. Default MODE is \"play\"." (narrow-to-region start end) (goto-char start) (let ((method (cdr (assoc 'method situation))) - (name (expand-file-name (mime-raw-get-filename situation) - mime-temp-directory))) + (name (mime-entity-safe-filename entity))) + (setq name + (if name + (expand-file-name name mime-temp-directory) + (make-temp-name + (expand-file-name "EMI" mime-temp-directory)) + )) (mime-write-decoded-region (mime-entity-body-start entity) end name (cdr (assq 'encoding situation))) (message "External method is starting...") @@ -232,53 +237,6 @@ specified, play as it. Default MODE is \"play\"." (remove-alist 'mime-mailcap-method-filename-alist process) (message (format "%s %s" process event))) -;; (defun mime-activate-external-method (entity cal) -;; (save-excursion -;; (save-restriction -;; (let ((beg (mime-entity-point-min entity)) -;; (end (mime-entity-point-max entity))) -;; (narrow-to-region beg end) -;; (goto-char beg) -;; (let ((method (cdr (assoc 'method cal))) -;; (name (mime-raw-get-filename cal))) -;; (if method -;; (let ((file (make-temp-name -;; (expand-file-name "TM" mime-temp-directory))) -;; b args) -;; (if (nth 1 method) -;; (setq b beg) -;; (setq b (mime-entity-body-start entity))) -;; (goto-char b) -;; (write-region b end file) -;; (message "External method is starting...") -;; (setq cal (put-alist -;; 'name (replace-as-filename name) cal)) -;; (setq cal (put-alist 'file file cal)) -;; (setq args (nconc -;; (list (car method) -;; mime-echo-buffer-name (car method)) -;; (mime-make-external-method-args -;; cal (cdr (cdr method))) -;; )) -;; (apply (function start-process) args) -;; (mime-show-echo-buffer) -;; )) -;; ))))) - -;; (defun mime-make-external-method-args (cal format) -;; (mapcar (function -;; (lambda (arg) -;; (if (stringp arg) -;; arg -;; (let* ((item (eval arg)) -;; (ret (cdr (assoc item cal)))) -;; (or ret -;; (if (eq item 'encoding) -;; "7bit" -;; "")) -;; )))) -;; format)) - (defvar mime-echo-window-is-shared-with-bbdb t "*If non-nil, mime-echo window is shared with BBDB window.") @@ -336,47 +294,27 @@ window.") (concat (regexp-* mime-view-file-name-char-regexp) "\\(\\." mime-view-file-name-char-regexp "+\\)*")) -(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 - (assoc - "filename" - (mime-content-disposition-parameters ret))) - ) - (setq ret (assoc "name" param)) - (setq ret (assoc "x-name" param)) - ) - (std11-strip-quoted-string (cdr ret)) - ) - (if (setq ret - (std11-find-field-body '("Content-Description" - "Subject"))) - (if (or (string-match mime-view-file-name-regexp-1 ret) - (string-match mime-view-file-name-regexp-2 ret)) - (substring ret (match-beginning 0)(match-end 0)) - )) - )) - )) - -(defun mime-raw-get-filename (param) - (replace-as-filename (mime-raw-get-original-filename param)) - ) +(defun mime-entity-safe-filename (entity) + (replace-as-filename + (or (mime-entity-filename entity) + (let ((ret (or (mime-entity-read-field entity 'Content-Description) + (mime-entity-read-field entity 'Subject)))) + (if (or (string-match mime-view-file-name-regexp-1 ret) + (string-match mime-view-file-name-regexp-2 ret)) + (substring ret (match-beginning 0)(match-end 0)) + ))))) ;;; @ file extraction ;;; -(defun mime-method-to-save (entity cal) +(defun mime-save-content (entity cal) (let ((beg (mime-entity-point-min entity)) (end (mime-entity-point-max entity))) (goto-char beg) (let* ((name (save-restriction (narrow-to-region beg end) - (mime-raw-get-filename cal) + (mime-entity-safe-filename entity) )) (encoding (or (cdr (assq 'encoding cal)) "7bit")) (filename (if (and name (not (string-equal name ""))) @@ -415,13 +353,13 @@ REGEXP is pattern for \"file\" command output. TYPE is symbol to indicate primary type of media-type. SUBTYPE is symbol to indicate subtype of media-type.") -(defun mime-method-to-detect (entity situation) +(defun mime-detect-content (entity situation) (let ((beg (mime-entity-point-min entity)) (end (mime-entity-point-max entity))) (goto-char beg) (let* ((name (save-restriction (narrow-to-region beg end) - (mime-raw-get-filename situation) + (mime-entity-safe-filename entity) )) (encoding (or (cdr (assq 'encoding situation)) "7bit")) (filename (if (and name (not (string-equal name ""))) @@ -467,7 +405,7 @@ It is registered to variable `mime-preview-quitting-method-alist'." (pop-to-buffer mother) )) -(defun mime-method-to-display-message/rfc822 (entity cal) +(defun mime-view-message/rfc822 (entity cal) (let* ((beg (mime-entity-point-min entity)) (end (mime-entity-point-max entity)) (cnum (mime-raw-point-to-entity-number beg)) @@ -510,7 +448,7 @@ saved as binary. Otherwise the region is saved by `write-region'." (write-region start end filename) ))) -(defun mime-method-to-store-message/partial (entity cal) +(defun mime-store-message/partial-piece (entity cal) (goto-char (mime-entity-point-min entity)) (let* ((root-dir (expand-file-name @@ -642,7 +580,7 @@ saved as binary. Otherwise the region is saved by `write-region'." (dired dir) )) -(defun mime-method-to-display-message/external-ftp (entity cal) +(defun mime-view-message/external-ftp (entity cal) (let* ((site (cdr (assoc "site" cal))) (directory (cdr (assoc "directory" cal))) (name (cdr (assoc "name" cal))) @@ -657,7 +595,7 @@ saved as binary. Otherwise the region is saved by `write-region'." ;;; @ rot13-47 ;;; -(defun mime-method-to-display-caesar (entity situation) +(defun mime-view-caesar (entity situation) "Internal method for mime-view to display ROT13-47-48 message." (let* ((new-name (format "%s-%s" (buffer-name) (mime-entity-number entity))) diff --git a/mime-text.el b/mime-text.el index c7022f7..60bbdc7 100644 --- a/mime-text.el +++ b/mime-text.el @@ -101,7 +101,7 @@ SITUATION. It must be symbol." ;;; @ content filters for mime-text ;;; -(defun mime-preview-text/plain (entity situation) +(defun mime-display-text/plain (entity situation) (save-restriction (narrow-to-region (point-max)(point-max)) (mime-text-insert-decoded-body entity) @@ -110,10 +110,10 @@ SITUATION. It must be symbol." (insert "\n") ) (mime-text-add-url-buttons) - (run-hooks 'mime-preview-text/plain-hook) + (run-hooks 'mime-display-text/plain-hook) )) -(defun mime-preview-text/richtext (entity situation) +(defun mime-display-text/richtext (entity situation) (save-restriction (narrow-to-region (point-max)(point-max)) (mime-text-insert-decoded-body entity) @@ -122,7 +122,7 @@ SITUATION. It must be symbol." (richtext-decode beg (point-max)) ))) -(defun mime-preview-text/enriched (entity situation) +(defun mime-display-text/enriched (entity situation) (save-restriction (narrow-to-region (point-max)(point-max)) (mime-text-insert-decoded-body entity) diff --git a/mime-view.el b/mime-view.el index 3fe5010..5077e46 100644 --- a/mime-view.el +++ b/mime-view.el @@ -28,8 +28,7 @@ ;;; Code: (require 'std11) -(require 'mel) -(require 'eword-decode) +(require 'mime-lib) (require 'mime-parse) (require 'semi-def) (require 'calist) @@ -41,9 +40,10 @@ ;;; (defconst mime-view-version-string - `,(concat (car mime-module-version) " MIME-View " - (mapconcat #'number-to-string (cddr mime-module-version) ".") - " (" (cadr mime-module-version) ")")) + `,(concat (car mime-user-interface-version) " MIME-View " + (mapconcat #'number-to-string + (cddr mime-user-interface-version) ".") + " (" (cadr mime-user-interface-version) ")")) ;;; @ variables @@ -244,15 +244,20 @@ If optional argument MESSAGE-INFO is not specified, (defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode")) -(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 (entity) - (or (std11-find-field-body '("Content-Description" "Subject")) +(defun mime-entity-uu-filename (entity) + (if (member (mime-entity-encoding entity) + mime-view-uuencode-encoding-name-list) + (save-excursion + (set-buffer (mime-entity-buffer entity)) + (goto-char (mime-entity-body-start entity)) + (if (re-search-forward "^begin [0-9]+ " + (mime-entity-body-end entity) t) + (if (looking-at ".+$") + (buffer-substring (match-beginning 0)(match-end 0)) + ))))) + +(defun mime-entity-filename (entity) + (or (mime-entity-uu-filename entity) (let ((ret (mime-entity-content-disposition entity))) (and ret (setq ret (mime-content-disposition-filename ret)) @@ -268,9 +273,12 @@ If optional argument MESSAGE-INFO is not specified, ))) (std11-strip-quoted-string ret) )) - (if (member (mime-entity-encoding entity) - mime-view-uuencode-encoding-name-list) - (mime-raw-get-uu-filename)) + )) + +(defun mime-view-entity-title (entity) + (or (mime-entity-read-field entity 'Content-Description) + (mime-entity-read-field entity 'Subject) + (mime-entity-filename entity) "")) @@ -328,10 +336,11 @@ Please redefine this function if you want to change default setting." ;;; @@@ entity button generator ;;; -(defun mime-view-insert-entity-button (entity subject) +(defun mime-view-insert-entity-button (entity) "Insert entity-button of ENTITY." (let ((entity-node-id (mime-entity-node-id entity)) - (params (mime-entity-parameters entity))) + (params (mime-entity-parameters entity)) + (subject (mime-view-entity-title entity))) (mime-insert-button (let ((access-type (assoc "access-type" params)) (num (or (cdr (assoc "x-part-number" params)) @@ -383,18 +392,11 @@ Please redefine this function if you want to change default setting." ;;; @@ entity-header ;;; -;;; @@@ entity header filter -;;; - -(defvar mime-view-content-header-filter-alist nil) - -(defun mime-view-default-content-header-filter () - (mime-view-cut-header) - (eword-decode-header) - ) - -;;; @@@ entity field cutter -;;; +(defvar mime-header-presentation-method-alist nil + "Alist of major mode vs. corresponding header-presentation-method functions. +Each element looks like (SYMBOL . FUNCTION). +SYMBOL must be major mode in raw-buffer or t. t means default. +Interface of FUNCTION must be (ENTITY SITUATION).") (defvar mime-view-ignored-field-list '(".*Received" ".*Path" ".*Id" "References" @@ -405,36 +407,10 @@ Please redefine this function if you want to change default setting." "All fields that match this list will be hidden in MIME preview buffer. Each elements are regexp of field-name.") -(defvar mime-view-ignored-field-regexp - (concat "^" - (apply (function regexp-or) mime-view-ignored-field-list) - ":")) - (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.") -(defun mime-view-cut-header () - (goto-char (point-min)) - (while (re-search-forward mime-view-ignored-field-regexp nil t) - (let* ((beg (match-beginning 0)) - (end (match-end 0)) - (name (buffer-substring beg end)) - ) - (catch 'visible - (let ((rest mime-view-visible-field-list)) - (while rest - (if (string-match (car rest) name) - (throw 'visible nil) - ) - (setq rest (cdr rest)))) - (delete-region beg - (save-excursion - (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t) - (match-beginning 0) - (point-max)))) - )))) - ;;; @@ entity-body ;;; @@ -496,42 +472,42 @@ Each elements are regexp of field-name.") (ctree-set-calist-strictly 'mime-preview-condition '((body . visible) - (body-presentation-method . mime-preview-text/plain))) + (body-presentation-method . mime-display-text/plain))) (ctree-set-calist-strictly 'mime-preview-condition '((type . nil) (body . visible) - (body-presentation-method . mime-preview-text/plain))) + (body-presentation-method . mime-display-text/plain))) (ctree-set-calist-strictly 'mime-preview-condition '((type . text)(subtype . enriched) (body . visible) - (body-presentation-method . mime-preview-text/enriched))) + (body-presentation-method . mime-display-text/enriched))) (ctree-set-calist-strictly 'mime-preview-condition '((type . text)(subtype . richtext) (body . visible) - (body-presentation-method . mime-preview-text/richtext))) + (body-presentation-method . mime-display-text/richtext))) (ctree-set-calist-strictly 'mime-preview-condition '((type . text)(subtype . t) (body . visible) - (body-presentation-method . mime-preview-text/plain))) + (body-presentation-method . mime-display-text/plain))) (ctree-set-calist-strictly 'mime-preview-condition '((type . multipart)(subtype . alternative) (body . visible) - (body-presentation-method . mime-preview-multipart/alternative))) + (body-presentation-method . mime-display-multipart/alternative))) (ctree-set-calist-strictly 'mime-preview-condition '((type . message)(subtype . partial) (body-presentation-method - . mime-preview-message/partial-button))) + . mime-display-message/partial-button))) (ctree-set-calist-strictly 'mime-preview-condition '((type . message)(subtype . rfc822) @@ -549,9 +525,9 @@ Each elements are regexp of field-name.") ;;; @@@ entity presentation ;;; -(autoload 'mime-preview-text/plain "mime-text") -(autoload 'mime-preview-text/enriched "mime-text") -(autoload 'mime-preview-text/richtext "mime-text") +(autoload 'mime-display-text/plain "mime-text") +(autoload 'mime-display-text/enriched "mime-text") +(autoload 'mime-display-text/richtext "mime-text") (defvar mime-view-announcement-for-message/partial (if (and (>= emacs-major-version 19) window-system) @@ -563,7 +539,7 @@ This is message/partial style split message. Please press `v' key in this buffer." )) -(defun mime-preview-message/partial-button (&optional entity situation) +(defun mime-display-message/partial-button (&optional entity situation) (save-restriction (goto-char (point-max)) (if (not (search-backward "\n\n" nil t)) @@ -578,17 +554,12 @@ Please press `v' key in this buffer." #'mime-preview-play-current-entity) )) -(defun mime-preview-multipart/mixed (entity situation) +(defun mime-display-multipart/mixed (entity situation) (let ((children (mime-entity-children entity)) (default-situation (cdr (assq 'childrens-situation situation)))) (while children - (mime-view-display-entity (car children) - (save-excursion - (set-buffer (mime-entity-buffer entity)) - mime-raw-message-info) - (current-buffer) - default-situation) + (mime-display-entity (car children) nil default-situation) (setq children (cdr children)) ))) @@ -607,7 +578,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (item :tag "Default" t)) integer))) -(defun mime-preview-multipart/alternative (entity situation) +(defun mime-display-multipart/alternative (entity situation) (let* ((children (mime-entity-children entity)) (default-situation (cdr (assq 'childrens-situation situation))) @@ -650,16 +621,10 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (while children (let ((child (car children)) (situation (car situations))) - (mime-view-display-entity child - (save-excursion - (set-buffer (mime-entity-buffer child)) - mime-raw-message-info) - (current-buffer) - default-situation - (if (= i p) - situation - (del-alist 'body-presentation-method - (copy-alist situation)))) + (mime-display-entity child (if (= i p) + situation + (del-alist 'body-presentation-method + (copy-alist situation)))) ) (setq children (cdr children) situations (cdr situations) @@ -706,47 +671,47 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." 'mime-acting-condition '((type . application)(subtype . octet-stream) (mode . "play") - (method . mime-method-to-detect) + (method . mime-detect-content) )) (ctree-set-calist-with-default 'mime-acting-condition '((mode . "extract") - (method . mime-method-to-save))) + (method . mime-save-content))) (ctree-set-calist-strictly 'mime-acting-condition '((type . text)(subtype . x-rot13-47)(mode . "play") - (method . mime-method-to-display-caesar) + (method . mime-view-caesar) )) (ctree-set-calist-strictly 'mime-acting-condition '((type . text)(subtype . x-rot13-47-48)(mode . "play") - (method . mime-method-to-display-caesar) + (method . mime-view-caesar) )) (ctree-set-calist-strictly 'mime-acting-condition '((type . message)(subtype . rfc822)(mode . "play") - (method . mime-method-to-display-message/rfc822) + (method . mime-view-message/rfc822) )) (ctree-set-calist-strictly 'mime-acting-condition '((type . message)(subtype . partial)(mode . "play") - (method . mime-method-to-store-message/partial) + (method . mime-store-message/partial-piece) )) (ctree-set-calist-strictly 'mime-acting-condition '((type . message)(subtype . external-body) ("access-type" . "anon-ftp") - (method . mime-method-to-display-message/external-ftp) + (method . mime-view-message/external-ftp) )) (ctree-set-calist-strictly 'mime-acting-condition '((type . application)(subtype . octet-stream) - (method . mime-method-to-save) + (method . mime-save-content) )) @@ -768,7 +733,7 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." ;;; @ following method ;;; -(defvar mime-view-following-method-alist nil +(defvar mime-preview-following-method-alist nil "Alist of major-mode vs. following-method of mime-view.") (defvar mime-view-following-required-fields-list @@ -810,26 +775,15 @@ The compressed face will be piped to this command.") ;;; @ buffer setup ;;; -(defun mime-view-display-entity (entity message-info obuf - default-situation - &optional situation) +(defun mime-display-entity (entity &optional situation + default-situation preview-buffer) + (or preview-buffer + (setq preview-buffer (current-buffer))) (let* ((raw-buffer (mime-entity-buffer entity)) (start (mime-entity-point-min entity)) - (end (mime-entity-point-max entity)) - original-major-mode end-of-header e nb ne subj) + e nb ne) (set-buffer raw-buffer) - (setq original-major-mode major-mode) (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 entity))) - ) (or situation (setq situation (or (ctree-match-calist mime-preview-condition @@ -840,43 +794,43 @@ The compressed face will be piped to this command.") (eq (cdr (assq 'entity-button situation)) 'invisible)) (header-is-visible (eq (cdr (assq 'header situation)) 'visible)) + (header-presentation-method + (or (cdr (assq 'header-presentation-method situation)) + (cdr (assq major-mode mime-header-presentation-method-alist)))) (body-presentation-method (cdr (assq 'body-presentation-method situation))) (children (mime-entity-children entity))) - (set-buffer obuf) + (set-buffer preview-buffer) (setq nb (point)) (narrow-to-region nb nb) (or button-is-invisible (if (mime-view-entity-button-visible-p entity) - (mime-view-insert-entity-button entity subj) - )) - (if header-is-visible - (save-restriction - (narrow-to-region (point)(point)) - (insert-buffer-substring raw-buffer start end-of-header) - (let ((f (cdr (assq 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) + (mime-view-insert-entity-button entity) )) - (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 raw-buffer end-of-header end) - (funcall body-filter situation) - ))) - (children) - ((functionp body-presentation-method) + (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 + (save-excursion + (set-buffer raw-buffer) + (if (eq (cdr (assq major-mode mime-raw-representation-type-alist)) + 'binary) + default-mime-charset) + ))) + (goto-char (point-max)) + (insert "\n") + (run-hooks 'mime-display-header-hook) + ) + (cond (children) + ((functionp body-presentation-method) (funcall body-presentation-method entity situation) ) (t (when button-is-invisible (goto-char (point-max)) - (mime-view-insert-entity-button entity subj) + (mime-view-insert-entity-button entity) ) (or header-is-visible (progn @@ -891,7 +845,7 @@ The compressed face will be piped to this command.") (if children (if (functionp body-presentation-method) (funcall body-presentation-method entity situation) - (mime-preview-multipart/mixed entity situation) + (mime-display-multipart/mixed entity situation) )) ))) @@ -1032,8 +986,8 @@ The compressed face will be piped to this command.") (defvar mime-view-redisplay nil) -(defun mime-view-display-message (message &optional preview-buffer - mother default-keymap-or-function) +(defun mime-display-message (message &optional preview-buffer + mother default-keymap-or-function) (mime-maybe-hide-echo-buffer) (let ((win-conf (current-window-configuration)) (raw-buffer (mime-entity-buffer message))) @@ -1054,11 +1008,10 @@ The compressed face will be piped to this command.") (setq mime-preview-original-window-configuration win-conf) (setq major-mode 'mime-view-mode) (setq mode-name "MIME-View") - (mime-view-display-entity message message - preview-buffer - '((entity-button . invisible) - (header . visible) - )) + (mime-display-entity message nil + '((entity-button . invisible) + (header . visible)) + preview-buffer) (mime-view-define-keymap default-keymap-or-function) (let ((point (next-single-property-change (point-min) 'mime-view-entity))) @@ -1076,7 +1029,7 @@ The compressed face will be piped to this command.") (defun mime-view-buffer (&optional raw-buffer preview-buffer mother default-keymap-or-function) (interactive) - (mime-view-display-message + (mime-display-message (save-excursion (if raw-buffer (set-buffer raw-buffer)) (mime-parse-message) @@ -1109,7 +1062,7 @@ button-2 Move to point under the mouse cursor and decode current content as `play mode' " (interactive) - (mime-view-display-message + (mime-display-message (save-excursion (if raw-buffer (set-buffer raw-buffer)) (or mime-view-redisplay @@ -1149,7 +1102,7 @@ It decodes current entity to call internal or external method as (defun mime-preview-follow-current-entity () "Write follow message to current entity. It calls following-method selected from variable -`mime-view-following-method-alist'." +`mime-preview-following-method-alist'." (interactive) (let (entity) (while (null (setq entity @@ -1264,7 +1217,7 @@ It calls following-method selected from variable )) (eword-decode-header) ) - (let ((f (cdr (assq mode mime-view-following-method-alist)))) + (let ((f (cdr (assq mode mime-preview-following-method-alist)))) (if (functionp f) (funcall f new-buf) (message diff --git a/semi-def.el b/semi-def.el index 75a9280..8ca1e9a 100644 --- a/semi-def.el +++ b/semi-def.el @@ -29,7 +29,7 @@ (eval-when-compile (require 'cl)) -(defconst mime-module-version '("WEMI" "Yugawara" 1 6 0) +(defconst mime-user-interface-version '("WEMI" "Atami" 1 7 0) "Implementation name, version name and numbers of MIME-kernel package.") (autoload 'mule-caesar-region "mule-caesar" @@ -256,20 +256,6 @@ FUNCTION.") ;;; @ Other Utility ;;; -(defun call-after-loaded (module func &optional hook-name) - "If MODULE is provided, then FUNC is called. -Otherwise func is set to MODULE-load-hook. -If optional argument HOOK-NAME is specified, -it is used as hook to set." - (if (featurep module) - (funcall func) - (or hook-name - (setq hook-name (intern (concat (symbol-name module) "-load-hook"))) - ) - (add-hook hook-name func) - )) - - (defvar mime-condition-type-alist '((preview . mime-preview-condition) (action . mime-acting-condition))) diff --git a/semi-setup.el b/semi-setup.el index 10bc81a..e7decc8 100644 --- a/semi-setup.el +++ b/semi-setup.el @@ -27,6 +27,19 @@ (require 'semi-def) (require 'path-util) +(defun call-after-loaded (module func &optional hook-name) + "If MODULE is provided, then FUNC is called. +Otherwise func is set to MODULE-load-hook. +If optional argument HOOK-NAME is specified, +it is used as hook to set." + (if (featurep module) + (funcall func) + (or hook-name + (setq hook-name (intern (concat (symbol-name module) "-load-hook"))) + ) + (add-hook hook-name func) + )) + ;; for image/* and X-Face (defvar mime-setup-enable-inline-image @@ -82,33 +95,33 @@ (message-button . visible))) (mime-add-condition 'action '((type . application)(subtype . pgp) - (method . mime-method-for-application/pgp)) + (method . mime-view-application/pgp)) 'strict "mime-pgp") (mime-add-condition 'action '((type . text)(subtype . x-pgp) - (method . mime-method-for-application/pgp))) + (method . mime-view-application/pgp))) (mime-add-condition 'action '((type . multipart)(subtype . signed) - (method . mime-method-to-verify-multipart/signed)) + (method . mime-verify-multipart/signed)) 'strict "mime-pgp") (mime-add-condition 'action '((type . application)(subtype . pgp-signature) - (method . mime-method-to-verify-application/pgp-signature)) + (method . mime-verify-application/pgp-signature)) 'strict "mime-pgp") (mime-add-condition 'action '((type . application)(subtype . pgp-encrypted) - (method . mime-method-to-decrypt-application/pgp-encrypted)) + (method . mime-decrypt-application/pgp-encrypted)) 'strict "mime-pgp") (mime-add-condition 'action '((type . application)(subtype . pgp-keys) - (method . mime-method-to-add-application/pgp-keys)) + (method . mime-add-application/pgp-keys)) 'strict "mime-pgp") )) )