Merge remi-1_14_2-1.
authortomo <tomo>
Fri, 24 Nov 2000 12:32:58 +0000 (12:32 +0000)
committertomo <tomo>
Fri, 24 Nov 2000 12:32:58 +0000 (12:32 +0000)
29 files changed:
ChangeLog
Makefile
NEWS
README.en
SEMI-ELS
SEMI-MK
VERSION
ftp.in
mime-edit.el
mime-image.el
mime-pgp.el
mime-play.el
mime-ui-en.sgml
mime-ui-en.texi
mime-ui-ja.sgml
mime-ui-ja.texi
mime-view.el
mime-w3.el
pgg-def.el [new file with mode: 0644]
pgg-gpg.el [new file with mode: 0644]
pgg-parse.el [new file with mode: 0644]
pgg-pgp.el [new file with mode: 0644]
pgg-pgp5.el [new file with mode: 0644]
pgg.el [new file with mode: 0644]
postpet.el [new file with mode: 0644]
semi-def.el
semi-setup.el
signature.el
smime.el [new file with mode: 0644]

index 7591d3e..b677275 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
+2000-10-19  Takanori Saneto  <sanewo@ba2.so-net.ne.jp>
+
+       * 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  <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+       * mime-edit.el (mime-file-types): Fix to use application/msword
+       instead of application/winword.
+
+2000-08-11  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * mime-view.el (mime-display-text/plain): Display warning message
+       when `mime-insert-text-content' fails.
+
+2000-08-04   Daiki Ueno  <ueno@unixuser.org>
+
+       * pgg-gpg.el (pgg-gpg-process-region): Don't bind
+       coding-system-for-read.
+
+2000-07-04  Yuuichi Teranishi  <teranisi@gohome.org>
+
+       * mime-image.el (mime-image-insert) [XEmacs]:
+       Insert `string' only if it is non-nil.
+
+2000-06-27   Daiki Ueno  <ueno@unixuser.org>
+
+       * mime-image.el (mime-image-insert): Synch with the latest image.el.
+       (mime-display-image): Don't pass underlying string "x".
+
+2000-06-09   Daiki Ueno  <ueno@unixuser.org>
+
+       * mime-edit.el (mime-edit-insert-key): Insert a text tag when
+       the buffer has any trailing text.
+
+2000-06-05  Shugo Maeda <shugo@ruby-lang.org>
+
+       * pgg-gpg.el (pgg-scheme-insert-key): Don't quote user id.
+
+2000-05-21   Daiki Ueno  <ueno@unixuser.org>
+
+       * pgg-gpg.el (pgg-gpg-process-region): Abolish redundant nconc.
+
+2000-05-16   Daiki Ueno  <ueno@unixuser.org>
+
+       * mime-image.el (mime-image-create) [XEmacs]: Don't call
+       `make-image-instance' directly.
+
+2000-05-02   Daiki Ueno  <ueno@unixuser.org>
+
+       * pgg-gpg.el (pgg-scheme-encrypt-region): Don't quote recipient;
+       concatenate all arguments destructively.
+
+2000-04-13   Daiki Ueno  <ueno@unixuser.org>
+
+       * 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-03-01  Yoshiki Hayashi <yoshiki@xemacs.org>
+
+       * mime-image.el (mime-display-image): Don't wait for redisplay.
+
+\f
+2000-07-12  MORIOKA Tomohiko  <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+       * REMI: Version 1.14.2 (Hokuhoku-\e-DÒshima)\e-A released.
+
+       * README.en (Required environment): Modify for FLIM-Chao 1.14.1.
+
+2000-07-11  MORIOKA Tomohiko  <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+       * 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-06-23  MORIOKA Tomohiko  <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+       * 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  <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+       * 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-05-25  Tanaka Akira      <akr@m17n.org>
+
+        * README.en: Update for CVS via SSH.
+
+2000-04-28  MORIOKA Tomohiko  <tomo@kanji.zinbun.kyoto-u.ac.jp>
+
+       * mime-edit.el (mime-charset-type-list): Add `iso-2022-jp-3'.
+
+\f
+2000-03-01  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * REMI: Version 1.14.1 (Mushigawa\e-Dòsugi)\e-A released.
+
+2000-03-01  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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              <mit@nines.nec.co.jp>
+
+       * mime-edit.el (mime-edit-normalize-body): Fix number of arguments
+       against enriched-encode.
+
+2000-02-23  Daiki Ueno        <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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   Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <tomo@m17n.org>
+
+       * 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'.
+
+\f
+2000-02-17  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * REMI: Version 1.14.0 (Uragawara) released.
+
+2000-02-17  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * mime-view.el (mime-display-entity): Find
+       `header-presentation-method' only if `header-is-visible'.
+
+2000-02-10  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * mime-view.el (mime-display-entity): Don't use
+       `mime-goto-header-start-point'.
+
+2000-02-10  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * mime-view.el (mime-preview-follow-current-entity): Use
+       `mime-view-entity-body' to find body.
+
+2000-02-10  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * mime-view.el (mime-preview-find-boundary-info): Use <last point>
+       - 1 instead of <last point> to get `mime-view-entity' property.
+
+       * mime-view.el (mime-preview-follow-current-entity): Fix problem
+       in multipart entity.
+
+2000-02-07  Yoshiki Hayashi  <yoshiki@xemacs.org>
+
+       * 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  <Makoto.Nakagawa@jp.compaq.com>
+
+       * pgg-pgp5.el (pgg-scheme-verify-region): Copy the contents of
+       `pgg-errors-buffer' to `pgg-output-buffer'.
+
+2000-02-02   Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * pgg.el (pgg-temp-buffer-show-function): Don't check if the
+       selected window is the only window.
+
+2000-02-01  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * mime-view.el (mime-reduce-situation-examples): New function;
+       delete `mime-reduce-acting-situation-examples'.
+
+2000-01-16  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * mime-play.el (mime-play-entity): Use `mime-unify-situations'.
+
+       * mime-view.el (mime-unify-situations): New function.
+
+2000-01-16  MORIOKA Tomohiko  <tomo@m17n.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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  <Makoto.Nakagawa@jp.compaq.com>
+
+       * 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   <yamaoka@jpl.org>
+
+       * Makefile, README.en: Update for the new CVS server.
+
+1999-12-28   Daiki Ueno       <ueno@ueda.info.waseda.ac.jp>
+
+       * mime-edit.el (mime-edit-user-agent-value): Don't require
+       `apel-ver' directly.
+
+1999-12-28  Katsumi Yamaoka   <yamaoka@jpl.org>
+
+       * 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  <tomo@m17n.org>
+
+       * 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   <ari@atesoft.advantest.co.jp>
+
+       * 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   <yamaoka@jpl.org>
+
+       * README.en: Update for the recent ML address and ftp site.
+
+1999-12-11  Daiki Ueno        <ueno@ueda.info.waseda.ac.jp>
+
+       * 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        <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * smime.el (smime-x509-hash): Use `call-process' instead of
+       `call-process-region'.
+       (smime-x509-subject): Ditto.
+
+1999-12-08  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * SEMI-ELS (semi-modules-to-compile): Add smime.el.
+
+       * smime.el: New file.
+
+1999-11-30  Tsukamoto Tetsuo  <czkmt@remus.dti.ne.jp>
+
+       * mime-edit.el (mime-edit-decode-message-in-buffer): Don't decode
+       the message header twice.
+
+1999-11-30  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * pgg.el (pgg-remove-passphrase-cache): Add checking whether
+       the passphrase has already been expired.
+
+1999-11-26  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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-<impl>-user-id' if specified.
+       (sign-region): Ditto.
+       (decrypt-region): Ditto.
+       (insert-key): Ditto.
+
+1999-11-26  Nakagawa, Makoto  <Makoto.Nakagawa@jp.compaq.com>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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 <yamaoka@jpl.org>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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 <yamaoka@jpl.org>
+
+       * mime-image.el (mime-image-normalize-xbm): New macro.
+       (mime-display-image): Use it.
+
+1999-11-13  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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   <ari@atesoft.advantest.co.jp>
+
+       * mime-image.el (image-normalize): Use `write-region-as-binary'.
+
+1999-11-11  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * pgg-pgp.el, pgg-pgp5.el (verify-region): Set default umask to 077.
+
+1999-11-10  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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-10  Yoshiki Hayashi  <t90553@mail.ecc.u-tokyo.ac.jp>
+
+       * mime-play.el: (mime-save-directory): New variable.
+       (mime-save-content): Don't force filename parameter to be used.
+
+1999-11-09  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * pgg-pgp.el, pgg-pgp5.el
+       (sign-region): Don't convert line break code.
+
+1999-11-07  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * pgg-parse.el (pgg-byte-after): Always pass the first argument
+       of `char-after'.
+
+1999-11-05   Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * pgg.el (pgg-verify-region): Ignore all errors encountered on
+       calling `pgg-fetch-key'.
+
+1999-11-04  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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 <yamaoka@jpl.org>
+
+       * mime-edit.el (mime-edit-preview-message): Inherit the value of
+       `mime-edit-pgp-processing'.
+
+1999-11-04  Daiki Ueno  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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  <ueno@ueda.info.waseda.ac.jp>
+
+       * 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-01  Tanaka Akira  <akr@jaist.ac.jp>
+
+       * mime-view.el (mime-display-application/x-postpet): New function.
+       (mime-preview-condition): Set up for
+       'mime-preview-application/x-postpet.
+       (unpack): New macro.
+       (unpack-skip): New function.
+       (unpack-fixed): New function.
+       (unpack-byte): New function.
+       (unpack-short): New function.
+       (unpack-long): New function.
+       (unpack-string): New function.
+       (unpack-string-sjis): New function.
+       (postpet-decode): New function.
+
+1999-10-17  Yoshiki Hayashi  <t90553@mail.ecc.u-tokyo.ac.jp>
+
+       * SEMI-MK (install-semi-package): Delte auto-autoloads.el
+       and custom-load.el
+
+\f
 1999-10-16  MORIOKA Tomohiko  <tomo@m17n.org>
 
        * SEMI: Version 1.13.7 (Awazu) released.
 1999-10-16  MORIOKA Tomohiko  <tomo@m17n.org>
 
        * SEMI: Version 1.13.7 (Awazu) released.
index 84d8c26..758331f 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -2,11 +2,11 @@
 # Makefile for SEMI kernel.
 #
 
 # Makefile for SEMI kernel.
 #
 
-PACKAGE = semi
-API    = 1.13
-RELEASE = 7
+PACKAGE = remi
+API    = 1.14
+RELEASE = 2
 
 
-FLIM_API= 1.13
+FLIM_API= 1.14
 
 TAR    = tar
 RM     = /bin/rm -f
 
 TAR    = tar
 RM     = /bin/rm -f
@@ -24,7 +24,7 @@ VERSION_SPECIFIC_LISPDIR = NONE
 GOMI   = *.elc
 
 VERSION        = $(API).$(RELEASE)
 GOMI   = *.elc
 
 VERSION        = $(API).$(RELEASE)
-ARC_DIR = /pub/mule/semi/semi-$(API)-for-flim-$(FLIM_API)
+ARC_DIR = /home/tomo/public_html/comp/emacsen/lisp/semi/semi-$(API)-for-flim-$(FLIM_API)
 
 
 elc:
 
 
 elc:
@@ -53,7 +53,7 @@ tar:
        cvs commit
        sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) | tr . _`; \
        cd /tmp; \
        cvs commit
        sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) | tr . _`; \
        cd /tmp; \
-       cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \
+       cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root \
                export -d $(PACKAGE)-$(VERSION) \
                -r $(PACKAGE)-`echo $(VERSION) | tr . _` \
                semi'
                export -d $(PACKAGE)-$(VERSION) \
                -r $(PACKAGE)-`echo $(VERSION) | tr . _` \
                semi'
diff --git a/NEWS b/NEWS
index 529574f..eaebaeb 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,17 @@ Copyright (C) 1998,1999 Free Software Foundation, Inc.
 
 * Changes in SEMI 1.13
 
 
 * 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
 
 
 ** Requires FLIM 1.13 API
 
 
index 7f2d51b..56ffa9c 100644 (file)
--- a/README.en
+++ b/README.en
@@ -40,15 +40,16 @@ Required environment
   19.14.  SEMI also does not support Emacs 19.29 to 19.34, XEmacs
   19.15 or XEmacs 20.2 without mule, but SEMI may work with them.
 
   19.14.  SEMI also does not support Emacs 19.29 to 19.34, XEmacs
   19.15 or XEmacs 20.2 without mule, but SEMI 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:
 
   package.  Please install them before installing it.  APEL package is
   available at:
 
-       ftp://ftp.etl.go.jp/pub/mule/apel/
+       ftp://ftp.m17n.org/pub/mule/apel/
 
   and FLIM package is available at:
 
 
   and FLIM package is available at:
 
-       ftp://ftp.etl.go.jp/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.
 
 
   PGP/MIME and application/pgp require mailcrypt or tiny-pgp package.
 
@@ -179,24 +180,24 @@ Mailing lists
 =============
 
   If you write bug-reports and/or suggestions for improvement, please
 =============
 
   If you write bug-reports and/or suggestions for improvement, please
-  send them to the tm Mailing List:
+  send them to the EMACS-MIME Mailing List:
 
 
-       bug-tm-en@chamonix.jaist.ac.jp  (English)
-       bug-tm-ja@chamonix.jaist.ac.jp  (Japanese)
+       emacs-mime-en@m17n.org  (English)
+       emacs-mime-ja@m17n.org  (Japanese)
 
 
-  Via the tm ML, you can report SEMI bugs, obtain the latest release
-  of SEMI, and discuss future enhancements to SEMI.  To join the tm
-  ML, send an empty e-mail to
+  Via the EMACS-MIME ML, you can report SEMI bugs, obtain the latest
+  release of SEMI, and discuss future enhancements to SEMI.  To join
+  the EMACS-MIME ML, send an empty e-mail to
 
 
-       tm-en-help@chamonix.jaist.ac.jp (English)
-       tm-ja-help@chamonix.jaist.ac.jp (Japanese)
+       emacs-mime-en-ctl@m17n.org      (English)
+       emacs-mime-ja-ctl@m17n.org      (Japanese)
 
   Notice that you should not send mail to author(s), such as
   morioka@jaist.ac.jp, directly.  Because your problem may occur in
   other environments (if not, it might be your problem, not bug of
 
   Notice that you should not send mail to author(s), such as
   morioka@jaist.ac.jp, directly.  Because your problem may occur in
   other environments (if not, it might be your problem, not bug of
-  SEMI).  We should discuss in the tm mailing lists.  Anyway
+  SEMI).  We should discuss in the EMACS-MIME mailing lists.  Anyway
   direct-mail for authors might be ignored.  Please send mail to the
   direct-mail for authors might be ignored.  Please send mail to the
-  tm mailing lists.
+  EMACS-MIME mailing lists.
 
 
 CVS based development
 
 
 CVS based development
@@ -204,10 +205,16 @@ CVS based development
 
   If you would like to join CVS based development, please send mail to
 
 
   If you would like to join CVS based development, please send mail to
 
-       cvs@chamonix.jaist.ac.jp
+       cvs@cvs.m17n.org
 
 
-  with your account name and UNIX style crypted password.  We hope you 
-  will join the open development.
+  with your account name and your public key for ssh.  cvsroot is
+  :ext:cvs@cvs.m17n.org:/cvs/root.
+
+  If you cannot use ssh, please send UNIX /etc/passwd style crypted
+  password.  you can commit with the cvsroot
+  :pserver:<accountname>@cvs.m17n.org:/cvs/root.
+
+  We hope you will join the open development.
 
 
 Authors
 
 
 Authors
index 6ffa7fc..448caf3 100644 (file)
--- a/SEMI-ELS
+++ b/SEMI-ELS
@@ -6,7 +6,10 @@
 
 (setq semi-modules-to-compile
       '(signature
 
 (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)
        semi-setup mail-mime-setup))
 
 (setq semi-modules-not-to-compile nil)
@@ -23,8 +26,7 @@
                     (nconc semi-modules-not-to-compile i-modules))
               )
             )))
                     (nconc semi-modules-not-to-compile i-modules))
               )
             )))
-       '((mailcrypt    mime-pgp mime-mc)
-         (bbdb         mime-bbdb)
+       '((bbdb         mime-bbdb)
          (w3           mime-w3)
          ))
 
          (w3           mime-w3)
          ))
 
diff --git a/SEMI-MK b/SEMI-MK
index bd5f525..2aed7f1 100644 (file)
--- a/SEMI-MK
+++ b/SEMI-MK
@@ -90,6 +90,8 @@ LISPDIR=%s\n" PREFIX LISPDIR))
                         (expand-file-name SEMI_PREFIX
                                           (expand-file-name "lisp"
                                                             PACKAGEDIR)))
                         (expand-file-name SEMI_PREFIX
                                           (expand-file-name "lisp"
                                                             PACKAGEDIR)))
+  (delete-file "./auto-autoloads.el")
+  (delete-file "./custom-load.el")
   )
 
 ;;; SEMI-MK ends here
   )
 
 ;;; SEMI-MK ends here
diff --git a/VERSION b/VERSION
index 9c1fa27..7367163 100644 (file)
--- a/VERSION
+++ b/VERSION
@@ -91,7 +91,7 @@
 -------        Kawake                  \e$(B2OLS\e(B
 -------        Torahime                \e$(B8WI1\e(B
 -------        Nagahama                \e$(BD9IM\e(B
 -------        Kawake                  \e$(B2OLS\e(B
 -------        Torahime                \e$(B8WI1\e(B
 -------        Nagahama                \e$(BD9IM\e(B
-------- Tamura                 \e$(BEDB<\e(B
+-------        Tamura                  \e$(BEDB<\e(B
 -------        Sakata                  \e$(B:dED\e(B
        (Maibara)               (\e$(BJF86\e(B)           ; = JR \e$(BEl3$F;K\@~\e(B
 
 -------        Sakata                  \e$(B:dED\e(B
        (Maibara)               (\e$(BJF86\e(B)           ; = JR \e$(BEl3$F;K\@~\e(B
 
 1.13.0 Saigata                 \e$(B:T3c\e(B     ; = JR \e$(B?.1[K\@~\e(B
 1.13.1 Kubiki                  \e$(B$/$S$-\e(B
 1.13.2 \e-DÒike-Ikoinomori\e-A           \e$(BBgCS$$$3$$$N?9\e(B
 1.13.0 Saigata                 \e$(B:T3c\e(B     ; = JR \e$(B?.1[K\@~\e(B
 1.13.1 Kubiki                  \e$(B$/$S$-\e(B
 1.13.2 \e-DÒike-Ikoinomori\e-A           \e$(BBgCS$$$3$$$N?9\e(B
+1.14.0 Uragawara               \e$(B$&$i$,$o$i\e(B
+1.14.1 Mushigawa\e-Dòsugi\e-A            \e$(BCn@nBg?y\e(B
+1.14.2 Hokuhoku-\e-DÒshima\e-A           \e$(B$[$/$[$/BgEg\e(B
+1.14.3 Matsudai                \e$(B$^$D$@$$\e(B
 
 
 [etc.]
 
 
 [etc.]
diff --git a/ftp.in b/ftp.in
index 848fbe2..f15aa34 100644 (file)
--- a/ftp.in
+++ b/ftp.in
@@ -2,18 +2,14 @@
 
   It is available from
 
 
   It is available from
 
-    ftp://ftp.m17n.org/pub/mule/semi/semi-API-for-flim-FLIM_API
+    http://www.kanji.zinbun.kyoto-u.ac.jp/~tomo/comp/emacsen/lisp/semi/semi-API-for-flim-FLIM_API/
 
 
-or
-
-    ftp://ftp.etl.go.jp/pub/mule/semi/semi-API-for-flim-FLIM_API
-
---[[message/external-body;
-       access-type=anon-ftp;
-       site="ftp.m17n.org";
-       directory="/pub/mule/semi/semi-API-for-flim-FLIM_API";
-       name="PACKAGE-VERSION.tar.gz";
-       mode=image]]
+--[[message/external-body; access-type=URL;
+       URL*0="http://";
+       URL*1="www.kanji.zinbun.kyoto-u.ac.jp/~tomo/";
+       URL*2="comp/emacsen/lisp/";
+       URL*3="semi/semi-API-for-flim-FLIM_API/";
+       URL*4="PACKAGE-VERSION.tar.gz"]]
 Content-Type: application/octet-stream;
        name="PACKAGE-VERSION.tar.gz";
        type=tar;
 Content-Type: application/octet-stream;
        name="PACKAGE-VERSION.tar.gz";
        type=tar;
index 81b7613..d6899a3 100644 (file)
@@ -1,9 +1,10 @@
 ;;; mime-edit.el --- Simple MIME Composer for GNU Emacs
 
 ;;; 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 <umerin@mse.kyutech.ac.jp>
 
 ;; Author: UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
-;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;;     MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+;;     Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
 ;; Created: 1994/08/21 renamed from mime.el
 ;;     Renamed: 1997/2/21 from tm-edit.el
 ;; Keywords: MIME, multimedia, multilingual, mail, news
 ;; Created: 1994/08/21 renamed from mime.el
 ;;     Renamed: 1997/2/21 from tm-edit.el
 ;; Keywords: MIME, multimedia, multilingual, mail, news
 (require 'signature)
 (require 'alist)
 (require 'invisible)
 (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
 
 
 ;;; @ version
@@ -301,7 +317,7 @@ To insert a signature file automatically, call the function
     ;;  Octect binary text
 
     ("\\.doc$"                         ;MS Word
     ;;  Octect binary text
 
     ("\\.doc$"                         ;MS Word
-     "application" "winword" nil
+     "application" "msword" nil
      "base64"
      "attachment" (("filename" . file))
      )
      "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-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")
     (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)
 
   "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
 ;;; @@ 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)
          ") "
          " ("
          (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))
          (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)
           (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)))
          ))))
 
            (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)
 (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)
   (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 "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
                (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)))
          )))))
 
          (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
 (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))
             (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")
        (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)
            )
            (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"))
        ))))
 
 (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)
   (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)
              )
              (throw 'mime-edit-error 'pgp-error)
              )
+         (delete-region (point-min)(point-max))
          (goto-char beg)
          (insert (format "--[[multipart/encrypted;
  boundary=\"%s\";
          (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))
 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))
          )))))
          (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")
            (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)
            (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")
              (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)
              (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)
 (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
                    ;;                        (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))
                   (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)
   )
 
   (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")
 (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
 
 
 ;;; @ flag setting
@@ -2373,12 +2526,14 @@ Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8."
     ))
   (if arg
       (progn
     ))
   (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.")
        )
        (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.")
     ))
 
     (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
     ))
   (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.")
        )
        (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.")
     ))
 
     (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)
                 )))
               (if (search-forward (concat "\n" mail-header-separator "\n"))
                   (match-end 0)
                 )))
-       (end (point-max))
        )
     (if beg
        )
     (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))
         (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
         )
     (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 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)
 
     (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)
        (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."
 
 (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)
         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
 
 (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)
     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)
         (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)
                )
              (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))
                ))))
        ))
     (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))
   (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)
         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)
     (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-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))
        )
              )))
        (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
       )))
 
 ;;;###autoload
index d5e4aa0..76c2335 100644 (file)
@@ -4,7 +4,9 @@
 ;; Copyright (C) 1996 Dan Rich
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Copyright (C) 1996 Dan Rich
 
 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;         Dan Rich <drich@morpheus.corp.sgi.com>
+;;     Dan Rich <drich@morpheus.corp.sgi.com>
+;;     Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;;     Katsumi Yamaoka  <yamaoka@jpl.org>
 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/12/15
 ;;     Renamed: 1997/2/21 from tm-image.el
 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
 ;; Created: 1995/12/15
 ;;     Renamed: 1997/2/21 from tm-image.el
 
 ;;; Code:
 
 
 ;;; 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
 ;;;
 
 ;;; @ content filter for images
 ;;;
 
 (defun mime-display-image (entity situation)
   (message "Decoding image...")
 
 (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
 ;;;
 
 ;;; @ end
 ;;;
index fb76f45..718ad9e 100644 (file)
@@ -1,8 +1,9 @@
 ;;; mime-pgp.el --- mime-view internal methods for PGP.
 
 ;;; 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 <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;;     Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
 ;; Created: 1995/12/7
 ;;     Renamed: 1997/2/27 from tm-pgp.el
 ;; Keywords: PGP, security, MIME, multimedia, mail, news
 ;; Created: 1995/12/7
 ;;     Renamed: 1997/2/27 from tm-pgp.el
 ;; Keywords: PGP, security, MIME, multimedia, mail, news
 ;;         by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
 ;;         expired)
 
 ;;         by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
 ;;         expired)
 
+;;     [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME
+;;         Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO
+;;         <kazu@iijlab.net> (1998/1)
+
 ;;; Code:
 
 (require 'mime-play)
 ;;; 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
 
 
 ;;; @ Internal method for multipart/signed
         (new-name
          (format "%s-%s" (buffer-name) (mime-entity-number entity)))
         (mother (current-buffer))
         (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))
     (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)
           (goto-char (point-min))
           (delete-region
            (point-min)
            (point-max))
           (goto-char (point-min))
           (while (re-search-forward "^- -" nil t)
            (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)
           (setq representation-type (if (mime-entity-cooked-p entity)
-                                        'cooked))
-          )
+                                        'cooked)))
          ((progn
             (goto-char (point-min))
             (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t))
          ((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)
     (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
 ;;;
 
 
 ;;; @ 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."
 
 (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))
                 (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)
     (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)
            (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
 ;;;
 
 
 ;;; @ 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))
 
 (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))))
                   (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
 ;;;
 
 
 ;;; @ 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)
 
 (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
 ;;;
 
 ;;; @ end
 ;;;
 
index b4a03a2..e43b872 100644 (file)
@@ -1,8 +1,8 @@
 ;;; mime-play.el --- Playback processing module for mime-view.el
 
 ;;; 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 <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Created: 1995/9/26 (separated from tm-view.el)
 ;;     Renamed: 1997/2/21 from tm-play.el
 ;; Keywords: MIME, multimedia, mail, news
 ;; Created: 1995/9/26 (separated from tm-view.el)
 ;;     Renamed: 1997/2/21 from tm-play.el
 ;; Keywords: MIME, multimedia, mail, news
     (error (defvar bbdb-buffer-name nil)))
   )
 
     (error (defvar bbdb-buffer-name nil)))
   )
 
-(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))
-      )))
+(defcustom mime-save-directory "~/"
+  "*Name of the directory where MIME entity will be saved in.
+If t, it means current directory."
+  :group 'mime-view
+  :type '(choice (const :tag "Current directory" t)
+                (directory)))
+
+(defvar mime-play-find-every-situations t
+  "*Find every available situations if non-nil.")
 
 
 ;;; @ content decoder
 
 
 ;;; @ content decoder
@@ -175,136 +77,21 @@ If MODE is specified, play as it.  Default MODE is \"play\"."
          (mime-play-entity entity situation)
          ))))
 
          (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\"."
 ;;;###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"
     (cond ((cdr ret)
           (setq ret (select-menu-alist
                      "Methods"
@@ -459,26 +246,25 @@ window.")
 ;;;
 
 (defun mime-save-content (entity situation)
 ;;;
 
 (defun mime-save-content (entity situation)
-  (let* ((name (mime-entity-safe-filename entity))
-        (filename (if (and name (not (string-equal name "")))
-                      (expand-file-name name
-                                        (save-window-excursion
-                                          (call-interactively
-                                           (function
-                                            (lambda (dir)
-                                              (interactive "DDirectory: ")
-                                              dir)))))
-                    (save-window-excursion
-                      (call-interactively
-                       (function
-                        (lambda (file)
-                          (interactive "FFilename: ")
-                          (expand-file-name file)))))))
-        )
+  (let ((name (or (mime-entity-safe-filename entity)
+                 (format "%s" (mime-entity-media-type entity))))
+       (dir (if (eq t mime-save-directory)
+                default-directory
+              mime-save-directory))
+       filename)
+    (setq filename (read-file-name
+                   (concat "File name: (default "
+                           (file-name-nondirectory name) ") ")
+                   dir
+                   (concat (file-name-as-directory dir)
+                           (file-name-nondirectory name))))
+    (if (file-directory-p filename)
+       (setq filename (concat (file-name-as-directory filename)
+                              (file-name-nondirectory name))))
     (if (file-exists-p filename)
        (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
            (error "")))
     (if (file-exists-p filename)
        (or (yes-or-no-p (format "File %s exists. Save anyway? " filename))
            (error "")))
-    (mime-write-entity-content entity filename)
+    (mime-write-entity-content entity (expand-file-name filename))
     ))
 
 
     ))
 
 
@@ -529,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'."
 (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))
        (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)
     (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
 
 (defun mime-view-message/rfc822 (entity situation)
   (let* ((new-name
@@ -584,14 +369,14 @@ It is registered to variable `mime-preview-quitting-method-alist'."
          (save-window-excursion
            (set-buffer full-buf)
            (erase-buffer)
          (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))
            (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)
          (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")))
       (setq file (concat root-dir "/" number))
       (mime-write-entity-body entity file)
       (let ((total-file (concat root-dir "/CT")))
@@ -639,9 +424,8 @@ It is registered to variable `mime-preview-quitting-method-alist'."
                    (goto-char (point-max))
                    (setq i (1+ i))
                    ))
                    (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)))
                (let ((i 1))
                  (while (<= i total)
                    (let ((file (format "%s/%d" root-dir i)))
@@ -654,11 +438,15 @@ It is registered to variable `mime-preview-quitting-method-alist'."
                  (and (file-exists-p file)
                       (delete-file file)
                       ))
                  (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)))
                                (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)
                  )))))
                  (set-window-buffer pwin pbuf)
                  (select-window pwin)
                  )))))
