From 56867dd5cee177d69de40c2025eb685e264b3e37 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Mon, 15 Jun 1998 23:02:53 +0000 Subject: [PATCH] Sync up with SEMI 1.6.0. --- ChangeLog | 284 ++++++++++++++++++++++++++++ MIME-View-API-ja.ol | 46 ++--- Makefile | 2 +- NEWS | 57 ++++++ TODO | 2 + VERSION | 13 +- mime-edit.el | 205 +++++++++----------- mime-mc.el | 2 +- mime-parse.el | 5 + mime-partial.el | 8 +- mime-pgp.el | 36 ++-- mime-play.el | 430 ++++++++++++++++++++++-------------------- mime-view.el | 515 +++++++++++++++++++++++---------------------------- mime-w3.el | 26 ++- semi-def.el | 2 +- 15 files changed, 978 insertions(+), 655 deletions(-) diff --git a/ChangeLog b/ChangeLog index f9de6ed..308f00a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,287 @@ +1998-06-16 Katsumi Yamaoka + + * WEMI: Version 1.6.0 (Yugawara) released. + +1998-06-15 MORIOKA Tomohiko + + * mime-view-ja.texi, mime-view-ja.sgml: New files. + + * mime-view.el (mime-view-mode): Fix DOC-string. + +1998-06-15 MORIOKA Tomohiko + + * mime-play.el (mime-file-content-type-alist): Renamed from + `mime-file-type-regexp-type-subtype-alist'. + +1998-06-14 MORIOKA Tomohiko + + * NEWS: Add description about + `mime-preview-over-to-{previous|next}-method-alist'. + + * mime-view.el (mime-preview-over-to-previous-method-alist): + Add DOC-string. + (mime-preview-over-to-next-method-alist): Add DOC-string. + + * mime-view.el (mime-preview-over-to-previous-method-alist): + Renamed from `mime-view-over-to-previous-method-alist'. + (mime-preview-over-to-next-method-alist): Renamed from + `mime-view-over-to-next-method-alist'. + +1998-06-13 MORIOKA Tomohiko + + * mime-w3.el (mime-save-background-color): Fixed. + + * mime-view.el (mime-acting-condition): Set up + `mime-method-to-detect' for application/octet-stream in "play" + mode. + + * mime-play.el (mime-file-type-regexp-type-subtype-alist): New + variable. + (mime-method-to-detect): New function. + +1998-06-13 MORIOKA Tomohiko + + * mime-play.el (mime-sort-situation): Modify for + Content-Disposition information. + +1998-06-13 MORIOKA Tomohiko + + * mime-view.el: Abolish variable `mime-view-show-summary-method' + and function `mime-preview-show-summary'. + +1998-06-13 MORIOKA Tomohiko + + * mime-view.el (mime-entity-situation): Add information of + Content-Disposition. + +1998-06-12 MORIOKA Tomohiko + + * MIME-View-API-ja.ol (mime-preview-buffer): Add description about + `mime-preview-original-major-mode'. + + * mime-view.el (mime-preview-original-major-mode): Modify + DOC-string. + + * NEWS: Add description about abolishment of tm-compatible + external method support. + + * mime-play.el (mime-raw-play-entity): Abolish tm-compatible + external method support; abolish function + `mime-activate-external-method' and + `mime-make-external-method-args'. + +1998-06-12 MORIOKA Tomohiko + + * mime-play.el (mime-activate-mailcap-method): Use + `mime-entity-body-start'. + + * mime-play.el (mime-activate-external-method): Change interface. + + * mime-play.el (mime-activate-mailcap-method): Change interface. + +1998-06-12 MORIOKA Tomohiko + + * MIME-View-API-ja.ol (mime-preview-buffer): Delete description + about text-property `mime-view-raw-buffer'. + + * mime-play.el (mime-preview-play-current-entity): Don't refer + text-property `mime-view-raw-buffer'. + + * mime-view.el (mime-view-display-entity): Don't set up + text-property `mime-view-raw-buffer'. + +1998-06-12 MORIOKA Tomohiko + + * MIME-View-API-ja.ol: Abolish description about + `mime-preview-original-major-mode'. + + * NEWS (Changes in SEMI 1.6): New chapter. + + * TODO (multipart/related support): New item. + +1998-06-12 MORIOKA Tomohiko + + * NEWS: Add description about mime-w3.el. + +1998-06-12 MORIOKA Tomohiko + + * mime-w3.el (mime-save-background-color): New macro. + (mime-preview-text/html): Use `mime-save-background-color'. + +1998-06-11 MORIOKA Tomohiko + + * mime-edit.el: Abolish variable `mime-edit-signing-type' and + `mime-edit-encrypting-type'. + (mime-edit-process-multipart-1): Separate "signed" to "pgp-signed" + and "kazu-signed"; separate "encrypted" to "pgp-encrypted" and + "kazu-encrypted". + (mime-edit-enclose-signed-region): Renamed from + `mime-edit-enclose-pgp-signed-region'. + (mime-edit-enclose-pgp-encrypted-region): Renamed from + `mime-edit-enclose-encrypted-region'. + (mime-edit-enclose-kazu-signed-region): New function. + (mime-edit-enclose-kazu-encrypted-region): New function. + (mime-edit-set-sign): Don't refer `mime-edit-signing-type'. + (mime-edit-set-encrypt): Don't refer `mime-edit-encrypting-type'. + +1998-06-11 MORIOKA Tomohiko + + * mime-edit.el (mime-edit-sign-pgp-kazu): Abolish unused local + variable. + (mime-edit-encrypt-pgp-kazu): Abolish unused local variables. + +1998-06-11 MORIOKA Tomohiko + + * mime-pgp.el (mime-method-for-application/pgp): Change interface. + (mime-method-to-verify-multipart/signed): Change interface. + (mime-method-to-verify-application/pgp-signature): Change + interface. + (mime-method-to-decrypt-application/pgp-encrypted): Change + interface. + (mime-method-to-add-application/pgp-keys): Change interface. + + * mime-partial.el (mime-method-to-combine-message/partial-pieces): + Change interface. + + * mime-play.el (mime-raw-play-entity): Change interface of + internal-method. + (mime-method-to-save): Change interface. + (mime-method-to-display-message/rfc822): Change interface. + (mime-method-to-store-message/partial): Change interface. + (mime-method-to-display-message/external-ftp): Change interface. + (mime-method-to-display-caesar): Change interface. + +1998-06-11 MORIOKA Tomohiko + + * mime-edit.el (mime-edit-normalize-body): Use + `mime-charset-type-list' directly; abolish local variable + `mime-edit-charset-default-encoding-alist' and function + `mime-make-charset-default-encoding-alist'. + (mime-edit-toggle-transfer-level): Don't set up + `mime-edit-charset-default-encoding-alist'. + +1998-06-11 MORIOKA Tomohiko + + * mime-view.el (mime-view-display-message): Set up + `mime-raw-message-info'. + (mime-view-buffer): New function. + (mime-view-mode): Don't set up `mime-raw-message-info'. + +1998-06-11 MORIOKA Tomohiko + + * mime-edit.el (mime-charset-type-list): Use base64 for cn-gb2312 + and gb2312. + (mime-edit-normalize-body): If encoding is not specified for + charset, use quoted-printable or 8bit for mime-transfer-level is 7 + or 8. + + * mime-edit.el (mime-charset-type-list): Add `shift_jis'. + +1998-06-10 MORIOKA Tomohiko + + * mime-view.el (mime-view-display-message): Use + `mime-maybe-hide-echo-buffer'. + (mime-view-mode): Don't use `mime-maybe-hide-echo-buffer'. + + * mime-view.el (mime-view-display-message): Move point to top of + body; run `mime-view-mode-hook'. + (mime-view-mode): Don't move point; don't run + `mime-view-mode-hook'. + + * mime-view.el (mime-view-display-message): Add new optional + argument `default-keymap-or-function'. + (mime-view-mode): Modify for `mime-view-display-message'. + + * mime-view.el (mime-view-display-message): Add new optional + argument `mother'; set to `mime-mother-buffer'. + (mime-view-mode): Modify for `mime-view-display-message'. + +1998-06-10 MORIOKA Tomohiko + + * mime-mc.el: Use `eval-and-compile' to load "mc-pgp". + + * mime-view.el (mime-preview-multipart/mixed): Modify for + `mime-view-display-entity'; don't refer `mime-raw-buffer'. + (mime-preview-multipart/alternative): Modify for + `mime-view-display-entity'; don't refer `mime-raw-buffer'. + (mime-view-display-entity): Change interface to abolish argument + for raw-buffer; don't refer `mime-raw-buffer'. + (mime-view-display-message): Abolish variable + `mime-preview-original-major-mode'; modify for + `mime-view-display-entity'. + (mime-preview-original-major-mode): New implementation; add + optional argument `recursive'. + (mime-preview-follow-current-entity): Modify for + `mime-preview-original-major-mode'. + (mime-preview-move-to-next): Use function + `mime-preview-original-major-mode'. + (mime-preview-scroll-up-entity): Use function + `mime-preview-original-major-mode'. + (mime-preview-scroll-down-entity): Use function + `mime-preview-original-major-mode'. + (mime-preview-quit): Use function + `mime-preview-original-major-mode'. + (mime-preview-show-summary): Use function + `mime-preview-original-major-mode'. + + * mime-view.el (mime-view-display-message): New function; abolish + function `mime-view-setup-buffers'. + (mime-view-mode): Use `mime-view-display-message'. + +1998-06-10 MORIOKA Tomohiko + + * mime-play.el (mime-raw-play-entity): Use + `mime-entity-situation'. + + * mime-view.el (mime-entity-situation): New function. + (mime-preview-multipart/alternative): Use `mime-entity-situation'. + (mime-view-display-entity): Use `mime-entity-situation'. + +1998-06-10 MORIOKA Tomohiko + + * mime-edit.el (mime-edit-enclose-region-internal): Abolish unused + local variable. + +1998-06-09 MORIOKA Tomohiko + + * MIME-View-API-ja.ol (entity): Add description of + `mime-entity-number'. + + * mime-play.el (mime-method-to-display-caesar): Use + `mime-entity-number'. + + * mime-parse.el (mime-entity-number): New function. + +1998-06-09 MORIOKA Tomohiko + + * MIME-View-API-ja.ol (entity-button): Modify description of + `mime-view-insert-entity-button'. + + * mime-view.el (mime-view-insert-entity-button): Change interface. + (mime-view-display-entity): Modify for + `mime-view-insert-entity-button'. + +1998-06-09 MORIOKA Tomohiko + + * MIME-View-API-ja.ol (entity-button): Modify description of + `mime-view-entity-button-visible-p'. + + * mime-view.el (mime-view-entity-button-visible-p): Change + interface. + (mime-view-display-entity): Modify for + `mime-view-entity-button-visible-p'. + +1998-06-09 MORIOKA Tomohiko + + * MIME-View-API-ja.ol: Add description of `mime-entity-parent' and + abolish description `mime-raw-entity-parent'. + + * mime-view.el (mime-entity-parent): New function; abolish + `mime-raw-entity-parent'. + (mime-view-entity-button-visible-p): Use `mime-entity-parent' + instead of `mime-raw-entity-parent'. + + 1998-06-09 Katsumi Yamaoka * WEMI: Version 1.5.4 (Manazuru) released. diff --git a/MIME-View-API-ja.ol b/MIME-View-API-ja.ol index 43c3afa..8a84180 100644 --- a/MIME-View-API-ja.ol +++ b/MIME-View-API-ja.ol @@ -250,14 +250,6 @@ buffer $B$G$9!#(BMIME $B=qLL$O(B entity $B$rC10L$H$9$kLZ9=B$$G$9$,!"$3$N(B $BMQ$$$k!#(B -[$B4X?t(B] mime-raw-entity-parent (ENTITY &optional MESSAGE-INFO) - - $B=qLL9=B$(B MESSAGE-INFO $B$K$*$$$F(B ENTITY $B$N?F$N(B entity $B$rJV$9!#(B - - MESSAGE-INFO $B$,>JN,$5$l$?>l9g$O(B `mime-raw-message-info' $B$NCM$r(B - $BMQ$$$k!#(B - - [$B4X?t(B] mime-raw-flatten-message-info (&optional message-info) $B=qLL9=B$(B MESSAGE-INFO $B$K4^$^$l$kA4$F$N(B entity $B$N(B list $B$rJV$9!#(B @@ -286,8 +278,6 @@ buffer $B$G$9!#(BMIME $B=qLL$O(B entity $B$rC10L$H$9$kLZ9=B$$G$9$,!"$3$N(B ** API -*** $B0lHL(B - [buffer $B6I=jJQ?t(B] mime-mother-buffer $BBP1~$9$k?F(B buffer $B$r<($9!#(B @@ -310,24 +300,23 @@ buffer $B$G$9!#(BMIME $B=qLL$O(B entity $B$rC10L$H$9$kLZ9=B$$G$9$,!"$3$N(B $B2DG=@-$,$"$k$+$i$G$"$k!#(B -[buffer $B6I=jJQ?t(B] mime-preview-original-major-mode - - $BBP1~$9$k(B mime-raw-buffer $B$K$*$1$k(B major-mode $B$r<($9!#(B - - [buffer $B6I=jJQ?t(B] mime-preview-original-window-configuration mime-preview-buffer $B$r:n$kA0$N(B window-configuration $B$r<}$a$k!#(B -[text-property] mime-view-raw-buffer +[text-property] mime-view-entity - $B$3$N0LCV$KBP1~$9$k(B mime-raw-buffer $B$r<($9!#(B + $B8=:_0LCV$KBP1~$9$k(B entity $B9=B$BN$r<($9!#(B -[text-property] mime-view-entity +[$B4X?t(B] mime-preview-original-major-mode (&optional recursive) + + $B8=:_0LCV$KBP1~$9$k(B entity $B$NI=>]$,B8:_$9$k(B buffer $B$N(B + major-mode $B$rJV$9!#(B - $B$3$N0LCV$KBP1~$9$k(B entity $B9=B$BN$r<($9!#(B + RECURSIVE $B$K(B non-nil $B$,;XDj$5$l$?>l9g!";OAD$N(B major-mode $B$rJV(B + $B$9!#(B * entity @@ -445,6 +434,21 @@ entity-number $B$H8F$S$^$9!#(Bentity-number $B$O(B S $B<0$H$7$F$O(B (1 2 3 entity $B$N@8@.;R!#(B +[$B4X?t(B] mime-entity-number (ENTITY) + + ENTITY $B$N(B entity-number $B$rJV$9!#(B + + +[$B4X?t(B] mime-entity-parent (ENTITY &optional MESSAGE-INFO) + + ENTITY $B$N?F$N(B entity $B$rJV$9!#(B + + MESSAGE-INFO $B$,>JN,$5$l$?>l9g$O(B ENTITY $B$,B8:_$9$k(B buffer $B$K$*(B + $B$1$k(B `mime-raw-message-info' $B$NCM$rMQ$$$k!#(B + + MESSAGE-INFO $B$,;XDj$5$l$?>l9g!"$3$l$r:,$H8+Jo$9!#(B + + [$B4X?t(B] mime-root-entity-p (ENTITY) ENTITY $B$,(B root-entity$B!JB($A!"(Bmessage $BA4BN!K$G$"$k>l9g$K!"Hs(B @@ -503,12 +507,12 @@ media-type/subtype $BEy$N(B entity $B$N9=B$!&7A<0$K4X$9$k>pJs$KBP$7$F!"I=<(( ** entity-button -[$B4X?t(B] mime-view-entity-button-visible-p (ENTITY MESSAGE-INFO) +[$B4X?t(B] mime-view-entity-button-visible-p (ENTITY) $BHs(B nil $B$N>l9g!"(Bentity-button $B$rI=<($9$k$3$H$rI=$9!#(B -[$B4X?t(B] mime-view-insert-entity-button (ENTITY MESSAGE-INFO SUBJECT) +[$B4X?t(B] mime-view-insert-entity-button (ENTITY SUBJECT) ENTITY $B$N(B entity-button $B$rA^F~$9$k!#(B diff --git a/Makefile b/Makefile index cdb239e..7242f59 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ # Makefile for WEMI. # -VERSION = 1.5.4 +VERSION = 1.6.0 PACKAGE = wemi SHELL = /bin/sh diff --git a/NEWS b/NEWS index bde99e3..20be678 100644 --- a/NEWS +++ b/NEWS @@ -1,8 +1,64 @@ SEMI NEWS --- history of major-changes. Copyright (C) 1998 Free Software Foundation, Inc. +* Changes in SEMI 1.6 + +** Abolish tm-compatible external method support + + Abolish tm-compatible external method support. Please use mailcap +method instead of it. + + +** Abolish `mime-edit-signing-type' and `mime-edit-encrypting-type' + + C-c C-m C-s encloses as "pgp-signed" which means PGP/MIME signature. + + C-c C-m C-e encloses as "pgp-encrypted" which means PGP/MIME +encryption. + + +** New interface to display message + +- Function `mime-view-buffer' +- Function `mime-view-display-message' + + +** Change interface of internal playback method + + Interface of internal playback method was changed to + + (entity situation) + +It is as same as interface of body-presentation-method. + + +** Change interface of `mime-view-entity-button-visible-p' + +** Change interface of `mime-view-insert-entity-button' + + +** `mime-preview-original-major-mode' + + Abolish variable `mime-preview-original-major-mode'. + + Please use function `mime-preview-original-major-mode' instead of +it. + + +** mime-preview-over-to-{previous|next}-method-alist + + `mime-preview-over-to-{previous|next}-method-alist' were renamed +from `mime-view-over-to-{previous|next}-method-alist'. + + * Changes in SEMI 1.5 +** mime-w3 + + Add inline text/html preview feature using w3. If +`mime-setup-enable-inline-html' is not nil, semi-setup.el sets up it. + + ** `pgp-elkins' -> `pgp-mime' Rename `pgp-elkins' -> `pgp-mime'. Variable @@ -33,6 +89,7 @@ body-presentation-method to display text entity. In this purpose, old text decoding features were abolished and introduces news features (cf. next section). + ** mime-raw-representation-type and mime-raw-representation-type-alist Abolish `mime-text-decoder' and `mime-text-decoder-alist' because of diff --git a/TODO b/TODO index cb2a11c..aaaac05 100644 --- a/TODO +++ b/TODO @@ -5,6 +5,8 @@ ** dynamic configuration for 'mime-preview-condition +** multipart/related support + ** Don't use filter-model tomo (major developer of SEMI) and akr (major developer of diff --git a/VERSION b/VERSION index 415806a..8c9e1e8 100644 --- a/VERSION +++ b/VERSION @@ -55,7 +55,7 @@ 1.5.2 Kurobe $(B9uIt(B 1.5.3 Uozu $(B5{DE(B ; <=> $(BIY;3COJ}E4F;(B 1.5.4 Higashi-Namerikawa $(BEl3j@n(B ------ Namerikawa $(B3j@n(B ; <=> $(BIY;3COJ}E4F;(B +1.6.0 Namerikawa $(B3j@n(B ; <=> $(BIY;3COJ}E4F;(B ----- Mizuhashi $(B?e66(B ----- Higashi-Toyama $(BElIY;3(B ----- Toyama $(BIY;3(B ; = JR $(B9b;3K\@~!"IY;39A@~(B @@ -106,12 +106,19 @@ 1.5.2 Hayakawa $BAa@n(B 1.5.3 Nebukawa $B:,I\@n(B 1.5.4 Manazuru $B??Da(B ------ Yugawara $BEr2O86(B +1.6.0 Yugawara $BEr2O86(B ----- Atami $(BG.3$(B ; = JR $(B0KEl@~(B ;;------------------------------------------------------------------------- ;; Central Japan Railway $(BEl3$N95RE4F;(B ;;------------------------------------------------------------------------- ----- Kan'nami $(BH!Fn(B +----- Mishima $B;0Eg(B ; = $B0KF&H":,E4F;(B +----- Numazu $B>BDE(B ; = JR $(B8fEB>l@~(B +----- Katahama $BJRIM(B +----- Hara $B86(B +----- Higashi-Tagonoura $BElED;R%N1:(B +----- Yoshiwara $B5H86(B ; = $B3YFnE4F;(B +----- Fuji $BIY;N(B ; = JR $B?H1d@~(B : : : ----- Kanayama $(B6b;3(B ; =$(B!J(BJR $(BCf1{K\@~!K(B ----- Ot-Dòbashi $(BHxF,66(B-A @@ -145,7 +152,7 @@ ;;------------------------------------------------------------------------- 1.4.0 Himi $(BI98+(B 1.5.0 Shimao $(BEgHx(B -1.5.1 Amaharashi $(B1+@2(B +1.6.0 Amaharashi $(B1+@2(B ------- Ecch-Dþ-Kokubu $(B1[Cf9qJ,(B-A ------- Fushiki $(BIzLZ(B ------- Noumachi $(BG=D.(B diff --git a/mime-edit.el b/mime-edit.el index 56e77b0..4924c8d 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -441,10 +441,11 @@ If encoding is nil, it is determined from its contents." (iso-2022-jp 7 "base64") (iso-2022-kr 7 "base64") (euc-kr 8 "base64") - (cn-gb2312 8 "quoted-printable") + (cn-gb2312 8 "base64") + (gb2312 8 "base64") (cn-big5 8 "base64") - (gb2312 8 "quoted-printable") (big5 8 "base64") + (shift_jis 8 "base64") (iso-2022-jp-2 7 "base64") (iso-2022-int-1 7 "base64") )) @@ -464,23 +465,6 @@ If encoding is nil, it is determined from its contents." "A string formatted version of mime-transfer-level") (make-variable-buffer-local 'mime-transfer-level-string) -(defun mime-make-charset-default-encoding-alist (transfer-level) - (mapcar (function - (lambda (charset-type) - (let ((charset (car charset-type)) - (type (nth 1 charset-type)) - (encoding (nth 2 charset-type)) - ) - (if (<= type transfer-level) - (cons charset (mime-encoding-name type)) - (cons charset encoding) - )))) - mime-charset-type-list)) - -(defvar mime-edit-charset-default-encoding-alist - (mime-make-charset-default-encoding-alist mime-transfer-level)) -(make-variable-buffer-local 'mime-edit-charset-default-encoding-alist) - ;;; @@ about message inserting ;;; @@ -533,16 +517,6 @@ If it is not specified for a major-mode, (defvar mime-edit-news-reply-mode-server-running nil) -;;; @@ about PGP -;;; - -(defvar mime-edit-signing-type 'pgp-mime - "*PGP signing type (pgp-mime, pgp-kazu or nil).") - -(defvar mime-edit-encrypting-type 'pgp-mime - "*PGP encrypting type (pgp-mime, pgp-kazu or nil).") - - ;;; @@ about tag ;;; @@ -677,9 +651,9 @@ Tspecials means any character that matches with it in header must be quoted.") (define-key mime-edit-mode-enclosure-map "\C-d" 'mime-edit-enclose-digest-region) (define-key mime-edit-mode-enclosure-map - "\C-s" 'mime-edit-enclose-signed-region) + "\C-s" 'mime-edit-enclose-pgp-signed-region) (define-key mime-edit-mode-enclosure-map - "\C-e" 'mime-edit-enclose-encrypted-region) + "\C-e" 'mime-edit-enclose-pgp-encrypted-region) (define-key mime-edit-mode-enclosure-map "\C-q" 'mime-edit-enclose-quote-region) @@ -707,8 +681,8 @@ Tspecials means any character that matches with it in header must be quoted.") (parallel "Enclose as parallel" mime-edit-enclose-parallel-region) (mixed "Enclose as serial" mime-edit-enclose-mixed-region) (digest "Enclose as digest" mime-edit-enclose-digest-region) - (signed "Enclose as signed" mime-edit-enclose-signed-region) - (encrypted "Enclose as encrypted" mime-edit-enclose-encrypted-region) + (signed "Enclose as signed" mime-edit-enclose-pgp-signed-region) + (encrypted "Enclose as encrypted" mime-edit-enclose-pgp-encrypted-region) (quote "Verbatim region" mime-edit-enclose-quote-region) (key "Insert Public Key" mime-edit-insert-key) (split "About split" mime-edit-set-split) @@ -826,24 +800,27 @@ Following commands are available in addition to major mode commands: \\[mime-edit-insert-tag] insert a new MIME tag. \[make enclosure (maybe multipart)\] -\\[mime-edit-enclose-alternative-region] enclose as multipart/alternative. -\\[mime-edit-enclose-parallel-region] enclose as multipart/parallel. -\\[mime-edit-enclose-mixed-region] enclose as multipart/mixed. -\\[mime-edit-enclose-digest-region] enclose as multipart/digest. -\\[mime-edit-enclose-signed-region] enclose as PGP signed. -\\[mime-edit-enclose-encrypted-region] enclose as PGP encrypted. -\\[mime-edit-enclose-quote-region] enclose as verbose mode (to avoid to expand tags) +\\[mime-edit-enclose-alternative-region] enclose as multipart/alternative. +\\[mime-edit-enclose-parallel-region] enclose as multipart/parallel. +\\[mime-edit-enclose-mixed-region] enclose as multipart/mixed. +\\[mime-edit-enclose-digest-region] enclose as multipart/digest. +\\[mime-edit-enclose-pgp-signed-region] enclose as PGP signed. +\\[mime-edit-enclose-pgp-encrypted-region] enclose as PGP encrypted. +\\[mime-edit-enclose-quote-region] enclose as verbose mode + (to avoid to expand tags) \[other commands\] \\[mime-edit-set-transfer-level-7bit] set transfer-level as 7. \\[mime-edit-set-transfer-level-8bit] set transfer-level as 8. -\\[mime-edit-set-split] set message splitting mode. -\\[mime-edit-set-sign] set PGP-sign mode. -\\[mime-edit-set-encrypt] set PGP-encryption mode. -\\[mime-edit-preview-message] preview editing MIME message. -\\[mime-edit-exit] exit and translate into a MIME compliant message. -\\[mime-edit-help] show this help. -\\[mime-edit-maybe-translate] exit and translate if in MIME mode, then split. +\\[mime-edit-set-split] set message splitting mode. +\\[mime-edit-set-sign] set PGP-sign mode. +\\[mime-edit-set-encrypt] set PGP-encryption mode. +\\[mime-edit-preview-message] preview editing MIME message. +\\[mime-edit-exit] exit and translate into a MIME + compliant message. +\\[mime-edit-help] show this help. +\\[mime-edit-maybe-translate] exit and translate if in MIME mode, + then split. Additional commands are available in some major modes: C-c C-c exit, translate and run the original command. @@ -1620,21 +1597,18 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (cond ((string-equal type "quote") (mime-edit-enquote-region bb eb) ) - ((string-equal type "signed") - (cond ((eq mime-edit-signing-type 'pgp-mime) - (mime-edit-sign-pgp-mime bb eb boundary) - ) - ((eq mime-edit-signing-type 'pgp-kazu) - (mime-edit-sign-pgp-kazu bb eb boundary) - )) + ((string-equal type "pgp-signed") + (mime-edit-sign-pgp-mime bb eb boundary) + ) + ((string-equal type "pgp-encrypted") + (mime-edit-encrypt-pgp-mime bb eb boundary) + ) + ((string-equal type "kazu-signed") + (mime-edit-sign-pgp-kazu bb eb boundary) + ) + ((string-equal type "kazu-encrypted") + (mime-edit-encrypt-pgp-kazu bb eb boundary) ) - ((string-equal type "encrypted") - (cond ((eq mime-edit-encrypting-type 'pgp-mime) - (mime-edit-encrypt-pgp-mime bb eb boundary) - ) - ((eq mime-edit-encrypting-type 'pgp-kazu) - (mime-edit-encrypt-pgp-kazu bb eb boundary) - ))) (t (setq boundary (nth 2 (mime-edit-translate-region bb eb @@ -1773,9 +1747,7 @@ Content-Transfer-Encoding: 7bit (let* ((ret (mime-edit-translate-region beg end boundary)) (ctype (car ret)) - (encoding (nth 1 ret)) - (parts (nth 3 ret)) - ) + (encoding (nth 1 ret))) (goto-char beg) (insert (format "Content-Type: %s\n" ctype)) (if encoding @@ -1795,10 +1767,9 @@ Content-Transfer-Encoding: 7bit (defun mime-edit-encrypt-pgp-kazu (beg end boundary) (save-excursion - (let (from recipients header) + (let (recipients header) (let ((ret (mime-edit-make-encrypt-recipient-header))) - (setq from (aref ret 0) - recipients (aref ret 1) + (setq recipients (aref ret 1) header (aref ret 2)) ) (save-restriction @@ -1806,9 +1777,7 @@ Content-Transfer-Encoding: 7bit (let* ((ret (mime-edit-translate-region beg end boundary)) (ctype (car ret)) - (encoding (nth 1 ret)) - (parts (nth 3 ret)) - ) + (encoding (nth 1 ret))) (goto-char beg) (insert header) (insert (format "Content-Type: %s\n" ctype)) @@ -2043,12 +2012,17 @@ Content-Transfer-Encoding: 7bit ;; Define encoding and encode text if necessary. (or encoding ;Encoding is not specified. (let* ((encoding - (cdr - (assq charset - mime-edit-charset-default-encoding-alist) - )) - (beg (mime-edit-content-beginning)) - ) + (let (bits conv) + (let ((ret (cdr (assq charset mime-charset-type-list)))) + (if ret + (setq bits (car ret) + conv (nth 1 ret)) + (setq bits 8 + conv "quoted-printable"))) + (if (<= bits mime-transfer-level) + (mime-encoding-name bits) + conv))) + (beg (mime-edit-content-beginning))) (encode-mime-charset-region beg (mime-edit-content-end) charset) ;; Protect "From " in beginning of line @@ -2177,19 +2151,18 @@ and insert data encoded as ENCODING." (defun mime-edit-enclose-region-internal (type beg end) (save-excursion (goto-char beg) - (let ((current (point))) - (save-restriction - (narrow-to-region beg end) - (insert (format "--<<%s>>-{\n" type)) - (goto-char (point-max)) - (insert (format "--}-<<%s>>\n" type)) - (goto-char (point-max)) + (save-restriction + (narrow-to-region beg end) + (insert (format "--<<%s>>-{\n" type)) + (goto-char (point-max)) + (insert (format "--}-<<%s>>\n" type)) + (goto-char (point-max)) + ) + (or (looking-at mime-edit-beginning-tag-regexp) + (eobp) + (insert (mime-make-text-tag) "\n") ) - (or (looking-at mime-edit-beginning-tag-regexp) - (eobp) - (insert (mime-make-text-tag) "\n") - ) - ))) + )) (defun mime-edit-enclose-quote-region (beg end) (interactive "*r") @@ -2216,19 +2189,25 @@ and insert data encoded as ENCODING." (mime-edit-enclose-region-internal 'alternative beg end) ) -(defun mime-edit-enclose-signed-region (beg end) +(defun mime-edit-enclose-pgp-signed-region (beg end) (interactive "*r") - (if mime-edit-signing-type - (mime-edit-enclose-region-internal 'signed beg end) - (message "Please specify signing type.") - )) + (mime-edit-enclose-region-internal 'pgp-signed beg end) + ) -(defun mime-edit-enclose-encrypted-region (beg end) +(defun mime-edit-enclose-pgp-encrypted-region (beg end) (interactive "*r") - (if mime-edit-signing-type - (mime-edit-enclose-region-internal 'encrypted beg end) - (message "Please specify encrypting type.") - )) + (mime-edit-enclose-region-internal 'pgp-encrypted beg end) + ) + +(defun mime-edit-enclose-kazu-signed-region (beg end) + (interactive "*r") + (mime-edit-enclose-region-internal 'kazu-signed beg end) + ) + +(defun mime-edit-enclose-kazu-encrypted-region (beg end) + (interactive "*r") + (mime-edit-enclose-region-internal 'kazu-encrypted beg end) + ) (defun mime-edit-insert-key (&optional arg) "Insert a pgp public key." @@ -2264,8 +2243,6 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (setq mime-transfer-level 8) (setq mime-transfer-level 7) )) - (setq mime-edit-charset-default-encoding-alist - (mime-make-charset-default-encoding-alist mime-transfer-level)) (message (format "Current transfer-level is %d bit" mime-transfer-level)) (setq mime-transfer-level-string @@ -2287,18 +2264,18 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." ;;; @ pgp ;;; +(defvar mime-edit-pgp-processing nil) +(make-variable-buffer-local 'mime-edit-pgp-processing) + (defun mime-edit-set-sign (arg) (interactive (list (y-or-n-p "Do you want to sign? ") )) (if arg - (if mime-edit-signing-type - (progn - (setq mime-edit-pgp-processing 'sign) - (message "This message will be signed.") - ) - (message "Please specify signing type.") + (progn + (setq mime-edit-pgp-processing 'sign) + (message "This message will be signed.") ) (if (eq mime-edit-pgp-processing 'sign) (setq mime-edit-pgp-processing nil) @@ -2312,12 +2289,9 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (y-or-n-p "Do you want to encrypt? ") )) (if arg - (if mime-edit-encrypting-type - (progn - (setq mime-edit-pgp-processing 'encrypt) - (message "This message will be encrypt.") - ) - (message "Please specify encrypting type.") + (progn + (setq mime-edit-pgp-processing 'encrypt) + (message "This message will be encrypt.") ) (if (eq mime-edit-pgp-processing 'encrypt) (setq mime-edit-pgp-processing nil) @@ -2325,9 +2299,6 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (message "This message will not be encrypt.") )) -(defvar mime-edit-pgp-processing nil) -(make-variable-buffer-local 'mime-edit-pgp-processing) - (defun mime-edit-pgp-enclose-buffer () (let ((beg (save-excursion (goto-char (point-min)) @@ -2338,10 +2309,10 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." ) (if beg (cond ((eq mime-edit-pgp-processing 'sign) - (mime-edit-enclose-signed-region beg end) + (mime-edit-enclose-pgp-signed-region beg end) ) ((eq mime-edit-pgp-processing 'encrypt) - (mime-edit-enclose-encrypted-region beg end) + (mime-edit-enclose-pgp-encrypted-region beg end) )) ))) diff --git a/mime-mc.el b/mime-mc.el index 78dfdae..7e5cb26 100644 --- a/mime-mc.el +++ b/mime-mc.el @@ -25,7 +25,7 @@ ;;; Code: (require 'mailcrypt) -(load "mc-pgp") +(eval-and-compile (load "mc-pgp")) (defun mime-mc-pgp-generic-parser (result) (let ((ret (mc-pgp-generic-parser result))) diff --git a/mime-parse.el b/mime-parse.el index 5ea30dd..213563c 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -200,14 +200,19 @@ If is is not found, return DEFAULT-ENCODING." (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))) diff --git a/mime-partial.el b/mime-partial.el index c240070..c8ef3ed 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 (beg end cal) +(defun mime-method-to-combine-message/partial-pieces (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 beg end cal) + (mime-method-to-store-message/partial entity cal) (let (the-id parameters) (setq subject-id (std11-field-body "Subject")) (if (string-match "[0-9\n]+" subject-id) @@ -84,9 +84,7 @@ partial messages using mime-view." (if (string= the-id id) (progn (mime-method-to-store-message/partial - (mime-entity-point-min mime-raw-message-info) - (mime-entity-point-max mime-raw-message-info) - parameters) + mime-raw-message-info parameters) (if (file-exists-p full-file) (throw 'tag nil) ) diff --git a/mime-pgp.el b/mime-pgp.el index 8aa0c40..b27c314 100644 --- a/mime-pgp.el +++ b/mime-pgp.el @@ -53,8 +53,10 @@ ;;; ;;; It is based on draft-kazu-pgp-mime-00.txt (PGP-kazu). -(defun mime-method-for-application/pgp (start end cal) - (let* ((entity-number (mime-raw-point-to-entity-number start)) +(defun mime-method-for-application/pgp (entity cal) + (let* ((start (mime-entity-point-min entity)) + (end (mime-entity-point-max entity)) + (entity-number (mime-raw-point-to-entity-number start)) (p-win (or (get-buffer-window mime-preview-buffer) (get-largest-window))) (new-name (format "%s-%s" (buffer-name) entity-number)) @@ -109,13 +111,10 @@ ;;; ;;; It is based on RFC 1847 (security-multipart). -(defun mime-method-to-verify-multipart/signed (start end cal) +(defun mime-method-to-verify-multipart/signed (entity cal) "Internal method to verify multipart/signed." (mime-raw-play-entity - ;; entity-info of signature - (mime-raw-find-entity-from-node-id - ;; entity-node-id of signature - (cons 1 (mime-raw-point-to-entity-node-id start))) + (nth 1 (mime-entity-children entity)) ; entity-info of signature (cdr (assq 'mode cal)) ; play-mode )) @@ -161,9 +160,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 (start end cal) +(defun mime-method-to-verify-application/pgp-signature (entity cal) "Internal method to check PGP/MIME signature." - (let* ((encoding (cdr (assq 'encoding cal))) + (let* ((start (mime-entity-point-min entity)) + (end (mime-entity-point-max entity)) + (encoding (cdr (assq 'encoding cal))) (entity-node-id (mime-raw-point-to-entity-node-id start)) (mother-node-id (cdr entity-node-id)) (knum (car entity-node-id)) @@ -223,19 +224,16 @@ 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 (start end cal) - (let* ((entity-node-id (mime-raw-point-to-entity-node-id start)) +(defun mime-method-to-decrypt-application/pgp-encrypted (entity cal) + (let* ((entity-node-id (mime-entity-node-id entity)) (mother-node-id (cdr entity-node-id)) (knum (car entity-node-id)) (onum (if (> knum 0) (1- knum) (1+ knum))) (oinfo (mime-raw-find-entity-from-node-id - (cons onum mother-node-id) mime-raw-message-info)) - (obeg (mime-entity-point-min oinfo)) - (oend (mime-entity-point-max oinfo)) - ) - (mime-method-for-application/pgp obeg oend cal) + (cons onum mother-node-id) mime-raw-message-info))) + (mime-method-for-application/pgp oinfo cal) )) @@ -243,8 +241,10 @@ 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 (start end cal) - (let* ((entity-number (mime-raw-point-to-entity-number start)) +(defun mime-method-to-add-application/pgp-keys (entity cal) + (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))) str) diff --git a/mime-play.el b/mime-play.el index af845c1..45ff40d 100644 --- a/mime-play.el +++ b/mime-play.el @@ -76,13 +76,13 @@ If MODE is specified, play as it. Default MODE is \"play\"." (interactive) (or mode (setq mode "play")) - (let ((entity-info (get-text-property (point) 'mime-view-entity))) - (if entity-info + (let ((entity (get-text-property (point) 'mime-view-entity))) + (if entity (let ((the-buf (current-buffer)) - (raw-buffer (get-text-property (point) 'mime-view-raw-buffer))) + (raw-buffer (mime-entity-buffer entity))) (setq mime-preview-after-decoded-position (point)) (set-buffer raw-buffer) - (mime-raw-play-entity entity-info mode) + (mime-raw-play-entity entity mode) (when (eq (current-buffer) raw-buffer) (set-buffer the-buf) (goto-char mime-preview-after-decoded-position) @@ -96,23 +96,26 @@ If MODE is specified, play as it. Default MODE is \"play\"." (order '((type . 1) (subtype . 2) (mode . 3) - (major-mode . 4))) + (method . 4) + (major-mode . 5) + (disposition-type . 6) + )) a-order b-order) (if (symbolp a-t) (let ((ret (assq a-t order))) (if ret (setq a-order (cdr ret)) - (setq a-order 5) + (setq a-order 7) )) - (setq a-order 6) + (setq a-order 8) ) (if (symbolp b-t) (let ((ret (assq b-t order))) (if ret (setq b-order (cdr ret)) - (setq b-order 5) + (setq b-order 7) )) - (setq b-order 6) + (setq b-order 8) ) (if (= a-order b-order) (string< (format "%s" a-t)(format "%s" b-t)) @@ -130,74 +133,64 @@ If MODE is specified, play as it. Default MODE is \"play\"." (setq situations (cdr situations))) dest)) -(defun mime-raw-play-entity (entity-info &optional mode) - "Play entity specified by ENTITY-INFO. +(defun mime-raw-play-entity (entity &optional mode situation) + "Play entity specified by ENTITY. It decodes the entity to call internal or external method. The method 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)) - (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))) - (let (method cal ret) - (setq cal (list* (cons 'major-mode major-mode) - (cons 'encoding encoding) - content-type)) - (if mode - (setq cal (cons (cons 'mode mode) cal)) - ) - (setq ret - (or (ctree-match-calist mime-acting-situation-examples cal) - (ctree-match-calist-partially mime-acting-situation-examples - cal) - cal)) - (setq ret - (or (mime-delq-null-situation - (ctree-find-calist mime-acting-condition ret - mime-view-find-every-acting-situation) - 'method) - (mime-delq-null-situation - (ctree-find-calist mime-acting-condition cal - mime-view-find-every-acting-situation) - 'method) - )) - (cond ((cdr ret) - (setq ret (select-menu-alist - "Methods" - (mapcar (function - (lambda (situation) - (cons - (format "%s" - (cdr (assq 'method situation))) - situation))) - ret))) - (setq ret (mime-sort-situation ret)) - (ctree-set-calist-strictly 'mime-acting-situation-examples ret) - ) - (t - (setq ret (car ret)) - )) - (setq method (cdr (assq 'method ret))) - (cond ((and (symbolp method) - (fboundp method)) - (funcall method beg end ret) - ) - ((stringp method) - (mime-activate-mailcap-method beg end ret) - ) - ((and (listp method)(stringp (car method))) - (mime-activate-external-method beg end ret) - ) - (t - (mime-show-echo-buffer - "No method are specified for %s\n" - (mime-type/subtype-string - (mime-content-type-primary-type content-type) - (mime-content-type-subtype content-type)) - ))) - ))) + (let (method ret) + (or situation + (setq situation (mime-entity-situation entity))) + (if mode + (setq situation (cons (cons 'mode mode) situation)) + ) + (setq ret + (or (ctree-match-calist mime-acting-situation-examples situation) + (ctree-match-calist-partially mime-acting-situation-examples + situation) + situation)) + (setq ret + (or (mime-delq-null-situation + (ctree-find-calist mime-acting-condition ret + mime-view-find-every-acting-situation) + 'method) + (mime-delq-null-situation + (ctree-find-calist mime-acting-condition situation + mime-view-find-every-acting-situation) + 'method) + )) + (cond ((cdr ret) + (setq ret (select-menu-alist + "Methods" + (mapcar (function + (lambda (situation) + (cons + (format "%s" + (cdr (assq 'method situation))) + situation))) + ret))) + (setq ret (mime-sort-situation ret)) + (ctree-set-calist-strictly 'mime-acting-situation-examples ret) + ) + (t + (setq ret (car ret)) + )) + (setq method (cdr (assq 'method ret))) + (cond ((and (symbolp method) + (fboundp method)) + (funcall method entity ret) + ) + ((stringp method) + (mime-activate-mailcap-method entity ret) + ) + ;; ((and (listp method)(stringp (car method))) + ;; (mime-activate-external-method entity ret) + ;; ) + (t + (mime-show-echo-buffer "No method are specified for %s\n" + (mime-entity-type/subtype entity)) + )) + )) ;;; @ external decoder @@ -205,33 +198,31 @@ specified, play as it. Default MODE is \"play\"." (defvar mime-mailcap-method-filename-alist nil) -(defun mime-activate-mailcap-method (start end situation) +(defun mime-activate-mailcap-method (entity situation) (save-excursion (save-restriction - (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))) - (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 ((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) - )))) + (let ((start (mime-entity-point-min entity)) + (end (mime-entity-point-max entity))) + (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))) + (mime-write-decoded-region (mime-entity-body-start entity) end + name (cdr (assq 'encoding situation))) + (message "External method is starting...") + (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) + ) + ))))) (defun mime-mailcap-method-sentinel (process event) (let ((file (cdr (assq process mime-mailcap-method-filename-alist)))) @@ -241,60 +232,52 @@ 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 (beg end cal) - (save-excursion - (save-restriction - (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 - (if (re-search-forward "^$" nil t) - (1+ (match-end 0)) - (point-min) - )) - ) - (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))) - ) - (if ret - ret - (if (eq item 'encoding) - "7bit" - "")) - )) - )) - format)) +;; (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.") @@ -387,36 +370,86 @@ window.") ;;; @ file extraction ;;; -(defun mime-method-to-save (beg end cal) - (goto-char beg) - (let* ((name - (save-restriction - (narrow-to-region beg end) - (mime-raw-get-filename cal) - )) - (encoding (or (cdr (assq 'encoding cal)) "7bit")) - (filename - (if (and name (not (string-equal name ""))) - (expand-file-name name - (save-window-excursion - (call-interactively - (function - (lambda (dir) - (interactive "DDirectory: ") - dir))))) - (save-window-excursion - (call-interactively - (function - (lambda (file) - (interactive "FFilename: ") - (expand-file-name file))))))) - ) - (if (file-exists-p filename) - (or (yes-or-no-p (format "File %s exists. Save anyway? " filename)) - (error ""))) - (re-search-forward "\n\n") - (mime-write-decoded-region (match-end 0) end filename encoding) - )) +(defun mime-method-to-save (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) + )) + (encoding (or (cdr (assq 'encoding cal)) "7bit")) + (filename (if (and name (not (string-equal name ""))) + (expand-file-name name + (save-window-excursion + (call-interactively + (function + (lambda (dir) + (interactive "DDirectory: ") + dir))))) + (save-window-excursion + (call-interactively + (function + (lambda (file) + (interactive "FFilename: ") + (expand-file-name file))))))) + ) + (if (file-exists-p filename) + (or (yes-or-no-p (format "File %s exists. Save anyway? " filename)) + (error ""))) + (re-search-forward "\n\n") + (mime-write-decoded-region (match-end 0) end filename encoding) + ))) + + +;;; @ file detection +;;; + +(defvar mime-file-content-type-alist + '(("JPEG" image jpeg) + ("GIF" image gif) + ) + "*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.") + +(defun mime-method-to-detect (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) + )) + (encoding (or (cdr (assq 'encoding situation)) "7bit")) + (filename (if (and name (not (string-equal 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 + filename encoding) + (let (type subtype) + (with-temp-buffer + (call-process "file" nil t nil filename) + (goto-char (point-min)) + (if (search-forward (concat filename ": ") nil t) + (let ((rest mime-file-content-type-alist)) + (while (not (let ((cell (car rest))) + (if (looking-at (car cell)) + (setq type (nth 1 cell) + subtype (nth 2 cell)) + ))) + (setq rest (cdr rest)))))) + (if type + (mime-raw-play-entity + entity "play" + (put-alist 'type type + (put-alist 'subtype subtype + (mime-entity-situation entity)))) + )) + ))) ;;; @ mail/news message @@ -434,8 +467,10 @@ It is registered to variable `mime-preview-quitting-method-alist'." (pop-to-buffer mother) )) -(defun mime-method-to-display-message/rfc822 (beg end cal) - (let* ((cnum (mime-raw-point-to-entity-number beg)) +(defun mime-method-to-display-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)) (new-name (format "%s-%s" (buffer-name) cnum)) (mother mime-preview-buffer) (representation-type @@ -475,8 +510,8 @@ saved as binary. Otherwise the region is saved by `write-region'." (write-region start end filename) ))) -(defun mime-method-to-store-message/partial (beg end cal) - (goto-char beg) +(defun mime-method-to-store-message/partial (entity cal) + (goto-char (mime-entity-point-min entity)) (let* ((root-dir (expand-file-name (concat "m-prts-" (user-login-name)) mime-temp-directory)) @@ -485,7 +520,7 @@ saved as binary. Otherwise the region is saved by `write-region'." (total (cdr (assoc "total" cal))) file (mother mime-preview-buffer) - ) + ) (or (file-exists-p root-dir) (make-directory root-dir) ) @@ -516,7 +551,7 @@ saved as binary. Otherwise the region is saved by `write-region'." (re-search-forward "^$") (goto-char (1+ (match-end 0))) (setq file (concat root-dir "/" number)) - (mime-raw-write-region (point) end file) + (mime-raw-write-region (point) (mime-entity-point-max entity) file) (let ((total-file (concat root-dir "/CT"))) (setq total (if total @@ -561,8 +596,8 @@ saved as binary. Otherwise the region is saved by `write-region'." (setq i (1+ i)) )) (as-binary-output-file - (write-region (point-min)(point-max) - (expand-file-name "FULL" root-dir))) + (write-region (point-min)(point-max) + (expand-file-name "FULL" root-dir))) (let ((i 1)) (while (<= i total) (let ((file (format "%s/%d" root-dir i))) @@ -607,13 +642,11 @@ saved as binary. Otherwise the region is saved by `write-region'." (dired dir) )) -(defun mime-method-to-display-message/external-ftp (beg end cal) +(defun mime-method-to-display-message/external-ftp (entity cal) (let* ((site (cdr (assoc "site" cal))) (directory (cdr (assoc "directory" cal))) (name (cdr (assoc "name" cal))) - ;;(mode (cdr (assoc "mode" cal))) - (pathname (concat "/anonymous@" site ":" directory)) - ) + (pathname (concat "/anonymous@" site ":" directory))) (message (concat "Accessing " (expand-file-name name pathname) "...")) (funcall mime-raw-dired-function pathname) (goto-char (point-min)) @@ -624,11 +657,10 @@ saved as binary. Otherwise the region is saved by `write-region'." ;;; @ rot13-47 ;;; -(defun mime-method-to-display-caesar (start end cal) +(defun mime-method-to-display-caesar (entity situation) "Internal method for mime-view to display ROT13-47-48 message." - (let* ((entity (mime-raw-find-entity-from-point start)) - (new-name (format "%s-%s" (buffer-name) - (reverse (mime-entity-node-id entity)))) + (let* ((new-name (format "%s-%s" (buffer-name) + (mime-entity-number entity))) (mother mime-preview-buffer)) (let ((pwin (or (get-buffer-window mother) (get-largest-window))) diff --git a/mime-view.el b/mime-view.el index 117cfcd..3fe5010 100644 --- a/mime-view.el +++ b/mime-view.el @@ -64,10 +64,7 @@ :type 'file) -;;; @ buffer local variables -;;; - -;;; @@ in raw-buffer +;;; @ in raw-buffer (representation space) ;;; (defvar mime-raw-message-info nil @@ -121,31 +118,6 @@ This value is overridden by buffer local variable `mime-raw-representation-type' if it is not nil.") -;;; @@ in preview-buffer -;;; - -(defvar mime-mother-buffer nil - "Mother buffer corresponding with the (MIME-preview) buffer. -If current MIME-preview buffer is generated by other buffer, such as -message/partial, it is called `mother-buffer'.") -(make-variable-buffer-local 'mime-mother-buffer) - -(defvar mime-raw-buffer nil - "Raw buffer corresponding with the (MIME-preview) buffer.") -(make-variable-buffer-local 'mime-raw-buffer) - -(defvar mime-preview-original-major-mode nil - "Major-mode of mime-raw-buffer.") -(make-variable-buffer-local 'mime-preview-original-major-mode) - -(defvar mime-preview-original-window-configuration nil - "Window-configuration before mime-view-mode is called.") -(make-variable-buffer-local 'mime-preview-original-window-configuration) - - -;;; @ entity information -;;; - (defsubst mime-raw-find-entity-from-node-id (entity-node-id &optional message-info) "Return entity from ENTITY-NODE-ID in mime-raw-buffer. @@ -189,6 +161,119 @@ If optional argument MESSAGE-INFO is not specified, (setq children (cdr children))) message-info)))) + +;;; @ in preview-buffer (presentation space) +;;; + +(defvar mime-mother-buffer nil + "Mother buffer corresponding with the (MIME-preview) buffer. +If current MIME-preview buffer is generated by other buffer, such as +message/partial, it is called `mother-buffer'.") +(make-variable-buffer-local 'mime-mother-buffer) + +(defvar mime-raw-buffer nil + "Raw buffer corresponding with the (MIME-preview) buffer.") +(make-variable-buffer-local 'mime-raw-buffer) + +(defvar mime-preview-original-window-configuration nil + "Window-configuration before mime-view-mode is called.") +(make-variable-buffer-local 'mime-preview-original-window-configuration) + +(defun mime-preview-original-major-mode (&optional recursive) + "Return major-mode of original buffer. +If optional argument RECURSIVE is non-nil and current buffer has +mime-mother-buffer, it returns original major-mode of the +mother-buffer." + (if (and recursive mime-mother-buffer) + (save-excursion + (set-buffer mime-mother-buffer) + (mime-preview-original-major-mode recursive) + ) + (save-excursion + (set-buffer + (mime-entity-buffer + (get-text-property (point-min) 'mime-view-entity))) + major-mode))) + + +;;; @ entity information +;;; + +(defsubst mime-entity-parent (entity &optional message-info) + "Return mother entity of ENTITY. +If optional argument MESSAGE-INFO is not specified, +`mime-raw-message-info' in buffer of ENTITY is used." + (mime-raw-find-entity-from-node-id + (cdr (mime-entity-node-id entity)) + (or message-info + (save-excursion + (set-buffer (mime-entity-buffer entity)) + mime-raw-message-info)))) + +(defun mime-entity-situation (entity) + "Return situation of ENTITY." + (append (or (mime-entity-content-type entity) + (make-mime-content-type 'text 'plain)) + (let ((d (mime-entity-content-disposition entity))) + (cons (cons 'disposition-type + (mime-content-disposition-type d)) + (mapcar (function + (lambda (param) + (let ((name (car param))) + (cons (cond ((string= name "filename") + 'filename) + ((string= name "creation-date") + 'creation-date) + ((string= name "modification-date") + 'modification-date) + ((string= name "read-date") + 'read-date) + ((string= name "size") + 'size) + (t (cons 'disposition (car param)))) + (cdr param))))) + (mime-content-disposition-parameters d)) + )) + (list (cons 'encoding (mime-entity-encoding entity)) + (cons 'major-mode + (save-excursion + (set-buffer (mime-entity-buffer entity)) + major-mode))) + )) + + +(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")) + (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)) + "")) + + (defsubst mime-raw-point-to-entity-node-id (point &optional message-info) "Return entity-node-id from POINT in mime-raw-buffer. If optional argument MESSAGE-INFO is not specified, @@ -199,14 +284,7 @@ If optional argument MESSAGE-INFO is not specified, "Return entity-number from POINT in mime-raw-buffer. If optional argument MESSAGE-INFO is not specified, `mime-raw-message-info' is used." - (reverse (mime-raw-point-to-entity-node-id point message-info))) - -(defsubst mime-raw-entity-parent (entity &optional message-info) - "Return mother entity of ENTITY. -If optional argument MESSAGE-INFO is not specified, -`mime-raw-message-info' is used." - (mime-raw-find-entity-from-node-id (cdr (mime-entity-node-id entity)) - message-info)) + (mime-entity-number (mime-raw-find-entity-from-point point message-info))) (defun mime-raw-flatten-message-info (&optional message-info) "Return list of entity in mime-raw-buffer. @@ -231,7 +309,7 @@ If optional argument MESSAGE-INFO is not specified, ;;; @@@ predicate function ;;; -(defun mime-view-entity-button-visible-p (entity message-info) +(defun mime-view-entity-button-visible-p (entity) "Return non-nil if header of ENTITY is visible. Please redefine this function if you want to change default setting." (let ((media-type (mime-entity-media-type entity)) @@ -239,8 +317,7 @@ Please redefine this function if you want to change default setting." (or (not (eq media-type 'application)) (and (not (eq media-subtype 'x-selection)) (or (not (eq media-subtype 'octet-stream)) - (let ((mother-entity - (mime-raw-entity-parent entity message-info))) + (let ((mother-entity (mime-entity-parent entity))) (or (not (eq (mime-entity-media-type mother-entity) 'multipart)) (not (eq (mime-entity-media-subtype mother-entity) @@ -251,7 +328,7 @@ Please redefine this function if you want to change default setting." ;;; @@@ entity button generator ;;; -(defun mime-view-insert-entity-button (entity message-info subj) +(defun mime-view-insert-entity-button (entity subject) "Insert entity-button of ENTITY." (let ((entity-node-id (mime-entity-node-id entity)) (params (mime-entity-parameters entity))) @@ -271,12 +348,12 @@ Please redefine this function if you want to change default setting." (setq access-type (cdr access-type)) (if server (format "%s %s ([%s] %s)" - num subj access-type (cdr server)) + num subject access-type (cdr server)) (let ((site (cdr (assoc "site" params))) (dir (cdr (assoc "directory" params))) ) (format "%s %s ([%s] %s:%s)" - num subj access-type site dir) + num subject access-type site dir) ))) ) (t @@ -285,7 +362,7 @@ Please redefine this function if you want to change default setting." (charset (cdr (assoc "charset" params))) (encoding (mime-entity-encoding entity))) (concat - num " " subj + num " " subject (let ((rest (format " <%s/%s%s%s>" media-type media-subtype @@ -508,9 +585,9 @@ Please press `v' key in this buffer." (while children (mime-view-display-entity (car children) (save-excursion - (set-buffer mime-raw-buffer) + (set-buffer (mime-entity-buffer entity)) mime-raw-message-info) - mime-raw-buffer (current-buffer) + (current-buffer) default-situation) (setq children (cdr children)) ))) @@ -543,13 +620,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (let ((situation (or (ctree-match-calist mime-preview-condition - (append - (or (mime-entity-content-type child) - (make-mime-content-type 'text 'plain)) - (list* (cons 'encoding - (mime-entity-encoding child)) - (cons 'major-mode major-mode) - default-situation))) + (append (mime-entity-situation child) + default-situation)) default-situation))) (if (cdr (assq 'body-presentation-method situation)) (let ((score @@ -576,12 +648,13 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." children))) (setq i 0) (while children - (let ((situation (car situations))) - (mime-view-display-entity (car children) + (let ((child (car children)) + (situation (car situations))) + (mime-view-display-entity child (save-excursion - (set-buffer mime-raw-buffer) + (set-buffer (mime-entity-buffer child)) mime-raw-message-info) - mime-raw-buffer (current-buffer) + (current-buffer) default-situation (if (= i p) situation @@ -629,30 +702,18 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (setq entries (cdr entries)) ))) -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . t)(subtype . t)(mode . "extract") -;; (method . mime-method-to-save))) +(ctree-set-calist-strictly + 'mime-acting-condition + '((type . application)(subtype . octet-stream) + (mode . "play") + (method . mime-method-to-detect) + )) + (ctree-set-calist-with-default 'mime-acting-condition '((mode . "extract") (method . mime-method-to-save))) -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . text)(subtype . plain)(mode . "play") -;; (method "tm-plain" nil 'file "" 'encoding 'mode 'name) -;; )) -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . text)(subtype . plain)(mode . "print") -;; (method "tm-plain" nil 'file "" 'encoding 'mode 'name) -;; )) -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . text)(subtype . html)(mode . "play") -;; (method "tm-html" nil 'file "" 'encoding 'mode 'name) -;; )) (ctree-set-calist-strictly 'mime-acting-condition '((type . text)(subtype . x-rot13-47)(mode . "play") @@ -664,40 +725,6 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (method . mime-method-to-display-caesar) )) -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . audio)(subtype . basic)(mode . "play") -;; (method "tm-au" nil 'file "" 'encoding 'mode 'name) -;; )) - -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . image)(mode . "play") -;; (method "tm-image" nil 'file "" 'encoding 'mode 'name) -;; )) -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . image)(mode . "print") -;; (method "tm-image" nil 'file "" 'encoding 'mode 'name) -;; )) - -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . video)(subtype . mpeg)(mode . "play") -;; (method "tm-mpeg" nil 'file "" 'encoding 'mode 'name) -;; )) - -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . application)(subtype . postscript)(mode . "play") -;; (method "tm-ps" nil 'file "" 'encoding 'mode 'name) -;; )) -;; (ctree-set-calist-strictly -;; 'mime-acting-condition -;; '((type . application)(subtype . postscript)(mode . "print") -;; (method "tm-ps" nil 'file "" 'encoding 'mode 'name) -;; )) - (ctree-set-calist-strictly 'mime-acting-condition '((type . message)(subtype . rfc822)(mode . "play") @@ -731,11 +758,11 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." . mime-preview-quitting-method-for-mime-show-message-mode)) "Alist of major-mode vs. quitting-method of mime-view.") -(defvar mime-view-over-to-previous-method-alist nil) -(defvar mime-view-over-to-next-method-alist nil) +(defvar mime-preview-over-to-previous-method-alist nil + "Alist of major-mode vs. over-to-previous-method of mime-view.") -(defvar mime-view-show-summary-method nil - "Alist of major-mode vs. show-summary-method.") +(defvar mime-preview-over-to-next-method-alist nil + "Alist of major-mode vs. over-to-next-method of mime-view.") ;;; @ following method @@ -780,62 +807,18 @@ The compressed face will be piped to this command.") )))) -;;; @ miscellaneous -;;; - -(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode")) - - ;;; @ buffer setup ;;; -(defvar mime-view-redisplay nil) - -(defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf) - (if ibuf - (progn - (get-buffer ibuf) - (set-buffer ibuf) - )) - (or mime-view-redisplay - (setq mime-raw-message-info (mime-parse-message ctl encoding)) - ) - (let ((message-info mime-raw-message-info) - (the-buf (current-buffer)) - (mode major-mode)) - (or obuf - (setq obuf (concat "*Preview-" (buffer-name the-buf) "*"))) - (set-buffer (get-buffer-create obuf)) - (let ((inhibit-read-only t)) - ;;(setq buffer-read-only nil) - (widen) - (erase-buffer) - (setq mime-raw-buffer the-buf) - (setq mime-preview-original-major-mode mode) - (setq major-mode 'mime-view-mode) - (setq mode-name "MIME-View") - (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) - (set-buffer the-buf) - ) - (setq mime-preview-buffer obuf) - ) - -(defun mime-view-display-entity (entity message-info ibuf obuf +(defun mime-view-display-entity (entity message-info obuf default-situation &optional situation) - (let* ((start (mime-entity-point-min entity)) + (let* ((raw-buffer (mime-entity-buffer entity)) + (start (mime-entity-point-min entity)) (end (mime-entity-point-max entity)) - (content-type (mime-entity-content-type entity)) - (encoding (mime-entity-encoding entity)) - end-of-header e nb ne subj) - (set-buffer ibuf) + original-major-mode end-of-header e nb ne subj) + (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)) @@ -850,13 +833,8 @@ The compressed face will be piped to this command.") (or situation (setq 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))) + (append (mime-entity-situation entity) + default-situation)) default-situation))) (let ((button-is-invisible (eq (cdr (assq 'entity-button situation)) 'invisible)) @@ -869,14 +847,14 @@ The compressed face will be piped to this command.") (setq nb (point)) (narrow-to-region nb nb) (or button-is-invisible - (if (mime-view-entity-button-visible-p entity message-info) - (mime-view-insert-entity-button entity message-info subj) + (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 mime-raw-buffer start end-of-header) - (let ((f (cdr (assq mime-preview-original-major-mode + (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) @@ -888,7 +866,7 @@ The compressed face will be piped to this command.") (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) + (insert-buffer-substring raw-buffer end-of-header end) (funcall body-filter situation) ))) (children) @@ -898,7 +876,7 @@ The compressed face will be piped to this command.") (t (when button-is-invisible (goto-char (point-max)) - (mime-view-insert-entity-button entity message-info subj) + (mime-view-insert-entity-button entity subj) ) (or header-is-visible (progn @@ -908,7 +886,6 @@ The compressed face will be piped to this command.") )) (setq ne (point-max)) (widen) - (put-text-property nb ne 'mime-view-raw-buffer ibuf) (put-text-property nb ne 'mime-view-entity entity) (goto-char ne) (if children @@ -918,35 +895,6 @@ The compressed face will be piped to this command.") )) ))) -(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")) - (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)) - "")) - ;;; @ MIME viewer mode ;;; @@ -1021,8 +969,6 @@ The compressed face will be piped to this command.") (define-key mime-view-mode-map "q" (function mime-preview-quit)) (define-key mime-view-mode-map - "h" (function mime-preview-show-summary)) - (define-key mime-view-mode-map "\C-c\C-x" (function mime-preview-kill-buffer)) ;; (define-key mime-view-mode-map ;; "<" (function beginning-of-buffer)) @@ -1084,7 +1030,61 @@ The compressed face will be piped to this command.") (bury-buffer buf) )))) -(defun mime-view-mode (&optional mother ctl encoding ibuf obuf +(defvar mime-view-redisplay nil) + +(defun mime-view-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))) + (or preview-buffer + (setq preview-buffer + (concat "*Preview-" (buffer-name raw-buffer) "*"))) + (set-buffer raw-buffer) + (setq mime-raw-message-info (mime-parse-message)) + (setq mime-preview-buffer preview-buffer) + (let ((inhibit-read-only t)) + (switch-to-buffer preview-buffer) + (widen) + (erase-buffer) + (setq mime-raw-buffer raw-buffer) + (if mother + (setq mime-mother-buffer mother) + ) + (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-view-define-keymap default-keymap-or-function) + (let ((point + (next-single-property-change (point-min) 'mime-view-entity))) + (if point + (goto-char point) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + )) + (run-hooks 'mime-view-mode-hook) + )) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + ) + +(defun mime-view-buffer (&optional raw-buffer preview-buffer mother + default-keymap-or-function) + (interactive) + (mime-view-display-message + (save-excursion + (if raw-buffer (set-buffer raw-buffer)) + (mime-parse-message) + ) + preview-buffer mother default-keymap-or-function)) + +(defun mime-view-mode (&optional mother ctl encoding + raw-buffer preview-buffer default-keymap-or-function) "Major mode for viewing MIME message. @@ -1104,33 +1104,18 @@ v Decode current content as `play mode' e Decode current content as `extract mode' C-c C-p Decode current content as `print mode' a Followup to current content. -x Display X-Face q Quit button-2 Move to point under the mouse cursor and decode current content as `play mode' " (interactive) - (mime-maybe-hide-echo-buffer) - (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf)) - (win-conf (current-window-configuration)) - ) - (prog1 - (switch-to-buffer ret) - (setq mime-preview-original-window-configuration win-conf) - (if mother - (progn - (setq mime-mother-buffer mother) - )) - (mime-view-define-keymap default-keymap-or-function) - (let ((point - (next-single-property-change (point-min) 'mime-view-entity))) - (if point - (goto-char point) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - )) - (run-hooks 'mime-view-mode-hook) - ))) + (mime-view-display-message + (save-excursion + (if raw-buffer (set-buffer raw-buffer)) + (or mime-view-redisplay + (mime-parse-message ctl encoding)) + ) + preview-buffer mother default-keymap-or-function)) ;;; @@ playing @@ -1161,17 +1146,6 @@ It decodes current entity to call internal or external method as ;;; @@ following ;;; -(defun mime-preview-original-major-mode () - "Return major-mode of original buffer. -If a current buffer has mime-mother-buffer, return original major-mode -of the mother-buffer." - (if mime-mother-buffer - (save-excursion - (set-buffer mime-mother-buffer) - (mime-preview-original-major-mode) - ) - mime-preview-original-major-mode)) - (defun mime-preview-follow-current-entity () "Write follow message to current entity. It calls following-method selected from variable @@ -1228,7 +1202,7 @@ It calls following-method selected from variable (setq p-end (point-max)) )) )) - (let* ((mode (mime-preview-original-major-mode)) + (let* ((mode (mime-preview-original-major-mode 'recursive)) (new-name (format "%s-%s" (buffer-name) (reverse entity-node-id))) new-buf @@ -1342,7 +1316,7 @@ If there is no upper entity, call function `mime-preview-quit'." (defun mime-preview-move-to-previous () "Move to previous entity. If there is no previous entity, it calls function registered in -variable `mime-view-over-to-previous-method-alist'." +variable `mime-preview-over-to-previous-method-alist'." (interactive) (while (null (get-text-property (point) 'mime-view-entity)) (backward-char) @@ -1354,8 +1328,8 @@ variable `mime-view-over-to-previous-method-alist'." (goto-char (1- point)) (mime-preview-move-to-previous) ) - (let ((f (assq mime-preview-original-major-mode - mime-view-over-to-previous-method-alist))) + (let ((f (assq (mime-preview-original-major-mode) + mime-preview-over-to-previous-method-alist))) (if f (funcall (cdr f)) )) @@ -1364,7 +1338,7 @@ variable `mime-view-over-to-previous-method-alist'." (defun mime-preview-move-to-next () "Move to next entity. If there is no previous entity, it calls function registered in -variable `mime-view-over-to-next-method-alist'." +variable `mime-preview-over-to-next-method-alist'." (interactive) (while (null (get-text-property (point) 'mime-view-entity)) (forward-char) @@ -1376,8 +1350,8 @@ variable `mime-view-over-to-next-method-alist'." (if (null (get-text-property point 'mime-view-entity)) (mime-preview-move-to-next) )) - (let ((f (assq mime-preview-original-major-mode - mime-view-over-to-next-method-alist))) + (let ((f (assq (mime-preview-original-major-mode) + mime-preview-over-to-next-method-alist))) (if f (funcall (cdr f)) )) @@ -1386,14 +1360,14 @@ variable `mime-view-over-to-next-method-alist'." (defun mime-preview-scroll-up-entity (&optional h) "Scroll up current entity. If reached to (point-max), it calls function registered in variable -`mime-view-over-to-next-method-alist'." +`mime-preview-over-to-next-method-alist'." (interactive) (or h (setq h (1- (window-height))) ) (if (= (point) (point-max)) - (let ((f (assq mime-preview-original-major-mode - mime-view-over-to-next-method-alist))) + (let ((f (assq (mime-preview-original-major-mode) + mime-preview-over-to-next-method-alist))) (if f (funcall (cdr f)) )) @@ -1409,30 +1383,20 @@ If reached to (point-max), it calls function registered in variable (defun mime-preview-scroll-down-entity (&optional h) "Scroll down current entity. If reached to (point-min), it calls function registered in variable -`mime-view-over-to-previous-method-alist'." +`mime-preview-over-to-previous-method-alist'." (interactive) (or h (setq h (1- (window-height))) ) (if (= (point) (point-min)) - (let ((f (assq mime-preview-original-major-mode - mime-view-over-to-previous-method-alist))) + (let ((f (assq (mime-preview-original-major-mode) + mime-preview-over-to-previous-method-alist))) (if f (funcall (cdr f)) )) - (let (point) - (save-excursion - (catch 'tag - (while (not (bobp)) - (if (setq point - (previous-single-property-change (point) - 'mime-view-entity)) - (throw 'tag t) - ) - (backward-char) - ) - (setq point (point-min)) - )) + (let ((point + (or (previous-single-property-change (point) 'mime-view-entity) + (point-min)))) (forward-line (- h)) (if (< (point) point) (goto-char point) @@ -1457,23 +1421,12 @@ If reached to (point-min), it calls function registered in variable It calls function registered in variable `mime-preview-quitting-method-alist'." (interactive) - (let ((r (assq mime-preview-original-major-mode + (let ((r (assq (mime-preview-original-major-mode) mime-preview-quitting-method-alist))) (if r (funcall (cdr r)) ))) -(defun mime-preview-show-summary () - "Show summary. -It calls function registered in variable -`mime-view-show-summary-method'." - (interactive) - (let ((r (assq mime-preview-original-major-mode - mime-view-show-summary-method))) - (if r - (funcall (cdr r)) - ))) - (defun mime-preview-kill-buffer () (interactive) (kill-buffer (current-buffer)) diff --git a/mime-w3.el b/mime-w3.el index b5b0e41..2c0655b 100644 --- a/mime-w3.el +++ b/mime-w3.el @@ -35,15 +35,25 @@ ,keymap) ) +(defmacro mime-save-background-color (&rest body) + (if (featurep 'xemacs) + `(let ((color (color-name (face-background 'default)))) + (prog1 + (progn ,@body) + (font-set-face-background 'default color (current-buffer)) + )) + (cons 'progn body))) + (defun mime-preview-text/html (entity situation) - (save-restriction - (narrow-to-region (point-max)(point-max)) - (mime-text-insert-decoded-body entity) - (let ((beg (point-min))) - (remove-text-properties beg (point-max) '(face nil)) - (w3-region beg (point-max)) - (mime-put-keymap-region beg (point-max) w3-mode-map) - ))) + (mime-save-background-color + (save-restriction + (narrow-to-region (point-max)(point-max)) + (mime-text-insert-decoded-body entity) + (let ((beg (point-min))) + (remove-text-properties beg (point-max) '(face nil)) + (w3-region beg (point-max)) + (mime-put-keymap-region beg (point-max) w3-mode-map) + )))) ;;; @ end diff --git a/semi-def.el b/semi-def.el index f0b84c9..75a9280 100644 --- a/semi-def.el +++ b/semi-def.el @@ -29,7 +29,7 @@ (eval-when-compile (require 'cl)) -(defconst mime-module-version '("WEMI" "Manazuru" 1 5 4) +(defconst mime-module-version '("WEMI" "Yugawara" 1 6 0) "Implementation name, version name and numbers of MIME-kernel package.") (autoload 'mule-caesar-region "mule-caesar" -- 1.7.10.4