From e742225294d476268ba86d026009dece9cdeeae6 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 6 Dec 2000 06:46:57 +0000 Subject: [PATCH] Synch with `semi-1_14'. The last WEMI 1.13 is tagged with `wemi-1_13-last-'. --- ChangeLog | 1076 ++++++++++++++++++++++++++++++++++++++++++++++++++++++- Makefile | 6 +- NEWS | 11 + README.en | 5 +- SEMI-ELS | 8 +- VERSION | 14 +- mime-edit.el | 384 ++++++++++++++++---- mime-image.el | 281 ++++++++------- mime-pgp.el | 272 +++++++------- mime-play.el | 300 ++-------------- mime-ui-en.sgml | 30 +- mime-ui-en.texi | 27 +- mime-ui-ja.sgml | 28 +- mime-ui-ja.texi | 27 +- mime-view.el | 1032 ++++++++++++++++++++++++++++++++-------------------- mime-w3.el | 10 +- semi-def.el | 89 ++--- semi-setup.el | 111 +++--- signature.el | 9 +- 19 files changed, 2535 insertions(+), 1185 deletions(-) diff --git a/ChangeLog b/ChangeLog index f96fc42..c3eeb47 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,87 @@ +2000-11-26 MORIOKA Tomohiko + + * mime-view.el: Use `mime-conf' instead of `mailcap'. + + * mime-play.el (mime-activate-mailcap-method): Use + `mime-format-mailcap-command' instead of `mailcap-format-command'. + +2000-10-19 Takanori Saneto + + * pgg-pgp.el (pgg-pgp-process-region): bind process-environment + locally so that setenv's effect won't last forever. + pgg-pgp5.el (pgg-pgp5-process-region): Ditto. + +2000-09-29 MORIOKA Tomohiko + + * mime-edit.el (mime-file-types): Fix to use application/msword + instead of application/winword. + +2000-08-11 MORIOKA Tomohiko + + * mime-view.el (mime-display-text/plain): Display warning message + when `mime-insert-text-content' fails. + +2000-08-04 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-process-region): Don't bind + coding-system-for-read. + +2000-07-12 MORIOKA Tomohiko + + * README.en (Required environment): Modify for FLIM-Chao 1.14.1. + +2000-07-11 MORIOKA Tomohiko + + * mime-pgp.el (mime-view-application/pgp): Setup local variable + `mime-view-temp-message-buffer' of preview-buffer. + (mime-view-application/pkcs7-mime): Likewise. + + * mime-play.el + (mime-preview-quitting-method-for-mime-show-message-mode): Don't + use `mime-entity-buffer'; refer `mime-view-temp-message-buffer'. + (mime-store-message/partial-piece): Use + `insert-file-contents-as-binary' instead of + `(as-binary-input-file (insert-file-contents ...))'; use + `write-region-as-binary' instead of + `(as-binary-output-file (write-region ...)); setup local variable + `mime-view-temp-message-buffer' of preview-buffer. + +2000-07-04 Yuuichi Teranishi + + * mime-image.el (mime-image-insert) [XEmacs]: + Insert `string' only if it is non-nil. + +2000-06-27 Daiki Ueno + + * mime-image.el (mime-image-insert): Synch with the latest image.el. + (mime-display-image): Don't pass underlying string "x". + +2000-06-23 MORIOKA Tomohiko + + * mime-edit.el (mime-edit-preview-message): Set up local variable + `mime-edit-temp-message-buffer'. + (mime-edit-quitting-method): Refer `mime-edit-temp-message-buffer' + to avoid to use `mime-entity-buffer'. + +2000-06-21 MORIOKA Tomohiko + + * mime-view.el (mime-view-mode): Use + `mime-entity-set-content-type' and `mime-entity-set-encoding' + instead of `mime-entity-set-content-type-internal' and + `mime-entity-set-encoding-internal'. + + * mime-w3.el (mime-preview-text/html): Use + `mime-find-root-entity'. + +2000-06-09 Daiki Ueno + + * mime-edit.el (mime-edit-insert-key): Insert a text tag when + the buffer has any trailing text. + +2000-06-05 Shugo Maeda + + * pgg-gpg.el (pgg-scheme-insert-key): Don't quote user id. + 2000-05-25 Tanaka Akira * README.en: Update for CVS via SSH. @@ -14,10 +98,32 @@ `mime-create-widget-button' if the TTY frame is used. (mime-create-widget-button): Add comment. -2000-02-20 Yoshiki Hayashi +2000-05-21 Daiki Ueno - * semi-def.el (mime-insert-button): Insert newline to avoid - face property concatenation. + * pgg-gpg.el (pgg-gpg-process-region): Abolish redundant nconc. + +2000-05-16 Daiki Ueno + + * mime-image.el (mime-image-create) [XEmacs]: Don't call + `make-image-instance' directly. + +2000-05-02 Daiki Ueno + + * pgg-gpg.el (pgg-scheme-encrypt-region): Don't quote recipient; + concatenate all arguments destructively. + +2000-04-28 MORIOKA Tomohiko + + * mime-edit.el (mime-charset-type-list): Add `iso-2022-jp-3'. + +2000-04-13 Daiki Ueno + + * pgg-gpg.el: Fix author's mailing address. + (pgg-gpg-process-region): Add --output option; set status fd to 2. + (pgg-gpg-possibly-cache-passphrase): New function. + (pgg-gpg-shell-file-name): Abolish. + (pgg-gpg-shell-command-switch): Abolish. + (pgg-scheme-lookup-key): Work on temp buffer. 2000-04-13 Katsumi Yamaoka @@ -27,19 +133,983 @@ XEmacs 21.2.20 and later. (mime-preview-scroll-up-entity): Likewise. +2000-03-01 Yoshiki Hayashi + + * mime-image.el (mime-display-image): Don't wait for redisplay. + +2000-03-01 MORIOKA Tomohiko + + * mime-view.el (mime-view-define-keymap): Add new binding + `mime-preview-show-header' for C-c C-v C-f and C-c C-v h; add new + binding `mime-preview-show-content' for C-c C-v C-c; add new + binding `mime-preview-hide-header' for C-c C-d C-f and C-c C-d h; + add new binding `mime-preview-hide-content' for C-c C-d C-c. + (mime-preview-toggle-display): New function. + (mime-preview-toggle-header): Add new optional argument + `force-visible'; use `mime-preview-toggle-display'. + (mime-preview-toggle-content): Likewise. + (mime-preview-show-header): New function. + (mime-preview-show-content): New function. + (mime-preview-hide-header): New function. + (mime-preview-hide-content): New function. + +2000-02-25 MORIOKA Tomohiko + + * mime-view.el (mime-situation-examples-file-coding-system): New + variable. + (mime-save-situation-examples): Use `with-temp-buffer'; try to + save as `mime-situation-examples-file-coding-system'. + - Use with-temp-buffer to load `mime-situation-examples-file'; + setup `mime-situation-examples-file-coding-system' when + mime-situation-examples-file is loaded; + +2000-02-25 MORIOKA Tomohiko + + * mime-view.el (mime-view-define-keymap): Change keybind for + `mime-preview-toggle-header' to C-c C-t h and C-c C-t C-f. + +2000-02-24 Mito + + * mime-edit.el (mime-edit-normalize-body): Fix number of arguments + against enriched-encode. + +2000-02-23 Daiki Ueno + + * mime-image.el (mime-image-normalize-xbm-buffer): New inline + function. + (mime-image-create) [XEmacs || Emacs21]: Use it for XBM data. + (mime-display-image): Don't create temporary file. + +2000-02-22 MORIOKA Tomohiko + + * mime-view.el (mime-delq-null-situation): Accept multiple ignored + values. + (mime-unify-situations): t is also regarded as an ignored-value. + (mime-preview-follow-current-entity): Eliminate unused local + variable `str'. + +2000-02-22 MORIOKA Tomohiko + + * mime-play.el (mime-play-find-every-situations): Renamed from + `mime-view-find-every-situations'. + + * mime-view.el (mime-view-find-every-situations): Moved to + mime-play.el. + +2000-02-22 MORIOKA Tomohiko + + * mime-play.el (mime-play-entity): Specify + `mime-view-find-every-situations' as an optional argument + `every-situations'. + + * mime-view.el (mime-unify-situations): Add new optional argument + `every-situations'; use it instead of + `mime-view-find-every-situations'. + (mime-display-multipart/alternative): Modify `body' property + instead of `body-presentation-method' property of + preview-situation. + + * semi-setup.el: Use `eval-after-load' for text/html related + setting. + +2000-02-21 Daiki Ueno + + * semi-def.el (mime-user-interface-product): Bump up to + EMIKO 1.13.12. + + * pgg.el (pgg-temp-buffer-show-function): Use + `shrink-window-if-larger-than-buffer'. + + * pgg-gpg.el (pgg-gpg-process-region): Fix cleanup form. + + * pgg-pgp.el (pgg-pgp-process-region): Ditto. + + * pgg-pgp5.el (pgg-pgp5-process-region): Ditto. + + * semi-setup.el (mime-setup-enable-inline-image): Remove checking + of bitmap-mule; use `eval-after-load' instead of + `call-after-loaded' to require `mime-image'. + + * mime-image.el (mime-display-image): Set default umask to 077. + (mime-image-create): Use `nothing-image-instance-p'. + + * mime-pgp.el: When it is compiled, define `smime-output-buffer' + and `smime-errors-buffer' to avoid compiler warning. + + * mime-edit.el: Ditto. + + * mime-pgp.el + (mime-view-application/pkcs7-mime): Regard smime-type as + "enveloped-data" unless it is specified. + + * smime.el (smime-directory-files): Abolish. + (smime-verify-region): Abolish local variable `args'. + +2000-02-20 Yoshiki Hayashi + + * semi-def.el (mime-insert-button): Insert newline to avoid + face property concatenation. + +2000-02-20 Daiki Ueno + + * mime-image.el: Remove X-Face setting; require cl when compiling. + (mime-image-format-alist): Remove image/x-mag and image/x-pic. + (mime-image-type-available-p): New function. + (mime-image-create): New function. + (mime-image-insert): New function. + (mime-display-image): Rewrite. + + * mime-edit.el + (mime-edit-define-charset): Handle 'mime-charset-comment. + +2000-02-18 MORIOKA Tomohiko + + * mime-view.el (mime-view-define-keymap): Change binding of + `mime-preview-toggle-content' from C-c C-t C-b to C-c C-t C-c. + (mime-preview-toggle-content): Renamed from + `mime-preview-toggle-body'. + +2000-02-17 MORIOKA Tomohiko + + * mime-view.el (mime-view-define-keymap): Add new binding + `mime-preview-toggle-body' for C-c C-t C-b. + (mime-preview-toggle-body): New command. + + * semi-def.el (mime-add-button): Don't use overlay. + +2000-02-17 MORIOKA Tomohiko + + * mime-view.el (mime-preview-condition): Add default setting of + multipart; declare body of message/partial, message/rfc822 and + message/news are visible. + (mime-display-entity): Check `*body' or `body' property of + situation. + +2000-02-17 MORIOKA Tomohiko + + * mime-view.el (mime-display-entity): Find + `header-presentation-method' only if `header-is-visible'. + +2000-02-10 MORIOKA Tomohiko + + * mime-view.el (mime-display-entity): Don't use + `mime-goto-header-start-point'. + +2000-02-10 MORIOKA Tomohiko + + * mime-view.el (mime-display-message): Use `major-mode' of + current-buffer as default value of `original-major-mode'; don't + use `mime-entity-header-buffer'. + (mime-preview-follow-current-entity): Use `mime-insert-header' to + insert header; don't use `mime-entity-header-buffer', + `mime-entity-header-start-point' and + `mime-entity-header-end-point'. + +2000-02-10 MORIOKA Tomohiko + + * mime-view.el (mime-preview-follow-current-entity): Use + `mime-view-entity-body' to find body. + +2000-02-10 MORIOKA Tomohiko + + * mime-view.el (mime-preview-find-boundary-info): Fix problem when + entity is in boundary of mother entity. + (mime-preview-follow-current-entity): Check header information of + `mime-view-situation' property. + +2000-02-09 MORIOKA Tomohiko + + * mime-view.el (mime-preview-find-boundary-info): Use + - 1 instead of to get `mime-view-entity' property. + + * mime-view.el (mime-preview-follow-current-entity): Fix problem + in multipart entity. + +2000-02-07 Yoshiki Hayashi + + * mime-pgp.el: Fix doc string. + * pgg-def.el: Ditto. + * pgg-gpg.el: Ditto. + * pgg-parse.el: Ditto. + * pgg-pgp.el: Ditto. + * pgg-pgp5.el: Ditto. + * pgg.el: Ditto. + +2000-02-02 Nakagawa, Makoto + + * pgg-pgp5.el (pgg-scheme-verify-region): Copy the contents of + `pgg-errors-buffer' to `pgg-output-buffer'. + +2000-02-02 Daiki Ueno + + * pgg.el (pgg-temp-buffer-show-function): Don't check if the + selected window is the only window. + +2000-02-01 MORIOKA Tomohiko + + * semi-setup.el (mime-setup-enable-inline-image): Use "(fboundp + 'create-image)" to detect Emacs 21. + Use `eval-after-load' instead of `call-after-loaded' to require + `mime-image'. + +2000-02-01 MORIOKA Tomohiko + + * mime-view.el (mime-view-define-keymap): Change keybind for + `mime-preview-toggle-header' to "\C-c\C-t\C-h". + +2000-02-01 Daiki Ueno + + * mime-image.el: Add checking for `x-face-mule'. + + * pgg.el,pgp-gpg.el,pgg-pgp.el,pgg-pgp5.el + (pgg-scheme-lookup-key): Rename from + `pgg-scheme-lookup-key-string'. + (pgg-scheme-decrypt-region): Use `pgg-scheme-lookup-key'. + (pgg-scheme-sign-region): Ditto. + + * pgg-gpg.el (pgg-scheme-lookup-key): Generate *PGG-output* buffer + if it does not exist. + +2000-01-24 Daiki Ueno + + * semi-def.el (mime-user-interface-product): Bump up to + EMIKO 1.13.10. + + * mime-image.el [Emacs21]: Require `image' when compiling. + (image-normalize): Use `create-image' with 3rd arg `data-p'. + (create-image): Advice it to accept 3rd arg `data-p'. + + * pgg-pgp.el. pgg-pgp5.el + (pgg-scheme-verify-region): Don't send buffer contents. + + * mime-pgp.el (mime-view-application/pkcs7-mime): Rename from + `mime-decrypt-application/pkcs7-mime'; handle `smime-type' + parameter; abolish local variable `representation-type'. + + * semi-setup.el: Rename `mime-decrypt-application/pkcs7-mime' to + `mime-view-application/pkcs7-mime'. + +2000-01-18 Daiki Ueno + + * pgg.el,pgp-gpg.el,pgg-pgp.el,pgg-pgp5.el + (pgg-scheme-lookup-key-string,pgg-scheme-encrypt-region, + pgg-scheme-decrypt-region,pgg-scheme-sign-region, + pgg-scheme-verify-region,pgg-scheme-insert-key, + pgg-scheme-snarf-keys-region): Prepend `pgg-scheme' to each symbol. + + * pgg.el + (pgg-encrypt-region,pgg-decrypt-region,pgg-sign-region, + pgg-verify-region,pgg-insert-key,pgg-snarf-keys-region, + pgg-lookup-key-string): Don't use `luna-send'. + +2000-01-17 MORIOKA Tomohiko + + * mime-view.el (mime-view-entity-button-visible-p): Comment out. + (mime-display-entity): Don't use + `mime-view-entity-button-visible-p'. + +2000-01-17 MORIOKA Tomohiko + + * mime-view.el (mime-find-entity-preview-situation): New function. + (mime-display-multipart/alternative): Use + `mime-find-entity-preview-situation'. + (mime-display-entity): Likewise; prefer`*entity-button' and + `*header'. + (mime-preview-toggle-header): Modify `*header' instead of + `header'; update `mime-preview-situation-example-list'. + +2000-01-17 MORIOKA Tomohiko + + * mime-view.el (mime-unify-situations): Fixed. + (mime-view-define-keymap): Add new binding + `mime-preview-toggle-header' for C-c h. + (mime-preview-find-boundary-info): New function. + (mime-preview-follow-current-entity): Use + `mime-preview-find-boundary-info'. + (mime-preview-toggle-header): New command. + 2000-01-16 Keiichi Suzuki * mime-w3.el (mime-preview-text/html): Don't get root entity from `mime-entity-buffer'. +2000-01-16 MORIOKA Tomohiko + + * mime-play.el (mime-play-entity): Modify for + `mime-unify-situations'. + + * mime-view.el (mime-unify-situations): Add new optional argument + `required-name'; use it instead of `method'. + (mime-display-multipart/alternative): Use `mime-unify-situations'. + (mime-display-entity): Likewise. + +2000-01-16 MORIOKA Tomohiko + + * mime-view.el (mime-reduce-situation-examples): New function; + delete `mime-reduce-acting-situation-examples'. + +2000-01-16 MORIOKA Tomohiko + + * mime-view.el (mime-view-find-every-situations): Renamed from + `mime-view-find-every-acting-situation'; changed to variable. + (mime-situation-examples-file): Renamed from + `mime-acting-situation-examples-file'. + (mime-preview-situation-example-list-max-size): New variable. + (mime-save-situation-examples): Renamed from + `mime-save-acting-situation-examples'; save + `mime-preview-situation-example-list' if it is not null. + +2000-01-16 MORIOKA Tomohiko + + * mime-play.el (mime-acting-situation-example-list): Moved to + mime-view.el. + (mime-acting-situation-example-list-max-size): Likewise. + (mime-save-acting-situation-examples): Likewise. + (mime-reduce-acting-situation-examples): Likewise. + + * mime-view.el (mime-preview-situation-example-list): New + variable. + (mime-acting-situation-example-list): Moved from mime-play.el. + (mime-acting-situation-example-list-max-size): Likewise. + (mime-save-acting-situation-examples): Likewise. + (mime-reduce-acting-situation-examples): Likewise. + (mime-view-load-hook): Abolished. + +2000-01-16 MORIOKA Tomohiko + + * mime-play.el (mime-play-entity): Use `mime-unify-situations'. + + * mime-view.el (mime-unify-situations): New function. + +2000-01-16 MORIOKA Tomohiko + + * mime-play.el (mime-compare-situation-with-example): Moved to + mime-view.el. + (mime-sort-situation): Likewise. + + * mime-view.el (mime-compare-situation-with-example): Moved from + mime-play.el. + (mime-sort-situation): Likewise. + +2000-01-16 MORIOKA Tomohiko + + * postpet.el: New module. + + * SEMI-ELS (semi-modules-to-compile): Add `postpet'. + + * mime-play.el (mime-delq-null-situation): Moved to mime-view.el. + + * mime-view.el: Add setting for + `mime-display-application/x-postpet' to autoload "postpet". + (mime-delq-null-situation): Moved from mime-play.el. + (unpack): Moved to postpet.el. + (unpack-skip): Likewise. + (unpack-fixed): Likewise. + (unpack-byte): Likewise. + (unpack-short): Likewise. + (unpack-long): Likewise. + (unpack-string): Likewise. + (unpack-string-sjis): Likewise. + (postpet-decode): Likewise. + (mime-display-application/x-postpet): Likewise. + +2000-01-11 Nakagawa, Makoto + + * pgg-pgp.el, pgg-pgp5.el + (pgg-scheme-lookup-key-string): Fix number of arguments against + call-process. + + * pgg-pgp5.el (pgg-scheme-verify-region): Analize process output + to see whether verify successed or not. + 2000-01-05 Katsumi Yamaoka * Makefile, README.en: Update for the new CVS server. +1999-12-28 Daiki Ueno + + * mime-edit.el (mime-edit-user-agent-value): Don't require + `apel-ver' directly. + +1999-12-28 Katsumi Yamaoka + + * mime-edit.el (mime-edit-user-agent-value): Use `error' instead of + `file-error' for the handler of `condition-case' because XEmacs + does not signal an error named `file-error' if the required feature + is not provided. + +1999-12-16 MORIOKA Tomohiko + + * semi-setup.el (mime-setup-decode-message-header): Comment out. + (mime-edit-mode-hook): Don't use + `mime-setup-decode-message-header'. + (mu-cite/pre-cite-hook): Don't use `eword-decode-header'. + +1999-12-14 Akihiro Arisawa + + * mime-view.el (mime-preview-follow-current-entity): Fetch field of + `mime-view-following-required-fields-list' from parent entity if it + is not exist in current entity. + 1999-12-13 Katsumi Yamaoka * README.en: Update for the recent ML address and ftp site. +1999-12-11 Daiki Ueno + + * smime.el (smime-encrypt-region): Delete entity header. + (smime-sign-region): Ditto. + + * mime-edit.el: Fix autoload settings for `smime-sign-region' and + `smime-encrypt-region. + (mime-edit-sign-smime): Set Content-Type + `application/pkcs7-signature' instead of + `application/x-pkcs7-signature'; add Content-Description. + (mime-edit-encrypt-smime): Set content-type + `application/pkcs7-mime' instead of `x-application/pkcs7-mime'. + + * mime-pgp.el: Fix autoload settings for `smime-verify-region' and + `smime-decrypt-region. + (mime-decrypt-application/pkcs7-mime): + Bind `inhibit-read-only' to t. + +1999-12-09 Daiki Ueno + + * semi-def.el (mime-user-interface-product): Bump up to + EMIKO 1.13.9. + + * smime.el: Require `static' when compiling. + (smime-directory-files): New macro. + (smime-find-certificate): Use it. + +1999-12-08 Daiki Ueno + + * smime.el (smime-verify-region): Abolish local variable `cert-file'. + (smime-find-certificate): Rename from `smime-search-certificate'. + + * mime-edit.el: Add autoload settings for `smime-encrypt-region' and + `smime-sign-region'. + (mime-edit-process-multipart-1): Handle type "smime-signed" and + "smime-encrypted". + (mime-edit-sign-smime): New function. + (mime-edit-encrypt-smime): New function. + (mime-edit-enclose-smime-signed-region): New function. + (mime-edit-enclose-smime-encrypted-region): New function. + + * mime-pgp.el: Add autoload settings for `smime-decrypt-region' and + `smime-verify-region'. + (mime-verify-application/pkcs7-signature): New function. + (mime-decrypt-application/pkcs7-mime): New function. + + * semi-setup.el: Set up for `mime-verify-application/pkcs7-signature' + and `mime-decrypt-application/pkcs7-mime'. + +1999-12-08 Daiki Ueno + + * smime.el (smime-x509-hash): Use `call-process' instead of + `call-process-region'. + (smime-x509-subject): Ditto. + +1999-12-08 Daiki Ueno + + * SEMI-ELS (semi-modules-to-compile): Add smime.el. + + * smime.el: New file. + +1999-11-30 Tsukamoto Tetsuo + + * mime-edit.el (mime-edit-decode-message-in-buffer): Don't decode + the message header twice. + +1999-11-30 Daiki Ueno + + * pgg.el (pgg-remove-passphrase-cache): Add checking whether + the passphrase has already been expired. + +1999-11-26 Daiki Ueno + + * mime-edit.el (mime-edit-pgp-user-id): New variable. + (mime-edit-sign-pgp-mime): Undo last change; refer + `mime-edit-pgp-user-id'. + (mime-edit-encrypt-pgp-mime): Ditto. + + * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el + (encrypt-region): Refer `pgg--user-id' if specified. + (sign-region): Ditto. + (decrypt-region): Ditto. + (insert-key): Ditto. + +1999-11-26 Nakagawa, Makoto + + * mime-edit.el (mime-edit-sign-pgp-mime): Regard + `pgg-default-user-id' as more preferrable if it's specified. + (mime-edit-encrypt-pgp-mime): Ditto. + +1999-11-22 Daiki Ueno + + * semi-def.el (mime-user-interface-product): Bump up to + EMIKO 1.13.8. + + * pgg.el (pgg-remove-passphrase-cache): Don't unbind passphrase. + +1999-11-20 Daiki Ueno + + * mime-edit.el (mime-edit-sign-pgp-mime): Bind + `pgg-default-user-id' to the canonical address of From field. + + * pgg-def.el (pgg-cache-passphrase): New user option. + + * pgg.el (pgg-read-passphrase): Refer `pgg-cache-passphrase'. + (pgg-remove-passphrase-cache): Fill cached passphrase with `_'. + + * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (sign-region): Refer + `pgg-cache-passphrase'. + +1999-11-17 Katsumi Yamaoka + + * mime-image.el (mime-display-image): Use + `mime-image-normalize-xbm' if the feature `xemacs' is provided or + the variable `image-types' is bound. + +1999-11-17 Daiki Ueno + + * mime-image.el (mime-image-normalize-xbm): Work for the future + FSF Emacsen as well. + (mime-display-image): Always use `mime-image-normalize-xbm'. + +1999-11-17 Katsumi Yamaoka + + * mime-image.el (mime-image-normalize-xbm): New macro. + (mime-display-image): Use it. + +1999-11-13 Daiki Ueno + + * pgg.el (pgg-temp-buffer-show-function): New function. + (pgg-display-output-buffer): Use it. + (pgg-save-coding-system): Use buffer narrowing. + (pgg-encrypt-region, pgg-decrypt-region, pgg-sign-region, + pgg-verify-region): Assume that the current region has already + been narrowed. + +1999-11-13 Daiki Ueno + + * pgg-def.el (pgg-default-keyserver-address): Default to + `wwwkeys.pgp.net'. + + * pgg.el (pgg-save-coding-system): New macro. + (pgg-display-output-buffer): New function. + (pgg-encrypt-region, pgg-decrypt-region, pgg-sign-region, + pgg-verify-region, pgg-insert-key, pgg-snarf-keys-region): + Add documentation string; use `pgg-save-coding-system'. + (pgg-fetch-key): Fix documentation. + +1999-11-11 Akihiro Arisawa + + * mime-image.el (image-normalize): Use `write-region-as-binary'. + +1999-11-11 Daiki Ueno + + * pgg-pgp.el, pgg-pgp5.el (verify-region): Set default umask to 077. + +1999-11-10 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-process-region): Enclose `start-process' + with `as-binary-process'. + + * pgg-pgp.el (pgg-pgp-process-region): Enclose `start-process' + with `as-binary-process'. + + * pgg-pgp5.el (pgg-pgp5-process-region): Enclose `start-process' + with `as-binary-process'. + + * mime-edit.el (mime-edit-set-sign): Remove duplication. + (mime-edit-set-encrypt): Ditto. + (mime-edit-encrypt-pgp-mime): Encode header before encrypting. + + * mime-image.el (image-insert-at-point): Check the number of the + arguments of `insert-image'. + (mime-display-image): Rewrite. + +1999-11-09 Daiki Ueno + + * pgg-pgp.el, pgg-pgp5.el + (sign-region): Don't convert line break code. + +1999-11-07 Daiki Ueno + + * mime-pgp.el (mime-verify-application/pgp-signature): Don't + scroll MIME-echo buffer, just set window starting point. + (mime-add-application/pgp-keys): Ditto. + +1999-11-06 Daiki Ueno + + * pgg.el (pgg-sign-region): Add optional argument `cleartext'. + + * mime-ui-en.sgml, mime-ui-ja.sgml: Remove description about + `pgp-functions-alist' and `pgp-function'; add description about + `pgg-default-scheme' and `pgg-scheme'. + + * NEWS (PGP 5.0i and GnuPG are now supported for PGP/MIME): + New section. + + * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (encrypt-region): Add + sender's user id to the recipients list if `pgg-encrypt-for-me' is + specified. + + * pgg-def.el (pgg-encrypt-for-me): New user option. + + * mime-edit.el: + (mime-edit-decode-multipart-in-buffer): Sync up with semi-pgpgpg_20. + (mime-edit-decode-message-in-buffer): Ditto. + (mime-edit-decode-single-part-in-buffer): Ditto. + +1999-11-06 Daiki Ueno + + * pgg.el (pgg-verify-region): Bind `pgg-scheme' in the predicate + of whether to fetch signer's public key. + (pgg-convert-lbt-region): New macro. + (pgg-as-lbt): New macro. + + * mime-edit.el (mime-edit-encrypt-pgp-mime): Extract canonical + address of From field to use it as default user id; tokenize + bodies of the recipient fields. + (mime-edit-make-encrypt-recipient-header): Undo last change. + (mime-edit-translate-buffer): Do `undo-boundary' + before translating. + + * pgg-gpg.el (sign-region): Use `pgg-as-lbt'. + (pgg-gpg-process-region): Use `pgg-convert-lbt-region'. + (encrypt-region): Don't ask passphrase. + + * pgg-pgp5.el (sign-region): Use `pgg-as-lbt'. + (pgg-pgp5-process-region): Use `pgg-convert-lbt-region'. + (encrypt-region): Don't ask passphrase. + + * pgg-pgp.el (verify-region): Fill errors buffer. + (pgg-pgp-process-region): Use `pgg-convert-lbt-region'. + (sign-region): Use `pgg-as-lbt'. + (encrypt-region): Don't ask passphrase. + +1999-11-06 Daiki Ueno + + * pgg-parse.el (pgg-byte-after): Always pass the first argument + of `char-after'. + +1999-11-05 Daiki Ueno + + * pgg-pgp.el (sign-region): Fix regexp for the beginning of armor. + + * pgg-gpg.el (encrypt-region): Don't use "--textmode" in GPG + arguments, replace line break code with CRLF while signing + instead. + +1999-11-05 Daiki Ueno + + * mime-pgp.el (mime-verify-application/pgp-signature): Copy the + messages in PGG buffers to MIME-echo buffer instead of binding + `pgg-output-buffer'. + (mime-add-application/pgp-keys): Likewise. + + * pgg-gpg.el (verify-region): Fill errors buffer whether + verification has succeeded or not. + +1999-11-05 Daiki Ueno + + * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (snarf-keys-region): + Use `pgg-process-when-success'. + + * pgg.el (pgg-encrypt-region): Add autoload cookie. + (pgg-decrypt-region): Ditto. + (pgg-sign-region): Ditto. + (pgg-verify-region): Don't modify the buffer; add autload cookie. + (pgg-snarf-keys-region): Add interactive spec; add autload cookie. + (pgg-insert-key): Add interactive spec; add autload cookie. + +1999-11-05 Daiki Ueno + + * pgg-gpg.el (pgg-gpg-shell-command-switch): New user option. + (pgg-gpg-process-region): Bind `shell-command-switch' to the value + of `pgg-gpg-shell-command-switch'. + + * pgg-pgp.el (pgg-pgp-shell-command-switch): New user option. + (pgg-pgp-process-region): Bind `shell-command-switch' to the value + of `pgg-pgp-shell-command-switch'. + + * pgg-pgp5.el (pgg-pgp5-shell-command-switch): New user option. + (pgg-pgp5-process-region): Bind `shell-command-switch' to the value + of `pgg-pgp5-shell-command-switch'. + + * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el (sign-region): Use fixed end + position of the signature. + + * mime-pgp.el: Add autoload for `pgg-decrypt-region', + `pgg-verify-region', `pgg-snarf-keys-region'. + (mime-view-application/pgp): Don't use `pgp-function'. + (mime-verify-application/pgp-signature): Ditto. + (mime-add-application/pgp-keys): Ditto. + (mime-pgp-command): Abolish. + (mime-pgp-default-language): Abolish. + (mime-pgp-good-signature-regexp-alist): Abolish. + (mime-pgp-key-expected-regexp-alist): Abolish + (mime-pgp-check-signature): Abolish. + + * semi-def.el (pgp-function-alist): Abolish. + (pgp-function): Abolish. + + * mime-edit.el: Add autoload for `pgg-encrypt-region', + `pgg-sign-region', `pgg-insert-key'. + (mime-edit-sign-pgp-mime): Throw an error when + `pgg-sign-region' returns nil; don't use `pgp-function'. + (mime-edit-encrypt-pgp-mime): Throw an error when + `pgg-encrypt-region' returns nil; don't use `pgp-function'. + (mime-edit-sign-pgp-kazu): Don't use `pgp-function'. + (mime-edit-encrypt-pgp-mime): Ditto. + +1999-11-05 Daiki Ueno + + * mime-pgp.el (mime-add-application/pgp-keys): Don't display + public key block; snarf keys immediately. + + * pgg.el (pgg-insert-url-with-program): Call program asynchronously. + +1999-11-05 Daiki Ueno + + * pgg-def.el (pgg-echo-buffer): New variable. + + * pgg.el (pgg-process-when-success): New macro. + (pgg-insert-url-with-w3): New function. + (pgg-insert-url-program): New variable. + (pgg-insert-url-extra-arguments): New variable. + (pgg-insert-url-function): New variable. + (pgg-fetch-key): Use it. + (pgg-encrypt-region): If called interactively, popup + `pgg-echo-buffer' to display encryption status. + (pgg-decrypt-region): Likewise. + (pgg-sign-region): Likewise. + (pgg-verify-region): Likewise. + + * pgg-gpg.el (lookup-key-string): Use `call-process' instead of + `pgg-gpg-process-region'. + (encrypt-region): Use `pgg-process-when-success'; if the output + buffer is empty, don't copy errors, just return nil. + (decrypt-region): Likewise. + (verify-region): Check the contents of status buffer to looking + for `GOODSIG' response. + (sign-region): Accept optional argument `clearsign'. + + * pgg-pgp.el (lookup-key-string): Use `call-process' instead of + `pgg-pgp-process-region'. + (encrypt-region): Use `pgg-process-when-success'; if the output + buffer is empty, don't copy errors, just return nil. + (decrypt-region): Likewise. + (verify-region): Likewise. + (sign-region): Accept optional argument `clearsign'. + + * pgg-pgp5.el (lookup-key-string): Use `call-process' instead of + `pgg-pgp5-process-region'. + (encrypt-region): Use `pgg-process-when-success'; if the output + buffer is empty, don't copy errors, just return nil. + (decrypt-region): Likewise. + (verify-region): Likewise. + (sign-region): Accept optional argument `clearsign'. + +1999-11-04 Daiki Ueno + + * pgg.el (pgg-verify-region): Ignore all errors encountered on + calling `pgg-fetch-key'. + +1999-11-04 Daiki Ueno + + * mime-pgp.el (mime-verify-application/pgp-signature): Enclose + with `unwind-protect' to be sure of deleting *.asc files. + + * pgg-pgp.el (pgg-pgp-process-region): Set `PGPPASSFD' before + starting PGP process. + + * pgg-pgp5.el (pgg-pgp5-process-region): Ditto. + +1999-11-04 Daiki Ueno + + * pgg-parse.el (pgg-parse-crc24): Don't use any `write' ops. + (pgg-parse-crc24-string): Use `ccl-execute-on-string'. + +1999-11-04 Daiki Ueno + + * mime-edit.el (mime-edit-set-sign): Preserve last status of + `mime-edit-pgp-processing'. + (mime-edit-set-encrypt): Ditto. + (mime-edit-pgp-enclose-buffer): Process + `mime-edit-pgp-enclose-buffer' consequently. + + * pgg-parse.el (pgg-decode-packets): Don't use + `mime-encode-string'. + (pgg-ignore-packet-checksum): Default to t. + +1999-11-04 Daiki Ueno + + * pgg.el: Rename the field name `cipher-algorithm' to + `symmetric-key-algorithm'. + (pgg-verify-condition): Fix documentation. + (pgg-decrypt-condition): Ditto. + +1999-11-04 Katsumi Yamaoka + + * mime-edit.el (mime-edit-preview-message): Inherit the value of + `mime-edit-pgp-processing'. + +1999-11-04 Daiki Ueno + + * pgg.el (pgg-encrypt-region): Add interactive spec. + (pgg-decrypt-region): Ditto. + (pgg-sign-region): Ditto. + (pgg-verify-region): Add optional argument `fetch' to fetch + signer's public key. + + * pgg-def.el (pgg-default-keyserver-address): New variable. + + * semi-def.el (pgp-function-alist): Remove `lookup-key'. + + * mime-pgp.el (mime-display-application/pgp-signature): Abolish. + (mime-display-application/pgp-encrypted): Abolish. + (mime-display-application/pgp-keys): Abolish. + (mime-pgp-keyserver-url-template): Abolish. + (mime-pgp-keyserver-address): Abolish. + (mime-pgp-keyserver-port): Abolish. + (mime-pgp-keyserver-protocol): Abolish. + (mime-pgp-fetch-key): Abolish. + + * semi-setup.el: Delete default setting of + `mime-display-application/pgp-signature', + `mime-display-application/pgp-encrypted', + `mime-display-application/pgp-keys' + +1999-11-03 Daiki Ueno + + * pgg.el (pgg-fetch-key): Protect `buffer-file-name'. + + * pgg-gpg.el (snarf-keys-region): Add `-' as extra argument of + gpg --import; convert status code into an integer. + +1999-11-03 Daiki Ueno + + * semi-def.el (pgp-function-alist): Add `lookup-key'. + + * pgg.el, pgg-gpg.el, pgg-pgp5.el, pgg-pgp.el: + Rename generic function `lookup-key' to `lookup-key-string'; + add optional argument `type'. + + * pgg-def.el (pgg-truncate-key-identifier): New macro. + + * pgg.el: Rename generic function `lookup-key' to + `lookup-key-string'; add optional argument `type'. + (pgg-fetch-key): New function. + (pgg-snarf-keys-region): Fix typo. + (pgg-lookup-key-string): New function. + (pgg-read-passphrase): Use `pgg-truncate-key-identifier'. + (pgg-add-passphrase-cache): Ditto. + + * mime-pgp.el (mime-pgp-keyserver-url-template): New variable + imported from semi-pgpgpg. + (mime-pgp-keyserver-address): Ditto. + (mime-pgp-keyserver-port): Ditto. + (mime-pgp-keyserver-protocol): New variable. + (mime-pgp-fetch-key): New function. + (mime-verify-application/pgp-signature): Prompt user to fetch + signer's public key. + +1999-11-03 Daiki Ueno + + * pgg.el (pgg-fetch-public-key): New function. + + * pgg-pgp.el (lookup-key): New generic function. + (encrypt-region): Use `lookup-key'; cache passphrase if the + encryption has done successfully. + (sign-region): Likewise. + (decrypt-region): Use `lookup-key'. + + * pgg.el (pgg-scheme): Remove all slots. + (pgg-decrypt-codition): Rename tag `cipher-algorithm' to + `symmetric-key-algorithm'. + (lookup-key): Add documentation about the new generic function. + + * pgg-parse.el (pgg-decode-armor-region): Remove autoload cookie. + (pgg-armor-header-lines): New variable. + +1999-11-02 Daiki Ueno + + * pgg.el (pgg-add-passphrase-cache): Use only four octets of the key. + (pgg-read-passphrase): Ditto. + + * pgg-pgp5.el (lookup-key): New generic function. + (encrypt-region): Use `lookup-key'; cache passphrase if the + encryption has done successfully. + (sign-region): Likewise. + (decrypt-region): Use `lookup-key'. + +1999-11-02 Daiki Ueno + + * pgg-parse.el + (pgg-parse-public-key-encrypted-session-key-packet): + Rename tag `public-key-identifier' to `key-identifier'. + + * mime-pgp.el + (mime-display-application/pgp-encrypted): Refer it. + + * pgg.el (pgg-passphrase-cache-expiry): New variable. + (pgg-passphrase-cache): New variable. + (pgg-read-passphrase): Add optional argument `key'. + (pgg-add-passphrase-cache): New function. + (pgg-remove-passphrase-cache): New function. + + * pgg-gpg.el (lookup-key): New generic function. + (encrypt-region): Use `lookup-key'; cache passphrase if the + encryption has done successfully. + (sign-region): Likewise. + (decrypt-region): Use `lookup-key'. + +1999-11-02 Daiki Ueno + + * pgg-parse.el (pgg-parse-length-type): Fix typo. + (pgg-parse-public-key-encrypted-session-key-packet): Use + `pgg-read-bytes-string' instead of `pgg-read-bytes'. + +1999-11-02 Daiki Ueno + + * mime-edit.el (mime-edit-sign-pgp-mime): Rewrite with PGG functions. + (mime-edit-encrypt-pgp-mime): Likewise. + (mime-edit-encrypt-recipient-fields-list): Return recipients as list. + + * mime-pgp.el: Add comment that this module is based on + draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) and RFC 2440 + (OpenPGP Message Format) as well. + (mime-verify-application/pgp-signature): Use + `pgg-verify-region' instead of `mime-pgp-check-signature'. + (mime-display-application/pgp-signature): New function. + (mime-display-application/pgp-encrypted): New function. + (mime-display-application/pgp-keys): New function. + + * semi-setup.el: Set up for + `mime-display-application/pgp-signature', + `mime-display-application/pgp-encrypted', + `mime-display-application/pgp-keys'. + (mime-setup-enable-pgp): Default to t. + + * SEMI-ELS (semi-modules-to-compile): Add `pgg', `pgg-parse', + `pgg-gpg', `pgg-pgp' and `pgg-pgp5' instead of `mime-mc'. + + * EMIKO-VERSION, pgg-def.el, pgg.el, pgg-gpg.el, + pgg-pgp5.el, pgg-pgp.el, pgg-parse.el: New file. + + * mime-image.el (mime-display-image): Rewrite. + + * semi-def.el (mime-user-interface-product): Modify for EMIKO. + (pgp-function-alist): Replace each method with PGG function. + + * mime-view.el (mime-view-popup-menu): New variable. + (mime-view-popup-menu): New function. + (mime-view-define-keymap): Bind `mime-view-popup-menu' to + `mouse-button-3'. + 1999-11-10 Yoshiki Hayashi * mime-play.el: (mime-save-directory): New variable. diff --git a/Makefile b/Makefile index 3613579..ef7eaea 100644 --- a/Makefile +++ b/Makefile @@ -3,10 +3,10 @@ # PACKAGE = wemi -API = 1.13 -RELEASE = 7 +API = 1.14 +RELEASE = 0 -FLIM_API= 1.13 +FLIM_API= 1.14 TAR = tar RM = /bin/rm -f diff --git a/NEWS b/NEWS index 529574f..eaebaeb 100644 --- a/NEWS +++ b/NEWS @@ -3,6 +3,17 @@ Copyright (C) 1998,1999 Free Software Foundation, Inc. * Changes in SEMI 1.13 +** PGP 5.0i and GnuPG are now supported for PGP/MIME + + You can select the various PGP or GnuPG commands by the user option +`pgg-default-scheme' or `pgg-scheme'. The former is for encrypting and +signing, the latter could be bound for controlling which command is +used to process the incoming PGP armors. Note that Mailcrypt is not +needed anymore. A user interface for editing or viewing has never +changed. Note also that `pgp-function' and `pgp-functions-alist' are +abolished in this version. + + ** Requires FLIM 1.13 API diff --git a/README.en b/README.en index 0f94419..1b5c94d 100644 --- a/README.en +++ b/README.en @@ -44,7 +44,7 @@ Required environment 19.14. WEMI also does not support Emacs 19.29 to 19.34, XEmacs 19.15 or XEmacs 20.2 without mule, but WEMI may work with them. - SEMI requires APEL (9.20 or later) and FLIM (1.13.1 or later) + SEMI requires APEL (9.22 or later) and FLIM (Chao 1.14.1 or later) package. Please install them before installing it. APEL package is available at: @@ -52,7 +52,8 @@ Required environment and FLIM package is available at: - ftp://ftp.m17n.org/pub/mule/flim/flim-1.13/ + http://www.kanji.zinbun.kyoto-u.ac.jp/~tomo/comp/emacsen/lisp/ + flim/flim-1.14/ PGP/MIME and application/pgp require mailcrypt or tiny-pgp package. diff --git a/SEMI-ELS b/SEMI-ELS index 6ffa7fc..448caf3 100644 --- a/SEMI-ELS +++ b/SEMI-ELS @@ -6,7 +6,10 @@ (setq semi-modules-to-compile '(signature - semi-def mime-view mime-play mime-partial mime-edit + pgg-def pgg pgg-parse pgg-gpg pgg-pgp5 pgg-pgp mime-pgp + smime + semi-def mime-view mime-play mime-partial postpet + mime-edit semi-setup mail-mime-setup)) (setq semi-modules-not-to-compile nil) @@ -23,8 +26,7 @@ (nconc semi-modules-not-to-compile i-modules)) ) ))) - '((mailcrypt mime-pgp mime-mc) - (bbdb mime-bbdb) + '((bbdb mime-bbdb) (w3 mime-w3) )) diff --git a/VERSION b/VERSION index 9c1fa27..8b8d6ef 100644 --- a/VERSION +++ b/VERSION @@ -81,6 +81,12 @@ 1.13.5 Meih-Dò-A $(BL@Jv(B 1.13.6 Komatsu $(B>.>>(B 1.13.7 Awazu $(B0@DE(B +1.14.0 Iburihashi $(BF066(B +------ Kaga-Onsen $(B2C2l29@t(B +------ Daish-Dòji-A $(BBg@;;{(B +------ Ushinoya $(B5m%NC+(B +------ Hosorogi $(B:YO$LZ(B +------ Awara-Onsen $(B028629@t(B : : : ------- Tsuruga $(BFX2l(B ; = JR $(B>.IM@~(B ------- Shin-Hikida $(B?7I%ED(B @@ -91,7 +97,7 @@ ------- Kawake $(B2OLS(B ------- Torahime $(B8WI1(B ------- Nagahama $(BD9IM(B -------- Tamura $(BEDB<(B +------- Tamura $(BEDB<(B ------- Sakata $(B:dED(B (Maibara) ($(BJF86(B) ; = JR $(BEl3$F;K\@~(B @@ -150,7 +156,7 @@ 1.13.5 Fijieda $(BF#;^(B 1.13.6 Rokug-Dò-A $(BO;9g(B 1.13.7 Shimada $(BEgED(B ------- Kanaya $(B6bC+(B ; = $(BBg0f@nE4F;(B +1.14.0 Kanaya $(B6bC+(B ; = $(BBg0f@nE4F;(B ------ Kikugawa $(B5F@n(B ------ Kakegawa $(B3]@n(B ; = $(BE7N5IML>8PE4F;(B ------ Fukuroi $(BB^0f(B @@ -214,6 +220,10 @@ 1.13.0 Saigata $(B:T3c(B ; = JR $(B?.1[K\@~(B 1.13.1 Kubiki $(B$/$S$-(B 1.13.2 -DÒike-Ikoinomori-A $(BBgCS$$$3$$$N?9(B +1.14.0 Uragawara $(B$&$i$,$o$i(B +1.14.1 Mushigawa-Dòsugi-A $(BCn@nBg?y(B +1.14.2 Hokuhoku--DÒshima-A $(B$[$/$[$/BgEg(B +1.14.3 Matsudai $(B$^$D$@$$(B [etc.] diff --git a/mime-edit.el b/mime-edit.el index 81b7613..d6899a3 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -1,9 +1,10 @@ ;;; mime-edit.el --- Simple MIME Composer for GNU Emacs -;; Copyright (C) 1993,94,95,96,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1993,94,95,96,97,98,99,2000 Free Software Foundation, Inc. ;; Author: UMEDA Masanobu -;; MORIOKA Tomohiko +;; MORIOKA Tomohiko +;; Daiki Ueno ;; Created: 1994/08/21 renamed from mime.el ;; Renamed: 1997/2/21 from tm-edit.el ;; Keywords: MIME, multimedia, multilingual, mail, news @@ -114,6 +115,21 @@ (require 'signature) (require 'alist) (require 'invisible) +(require 'pgg-def) +(require 'pgg-parse) + +(autoload 'pgg-encrypt-region "pgg" + "PGP encryption of current region." t) +(autoload 'pgg-sign-region "pgg" + "PGP signature of current region." t) +(autoload 'pgg-insert-key "pgg" + "Insert PGP public key at point." t) +(autoload 'smime-encrypt-region "smime" + "S/MIME encryption of current region.") +(autoload 'smime-sign-region "smime" + "S/MIME signature of current region.") +(defvar smime-output-buffer) +(defvar smime-errors-buffer) ;;; @ version @@ -301,7 +317,7 @@ To insert a signature file automatically, call the function ;; Octect binary text ("\\.doc$" ;MS Word - "application" "winword" nil + "application" "msword" nil "base64" "attachment" (("filename" . file)) ) @@ -483,6 +499,7 @@ If encoding is nil, it is determined from its contents." (iso-8859-8 8 "quoted-printable") (iso-8859-9 8 "quoted-printable") (iso-2022-jp 7 "base64") + (iso-2022-jp-3 7 "base64") (iso-2022-kr 7 "base64") (euc-kr 8 "base64") (cn-gb 8 "base64") @@ -510,7 +527,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) - ;;; @@ about content transfer encoding (defvar mime-content-transfer-encoding-priority-list @@ -632,6 +648,8 @@ If it is not specified for a major-mode, " (" (mime-product-code-name mime-library-product) ") " + (if (fboundp 'apel-version) + (concat (apel-version) " ")) (if (featurep 'xemacs) (concat (cond ((featurep 'utf-2000) (concat "UTF-2000-MULE/" utf-2000-version)) @@ -1384,7 +1402,11 @@ Optional argument ENCODING specifies an encoding method such as base64." (mime-create-tag (mime-edit-set-parameter (mime-edit-get-contype tag) - "charset" (upcase (symbol-name charset))) + "charset" + (let ((comment (get charset 'mime-charset-comment))) + (if comment + (concat (upcase (symbol-name charset)) " (" comment ")") + (upcase (symbol-name charset))))) (mime-edit-get-encoding tag))) )))) @@ -1633,6 +1655,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (defun mime-edit-translate-buffer () "Encode the tagged MIME message in current buffer in MIME compliant message." (interactive) + (undo-boundary) (if (catch 'mime-edit-error (save-excursion (run-hooks 'mime-edit-translate-buffer-hook) @@ -1703,6 +1726,12 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." ((string-equal type "kazu-encrypted") (mime-edit-encrypt-pgp-kazu bb eb boundary) ) + ((string-equal type "smime-signed") + (mime-edit-sign-smime bb eb boundary) + ) + ((string-equal type "smime-encrypted") + (mime-edit-encrypt-smime bb eb boundary) + ) (t (setq boundary (nth 2 (mime-edit-translate-region bb eb @@ -1736,26 +1765,57 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (replace-match (concat "-" (substring tag 2))) ))))) +(defvar mime-edit-pgp-user-id nil) + (defun mime-edit-sign-pgp-mime (beg end boundary) (save-excursion (save-restriction - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) + (let* ((from (std11-field-body "From" mail-header-separator)) + (ret (progn + (narrow-to-region beg end) + (mime-edit-translate-region beg end boundary))) (ctype (car ret)) (encoding (nth 1 ret)) - (pgp-boundary (concat "pgp-sign-" boundary))) + (pgp-boundary (concat "pgp-sign-" boundary)) + micalg) (goto-char beg) (insert (format "Content-Type: %s\n" ctype)) (if encoding (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") - (or (as-binary-process - (funcall (pgp-function 'mime-sign) - (point-min)(point-max) nil nil pgp-boundary)) + (or (let ((pgg-default-user-id + (or mime-edit-pgp-user-id + (if from + (nth 1 (std11-extract-address-components from)) + pgg-default-user-id)))) + (pgg-sign-region (point-min)(point-max))) (throw 'mime-edit-error 'pgp-error) ) + (setq micalg + (cdr (assq 'hash-algorithm + (cdar (with-current-buffer pgg-output-buffer + (pgg-parse-armor-region + (point-min)(point-max)))))) + micalg + (if micalg + (concat "; micalg=pgp-" (downcase (symbol-name micalg))) + "")) + (goto-char beg) + (insert (format "--[[multipart/signed; + boundary=\"%s\"%s; + protocol=\"application/pgp-signature\"][7bit]] +--%s +" pgp-boundary micalg pgp-boundary)) + (goto-char (point-max)) + (insert (format "\n--%s +Content-Type: application/pgp-signature +Content-Transfer-Encoding: 7bit + +" pgp-boundary)) + (insert-buffer-substring pgg-output-buffer) + (goto-char (point-max)) + (insert (format "\n--%s--\n" pgp-boundary)) )))) (defvar mime-edit-encrypt-recipient-fields-list '("To" "cc")) @@ -1796,28 +1856,41 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (save-excursion (save-restriction (let (from recipients header) - (let ((ret (mime-edit-make-encrypt-recipient-header))) - (setq from (aref ret 0) - recipients (aref ret 1) - header (aref ret 2)) + (let ((ret (mime-edit-make-encrypt-recipient-header))) + (setq from (aref ret 0) + recipients (aref ret 1) + header (aref ret 2)) ) - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret)) - (pgp-boundary (concat "pgp-" boundary))) - (goto-char beg) - (insert header) - (insert (format "Content-Type: %s\n" ctype)) - (if encoding - (insert (format "Content-Transfer-Encoding: %s\n" encoding)) - ) - (insert "\n") - (or (funcall (pgp-function 'encrypt) - recipients (point-min) (point-max) from) + (narrow-to-region beg end) + (let* ((ret + (mime-edit-translate-region beg end boundary)) + (ctype (car ret)) + (encoding (nth 1 ret)) + (pgp-boundary (concat "pgp-" boundary))) + (goto-char beg) + (insert header) + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + ) + (insert "\n") + (eword-encode-header) + (or (let ((pgg-default-user-id + (or mime-edit-pgp-user-id + (if from + (nth 1 (std11-extract-address-components from)) + pgg-default-user-id)))) + (pgg-encrypt-region + (point-min) (point-max) + (mapcar (lambda (recipient) + (nth 1 (std11-extract-address-components + recipient))) + (split-string recipients + "\\([ \t\n]*,[ \t\n]*\\)+"))) + ) (throw 'mime-edit-error 'pgp-error) ) + (delete-region (point-min)(point-max)) (goto-char beg) (insert (format "--[[multipart/encrypted; boundary=\"%s\"; @@ -1830,6 +1903,7 @@ Content-Type: application/octet-stream Content-Transfer-Encoding: 7bit " pgp-boundary pgp-boundary pgp-boundary)) + (insert-buffer-substring pgg-output-buffer) (goto-char (point-max)) (insert (format "\n--%s--\n" pgp-boundary)) ))))) @@ -1848,9 +1922,7 @@ Content-Transfer-Encoding: 7bit (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") - (or (as-binary-process - (funcall (pgp-function 'traditional-sign) - beg (point-max))) + (or (pgg-sign-region beg (point-max) 'clearsign) (throw 'mime-edit-error 'pgp-error) ) (goto-char beg) @@ -1879,10 +1951,7 @@ Content-Transfer-Encoding: 7bit (insert (format "Content-Transfer-Encoding: %s\n" encoding)) ) (insert "\n") - (or (as-binary-process - (funcall (pgp-function 'encrypt) - recipients beg (point-max) nil 'maybe) - ) + (or (pgg-encrypt-region beg (point-max) recipients) (throw 'mime-edit-error 'pgp-error) ) (goto-char beg) @@ -1891,6 +1960,78 @@ Content-Transfer-Encoding: 7bit )) ))) +(defun mime-edit-sign-smime (beg end boundary) + (save-excursion + (save-restriction + (let* ((ret (progn + (narrow-to-region beg end) + (mime-edit-translate-region beg end boundary))) + (ctype (car ret)) + (encoding (nth 1 ret)) + (smime-boundary (concat "smime-sign-" boundary))) + (goto-char beg) + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + ) + (insert "\n") + (let (buffer-undo-list) + (goto-char (point-min)) + (while (progn (end-of-line) (not (eobp))) + (insert "\r") + (forward-line 1)) + (or (prog1 (smime-sign-region (point-min)(point-max)) + (push nil buffer-undo-list) + (ignore-errors (undo))) + (throw 'mime-edit-error 'pgp-error) + )) + (goto-char beg) + (insert (format "--[[multipart/signed; + boundary=\"%s\"; micalg=sha1; + protocol=\"application/pkcs7-signature\"][7bit]] +--%s +" smime-boundary smime-boundary)) + (goto-char (point-max)) + (insert (format "\n--%s +Content-Type: application/pkcs7-signature; name=\"smime.p7s\" +Content-Transfer-Encoding: base64 +Content-Disposition: attachment; filename=\"smime.p7s\" +Content-Description: S/MIME Cryptographic Signature + +" smime-boundary)) + (insert-buffer-substring smime-output-buffer) + (goto-char (point-max)) + (insert (format "\n--%s--\n" smime-boundary)) + )))) + +(defun mime-edit-encrypt-smime (beg end boundary) + (save-excursion + (save-restriction + (let* ((ret (progn + (narrow-to-region beg end) + (mime-edit-translate-region beg end boundary))) + (ctype (car ret)) + (encoding (nth 1 ret))) + (goto-char beg) + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + ) + (insert "\n") + (goto-char (point-min)) + (while (progn (end-of-line) (not (eobp))) + (insert "\r") + (forward-line 1)) + (or (smime-encrypt-region (point-min)(point-max)) + (throw 'mime-edit-error 'pgp-error) + ) + (delete-region (point-min)(point-max)) + (insert "--[[application/pkcs7-mime; name=\"smime.p7m\" +Content-Disposition: attachment; filename=\"smime.p7m\" +Content-Description: S/MIME Encrypted Message][base64]]\n") + (insert-buffer-substring smime-output-buffer) + )))) + (defsubst replace-space-with-underline (str) (mapconcat (function (lambda (arg) @@ -2104,7 +2245,7 @@ Content-Transfer-Encoding: 7bit ;; (point) ;; 'hard t))) ;; End patch for hard newlines - (enriched-encode beg end) + (enriched-encode beg end nil) (goto-char beg) (if (search-forward "\n\n") (delete-region beg (match-end 0)) @@ -2308,13 +2449,25 @@ and insert data encoded as ENCODING." (mime-edit-enclose-region-internal 'kazu-encrypted beg end) ) +(defun mime-edit-enclose-smime-signed-region (beg end) + (interactive "*r") + (mime-edit-enclose-region-internal 'smime-signed beg end) + ) + +(defun mime-edit-enclose-smime-encrypted-region (beg end) + (interactive "*r") + (mime-edit-enclose-region-internal 'smime-encrypted beg end) + ) + (defun mime-edit-insert-key (&optional arg) "Insert a pgp public key." (interactive "P") (mime-edit-insert-tag "application" "pgp-keys") (mime-edit-define-encoding "7bit") - (funcall (pgp-function 'insert-key)) - ) + (pgg-insert-key) + (if (and (not (eobp)) + (not (looking-at mime-edit-single-part-tag-regexp))) + (insert (mime-make-text-tag) "\n"))) ;;; @ flag setting @@ -2373,12 +2526,14 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." )) (if arg (progn - (setq mime-edit-pgp-processing 'sign) + (or (memq 'sign mime-edit-pgp-processing) + (setq mime-edit-pgp-processing + (nconc mime-edit-pgp-processing + (copy-sequence '(sign))))) (message "This message will be signed.") ) - (if (eq mime-edit-pgp-processing 'sign) - (setq mime-edit-pgp-processing nil) - ) + (setq mime-edit-pgp-processing + (delq 'sign mime-edit-pgp-processing)) (message "This message will not be signed.") )) @@ -2389,12 +2544,14 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." )) (if arg (progn - (setq mime-edit-pgp-processing 'encrypt) + (or (memq 'encrypt mime-edit-pgp-processing) + (setq mime-edit-pgp-processing + (nconc mime-edit-pgp-processing + (copy-sequence '(encrypt))))) (message "This message will be encrypt.") ) - (if (eq mime-edit-pgp-processing 'encrypt) - (setq mime-edit-pgp-processing nil) - ) + (setq mime-edit-pgp-processing + (delq 'encrypt mime-edit-pgp-processing)) (message "This message will not be encrypt.") )) @@ -2404,15 +2561,18 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." (if (search-forward (concat "\n" mail-header-separator "\n")) (match-end 0) ))) - (end (point-max)) ) (if beg - (cond ((eq mime-edit-pgp-processing 'sign) - (mime-edit-enclose-pgp-signed-region beg end) - ) - ((eq mime-edit-pgp-processing 'encrypt) - (mime-edit-enclose-pgp-encrypted-region beg end) - )) + (dolist (pgp-processing mime-edit-pgp-processing) + (case pgp-processing + (sign + (mime-edit-enclose-pgp-signed-region + beg (point-max)) + ) + (encrypt + (mime-edit-enclose-pgp-encrypted-region + beg (point-max)) + ))) ))) @@ -2557,6 +2717,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (buf-name (buffer-name)) (temp-buf-name (concat "*temp-article:" buf-name "*")) (buf (get-buffer temp-buf-name)) + (pgp-processing mime-edit-pgp-processing) ) (if buf (progn @@ -2572,6 +2733,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (setq mail-header-separator separator) (make-local-variable 'mime-edit-buffer) (setq mime-edit-buffer the-buf) + (setq mime-edit-pgp-processing pgp-processing) (run-hooks 'mime-edit-translate-hook) (mime-edit-translate-buffer) @@ -2581,19 +2743,18 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (replace-match "") ) (mime-view-buffer) - )) + (make-local-variable 'mime-edit-temp-message-buffer) + (setq mime-edit-temp-message-buffer buf))) (defun mime-edit-quitting-method () "Quitting method for mime-view." - (let* ((entity (get-text-property (point-min) 'mime-view-entity)) - (temp (mime-entity-buffer entity)) + (let* ((temp mime-edit-temp-message-buffer) buf) (mime-preview-kill-buffer) (set-buffer temp) (setq buf mime-edit-buffer) (kill-buffer temp) - (switch-to-buffer buf) - )) + (switch-to-buffer buf))) (set-alist 'mime-preview-quitting-method-alist 'mime-temp-message-mode @@ -2616,7 +2777,12 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" string)) (defun mime-edit-decode-multipart-in-buffer (content-type not-decode-text) - (let* ((subtype (mime-content-type-subtype content-type)) + (let* ((subtype + (or + (cdr (assoc (mime-content-type-parameter content-type "protocol") + '(("application/pgp-encrypted" . pgp-encrypted) + ("application/pgp-signature" . pgp-signed)))) + (mime-content-type-subtype content-type))) (boundary (mime-content-type-parameter content-type "boundary")) (boundary-pat (concat "\n--" (regexp-quote boundary) "[ \t]*\n"))) (re-search-forward boundary-pat nil t) @@ -2644,13 +2810,36 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" ) (save-restriction (narrow-to-region beg end) - (mime-edit-decode-message-in-buffer - (if (eq subtype 'digest) - (eval-when-compile - (make-mime-content-type 'message 'rfc822)) - ) - not-decode-text) - (goto-char (point-max)) + (cond + ((eq subtype 'pgp-encrypted) + (when (and + (progn + (goto-char (point-min)) + (re-search-forward "^-+BEGIN PGP MESSAGE-+$" + nil t)) + (prog1 + (save-window-excursion + (pgg-decrypt-region (match-beginning 0) + (point-max))) + (delete-region (point-min)(point-max)))) + (insert-buffer-substring pgg-output-buffer) + (mime-edit-decode-message-in-buffer + nil not-decode-text) + (delete-region (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (match-end 0) + (point-min))) + (goto-char (point-max)) + )) + (t + (mime-edit-decode-message-in-buffer + (if (eq subtype 'digest) + (eval-when-compile + (make-mime-content-type 'message 'rfc822)) + ) + not-decode-text) + (goto-char (point-max)) + )) )))) )) (goto-char (point-min)) @@ -2662,7 +2851,8 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" ))) )) -(defun mime-edit-decode-single-part-in-buffer (content-type not-decode-text) +(defun mime-edit-decode-single-part-in-buffer + (content-type not-decode-text &optional content-disposition) (let* ((type (mime-content-type-primary-type content-type)) (subtype (mime-content-type-subtype content-type)) (ctype (format "%s/%s" type subtype)) @@ -2689,7 +2879,38 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" encoded (limit (save-excursion (if (search-forward "\n\n" nil t) - (1- (point)))))) + (1- (point))))) + (disposition-type + (mime-content-disposition-type content-disposition)) + (disposition-str + (if disposition-type + (let ((bytes (+ 21 (length (format "%s" disposition-type))))) + (mapconcat (function + (lambda (attr) + (let* ((str (concat + (car attr) + "=" + (if (string-equal "filename" + (car attr)) + (std11-wrap-as-quoted-string + (cdr attr)) + (cdr attr)))) + (bs (length str))) + (setq bytes (+ bytes bs 2)) + (if (< bytes 76) + (concat "; " str) + (setq bytes (+ bs 1)) + (concat ";\n " str) + ) + ))) + (mime-content-disposition-parameters + content-disposition) + "")))) + ) + (if disposition-type + (setq pstr (format "%s\nContent-Disposition: %s%s" + pstr disposition-type disposition-str)) + ) (save-excursion (if (re-search-forward "^Content-Transfer-Encoding:" limit t) @@ -2764,19 +2985,24 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (mime-edit-decode-multipart-in-buffer ctl not-decode-text) ) (t - (mime-edit-decode-single-part-in-buffer ctl not-decode-text) + (mime-edit-decode-single-part-in-buffer + ctl not-decode-text (mime-read-Content-Disposition)) ))) (or not-decode-text (decode-mime-charset-region (point-min) (point-max) default-mime-charset)) ) - (save-restriction - (std11-narrow-to-header) - (goto-char (point-min)) - (while (re-search-forward mime-edit-again-ignored-field-regexp nil t) - (delete-region (match-beginning 0) (1+ (std11-field-end))) - )) - (mime-decode-header-in-buffer (not not-decode-text)) + (if (= (point-min) 1) + (progn + (save-restriction + (std11-narrow-to-header) + (goto-char (point-min)) + (while (re-search-forward + mime-edit-again-ignored-field-regexp nil t) + (delete-region (match-beginning 0) (1+ (std11-field-end))) + )) + (mime-decode-header-in-buffer (not not-decode-text)) + )) ))) ;;;###autoload diff --git a/mime-image.el b/mime-image.el index d5e4aa0..76c2335 100644 --- a/mime-image.el +++ b/mime-image.el @@ -4,7 +4,9 @@ ;; Copyright (C) 1996 Dan Rich ;; Author: MORIOKA Tomohiko -;; Dan Rich +;; Dan Rich +;; Daiki Ueno +;; Katsumi Yamaoka ;; Maintainer: MORIOKA Tomohiko ;; Created: 1995/12/15 ;; Renamed: 1997/2/21 from tm-image.el @@ -34,102 +36,151 @@ ;;; Code: -(require 'mime-view) -(require 'alist) +(eval-when-compile (require 'cl)) -(cond ((featurep 'xemacs) - (require 'images) - - (defun-maybe image-inline-p (format) - (or (memq format image-native-formats) - (find-if (function - (lambda (native) - (image-converter-chain format native) - )) - image-native-formats) - )) - - (image-register-netpbm-utilities) - (image-register-converter 'pic 'ppm "pictoppm") - (image-register-converter 'mag 'ppm "magtoppm") - - (defun bitmap-insert-xbm-file (file) - (let ((gl (make-glyph (list (cons 'x file)))) - (e (make-extent (point) (point))) - ) - (set-extent-end-glyph e gl) - )) - - ;; - ;; X-Face - ;; - (autoload 'highlight-headers "highlight-headers") - - (defun mime-preview-x-face-function-use-highlight-headers () - (highlight-headers (point-min) (re-search-forward "^$" nil t) t) - ) - - (add-hook 'mime-display-header-hook - 'mime-preview-x-face-function-use-highlight-headers) - - ) - ((featurep 'mule) - ;; for MULE 2.* or mule merged EMACS - (require 'x-face-mule) - - (defvar image-native-formats '(xbm)) - - (defun-maybe image-inline-p (format) - (memq format image-native-formats) - ) - - (defun-maybe image-normalize (format data) - (and (eq format 'xbm) - (vector 'xbm ':data data) - )) - - ;; - ;; X-Face - ;; - (if (exec-installed-p uncompface-program exec-path) - (add-hook 'mime-display-header-hook - 'x-face-decode-message-header) - ) - )) - -(or (fboundp 'image-invalid-glyph-p) - (defsubst image-invalid-glyph-p (glyph) - (or (null (aref glyph 0)) - (null (aref glyph 2)) - (equal (aref glyph 2) "") - )) - ) - -(mapcar (function - (lambda (rule) - (let ((type (car rule)) - (subtype (nth 1 rule)) - (format (nth 2 rule))) - (if (image-inline-p format) - (ctree-set-calist-strictly - 'mime-preview-condition - (list (cons 'type type)(cons 'subtype subtype) - '(body . visible) - (cons 'body-presentation-method #'mime-display-image) - (cons 'image-format format)) - ))))) - '((image jpeg jpeg) - (image gif gif) - (image tiff tiff) - (image x-tiff tiff) - (image xbm xbm) - (image x-xbm xbm) - (image x-xpixmap xpm) - (image x-pic pic) - (image x-mag mag) - (image png png) - )) +(eval-when-compile (require 'static)) +(require 'mime-view) +(require 'alist) +(require 'path-util) + +(defsubst mime-image-normalize-xbm-buffer (buffer) + (save-excursion + (set-buffer buffer) + (let ((case-fold-search t) width height xbytes right margin) + (goto-char (point-min)) + (or (re-search-forward "_width[\t ]+\\([0-9]+\\)" nil t) + (error "!! Illegal xbm file format" (current-buffer))) + (setq width (string-to-int (match-string 1)) + xbytes (/ (+ width 7) 8)) + (goto-char (point-min)) + (or (re-search-forward "_height[\t ]+\\([0-9]+\\)" nil t) + (error "!! Illegal xbm file format" (current-buffer))) + (setq height (string-to-int (match-string 1))) + (goto-char (point-min)) + (re-search-forward "0x[0-9a-f][0-9a-f],") + (delete-region (point-min) (match-beginning 0)) + (goto-char (point-min)) + (while (re-search-forward "[\n\r\t ,;}]" nil t) + (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "0x" nil t) + (replace-match "\\x" nil t)) + (goto-char (point-min)) + (insert "(" (number-to-string width) " " + (number-to-string height) " \"") + (goto-char (point-max)) + (insert "\")") + (goto-char (point-min)) + (read (current-buffer))))) + +(static-if (featurep 'xemacs) + (progn + (defun mime-image-type-available-p (type) + (memq type (image-instantiator-format-list))) + + (defun mime-image-create (file-or-data &optional type data-p &rest props) + (when (and data-p (eq type 'xbm)) + (with-temp-buffer + (insert file-or-data) + (setq file-or-data + (mime-image-normalize-xbm-buffer (current-buffer))))) + (let ((glyph + (make-glyph + (if (and type (mime-image-type-available-p type)) + (vconcat + (list type (if data-p :data :file) file-or-data) + props) + file-or-data)))) + (if (nothing-image-instance-p (glyph-image-instance glyph)) nil + glyph))) + + (defun mime-image-insert (image &optional string area) + (let ((extent (make-extent (point) + (progn (and string + (insert string)) + (point))))) + (set-extent-property extent 'invisible t) + (set-extent-end-glyph extent image)))) + (condition-case nil + (progn + (require 'image) + (defalias 'mime-image-type-available-p 'image-type-available-p) + (defun mime-image-create + (file-or-data &optional type data-p &rest props) + (if (and data-p (eq type 'xbm)) + (with-temp-buffer + (insert file-or-data) + (setq file-or-data + (mime-image-normalize-xbm-buffer (current-buffer))) + (apply #'create-image (nth 2 file-or-data) type data-p + (nconc + (list :width (car file-or-data) + :height (nth 1 file-or-data)) + props))) + (apply #'create-image file-or-data type data-p props))) + (defalias 'mime-image-insert 'insert-image)) + (error + (condition-case nil + (progn + (require (if (featurep 'mule) 'bitmap "")) + (defun mime-image-read-xbm-buffer (buffer) + (condition-case nil + (mapconcat #'bitmap-compose + (append (bitmap-decode-xbm + (bitmap-read-xbm-buffer + (current-buffer))) nil) "\n") + (error nil))) + (defun mime-image-insert (image &optional string area) + (insert image))) + (error + (defalias 'mime-image-read-xbm-buffer + 'mime-image-normalize-xbm-buffer) + (defun mime-image-insert (image &optional string area) + (save-restriction + (narrow-to-region (point)(point)) + (let ((face (gensym "mii"))) + (or (facep face) (make-face face)) + (set-face-stipple face image) + (let ((row (make-string (/ (car image) (frame-char-width)) ? )) + (height (/ (nth 1 image) (frame-char-height))) + (i 0)) + (while (< i height) + (set-text-properties (point) (progn (insert row)(point)) + (list 'face face)) + (insert "\n") + (setq i (1+ i))))))))) + + (defun mime-image-type-available-p (type) + (eq type 'xbm)) + + (defun mime-image-create (file-or-data &optional type data-p &rest props) + (when (or (null type) (eq type 'xbm)) + (with-temp-buffer + (if data-p + (insert file-or-data) + (insert-file-contents file-or-data)) + (mime-image-read-xbm-buffer (current-buffer)))))))) + +(defvar mime-image-format-alist + '((image jpeg jpeg) + (image gif gif) + (image tiff tiff) + (image x-tiff tiff) + (image xbm xbm) + (image x-xbm xbm) + (image x-xpixmap xpm) + (image png png))) + +(dolist (rule mime-image-format-alist) + (when (mime-image-type-available-p (nth 2 rule)) + (ctree-set-calist-strictly + 'mime-preview-condition + (list (cons 'type (car rule))(cons 'subtype (nth 1 rule)) + '(body . visible) + (cons 'body-presentation-method #'mime-display-image) + (cons 'image-format (nth 2 rule)))))) + ;;; @ content filter for images ;;; @@ -137,37 +188,15 @@ (defun mime-display-image (entity situation) (message "Decoding image...") - (let ((gl (image-normalize (cdr (assq 'image-format situation)) - (mime-entity-content entity)))) - (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" temporary-file-directory)))) - (with-temp-buffer - (insert (aref gl 2)) - (write-region (point-min)(point-max) xbm-file) - ) - (message "Decoding image...") - (bitmap-insert-xbm-file xbm-file) - (delete-file xbm-file) - ) - (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") - ) - + (let ((format (cdr (assq 'image-format situation))) + image) + (setq image (mime-image-create (mime-entity-content entity) format 'data)) + (if (null image) + (message "Invalid glyph!") + (save-excursion + (mime-image-insert image) + (insert "\n") + (message "Decoding image... done"))))) ;;; @ end ;;; diff --git a/mime-pgp.el b/mime-pgp.el index fb76f45..718ad9e 100644 --- a/mime-pgp.el +++ b/mime-pgp.el @@ -1,8 +1,9 @@ ;;; mime-pgp.el --- mime-view internal methods for PGP. -;; Copyright (C) 1995,1996,1997,1998,1999 MORIOKA Tomohiko +;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko +;; Daiki Ueno ;; Created: 1995/12/7 ;; Renamed: 1997/2/27 from tm-pgp.el ;; Keywords: PGP, security, MIME, multimedia, mail, news @@ -41,9 +42,27 @@ ;; by Kazuhiko Yamamoto (1995/10; ;; expired) +;; [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME +;; Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO +;; (1998/1) + ;;; Code: (require 'mime-play) +(require 'pgg-def) + +(autoload 'pgg-decrypt-region "pgg" + "PGP decryption of current region." t) +(autoload 'pgg-verify-region "pgg" + "PGP verification of current region." t) +(autoload 'pgg-snarf-keys-region "pgg" + "Snarf PGP public keys in current region." t) +(autoload 'smime-decrypt-region "smime" + "S/MIME decryption of current region.") +(autoload 'smime-verify-region "smime" + "S/MIME verification of current region.") +(defvar smime-output-buffer) +(defvar smime-errors-buffer) ;;; @ Internal method for multipart/signed @@ -68,14 +87,15 @@ (new-name (format "%s-%s" (buffer-name) (mime-entity-number entity))) (mother (current-buffer)) - representation-type) - (set-buffer (get-buffer-create new-name)) + (preview-buffer (concat "*Preview-" (buffer-name) "*")) + representation-type message-buf) + (set-buffer (setq message-buf (get-buffer-create new-name))) (erase-buffer) (mime-insert-entity entity) (cond ((progn (goto-char (point-min)) (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)) - (funcall (pgp-function 'verify)) + (pgg-verify-region (match-beginning 0)(point-max) nil 'fetch) (goto-char (point-min)) (delete-region (point-min) @@ -88,69 +108,29 @@ (point-max)) (goto-char (point-min)) (while (re-search-forward "^- -" nil t) - (replace-match "-") - ) + (replace-match "-")) (setq representation-type (if (mime-entity-cooked-p entity) - 'cooked)) - ) + 'cooked))) ((progn (goto-char (point-min)) (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)) - (as-binary-process (funcall (pgp-function 'decrypt))) - (goto-char (point-min)) - (delete-region (point-min) - (and - (search-forward "\n\n") - (match-end 0))) - (setq representation-type 'binary) - )) + (pgg-decrypt-region (point-min)(point-max)) + (delete-region (point-min)(point-max)) + (insert-buffer pgg-output-buffer) + (setq representation-type 'binary))) (setq major-mode 'mime-show-message-mode) - (save-window-excursion (mime-view-buffer nil nil mother - nil representation-type)) - (set-window-buffer p-win mime-preview-buffer) - )) + (save-window-excursion + (mime-view-buffer nil preview-buffer mother + nil representation-type) + (make-local-variable 'mime-view-temp-message-buffer) + (setq mime-view-temp-message-buffer message-buf)) + (set-window-buffer p-win preview-buffer))) ;;; @ Internal method for application/pgp-signature ;;; -;;; It is based on RFC 2015 (PGP/MIME). - -(defvar mime-pgp-command "pgp" - "*Name of the PGP command.") - -(defvar mime-pgp-default-language 'en - "*Symbol of language for pgp. -It should be ISO 639 2 letter language code such as en, ja, ...") - -(defvar mime-pgp-good-signature-regexp-alist - '((en . "Good signature from user.*$")) - "Alist of language vs regexp to detect ``Good signature''.") - -(defvar mime-pgp-key-expected-regexp-alist - '((en . "Key matching expected Key ID \\(\\S +\\) not found")) - "Alist of language vs regexp to detect ``Key expected''.") - -(defun mime-pgp-check-signature (output-buffer sig-file orig-file) - (save-excursion - (set-buffer output-buffer) - (erase-buffer)) - (let* ((lang (or mime-pgp-default-language 'en)) - (status (call-process-region (point-min)(point-max) - mime-pgp-command - nil output-buffer nil - sig-file orig-file (format "+language=%s" lang))) - (regexp (cdr (assq lang mime-pgp-good-signature-regexp-alist)))) - (if (= status 0) - (save-excursion - (set-buffer output-buffer) - (goto-char (point-min)) - (message - (cond ((not (stringp regexp)) - "Please specify right regexp for specified language") - ((re-search-forward regexp nil t) - (buffer-substring (match-beginning 0) (match-end 0))) - (t "Bad signature"))) - )))) +;;; It is based on RFC 2015 (PGP/MIME) and +;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME). (defun mime-verify-application/pgp-signature (entity situation) "Internal method to check PGP/MIME signature." @@ -162,49 +142,35 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (1+ knum))) (orig-entity (nth onum (mime-entity-children mother))) (basename (expand-file-name "tm" temporary-file-directory)) - (orig-file (make-temp-name basename)) - (sig-file (concat orig-file ".sig")) - ) - (mime-write-entity orig-entity orig-file) - (save-excursion (mime-show-echo-buffer)) + (sig-file (concat (make-temp-name basename) ".asc")) + status) + (save-excursion + (mime-show-echo-buffer) + (set-buffer mime-echo-buffer-name) + (set-window-start + (get-buffer-window mime-echo-buffer-name) + (point-max))) (mime-write-entity-content entity sig-file) - (or (mime-pgp-check-signature mime-echo-buffer-name sig-file orig-file) - (let (pgp-id) - (save-excursion + (unwind-protect + (with-temp-buffer + (mime-insert-entity orig-entity) + (goto-char (point-min)) + (while (progn (end-of-line) (not (eobp))) + (insert "\r") + (forward-line 1)) + (setq status (pgg-verify-region (point-min)(point-max) + sig-file 'fetch)) + (save-excursion (set-buffer mime-echo-buffer-name) - (goto-char (point-min)) - (let ((regexp (cdr (assq (or mime-pgp-default-language 'en) - mime-pgp-key-expected-regexp-alist)))) - (cond ((not (stringp regexp)) - (message - "Please specify right regexp for specified language") - ) - ((re-search-forward regexp nil t) - (setq pgp-id - (concat "0x" (buffer-substring-no-properties - (match-beginning 1) - (match-end 1)))) - )))) - (if (and pgp-id - (y-or-n-p - (format "Key %s not found; attempt to fetch? " pgp-id)) - ) - (progn - (funcall (pgp-function 'fetch-key) (cons nil pgp-id)) - (mime-pgp-check-signature mime-echo-buffer-name orig-file) - )) - )) - (let ((other-window-scroll-buffer mime-echo-buffer-name)) - (scroll-other-window 8) - ) - (delete-file orig-file) - (delete-file sig-file) - )) + (insert-buffer-substring (if status pgg-output-buffer + pgg-errors-buffer)))) + (delete-file sig-file)))) ;;; @ Internal method for application/pgp-encrypted ;;; -;;; It is based on RFC 2015 (PGP/MIME). +;;; It is based on RFC 2015 (PGP/MIME) and +;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME). (defun mime-decrypt-application/pgp-encrypted (entity situation) (let* ((entity-node-id (mime-entity-node-id entity)) @@ -214,36 +180,102 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (1- knum) (1+ knum))) (orig-entity (nth onum (mime-entity-children mother)))) - (mime-view-application/pgp orig-entity situation) - )) + (mime-view-application/pgp orig-entity situation))) ;;; @ Internal method for application/pgp-keys ;;; -;;; It is based on RFC 2015 (PGP/MIME). +;;; It is based on RFC 2015 (PGP/MIME) and +;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME). (defun mime-add-application/pgp-keys (entity situation) - (let* ((start (mime-entity-point-min entity)) - (end (mime-entity-point-max entity)) - (entity-number (mime-entity-number entity)) - (new-name (format "%s-%s" (buffer-name) entity-number)) - (encoding (cdr (assq 'encoding situation))) - str) - (setq str (buffer-substring start end)) - (switch-to-buffer new-name) - (setq buffer-read-only nil) - (erase-buffer) - (insert str) - (goto-char (point-min)) - (if (re-search-forward "^\n" nil t) - (delete-region (point-min) (match-end 0)) - ) - (mime-decode-region (point-min)(point-max) encoding) - (funcall (pgp-function 'snarf-keys)) - (kill-buffer (current-buffer)) - )) - - + (save-excursion + (mime-show-echo-buffer) + (set-buffer mime-echo-buffer-name) + (set-window-start + (get-buffer-window mime-echo-buffer-name) + (point-max))) + (with-temp-buffer + (mime-insert-entity-content entity) + (mime-decode-region (point-min) (point-max) + (cdr (assq 'encoding situation))) + (let ((status (pgg-snarf-keys-region (point-min)(point-max)))) + (save-excursion + (set-buffer mime-echo-buffer-name) + (insert-buffer-substring (if status pgg-output-buffer + pgg-errors-buffer)))))) + + +;;; @ Internal method for application/pkcs7-signature +;;; +;;; It is based on RFC 2633 (S/MIME version 3). + +(defun mime-verify-application/pkcs7-signature (entity situation) + "Internal method to check S/MIME signature." + (let* ((entity-node-id (mime-entity-node-id entity)) + (mother (mime-entity-parent entity)) + (knum (car entity-node-id)) + (onum (if (> knum 0) + (1- knum) + (1+ knum))) + (orig-entity (nth onum (mime-entity-children mother))) + (basename (expand-file-name "tm" temporary-file-directory)) + (sig-file (concat (make-temp-name basename) ".asc")) + status) + (save-excursion + (mime-show-echo-buffer) + (set-buffer mime-echo-buffer-name) + (set-window-start + (get-buffer-window mime-echo-buffer-name) + (point-max))) + (mime-write-entity entity sig-file) + (unwind-protect + (with-temp-buffer + (mime-insert-entity orig-entity) + (goto-char (point-min)) + (while (progn (end-of-line) (not (eobp))) + (insert "\r") + (forward-line 1)) + (setq status (smime-verify-region (point-min)(point-max) + sig-file)) + (save-excursion + (set-buffer mime-echo-buffer-name) + (insert-buffer-substring (if status smime-output-buffer + smime-errors-buffer)))) + (delete-file sig-file)))) + + +;;; @ Internal method for application/pkcs7-mime +;;; +;;; It is based on RFC 2633 (S/MIME version 3). + +(defun mime-view-application/pkcs7-mime (entity situation) + (let* ((p-win (or (get-buffer-window (current-buffer)) + (get-largest-window))) + (new-name + (format "%s-%s" (buffer-name) (mime-entity-number entity))) + (mother (current-buffer)) + (preview-buffer (concat "*Preview-" (buffer-name) "*")) + message-buf) + (when (memq (or (cdr (assq 'smime-type situation)) 'enveloped-data) + '(enveloped-data signed-data)) + (set-buffer (setq message-buf (get-buffer-create new-name))) + (let ((inhibit-read-only t) + buffer-read-only) + (erase-buffer) + (mime-insert-entity entity) + (smime-decrypt-region (point-min)(point-max)) + (delete-region (point-min)(point-max)) + (insert-buffer smime-output-buffer)) + (setq major-mode 'mime-show-message-mode) + (save-window-excursion + (mime-view-buffer nil preview-buffer mother + nil 'binary) + (make-local-variable 'mime-view-temp-message-buffer) + (setq mime-view-temp-message-buffer message-buf)) + (set-window-buffer p-win preview-buffer)))) + + ;;; @ end ;;; diff --git a/mime-play.el b/mime-play.el index b98ccea..1b1b869 100644 --- a/mime-play.el +++ b/mime-play.el @@ -1,8 +1,8 @@ ;;; mime-play.el --- Playback processing module for mime-view.el -;; Copyright (C) 1994,1995,1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Created: 1995/9/26 (separated from tm-view.el) ;; Renamed: 1997/2/21 from tm-play.el ;; Keywords: MIME, multimedia, mail, news @@ -43,113 +43,8 @@ If t, it means current directory." :type '(choice (const :tag "Current directory" t) (directory))) -(defvar mime-acting-situation-example-list nil) - -(defvar mime-acting-situation-example-list-max-size 16) - -(defun mime-save-acting-situation-examples () - (let* ((file mime-acting-situation-examples-file) - (buffer (get-buffer-create " *mime-example*"))) - (unwind-protect - (save-excursion - (set-buffer buffer) - (setq buffer-file-name file) - (erase-buffer) - (insert ";;; " (file-name-nondirectory file) "\n") - (insert "\n;; This file is generated automatically by " - mime-view-version "\n\n") - (insert ";;; Code:\n\n") - (pp `(setq mime-acting-situation-example-list - ',mime-acting-situation-example-list) - (current-buffer)) - (insert "\n;;; " - (file-name-nondirectory file) - " ends here.\n") - (save-buffer)) - (kill-buffer buffer)))) - -(add-hook 'kill-emacs-hook 'mime-save-acting-situation-examples) - -(defun mime-reduce-acting-situation-examples () - (let ((len (length mime-acting-situation-example-list)) - i ir ic j jr jc ret - dest d-i d-j - (max-sim 0) sim - min-det-ret det-ret - min-det-org det-org - min-freq freq) - (setq i 0 - ir mime-acting-situation-example-list) - (while (< i len) - (setq ic (car ir) - j 0 - jr mime-acting-situation-example-list) - (while (< j len) - (unless (= i j) - (setq jc (car jr)) - (setq ret (mime-compare-situation-with-example (car ic)(car jc)) - sim (car ret) - det-ret (+ (length (car ic))(length (car jc))) - det-org (length (cdr ret)) - freq (+ (cdr ic)(cdr jc))) - (cond ((< max-sim sim) - (setq max-sim sim - min-det-ret det-ret - min-det-org det-org - min-freq freq - d-i i - d-j j - dest (cons (cdr ret) freq)) - ) - ((= max-sim sim) - (cond ((> min-det-ret det-ret) - (setq min-det-ret det-ret - min-det-org det-org - min-freq freq - d-i i - d-j j - dest (cons (cdr ret) freq)) - ) - ((= min-det-ret det-ret) - (cond ((> min-det-org det-org) - (setq min-det-org det-org - min-freq freq - d-i i - d-j j - dest (cons (cdr ret) freq)) - ) - ((= min-det-org det-org) - (cond ((> min-freq freq) - (setq min-freq freq - d-i i - d-j j - dest (cons (cdr ret) freq)) - )) - )) - )) - )) - ) - (setq jr (cdr jr) - j (1+ j))) - (setq ir (cdr ir) - i (1+ i))) - (if (> d-i d-j) - (setq i d-i - d-i d-j - d-j i)) - (setq jr (nthcdr (1- d-j) mime-acting-situation-example-list)) - (setcdr jr (cddr jr)) - (if (= d-i 0) - (setq mime-acting-situation-example-list - (cdr mime-acting-situation-example-list)) - (setq ir (nthcdr (1- d-i) mime-acting-situation-example-list)) - (setcdr ir (cddr ir)) - ) - (if (setq ir (assoc (car dest) mime-acting-situation-example-list)) - (setcdr ir (+ (cdr ir)(cdr dest))) - (setq mime-acting-situation-example-list - (cons dest mime-acting-situation-example-list)) - ))) +(defvar mime-play-find-every-situations t + "*Find every available situations if non-nil.") ;;; @ content decoder @@ -182,136 +77,21 @@ If MODE is specified, play as it. Default MODE is \"play\"." (mime-play-entity entity situation) )))) -(defun mime-sort-situation (situation) - (sort situation - #'(lambda (a b) - (let ((a-t (car a)) - (b-t (car b)) - (order '((type . 1) - (subtype . 2) - (mode . 3) - (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 7) - )) - (setq a-order 8) - ) - (if (symbolp b-t) - (let ((ret (assq b-t order))) - (if ret - (setq b-order (cdr ret)) - (setq b-order 7) - )) - (setq b-order 8) - ) - (if (= a-order b-order) - (string< (format "%s" a-t)(format "%s" b-t)) - (< a-order b-order)) - ))) - ) - -(defsubst mime-delq-null-situation (situations field - &optional ignored-value) - (let (dest) - (while situations - (let* ((situation (car situations)) - (cell (assq field situation))) - (if cell - (or (eq (cdr cell) ignored-value) - (setq dest (cons situation dest)) - ))) - (setq situations (cdr situations))) - dest)) - -(defun mime-compare-situation-with-example (situation example) - (let ((example (copy-alist example)) - (match 0)) - (while situation - (let* ((cell (car situation)) - (key (car cell)) - (ecell (assoc key example))) - (when ecell - (if (equal cell ecell) - (setq match (1+ match)) - (setq example (delq ecell example)) - )) - ) - (setq situation (cdr situation)) - ) - (cons match example) - )) - ;;;###autoload (defun mime-play-entity (entity &optional situation ignored-method) "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 (method ret) - (in-calist-package 'mime-view) - (setq ret - (mime-delq-null-situation - (ctree-find-calist mime-acting-condition - (mime-entity-situation entity situation) - mime-view-find-every-acting-situation) - 'method ignored-method)) - (or (assq 'ignore-examples situation) - (if (cdr ret) - (let ((rest ret) - (max-score 0) - (max-escore 0) - max-examples - max-situations) - (while rest - (let ((situation (car rest)) - (examples mime-acting-situation-example-list)) - (while examples - (let* ((ret - (mime-compare-situation-with-example - situation (caar examples))) - (ret-score (car ret))) - (cond ((> ret-score max-score) - (setq max-score ret-score - max-escore (cdar examples) - max-examples (list (cdr ret)) - max-situations (list situation)) - ) - ((= ret-score max-score) - (cond ((> (cdar examples) max-escore) - (setq max-escore (cdar examples) - max-examples (list (cdr ret)) - max-situations (list situation)) - ) - ((= (cdar examples) max-escore) - (setq max-examples - (cons (cdr ret) max-examples)) - (or (member situation max-situations) - (setq max-situations - (cons situation max-situations))) - ))))) - (setq examples (cdr examples)))) - (setq rest (cdr rest))) - (when max-situations - (setq ret max-situations) - (while max-examples - (let* ((example (car max-examples)) - (cell - (assoc example mime-acting-situation-example-list))) - (if cell - (setcdr cell (1+ (cdr cell))) - (setq mime-acting-situation-example-list - (cons (cons example 0) - mime-acting-situation-example-list)) - )) - (setq max-examples (cdr max-examples)) - ))))) + (let ((ret + (mime-unify-situations (mime-entity-situation entity situation) + mime-acting-condition + mime-acting-situation-example-list + 'method ignored-method + mime-play-find-every-situations)) + method) + (setq mime-acting-situation-example-list (cdr ret) + ret (car ret)) (cond ((cdr ret) (setq ret (select-menu-alist "Methods" @@ -368,7 +148,7 @@ specified, play as it. Default MODE is \"play\"." (message "External method is starting...") (let ((process (let ((command - (mailcap-format-command + (mime-format-mailcap-command method (cons (cons 'filename name) situation)))) (start-process command mime-echo-buffer-name @@ -535,15 +315,14 @@ SUBTYPE is symbol to indicate subtype of media-type.") (defun mime-preview-quitting-method-for-mime-show-message-mode () "Quitting method for mime-view. It is registered to variable `mime-preview-quitting-method-alist'." - (let ((raw-buffer (mime-entity-buffer - (get-text-property (point-min) 'mime-view-entity))) - (mother mime-mother-buffer) + (let ((mother mime-mother-buffer) (win-conf mime-preview-original-window-configuration)) - (kill-buffer raw-buffer) + (if (and (boundp 'mime-view-temp-message-buffer) + (buffer-live-p mime-view-temp-message-buffer)) + (kill-buffer mime-view-temp-message-buffer)) (mime-preview-kill-buffer) (set-window-configuration win-conf) - (pop-to-buffer mother) - )) + (pop-to-buffer mother))) (defun mime-view-message/rfc822 (entity situation) (let* ((new-name @@ -590,14 +369,14 @@ It is registered to variable `mime-preview-quitting-method-alist'." (save-window-excursion (set-buffer full-buf) (erase-buffer) - (as-binary-input-file (insert-file-contents file)) + (insert-file-contents-as-binary file) (setq major-mode 'mime-show-message-mode) (mime-view-buffer (current-buffer) nil mother) (setq pbuf (current-buffer)) - ) + (make-local-variable 'mime-view-temp-message-buffer) + (setq mime-view-temp-message-buffer full-buf)) (set-window-buffer pwin pbuf) - (select-window pwin) - ) + (select-window pwin)) (setq file (concat root-dir "/" number)) (mime-write-entity-body entity file) (let ((total-file (concat root-dir "/CT"))) @@ -645,9 +424,8 @@ It is registered to variable `mime-preview-quitting-method-alist'." (goto-char (point-max)) (setq i (1+ i)) )) - (as-binary-output-file - (write-region (point-min)(point-max) - (expand-file-name "FULL" root-dir))) + (write-region-as-binary (point-min)(point-max) + (expand-file-name "FULL" root-dir)) (let ((i 1)) (while (<= i total) (let ((file (format "%s/%d" root-dir i))) @@ -660,11 +438,15 @@ It is registered to variable `mime-preview-quitting-method-alist'." (and (file-exists-p file) (delete-file file) )) - (let ((pwin (or (get-buffer-window mother) + (let ((buf (current-buffer)) + (pwin (or (get-buffer-window mother) (get-largest-window))) (pbuf (mime-display-message (mime-open-entity 'buffer (current-buffer)) nil mother nil 'mime-show-message-mode))) + (with-current-buffer pbuf + (make-local-variable 'mime-view-temp-message-buffer) + (setq mime-view-temp-message-buffer buf)) (set-window-buffer pwin pbuf) (select-window pwin) ))))) @@ -734,26 +516,4 @@ It is registered to variable `mime-preview-quitting-method-alist'." (provide 'mime-play) -(let* ((file mime-acting-situation-examples-file) - (buffer (get-buffer-create " *mime-example*"))) - (if (file-readable-p file) - (unwind-protect - (save-excursion - (set-buffer buffer) - (erase-buffer) - (insert-file-contents file) - (eval-buffer) - ;; format check - (condition-case nil - (let ((i 0)) - (while (and (> (length mime-acting-situation-example-list) - mime-acting-situation-example-list-max-size) - (< i 16)) - (mime-reduce-acting-situation-examples) - (setq i (1+ i)) - )) - (error (setq mime-acting-situation-example-list nil))) - ) - (kill-buffer buffer)))) - ;;; mime-play.el ends here diff --git a/mime-ui-en.sgml b/mime-ui-en.sgml index 58bfb8a..d848ab7 100644 --- a/mime-ui-en.sgml +++ b/mime-ui-en.sgml @@ -370,7 +370,7 @@ Insert signature. C-c C-x C-k -Insert PGP public key. (It requires Mailcrypt package.) +Insert PGP public key. C-c C-x t @@ -609,29 +609,21 @@ mime-edit provides PGP encryption, signature and inserting public-key features based on PGP/MIME (RFC 2015) or PGP-kazu (draft-kazu-pgp-mime-00.txt).

-This feature requires pgp command and pgp interface package, such as -Mailcrypt package. +This feature requires your pgp command. - +

-Alist of service names vs. corresponding functions and its filenames. -Each element looks like (SERVICE FUNCTION FILE). -

-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt', -`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt' -or `insert-key'. -

-Function is a symbol of function to do specified SERVICE. -

-FILE is string of filename which has definition of corresponding -FUNCTION. +Version of PGP or GnuPG command to be used for encryption or sign. +The value should be a symbol. Allowed versions are gpg, +pgp or pgp5. - - method +

-Return function to do service method. - +Version of PGP or GnuPG command to be used for decryption or verification. +The value should be a symbol. Allowed versions are gpg, +pgp or pgp5. +

Mouse button diff --git a/mime-ui-en.texi b/mime-ui-en.texi index 9866ed1..d60b99e 100644 --- a/mime-ui-en.texi +++ b/mime-ui-en.texi @@ -681,29 +681,22 @@ mime-edit provides PGP encryption, signature and inserting public-key features based on @strong{PGP/MIME} (RFC 2015) or @strong{PGP-kazu} (draft-kazu-pgp-mime-00.txt).@refill -This feature requires pgp command and pgp interface package, such as -Mailcrypt package (@ref{(mailcrypt)}). +This feature requires your pgp command. -@defvar pgp-function-alist +@defvar pgg-default-scheme -Alist of service names vs. corresponding functions and its filenames. -Each element looks like @code{(SERVICE FUNCTION FILE)}.@refill - -SERVICE is a symbol of PGP processing. It allows `verify', `decrypt', -`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt' or -`insert-key'.@refill - -Function is a symbol of function to do specified SERVICE.@refill - -FILE is string of filename which has definition of corresponding -FUNCTION. +Version of PGP or GnuPG command to be used for encryption or sign. +The value should be a symbol. Allowed versions are @code{gpg}, +@code{pgp} or @code{pgp5}.@refill @end defvar -@defun pgp-function method +@defvar pgg-scheme -Return function to do service @var{method}. -@end defun +Version of PGP or GnuPG command to be used for decryption or verification. +The value should be a symbol. Allowed versions are @code{gpg}, +@code{pgp} or @code{pgp5}.@refill +@end defvar diff --git a/mime-ui-ja.sgml b/mime-ui-ja.sgml index a85caac..ef1c2be 100644 --- a/mime-ui-ja.sgml +++ b/mime-ui-ja.sgml @@ -624,29 +624,21 @@ mime-edit $B$G$O(B PGP/MIME (RFC 2015) $B$*$h$S(B PGP-kazu (draft-kazu-pgp-mime-00.txt) $B$K$h$k0E9f2=!&(B $BEE;R=pL>!&8x3+80$NA^F~5!G=$rMxMQ$9$k$3$H$,$G$-$^$9!#(B

-$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O(B Mailcrypt package -$B$H(B pgp command $B$,I,MW$G$9!#(B +$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F +

-Alist of service names vs. corresponding functions and its filenames. -Each element looks like (SERVICE FUNCTION FILE). -

-SERVICE is a symbol of PGP processing. It allows `verify', `decrypt', -`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt' -or `insert-key'. -

-Function is a symbol of function to do specified SERVICE. -

-FILE is string of filename which has definition of corresponding -FUNCTION. +Version of PGP or GnuPG command to be used for encryption or sign. +The value should be a symbol. Allowed versions are gpg, +pgp or pgp5. - - method +

-Return function to do service method. - +Version of PGP or GnuPG command to be used for decryption or verification. +The value should be a symbol. Allowed versions are gpg, +pgp or pgp5. +

$B2!KU(B diff --git a/mime-ui-ja.texi b/mime-ui-ja.texi index 28e62b3..736ce4e 100644 --- a/mime-ui-ja.texi +++ b/mime-ui-ja.texi @@ -698,29 +698,22 @@ mime-edit $B$G$O(B @strong{PGP/MIME} (RFC 2015) $B$*$h$S(B@strong{PGP-kazu} (draft-kazu-pgp-mime-00.txt) $B$K$h$k0E9f2=!&EE;R=pL>!&8x3+80$NA^F~5!G=$r(B $BMxMQ$9$k$3$H$,$G$-$^$9!#(B@refill -$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O(B Mailcrypt package (@ref{(mailcrypt)}) $B$H(B -pgp command $B$,I,MW$G$9!#(B +$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F +;; Author: MORIOKA Tomohiko ;; Created: 1994/07/13 ;; Renamed: 1994/08/31 from tm-body.el ;; Renamed: 1997/02/19 from tm-view.el @@ -32,7 +32,7 @@ (require 'semi-def) (require 'calist) (require 'alist) -(require 'mailcap) +(require 'mime-conf) ;;; @ version @@ -52,13 +52,8 @@ "MIME view mode" :group 'mime) -(defcustom mime-view-find-every-acting-situation t - "*Find every available acting-situation if non-nil." - :group 'mime-view - :type 'boolean) - -(defcustom mime-acting-situation-examples-file "~/.mime-example" - "*File name of example about acting-situation demonstrated by user." +(defcustom mime-situation-examples-file "~/.mime-example" + "*File name of situation-examples demonstrated by user." :group 'mime-view :type 'file) @@ -72,6 +67,7 @@ buttom. Nil means don't scroll at all." (const :tag "On" t) (sexp :tag "Situation" 1))) + ;;; @ in raw-buffer (representation space) ;;; @@ -91,27 +87,6 @@ major-mode or t. t means default. REPRESENTATION-TYPE must be `binary' or `cooked'.") -;; (defun mime-raw-find-entity-from-point (point &optional message-info) -;; "Return entity from POINT in mime-raw-buffer. -;; If optional argument MESSAGE-INFO is not specified, -;; `mime-message-structure' is used." -;; (or message-info -;; (setq message-info mime-message-structure)) -;; (if (and (<= (mime-entity-point-min message-info) point) -;; (<= point (mime-entity-point-max message-info))) -;; (let ((children (mime-entity-children message-info))) -;; (catch 'tag -;; (while children -;; (let ((ret -;; (mime-raw-find-entity-from-point point (car children)))) -;; (if ret -;; (throw 'tag ret) -;; )) -;; (setq children (cdr children))) -;; message-info)))) -;; (make-obsolete 'mime-raw-find-entity-from-point "don't use it.") - - ;;; @ in preview-buffer (presentation space) ;;; @@ -224,41 +199,282 @@ mother-buffer." situation)) +(defsubst mime-delq-null-situation (situations field + &rest ignored-values) + (let (dest) + (while situations + (let* ((situation (car situations)) + (cell (assq field situation))) + (if cell + (or (memq (cdr cell) ignored-values) + (setq dest (cons situation dest)) + ))) + (setq situations (cdr situations))) + dest)) + +(defun mime-compare-situation-with-example (situation example) + (let ((example (copy-alist example)) + (match 0)) + (while situation + (let* ((cell (car situation)) + (key (car cell)) + (ecell (assoc key example))) + (when ecell + (if (equal cell ecell) + (setq match (1+ match)) + (setq example (delq ecell example)) + )) + ) + (setq situation (cdr situation)) + ) + (cons match example) + )) + +(defun mime-sort-situation (situation) + (sort situation + #'(lambda (a b) + (let ((a-t (car a)) + (b-t (car b)) + (order '((type . 1) + (subtype . 2) + (mode . 3) + (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 7) + )) + (setq a-order 8) + ) + (if (symbolp b-t) + (let ((ret (assq b-t order))) + (if ret + (setq b-order (cdr ret)) + (setq b-order 7) + )) + (setq b-order 8) + ) + (if (= a-order b-order) + (string< (format "%s" a-t)(format "%s" b-t)) + (< a-order b-order)) + ))) + ) + +(defun mime-unify-situations (entity-situation + condition situation-examples + &optional required-name ignored-value + every-situations) + (let (ret) + (in-calist-package 'mime-view) + (setq ret + (ctree-find-calist condition entity-situation + every-situations)) + (if required-name + (setq ret (mime-delq-null-situation ret required-name + ignored-value t))) + (or (assq 'ignore-examples entity-situation) + (if (cdr ret) + (let ((rest ret) + (max-score 0) + (max-escore 0) + max-examples + max-situations) + (while rest + (let ((situation (car rest)) + (examples situation-examples)) + (while examples + (let* ((ret + (mime-compare-situation-with-example + situation (caar examples))) + (ret-score (car ret))) + (cond ((> ret-score max-score) + (setq max-score ret-score + max-escore (cdar examples) + max-examples (list (cdr ret)) + max-situations (list situation)) + ) + ((= ret-score max-score) + (cond ((> (cdar examples) max-escore) + (setq max-escore (cdar examples) + max-examples (list (cdr ret)) + max-situations (list situation)) + ) + ((= (cdar examples) max-escore) + (setq max-examples + (cons (cdr ret) max-examples)) + (or (member situation max-situations) + (setq max-situations + (cons situation max-situations))) + ))))) + (setq examples (cdr examples)))) + (setq rest (cdr rest))) + (when max-situations + (setq ret max-situations) + (while max-examples + (let* ((example (car max-examples)) + (cell + (assoc example situation-examples))) + (if cell + (setcdr cell (1+ (cdr cell))) + (setq situation-examples + (cons (cons example 0) + situation-examples)) + )) + (setq max-examples (cdr max-examples)) + ))))) + (cons ret situation-examples) + ;; ret: list of situations + ;; situation-examples: new examples (notoce that contents of + ;; argument `situation-examples' has bees modified) + )) + (defun mime-view-entity-title (entity) (or (mime-entity-read-field entity 'Content-Description) (mime-entity-read-field entity 'Subject) (mime-entity-filename entity) "")) - -;; (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, -;; `mime-message-structure' is used." -;; (mime-entity-node-id (mime-raw-find-entity-from-point point message-info))) - -;; (make-obsolete 'mime-raw-point-to-entity-node-id "don't use it.") - -;; (defsubst mime-raw-point-to-entity-number (point &optional message-info) -;; "Return entity-number from POINT in mime-raw-buffer. -;; If optional argument MESSAGE-INFO is not specified, -;; `mime-message-structure' is used." -;; (mime-entity-number (mime-raw-find-entity-from-point point message-info))) - -;; (make-obsolete 'mime-raw-point-to-entity-number "don't use it.") - -;; (defun mime-raw-flatten-message-info (&optional message-info) -;; "Return list of entity in mime-raw-buffer. -;; If optional argument MESSAGE-INFO is not specified, -;; `mime-message-structure' is used." -;; (or message-info -;; (setq message-info mime-message-structure)) -;; (let ((dest (list message-info)) -;; (rcl (mime-entity-children message-info))) -;; (while rcl -;; (setq dest (nconc dest (mime-raw-flatten-message-info (car rcl)))) -;; (setq rcl (cdr rcl))) -;; dest)) +(defvar mime-preview-situation-example-list nil) +(defvar mime-preview-situation-example-list-max-size 16) +;; (defvar mime-preview-situation-example-condition nil) + +(defun mime-find-entity-preview-situation (entity + &optional default-situation) + (or (let ((ret + (mime-unify-situations + (append (mime-entity-situation entity) + default-situation) + mime-preview-condition + mime-preview-situation-example-list))) + (setq mime-preview-situation-example-list + (cdr ret)) + (caar ret)) + default-situation)) + + +(defvar mime-acting-situation-example-list nil) +(defvar mime-acting-situation-example-list-max-size 16) +(defvar mime-situation-examples-file-coding-system nil) + +(defun mime-save-situation-examples () + (if (or mime-preview-situation-example-list + mime-acting-situation-example-list) + (let ((file mime-situation-examples-file)) + (with-temp-buffer + (insert ";;; " (file-name-nondirectory file) "\n") + (insert "\n;; This file is generated automatically by " + mime-view-version "\n\n") + (insert ";;; Code:\n\n") + (if mime-preview-situation-example-list + (pp `(setq mime-preview-situation-example-list + ',mime-preview-situation-example-list) + (current-buffer))) + (if mime-acting-situation-example-list + (pp `(setq mime-acting-situation-example-list + ',mime-acting-situation-example-list) + (current-buffer))) + (insert "\n;;; " + (file-name-nondirectory file) + " ends here.\n") + (static-cond + ((boundp 'buffer-file-coding-system) + (setq buffer-file-coding-system + mime-situation-examples-file-coding-system)) + ((boundp 'file-coding-system) + (setq file-coding-system + mime-situation-examples-file-coding-system))) + (setq buffer-file-name file) + (save-buffer))))) + +(add-hook 'kill-emacs-hook 'mime-save-situation-examples) + +(defun mime-reduce-situation-examples (situation-examples) + (let ((len (length situation-examples)) + i ir ic j jr jc ret + dest d-i d-j + (max-sim 0) sim + min-det-ret det-ret + min-det-org det-org + min-freq freq) + (setq i 0 + ir situation-examples) + (while (< i len) + (setq ic (car ir) + j 0 + jr situation-examples) + (while (< j len) + (unless (= i j) + (setq jc (car jr)) + (setq ret (mime-compare-situation-with-example (car ic)(car jc)) + sim (car ret) + det-ret (+ (length (car ic))(length (car jc))) + det-org (length (cdr ret)) + freq (+ (cdr ic)(cdr jc))) + (cond ((< max-sim sim) + (setq max-sim sim + min-det-ret det-ret + min-det-org det-org + min-freq freq + d-i i + d-j j + dest (cons (cdr ret) freq)) + ) + ((= max-sim sim) + (cond ((> min-det-ret det-ret) + (setq min-det-ret det-ret + min-det-org det-org + min-freq freq + d-i i + d-j j + dest (cons (cdr ret) freq)) + ) + ((= min-det-ret det-ret) + (cond ((> min-det-org det-org) + (setq min-det-org det-org + min-freq freq + d-i i + d-j j + dest (cons (cdr ret) freq)) + ) + ((= min-det-org det-org) + (cond ((> min-freq freq) + (setq min-freq freq + d-i i + d-j j + dest (cons (cdr ret) freq)) + )) + )) + )) + )) + ) + (setq jr (cdr jr) + j (1+ j))) + (setq ir (cdr ir) + i (1+ i))) + (if (> d-i d-j) + (setq i d-i + d-i d-j + d-j i)) + (setq jr (nthcdr (1- d-j) situation-examples)) + (setcdr jr (cddr jr)) + (if (= d-i 0) + (setq situation-examples + (cdr situation-examples)) + (setq ir (nthcdr (1- d-i) situation-examples)) + (setcdr ir (cddr ir)) + ) + (if (setq ir (assoc (car dest) situation-examples)) + (progn + (setcdr ir (+ (cdr ir)(cdr dest))) + situation-examples) + (cons dest situation-examples) + ;; situation-examples may be modified. + ))) ;;; @ presentation of preview @@ -270,21 +486,21 @@ mother-buffer." ;;; @@@ predicate function ;;; -(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)) - (media-subtype (mime-entity-media-subtype entity))) - (or (not (eq media-type 'application)) - (and (not (eq media-subtype 'x-selection)) - (or (not (eq media-subtype 'octet-stream)) - (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) - 'encrypted))) - ) - ))))) +;; (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)) +;; (media-subtype (mime-entity-media-subtype entity))) +;; (or (not (eq media-type 'application)) +;; (and (not (eq media-subtype 'x-selection)) +;; (or (not (eq media-subtype 'octet-stream)) +;; (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) +;; 'encrypted))) +;; ) +;; ))))) ;;; @@@ entity button generator ;;; @@ -451,6 +667,8 @@ Each elements are regexp of field-name.") (body . visible) (body-presentation-method . mime-display-text/richtext))) +(autoload 'mime-display-application/x-postpet "postpet") + (ctree-set-calist-strictly 'mime-preview-condition '((type . application)(subtype . x-postpet) @@ -470,21 +688,32 @@ Each elements are regexp of field-name.") (body-presentation-method . mime-display-multipart/alternative))) (ctree-set-calist-strictly - 'mime-preview-condition '((type . message)(subtype . partial) - (body-presentation-method - . mime-display-message/partial-button))) + 'mime-preview-condition + '((type . multipart)(subtype . t) + (body . visible) + (body-presentation-method . mime-display-multipart/mixed))) + +(ctree-set-calist-strictly + 'mime-preview-condition + '((type . message)(subtype . partial) + (body . visible) + (body-presentation-method . mime-display-message/partial-button))) (ctree-set-calist-strictly - 'mime-preview-condition '((type . message)(subtype . rfc822) - (body-presentation-method . nil) - (childrens-situation (header . visible) - (entity-button . invisible)))) + 'mime-preview-condition + '((type . message)(subtype . rfc822) + (body . visible) + (body-presentation-method . mime-display-multipart/mixed) + (childrens-situation (header . visible) + (entity-button . invisible)))) (ctree-set-calist-strictly - 'mime-preview-condition '((type . message)(subtype . news) - (body-presentation-method . nil) - (childrens-situation (header . visible) - (entity-button . invisible)))) + 'mime-preview-condition + '((type . message)(subtype . news) + (body . visible) + (body-presentation-method . mime-display-multipart/mixed) + (childrens-situation (header . visible) + (entity-button . invisible)))) ;;; @@@ entity presentation @@ -493,7 +722,11 @@ Each elements are regexp of field-name.") (defun mime-display-text/plain (entity situation) (save-restriction (narrow-to-region (point-max)(point-max)) - (mime-insert-text-content entity) + (condition-case nil + (mime-insert-text-content entity) + (error (progn + (message "Can't decode current entity.") + (sit-for 1)))) (run-hooks 'mime-text-decode-hook) (goto-char (point-max)) (if (not (eq (char-after (1- (point))) ?\n)) @@ -523,104 +756,6 @@ Each elements are regexp of field-name.") (enriched-decode beg (point-max)) ))) -(put 'unpack 'lisp-indent-function 1) -(defmacro unpack (string &rest body) - `(let* ((*unpack*string* (string-as-unibyte ,string)) - (*unpack*index* 0)) - ,@body)) - -(defun unpack-skip (len) - (setq *unpack*index* (+ len *unpack*index*))) - -(defun unpack-fixed (len) - (prog1 - (substring *unpack*string* *unpack*index* (+ *unpack*index* len)) - (unpack-skip len))) - -(defun unpack-byte () - (char-int (aref (unpack-fixed 1) 0))) - -(defun unpack-short () - (let* ((b0 (unpack-byte)) - (b1 (unpack-byte))) - (+ (* 256 b0) b1))) - -(defun unpack-long () - (let* ((s0 (unpack-short)) - (s1 (unpack-short))) - (+ (* 65536 s0) s1))) - -(defun unpack-string () - (let ((len (unpack-byte))) - (unpack-fixed len))) - -(defun unpack-string-sjis () - (decode-mime-charset-string (unpack-string) 'shift_jis)) - -(defun postpet-decode (string) - (condition-case nil - (unpack string - (let (res) - (unpack-skip 4) - (set-alist 'res 'carryingcount (unpack-long)) - (unpack-skip 8) - (set-alist 'res 'sentyear (unpack-short)) - (set-alist 'res 'sentmonth (unpack-short)) - (set-alist 'res 'sentday (unpack-short)) - (unpack-skip 8) - (set-alist 'res 'petname (unpack-string-sjis)) - (set-alist 'res 'owner (unpack-string-sjis)) - (set-alist 'res 'pettype (unpack-fixed 4)) - (set-alist 'res 'health (unpack-short)) - (unpack-skip 2) - (set-alist 'res 'sex (unpack-long)) - (unpack-skip 1) - (set-alist 'res 'brain (unpack-byte)) - (unpack-skip 39) - (set-alist 'res 'happiness (unpack-byte)) - (unpack-skip 14) - (set-alist 'res 'petbirthyear (unpack-short)) - (set-alist 'res 'petbirthmonth (unpack-short)) - (set-alist 'res 'petbirthday (unpack-short)) - (unpack-skip 8) - (set-alist 'res 'from (unpack-string)) - (unpack-skip 5) - (unpack-skip 160) - (unpack-skip 4) - (unpack-skip 8) - (unpack-skip 8) - (unpack-skip 26) - (set-alist 'res 'treasure (unpack-short)) - (set-alist 'res 'money (unpack-long)) - res)) - (error nil))) - -(defun mime-display-application/x-postpet (entity situation) - (save-restriction - (narrow-to-region (point-max)(point-max)) - (let ((pet (postpet-decode (mime-entity-content entity)))) - (if pet - (insert "Petname: " (cdr (assq 'petname pet)) "\n" - "Owner: " (cdr (assq 'owner pet)) "\n" - "Pettype: " (cdr (assq 'pettype pet)) "\n" - "From: " (cdr (assq 'from pet)) "\n" - "CarryingCount: " (int-to-string (cdr (assq 'carryingcount pet))) "\n" - "SentYear: " (int-to-string (cdr (assq 'sentyear pet))) "\n" - "SentMonth: " (int-to-string (cdr (assq 'sentmonth pet))) "\n" - "SentDay: " (int-to-string (cdr (assq 'sentday pet))) "\n" - "PetbirthYear: " (int-to-string (cdr (assq 'petbirthyear pet))) "\n" - "PetbirthMonth: " (int-to-string (cdr (assq 'petbirthmonth pet))) "\n" - "PetbirthDay: " (int-to-string (cdr (assq 'petbirthday pet))) "\n" - "Health: " (int-to-string (cdr (assq 'health pet))) "\n" - "Sex: " (int-to-string (cdr (assq 'sex pet))) "\n" - "Brain: " (int-to-string (cdr (assq 'brain pet))) "\n" - "Happiness: " (int-to-string (cdr (assq 'happiness pet))) "\n" - "Treasure: " (int-to-string (cdr (assq 'treasure pet))) "\n" - "Money: " (int-to-string (cdr (assq 'money pet))) "\n" - ) - (insert "Invalid format\n")) - (run-hooks 'mime-display-application/x-postpet-hook)))) - (defvar mime-view-announcement-for-message/partial (if (and (>= emacs-major-version 19) window-system) @@ -692,11 +827,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (mapcar (function (lambda (child) (let ((situation - (or (ctree-match-calist - mime-preview-condition - (append (mime-entity-situation child) - default-situation)) - default-situation))) + (mime-find-entity-preview-situation + child default-situation))) (if (cdr (assq 'body-presentation-method situation)) (let ((score (cdr @@ -726,13 +858,11 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (situation (car situations))) (mime-display-entity child (if (= i p) situation - (del-alist 'body-presentation-method - (copy-alist situation)))) - ) + (put-alist 'body 'invisible + (copy-alist situation))))) (setq children (cdr children) situations (cdr situations) - i (1+ i)) - ))) + i (1+ i))))) ;;; @ acting-condition @@ -741,8 +871,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (defvar mime-acting-condition nil "Condition-tree about how to process entity.") -(if (file-readable-p mailcap-file) - (let ((entries (mailcap-parse-file))) +(if (file-readable-p mime-mailcap-file) + (let ((entries (mime-parse-mailcap-file))) (while entries (let ((entry (car entries)) view print shared) @@ -858,71 +988,74 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (or preview-buffer (setq preview-buffer (current-buffer))) (let* (e nb ne nhb nbb) - (mime-goto-header-start-point entity) (in-calist-package 'mime-view) (or situation (setq situation - (or (ctree-match-calist mime-preview-condition - (append (mime-entity-situation entity) - default-situation)) - default-situation))) + (mime-find-entity-preview-situation entity default-situation))) (let ((button-is-invisible - (eq (cdr (assq 'entity-button situation)) 'invisible)) + (eq (cdr (or (assq '*entity-button situation) + (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 (cdr (assq 'major-mode situation)) - mime-header-presentation-method-alist)))) - (body-presentation-method - (cdr (assq 'body-presentation-method situation))) + (eq (cdr (or (assq '*header situation) + (assq 'header situation))) + 'visible)) + (body-is-visible + (eq (cdr (or (assq '*body situation) + (assq 'body situation))) + 'visible)) (children (mime-entity-children entity))) (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) - )) - (when header-is-visible - (setq nhb (point)) - (if header-presentation-method - (funcall header-presentation-method entity situation) - (mime-insert-header entity - mime-view-ignored-field-list - mime-view-visible-field-list)) - (run-hooks 'mime-display-header-hook) - (put-text-property nhb (point-max) 'mime-view-entity-header entity) - (goto-char (point-max)) - (insert "\n") - ) + ;; (if (mime-view-entity-button-visible-p entity) + (mime-view-insert-entity-button entity) + ;; ) + ) + (if header-is-visible + (let ((header-presentation-method + (or (cdr (assq 'header-presentation-method situation)) + (cdr (assq (cdr (assq 'major-mode situation)) + mime-header-presentation-method-alist))))) + (setq nhb (point)) + (if header-presentation-method + (funcall header-presentation-method entity situation) + (mime-insert-header entity + mime-view-ignored-field-list + mime-view-visible-field-list)) + (run-hooks 'mime-display-header-hook) + (put-text-property nhb (point-max) 'mime-view-entity-header entity) + (goto-char (point-max)) + (insert "\n"))) (setq nbb (point)) - (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) - ) - (or header-is-visible - (progn - (goto-char (point-max)) - (insert "\n") - )) - )) + (unless children + (if body-is-visible + (let ((body-presentation-method + (cdr (assq 'body-presentation-method situation)))) + (if (functionp body-presentation-method) + (funcall body-presentation-method entity situation) + (mime-display-text/plain entity situation))) + (when button-is-invisible + (goto-char (point-max)) + (mime-view-insert-entity-button entity) + ) + (unless header-is-visible + (goto-char (point-max)) + (insert "\n")) + )) (setq ne (point-max)) (widen) (put-text-property nb ne 'mime-view-entity entity) (put-text-property nb ne 'mime-view-situation situation) (put-text-property nbb ne 'mime-view-entity-body entity) (goto-char ne) - (if children - (if (functionp body-presentation-method) - (funcall body-presentation-method entity situation) - (mime-display-multipart/mixed entity situation) - )) + (if (and children body-is-visible) + (let ((body-presentation-method + (cdr (assq 'body-presentation-method situation)))) + (if (functionp body-presentation-method) + (funcall body-presentation-method entity situation) + (mime-display-multipart/mixed entity situation)))) ))) @@ -959,6 +1092,24 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." (defvar mouse-button-2 'button2) ) (t + (defvar mime-view-popup-menu + (let ((menu (make-sparse-keymap mime-view-menu-title))) + (nconc menu + (mapcar (function + (lambda (item) + (list (intern (nth 1 item)) 'menu-item + (nth 1 item)(nth 2 item)) + )) + mime-view-menu-list)))) + (defun mime-view-popup-menu (event) + "Popup the menu in the MIME Viewer buffer" + (interactive "@e") + (let ((menu mime-view-popup-menu) events func) + (setq events (x-popup-menu t menu)) + (and events + (setq func (lookup-key menu (apply #'vector events))) + (commandp func) + (funcall func)))) (defvar mouse-button-2 [mouse-2]) )) @@ -993,6 +1144,28 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." "e" (function mime-preview-extract-current-entity)) (define-key mime-view-mode-map "\C-c\C-p" (function mime-preview-print-current-entity)) + + (define-key mime-view-mode-map + "\C-c\C-t\C-f" (function mime-preview-toggle-header)) + (define-key mime-view-mode-map + "\C-c\C-th" (function mime-preview-toggle-header)) + (define-key mime-view-mode-map + "\C-c\C-t\C-c" (function mime-preview-toggle-content)) + + (define-key mime-view-mode-map + "\C-c\C-v\C-f" (function mime-preview-show-header)) + (define-key mime-view-mode-map + "\C-c\C-vh" (function mime-preview-show-header)) + (define-key mime-view-mode-map + "\C-c\C-v\C-c" (function mime-preview-show-content)) + + (define-key mime-view-mode-map + "\C-c\C-d\C-f" (function mime-preview-hide-header)) + (define-key mime-view-mode-map + "\C-c\C-dh" (function mime-preview-hide-header)) + (define-key mime-view-mode-map + "\C-c\C-d\C-c" (function mime-preview-hide-content)) + (define-key mime-view-mode-map "a" (function mime-preview-follow-current-entity)) (define-key mime-view-mode-map @@ -1028,6 +1201,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t. t means default." mouse-button-3 (function mime-view-xemacs-popup-menu)) ) ((>= emacs-major-version 19) + (define-key mime-view-mode-map + mouse-button-3 (function mime-view-popup-menu)) (define-key mime-view-mode-map [menu-bar mime-view] (cons mime-view-menu-title (make-sparse-keymap mime-view-menu-title))) @@ -1082,9 +1257,7 @@ keymap of MIME-View mode." (setq preview-buffer (concat "*Preview-" (mime-entity-name message) "*"))) (or original-major-mode - (setq original-major-mode - (with-current-buffer (mime-entity-header-buffer message) - major-mode))) + (setq original-major-mode major-mode)) (let ((inhibit-read-only t)) (set-buffer (get-buffer-create preview-buffer)) (widen) @@ -1191,17 +1364,69 @@ button-2 Move to point under the mouse cursor ) (setq mime-message-structure (mime-open-entity type raw-buffer)) (or (mime-entity-content-type mime-message-structure) - (mime-entity-set-content-type-internal - mime-message-structure ctl)) + (mime-entity-set-content-type mime-message-structure ctl)) ) (or (mime-entity-encoding mime-message-structure) - (mime-entity-set-encoding-internal mime-message-structure encoding)) + (mime-entity-set-encoding mime-message-structure encoding)) )) (mime-display-message mime-message-structure preview-buffer mother default-keymap-or-function) ) +;;; @@ utility +;;; + +(defun mime-preview-find-boundary-info (&optional get-mother) + (let (entity + p-beg p-end + entity-node-id len) + (while (null (setq entity + (get-text-property (point) 'mime-view-entity))) + (backward-char)) + (setq p-beg (previous-single-property-change (point) 'mime-view-entity)) + (setq entity-node-id (mime-entity-node-id entity)) + (setq len (length entity-node-id)) + (cond ((null p-beg) + (setq p-beg + (if (eq (next-single-property-change (point-min) + 'mime-view-entity) + (point)) + (point) + (point-min))) + ) + ((eq (next-single-property-change p-beg 'mime-view-entity) + (point)) + (setq p-beg (point)) + )) + (setq p-end (next-single-property-change p-beg 'mime-view-entity)) + (cond ((null p-end) + (setq p-end (point-max)) + ) + ((null entity-node-id) + (setq p-end (point-max)) + ) + (get-mother + (save-excursion + (goto-char p-end) + (catch 'tag + (let (e i) + (while (setq e + (next-single-property-change + (point) 'mime-view-entity)) + (goto-char e) + (let ((rc (mime-entity-node-id + (get-text-property (1- (point)) + 'mime-view-entity)))) + (or (and (>= (setq i (- (length rc) len)) 0) + (equal entity-node-id (nthcdr i rc))) + (throw 'tag nil))) + (setq p-end e))) + (setq p-end (point-max)))) + )) + (vector p-beg p-end entity))) + + ;;; @@ playing ;;; @@ -1235,144 +1460,79 @@ It decodes current entity to call internal or external method as It calls following-method selected from variable `mime-preview-following-method-alist'." (interactive) - (let (entity) - (while (null (setq entity - (get-text-property (point) 'mime-view-entity))) - (backward-char) - ) - (let* ((p-beg - (previous-single-property-change (point) 'mime-view-entity)) - p-end - ph-end + (let ((entity (mime-preview-find-boundary-info t)) + p-beg p-end + pb-beg) + (setq p-beg (aref entity 0) + p-end (aref entity 1) + entity (aref entity 2)) + (if (get-text-property p-beg 'mime-view-entity-body) + (setq pb-beg p-beg) + (setq pb-beg + (next-single-property-change + p-beg 'mime-view-entity-body nil + (or (next-single-property-change p-beg 'mime-view-entity) + p-end)))) + (let* ((mode (mime-preview-original-major-mode 'recursive)) (entity-node-id (mime-entity-node-id entity)) - (len (length entity-node-id)) - ) - (cond ((null p-beg) - (setq p-beg - (if (eq (next-single-property-change (point-min) - 'mime-view-entity) - (point)) - (point) - (point-min))) - ) - ((eq (next-single-property-change p-beg 'mime-view-entity) - (point)) - (setq p-beg (point)) - )) - (setq p-end (next-single-property-change p-beg 'mime-view-entity)) - (cond ((null p-end) - (setq p-end (point-max)) - ) - ((null entity-node-id) - (setq p-end (point-max)) - ) - (t - (save-excursion - (goto-char p-end) - (catch 'tag - (let (e) - (while (setq e - (next-single-property-change - (point) 'mime-view-entity)) - (goto-char e) - (let ((rc (mime-entity-node-id - (get-text-property (point) - 'mime-view-entity)))) - (or (equal entity-node-id - (nthcdr (- (length rc) len) rc)) - (throw 'tag nil) - )) - (setq p-end e) - )) - (setq p-end (point-max)) - )) - )) - (setq ph-end - (previous-single-property-change p-end 'mime-view-entity-header)) - (if (or (null ph-end) - (< ph-end p-beg)) - (setq ph-end p-beg) - ) - (let* ((mode (mime-preview-original-major-mode 'recursive)) - (new-name - (format "%s-%s" (buffer-name) (reverse entity-node-id))) - new-buf - (the-buf (current-buffer)) - fields) - (save-excursion - (set-buffer (setq new-buf (get-buffer-create new-name))) - (erase-buffer) - (insert-buffer-substring the-buf ph-end p-end) - (when (= ph-end p-beg) - (goto-char (point-min)) - (insert ?\n)) - (goto-char (point-min)) - (let ((current-entity - (if (and (eq (mime-entity-media-type entity) 'message) - (eq (mime-entity-media-subtype entity) 'rfc822)) - (mime-entity-children entity) - entity)) - str) - (while (and current-entity - (progn - (setq str - (with-current-buffer - (mime-entity-header-buffer current-entity) - (save-restriction - (narrow-to-region - (mime-entity-header-start-point - current-entity) - (mime-entity-header-end-point - current-entity)) - (std11-header-string-except - (concat - "^" - (apply (function regexp-or) fields) - ":") "")))) - (if (and (eq (mime-entity-media-type - current-entity) 'message) - (eq (mime-entity-media-subtype - current-entity) 'rfc822)) - nil - (if str - (insert str) - ) - t))) - (setq fields (std11-collect-field-names) - current-entity (mime-entity-parent current-entity)) - ) - ) - (let ((rest mime-view-following-required-fields-list) - field-name ret) - (while rest - (setq field-name (car rest)) - (or (std11-field-body field-name) - (progn - (save-excursion - (set-buffer the-buf) - (setq ret - (when mime-mother-buffer - (set-buffer mime-mother-buffer) - (mime-entity-fetch-field - (get-text-property (point) - 'mime-view-entity) - field-name)))) - (if ret - (insert (concat field-name ": " ret "\n")) - ))) - (setq rest (cdr rest)) - )) - (mime-decode-header-in-buffer) - ) - (let ((f (cdr (assq mode mime-preview-following-method-alist)))) - (if (functionp f) - (funcall f new-buf) - (message - (format - "Sorry, following method for %s is not implemented yet." - mode)) + (new-name + (format "%s-%s" (buffer-name) (reverse entity-node-id))) + new-buf + (the-buf (current-buffer)) + fields) + (save-excursion + (set-buffer (setq new-buf (get-buffer-create new-name))) + (erase-buffer) + (insert ?\n) + (insert-buffer-substring the-buf pb-beg p-end) + (goto-char (point-min)) + (let ((current-entity + (if (and (eq (mime-entity-media-type entity) 'message) + (eq (mime-entity-media-subtype entity) 'rfc822)) + (car (mime-entity-children entity)) + entity))) + (while (and current-entity + (if (and (eq (mime-entity-media-type + current-entity) 'message) + (eq (mime-entity-media-subtype + current-entity) 'rfc822)) + nil + (mime-insert-header current-entity fields) + t)) + (setq fields (std11-collect-field-names) + current-entity (mime-entity-parent current-entity)) )) - )))) + (let ((rest mime-view-following-required-fields-list) + field-name ret) + (while rest + (setq field-name (car rest)) + (or (std11-field-body field-name) + (progn + (save-excursion + (set-buffer the-buf) + (let ((entity (when mime-mother-buffer + (set-buffer mime-mother-buffer) + (get-text-property (point) + 'mime-view-entity)))) + (while (and entity + (null (setq ret (mime-entity-fetch-field + entity field-name)))) + (setq entity (mime-entity-parent entity))))) + (if ret + (insert (concat field-name ": " ret "\n")) + ))) + (setq rest (cdr rest)) + )) + ) + (let ((f (cdr (assq mode mime-preview-following-method-alist)))) + (if (functionp f) + (funcall f new-buf) + (message + (format + "Sorry, following method for %s is not implemented yet." + mode)) + )) + ))) ;;; @@ moving @@ -1544,6 +1704,65 @@ If LINES is negative, scroll up LINES lines." (mime-preview-scroll-down-entity (or lines 1)) ) + +;;; @@ display +;;; + +(defun mime-preview-toggle-display (type &optional display) + (let ((situation (mime-preview-find-boundary-info)) + (sym (intern (concat "*" (symbol-name type)))) + entity p-beg p-end) + (setq p-beg (aref situation 0) + p-end (aref situation 1) + entity (aref situation 2) + situation (get-text-property p-beg 'mime-view-situation)) + (cond ((eq display 'invisible) + (setq display nil)) + (display) + (t + (setq display + (eq (cdr (or (assq sym situation) + (assq type situation))) + 'invisible)))) + (setq situation (put-alist sym (if display + 'visible + 'invisible) + situation)) + (save-excursion + (let ((inhibit-read-only t)) + (delete-region p-beg p-end) + (mime-display-entity entity situation))) + (let ((ret (assoc situation mime-preview-situation-example-list))) + (if ret + (setcdr ret (1+ (cdr ret))) + (add-to-list 'mime-preview-situation-example-list + (cons situation 0)))))) + +(defun mime-preview-toggle-header (&optional force-visible) + (interactive "P") + (mime-preview-toggle-display 'header force-visible)) + +(defun mime-preview-toggle-content (&optional force-visible) + (interactive "P") + (mime-preview-toggle-display 'body force-visible)) + +(defun mime-preview-show-header () + (interactive) + (mime-preview-toggle-display 'header 'visible)) + +(defun mime-preview-show-content () + (interactive) + (mime-preview-toggle-display 'body 'visible)) + +(defun mime-preview-hide-header () + (interactive) + (mime-preview-toggle-display 'header 'invisible)) + +(defun mime-preview-hide-content () + (interactive) + (mime-preview-toggle-display 'body 'invisible)) + + ;;; @@ quitting ;;; @@ -1569,6 +1788,43 @@ It calls function registered in variable (provide 'mime-view) -(run-hooks 'mime-view-load-hook) +(let ((file mime-situation-examples-file)) + (if (file-readable-p file) + (with-temp-buffer + (insert-file-contents file) + (setq mime-situation-examples-file-coding-system + (static-cond + ((boundp 'buffer-file-coding-system) + (symbol-value 'buffer-file-coding-system)) + ((boundp 'file-coding-system) + (symbol-value 'file-coding-system)) + (t nil))) + (eval-buffer) + ;; format check + (condition-case nil + (let ((i 0)) + (while (and (> (length mime-preview-situation-example-list) + mime-preview-situation-example-list-max-size) + (< i 16)) + (setq mime-preview-situation-example-list + (mime-reduce-situation-examples + mime-preview-situation-example-list)) + (setq i (1+ i)))) + (error (setq mime-preview-situation-example-list nil))) + ;; (let ((rest mime-preview-situation-example-list)) + ;; (while rest + ;; (ctree-set-calist-strictly 'mime-preview-condition + ;; (caar rest)) + ;; (setq rest (cdr rest)))) + (condition-case nil + (let ((i 0)) + (while (and (> (length mime-acting-situation-example-list) + mime-acting-situation-example-list-max-size) + (< i 16)) + (setq mime-acting-situation-example-list + (mime-reduce-situation-examples + mime-acting-situation-example-list)) + (setq i (1+ i)))) + (error (setq mime-acting-situation-example-list nil)))))) ;;; mime-view.el ends here diff --git a/mime-w3.el b/mime-w3.el index 80d67ce..ff2aecc 100644 --- a/mime-w3.el +++ b/mime-w3.el @@ -1,8 +1,8 @@ ;;; mime-w3.el --- mime-view content filter for text -;; Copyright (C) 1994,1995,1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: HTML, MIME, multimedia, mail, news ;; This file is part of SEMI (Suite of Emacs MIME Interfaces). @@ -46,11 +46,7 @@ (defvar mime-w3-message-structure nil) (defun mime-preview-text/html (entity situation) - (setq mime-w3-message-structure - (let ((ent entity)) - (while (not (mime-root-entity-p ent)) - (setq ent (mime-entity-parent ent))) - ent)) + (setq mime-w3-message-structure (mime-find-root-entity entity)) (goto-char (point-max)) (let ((p (point))) (insert "\n") diff --git a/semi-def.el b/semi-def.el index 18e2f03..e7169c8 100644 --- a/semi-def.el +++ b/semi-def.el @@ -1,6 +1,6 @@ ;;; semi-def.el --- definition module for WEMI -*- coding: iso-8859-4; -*- -;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: definition, MIME, multimedia, mail, news @@ -25,10 +25,10 @@ ;;; Code: (require 'poe) -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'static)) (require 'custom) -(defconst mime-user-interface-product ["WEMI" (1 13 7) "Shimada"] +(defconst mime-user-interface-product ["WEMI" (1 14 0) "Kanaya"] "Product name, version number and code name of MIME-kernel package.") (autoload 'mule-caesar-region "mule-caesar" @@ -80,7 +80,10 @@ provided or the TTY frame is used." ;; Avoid removing extents of next part. (if (eq (extent-end-position extent) end) (set-extent-endpoints extent end (point)))) - (delete-region start end)))) + (delete-region start end))) + (add-text-properties start (point) + (list 'start-open t + 'mime-button t))) (insert "\n")) (static-when (featurep 'xemacs) @@ -110,11 +113,15 @@ if the TTY frame is used." ;; `device-on-widow-system-p' must be checked at run-time. (if (device-on-window-system-p) (progn - (set-extent-properties (make-extent (point) - (progn - (insert "[" string "]") - (point))) - '(invisible t intangible t)) + (let ((old-point (point))) + (set-extent-properties (make-extent (point) + (progn + (insert "[" string "]") + (point))) + '(invisible t intangible t + start-open t)) + (add-text-properties old-point (point) + '(mime-button t start-open t))) (let* ((spec (list string mime-xpm-button-shadow-thickness mime-xpm-button-foreground @@ -236,11 +243,14 @@ if the TTY frame is used." ;;; @ menu ;;; -(if window-system - (if (featurep 'xemacs) - (defun select-menu-alist (title menu-alist) +(static-if (featurep 'xemacs) + (defun select-menu-alist (title menu-alist) + ;; XEmacs can have both X and tty frames at the same time with + ;; gnuclient. + (if (device-on-window-system-p) (let (ret) (popup-menu + ;; list* is CL function, but CL is a part of XEmacs. (list* title "---" (mapcar (function @@ -252,54 +262,19 @@ if the TTY frame is used." t))) menu-alist))) (recursive-edit) - ret)) + ret) + (cdr + (assoc (completing-read (concat title " : ") menu-alist) + menu-alist)))) + (if window-system (defun select-menu-alist (title menu-alist) (x-popup-menu (list '(1 1) (selected-window)) - (list title (cons title menu-alist))))) - (defun select-menu-alist (title menu-alist) - (cdr - (assoc (completing-read (concat title " : ") menu-alist) - menu-alist)))) - - -;;; @ PGP -;;; - -(defvar pgp-function-alist - '( - ;; for mime-pgp - (verify mc-verify "mc-toplev") - (decrypt mc-decrypt "mc-toplev") - (fetch-key mc-pgp-fetch-key "mc-pgp") - (snarf-keys mc-snarf-keys "mc-toplev") - ;; for mime-edit - (mime-sign mime-mc-pgp-sign-region "mime-mc") - (traditional-sign mc-pgp-sign-region "mc-pgp") - (encrypt mime-mc-pgp-encrypt-region "mime-mc") - (insert-key mc-insert-public-key "mc-toplev") - ) - "Alist of service names vs. corresponding functions and its filenames. -Each element looks like (SERVICE FUNCTION FILE). - -SERVICE is a symbol of PGP processing. It allows `verify', `decrypt', -`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt' -or `insert-key'. - -Function is a symbol of function to do specified SERVICE. - -FILE is string of filename which has definition of corresponding -FUNCTION.") - -(defmacro pgp-function (method) - "Return function to do service METHOD." - `(cadr (assq ,method (symbol-value 'pgp-function-alist)))) - -(mapcar (function - (lambda (method) - (autoload (cadr method)(nth 2 method)) - )) - pgp-function-alist) + (list title (cons title menu-alist)))) + (defun select-menu-alist (title menu-alist) + (cdr + (assoc (completing-read (concat title " : ") menu-alist) + menu-alist))))) ;;; @ Other Utility diff --git a/semi-setup.el b/semi-setup.el index 9928d1e..ecdf2ae 100644 --- a/semi-setup.el +++ b/semi-setup.el @@ -1,8 +1,8 @@ ;;; semi-setup.el --- setup file for MIME-View. -;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1994,95,96,97,98,99,2000 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word ;; This file is part of SEMI (Setting for Emacs MIME Interfaces). @@ -41,22 +41,15 @@ it is used as hook to set." )) -;; for image/* and X-Face +;; for image/* (defvar mime-setup-enable-inline-image (and window-system - (or (featurep 'xemacs) - (and (featurep 'mule)(module-installed-p 'bitmap)) - )) + (or (featurep 'xemacs)(featurep 'mule))) "*If it is non-nil, semi-setup sets up to use mime-image.") (if mime-setup-enable-inline-image - (call-after-loaded 'mime-view - (function - (lambda () - (require 'mime-image) - ))) - ) - + (eval-after-load "mime-view" + '(require 'mime-image))) ;; for text/html (defvar mime-setup-enable-inline-html @@ -64,27 +57,23 @@ it is used as hook to set." "*If it is non-nil, semi-setup sets up to use mime-w3.") (if mime-setup-enable-inline-html - (call-after-loaded - 'mime-view - (function - (lambda () - (autoload 'mime-preview-text/html "mime-w3") - - (ctree-set-calist-strictly - 'mime-preview-condition - '((type . text)(subtype . html) - (body . visible) - (body-presentation-method . mime-preview-text/html))) - - (set-alist 'mime-view-type-subtype-score-alist - '(text . html) 3) - ))) - ) + (eval-after-load "mime-view" + '(progn + (autoload 'mime-preview-text/html "mime-w3") + + (ctree-set-calist-strictly + 'mime-preview-condition + '((type . text)(subtype . html) + (body . visible) + (body-presentation-method . mime-preview-text/html))) + + (set-alist 'mime-view-type-subtype-score-alist + '(text . html) 3) + ))) ;; for PGP -(defvar mime-setup-enable-pgp - (module-installed-p 'mailcrypt) +(defvar mime-setup-enable-pgp t "*If it is non-nil, semi-setup sets uf to use mime-pgp.") (if mime-setup-enable-pgp @@ -123,6 +112,30 @@ it is used as hook to set." '((type . application)(subtype . pgp-keys) (method . mime-add-application/pgp-keys)) 'strict "mime-pgp") + + (mime-add-condition + 'action + '((type . application)(subtype . pkcs7-signature) + (method . mime-verify-application/pkcs7-signature)) + 'strict "mime-pgp") + + (mime-add-condition + 'action + '((type . application)(subtype . x-pkcs7-signature) + (method . mime-verify-application/pkcs7-signature)) + 'strict "mime-pgp") + + (mime-add-condition + 'action + '((type . application)(subtype . pkcs7-mime) + (method . mime-view-application/pkcs7-mime)) + 'strict "mime-pgp") + + (mime-add-condition + 'action + '((type . application)(subtype . x-pkcs7-mime) + (method . mime-view-application/pkcs7-mime)) + 'strict "mime-pgp") )) ) @@ -130,23 +143,23 @@ it is used as hook to set." ;;; @ for mime-edit ;;; -(defun mime-setup-decode-message-header () - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region - (point-min) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (match-beginning 0) - (point-max) - )) - (mime-decode-header-in-buffer) - (set-buffer-modified-p nil) - ))) - -(add-hook 'mime-edit-mode-hook 'mime-setup-decode-message-header) +;; (defun mime-setup-decode-message-header () +;; (save-excursion +;; (save-restriction +;; (goto-char (point-min)) +;; (narrow-to-region +;; (point-min) +;; (if (re-search-forward +;; (concat "^" (regexp-quote mail-header-separator) "$") +;; nil t) +;; (match-beginning 0) +;; (point-max) +;; )) +;; (mime-decode-header-in-buffer) +;; (set-buffer-modified-p nil) +;; ))) + +;; (add-hook 'mime-edit-mode-hook 'mime-setup-decode-message-header) ;;; @@ variables @@ -184,7 +197,7 @@ it is used as hook to set." ;;; @ for mu-cite ;;; -(add-hook 'mu-cite/pre-cite-hook 'eword-decode-header) +;; (add-hook 'mu-cite/pre-cite-hook 'eword-decode-header) ;;; @ end diff --git a/signature.el b/signature.el index f06f53c..6bd81c3 100644 --- a/signature.el +++ b/signature.el @@ -1,13 +1,12 @@ ;;; signature.el --- a signature utility for GNU Emacs -;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. +;; Copyright (C) 1994,1995,1996,1997,2000 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; OKABE Yasuo -;; Shuhei KOBAYASHI -;; Maintainer: Shuhei KOBAYASHI +;; Shuhei KOBAYASHI +;; Maintainer: Shuhei KOBAYASHI ;; Created: 1994/7/11 -;; Version: $Id: signature.el,v 7.16 1997/09/24 23:17:38 shuhei-k Exp $ ;; Keywords: mail, news, signature ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). -- 1.7.10.4