@@ -728,26 +516,4 @@ It is registered to variable `mime-preview-quitting-method-alist'."
 
 (provide 'mime-play)
 
 
 (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
 ;;; mime-play.el ends here
index 6f1b876..7a02f72 100644 (file)
@@ -370,7 +370,7 @@ Insert signature.
 </dd>
 <kt>C-c C-x C-k
 <kd>
 </dd>
 <kt>C-c C-x C-k
 <kd>
-Insert <dref>PGP</dref> public key. (It requires Mailcrypt package.)
+Insert <dref>PGP</dref> public key.
 </kd>
 <kt>C-c C-x t
 <kd>
 </kd>
 <kt>C-c C-x t
 <kd>
@@ -609,29 +609,21 @@ mime-edit provides PGP encryption, signature and inserting public-key
 features based on <concept>PGP/MIME</concept> (RFC 2015) or
 <concept>PGP-kazu</concept> (draft-kazu-pgp-mime-00.txt).
 <p>
 features based on <concept>PGP/MIME</concept> (RFC 2015) or
 <concept>PGP-kazu</concept> (draft-kazu-pgp-mime-00.txt).
 <p>
-This feature requires pgp command and pgp interface package, such as
-<a file="mailcrypt">Mailcrypt package</a>.
+This feature requires your pgp command.
 
 
-<defvar name="pgp-function-alist">
+<defvar name="pgg-default-scheme">
 <p>
 <p>
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like <code>(SERVICE FUNCTION FILE)</code>.
-<p>
-SERVICE is a symbol of PGP processing.  It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt'
-or `insert-key'.
-<p>
-Function is a symbol of function to do specified SERVICE.
-<p>
-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>,
+<code>pgp</code> or <code>pgp5</code>.
 </defvar>
 
 </defvar>
 
-<defun name="pgp-function">
-           <args> method
+<defvar name="pgg-scheme">
 <p>
 <p>
-Return function to do service <var>method</var>.
-</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>,
+<code>pgp</code> or <code>pgp5</code>.
+</defvar>
 
 
 <h2> Mouse button
 
 
 <h2> Mouse button
index 9946c5f..2cde0f9 100644 (file)
@@ -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
 
 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
 
 
 @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
 
 
 
 
 
 
index 2e1094a..9bb5473 100644 (file)
@@ -624,29 +624,21 @@ mime-edit \e$B$G$O\e(B <concept>PGP/MIME</concept> (RFC 2015) \e$B$*$h$S\e(B
 <concept>PGP-kazu</concept> (draft-kazu-pgp-mime-00.txt) \e$B$K$h$k0E9f2=!&\e(B
 \e$BEE;R=pL>!&8x3+80$NA^F~5!G=$rMxMQ$9$k$3$H$,$G$-$^$9!#\e(B
 <p>
 <concept>PGP-kazu</concept> (draft-kazu-pgp-mime-00.txt) \e$B$K$h$k0E9f2=!&\e(B
 \e$BEE;R=pL>!&8x3+80$NA^F~5!G=$rMxMQ$9$k$3$H$,$G$-$^$9!#\e(B
 <p>
-\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O\e(B <a file="mailcrypt">Mailcrypt package</a> 
-\e$B$H\e(B pgp command \e$B$,I,MW$G$9!#\e(B
+\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F<o\e(B pgp command \e$B$,I,MW$G$9!#\e(B
 
 
-<defvar name="pgp-function-alist">
+<defvar name="pgg-default-scheme">
 <p>
 <p>
-Alist of service names vs. corresponding functions and its filenames.
-Each element looks like <code>(SERVICE FUNCTION FILE)</code>.
-<p>
-SERVICE is a symbol of PGP processing.  It allows `verify', `decrypt',
-`fetch-key', `snarf-keys', `mime-sign', `traditional-sign', `encrypt'
-or `insert-key'.
-<p>
-Function is a symbol of function to do specified SERVICE.
-<p>
-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>,
+<code>pgp</code> or <code>pgp5</code>.
 </defvar>
 
 </defvar>
 
-<defun name="pgp-function">
-           <args> method
+<defvar name="pgg-scheme">
 <p>
 <p>
-Return function to do service <var>method</var>.
-</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>,
+<code>pgp</code> or <code>pgp5</code>.
+</defvar>
 
 
 <h2> \e$B2!KU\e(B
 
 
 <h2> \e$B2!KU\e(B
index 24583c1..8293821 100644 (file)
@@ -698,29 +698,22 @@ mime-edit \e$B$G$O\e(B @strong{PGP/MIME} (RFC 2015) \e$B$*$h$S\e(B@strong{PGP-kazu}
 (draft-kazu-pgp-mime-00.txt) \e$B$K$h$k0E9f2=!&EE;R=pL>!&8x3+80$NA^F~5!G=$r\e(B
 \e$BMxMQ$9$k$3$H$,$G$-$^$9!#\e(B@refill
 
 (draft-kazu-pgp-mime-00.txt) \e$B$K$h$k0E9f2=!&EE;R=pL>!&8x3+80$NA^F~5!G=$r\e(B
 \e$BMxMQ$9$k$3$H$,$G$-$^$9!#\e(B@refill
 
-\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O\e(B Mailcrypt package (@ref{(mailcrypt)}) \e$B$H\e(B 
-pgp command \e$B$,I,MW$G$9!#\e(B
+\e$BC"$7!"$3$N5!G=$rMxMQ$9$k$K$O3F<o\e(B pgp command \e$B$,I,MW$G$9!#\e(B
 
 
-@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
 
 
 @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
 
 
 
 
 
 
index 119d972..24678d0 100644 (file)
@@ -1,8 +1,8 @@
 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
 
 ;;; mime-view.el --- interactive MIME viewer for GNU Emacs
 
-;; 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 <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Created: 1994/07/13
 ;;     Renamed: 1994/08/31 from tm-body.el
 ;;     Renamed: 1997/02/19 from tm-view.el
 ;; Created: 1994/07/13
 ;;     Renamed: 1994/08/31 from tm-body.el
 ;;     Renamed: 1997/02/19 from tm-view.el
   "MIME view mode"
   :group 'mime)
 
   "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)
 
   :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)))
 
                 (const :tag "On" t)
                 (sexp :tag "Situation" 1)))
 
+
 ;;; @ in raw-buffer (representation space)
 ;;;
 
 ;;; @ in raw-buffer (representation space)
 ;;;
 
@@ -91,27 +87,6 @@ major-mode or t.  t means default.  REPRESENTATION-TYPE must be
 `binary' or `cooked'.")
 
 
 `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)
 ;;;
 
 ;;; @ in preview-buffer (presentation space)
 ;;;
 
@@ -224,41 +199,282 @@ mother-buffer."
     
     situation))
 
     
     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)
       ""))
 
 (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
 
 
 ;;; @ presentation of preview
@@ -270,21 +486,21 @@ mother-buffer."
 ;;; @@@ predicate function
 ;;;
 
 ;;; @@@ 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
 ;;;
 
 ;;; @@@ entity button generator
 ;;;
@@ -451,6 +667,14 @@ Each elements are regexp of field-name.")
    (body . visible)
    (body-presentation-method . mime-display-text/richtext)))
 
    (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)
+   (body . visible)
+   (body-presentation-method . mime-display-application/x-postpet)))
+
 (ctree-set-calist-strictly
  'mime-preview-condition
  '((type . text)(subtype . t)
 (ctree-set-calist-strictly
  'mime-preview-condition
  '((type . text)(subtype . t)
@@ -464,21 +688,32 @@ Each elements are regexp of field-name.")
    (body-presentation-method . mime-display-multipart/alternative)))
 
 (ctree-set-calist-strictly
    (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
 
 (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
 
 (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
 
 
 ;;; @@@ entity presentation
@@ -487,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))
 (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))
     (run-hooks 'mime-text-decode-hook)
     (goto-char (point-max))
     (if (not (eq (char-after (1- (point))) ?\n))
@@ -517,6 +756,7 @@ Each elements are regexp of field-name.")
       (enriched-decode beg (point-max))
       )))
 
       (enriched-decode beg (point-max))
       )))
 
+
 (defvar mime-view-announcement-for-message/partial
   (if (and (>= emacs-major-version 19) window-system)
       "\
 (defvar mime-view-announcement-for-message/partial
   (if (and (>= emacs-major-version 19) window-system)
       "\
@@ -586,11 +826,8 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
          (mapcar (function
                   (lambda (child)
                     (let ((situation
          (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
                       (if (cdr (assq 'body-presentation-method situation))
                           (let ((score
                                  (cdr
@@ -620,13 +857,11 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
            (situation (car situations)))
        (mime-display-entity child (if (= i p)
                                       situation
            (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)
       (setq children (cdr children)
            situations (cdr situations)
-           i (1+ i))
-      )))
+           i (1+ i)))))
 
 
 ;;; @ acting-condition
 
 
 ;;; @ acting-condition
@@ -752,71 +987,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)
   (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
     (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
     (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
          (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
          (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))
       (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)
       (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))))
       )))
 
 
       )))
 
 
@@ -853,6 +1091,24 @@ MEDIA-TYPE must be (TYPE . SUBTYPE), TYPE or t.  t means default."
        (defvar mouse-button-2 'button2)
        )
       (t
        (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])
        ))
 
        (defvar mouse-button-2 [mouse-2])
        ))
 
@@ -887,6 +1143,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))
       "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
     (define-key mime-view-mode-map
       "a"        (function mime-preview-follow-current-entity))
     (define-key mime-view-mode-map
@@ -922,6 +1200,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)
             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)))
           (define-key mime-view-mode-map [menu-bar mime-view]
             (cons mime-view-menu-title
                   (make-sparse-keymap mime-view-menu-title)))
@@ -976,9 +1256,7 @@ keymap of MIME-View mode."
        (setq preview-buffer
              (concat "*Preview-" (mime-entity-name message) "*")))
     (or original-major-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)
     (let ((inhibit-read-only t))
       (set-buffer (get-buffer-create preview-buffer))
       (widen)
@@ -1085,17 +1363,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)
          )
        (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)
        )
       (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)
   )
 
 
       ))
   (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
 ;;;
 
 ;;; @@ playing
 ;;;
 
@@ -1129,144 +1459,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)
 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))
           (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
 
 
 ;;; @@ moving
@@ -1436,6 +1701,65 @@ If LINES is negative, scroll up LINES lines."
   (mime-preview-scroll-down-entity (or lines 1))
   )
 
   (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
 ;;;
 
 ;;; @@ quitting
 ;;;
 
@@ -1461,6 +1785,43 @@ It calls function registered in variable
 
 (provide 'mime-view)
 
 
 (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
 
 ;;; mime-view.el ends here
index 6ce9927..ff2aecc 100644 (file)
@@ -1,8 +1,8 @@
 ;;; mime-w3.el --- mime-view content filter for text
 
 ;;; 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 <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: HTML, MIME, multimedia, mail, news
 
 ;; This file is part of SEMI (Suite of Emacs MIME Interfaces).
 ;; Keywords: HTML, MIME, multimedia, mail, news
 
 ;; This file is part of SEMI (Suite of Emacs MIME Interfaces).
@@ -46,9 +46,7 @@
 (defvar mime-w3-message-structure nil)
 
 (defun mime-preview-text/html (entity situation)
 (defvar mime-w3-message-structure nil)
 
 (defun mime-preview-text/html (entity situation)
-  (setq mime-w3-message-structure
-       (with-current-buffer (mime-entity-buffer entity)
-         mime-message-structure))
+  (setq mime-w3-message-structure (mime-find-root-entity entity))
   (goto-char (point-max))
   (let ((p (point)))
     (insert "\n")
   (goto-char (point-max))
   (let ((p (point)))
     (insert "\n")
diff --git a/pgg-def.el b/pgg-def.el
new file mode 100644 (file)
index 0000000..1227996
--- /dev/null
@@ -0,0 +1,75 @@
+;;; pgg-def.el --- functions/macros for defining PGG functions
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'pcustom)
+
+(defgroup pgg ()
+  "Glue for the various PGP implementations."
+  :group 'mime)
+
+(defcustom pgg-default-scheme 'gpg
+  "Default PGP scheme."
+  :group 'pgg
+  :type '(choice (const :tag "GnuPG" gpg)
+                (const :tag "PGP 5" pgp5)
+                (const :tag "PGP" pgp)))
+
+(defcustom pgg-default-user-id (user-login-name)
+  "User ID of your default identity."
+  :group 'pgg
+  :type 'string)
+
+(defcustom pgg-default-keyserver-address "wwwkeys.pgp.net"
+  "Host name of keyserver."
+  :group 'pgg
+  :type 'string)
+
+(defcustom pgg-encrypt-for-me nil
+  "If t, encrypt all outgoing messages with user's public key."
+  :group 'pgg
+  :type 'boolean)
+
+(defcustom pgg-cache-passphrase t
+  "If t, cache passphrase."
+  :group 'pgg
+  :type 'boolean)
+
+(defvar pgg-status-buffer " *PGG status*")
+(defvar pgg-errors-buffer " *PGG errors*")
+(defvar pgg-output-buffer " *PGG output*")
+
+(defvar pgg-echo-buffer "*PGG-echo*")
+
+(defvar pgg-scheme nil
+  "Current scheme of PGP implementation.")
+
+(defmacro pgg-truncate-key-identifier (key)
+  `(if (> (length ,key) 8) (substring ,key 8) ,key))
+
+(provide 'pgg-def)
+
+;;; pgg-def.el ends here
diff --git a/pgg-gpg.el b/pgg-gpg.el
new file mode 100644 (file)
index 0000000..5ac69f6
--- /dev/null
@@ -0,0 +1,234 @@
+;;; pgg-gpg.el --- GnuPG support for PGG.
+
+;; Copyright (C) 1999,2000 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-gpg ()
+  "GnuPG interface"
+  :group 'pgg)
+
+(defcustom pgg-gpg-program "gpg" 
+  "The GnuPG executable."
+  :group 'pgg-gpg
+  :type 'string)
+
+(defcustom pgg-gpg-extra-args nil
+  "Extra arguments for every GnuPG invocation."
+  :group 'pgg-gpg
+  :type 'string)
+
+(eval-and-compile
+  (luna-define-class pgg-scheme-gpg (pgg-scheme)))
+
+(defvar pgg-gpg-user-id nil
+  "GnuPG ID of your default identity.")
+
+(defvar pgg-scheme-gpg-instance nil)
+
+;;;###autoload
+(defun pgg-make-scheme-gpg ()
+  (or pgg-scheme-gpg-instance
+      (setq pgg-scheme-gpg-instance
+           (luna-make-entity 'pgg-scheme-gpg))))
+
+(defun pgg-gpg-process-region (start end passphrase program args)
+  (let* ((output-file-name
+         (concat temporary-file-directory (make-temp-name "pgg-output")))
+        (args
+         `("--status-fd" "2"
+           ,@(if passphrase '("--passphrase-fd" "0"))
+           "--output" ,output-file-name
+           ,@pgg-gpg-extra-args ,@args))
+        (output-buffer pgg-output-buffer)
+        (errors-buffer pgg-errors-buffer)
+        (orig-mode (default-file-modes))
+        (process-connection-type nil)
+        process status exit-status)
+    (with-current-buffer (get-buffer-create errors-buffer)
+      (buffer-disable-undo)
+      (erase-buffer))
+    (unwind-protect
+       (progn
+         (set-default-file-modes 448)
+         (as-binary-output-file
+          (setq process
+                (apply #'start-process "*GnuPG*" errors-buffer program args)))
+         (set-process-sentinel process #'ignore)
+         (when passphrase
+           (process-send-string process (concat passphrase "\n")))
+         (process-send-region process start end)
+         (process-send-eof process)
+         (while (eq 'run (process-status process))
+           (accept-process-output process 5))
+         (setq status (process-status process)
+               exit-status (process-exit-status process))
+         (delete-process process)
+         (with-current-buffer (get-buffer-create output-buffer)
+           (buffer-disable-undo)
+           (erase-buffer)
+           (if (file-exists-p output-file-name)
+               (insert-file-contents-as-raw-text-CRLF output-file-name))
+           (set-buffer errors-buffer)
+           (if (memq status '(stop signal))
+               (error "%s exited abnormally: '%s'" program exit-status))
+           (if (= 127 exit-status)
+               (error "%s could not be found" program))))
+      (if (and process (eq 'run (process-status process)))
+         (interrupt-process process))
+      (if (file-exists-p output-file-name)
+         (delete-file output-file-name))
+      (set-default-file-modes orig-mode))))
+
+(defun pgg-gpg-possibly-cache-passphrase (passphrase)
+  (if (and pgg-cache-passphrase
+          (progn
+            (goto-char (point-min))
+            (re-search-forward "^\\[GNUPG:] GOOD_PASSPHRASE\\>" nil t)))
+      (pgg-add-passphrase-cache
+       (progn
+        (goto-char (point-min))
+        (if (re-search-forward
+             "^\\[GNUPG:] NEED_PASSPHRASE \\w+ ?\\w*" nil t)
+            (substring (match-string 0) -8)))
+       passphrase)))
+
+(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-gpg)
+                                          string &optional type)
+  (let ((args (list "--with-colons" "--no-greeting" "--batch"
+                   (if type "--list-secret-keys" "--list-keys")
+                   string)))
+    (with-temp-buffer
+      (apply #'call-process pgg-gpg-program nil t nil args)
+      (goto-char (point-min))
+      (if (re-search-forward "^\\(sec\\|pub\\):"  nil t)
+         (substring
+          (nth 3 (split-string
+                  (buffer-substring (match-end 0)
+                                    (progn (end-of-line)(point)))
+                  ":")) 8)))))
+
+(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-gpg)
+                                              start end recipients)
+  (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+        (args
+         `("--batch" "--armor" "--always-trust" "--encrypt"
+           ,@(if recipients
+                 (apply #'nconc
+                        (mapcar (lambda (rcpt)
+                                  (list "--remote-user" rcpt))
+                                (append recipients
+                                        (if pgg-encrypt-for-me
+                                            (list pgg-gpg-user-id)))))))))
+    (pgg-as-lbt start end 'CRLF
+      (pgg-gpg-process-region start end nil pgg-gpg-program args))
+    (pgg-process-when-success)))
+
+(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-gpg)
+                                              start end)
+  (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+        (passphrase
+         (pgg-read-passphrase
+          (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+          (pgg-scheme-lookup-key scheme pgg-gpg-user-id 'encrypt)))
+        (args '("--batch" "--decrypt")))
+    (pgg-gpg-process-region start end passphrase pgg-gpg-program args)
+    (with-current-buffer pgg-errors-buffer
+      (pgg-gpg-possibly-cache-passphrase passphrase)
+      (goto-char (point-min))
+      (re-search-forward "^\\[GNUPG:] DECRYPTION_OKAY\\>" nil t))))
+
+(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-gpg)
+                                           start end &optional cleartext)
+  (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+        (passphrase
+         (pgg-read-passphrase
+          (format "GnuPG passphrase for %s: " pgg-gpg-user-id)
+          (pgg-scheme-lookup-key scheme pgg-gpg-user-id 'sign)))
+        (args
+         (list (if cleartext "--clearsign" "--detach-sign")
+               "--armor" "--batch" "--verbose"
+               "--local-user" pgg-gpg-user-id))
+        (inhibit-read-only t)
+        buffer-read-only)
+    (pgg-as-lbt start end 'CRLF
+      (pgg-gpg-process-region start end passphrase pgg-gpg-program args))
+    (with-current-buffer pgg-errors-buffer
+      (pgg-gpg-possibly-cache-passphrase passphrase))
+    (pgg-process-when-success)))
+
+(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-gpg)
+                                             start end &optional signature)
+  (let ((args '("--batch" "--verify")))
+    (when (stringp signature)
+      (setq args (append args (list signature))))
+    (pgg-gpg-process-region start end nil pgg-gpg-program args)
+    (with-current-buffer pgg-errors-buffer
+      (goto-char (point-min))
+      (while (re-search-forward "^gpg: " nil t)
+       (replace-match ""))
+      (goto-char (point-min))
+      (prog1 (re-search-forward "^\\[GNUPG:] GOODSIG\\>" nil t)
+       (goto-char (point-min))
+       (delete-matching-lines "^warning\\|\\[GNUPG:]")
+       (set-buffer pgg-output-buffer)
+       (insert-buffer-substring pgg-errors-buffer)))))
+
+(luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-gpg))
+  (let* ((pgg-gpg-user-id (or pgg-gpg-user-id pgg-default-user-id))
+        (args (list "--batch" "--export" "--armor"
+                    pgg-gpg-user-id)))
+    (pgg-gpg-process-region (point)(point) nil pgg-gpg-program args)
+    (insert-buffer-substring pgg-output-buffer)))
+
+(luna-define-method pgg-scheme-snarf-keys-region ((scheme pgg-scheme-gpg)
+                                                 start end)
+  (let ((args '("--import" "--batch" "-")) status)
+    (pgg-gpg-process-region start end nil pgg-gpg-program args)
+    (set-buffer pgg-errors-buffer)
+    (goto-char (point-min))
+    (when (re-search-forward "^\\[GNUPG:] IMPORT_RES\\>" nil t)
+      (setq status (buffer-substring (match-end 0)
+                                    (progn (end-of-line)(point)))
+           status (vconcat (mapcar #'string-to-int (split-string status))))
+      (erase-buffer)
+      (insert (format "Imported %d key(s).
+\tArmor contains %d key(s) [%d bad, %d old].\n"
+                     (+ (aref status 2)
+                        (aref status 10))
+                     (aref status 0)
+                     (aref status 1)
+                     (+ (aref status 4)
+                        (aref status 11)))
+             (if (zerop (aref status 9))
+                 ""
+               "\tSecret keys are imported.\n")))
+    (append-to-buffer pgg-output-buffer (point-min)(point-max))
+    (pgg-process-when-success)))
+
+(provide 'pgg-gpg)
+
+;;; pgg-gpg.el ends here
diff --git a/pgg-parse.el b/pgg-parse.el
new file mode 100644 (file)
index 0000000..910b0ff
--- /dev/null
@@ -0,0 +1,494 @@
+;;; pgg-parse.el --- OpenPGP packet parsing
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP, OpenPGP, GnuPG
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;    This module is based on
+
+;;     [OpenPGP] RFC 2440: "OpenPGP Message Format"
+;;         by John W. Noerenberg, II <jwn2@qualcomm.com>,
+;;          Jon Callas <jon@pgp.com>, Lutz Donnerhacke <lutz@iks-jena.de>,
+;;          Hal Finney <hal@pgp.com> and Rodney Thayer <rodney@unitran.com>
+;;         (1998/11)
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(eval-when-compile (require 'static))
+
+(require 'poem)
+(require 'pccl)
+(require 'pcustom)
+(require 'mel)
+
+(defgroup pgg-parse ()
+  "OpenPGP packet parsing"
+  :group 'pgg)
+
+(defcustom pgg-parse-public-key-algorithm-alist
+  '((1 . RSA) (2 . RSA-E) (3 . RSA-S) (16 . ELG-E) (17 . DSA) (20 . ELG))
+  "Alist of the assigned number to the public key algorithm."
+  :group 'pgg-parse
+  :type 'alist)
+
+(defcustom pgg-parse-symmetric-key-algorithm-alist
+  '((1 . IDEA) (2 . 3DES) (4 . CAST5) (5 . SAFER-SK128))
+  "Alist of the assigned number to the simmetric key algorithm."
+  :group 'pgg-parse
+  :type 'alist)
+
+(defcustom pgg-parse-hash-algorithm-alist
+  '((1 . MD5) (2 . SHA1) (3 . RIPEMD160) (5 . MD2))
+  "Alist of the assigned number to the cryptographic hash algorithm."
+  :group 'pgg-parse
+  :type 'alist)
+
+(defcustom pgg-parse-compression-algorithm-alist
+  '((0 . nil); Uncompressed
+    (1 . ZIP)
+    (2 . ZLIB))
+  "Alist of the assigned number to the compression algorithm."
+  :group 'pgg-parse
+  :type 'alist)
+
+(defcustom pgg-parse-signature-type-alist
+  '((0 . "Signature of a binary document")
+    (1 . "Signature of a canonical text document")
+    (2 . "Standalone signature")
+    (16 . "Generic certification of a User ID and Public Key packet")
+    (17 . "Persona certification of a User ID and Public Key packet")
+    (18 . "Casual certification of a User ID and Public Key packet")
+    (19 . "Positive certification of a User ID and Public Key packet")
+    (24 . "Subkey Binding Signature")
+    (31 . "Signature directly on a key")
+    (32 . "Key revocation signature")
+    (40 . "Subkey revocation signature")
+    (48 . "Certification revocation signature")
+    (64 . "Timestamp signature."))
+  "Alist of the assigned number to the signature type."
+  :group 'pgg-parse
+  :type 'alist)
+
+(defcustom pgg-ignore-packet-checksum t; XXX
+  "If non-nil checksum of each ascii armored packet will be ignored."
+  :group 'pgg-parse
+  :type 'boolean)
+
+(defvar pgg-armor-header-lines
+  '("^-----BEGIN PGP MESSAGE\\(, PART [0-9]+\\(/[0-9]+\\)?\\)?-----\r?$"
+    "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$"
+    "^-----BEGIN PGP PRIVATE KEY BLOCK-----\r?$"
+    "^-----BEGIN PGP SIGNATURE-----\r?$")
+  "Armor headers.")
+
+(defmacro pgg-format-key-identifier (string)
+  `(upcase (apply #'format "%02x%02x%02x%02x%02x%02x%02x%02x"
+                 (string-to-int-list ,string))))
+
+(defmacro pgg-parse-time-field (bytes)
+  `(list (logior (lsh (car ,bytes) 8)
+                (nth 1 ,bytes))
+        (logior (lsh (nth 2 ,bytes) 8)
+                (nth 3 ,bytes))
+        0))
+
+(defmacro pgg-byte-after (&optional pos)
+  `(char-int (char-after ,(or pos `(point)))))
+
+(defmacro pgg-read-byte ()
+  `(char-int (char-after (prog1 (point) (forward-char)))))
+
+(defmacro pgg-read-bytes-string (nbytes)
+  `(buffer-substring
+    (point) (prog1 (+ ,nbytes (point))
+             (forward-char ,nbytes))))
+
+(defmacro pgg-read-bytes (nbytes)
+  `(string-to-int-list (pgg-read-bytes-string ,nbytes)))
+
+(defmacro pgg-read-body-string (ptag)
+  `(if (nth 1 ,ptag)
+       (pgg-read-bytes-string (nth 1 ,ptag))
+     (pgg-read-bytes-string (- (point-max) (point)))))
+
+(defmacro pgg-read-body (ptag)
+  `(string-to-int-list (pgg-read-body-string ,ptag)))
+
+(defalias 'pgg-skip-bytes 'forward-char)
+
+(defmacro pgg-skip-header (ptag)
+  `(pgg-skip-bytes (nth 2 ,ptag)))
+
+(defmacro pgg-skip-body (ptag)
+  `(pgg-skip-bytes (nth 1 ,ptag)))
+
+(defmacro pgg-set-alist (alist key value)
+  `(setq ,alist (nconc ,alist (list (cons ,key ,value)))))
+
+(unless-broken ccl-usable
+  (define-ccl-program pgg-parse-crc24
+    '(1
+      ((loop
+       (read r0) (r1 ^= r0) (r2 ^= 0)
+       (r5 = 0)
+       (loop
+        (r1 <<= 1)
+        (r1 += ((r2 >> 15) & 1))
+        (r2 <<= 1)
+        (if (r1 & 256)
+            ((r1 ^= 390) (r2 ^= 19707)))
+        (if (r5 < 7)
+            ((r5 += 1)
+             (repeat))))
+       (repeat)))))
+
+  (defun pgg-parse-crc24-string (string)
+    (let ((h (vector nil 183 1230 nil nil nil nil nil nil)))
+      (ccl-execute-on-string pgg-parse-crc24 h string)
+      (format "%c%c%c"
+             (logand (aref h 1) 255)
+             (logand (lsh (aref h 2) -8) 255)
+             (logand (aref h 2) 255)))))
+
+(defmacro pgg-parse-length-type (c)
+  `(cond
+    ((< ,c 192) (cons ,c 1))
+    ((< ,c 224)
+     (cons (+ (lsh (- ,c 192) 8)
+             (pgg-byte-after (+ 2 (point)))
+             192)
+          2))
+    ((= ,c 255)
+     (cons (cons (logior (lsh (pgg-byte-after (+ 2 (point))) 8)
+                        (pgg-byte-after (+ 3 (point))))
+                (logior (lsh (pgg-byte-after (+ 4 (point))) 8)
+                        (pgg-byte-after (+ 5 (point)))))
+          5))
+    (t;partial body length
+     '(0 . 0))))
+
+(defun pgg-parse-packet-header ()
+  (let ((ptag (pgg-byte-after))
+       length-type content-tag packet-bytes header-bytes)
+    (if (zerop (logand 64 ptag));Old format
+       (progn
+         (setq length-type (logand ptag 3)
+               length-type (if (= 3 length-type) 0 (lsh 1 length-type))
+               content-tag (logand 15 (lsh ptag -2))
+               packet-bytes 0
+               header-bytes (1+ length-type))
+         (dotimes (i length-type)
+           (setq packet-bytes
+                 (logior (lsh packet-bytes 8)
+                         (pgg-byte-after (+ 1 i (point)))))))
+      (setq content-tag (logand 63 ptag)
+           length-type (pgg-parse-length-type
+                        (pgg-byte-after (1+ (point))))
+           packet-bytes (car length-type)
+           header-bytes (1+ (cdr length-type))))
+    (list content-tag packet-bytes header-bytes)))
+
+(defun pgg-parse-packet (ptag)
+  (case (car ptag)
+    (1 ;Public-Key Encrypted Session Key Packet
+     (pgg-parse-public-key-encrypted-session-key-packet ptag))
+    (2 ;Signature Packet
+     (pgg-parse-signature-packet ptag))
+    (3 ;Symmetric-Key Encrypted Session Key Packet
+     (pgg-parse-symmetric-key-encrypted-session-key-packet ptag))
+    ;; 4        -- One-Pass Signature Packet
+    ;; 5        -- Secret Key Packet
+    (6 ;Public Key Packet
+     (pgg-parse-public-key-packet ptag))
+    ;; 7        -- Secret Subkey Packet
+    ;; 8        -- Compressed Data Packet
+    (9 ;Symmetrically Encrypted Data Packet
+     (pgg-read-body-string ptag))
+    (10 ;Marker Packet
+     (pgg-read-body-string ptag))
+    (11 ;Literal Data Packet
+     (pgg-read-body-string ptag))
+    ;; 12       -- Trust Packet
+    (13 ;User ID Packet
+     (pgg-read-body-string ptag))
+    ;; 14       -- Public Subkey Packet
+    ;; 60 .. 63 -- Private or Experimental Values
+    ))
+
+(defun pgg-parse-packets (&optional header-parser body-parser)
+  (let ((header-parser
+        (or header-parser
+            (function pgg-parse-packet-header)))
+       (body-parser
+        (or body-parser
+            (function pgg-parse-packet)))
+       result ptag)
+    (while (> (point-max) (1+ (point)))
+      (setq ptag (funcall header-parser))
+      (pgg-skip-header ptag)
+      (push (cons (car ptag)
+                 (save-excursion
+                   (funcall body-parser ptag)))
+           result)
+      (if (zerop (nth 1 ptag))
+         (goto-char (point-max))
+       (forward-char (nth 1 ptag))))
+    result))
+
+(defun pgg-parse-signature-subpacket-header ()
+  (let ((length-type (pgg-parse-length-type (pgg-byte-after))))
+    (list (pgg-byte-after (+ (cdr length-type) (point)))
+         (1- (car length-type))
+         (1+ (cdr length-type)))))
+       
+(defun pgg-parse-signature-subpacket (ptag)
+  (case (car ptag)
+    (2 ;signature creation time
+     (cons 'creation-time
+          (let ((bytes (pgg-read-bytes 4)))
+            (pgg-parse-time-field bytes))))
+    (3 ;signature expiration time
+     (cons 'signature-expiry
+          (let ((bytes (pgg-read-bytes 4)))
+            (pgg-parse-time-field bytes))))
+    (4 ;exportable certification
+     (cons 'exportability (pgg-read-byte)))
+    (5 ;trust signature
+     (cons 'trust-level (pgg-read-byte)))
+    (6 ;regular expression
+     (cons 'regular-expression
+          (pgg-read-body-string ptag)))
+    (7 ;revocable
+     (cons 'revocability (pgg-read-byte)))
+    (9 ;key expiration time
+     (cons 'key-expiry
+          (let ((bytes (pgg-read-bytes 4)))
+            (pgg-parse-time-field bytes))))
+    ;; 10 = placeholder for backward compatibility
+    (11 ;preferred symmetric algorithms
+     (cons 'preferred-symmetric-key-algorithm
+          (cdr (assq (pgg-read-byte)
+                     pgg-parse-symmetric-key-algorithm-alist))))
+    (12 ;revocation key
+     )
+    (16 ;issuer key ID
+     (cons 'key-identifier
+          (pgg-format-key-identifier (pgg-read-body-string ptag))))
+    (20 ;notation data
+     (pgg-skip-bytes 4)
+     (cons 'notation
+          (let ((name-bytes (pgg-read-bytes 2))
+                (value-bytes (pgg-read-bytes 2)))
+            (cons (pgg-read-bytes-string
+                   (logior (lsh (car name-bytes) 8)
+                           (nth 1 name-bytes)))
+                  (pgg-read-bytes-string
+                   (logior (lsh (car value-bytes) 8)
+                           (nth 1 value-bytes)))))))
+    (21 ;preferred hash algorithms
+     (cons 'preferred-hash-algorithm
+          (cdr (assq (pgg-read-byte)
+                     pgg-parse-hash-algorithm-alist))))
+    (22 ;preferred compression algorithms
+     (cons 'preferred-compression-algorithm
+          (cdr (assq (pgg-read-byte)
+                     pgg-parse-compression-algorithm-alist))))
+    (23 ;key server preferences
+     (cons 'key-server-preferences
+          (pgg-read-body ptag)))
+    (24 ;preferred key server
+     (cons 'preferred-key-server
+          (pgg-read-body-string ptag)))
+    ;; 25 = primary user id
+    (26 ;policy URL
+     (cons 'policy-url (pgg-read-body-string ptag)))
+    ;; 27 = key flags
+    ;; 28 = signer's user id
+    ;; 29 = reason for revocation
+    ;; 100 to 110 = internal or user-defined
+    ))
+
+(defun pgg-parse-signature-packet (ptag)
+  (let* ((signature-version (pgg-byte-after))
+        (result (list (cons 'version signature-version)))
+        hashed-material field n)
+    (cond
+     ((= signature-version 3)
+      (pgg-skip-bytes 2)
+      (setq hashed-material (pgg-read-bytes 5))
+      (pgg-set-alist result
+                    'signature-type
+                    (cdr (assq (pop hashed-material)
+                               pgg-parse-signature-type-alist)))
+      (pgg-set-alist result
+                    'creation-time
+                    (pgg-parse-time-field hashed-material))
+      (pgg-set-alist result
+                    'key-identifier
+                    (pgg-format-key-identifier
+                     (pgg-read-bytes-string 8)))
+      (pgg-set-alist result
+                    'public-key-algorithm (pgg-read-byte))
+      (pgg-set-alist result
+                    'hash-algorithm (pgg-read-byte)))
+     ((= signature-version 4)
+      (pgg-skip-bytes 1)
+      (pgg-set-alist result
+                    'signature-type
+                    (cdr (assq (pgg-read-byte)
+                               pgg-parse-signature-type-alist)))
+      (pgg-set-alist result
+                    'public-key-algorithm
+                    (pgg-read-byte))
+      (pgg-set-alist result
+                    'hash-algorithm (pgg-read-byte))
+      (when (>= 10000 (setq n (pgg-read-bytes 2)
+                           n (logior (lsh (car n) 8)
+                                     (nth 1 n))))
+       (save-restriction
+         (narrow-to-region (point)(+ n (point)))
+         (nconc result
+                (mapcar (function cdr) ;remove packet types
+                        (pgg-parse-packets
+                         #'pgg-parse-signature-subpacket-header
+                         #'pgg-parse-signature-subpacket)))
+         (goto-char (point-max))))
+      (when (>= 10000 (setq n (pgg-read-bytes 2)
+                           n (logior (lsh (car n) 8)
+                                     (nth 1 n))))
+       (save-restriction
+         (narrow-to-region (point)(+ n (point)))
+         (nconc result
+                (mapcar (function cdr) ;remove packet types
+                        (pgg-parse-packets
+                         #'pgg-parse-signature-subpacket-header
+                         #'pgg-parse-signature-subpacket)))))))
+
+    (setcdr (setq field (assq 'public-key-algorithm
+                             result))
+           (cdr (assq (cdr field)
+                      pgg-parse-public-key-algorithm-alist)))
+    (setcdr (setq field (assq 'hash-algorithm
+                             result))
+           (cdr (assq (cdr field)
+                      pgg-parse-hash-algorithm-alist)))
+    result))
+
+(defun pgg-parse-public-key-encrypted-session-key-packet (ptag)
+  (let (result)
+    (pgg-set-alist result
+                  'version (pgg-read-byte))
+    (pgg-set-alist result
+                  'key-identifier
+                  (pgg-format-key-identifier
+                   (pgg-read-bytes-string 8)))
+    (pgg-set-alist result
+                  'public-key-algorithm
+                  (cdr (assq (pgg-read-byte)
+                             pgg-parse-public-key-algorithm-alist)))
+    result))
+
+(defun pgg-parse-symmetric-key-encrypted-session-key-packet (ptag)
+  (let (result)
+    (pgg-set-alist result
+                  'version
+                  (pgg-read-byte))
+    (pgg-set-alist result
+                  'symmetric-key-algorithm
+                  (cdr (assq (pgg-read-byte)
+                             pgg-parse-symmetric-key-algorithm-alist)))
+    result))
+
+(defun pgg-parse-public-key-packet (ptag)
+  (let* ((key-version (pgg-read-byte))
+        (result (list (cons 'version key-version)))
+        field)
+    (cond
+     ((= 3 key-version)
+      (pgg-set-alist result
+                    'creation-time
+                    (let ((bytes (pgg-read-bytes 4)))
+                      (pgg-parse-time-field bytes)))
+      (pgg-set-alist result
+                    'key-expiry (pgg-read-bytes 2))
+      (pgg-set-alist result
+                    'public-key-algorithm (pgg-read-byte)))
+     ((= 4 key-version)
+      (pgg-set-alist result
+                    'creation-time
+                    (let ((bytes (pgg-read-bytes 4)))
+                      (pgg-parse-time-field bytes)))
+      (pgg-set-alist result
+                    'public-key-algorithm (pgg-read-byte))))
+
+    (setcdr (setq field (assq 'public-key-algorithm
+                             result))
+           (cdr (assq (cdr field)
+                      pgg-parse-public-key-algorithm-alist)))
+    result))
+     
+(defun pgg-decode-packets ()
+  (let* ((marker
+         (set-marker (make-marker)
+                     (and (re-search-forward "^=")
+                          (match-beginning 0))))
+        (checksum (buffer-substring (point) (+ 4 (point)))))
+    (delete-region marker (point-max))
+    (mime-decode-region (point-min) marker "base64")
+    (static-when (fboundp 'pgg-parse-crc24-string )
+      (or pgg-ignore-packet-checksum
+         (string-equal
+          (funcall (mel-find-function 'mime-encode-string "base64")
+                   (pgg-parse-crc24-string
+                    (buffer-substring (point-min)(point-max))))
+          checksum)
+         (error "PGP packet checksum does not match")))))
+
+(defun pgg-decode-armor-region (start end)
+  (save-restriction
+    (narrow-to-region start end)
+    (goto-char (point-min))
+    (re-search-forward "^-+BEGIN PGP" nil t)
+    (delete-region (point-min)
+                  (and (search-forward "\n\n")
+                       (match-end 0)))
+    (pgg-decode-packets)
+    (goto-char (point-min))
+    (pgg-parse-packets)))
+
+(defun pgg-parse-armor (string)
+  (with-temp-buffer
+    (buffer-disable-undo)
+    (set-buffer-multibyte nil)
+    (insert string)
+    (pgg-decode-armor-region (point-min)(point))))
+
+(defun pgg-parse-armor-region (start end)
+  (pgg-parse-armor (string-as-unibyte (buffer-substring start end))))
+
+(provide 'pgg-parse)
+
+;;; pgg-parse.el ends here
diff --git a/pgg-pgp.el b/pgg-pgp.el
new file mode 100644 (file)
index 0000000..4f3fbd7
--- /dev/null
@@ -0,0 +1,244 @@
+;;; pgg-pgp.el --- PGP 2.* and 6.* support for PGG.
+
+;; Copyright (C) 1999,2000 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp ()
+  "PGP 2.* and 6.* interface"
+  :group 'pgg)
+
+(defcustom pgg-pgp-program "pgp"
+  "PGP 2.* and 6.* executable."
+  :group 'pgg-pgp
+  :type 'string)
+
+(defcustom pgg-pgp-shell-file-name "/bin/sh"
+  "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
+  :group 'pgg-pgp
+  :type 'string)
+
+(defcustom pgg-pgp-shell-command-switch "-c"
+  "Switch used to have the shell execute its command line argument."
+  :group 'pgg-pgp
+  :type 'string)
+
+(defcustom pgg-pgp-extra-args nil
+  "Extra arguments for every PGP invocation."
+  :group 'pgg-pgp
+  :type 'string)
+
+(eval-and-compile
+  (luna-define-class pgg-scheme-pgp (pgg-scheme)))
+
+(defvar pgg-pgp-user-id nil
+  "PGP ID of your default identity.")
+
+(defvar pgg-scheme-pgp-instance nil)
+
+;;;###autoload
+(defun pgg-make-scheme-pgp ()
+  (or pgg-scheme-pgp-instance
+      (setq pgg-scheme-pgp-instance
+           (luna-make-entity 'pgg-scheme-pgp))))
+
+(defun pgg-pgp-process-region (start end passphrase program args)
+  (let* ((errors-file-name
+         (concat temporary-file-directory
+                 (make-temp-name "pgg-errors")))
+        (args
+         (append args
+                 pgg-pgp-extra-args
+                 (list (concat "2>" errors-file-name))))
+        (shell-file-name pgg-pgp-shell-file-name)
+        (shell-command-switch pgg-pgp-shell-command-switch)
+        (process-environment process-environment)
+        (output-buffer pgg-output-buffer)
+        (errors-buffer pgg-errors-buffer)
+        (process-connection-type nil)
+        process status exit-status)
+    (with-current-buffer (get-buffer-create output-buffer)
+      (buffer-disable-undo)
+      (erase-buffer))
+    (when passphrase
+      (setenv "PGPPASSFD" "0"))
+    (unwind-protect
+       (progn
+         (as-binary-process
+          (setq process
+                (apply #'start-process-shell-command "*PGP*" output-buffer
+                       program args)))
+         (set-process-sentinel process #'ignore)
+         (when passphrase
+           (process-send-string process (concat passphrase "\n")))
+         (process-send-region process start end)
+         (process-send-eof process)
+         (while (eq 'run (process-status process))
+           (accept-process-output process 5))
+         (setq status (process-status process)
+               exit-status (process-exit-status process))
+         (delete-process process)
+         (with-current-buffer output-buffer
+           (pgg-convert-lbt-region (point-min)(point-max) 'LF)
+
+           (if (memq status '(stop signal))
+               (error "%s exited abnormally: '%s'" program exit-status))
+           (if (= 127 exit-status)
+               (error "%s could not be found" program))
+
+           (set-buffer (get-buffer-create errors-buffer))
+           (buffer-disable-undo)
+           (erase-buffer)
+           (insert-file-contents errors-file-name)))
+      (if (and process (eq 'run (process-status process)))
+         (interrupt-process process))
+      (condition-case nil
+         (delete-file errors-file-name)
+       (file-error nil)))))
+
+(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp)
+                                                 string &optional type)
+  (let ((args (list "+batchmode" "+language=en" "-kv" string)))
+    (with-current-buffer (get-buffer-create pgg-output-buffer)
+      (buffer-disable-undo)
+      (erase-buffer)
+      (apply #'call-process pgg-pgp-program nil t nil args)
+      (goto-char (point-min))
+      (cond
+       ((re-search-forward "^pub\\s +[0-9]+/" nil t);PGP 2.*
+       (buffer-substring (point)(+ 8 (point))))
+       ((re-search-forward "^Type" nil t);PGP 6.*
+       (beginning-of-line 2)
+       (substring
+        (nth 2 (split-string
+                (buffer-substring (point)(progn (end-of-line) (point)))))
+        2))))))
+
+(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp)
+                                              start end recipients)
+  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+        (args
+         `("+encrypttoself=off +verbose=1" "+batchmode"
+           "+language=us" "-fate"
+           ,@(if recipients
+                 (mapcar (lambda (rcpt) (concat "\"" rcpt "\""))
+                         (append recipients
+                                 (if pgg-encrypt-for-me
+                                     (list pgg-pgp-user-id))))))))
+    (pgg-pgp-process-region start end nil pgg-pgp-program args)
+    (pgg-process-when-success nil)))
+
+(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp)
+                                              start end)
+  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+        (passphrase
+         (pgg-read-passphrase
+          (format "PGP passphrase for %s: " pgg-pgp-user-id)
+          (pgg-scheme-lookup-key scheme pgg-pgp-user-id 'encrypt)))
+        (args
+         '("+verbose=1" "+batchmode" "+language=us" "-f")))
+    (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
+    (pgg-process-when-success nil)))
+
+(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp)
+                                           start end &optional clearsign)
+  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+        (passphrase
+         (pgg-read-passphrase
+          (format "PGP passphrase for %s: " pgg-pgp-user-id)
+          (pgg-scheme-lookup-key scheme pgg-pgp-user-id 'sign)))
+        (args
+         (list (if clearsign "-fast" "-fbast")
+               "+verbose=1" "+language=us" "+batchmode"
+               "-u" pgg-pgp-user-id)))
+    (pgg-pgp-process-region start end passphrase pgg-pgp-program args)
+    (pgg-process-when-success
+      (goto-char (point-min))
+      (when (re-search-forward "^-+BEGIN PGP" nil t);XXX
+       (let ((packet
+              (cdr (assq 2 (pgg-parse-armor-region
+                            (progn (beginning-of-line 2)
+                                   (point))
+                            (point-max))))))
+         (if pgg-cache-passphrase
+             (pgg-add-passphrase-cache
+              (cdr (assq 'key-identifier packet))
+              passphrase)))))))
+
+(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp)
+                                             start end &optional signature)
+  (let* ((basename (expand-file-name "pgg" temporary-file-directory))
+        (orig-file (make-temp-name basename))
+        (args '("+verbose=1" "+batchmode" "+language=us"))
+        (orig-mode (default-file-modes)))
+    (unwind-protect
+       (progn
+         (set-default-file-modes 448)
+         (write-region-as-binary start end orig-file))
+      (set-default-file-modes orig-mode))
+    (when (stringp signature)
+      (copy-file signature (setq signature (concat orig-file ".asc")))
+      (setq args (append args (list signature orig-file))))
+    (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+    (delete-file orig-file)
+    (if signature (delete-file signature))
+    (pgg-process-when-success
+      (goto-char (point-min))
+      (let ((case-fold-search t))
+       (while (re-search-forward "^warning: " nil t)
+         (delete-region (match-beginning 0)
+                        (progn (beginning-of-line 2) (point)))))
+      (goto-char (point-min))
+      (when (re-search-forward "^\\.$" nil t)
+       (delete-region (point-min)
+                      (progn (beginning-of-line 2)
+                             (point)))))))
+
+(luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-pgp))
+  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+        (args
+         (list "+verbose=1" "+batchmode" "+language=us" "-kxaf"
+               (concat "\"" pgg-pgp-user-id "\""))))
+    (pgg-pgp-process-region (point)(point) nil pgg-pgp-program args)
+    (insert-buffer-substring pgg-output-buffer)))
+
+(luna-define-method pgg-scheme-snarf-keys-region ((scheme pgg-scheme-pgp)
+                                                 start end)
+  (let* ((pgg-pgp-user-id (or pgg-pgp-user-id pgg-default-user-id))
+        (basename (expand-file-name "pgg" temporary-file-directory))
+        (key-file (make-temp-name basename))
+        (args
+         (list "+verbose=1" "+batchmode" "+language=us" "-kaf"
+               key-file)))
+    (write-region-as-raw-text-CRLF start end key-file)
+    (pgg-pgp-process-region start end nil pgg-pgp-program args)
+    (delete-file key-file)
+    (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp)
+
+;;; pgg-pgp.el ends here
diff --git a/pgg-pgp5.el b/pgg-pgp5.el
new file mode 100644 (file)
index 0000000..83e8187
--- /dev/null
@@ -0,0 +1,253 @@
+;;; pgg-pgp5.el --- PGP 5.* support for PGG.
+
+;; Copyright (C) 1999,2000 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/11/02
+;; Keywords: PGP, OpenPGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(eval-when-compile (require 'pgg))
+
+(defgroup pgg-pgp5 ()
+  "PGP 5.* interface"
+  :group 'pgg)
+
+(defcustom pgg-pgp5-pgpe-program "pgpe"
+  "PGP 5.* 'pgpe' executable."
+  :group 'pgg-pgp5
+  :type 'string)
+
+(defcustom pgg-pgp5-pgps-program "pgps"
+  "PGP 5.* 'pgps' executable."
+  :group 'pgg-pgp5
+  :type 'string)
+
+(defcustom pgg-pgp5-pgpk-program "pgpk"
+  "PGP 5.* 'pgpk' executable."
+  :group 'pgg-pgp5
+  :type 'string)
+
+(defcustom pgg-pgp5-pgpv-program "pgpv"
+  "PGP 5.* 'pgpv' executable."
+  :group 'pgg-pgp5
+  :type 'string)
+
+(defcustom pgg-pgp5-shell-file-name "/bin/sh"
+  "File name to load inferior shells from.
+Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"."
+  :group 'pgg-pgp5
+  :type 'string)
+
+(defcustom pgg-pgp5-shell-command-switch "-c"
+  "Switch used to have the shell execute its command line argument."
+  :group 'pgg-pgp5
+  :type 'string)
+
+(defcustom pgg-pgp5-extra-args nil
+  "Extra arguments for every PGP 5.* invocation."
+  :group 'pgg-pgp5
+  :type 'string)
+
+(eval-and-compile
+  (luna-define-class pgg-scheme-pgp5 (pgg-scheme)))
+
+(defvar pgg-pgp5-user-id nil
+  "PGP 5.* ID of your default identity.")
+
+(defvar pgg-scheme-pgp5-instance nil)
+
+;;;###autoload
+(defun pgg-make-scheme-pgp5 ()
+  (or pgg-scheme-pgp5-instance
+      (setq pgg-scheme-pgp5-instance
+           (luna-make-entity 'pgg-scheme-pgp5))))
+
+(defun pgg-pgp5-process-region (start end passphrase program args)
+  (let* ((errors-file-name
+         (concat temporary-file-directory
+                 (make-temp-name "pgg-errors")))
+        (args
+         (append args
+                 pgg-pgp5-extra-args
+                 (list (concat "2>" errors-file-name))))
+        (shell-file-name pgg-pgp5-shell-file-name)
+        (shell-command-switch pgg-pgp5-shell-command-switch)
+        (process-environment process-environment)
+        (output-buffer pgg-output-buffer)
+        (errors-buffer pgg-errors-buffer)
+        (process-connection-type nil)
+        process status exit-status)
+    (with-current-buffer (get-buffer-create output-buffer)
+      (buffer-disable-undo)
+      (erase-buffer))
+    (when passphrase
+      (setenv "PGPPASSFD" "0"))
+    (unwind-protect
+       (progn
+         (as-binary-process
+          (setq process
+                (apply #'start-process-shell-command "*PGP*" output-buffer
+                       program args)))
+         (set-process-sentinel process #'ignore)
+         (when passphrase
+           (process-send-string process (concat passphrase "\n")))
+         (process-send-region process start end)
+         (process-send-eof process)
+         (while (eq 'run (process-status process))
+           (accept-process-output process 5))
+         (setq status (process-status process)
+               exit-status (process-exit-status process))
+         (delete-process process)
+         (with-current-buffer output-buffer
+           (pgg-convert-lbt-region (point-min)(point-max) 'LF)
+
+           (if (memq status '(stop signal))
+               (error "%s exited abnormally: '%s'" program exit-status))
+           (if (= 127 exit-status)
+               (error "%s could not be found" program))
+
+           (set-buffer (get-buffer-create errors-buffer))
+           (buffer-disable-undo)
+           (erase-buffer)
+           (insert-file-contents errors-file-name)))
+      (if (and process (eq 'run (process-status process)))
+         (interrupt-process process))
+      (condition-case nil
+         (delete-file errors-file-name)
+       (file-error nil)))))
+
+(luna-define-method pgg-scheme-lookup-key ((scheme pgg-scheme-pgp5)
+                                                 string &optional type)
+  (let ((args (list "+language=en" "-l" string)))
+    (with-current-buffer (get-buffer-create pgg-output-buffer)
+      (buffer-disable-undo)
+      (erase-buffer)
+      (apply #'call-process pgg-pgp5-pgpk-program nil t nil args)
+      (goto-char (point-min))
+      (when (re-search-forward "^sec" nil t)
+       (substring
+        (nth 2 (split-string
+                (buffer-substring (match-end 0)(progn (end-of-line)(point)))))
+        2)))))
+
+(luna-define-method pgg-scheme-encrypt-region ((scheme pgg-scheme-pgp5)
+                                              start end recipients)
+  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+        (args
+         `("+NoBatchInvalidKeys=off" "-fat" "+batchmode=1"
+           ,@(if recipients
+                 (apply #'append
+                        (mapcar (lambda (rcpt)
+                                  (list "-r"
+                                        (concat "\"" rcpt "\"")))
+                                (append recipients
+                                        (if pgg-encrypt-for-me
+                                            (list pgg-pgp5-user-id)))))))))
+    (pgg-pgp5-process-region start end nil pgg-pgp5-pgpe-program args)
+    (pgg-process-when-success nil)))
+
+(luna-define-method pgg-scheme-decrypt-region ((scheme pgg-scheme-pgp5)
+                                              start end)
+  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+        (passphrase
+         (pgg-read-passphrase
+          (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+          (pgg-scheme-lookup-key scheme pgg-pgp5-user-id 'encrypt)))
+        (args
+         '("+verbose=1" "+batchmode=1" "+language=us" "-f")))
+    (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgpv-program args)
+    (pgg-process-when-success nil)))
+
+(luna-define-method pgg-scheme-sign-region ((scheme pgg-scheme-pgp5)
+                                           start end &optional clearsign)
+  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+        (passphrase
+         (pgg-read-passphrase
+          (format "PGP passphrase for %s: " pgg-pgp5-user-id)
+          (pgg-scheme-lookup-key scheme pgg-pgp5-user-id 'sign)))
+        (args
+         (list (if clearsign "-fat" "-fbat")
+               "+verbose=1" "+language=us" "+batchmode=1"
+               "-u" pgg-pgp5-user-id)))
+    (pgg-pgp5-process-region start end passphrase pgg-pgp5-pgps-program args)
+    (pgg-process-when-success
+      (when (re-search-forward "^-+BEGIN PGP SIGNATURE" nil t);XXX
+       (let ((packet
+              (cdr (assq 2 (pgg-parse-armor-region
+                            (progn (beginning-of-line 2)
+                                   (point))
+                            (point-max))))))
+         (if pgg-cache-passphrase
+             (pgg-add-passphrase-cache
+              (cdr (assq 'key-identifier packet))
+              passphrase)))))))
+
+(luna-define-method pgg-scheme-verify-region ((scheme pgg-scheme-pgp5)
+                                             start end &optional signature)
+  (let* ((basename (expand-file-name "pgg" temporary-file-directory))
+        (orig-file (make-temp-name basename))
+        (args '("+verbose=1" "+batchmode=1" "+language=us"))
+        (orig-mode (default-file-modes)))
+    (unwind-protect
+       (progn
+         (set-default-file-modes 448)
+         (write-region-as-binary start end orig-file))
+      (set-default-file-modes orig-mode))
+    (when (stringp signature)
+      (copy-file signature (setq signature (concat orig-file ".asc")))
+      (setq args (append args (list signature))))
+    (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpv-program args)
+    (delete-file orig-file)
+    (if signature (delete-file signature))
+    (with-current-buffer pgg-errors-buffer
+      (goto-char (point-min))
+      (if (re-search-forward "^Good signature" nil t)
+         (progn
+           (set-buffer pgg-output-buffer)
+           (insert-buffer-substring pgg-errors-buffer)
+           t)
+       nil))))
+
+(luna-define-method pgg-scheme-insert-key ((scheme pgg-scheme-pgp5))
+  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+        (args
+         (list "+verbose=1" "+batchmode=1" "+language=us" "-x"
+               (concat "\"" pgg-pgp5-user-id "\""))))
+    (pgg-pgp5-process-region (point)(point) nil pgg-pgp5-pgpk-program args)
+    (insert-buffer-substring pgg-output-buffer)))
+
+(luna-define-method pgg-scheme-snarf-keys-region ((scheme pgg-scheme-pgp5)
+                                                 start end)
+  (let* ((pgg-pgp5-user-id (or pgg-pgp5-user-id pgg-default-user-id))
+        (basename (expand-file-name "pgg" temporary-file-directory))
+        (key-file (make-temp-name basename))
+        (args
+         (list "+verbose=1" "+batchmode=1" "+language=us" "-a"
+               key-file)))
+    (write-region-as-raw-text-CRLF start end key-file)
+    (pgg-pgp5-process-region start end nil pgg-pgp5-pgpk-program args)
+    (delete-file key-file)
+    (pgg-process-when-success nil)))
+
+(provide 'pgg-pgp5)
+
+;;; pgg-pgp5.el ends here
diff --git a/pgg.el b/pgg.el
new file mode 100644 (file)
index 0000000..6975eef
--- /dev/null
+++ b/pgg.el
@@ -0,0 +1,421 @@
+;;; pgg.el --- glue for the various PGP implementations.
+
+;; Copyright (C) 1999,2000 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/10/28
+;; Keywords: PGP
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+;; 
+
+;;; Code:
+
+(require 'calist)
+
+(eval-and-compile (require 'luna))
+
+(require 'pgg-def)
+(require 'pgg-parse)
+
+(eval-when-compile
+  (ignore-errors
+    (require 'w3)
+    (require 'url)))
+
+(in-calist-package 'pgg)
+
+(defun pgg-field-match-method-with-containment
+  (calist field-type field-value)
+  (let ((s-field (assq field-type calist)))
+    (cond ((null s-field)
+          (cons (cons field-type field-value) calist))
+         ((memq (cdr s-field) field-value)
+          calist))))
+
+(define-calist-field-match-method 'signature-version
+  #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'symmetric-key-algorithm
+  #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'public-key-algorithm
+  #'pgg-field-match-method-with-containment)
+
+(define-calist-field-match-method 'hash-algorithm
+  #'pgg-field-match-method-with-containment)
+
+(defvar pgg-verify-condition nil
+  "Condition-tree about which PGP implementation is used for verifying.")
+
+(defvar pgg-decrypt-condition nil
+  "Condition-tree about which PGP implementation is used for decrypting.")
+
+(ctree-set-calist-strictly
+ 'pgg-verify-condition
+ '((signature-version 3)(public-key-algorithm RSA)(hash-algorithm MD5)
+   (scheme . pgp)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-condition
+ '((public-key-algorithm RSA)(symmetric-key-algorithm IDEA)
+   (scheme . pgp)))
+
+(ctree-set-calist-strictly
+ 'pgg-verify-condition
+ '((signature-version 3 4)
+   (public-key-algorithm RSA ELG DSA)
+   (hash-algorithm MD5 SHA1 RIPEMD160)
+   (scheme . pgp5)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-condition
+ '((public-key-algorithm RSA ELG DSA)
+   (symmetric-key-algorithm 3DES CAST5 IDEA)
+   (scheme . pgp5)))
+
+(ctree-set-calist-strictly
+ 'pgg-verify-condition
+ '((signature-version 3 4)
+   (public-key-algorithm ELG-E DSA ELG)
+   (hash-algorithm MD5 SHA1 RIPEMD160)
+   (scheme . gpg)))
+
+(ctree-set-calist-strictly
+ 'pgg-decrypt-condition
+ '((public-key-algorithm ELG-E DSA ELG)
+   (symmetric-key-algorithm 3DES CAST5 BLOWFISH TWOFISH)
+   (scheme . gpg)))
+
+;;; @ definition of the implementation scheme
+;;;
+
+(eval-and-compile
+  (luna-define-class pgg-scheme ())
+
+  (luna-define-internal-accessors 'pgg-scheme))
+
+(luna-define-generic pgg-scheme-lookup-key (scheme string &optional type)
+  "Search keys associated with STRING.")
+
+(luna-define-generic pgg-scheme-encrypt-region (scheme start end recipients)
+  "Encrypt the current region between START and END.")
+
+(luna-define-generic pgg-scheme-decrypt-region (scheme start end)
+  "Decrypt the current region between START and END.")
+
+(luna-define-generic pgg-scheme-sign-region
+  (scheme start end &optional cleartext)
+  "Make detached signature from text between START and END.")
+
+(luna-define-generic pgg-scheme-verify-region
+  (scheme start end &optional signature)
+  "Verify region between START and END as the detached signature SIGNATURE.")
+
+(luna-define-generic pgg-scheme-insert-key (scheme)
+  "Insert public key at point.")
+
+(luna-define-generic pgg-scheme-snarf-keys-region (scheme start end)
+  "Add all public keys in region between START and END to the keyring.")
+
+;;; @ utility functions
+;;;
+
+(defvar pgg-fetch-key-function (function pgg-fetch-key-with-w3))
+
+(defmacro pgg-make-scheme (scheme)
+  `(progn
+     (require (intern (format "pgg-%s" ,scheme)))
+     (funcall (intern (format "pgg-make-scheme-%s"
+                             ,scheme)))))
+
+(put 'pgg-save-coding-system 'lisp-indent-function 2)
+
+(defmacro pgg-save-coding-system (start end &rest body)
+  `(if (interactive-p)
+       (let ((buffer (current-buffer)))
+        (with-temp-buffer
+          (let (buffer-undo-list)
+            (insert-buffer-substring buffer ,start ,end)
+            (encode-coding-region (point-min)(point-max)
+                                  buffer-file-coding-system)
+            (prog1 (save-excursion ,@body)
+              (push nil buffer-undo-list)
+              (ignore-errors (undo))))))
+     (save-restriction
+       (narrow-to-region ,start ,end)
+       ,@body)))
+
+(defun pgg-temp-buffer-show-function (buffer)
+  (let ((window (split-window-vertically)))
+    (set-window-buffer window buffer)
+    (shrink-window-if-larger-than-buffer window)))
+
+(defun pgg-display-output-buffer (start end status)
+  (if status
+      (progn
+       (delete-region start end)
+       (insert-buffer-substring pgg-output-buffer)
+       (decode-coding-region start (point) buffer-file-coding-system))
+    (let ((temp-buffer-show-function
+          (function pgg-temp-buffer-show-function)))
+      (with-output-to-temp-buffer pgg-echo-buffer
+       (set-buffer standard-output)
+       (insert-buffer-substring pgg-errors-buffer)))))
+
+(defvar pgg-passphrase-cache-expiry 16)
+(defvar pgg-passphrase-cache (make-vector 7 0))
+
+(defvar pgg-read-passphrase nil)
+(defun pgg-read-passphrase (prompt &optional key)
+  (if (not pgg-read-passphrase)
+      (if (functionp 'read-passwd)
+         (setq pgg-read-passphrase 'read-passwd)
+       (if (load "passwd" t)
+           (setq pgg-read-passphrase 'read-passwd)
+         (autoload 'ange-ftp-read-passwd "ange-ftp")
+         (setq pgg-read-passphrase 'ange-ftp-read-passwd))))
+  (or (and pgg-cache-passphrase
+          key (setq key (pgg-truncate-key-identifier key))
+          (symbol-value (intern-soft key pgg-passphrase-cache)))
+      (funcall pgg-read-passphrase prompt)))
+
+(defun pgg-add-passphrase-cache (key passphrase)
+  (setq key (pgg-truncate-key-identifier key))
+  (set (intern key pgg-passphrase-cache)
+       passphrase)
+  (run-at-time pgg-passphrase-cache-expiry nil
+              #'pgg-remove-passphrase-cache
+              key))
+
+(defun pgg-remove-passphrase-cache (key)
+  (let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache))))
+    (when passphrase
+      (fillarray passphrase ?_)
+      (unintern key pgg-passphrase-cache))))
+
+(defmacro pgg-convert-lbt-region (start end lbt)
+  `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
+     (goto-char ,start)
+     (case ,lbt
+       (CRLF
+       (while (progn
+                (end-of-line)
+                (> (marker-position pgg-conversion-end) (point)))
+         (insert "\r")
+         (forward-line 1)))
+       (LF
+       (while (re-search-forward "\r$" pgg-conversion-end t)
+         (replace-match ""))))))
+
+(put 'pgg-as-lbt 'lisp-indent-function 3)
+
+(defmacro pgg-as-lbt (start end lbt &rest body)
+  `(let ((inhibit-read-only t)
+        buffer-read-only
+        buffer-undo-list)
+     (pgg-convert-lbt-region ,start ,end ,lbt)
+     (let ((,end (point)))
+       ,@body)
+     (push nil buffer-undo-list)
+     (ignore-errors (undo))))
+
+(put 'pgg-process-when-success 'lisp-indent-function 0)
+
+(defmacro pgg-process-when-success (&rest body)
+  `(with-current-buffer pgg-output-buffer
+     (if (zerop (buffer-size)) nil ,@body t)))
+
+
+;;; @ interface functions
+;;;
+
+;;;###autoload
+(defun pgg-encrypt-region (start end rcpts)
+  "Encrypt the current region between START and END for RCPTS."
+  (interactive
+   (list (region-beginning)(region-end)
+        (split-string (read-string "Recipients: ") "[ \t,]+")))
+  (let* ((entity (pgg-make-scheme pgg-default-scheme))
+        (status
+         (pgg-save-coding-system start end
+           (pgg-scheme-encrypt-region entity (point-min)(point-max) rcpts))))
+    (when (interactive-p)
+      (pgg-display-output-buffer start end status))
+    status))
+
+;;;###autoload
+(defun pgg-decrypt-region (start end)
+  "Decrypt the current region between START and END."
+  (interactive "r")
+  (let* ((packet (cdr (assq 1 (pgg-parse-armor-region start end))))
+        (scheme
+         (or pgg-scheme
+             (cdr (assq 'scheme
+                        (progn
+                          (in-calist-package 'pgg)
+                          (ctree-match-calist pgg-decrypt-condition
+                                              packet))))
+             pgg-default-scheme))
+        (entity (pgg-make-scheme scheme))
+        (status
+         (pgg-save-coding-system start end
+           (pgg-scheme-decrypt-region entity (point-min)(point-max)))))
+    (when (interactive-p)
+      (pgg-display-output-buffer start end status))
+    status))
+
+;;;###autoload
+(defun pgg-sign-region (start end &optional cleartext)
+  "Make the signature from text between START and END.
+If the optional 3rd argument CLEARTEXT is non-nil, it does not create
+a detached signature."
+  (interactive "r")
+  (let* ((entity (pgg-make-scheme pgg-default-scheme))
+        (status (pgg-save-coding-system start end
+                  (pgg-scheme-sign-region entity (point-min)(point-max)
+                                          (or (interactive-p) cleartext)))))
+    (when (interactive-p)
+      (pgg-display-output-buffer start end status))
+    status))
+
+;;;###autoload
+(defun pgg-verify-region (start end &optional signature fetch)
+  "Verify the current region between START and END.
+If the optional 3rd argument SIGNATURE is non-nil, it is treated as
+the detached signature of the current region.
+
+If the optional 4th argument FETCH is non-nil, we attempt to fetch the
+signer's public key from `pgg-default-keyserver-address'."
+  (interactive "r")
+  (let* ((packet
+         (if (null signature) nil
+           (with-temp-buffer
+             (buffer-disable-undo)
+             (set-buffer-multibyte nil)
+             (insert-file-contents signature)
+             (cdr (assq 2 (pgg-decode-armor-region
+                           (point-min)(point-max)))))))
+        (scheme
+         (or pgg-scheme
+             (cdr (assq 'scheme
+                        (progn
+                          (in-calist-package 'pgg)
+                          (ctree-match-calist pgg-verify-condition
+                                              packet))))
+             pgg-default-scheme))
+        (entity (pgg-make-scheme scheme))
+        (key (cdr (assq 'key-identifier packet)))
+        status keyserver)
+    (and (stringp key)
+        (setq key (concat "0x" (pgg-truncate-key-identifier key)))
+        (null (let ((pgg-scheme scheme))
+                (pgg-lookup-key key)))
+        (or fetch (interactive-p))
+        (y-or-n-p (format "Key %s not found; attempt to fetch? " key))
+        (setq keyserver
+              (or (cdr (assq 'preferred-key-server packet))
+                  pgg-default-keyserver-address))
+        (pgg-fetch-key keyserver key))
+    (setq status (pgg-save-coding-system start end
+                  (pgg-scheme-verify-region entity (point-min)(point-max)
+                                            signature)))
+    (when (interactive-p)
+      (let ((temp-buffer-show-function
+            (function pgg-temp-buffer-show-function)))
+       (with-output-to-temp-buffer pgg-echo-buffer
+         (set-buffer standard-output)
+         (insert-buffer-substring (if status pgg-output-buffer
+                                    pgg-errors-buffer)))))
+    status))
+
+;;;###autoload
+(defun pgg-insert-key ()
+  "Insert the ASCII armored public key."
+  (interactive)
+  (let ((entity (pgg-make-scheme (or pgg-scheme pgg-default-scheme))))
+    (pgg-scheme-insert-key entity)))
+
+;;;###autoload
+(defun pgg-snarf-keys-region (start end)
+  "Import public keys in the current region between START and END."
+  (interactive "r")
+  (let ((entity (pgg-make-scheme (or pgg-scheme pgg-default-scheme))))
+    (pgg-save-coding-system start end
+      (pgg-scheme-snarf-keys-region entity start end))))
+
+(defun pgg-lookup-key (string &optional type)
+  (let ((entity (pgg-make-scheme (or pgg-scheme pgg-default-scheme))))
+    (pgg-scheme-lookup-key entity string type)))
+
+(defvar pgg-insert-url-function  (function pgg-insert-url-with-w3))
+
+(defun pgg-insert-url-with-w3 (url)
+  (require 'w3)
+  (require 'url)
+  (let (buffer-file-name)
+    (url-insert-file-contents url)))
+
+(defvar pgg-insert-url-extra-arguments nil)
+(defvar pgg-insert-url-program nil)
+
+(defun pgg-insert-url-with-program (url)
+  (let ((args (copy-sequence pgg-insert-url-extra-arguments))
+       process)
+    (insert
+     (with-temp-buffer
+       (setq process
+            (apply #'start-process " *PGG url*" (current-buffer)
+                   pgg-insert-url-program (nconc args (list url))))
+       (set-process-sentinel process #'ignore)
+       (while (eq 'run (process-status process))
+        (accept-process-output process 5))
+       (delete-process process)
+       (if (and process (eq 'run (process-status process)))
+          (interrupt-process process))
+       (buffer-string)))))
+
+(defun pgg-fetch-key (keyserver key)
+  "Attempt to fetch a KEY from KEYSERVER for addition to PGP or GnuPG keyring."
+  (with-current-buffer (get-buffer-create pgg-output-buffer)
+    (buffer-disable-undo)
+    (erase-buffer)
+    (let ((proto (if (string-match "^[a-zA-Z\\+\\.\\\\-]+:" keyserver)
+                    (substring keyserver 0 (1- (match-end 0))))))
+      (save-excursion
+       (funcall pgg-insert-url-function
+                (if proto keyserver
+                  (format "http://%s:11371/pks/lookup?op=get&search=%s"
+                          keyserver key))))
+      (when (re-search-forward "^-+BEGIN" nil 'last)
+       (delete-region (point-min) (match-beginning 0))
+       (when (re-search-forward "^-+END" nil t)
+         (delete-region (progn (end-of-line) (point))
+                        (point-max)))
+       (insert "\n")
+       (with-temp-buffer
+         (insert-buffer-substring pgg-output-buffer)
+         (pgg-snarf-keys-region (point-min)(point-max)))))))
+
+
+(provide 'pgg)
+
+;;; pgg.el ends here
diff --git a/postpet.el b/postpet.el
new file mode 100644 (file)
index 0000000..f8730bb
--- /dev/null
@@ -0,0 +1,152 @@
+;;; postpet.el --- Postpet support for GNU Emacs
+
+;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
+
+;; Author: Tanaka Akira  <akr@jaist.ac.jp>
+;; Keywords: Postpet, MIME, multimedia, mail, news
+
+;; This file is part of SEMI (Sample of Elastic MIME Interfaces).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(require 'alist)
+
+(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))
+
+;;;###autoload
+(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)))
+
+;;;###autoload
+(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))))
+
+
+;;; @ end
+;;;
+
+(provide 'postpet)
+
+;;; postpet.el ends here
index 62baefd..483fd1b 100644 (file)
@@ -1,6 +1,6 @@
 ;;; semi-def.el --- definition module for SEMI -*- coding: iso-8859-4; -*-
 
 ;;; semi-def.el --- definition module for SEMI -*- 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 <tomo@m17n.org>
 ;; Keywords: definition, MIME, multimedia, mail, news
 
 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: definition, MIME, multimedia, mail, news
@@ -30,7 +30,7 @@
 
 (require 'custom)
 
 
 (require 'custom)
 
-(defconst mime-user-interface-product ["SEMI" (1 13 7) "Awazu"]
+(defconst mime-user-interface-product ["REMI" (1 14 3) "Matsudai"]
   "Product name, version number and code name of MIME-kernel package.")
 
 (autoload 'mule-caesar-region "mule-caesar"
   "Product name, version number and code name of MIME-kernel package.")
 
 (autoload 'mule-caesar-region "mule-caesar"
 
 (defsubst mime-add-button (from to function &optional data)
   "Create a button between FROM and TO with callback FUNCTION and DATA."
 
 (defsubst mime-add-button (from to function &optional data)
   "Create a button between FROM and TO with callback FUNCTION and DATA."
-  (let ((overlay (make-overlay from to)))
-    (and mime-button-face
-        (overlay-put overlay 'face mime-button-face))
-    (and mime-button-mouse-face
-        (overlay-put overlay 'mouse-face mime-button-mouse-face))
-    (add-text-properties from to (list 'mime-button-callback function))
-    (and data
-        (add-text-properties from to (list 'mime-button-data data)))
-    ))
+  (and mime-button-face
+       (put-text-property from to 'face mime-button-face))
+  (and mime-button-mouse-face
+       (put-text-property from to 'mouse-face mime-button-mouse-face))
+  (put-text-property from to 'mime-button-callback function)
+  (and data
+       (put-text-property from to 'mime-button-data data))
+  )
 
 (defsubst mime-insert-button (string function &optional data)
   "Insert STRING as button with callback FUNCTION and DATA."
 
 (defsubst mime-insert-button (string function &optional data)
   "Insert STRING as button with callback FUNCTION and DATA."
   )
 
 
   )
 
 
-;;; @ 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)
-
-
 ;;; @ Other Utility
 ;;;
 
 ;;; @ Other Utility
 ;;;
 
index 9928d1e..ecdf2ae 100644 (file)
@@ -1,8 +1,8 @@
 ;;; semi-setup.el --- setup file for MIME-View.
 
 ;;; 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 <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word
 
 ;; This file is part of SEMI (Setting for Emacs MIME Interfaces).
 ;; 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
 (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
   "*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
 
 ;; 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
   "*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
 
 
 ;; 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
   "*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")
          '((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
 ;;;
 
 ;;; @ 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
 
 
 ;;; @@ variables
@@ -184,7 +197,7 @@ it is used as hook to set."
 ;;; @ for mu-cite
 ;;;
 
 ;;; @ for mu-cite
 ;;;
 
-(add-hook 'mu-cite/pre-cite-hook 'eword-decode-header)
+;; (add-hook 'mu-cite/pre-cite-hook 'eword-decode-header)
 
 
 ;;; @ end
 
 
 ;;; @ end
index f06f53c..6bd81c3 100644 (file)
@@ -1,13 +1,12 @@
 ;;; signature.el --- a signature utility for GNU Emacs
 
 ;;; 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 <morioka@jaist.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
 ;;         OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
 ;;         OKABE Yasuo <okabe@kudpc.kyoto-u.ac.jp>
-;;         Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
-;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;;         Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+;; Maintainer: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
 ;; Created: 1994/7/11
 ;; 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).
 ;; Keywords: mail, news, signature
 
 ;; This file is part of SEMI (SEMI is Emacs MIME Interfaces).
diff --git a/smime.el b/smime.el
new file mode 100644 (file)
index 0000000..d01ee0d
--- /dev/null
+++ b/smime.el
@@ -0,0 +1,320 @@
+;;; smime.el --- S/MIME interface.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/12/08
+;; Keywords: S/MIME, OpenSSL
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+
+;;    This module is based on
+
+;;      [SMIMEV3] RFC 2633: "S/MIME Version 3 Message Specification"
+;;          by Crocker, D., Flanigan, B., Hoffman, P., Housley, R.,
+;;          Pawling, J. and Schaad, J. (1999/06)
+
+;;      [SMIMEV2] RFC 2311: "S/MIME Version 2 Message Specification"
+;;          by Dusse, S., Hoffman, P., Ramsdell, B., Lundblade, L.
+;;          and L. Repka. (1998/03)
+
+;;; Code:
+
+(require 'path-util)
+(eval-when-compile (require 'static))
+
+(defgroup smime ()
+  "S/MIME interface"
+  :group 'mime)
+
+(defcustom smime-program "smime" 
+  "The S/MIME executable."
+  :group 'smime
+  :type 'string)
+
+(defcustom smime-shell-file-name "/bin/sh"
+  "File name to load inferior shells from.  Bourne shell or its equivalent
+\(not tcsh) is needed for \"2>\"."
+  :group 'smime
+  :type 'string)
+
+(defcustom smime-shell-command-switch "-c"
+  "Switch used to have the shell execute its command line argument."
+  :group 'smime
+  :type 'string)
+
+(defcustom smime-x509-program
+  (let ((file (exec-installed-p "openssl")))
+    (and file (list file "x509" "-noout")))
+  "External program for x509 parser."
+  :group 'smime
+  :type 'string)
+
+(defcustom smime-cache-passphrase t
+  "Cache passphrase."
+  :group 'smime
+  :type 'boolean)
+
+(defcustom smime-certificate-directory "~/.w3/certs"
+  "Certificate directory."
+  :group 'smime
+  :type 'directory)
+
+(defcustom smime-public-key-file nil
+  "Public key file."
+  :group 'smime
+  :type 'boolean)
+
+(defcustom smime-private-key-file nil
+  "Private key file."
+  :group 'smime
+  :type 'boolean)
+
+(defvar smime-errors-buffer " *S/MIME errors*")
+(defvar smime-output-buffer " *S/MIME output*")
+
+;;; @ utility functions
+;;;
+(put 'smime-process-when-success 'lisp-indent-function 0)
+
+(defmacro smime-process-when-success (&rest body)
+  `(with-current-buffer smime-output-buffer
+     (if (zerop (buffer-size)) nil ,@body t)))
+
+(defvar smime-passphrase-cache-expiry 16)
+(defvar smime-passphrase-cache (make-vector 7 0))
+
+(defvar smime-read-passphrase nil)
+(defun smime-read-passphrase (prompt &optional key)
+  (if (not smime-read-passphrase)
+      (if (functionp 'read-passwd)
+         (setq smime-read-passphrase 'read-passwd)
+       (if (load "passwd" t)
+           (setq smime-read-passphrase 'read-passwd)
+         (autoload 'ange-ftp-read-passwd "ange-ftp")
+         (setq smime-read-passphrase 'ange-ftp-read-passwd))))
+  (or (and smime-cache-passphrase
+          (symbol-value (intern-soft key smime-passphrase-cache)))
+      (funcall smime-read-passphrase prompt)))
+
+(defun smime-add-passphrase-cache (key passphrase)
+  (set (intern key smime-passphrase-cache)
+       passphrase)
+  (run-at-time smime-passphrase-cache-expiry nil
+              #'smime-remove-passphrase-cache
+              key))
+
+(defun smime-remove-passphrase-cache (key)
+  (let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))
+    (when passphrase
+      (fillarray passphrase ?_)
+      (unintern key smime-passphrase-cache))))
+
+(defsubst smime-parse-attribute (string)
+  (delq nil (mapcar 
+            (lambda (attr)
+              (if (string-match "=" attr)
+                  (cons (intern (substring attr 0 (match-beginning 0)))
+                        (substring attr (match-end 0)))
+                nil))
+            (split-string string "/"))))
+
+(defsubst smime-query-signer (start end)
+  (smime-process-region start end smime-program (list "-qs"))
+  (with-current-buffer smime-output-buffer
+    (if (zerop (buffer-size)) nil
+      (goto-char (point-min))
+      (when (re-search-forward "^/" nil t)
+       (smime-parse-attribute 
+        (buffer-substring (point) (progn (end-of-line)(point)))))
+      )))
+
+(defsubst smime-x509-hash (cert-file)
+  (with-current-buffer (get-buffer-create smime-output-buffer)
+    (buffer-disable-undo)
+    (erase-buffer)
+    (apply #'call-process (car smime-x509-program) nil t nil 
+          (append (cdr smime-x509-program) 
+                  (list "-hash" "-in" cert-file)))
+    (if (zerop (buffer-size)) nil
+      (buffer-substring (point-min) (1- (point-max))))))
+
+(defsubst smime-x509-subject (cert-file)
+  (with-current-buffer (get-buffer-create smime-output-buffer)
+    (buffer-disable-undo)
+    (erase-buffer)
+    (apply #'call-process (car smime-x509-program) nil t nil 
+          (append (cdr smime-x509-program)
+                  (list "-subject" "-in" cert-file)))
+    (if (zerop (buffer-size)) nil
+      (goto-char (point-min))
+      (when (re-search-forward "^subject=" nil t)
+       (smime-parse-attribute
+        (buffer-substring (point)(progn (end-of-line)(point))))))))
+
+(defsubst smime-find-certificate (attr)
+  (let ((files
+        (and (file-directory-p smime-certificate-directory)
+             (delq nil (mapcar (lambda (file) 
+                                 (if (file-directory-p file) nil
+                                   file))
+                               (directory-files 
+                                smime-certificate-directory
+                                'full))))))
+    (catch 'found
+      (while files
+       (if (or (string-equal 
+                (cdr (assq 'CN (smime-x509-subject (car files))))
+                (cdr (assq 'CN attr)))
+               (string-equal
+                (cdr (assq 'Email (smime-x509-subject (car files))))
+                (cdr (assq 'Email attr))))
+           (throw 'found (car files)))
+       (pop files)))))
+
+(defun smime-process-region (start end program args)
+  (let* ((errors-file-name
+         (concat temporary-file-directory 
+                 (make-temp-name "smime-errors")))
+        (args (append args (list (concat "2>" errors-file-name))))
+        (shell-file-name smime-shell-file-name)
+        (shell-command-switch smime-shell-command-switch)
+        (process-connection-type nil)
+        process status exit-status)
+    (with-current-buffer (get-buffer-create smime-output-buffer)
+      (buffer-disable-undo)
+      (erase-buffer))
+    (as-binary-process
+     (setq process
+          (apply #'start-process-shell-command "*S/MIME*"
+                 smime-output-buffer program args)))
+    (set-process-sentinel process 'ignore)
+    (process-send-region process start end)
+    (process-send-eof process)
+    (while (eq 'run (process-status process))
+      (accept-process-output process 5))
+    (setq status (process-status process)
+         exit-status (process-exit-status process))
+    (delete-process process)
+    (with-current-buffer smime-output-buffer
+      (goto-char (point-min))
+      (while (re-search-forward "\r$" (point-max) t)
+       (replace-match ""))
+
+      (if (memq status '(stop signal))
+         (error "%s exited abnormally: '%s'" program exit-status))
+      (if (= 127 exit-status)
+         (error "%s could not be found" program))
+
+      (set-buffer (get-buffer-create smime-errors-buffer))
+      (buffer-disable-undo)
+      (erase-buffer)
+      (insert-file-contents errors-file-name)
+      (delete-file errors-file-name)
+      
+      (if (and process (eq 'run (process-status process)))
+         (interrupt-process process))
+      )
+    ))
+
+;;; @ interface functions
+;;;
+
+;;;###autoload
+(defun smime-encrypt-region (start end)
+  "Encrypt the current region between START and END."
+  (let* ((key-file
+         (or smime-private-key-file
+             (expand-file-name (read-file-name "Public key file: "))))
+        (args (list "-e" key-file)))
+    (smime-process-region start end smime-program args)
+    (smime-process-when-success 
+      (goto-char (point-min))
+      (delete-region (point-min) (progn
+                                  (re-search-forward "^$" nil t)
+                                  (1+ (point)))))))
+
+;;;###autoload
+(defun smime-decrypt-region (start end)
+  "Decrypt the current region between START and END."
+  (let* ((key-file
+         (or smime-private-key-file
+             (expand-file-name (read-file-name "Private key file: "))))
+        (hash (smime-x509-hash key-file))
+        (passphrase (smime-read-passphrase 
+                     (format "S/MIME passphrase for %s: " hash)
+                     hash))
+        (args (list "-d" key-file passphrase)))
+    (smime-process-region start end smime-program args)
+    (smime-process-when-success 
+      (when smime-cache-passphrase
+       (smime-add-passphrase-cache hash passphrase)))))
+        
+;;;###autoload
+(defun smime-sign-region (start end &optional cleartext)
+  "Make the signature from text between START and END.
+If the optional 3rd argument CLEARTEXT is non-nil, it does not create
+a detached signature."
+  (let* ((key-file
+         (or smime-private-key-file
+             (expand-file-name (read-file-name "Private key file: "))))
+        (hash (smime-x509-hash key-file))
+        (passphrase (smime-read-passphrase 
+                     (format "S/MIME passphrase for %s: " hash)
+                     hash))
+        (args (list "-ds" key-file passphrase)))
+    (smime-process-region start end smime-program args)
+    (smime-process-when-success 
+      (goto-char (point-min))
+      (delete-region (point-min) (progn
+                                  (re-search-forward "^$" nil t)
+                                  (1+ (point))))
+      (when smime-cache-passphrase
+       (smime-add-passphrase-cache hash passphrase)))))
+
+;;;###autoload
+(defun smime-verify-region (start end signature)
+  "Verify the current region between START and END.
+If the optional 3rd argument SIGNATURE is non-nil, it is treated as
+the detached signature of the current region."
+  (let* ((basename (expand-file-name "smime" temporary-file-directory))
+        (orig-file (make-temp-name basename))
+        (orig-mode (default-file-modes)))
+    (unwind-protect
+       (progn
+         (set-default-file-modes 448)
+         (write-region-as-binary start end orig-file))
+      (set-default-file-modes orig-mode))
+    (with-temp-buffer
+      (insert-file-contents-as-binary signature)
+      (goto-char (point-max))
+      (insert-file-contents-as-binary
+       (or (smime-find-certificate 
+           (smime-query-signer (point-min)(point-max)))
+          (expand-file-name 
+           (read-file-name "Certificate file: "))))
+      (smime-process-region (point-min)(point-max) smime-program 
+                           (list "-dv" orig-file)))
+    (smime-process-when-success nil)))
+
+(provide 'smime)
+
+;;; smime.el ends here