From: tomo Date: Wed, 2 Jul 1997 16:20:23 +0000 (+0000) Subject: This commit was manufactured by cvs2svn to create branch 'unlabeled-0.24.2'. X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=842181580c6c10b8e0f04c1430a4ab9030285c15;p=elisp%2Fsemi.git This commit was manufactured by cvs2svn to create branch 'unlabeled-0.24.2'. --- diff --git a/ChangeLog b/ChangeLog deleted file mode 100644 index 7fb94aa..0000000 --- a/ChangeLog +++ /dev/null @@ -1,1692 +0,0 @@ -1997-06-27 MORIOKA Tomohiko - - * mailcap.el: New file. - -1997-06-26 MORIOKA Tomohiko - - * eword-encode.el (eword-field-encoding-method-alist): Add - "Message-ID" as ignored. - -1997-06-26 MORIOKA Tomohiko - - * eword-encode.el (tm-eword::encode-string-1): avoid infinite loop - caused by long non-encoded-word element. (cf. [tm-en:1356]) - -1997-06-24 MORIOKA Tomohiko - - * mime-view.el: `mime-preview/display-message/partial' -> - `mime-view-insert-message/partial-button'. - - * mime-view.el (mime-preview/display-message/partial): Use - `mime-add-button' again. - -1997-06-21 MORIOKA Tomohiko - - * eword-encode.el: `tm-eword::lc-words-to-words' -> - `eword-encode-charset-words-to-words'. - - * eword-encode.el (tm-eword::lc-words-to-words): New - implementation; function `tm-eword::parse-word' was abolished. - -1997-06-21 MORIOKA Tomohiko - - * eword-encode.el: `tm-eword::split-to-lc-words' -> - `eword-encode-divide-into-charset-words'. - - * eword-encode.el: Function `tm-eword::parse-lc-word' was - abolished. - (tm-eword::split-to-lc-words): New implementation. - -1997-06-21 MORIOKA Tomohiko - - * eword-encode.el: `tm-eword::char-type' -> - `eword-encode-char-type'. - - * eword-encode.el: `tm-eword::encode-encoded-text' -> - `eword-encode-text' - - * mime-view.el (mime-view-insert-entity-button, - mime-preview/display-message/partial): Use `mime-insert-button'. - - (mime-view-setup-buffers): Enclose codes to display preview-buffer - by `(let ((inhibit-read-only t)) ...)'. - - * mime-def.el (mime-insert-button): New inline function. - - * mime-def.el (mime-add-button): Argument `func' was renamed to - `function'; Use overlay for `mime-button-mouse-face'. - - -1997-06-19 MORIOKA Tomohiko - - * SEMI: Version 0.92 was released. - - * mime-view.el, mime-play.el, mime-partial.el: - `mime-article/decode-' -> `mime-display-'. - - * mime-play.el (mime-display-caesar): fixed. - -1997-06-18 MORIOKA Tomohiko - - * eword-decode.el (eword-decode-structured-field-body): fixed. - -1997-06-16 MORIOKA Tomohiko - - * eword-decode.el (eword-lexical-analyze-cache): New variable. - (eword-lexical-analyze-cache-max): New variable. - (eword-analyze-quoted-string): New function. - (eword-analyze-comment): New function. - (eword-analyze-encoded-word): New function. - (eword-lexical-analyze-internal): New function. - (eword-lexical-analyze): New function. - (eword-decode-structured-field-body): New function. - (eword-decode-unstructured-field-body): New function. - (eword-extract-address-components): New function. - -1997-06-11 Steven L Baur - - * eword-encode.el (tm-eword::char-type, tm-eword::encode-rwl, - tm-eword::encode-rwl): Clean up Ebola - infection. (cf.[tm-en:1346],[xemacs-beta:9333]) - - -1997-05-30 MORIOKA Tomohiko - - * SEMI: Version 0.91 was released. - -Wed May 28 13:16:15 1997 MORIOKA Tomohiko - - * mime-view.el (mime-view-define-keymap): fixed problem about - [tab], [delete] and [backspace] keys. - -Tue May 27 03:26:23 1997 MORIOKA Tomohiko - - * mime-edit.el (mime-edit-sign-pgp-elkins): Enclose PGP-processing - by `as-binary-process'. - -1997-05-23 Steven L Baur - - * mime-view.el (mime-acting-condition): Add image/png - mime type. (cf.[tm-en:1334]) - - * mime-image.el: Add image/png mime type. (cf.[tm-en:1334]) - - * mime-edit.el (mime-file-types): Add png handling. - (mime-content-types): Ditto. (cf.[tm-en:1334]) - -Fri May 23 22:13:47 1997 MORIOKA Tomohiko - - * mime-view.el (mime-view-define-keymap): Doesn't bind - `beginning-of-buffer' and `end-of-buffer' for "<" and ">" keys. - - -1997-05-15 MORIOKA Tomohiko - - * SEMI: Version 0.88 was released. - -Thu May 15 06:05:13 1997 MORIOKA Tomohiko - - * Makefile (tar): New implementation. - -Tue May 13 14:32:39 1997 MORIOKA Tomohiko - - * SEMI-MK (config-semi): fixed. - - * SEMI-CFG: Add site-lisp/apel/ even if LISPDIR is specified. - -Tue May 13 14:11:48 1997 MORIOKA Tomohiko - - * README.en: Add `LISPDIR'. - - * Makefile (LISPDIR): New variable. - - * SEMI-CFG: Setting for load-path is modified. - -Mon May 12 12:30:42 1997 MORIOKA Tomohiko - - * mime-tar.el, mime-play.el, mime-pgp.el, mime-file.el, - mime-view.el: `mime/content-decoding-condition' -> - `mime-acting-condition'. - - -1997-05-09 MORIOKA Tomohiko - - * SEMI: Version 0.87 was released. - -Fri May 9 04:19:21 1997 MORIOKA Tomohiko - - * mime-tar.el: `mime-viewer/uuencode-encoding-name-list' -> - `mime-view-uuencode-encoding-name-list'. - -Fri May 9 03:07:02 1997 MORIOKA Tomohiko - - * mime-edit.el: Use "text/x-rot13-47-48" instead of - "text/x-rot13-47". - - * mime-view.el (mime/content-decoding-condition): Add - "text/x-rot13-47-48". - -Fri May 9 01:26:13 1997 MORIOKA Tomohiko - - * mime-edit.el (mime-edit-normalize-body): Use - `mule-caesar-region' instead of `caesar-region'. - - * mime-play.el (mime-display-caesar): Use `mule-caesar-region' - instead of `caesar-region'. - - * mime-def.el: Add autoload for mule-caesar.el. - - * mime-def.el: Function caesar-region was abolished. - -Thu May 8 23:31:45 1997 MORIOKA Tomohiko - - * mime-play.el, mime-edit.el, mime-def.el: `tm:caesar-region' -> - `caesar-region'. - -Thu May 8 22:37:47 1997 MORIOKA Tomohiko - - * mime-view.el (mime-view-define-keymap): Use - `set-keymap-default-binding' for XEmacs. - -Wed May 7 10:04:36 1997 MORIOKA Tomohiko - - * mime-play.el (mime-display-caesar): Don't use - `buffer-substring'. - - * mime-play.el (mime-display-caesar): Use `view-buffer' instead of - `view-mode-enter'. - -Wed May 7 09:37:54 1997 MORIOKA Tomohiko - - * mime-play.el: Don't require `view'. - - Constant `mime-view-text/plain-mode-map' was abolished. - - Function `mime-view-text/plain-mode' and - `mime-view-text/plain-exit' were abolished. - - (mime-display-caesar): Use `view-mode-enter mother' instead of - `mime-view-text/plain-mode'. - -Wed May 7 09:33:48 1997 MORIOKA Tomohiko - - * mime-play.el, mime-view.el (mime/content-decoding-condition): - `mime-article/decode-caesar' -> `mime-display-caesar'. - -Wed May 7 05:49:03 1997 MORIOKA Tomohiko - - * mime-view.el (mime-view-cut-header): fixed. (cf.[tm-ja:2386]) - - -1997-04-30 MORIOKA Tomohiko - - * SEMI: Version 0.83 was released. - -Sat Apr 5 06:20:34 1997 MORIOKA Tomohiko - - * mime-def.el: Overlay is required by emu. - -Thu Apr 3 18:09:35 1997 MORIOKA Tomohiko - - * mime-image.el, mime-view.el, mime-text.el: - `mime-preview/filter-' -> `mime-view-filter-'. - - * mime-view.el: `mime-preview/get-original-major-mode' -> - `mime-view-get-original-major-mode'. - -Thu Mar 27 22:16:53 1997 MORIOKA Tomohiko - - * mime-view.el (mime-view-mode): Hide mime-echo window. - - * mime-view.el: Function `mime-hide-echo-buffer' was moved from - mime-play.el. - - * mime-play.el: Function `mime-hide-echo-buffer' was moved to - mime-view.el. - - * mime-play.el (mime-hide-echo-buffer): New inline function. - - * mime-play.el (mime-echo-window-height): New variable. - -Thu Mar 27 21:48:32 1997 MORIOKA Tomohiko - - * mime-edit.el (mime-edit-content-end): Abolish unused local - variable `beg'. - -Thu Mar 27 21:45:49 1997 MORIOKA Tomohiko - - * mime-view.el (mime-view-follow-current-entity): Abolish unused - local variable `rc'. - -Thu Mar 27 21:42:08 1997 MORIOKA Tomohiko - - * eword-encode.el (eword-encode-field): Intern down-cased - field-name and use `memq' instead of `member' to detect a field is - address-list or not. - -Thu Mar 27 21:17:25 1997 MORIOKA Tomohiko - - * mime-pgp.el (mime-article/check-pgp-signature): Use - `insert-buffer-substring'. - -Thu Mar 27 20:59:00 1997 MORIOKA Tomohiko - - * mime-pgp.el (mime-article/check-pgp-signature): - `mime-article/show-output-buffer' -> `mime-show-echo-buffer'. - - * mime-play.el: `mime-article/show-output-buffer' -> - `mime-show-echo-buffer'. - - * mime-play.el: `mime/output-buffer-window-is-shared-with-bbdb' -> - `mime-echo-window-is-shared-with-bbdb'. - -Thu Mar 27 20:47:14 1997 MORIOKA Tomohiko - - * mime-play.el: Variable - `mime/output-buffer-window-is-shared-with-bbdb' was moved from - mime-def.el. - - * mime-def.el: Variable - `mime/output-buffer-window-is-shared-with-bbdb' was moved to - mime-play.el. - -Thu Mar 27 20:40:57 1997 MORIOKA Tomohiko - - * mime-view.el (mime-view-mode): `mime/output-buffer-name' -> - `mime-echo-buffer-name'. - - * mime-play.el: `mime/output-buffer-name' -> - `mime-echo-buffer-name'. - - * mime-pgp.el (mime-article/check-pgp-signature): - `mime/output-buffer-name' -> `mime-echo-buffer-name'. - - * mime-def.el (mime-echo-buffer-name): Renamed from - `mime/output-buffer-name'. - -Fri Mar 21 17:55:10 1997 MORIOKA Tomohiko - - * mime-edit.el (mime-edit-content-end): Abolish unused local - variable `top'. - - * mime-view.el: Function `mime-view-make-preview-buffer' was - abolished. - - * mime-view.el: `mime-view-setup-buffer' -> - `mime-view-setup-buffers'. - - -1997-03-18 MORIOKA Tomohiko - - * MU: Version 0.40.2 was released. - * SEMI: Version 0.75 was released. - -Tue Mar 18 15:28:25 1997 MORIOKA Tomohiko - - * mime-edit.el (mime-edit-translate-single-part-tag): Add - DOC-string. - -Tue Mar 18 15:21:28 1997 MORIOKA Tomohiko - - * mime-view.el: `mime::preview/original-major-mode' -> - `mime-view-original-major-mode'. - -Tue Mar 18 15:17:48 1997 MORIOKA Tomohiko - - * mime-play.el, mime-view.el: `mime::preview/mother-buffer' -> - `mime-mother-buffer'. - -Tue Mar 18 15:12:10 1997 MORIOKA Tomohiko - - * mime-text.el, mime-play.el, mime-edit.el, mime-view.el: - `mime::preview/article-buffer' -> `mime-raw-buffer'. - -Tue Mar 18 14:47:23 1997 MORIOKA Tomohiko - - * mime-tar.el, mime-play.el, mime-pgp.el, mime-bbdb.el, - mime-view.el: `mime::article/preview-buffer' -> - `mime-view-buffer'. - -Tue Mar 18 14:32:53 1997 MORIOKA Tomohiko - - * mime-view.el: Structure `mime::preview-content-info' was - abolished. - - (mime-view-setup-buffer): Return only - `mime::article/preview-buffer'. - - (mime-view-make-preview-buffer): Don't generate - preview-content-list; Return only `mime::article/preview-buffer'. - - (mime-view-display-entity): Don't create - `mime::preview-content-info'. - - (mime-view-mode): Don't set for `mime::preview/content-list'. - -Tue Mar 18 13:56:18 1997 MORIOKA Tomohiko - - * mime-partial.el (mime-combine-message/partials-automatically): - Don't use preview-content-list. - -Tue Mar 18 13:06:09 1997 MORIOKA Tomohiko - - * semi-setup.el: Don't require mime-partial; It is autoloaded. - - * mime-partial.el: `mime-article/grab-message/partials' -> - `mime-combine-message/partials-automatically'. - - * mime-partial.el: `mime-partial/preview-article' -> - `mime-view-partial-message'. - - * mime-partial.el: `mime-partial/preview-article-method-alist' -> - `mime-view-partial-message-method-alist'. - - * mime-play.el - (mime-view-quitting-method-for-mime-show-message-mode): Don't use - preview-content-list. - - * mime-text.el (mime-text-decoder-alist): `mime/show-message-mode' - -> `mime-show-message-mode'. - - * mime-pgp.el (mime-article/view-application/pgp): - `mime/show-message-mode' -> `mime-show-message-mode'. - - * mime-view.el (mime-view-follow-current-entity): New - implementation. - -Tue Mar 18 08:24:07 1997 MORIOKA Tomohiko - - * mime-view.el: `mime-view-follow-content' -> - `mime-view-follow-current-entity'. - - * mime-view.el (mime-view-mode): Don't use preview-content-list to - move to initial point. - - * mime-view.el: Function `mime-preview/cinfo-to-pcinfo' was - abolished. - - * mime-view.el: Function `mime-preview/point-pcinfo' was - abolished. - - * mime-view.el: Function `mime-preview/point-content-number' was - abolished. - - * mime-play.el (mime-view-play-current-entity): New - implementation. - -Mon Mar 17 17:18:29 1997 MORIOKA Tomohiko - - * mime-view.el (mime-view-quit): Use variable - `mime::preview/original-major-mode'. - - * mime-view.el (mime-view-show-summary): Use variable - `mime::preview/original-major-mode'. - - * mime-view.el (mime-view-scroll-down-entity): New implementation. - - * mime-view.el (mime-view-scroll-up-entity): New implementation. - -Mon Mar 17 16:19:30 1997 MORIOKA Tomohiko - - * mime-view.el: `mime-view-scroll-down-content' -> - `mime-view-scroll-down-entity'. - - * mime-view.el: `mime-view-scroll-up-content' -> - `mime-view-scroll-up-entity'. - - * mime-view.el (mime-view-move-to-next): New implementation. - -Mon Mar 17 16:03:11 1997 MORIOKA Tomohiko - - * mime-view.el: `mime-view-next-content' -> - `mime-view-move-to-next'. - - * mime-view.el (mime-view-move-to-previous): New implementation. - - * mime-view.el: `mime-view-previous-content' -> - `mime-view-move-to-previous'. - - * mime-view.el: `mime-view-up-content' -> - `mime-view-move-to-upper'. - -Mon Mar 17 15:39:17 1997 MORIOKA Tomohiko - - * mime-view.el, mime-play.el: `mime/show-message-mode' -> - `mime-show-message-mode'. - - * mime-view.el (mime-view-up-content): New implementation. - - * mime-view.el: `mime-preview/display-content' -> - `mime-view-display-entity'. - - * mime-view.el (mime-preview/display-content): Put - `mime-view-raw-buffer' and `mime-view-cinfo' as text-property. - - * mime-view.el: Variable `mime-view-visible-field-regexp' was - abolished. - - * mime-view.el: `mime-preview/cut-header' -> - `mime-view-cut-header'. - - * mime-view.el (mime-view-entity-separator-function): New - implementation. - - * mime-view.el: `mime-preview/default-content-separator' -> - `mime-view-entity-separator-function'. - -Mon Mar 17 13:49:27 1997 MORIOKA Tomohiko - - * mime-view.el (mime-view-header-visible-p): Abolish optional - argument `ctype'. - - * mime-view.el (mime-view-entity-button-function): New - implementation. - - * mime-view.el: Variable - `mime-view-content-button-ignored-ctype-list' was abolished. - - * mime-view.el: `mime-preview/default-content-button-function' -> - `mime-view-entity-button-function'. - - * mime-view.el: Variable `mime-preview/content-button-function' - was abolished. - - * mime-def.el (mime-add-button): New implementation. - - * mime-view.el (mime-view-insert-entity-button): modified. - - * mime-view.el: `mime-preview/insert-content-button' -> - `mime-view-insert-entity-button'. - - * mime-view.el (mime-view-header-visible-p): Don't calculate ctype - is optional argument `ctype' is not nil. - -Mon Mar 17 12:12:01 1997 MORIOKA Tomohiko - - * mime-view.el: `mime-print-entity' -> - `mime-view-print-current-entity'. - - * mime-view.el: `mime-extract-entity' -> - `mime-view-extract-current-entity'. - - * mime-play.el, mime-view.el: `mime-play-entity' -> - `mime-view-play-current-entity'. - - * mime-view.el (mime-play-entity, mime-extract-entity, - mime-print-entity): Add DOC-string. - - * mime-view.el: `mime-view-print-content' -> `mime-print-entity'. - - * mime-view.el: `mime-view-extract-content' -> - `mime-extract-entity'. - - * mime-play.el: Variable `mime-view-decoding-mode' was abolished. - - * mime-play.el: Variable `mime-view-decoding-mode' was moved from - mime-view.el. - - * mime-view.el: Variable `mime-view-decoding-mode' was moved to - mime-play.el. - -Mon Mar 17 05:09:05 1997 MORIOKA Tomohiko - - * mime-view.el: Use `mime-play-entity' instead of - `mime-view-play-content'. - -Mon Mar 17 05:06:33 1997 MORIOKA Tomohiko - - * mime-view.el, mime-play.el: `mime-preview/decode-content' -> - `mime-play-entity'. - - * mime-view.el (mime-view-play-content, mime-view-extract-content, - mime-view-print-content): Modify to use optional argument `mode'. - -Mon Mar 17 04:41:21 1997 MORIOKA Tomohiko - - * mime-play.el (mime-preview/decode-content, - mime-article/decode-content): Add new optional argument `mode'. - -Sun Mar 16 02:23:31 1997 MORIOKA Tomohiko - - * mime-text.el: `mime-charset/maybe-decode-buffer' -> - `mime-text-decode-buffer-maybe'. - - * mime-text.el: `mime-preview/decode-text-buffer' -> - `mime-decode-text-body'. - - * mime-view.el (mime-view-visible-media-type-list): Add - "text/rfc822-headers". - -Sun Mar 16 01:02:03 1997 MORIOKA Tomohiko - - * mime-image.el, mime-view.el: - `mime-view-default-showing-Content-Type-list' -> - `mime-view-visible-media-type-list'. - -Sun Mar 16 00:22:03 1997 MORIOKA Tomohiko - - * mime-play.el: `mime-raw::text-decoder' -> `mime-text-decoder'. - - * mime-pgp.el (mime-article/view-application/pgp): - `mime-charset/decode-buffer' -> `mime-text-decode-buffer'. - - * mime-text.el: `mime-charset/decode-buffer' -> - `mime-text-decode-buffer'. - -Sat Mar 15 23:59:09 1997 MORIOKA Tomohiko - - * mime-pgp.el (mime-article/view-application/pgp): - `mime-raw::text-decoder' -> `mime-text-decoder'. - - * mime-text.el: `mime-raw::text-decoder' -> `mime-text-decoder'. - -Sat Mar 15 23:53:49 1997 MORIOKA Tomohiko - - * mime-text.el: Variable `mime-raw::text-decoder' was moved from - mime-view.el. - - * mime-view.el: Variable `mime-raw::text-decoder' was moved to - mime-text.el. - -Sat Mar 15 22:40:50 1997 MORIOKA Tomohiko - - * mime-pgp.el (mime-article/view-application/pgp): Use - `insert-buffer-substring'. - -Sat Mar 15 22:27:53 1997 MORIOKA Tomohiko - - * mime-pgp.el (mime-article/view-application/pgp): - `mime::article/code-converter' -> `mime-raw::text-decoder'. - - * mime-play.el (mime-article/view-message/rfc822): - `mime::article/code-converter' -> `mime-raw::text-decoder'. - - * mime-text.el (mime-preview/decode-text-buffer): - `mime::article/code-converter' -> `mime-raw::text-decoder'. - - * mime-view.el: `mime::article/code-converter' -> - `mime-raw::text-decoder'. - -Sat Mar 15 21:20:02 1997 MORIOKA Tomohiko - - * mime-pgp.el (mime-article/add-pgp-keys): Abolish unused local - variables `charset' and `mime::article/preview-buffer'. - - * mime-pgp.el (mime-article/add-pgp-keys): Abolish unused local - variable `mode'. - -Sat Mar 15 21:10:43 1997 MORIOKA Tomohiko - - * mime-image.el (mime-preview/filter-for-image): Abolish unused - local variable `charset'. - - * mime-pgp.el (mime-article/check-pgp-signature): Abolish unused - local variable `status'. - - * mime-pgp.el: (mime-article/view-application/pgp, - mime-article/add-pgp-keys): Abolish unused local variable - `cur-buf'. - - * mime-image.el (mime-preview/filter-for-image, - mime-preview/filter-for-application/postscript): Abolish unused - local variable `mode'. - -Sat Mar 15 20:56:19 1997 MORIOKA Tomohiko - - * mime-text.el - (mime-preview/filter-for-text/richtext, - mime-preview/filter-for-text/enriched): Abolish unused local - variable `mode'. - - * mime-text.el (mime-preview/decode-text-buffer): New - implementation. - - * mime-view.el (mime-view-follow-content): Abolish unused - variables `f', `mid', `subj', `reply-to', `cc', `to', `from', `he' - and `hb'. - - * mime-edit.el (mime-edit-goto-tag): Abolish unused variable - `multipart'. - - * mime-file.el (mime-article/extract-file): Abolish unused local - variable `the-buf'. - - * mime-tar.el: Quote *autoconv*. - -Sat Mar 15 20:29:25 1997 MORIOKA Tomohiko - - * mime-partial.el (mime-article/grab-message/partials): Unused - local variable `mother' was abolished. - - * mime-play.el (mime-article/decode-caesar): Unused local variable - `cur-buf' was abolished. - - * mime-play.el (mime-article/decode-message/external-ftp): Unused - local variable `access-type' was abolished; Comment out `mode'. - - * mime-play.el (mime-article/view-message/rfc822): Unused local - variable `cur-buf' was abolished. - - * mime-text.el (mime-preview/filter-for-text/richtext, - mime-preview/filter-for-text/enriched): Unused local variable `m' - was abolished. - - * mime-parse.el (mime-parse-multipart): - Unused local variable `ct' was abolished. - - * eword-encode.el: Require eword-decode. - - * mime-image.el (mime-preview/filter-for-application/postscript): - Unused local variable `m' was abolished. - -Sat Mar 15 19:47:27 1997 MORIOKA Tomohiko - - * mime-pgp.el: (mime-article/view-application/pgp): - `mime-viewer/code-converter-alist' -> `mime-text-decoder-alist'. - - * mime-pgp.el (mime-pgp-command): New variable. - - (mime::article/call-pgp-to-check-signature): Use variable - `mime-pgp-command'. (cf. [tm-en:1259]) - -Sat Mar 15 19:25:25 1997 MORIOKA Tomohiko - - * mime-pgp.el: `mime/viewer-mode' -> `mime-view-mode'. - (cf. [tm-en:1259]) - - -1997-03-14 MORIOKA Tomohiko - - * emu: Version 7.40.1 was released. - * APEL: Version 3.2 was released. - * bitmap-mule: Version 7.17 was released. - * MU: Version 0.40.1 was released. - * MEL: Version 6.3 was released. - * SEMI: Version 0.72 was released. - -Fri Mar 14 08:48:07 1997 MORIOKA Tomohiko - - * SEMI-ELS (semi-modules-to-compile): Add mail-mime-setup.el. - -Fri Mar 14 08:47:06 1997 MORIOKA Tomohiko - - * mail-mime-setup.el: New module. - - * mime-setup.el: Only loads MUA specific setup files. - - * semi-setup.el: Setting for mime-edit, signature and mu-cite were - moved from mime-setup.el. - - * semi-setup.el: Setting for gnus-mime was moved to - gnus-mime/gnus-mime-setup.el. - - * semi-setup.el: Setting for mh-e was moved to emh/emh-setup.el. - - * Makefile: modified for SEMI package. - -Fri Mar 14 07:42:44 1997 MORIOKA Tomohiko - - * SEMI-MK: Don't compile and install other packages. - -Fri Mar 14 06:09:23 1997 MORIOKA Tomohiko - - * mime-edit.el: Definition of `mime-edit-mode' must be previous to - `add-minor-mode'. - - * mime-image.el (mime-preview/filter-for-image): Don't use - `assoc-value'. - -Fri Mar 14 04:49:04 1997 MORIOKA Tomohiko - - * mime-edit.el: Variable `mime-edit-prefix' and `mime-edit-map' - were abolished; Use `mime-edit-mode-map' directly. - - Use "C-c C-m" for enclosure commands. - - Add new binding "C-c C-x s" for `mime-edit-set-sign', "C-c C-x e" - for `mime-edit-set-encrypt'. - -Fri Mar 14 04:41:27 1997 MORIOKA Tomohiko - - * semi-setup.el: Require file-detect. - -Wed Mar 12 07:49:41 1997 MORIOKA Tomohiko - - * SEMI-CFG: Delete variables about other packages. - -Mon Mar 10 15:16:26 1997 MORIOKA Tomohiko - - * mime-def.el: Variable `mime-temp-directory' was moved to - mel/mel.el. - -1997-03-10 MORIOKA Tomohiko - - * SEMI-ELS (semi-modules-to-compile): Delete `mime-ftp'. - - * mime-view.el (mime/content-decoding-condition): Set up for - `mime-article/decode-message/external-ftp'. - - * semi-setup.el: tm-latex.el was abolished. - - * semi-setup.el: tm-ftp is merged to mime-play.el. - - * mime-play.el (mime-article/dired-function): New variable; copied - from tm-ftp.el. - - (mime-article/dired-function-for-one-frame, - mime-article/decode-message/external-ftp): New function; copied - from tm-ftp.el. - -1997-03-07 MORIOKA Tomohiko - - * mime-partial.el (mime-article/grab-message/partials): Don't use - `assoc-value'. - -1997-03-07 MORIOKA Tomohiko - - * mime-play.el: Require filename. - -1997-03-07 MORIOKA Tomohiko - - * mime-setup.el: Don't check `(boundp 'epoch::version)'. - - * mime-setup.el: Use `turn-on-mime-edit' instead of - `mime-edit-mode'. - - * mime-edit.el (mime-edit-decode-buffer): Renamed from - `mime-editor::edit-again'; optional argument `code-conversion' was - changed to `not-decode-text' (behavior was reversed). - (mime-edit-again): modified for `mime-edit-decode-buffer'. - - * mime-edit.el (mime-edit-again-ignored-field-regexp): New - variable. - - * mime-edit.el (mime-edit-again): optional argument - `code-conversion' was changed to `not-decode-text' (behavior was - reversed); optional argument `no-mode' was renamed to - `not-turn-on'; `mail-header-separator' was replaced to null line - before converting. - -1997-03-07 MORIOKA Tomohiko - - * mime-edit.el: `mime-edit-mode' -> `turn-on-mime-edit'; - `mime-edit-toggle-mode' -> `mime-edit-mode'. - - Alias `mime-mode' was abolished. - -1997-03-06 MORIOKA Tomohiko - - * eword-encode.el (eword-encode-header): fixed. - - * mime-edit.el: Comments was modified. - (mime-edit-mode): DOC-string was modified. - - * mime-edit.el: Function `mime-edit-define-menu-for-emacs19' was - abolished. Buffer local variable `mime-edit-mode-old-local-map' - was abolished. - - * mime-edit.el: `mime-edit-minor-mime-map' -> - `mime-edit-mode-map'. - - * mime-edit.el: `mime-edit-mime-map' -> `mime-edit-map'. - - * mime-edit.el: Function `mime-edit-define-keymap' was abolished. - -1997-03-06 MORIOKA Tomohiko - - * mime-edit.el: `mime-prefix' -> `mime-edit-prefix'. - -1997-03-04 MORIOKA Tomohiko - - * semi-setup.el: tm-pgp.el was already renamed to mime-pgp.el. - -1997-03-04 MORIOKA Tomohiko - - * mime-def.el (pgp-function-alist): `tm:mc-' -> `mime-mc-'. - -1997-03-04 MORIOKA Tomohiko - - * mime-def.el (mime-temp-directory): Refer environment variable - "MIME_TMP_DIR" as default value. - -1997-03-04 MORIOKA Tomohiko - - * SEMI-ELS (semi-modules-to-compile): tm-latex.el and tm-html.el - were abolished. - - * mime-tar.el (mime-decode-message/tar), mime-play.el, mime-pgp.el - (mime-article/check-pgp-signature), mime-partial.el - (mime-article/grab-message/partials), mime-image.el, mime-edit.el - (mime-edit-split-and-send), mime-def.el: Variable `mime/tmp-dir' - was renamed to `mime-temp-directory'. - - * mime-edit.el: `mime/edit-again' was renamed to - `mime-edit-again'. - -1997-03-04 MORIOKA Tomohiko - - * mime-text.el, mime-edit.el: `mime/temporary-message-mode' was - renamed to `mime-temp-message-mode'. - - * mime-edit.el: Draft preview feature was abolished. - - * mime-edit.el (mime-transfer-level-string): Fixed DOC-string. - - Buffer local variable `mime/editing-buffer' was renamed to - `mime-edit-buffer'. - - * mime-edit.el (mime-edit-insert-x-emacs-field): New variable. - (mime-edit-x-emacs-value): New variable. - (mime-edit-translate-body): Insert X-Emacs field if variable - `mime-edit-insert-x-emacs-field' is not nil. - -1997-03-03 MORIOKA Tomohiko - - * mime-view.el (mime-preview/insert-content-button): Don't use - function `assoc-value'. - -1997-03-03 MORIOKA Tomohiko - - * mime-bbdb.el: `mime-bbdb-' -> `mime-bbdb/'. - -1997-03-03 MORIOKA Tomohiko - - * SEMI-MK: compile and install emu and apel. - -1997-03-03 MORIOKA Tomohiko - - * SEMI-ELS: tm-bbdb.el was renamed to mime-bbdb.el. - - * mime-bbdb.el: Renamed from tm-bbdb.el. - - * SEMI-CFG (EMU_PREFIX, EMU_DIR): New variable. - (APEL_PREFIX, APEL_DIR, APEL_RELATIVE_DIR): New variable. - (load-path): Add "../apel" instead of "../tl". - - * SEMI-ELS: alist.el was moved to ../apel/. - -1997-03-03 MORIOKA Tomohiko - - * mime-parse.el: Require emu; Function `char-list-to-string' was - abolished. - - * mime-edit.el: Require emu; definitions about visible/invisible - were abolished. - -1997-03-03 MORIOKA Tomohiko - - * eword-encode.el: Require emu; function - `find-non-ascii-charset-string' and - `find-non-ascii-charset-region' were abolished. - - * mime-def.el: Require atype; functions about atype were - abolished. - -1997-03-03 MORIOKA Tomohiko - - * mime-def.el: Require emu; Variable `running-xemacs' was - abolished; Macro `defun-maybe' was abolished; Function `functionp' - was abolished; Variable `charsets-mime-charset-alist', - `default-mime-charset' and `mime-charset-coding-system-alist' were - abolished; Function `mime-charset-to-coding-system', - `charsets-to-mime-charset', `detect-mime-charset-region', - `encode-mime-charset-region', `decode-mime-charset-region', - `encode-mime-charset-string' and `decode-mime-charset-string' were - abolished. - -Sat Mar 1 04:12:37 1997 Tomohiko Morioka - - * mime-def.el (charsets-to-mime-charset): New function; copied - from emu.el. - - * eword-encode.el: Use `char-bytes' instead of `char-length'. - - * mime-def.el (eliminate-top-spaces): New inline-function; copied - from tl-str.el. - - * mime-edit.el: Fixed about definition of visible/invisible - functions for XEmacs. - -Sat Mar 1 03:39:01 1997 Tomohiko Morioka - - * mime-edit.el (enable-invisible, end-of-invisible): New macro; - copied from emu-19.el. - (invisible-region, invisible-p, next-visible-point): New function; - copied from emu-19.el and emu-xemacs.el. - (visible-region): New function; copied from emu-19.el. - - * mime-edit.el (mime-edit-make-boundary): New function. - (mime-edit-translate-body, mime-edit-translate-region): Use - `mime-edit-make-boundary'. - - * mime-edit.el (replace-space-with-underline): New inline - function; copied from tl-str.el. - -Sat Mar 1 02:07:00 1997 Tomohiko Morioka - - * eword-encode.el (find-non-ascii-charset-region): New - inline-function; copied from emu-e20.el. - -Fri Feb 28 06:46:48 1997 Tomohiko Morioka - - * mime-def.el: Require cl. - - * mime-view.el (mouse-button-2): New variable; copied from - emu-19.el and emu-xemacs.el. - - * mime-def.el (defun-maybe): New macro; copied from emu.el. - (functionp): New function; copied from emu.el. - -Fri Feb 28 05:14:54 1997 Tomohiko Morioka - - * mime-play.el: Supports only Emacs/mule API. - - * mime-def.el (field-unify): Fixed. - - * semi-setup.el: Don't require mime-play. - - * mime-def.el: Function `put-fields' were abolished. - - * mime-def.el: atype functions were moved from mime-play.el. - - * mime-play.el: atype functions were moved to mime-def.el. - -Fri Feb 28 04:50:13 1997 Tomohiko Morioka - - * mime-def.el (call-after-loaded): New function; moved from - semi-setup.el. - - * semi-setup.el: Function `call-after-loaded' was moved to - mime-def.el; require mime-def. - -Fri Feb 28 04:44:27 1997 Tomohiko Morioka - - * semi-setup.el: require mime-play instead of mime-view when - compiling. - -Fri Feb 28 04:21:43 1997 Tomohiko Morioka - - * SEMI-MK: BINS were abolished. - - * SEMI-CFG: require cl. - - * SEMI-CFG: Variable `BIN_SRC_DIR' and `BINS' were abolished. - -Fri Feb 28 04:08:12 1997 Tomohiko Morioka - - * SEMI-MK: Renamed from TM-MK. - - * SEMI-CFG: Don't require tl-misc. - - * SEMI-ELS (semi-modules-to-compile): Add alist.el. - -Fri Feb 28 02:33:20 1997 Tomohiko Morioka - - * mime-play.el (field-unify): Fixed. - -Fri Feb 28 02:22:38 1997 Tomohiko Morioka - - * mime-setup.el, mime-image.el, mime-edit.el, mime-play.el: - Require alist. - - * alist.el: New module; separated from tl-list.el. - - * mime-play.el: Function `put-alist' and `del-alist' were moved to - alist.el. - - * mime-play.el (mime-article/coding-system-alist): Use - `no-conversion' instead of *noconv*. - -Thu Feb 27 13:48:48 1997 Tomohiko Morioka - - * mime-parse.el (char-list-to-string): New inline-function; copied - from emu-19.el. - -Thu Feb 27 13:43:38 1997 Tomohiko Morioka - - * mime-parse.el (symbol-concat): New inline-function; copied from - tl-str.el. - - * semi-setup.el: require 'mime-view when compiling. - - * mime-parse.el (regexp-*): New inline-function; copied from - tl-str.el. - -Thu Feb 27 13:28:10 1997 Tomohiko Morioka - - * semi-setup.el (running-xemacs): New variable. - -Thu Feb 27 09:00:33 1997 Tomohiko Morioka - - * mime-play.el: `mime/viewer-mode' -> `mime-view-mode'. - - * mime-def.el: fixed DOC string. - -Thu Feb 27 08:56:45 1997 Tomohiko Morioka - - * eword-decode.el: Don't require emu. - - * mime-def.el (charsets-mime-charset-alist, default-mime-charset, - mime-charset-coding-system-alist): New variable; copied from - emu-e20.el. - (mime-charset-to-coding-system, detect-mime-charset-region, - encode-mime-charset-region, decode-mime-charset-region, - encode-mime-charset-string, decode-mime-charset-string): New - function; copied from emu-e20.el. - - * eword-encode.el (find-non-ascii-charset-string): New - inline-function; copied from emu-e20.el. - -Thu Feb 27 08:36:01 1997 Tomohiko Morioka - - * mime-tar.el: Don't require emu. - -Thu Feb 27 08:34:21 1997 Tomohiko Morioka - - * mime-play.el (put-alist, del-alist): New function; copied from - tl-list.el. - (put-fields, field-unifier-for-default, field-unifier-for-mode, - field-unify, assoc-unify, get-unified-alist, delete-atype, - remove-atype, replace-atype, set-atype): New function; copied from - tl-atype.el. Don't require tl-atype. - -Thu Feb 27 08:18:16 1997 Tomohiko Morioka - - * semi-setup.el (call-after-loaded): New function; imported from - tl-misc.el; Don't require tl-misc. - -Thu Feb 27 08:10:24 1997 Tomohiko Morioka - - * mime-pgp.el: Renamed from tm-pgp.el. - -Thu Feb 27 08:05:45 1997 Tomohiko Morioka - - * mime-def.el (pgp-function-alist): tm-edit-mc.el was renamed to - mime-mc.el. - - * mime-mc.el: Renamed from tm-edit-mc.el. - -Thu Feb 27 06:38:44 1997 Tomohiko Morioka - - * mime-text.el: `tm:mother-button-dispatcher' -> - `mime-button-mother-dispatcher'. - - * mime-def.el, mime-text.el (mime-preview/filter-for-text/plain), - mime-view.el, mime-tar.el (mime-tar-set-properties): - `tm:add-button' -> `mime-add-button'. - - * mime-file.el: Renamed from tm-file.el. - -Wed Feb 26 13:01:25 1997 Tomohiko Morioka - - * eword-decode.el: Must require emu. - - * eword-decode.el (eword-decode-region): Unused local variable - `charset', `encoding' and `text'. - -Wed Feb 26 07:58:29 1997 Tomohiko Morioka - - * eword-decode.el (eword-decode-encoded-word): Use - `add-text-properties' directly. - -Wed Feb 26 07:44:22 1997 Tomohiko Morioka - - * mime-def.el (tm:add-button): Use `add-text-properties' directly. - - * mime-def.el (running-xemacs): New variable; if it is not nil, - require overlay. - - * mime-def.el (regexp-or): New function. - -Wed Feb 26 04:57:33 1997 Tomohiko Morioka - - * mime-tar.el: Renamed from tm-tar.el. - - * mime-view.el (mime-view-define-keymap): `tm:button-dispatcher' - -> `mime-button-dispatcher'. - - * mime-def.el: `tm:button-dispatcher' -> `mime-button-dispatcher'. - - * mime-def.el: `tm:mother-button-dispatcher' -> - `mime-button-mother-dispatcher'. - - * mime-def.el: `semi-data' -> `mime-button-data'. - - * mime-def.el: `semi-callback' -> `mime-button-callback'. - - * mime-def.el: `tm:mouse-face' -> `mime-button-mouse-face'. - - * mime-def.el: `tm:button-face' -> `mime-button-face'. - - * mime-def.el (tm:add-button, tm:button-dispatcher): - `mime-callback' was renamed to `semi-callback'; `mime-data' was - renamed to `semi-data'. - -Wed Feb 26 03:54:17 1997 Tomohiko Morioka - - * mime-def.el (tm:add-button): Use `make-overlay' directly. - - * mime-def.el (tm:add-button): Use `overlay-put' directly. - -Tue Feb 25 07:40:37 1997 Tomohiko Morioka - - * mime-text.el: `tm:browse-url' was renamed to - `mime-text-browse-url'. - - * mime-text.el: Require browse-url. - - * mime-text.el: `tm:URL-regexp' was renamed to - `mime-text-url-regexp'. - - * mime-text.el: Variable `tm:URL-regexp', - `browse-url-browser-function' and function `tm:browse-url' were - moved from mime-def.el. - - * mime-def.el: Variable `tm:URL-regexp', - `browse-url-browser-function' and function `tm:browse-url' were - moved to mime-text.el. - - * eword-decode.el: Variable `tm:warning-face' was renamed to - `eword-warning-face'. - - * eword-decode.el: Variable `tm:warning-face' was moved from - mime-def.el. - - * mime-def.el: Variable `tm:warning-face' was moved to - eword-decode.el. - - * mime-def.el: Function `tm:set-face-region' was abolished. - - * mime-edit.el: `mime-edit-make-charset-default-encoding-alist' -> - `mime-make-charset-default-encoding-alist'. - - * mime-edit.el: `mime-edit-transfer-level' -> - `mime-transfer-level'. - - * mime-edit.el: Function `mime/encoding-name' was renamed to - `mime-encoding-name'. - - * mime-def.el: Function `mime/make-charset-default-encoding-alist' - was abolished. - - * mime-edit.el: Function `mime/encoding-name' was moved from - mime-def.el. - - * mime-def.el: Function `mime/encoding-name' was moved to - mime-edit.el. - -Tue Feb 25 06:15:53 1997 Tomohiko Morioka - - * mime-edit.el: Variable `mime-charset-type-list' was moved from - mime-def.el. - - * mime-def.el: Variable `mime-charset-type-list' was moved to - mime-edit.el. - -Mon Feb 24 10:07:33 1997 Tomohiko Morioka - - * eword-encode.el (eword-encode-header): fixed typo. - -Mon Feb 24 10:04:23 1997 Tomohiko Morioka - - * mime-edit.el (mime-edit-insert-message, mime-edit-insert-mail, - mime-editor::edit-again): Don't use `assoc-value'; Don't require - tl-list. - -Mon Feb 24 10:00:50 1997 Tomohiko Morioka - - * mime-play.el: require tl-atype. - - * mime-view.el: Don't require tl-atype. - -Mon Feb 24 09:58:14 1997 Tomohiko Morioka - - * mime-view.el: Don't require tl-misc. - -Mon Feb 24 09:57:03 1997 Tomohiko Morioka - - * eword-encode.el (eword-encode-header): Use function `assoc-if' - instead of `ASSOC'; require cl instead of tl-list. - - * mime-parse.el (define-structure): New macro; Don't require - tl-misc.el. - - * mime-view.el (mime-preview/insert-content-button): Don't use - function `assoc-value'. - - * mime-view.el: Require cl instead of tl-list. - - * mime-view.el: Don't require tl-str.el. - -Mon Feb 24 09:12:12 1997 Tomohiko Morioka - - * mime-parse.el (define-structure): New macro; Don't require - tl-misc.el. - - * mime-view.el (mime-preview/insert-content-button): Don't use - function `assoc-value'. - - * mime-view.el: Require cl instead of tl-list. - - * mime-view.el: Don't require tl-str.el. - -Mon Feb 24 09:04:48 1997 Tomohiko Morioka - - * eword-decode.el: Constant - `eword-Q-encoding-and-encoded-text-regexp' was abolished. - - * eword-decode.el (quoted-printable-hex-chars, - quoted-printable-octet-regexp, eword-Q-encoded-text-regexp, - eword-Q-encoding-and-encoded-text-regexp): New constant; moved - from mime-def.el. - - * mime-def.el (quoted-printable-hex-chars, - quoted-printable-octet-regexp, eword-Q-encoded-text-regexp, - eword-Q-encoding-and-encoded-text-regexp): Moved to - eword-decode.el. - - * eword-decode.el (base64-token-regexp, - base64-token-padding-regexp, eword-B-encoded-text-regexp): New - constant; moved from mime-def.el. - - * mime-def.el: Constant `base64-token-regexp', - `base64-token-padding-regexp' and `eword-B-encoded-text-regexp' - were moved to eword-decode.el. - - * mime-def.el: Constant `eword-B-encoding-and-encoded-text-regexp' - was abolished. - -Mon Feb 24 08:52:01 1997 Tomohiko Morioka - - * eword-decode.el: Don't require emu. - - * eword-decode.el: Don't require tl-str.el. - - * mime-def.el (get-version-string): New inline-function; imported - from tl-str.el. - -Mon Feb 24 02:42:24 1997 Tomohiko Morioka - - * mime-setup.el: Function `mime/encode-message-header' was renamed - to `eword-encode-header'. - - * mime-edit.el, eword-encode.el: Function - `eword-encode-message-header' was renamed to - `eword-encode-header'. - -Mon Feb 24 02:26:02 1997 Tomohiko Morioka - - * eword-decode.el (eword-decode-header): New optional argument - `SEPARATOR'; Use function `std11-narrow-to-header'. - - * mime-view.el, mime-setup.el, eword-decode.el: Function - `eword-decode-message-header' was renamed to - `eword-decode-header'. - -Mon Feb 24 02:17:11 1997 Tomohiko Morioka - - * mime-edit.el: tm-ew-e.el was renamed to eword-encode.el; - Function `mime/encode-message-header' was renamed to - `eword-encode-message-header'. - -Mon Feb 24 01:59:28 1997 Tomohiko Morioka - - * mime-view.el: Function `mime-eword/decode-string' was renamed to - `eword-decode-string'. - - * mime-def.el: `mime/Q-' -> `eword-Q-'. - - * mime-def.el: `mime/B-' -> `eword-B-'. - -Mon Feb 24 01:46:59 1997 Tomohiko Morioka - - * eword-decode.el: Constant `eword-charset-regexp' was renamed to - `mime-charset-regexp'. - - * mime-def.el: Constant `mime/charset-regexp' was renamed to - `mime-charset-regexp'. - -Mon Feb 24 01:38:18 1997 Tomohiko Morioka - - * mime-view.el: Function `mime/decode-message-header' was renamed to - `eword-decode-message-header'. - - * mime-view.el: tm-ew-d.el was renamed to eword-decode.el. - -Mon Feb 24 01:32:33 1997 Tomohiko Morioka - - * mime-setup.el: tm-ew-d.el was renamed to eword-decode.el; - Function `mime/decode-message-header' was renamed to - `eword-decode-message-header'. - -Sat Feb 22 17:30:15 1997 MORIOKA Tomohiko - - * SEMI-CFG: Renamed from TM-CFG. - - * SEMI-ELS: Renamed from TM-ELS. - - * eword-encode.el: `eword-exist-encoded-word-in-subject' -> - `eword-in-subject-p'. - - * eword-encode.el: `mime/' -> `eword-'. - - * eword-encode.el (eword-generate-X-Nsubject): Don't refer - variable `mime/use-X-Nsubject'. - - * eword-encode.el (eword-generate-X-Nsubject): Renamed from - `mime/generate-X-Nsubject'. - - * eword-encode.el (eword-field-encoding-method-alist): Don't refer - variable `mime/no-encoding-header-fields'. - - * eword-encode.el (eword-field-encoding-method-alist): Renamed - from `mime/field-encoding-method-alist'. - - * eword-encode.el: Renamed from tm-ew-e.el. - - * eword-decode.el: Renamed from tm-ew-d.el. - - * mime-view.el: Don't require tm-def. - - * mime-parse.el: tm-def.el was renamed to mime-def.el. - - * mime-def.el: Renamed from tm-def.el. - -1997-02-22 MORIOKA Tomohiko - - * SEMI-ELS: Renamed from TM-ELS. - -1997-02-22 MORIOKA Tomohiko - - * eword-encode.el: `eword-exist-encoded-word-in-subject' -> - `eword-in-subject-p'. - - * eword-encode.el: `mime/' -> `eword-'. - - * eword-encode.el (eword-generate-X-Nsubject): Don't refer - variable `mime/use-X-Nsubject'. - - * eword-encode.el (eword-generate-X-Nsubject): Renamed from - `mime/generate-X-Nsubject'. - - * eword-encode.el (eword-field-encoding-method-alist): Don't refer - variable `mime/no-encoding-header-fields'. - - * eword-encode.el (eword-field-encoding-method-alist): Renamed - from `mime/field-encoding-method-alist'. - - * eword-encode.el: Renamed from tm-ew-e.el. - - * eword-decode.el: Renamed from tm-ew-d.el. - - * mime-view.el: Don't require tm-def. - - * mime-parse.el: tm-def.el was renamed to mime-def.el. - -1997-02-22 MORIOKA Tomohiko - - * mime-def.el: Renamed from tm-def.el. - -Fri Feb 21 08:04:42 1997 Tomohiko Morioka - - * mime-view.el: Don't `suppress-keymap'. - -Fri Feb 21 07:42:32 1997 Tomohiko Morioka - - * mime-view.el: tm-parse.el was renamed to mime-parse.el. - - * mime-parse.el: Renamed from tm-parse.el. - - * mime-view.el: Key-binding for function - `mime-view-display-x-face' was abolished. - -Fri Feb 21 07:04:51 1997 Tomohiko Morioka - - * mime-setup.el: modified for mime-edit.el. - -Fri Feb 21 07:02:52 1997 Tomohiko Morioka - - * mime-edit.el: `mime-editor/' -> `mime-edit-'. - -Fri Feb 21 06:57:11 1997 Tomohiko Morioka - - * mime-edit.el: based on tm-edit 7.105. - - * semi-setup.el: tm-image.el was renamed to mime-image.el. - - * mime-image.el: Renamed from tm-image.el. - -Fri Feb 21 05:57:53 1997 Tomohiko Morioka - - * semi-setup.el: Renamed from tm-setup.el. - - * mime-setup.el: Setting for GNUS was abolished. - - * mime-setup.el: Variable `mime-setup-use-sc' was abolished. - - * mime-view.el: tm-play.el was renamed to mime-play.el. - - * mime-partial.el: Renamed from tm-partial.el. - - * mime-play.el: Renamed from tm-play.el. - - * mime-view.el: `tm-text' is renamed to `mime-text'. - - * mime-view.el (mime-view-mode): Optional argument `mother-keymap' - was renamed to `default-keymap-or-function'; optional argument - `default-function' was abolished. - - * mime-text.el: `mime-view-code-converter-alist' -> - `mime-text-decoder-alist'. - - * mime-text.el: Renamed from tm-text.el. - -Thu Feb 20 09:02:36 1997 Tomohiko Morioka - - * mime-view.el: `mime/viewer-mode' -> `mime-view-mode'. - - * mime-view.el: Renamed from tm-view.el. - -Thu Jul 11 14:57:42 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-file-types): add for patch. - - * mime-edit.el: rearrangement. - -Wed Jul 10 12:05:05 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/normalize-body): Use function - `encode-mime-charset-region' instead of - `mime-charset-encode-region'. - -Wed Jul 10 11:51:13 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/normalize-body): fixed. - - * mime-edit.el (mime-editor/define-charset): - Argument `charset' was changed to - symbol. - (mime-editor/choose-charset): Changed to return symbol. - (mime-editor/normalize-body): charset was changed to symbol. - -Wed Jul 10 11:22:55 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/make-charset-default-encoding-alist): - New function. - (mime-editor/charset-default-encoding-alist): Use function - `mime-editor/make-charset-default-encoding-alist'. - (mime-editor/toggle-transfer-level): Use function - `mime-editor/make-charset-default-encoding-alist'. - - * mime-edit.el (mime-editor/choose-charset): Use function - `detect-mime-charset-region' instead of - `mime/find-charset-region'. - -Tue Jul 9 13:24:21 1996 MORIOKA Tomohiko - - * mime-edit.el (mime/editor-mode): Don't toggle. - - (mime-editor/toggle-mode): New function. - -Tue Jul 2 14:06:53 1996 Alastair Burt - - * mime-edit.el: I think the following is the best way to handle - tm-edit as a minor mode in XEmacs (at least in 19.14 -- I am not - sure if "add-minor-mode" works the same way in earlier versions). - By clicking on the mode line you can turn mime/editor-mode on or - off. - -Thu Jun 27 14:08:17 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/encrypt-pgp-kazu): Use macro - `as-binary-process'. - - * mime-edit.el (mime-editor/sign-pgp-kazu): Use macro - `as-binary-process'. - -Wed Jun 12 05:58:23 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/split-message-sender-alist): setting - for `mail-mode' was moved to tm-rmail.el. - -Sun Jun 9 06:44:19 1996 MORIOKA Tomohiko - - * mime-edit.el: Variable - `mime-editor/message-default-sender-alist' was abolished. - -Sun Jun 9 06:40:26 1996 MORIOKA Tomohiko - - * mime-edit.el: Variable `mime-editor/window-config-alist' was - abolished. - -Sun Jun 9 06:35:10 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/split-and-send): New implementation. - -Mon Jun 3 17:39:10 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor::edit-again): fixed about multipart. - -Wed May 29 09:57:53 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/define-charset, - mime-editor/set-parameter): Function `mime-set-parameter' was - renamed to `mime-editor/set-parameter'. - - * mime-edit.el (mime-set-parameter): New implementation - - (mime-editor/translate-single-part-tag): New function. - (mime-editor/translate-region): Use function - `mime-editor/translate-single-part-tag'. - -Tue May 28 15:15:33 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor::edit-again): fixed. - - * mime-edit.el (mime/edit-again): fixed. - - * mime-edit.el (mime-editor::edit-again): modified for new tag - rule. - - * mime-edit.el (mime-editor/insert-signature): Use variable - `signature-file-name' instead of `signature'. - - * mime-edit.el (mime-editor/multipart-beginning-regexp): Don't - require begging new-line. - - (defconst mime-editor/multipart-end-regexp): Don't require begging - new-line. - - (mime-editor/find-inmost): modified for new enclosure tag rule. - - (mime-editor/translate-region): modified for new enclosure tag rule. - - (mime-editor/enclose-region): modified for new enclosure tag rule. - -Sun May 26 05:04:20 1996 MORIOKA Tomohiko - - * mime-edit.el: Add `(provide 'tm-edit)'. - - Do `(run-hooks 'tm-edit-load-hook)' if variable - `mime-edit-load-hook' is not bound. - -Sun May 26 02:10:08 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/insert-binary-buffer): fixed. - (mime-editor/normalize-body): fixed. - -Sat May 25 20:47:32 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/normalize-body): fixed. - - (mime-editor/content-end): Used function `invisible-p' and - `next-visible-point'. - -Sat May 25 20:05:20 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/insert-binary-buffer): Use function - `invisible-region' instead of `mime-flag-region'. - (mime-editor/normalize-body): Use function `visible-region' - instead of `mime-flag-region'. - (mime-editor/content-end): New implementation. - -Sat May 25 16:04:28 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/enquote-region): New command; bound to - `C-c C-x q'. - - (mime-editor/menu-list): New item for function - `mime-editor/enquote-region'. - -Sat May 25 15:52:44 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/process-multipart-1): Use function - `string-equal' instead of `string='. - -Sat May 25 15:48:33 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/process-multipart-1): fixed about - condition of next tag inserting. - -Sat May 25 15:36:58 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/enclose-region): fixed for new format. - -Sat May 25 15:15:03 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/insert-partial-header): Comment of - Mime-Version field was modified. - - * mime-edit.el (mime-editor/insert-tag): Don't insert unnecessary - line break. - - * mime-edit.el (mime-editor/version-name): New constant. - - (mime-editor/mime-version-value): Use constant - `mime-editor/version-name'. - - (mime-editor/insert-partial-header): Use constant - `mime-editor/version-name'. - -Fri May 24 15:16:37 1996 MORIOKA Tomohiko - - * mime-edit.el (mime-editor/goto-tag): fixed for a tag without - line break. - (mime-editor/normalize-body): fixed for a tag without line break. - - * mime-edit.el (mime-editor/translate-region): fixed for a part - starting without line break. - - * mime-edit.el (mime-editor/single-part-tag-regexp): It allows any - column. - (mime-editor/quoted-single-part-tag-regexp): New constant. - (mime-editor/enquote-region): New function. - (mime-editor/dequote-region): New function. - (mime-editor/process-multipart-1): Processing for ``quote'' - enclosure was added. - (mime-editor/translate-body): Use function - `mime-editor/dequote-region'. - - (mime-editor/mime-version-value): Comment was renamed. - - * mime-edit.el: Renamed from tm-edit.el diff --git a/Makefile b/Makefile deleted file mode 100644 index 23144fd..0000000 --- a/Makefile +++ /dev/null @@ -1,79 +0,0 @@ -# -# $Id: Makefile,v 0.8 1997-06-19 03:48:53 morioka Exp $ -# - -VERSION = 0.92 - -SHELL = /bin/sh -MAKE = make -CC = gcc -CFLAGS = -O2 -TAR = tar -RM = /bin/rm -f -CP = /bin/cp -p -EMACS = emacs - -GOMI = *.elc -FLAGS = -batch -q -no-site-file - -PREFIX = NONE -EXEC_PREFIX = NONE -LISPDIR = NONE - -FILES = README.?? Makefile SEMI-MK SEMI-CFG SEMI-ELS *.el ChangeLog - -elc: - $(EMACS) $(FLAGS) -l SEMI-MK -f compile-semi \ - $(PREFIX) $(EXEC_PREFIX) $(LISPDIR) - -install-elc: elc - $(EMACS) $(FLAGS) -l SEMI-MK -f install-semi \ - $(PREFIX) $(EXEC_PREFIX) $(LISPDIR) - - -all: $(UTILS) $(DVI) elc - -tex: ol2 - cd doc; $(MAKE) tex - -dvi: ol2 - cd doc; $(MAKE) dvi - -ps: ol2 - cd doc; $(MAKE) ps - - -install: install-elc install-execs - -execs: $(UTILS) - -install-execs: - $(EMACS) $(FLAGS) -l SEMI-MK -f install-execs $(PREFIX) $(EXEC_PREFIX) - - -update-xemacs: - $(EMACS) $(FLAGS) -l SEMI-MK -f update-xemacs-source - - -clean: - -$(RM) $(GOMI) - -cd doc && $(MAKE) clean - -cd gnus && $(MAKE) clean - -cd mh-e && $(MAKE) clean - cd ../mel && $(MAKE) clean - - -tar: - cvs commit - sh -c 'cvs tag -RF semi-`echo $(VERSION) \ - | sed s/\\\\./_/ | sed s/\\\\./_/`; \ - cd /tmp; cvs export -d semi-$(VERSION) \ - -r semi-`echo $(VERSION) \ - | sed s/\\\\./_/ | sed s/\\\\./_/` SEMI/semi' - cd /tmp; $(TAR) cvzf semi-$(VERSION).tar.gz semi-$(VERSION) - cd /tmp; $(RM) -r semi-$(VERSION) - sed "s/VERSION/$(VERSION)/" < ftp.in > ftp -# -cd ..; mkdir semi-$(VERSION) -# -$(CP) $(FILES) ../semi-$(VERSION) -# cd ..; $(TAR) cvzf semi-$(VERSION).tar.gz semi-$(VERSION) -# cd ..; $(RM) -r semi-$(VERSION) diff --git a/README.en b/README.en deleted file mode 100644 index 7e7717a..0000000 --- a/README.en +++ /dev/null @@ -1,163 +0,0 @@ -[README for SEMI kernel package (English Version)] -by MORIOKA Tomohiko -$Id: README.en,v 1.2 1997-05-13 14:11:48 morioka Exp $ - -What's SEMI? ------------- - - SEMI is a library to provide MIME feature for GNU Emacs. It stands - for "SEMI is Emacs MIME Interfaces". MIME is a proposed internet - standard for including content and headers other than (ASCII) plain - text in messages. - - RFC 2045 : Internet Message Bodies - RFC 2046 : Media Types - RFC 2047 : Message Header Extensions - RFC 2048 : MIME Registration Procedures - RFC 2049 : MIME Conformance - - SEMI has the following features: - - - MIME style multilingual header (RFC 2047) - - MIME message viewer (mime-view-mode) (RFC 2045 .. 2049) - - MIME message composer (mime-edit-mode) (RFC 2045 .. 2049) - - MIME message viewer and composer also support following features: - - - filename handling by Content-Disposition field (RFC 1806) - - PGP/MIME security Multiparts (RFC 2015) - - application/pgp (draft-kazu-pgp-mime-00.txt; obsolete) - - text/richtext (RFC 1521; obsolete; preview only) - - text/enriched (RFC 1896) - - Notice that this package does not contain MIME extender for any - MUAs and external methods. They are released as separated packages. - - -Required environment --------------------- - - SEMI supports XEmacs 20.1 or later with mule, and Emacs/mule (mule - merged EMACS; it will become Emacs 20.0). - - SEMI does not support EMACS 19.28 or later, XEmacs 19.14 or later, - XEmacs 20.1 or later without mule, but SEMI may work with them. - - If you use beta versions of XEmacs 20.1, please use the latest - version and compile with mule support, i.e. use the configure flag - `--with-mule'. - - If you use EMACS/mule, please use the latest version (GNU MULE - 19.34.91-delta or later). - - SEMI requires APEL and MEL package. Please install them before - installing it. APEL package - is available at: - - ftp://ftp.jaist.ac.jp/pub/GNU/elisp/apel/ - - and MEL package is available at: - - ftp://ftp.jaist.ac.jp/pub/GNU/elisp/mime/libs/ - - PGP/MIME and application/pgp require mailcrypt or tiny-pgp package. - - The package enriched.el is required to compose text/enriched, so if - you use Emacs anything 19.28 or older (including official version of - MULE 2.3), WYSIWYG composing for text/enriched is not available. - - -Installation ------------- - - % make install - - You can specify the emacs command name, for example - - % make install EMACS=xemacs - - If `EMACS=...' is omitted, EMACS=emacs is used. - - You can specify the prefix of the directory tree for Emacs Lisp - programs and shell scripts, for example: - - % make install PREFIX=~/ - - If `PREFIX=...' is omitted, the prefix of the directory tree of the - specified emacs command is used (perhaps /usr/local). - - For example, if PREFIX=/usr/local and EMACS 19.34 is specified, it - will create the following directory tree: - - /usr/local/share/emacs/19.34/site-lisp/ --- emu - /usr/local/share/emacs/site-lisp/apel/ --- APEL - /usr/local/share/emacs/site-lisp/bitmap/ --- BITMAP-MULE - /usr/local/share/emacs/site-lisp/mu/ --- MU - /usr/local/share/emacs/site-lisp/mel/ --- MEL - /usr/local/share/emacs/site-lisp/semi/ --- SEMI - - You can specify site-lisp directory, for example - - % make install LISPDIR=~/share/emacs/lisp - - If `LISPDIR=...' is omitted, site-lisp directory of the specified - emacs command is used (perhaps /usr/local/share/emacs/site-lisp or - /usr/local/lib/xemacs/site-lisp). - - You can specify other optional settings by editing the file - semi/SEMI-CFG. Please read semi/README.en and comments in - semi/TM-CFG. - - -Initialization --------------- - -(a) load-path - - If you are using Emacs or Mule, please add directory of emu, apel, - bitmap, mu, mel and semi to load-path. If you install by default - setting, you can write subdirs.el for example: - - -------------------------------------------------------------------- - (normal-top-level-add-to-load-path - '("apel" "bitmap" "mu" "mel" "semi")) - -------------------------------------------------------------------- - - If you are using XEmacs, there are no need of setting about - load-path. - -(b) mime-setup - - Please insert the following into your ~/.emacs: - - (load "mime-setup") - - -Documentation -------------- - - To get started, please read semi/README.en. - - RFC's 822, 1806, 1847, 1896, 2015, 2045, 2046, 2047, 2048 and 2049 - are available via anonymous ftp: - ftp://ds.internic.net/rfc/ - - -Bug reports ------------ - - If you write bug-reports and/or suggestions for improvement, please - send them to the tm Mailing List: - - bug-tm-en@chamonix.jaist.ac.jp (English) - bug-tm-ja@chamonix.jaist.ac.jp (Japanese) - - Via the tm ML, you can report tm bugs, obtain the latest release of - tm, and discuss future enhancements to tm. To join the tm ML, send - e-mail to - - tm-ja-admin@chamonix.jaist.ac.jp (Japanese) - tm-en-admin@chamonix.jaist.ac.jp (English) - - Since the user registration is done manually, please write the mail - body in human-recognizable language (^_^). diff --git a/SEMI-CFG b/SEMI-CFG deleted file mode 100644 index cda0c6e..0000000 --- a/SEMI-CFG +++ /dev/null @@ -1,147 +0,0 @@ -;;; -*-Emacs-Lisp-*- -;;; -;;; $Id: SEMI-CFG,v 0.7 1997-05-13 14:32:15 morioka Exp $ -;;; - -(defvar default-load-path load-path) -;; (setq load-path (append -;; (mapcar (function -;; (lambda (path) -;; (expand-file-name path default-directory) -;; )) -;; '("." "../emu" "../apel" "../bitmap-mule" -;; "../mu" "../mel") -;; ) -;; load-path)) - -(add-to-list 'load-path - (expand-file-name "../../site-lisp/apel" data-directory)) - -(when (boundp 'LISPDIR) - (add-to-list 'default-load-path LISPDIR) - (add-to-list 'load-path LISPDIR) - (add-to-list 'load-path (expand-file-name "apel" LISPDIR)) - ) - -(require 'install) -(require 'cl) - -(add-path "bitmap-mule") -(add-path "mel") - -(add-to-list 'load-path (expand-file-name ".")) - - -;;; @ Please specify optional package directory if you use them. -;;; - -;; It is only necessary to use `add-path' if these packages are not -;; already on the standard load-path of Emacs. - -;; Function `get-latest-path' detect latest version of such package -;; under load-path directories. If you want to use a version of a -;; package instead of latest version, please specify by argument of -;; function `add-path'. - -;; Function `add-path' finds path under load-path directories. If a -;; package does not exist in load-path, please specify by absolutely -;; (`~/' is available), for example -;; (add-path "~/lib/elisp/mailcrypt-3.4") -;; or -;; (add-path "/opt/share/xmule/site-lisp/mailcrypt-3.4") - - -;;; @@ Please specify Mailcrypt path. -;;; - -;; Use latest version installed in load-path. - -(let ((path (get-latest-path "mailcrypt" 'all-paths))) - (if path - (add-path path) - )) - -;; Or please specify path. -;; (add-path "mailcrypt-3.4" 'all-paths) - - -;;; @@ Please specify BBDB path. -;;; - -(let ((path (get-latest-path "bbdb" 'all-paths))) - (if path - (add-path path) - )) - -;; Or please specify path. -;; (add-path "bbdb-1.50" 'all-paths) - - -;;; @ shell -;;; - -;; Please specify shell command path. -(setq SHELL - (find-if (function file-exists-p) - '("/bin/sh" "/usr/bin/sh") - )) - -;; Please specify shell command option. -(setq SHELLOPTION "-c") - - -;;; @ Please specify prefix of install directory. -;;; - -;; Please specify install path prefix. -;; If it is omitted, shared directory (maybe /usr/local is used). -(defvar PREFIX install-prefix) -;;(setq PREFIX "~/") - -;; Please specify install path prefix for binaries. -(defvar EXEC_PREFIX - (if (or running-emacs-18 running-xemacs) - (expand-file-name "../../.." exec-directory) - (expand-file-name "../../../.." exec-directory) - )) - -;; Please specify emu prefix [optional] -(setq EMU_PREFIX - (if (string-match "XEmacs" emacs-version) - "emu" - "")) - -;; Please specify SEMI prefix [optional] -(setq SEMI_PREFIX "semi") - - -;;; @ executables -;;; - -;; Please specify binary path. -(defvar BIN_DIR (expand-file-name "bin" EXEC_PREFIX)) - -;; Please specify binary path. (for external method scripts) -(setq METHOD_DIR (expand-file-name "share/semi" PREFIX)) - - - - -;;; @ optional settings -;;; - -;; It is generated by automatically. Please set variable `PREFIX'. -;; If you don't like default directory tree, please set it. -(defvar LISPDIR (install-detect-elisp-directory PREFIX)) -;; (setq install-default-elisp-directory "~/lib/emacs/lisp") - -(setq SEMI_KERNEL_DIR (expand-file-name SEMI_PREFIX LISPDIR)) -(setq SETUP_FILE_DIR SEMI_KERNEL_DIR) - -(setq METHOD_SRC_DIR "methods") -(setq METHODS - '("tm-au" "tm-file" "tm-html" "tm-image" "tm-mpeg" - "tm-plain" "tm-ps" - "tmdecode")) - -;;; SEMI-CFG ends here diff --git a/SEMI-ELS b/SEMI-ELS deleted file mode 100644 index 22a6632..0000000 --- a/SEMI-ELS +++ /dev/null @@ -1,42 +0,0 @@ -;;; -*-Emacs-Lisp-*- -;;; -;;; $Id: SEMI-ELS,v 0.6 1997-03-14 08:48:07 morioka Exp $ -;;; - -(setq semi-modules-to-compile - '(signature - mime-def - eword-decode eword-encode - mime-parse mime-view mime-text mime-play mime-partial - mime-tar mime-file - mime-edit - semi-setup mail-mime-setup)) - -(setq semi-modules-not-to-compile nil) - -(mapcar (function - (lambda (cell) - (let ((c-module (car cell)) - (i-modules (cdr cell)) - ) - (if (module-installed-p c-module) - (setq semi-modules-to-compile - (nconc semi-modules-to-compile i-modules)) - (setq semi-modules-not-to-compile - (nconc semi-modules-not-to-compile i-modules)) - ) - ))) - '((mailcrypt mime-pgp mime-mc) - (bbdb mime-bbdb) - )) - -(if (or (string-match "XEmacs" emacs-version) - (featurep 'mule)) - (setq semi-modules-to-compile - (nconc semi-modules-to-compile '(mime-image))) - ) - -(setq semi-modules (append semi-modules-to-compile - semi-modules-not-to-compile)) - -;;; SEMI-ELS ends here diff --git a/SEMI-MK b/SEMI-MK deleted file mode 100644 index 02c7e44..0000000 --- a/SEMI-MK +++ /dev/null @@ -1,53 +0,0 @@ -;;; -*-Emacs-Lisp-*- -;;; -;;; $Id: SEMI-MK,v 0.5 1997-05-13 15:03:32 morioka Exp $ -;;; - -(defun config-semi () - (let (prefix exec-prefix lisp-dir) - (and (setq prefix (car command-line-args-left)) - (or (string-equal "NONE" prefix) - (defvar PREFIX prefix) - )) - (setq command-line-args-left (cdr command-line-args-left)) - (and (setq exec-prefix (car command-line-args-left)) - (or (string-equal "NONE" exec-prefix) - (defvar EXEC_PREFIX exec-prefix) - )) - (setq command-line-args-left (cdr command-line-args-left)) - (and (setq lisp-dir (car command-line-args-left)) - (or (string-equal "NONE" lisp-dir) - (defvar LISPDIR lisp-dir) - )) - (setq command-line-args-left (cdr command-line-args-left)) - ) - (load-file "SEMI-CFG") - (load-file "SEMI-ELS") - (princ (format "PREFIX=%s\tEXEC_PREFIX=%s -LISPDIR=%s\n" PREFIX EXEC_PREFIX LISPDIR)) - ) - -(defun directory= (dir1 dir2) - (string= (file-name-as-directory dir1)(file-name-as-directory dir2)) - ) - -(defun compile-semi () - (config-semi) - (print load-path) - (compile-elisp-modules semi-modules-to-compile ".") - (compile-elisp-module 'mime-setup ".") - ) - -(defun install-semi () - (config-semi) - (princ (format "%s\n" emacs-version)) - (install-elisp-modules semi-modules "." SEMI_KERNEL_DIR) - (install-elisp-modules '(mime-setup) "." SETUP_FILE_DIR) - ) - -(defun install-execs () - (config-semi) - (install-files METHODS METHOD_SRC_DIR METHOD_DIR nil t) - ) - -;;; SEMI-MK ends here diff --git a/eword-decode.el b/eword-decode.el deleted file mode 100644 index 9941117..0000000 --- a/eword-decode.el +++ /dev/null @@ -1,462 +0,0 @@ -;;; eword-decode.el --- RFC 2047 based encoded-word decoder for GNU Emacs - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: ENAMI Tsugutomo -;; MORIOKA Tomohiko -;; Maintainer: MORIOKA Tomohiko -;; Created: 1995/10/03 -;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'. -;; Renamed: 1993/06/03 to tiny-mime.el -;; Renamed: 1995/10/03 from tiny-mime.el (split off encoder) -;; Renamed: 1997/02/22 from tm-ew-d.el -;; Version: $Revision: 0.16 $ -;; Keywords: encoded-word, MIME, multilingual, header, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'std11-parse) -(require 'mel) -(require 'mime-def) - - -;;; @ version -;;; - -(defconst eword-decode-RCS-ID - "$Id: eword-decode.el,v 0.16 1997-06-18 13:26:28 morioka Exp $") -(defconst eword-decode-version (get-version-string eword-decode-RCS-ID)) - - -;;; @ MIME encoded-word definition -;;; - -(defconst eword-encoded-text-regexp "[!->@-~]+") -(defconst eword-encoded-word-regexp - (concat (regexp-quote "=?") - "\\(" - mime-charset-regexp - "\\)" - (regexp-quote "?") - "\\(B\\|Q\\)" - (regexp-quote "?") - "\\(" - eword-encoded-text-regexp - "\\)" - (regexp-quote "?="))) - - -;;; @@ Base64 -;;; - -(defconst base64-token-regexp "[A-Za-z0-9+/]") -(defconst base64-token-padding-regexp "[A-Za-z0-9+/=]") - -(defconst eword-B-encoded-text-regexp - (concat "\\(\\(" - base64-token-regexp - base64-token-regexp - base64-token-regexp - base64-token-regexp - "\\)*" - base64-token-regexp - base64-token-regexp - base64-token-padding-regexp - base64-token-padding-regexp - "\\)")) - -;; (defconst eword-B-encoding-and-encoded-text-regexp -;; (concat "\\(B\\)\\?" eword-B-encoded-text-regexp)) - - -;;; @@ Quoted-Printable -;;; - -(defconst quoted-printable-hex-chars "0123456789ABCDEF") -(defconst quoted-printable-octet-regexp - (concat "=[" quoted-printable-hex-chars - "][" quoted-printable-hex-chars "]")) - -(defconst eword-Q-encoded-text-regexp - (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+")) -;; (defconst eword-Q-encoding-and-encoded-text-regexp -;; (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp)) - - -;;; @ for string -;;; - -(defun eword-decode-string (string &optional must-unfold) - "Decode MIME encoded-words in STRING. - -STRING is unfolded before decoding. - -If an encoded-word is broken or your emacs implementation can not -decode the charset included in it, it is not decoded. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (setq string (std11-unfold-string string)) - (let ((dest "")(ew nil) - beg end) - (while (and (string-match eword-encoded-word-regexp string) - (setq beg (match-beginning 0) - end (match-end 0)) - ) - (if (> beg 0) - (if (not - (and (eq ew t) - (string-match "^[ \t]+$" (substring string 0 beg)) - )) - (setq dest (concat dest (substring string 0 beg))) - ) - ) - (setq dest - (concat dest - (eword-decode-encoded-word - (substring string beg end) must-unfold) - )) - (setq string (substring string end)) - (setq ew t) - ) - (concat dest string) - )) - - -;;; @ for region -;;; - -(defun eword-decode-region (start end &optional unfolding must-unfold) - "Decode MIME encoded-words in region between START and END. - -If UNFOLDING is not nil, it unfolds before decoding. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (interactive "*r") - (save-excursion - (save-restriction - (narrow-to-region start end) - (if unfolding - (eword-decode-unfold) - ) - (goto-char (point-min)) - (while (re-search-forward (concat "\\(" eword-encoded-word-regexp "\\)" - "\\(\n?[ \t]\\)+" - "\\(" eword-encoded-word-regexp "\\)") - nil t) - (replace-match "\\1\\6") - (goto-char (point-min)) - ) - (while (re-search-forward eword-encoded-word-regexp nil t) - (insert (eword-decode-encoded-word - (prog1 - (buffer-substring (match-beginning 0) (match-end 0)) - (delete-region (match-beginning 0) (match-end 0)) - ) must-unfold)) - ) - ))) - - -;;; @ for message header -;;; - -(defun eword-decode-header (&optional separator) - "Decode MIME encoded-words in header fields. -If SEPARATOR is not nil, it is used as header separator." - (interactive "*") - (save-excursion - (save-restriction - (std11-narrow-to-header separator) - (eword-decode-region (point-min) (point-max) t) - ))) - -(defun eword-decode-unfold () - (goto-char (point-min)) - (let (field beg end) - (while (re-search-forward std11-field-head-regexp nil t) - (setq beg (match-beginning 0) - end (std11-field-end)) - (setq field (buffer-substring beg end)) - (if (string-match eword-encoded-word-regexp field) - (save-restriction - (narrow-to-region (goto-char beg) end) - (while (re-search-forward "\n\\([ \t]\\)" nil t) - (replace-match (match-string 1)) - ) - (goto-char (point-max)) - )) - ))) - - -;;; @ encoded-word decoder -;;; - -(defvar eword-warning-face nil "Face used for invalid encoded-word.") - -(defun eword-decode-encoded-word (word &optional must-unfold) - "Decode WORD if it is an encoded-word. - -If your emacs implementation can not decode the charset of WORD, it -returns WORD. Similarly the encoded-word is broken, it returns WORD. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-word (generated by bad manner MUA such -as a version of Net$cape)." - (or (if (string-match eword-encoded-word-regexp word) - (let ((charset - (substring word (match-beginning 1) (match-end 1)) - ) - (encoding - (upcase - (substring word (match-beginning 2) (match-end 2)) - )) - (text - (substring word (match-beginning 3) (match-end 3)) - )) - (condition-case err - (eword-decode-encoded-text charset encoding text must-unfold) - (error - (and - (add-text-properties 0 (length word) - (and eword-warning-face - (list 'face eword-warning-face)) - word) - word))) - )) - word)) - - -;;; @ encoded-text decoder -;;; - -(defun eword-decode-encoded-text (charset encoding string - &optional must-unfold) - "Decode STRING as an encoded-text. - -If your emacs implementation can not decode CHARSET, it returns nil. - -If ENCODING is not \"B\" or \"Q\", it occurs error. -So you should write error-handling code if you don't want break by errors. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-text (generated by bad manner MUA such -as a version of Net$cape)." - (let ((cs (mime-charset-to-coding-system charset))) - (if cs - (let ((dest - (cond - ((string-equal "B" encoding) - (if (and (string-match eword-B-encoded-text-regexp string) - (string-equal string (match-string 0 string))) - (base64-decode-string string) - (error "Invalid encoded-text %s" string))) - ((string-equal "Q" encoding) - (if (and (string-match eword-Q-encoded-text-regexp string) - (string-equal string (match-string 0 string))) - (q-encoding-decode-string string) - (error "Invalid encoded-text %s" string))) - (t - (error "Invalid encoding %s" encoding) - ))) - ) - (if dest - (progn - (setq dest (decode-coding-string dest cs)) - (if must-unfold - (mapconcat (function - (lambda (chr) - (cond - ((eq chr ?\n) "") - ((eq chr ?\t) " ") - (t (char-to-string chr))) - )) - (std11-unfold-string dest) - "") - dest) - )))))) - - -;;; @ lexical analyze -;;; - -(defvar eword-lexical-analyze-cache nil) -(defvar eword-lexical-analyze-cache-max 299 - "*Max position of eword-lexical-analyze-cache. -It is max size of eword-lexical-analyze-cache - 1.") - -(defun eword-analyze-quoted-string (string) - (let ((p (std11-check-enclosure string ?\" ?\"))) - (if p - (cons (cons 'quoted-string - (decode-mime-charset-string - (std11-strip-quoted-pair (substring string 1 (1- p))) - default-mime-charset)) - (substring string p)) - ))) - -(defun eword-analyze-comment (string &optional must-unfold) - (let ((p (std11-check-enclosure string ?\( ?\) t))) - (if p - (cons (cons 'comment - (eword-decode-string - (decode-mime-charset-string - (std11-strip-quoted-pair (substring string 1 (1- p))) - default-mime-charset) - must-unfold)) - (substring string p)) - ))) - -(defun eword-analyze-encoded-word (string &optional must-unfold) - (if (eq (string-match eword-encoded-word-regexp string) 0) - (let ((end (match-end 0)) - (dest (eword-decode-encoded-word (match-string 0 string) - must-unfold)) - ) - (setq string (substring string end)) - (while (eq (string-match `,(concat "[ \t\n]*\\(" - eword-encoded-word-regexp - "\\)") - string) - 0) - (setq end (match-end 0)) - (setq dest - (concat dest - (eword-decode-encoded-word (match-string 1 string) - must-unfold)) - string (substring string end)) - ) - (cons (cons 'atom dest) - (if (string= string "") - nil - string)) - ))) - -(defun eword-lexical-analyze-internal (string must-unfold) - (let (dest ret) - (while (not (string-equal string "")) - (setq ret - (or (eword-analyze-quoted-string string) - (std11-analyze-domain-literal string) - (eword-analyze-comment string must-unfold) - (std11-analyze-spaces string) - (std11-analyze-special string) - (eword-analyze-encoded-word string must-unfold) - (std11-analyze-atom string) - '((error) . "") - )) - (setq dest (cons (car ret) dest)) - (setq string (cdr ret)) - ) - (nreverse dest) - )) - -(defun eword-lexical-analyze (string &optional must-unfold) - "Return lexical analyzed list corresponding STRING. -It is like std11-lexical-analyze, but it decodes non us-ascii -characters encoded as encoded-words or invalid \"raw\" format. -\"Raw\" non us-ascii characters are regarded as variable -`default-mime-charset'." - (let ((key (copy-sequence string)) - ret) - (set-text-properties 0 (length key) nil key) - (if (setq ret (assoc key eword-lexical-analyze-cache)) - (cdr ret) - (setq ret (eword-lexical-analyze-internal key must-unfold)) - (setq eword-lexical-analyze-cache - (cons (cons key ret) - (last eword-lexical-analyze-cache - eword-lexical-analyze-cache-max))) - ret))) - -(defun eword-decode-structured-field-body (string &optional must-unfold) - "Decode non us-ascii characters in STRING as structured field body. -STRING is unfolded before decoding. - -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -characters are regarded as variable `default-mime-charset'. - -If an encoded-word is broken or your emacs implementation can not -decode the charset included in it, it is not decoded. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (mapconcat (function - (lambda (token) - (let ((type (car token)) - (value (cdr token))) - (cond ((eq type 'quoted-string) - (std11-wrap-as-quoted-string value) - ) - ((eq type 'comment) - (concat "(" - (std11-wrap-as-quoted-pairs value '(?( ?))) - ")") - ) - (t - value))))) - (eword-lexical-analyze string must-unfold) - "")) - -(defun eword-decode-unstructured-field-body (string &optional must-unfold) - "Decode non us-ascii characters in STRING as unstructured field body. -STRING is unfolded before decoding. - -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -characters are regarded as variable `default-mime-charset'. - -If an encoded-word is broken or your emacs implementation can not -decode the charset included in it, it is not decoded. - -If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even -if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape)." - (eword-decode-string - (decode-mime-charset-string string default-mime-charset) - must-unfold)) - -(defun eword-extract-address-components (string) - "Extract full name and canonical address from STRING. -Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). -If no name can be extracted, FULL-NAME will be nil. -It decodes non us-ascii characters in FULL-NAME encoded as -encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii -characters are regarded as variable `default-mime-charset'." - (let* ((structure (car (std11-parse-address - (eword-lexical-analyze - (std11-unfold-string string) 'must-unfold)))) - (phrase (std11-full-name-string structure)) - (address (std11-address-string structure)) - ) - (list phrase address) - )) - - -;;; @ end -;;; - -(provide 'eword-decode) - -;;; eword-decode.el ends here diff --git a/eword-encode.el b/eword-encode.el deleted file mode 100644 index 80e8e87..0000000 --- a/eword-encode.el +++ /dev/null @@ -1,623 +0,0 @@ -;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Version: $Revision: 0.25 $ -;; Keywords: encoded-word, MIME, multilingual, header, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'emu) -(require 'mel) -(require 'std11) -(require 'mime-def) -(require 'eword-decode) - - -;;; @ version -;;; - -(defconst eword-encode-RCS-ID - "$Id: eword-encode.el,v 0.25 1997-06-26 09:21:38 morioka Exp $") -(defconst eword-encode-version (get-version-string eword-encode-RCS-ID)) - - -;;; @ variables -;;; - -(defvar eword-field-encoding-method-alist - '(("X-Nsubject" . iso-2022-jp-2) - ("Newsgroups" . nil) - ("Message-ID" . nil) - (t . mime) - ) - "*Alist to specify field encoding method. -Its key is field-name, value is encoding method. - -If method is `mime', this field will be encoded into MIME format. - -If method is a MIME-charset, this field will be encoded as the charset -when it must be convert into network-code. - -If method is `default-mime-charset', this field will be encoded as -variable `default-mime-charset' when it must be convert into -network-code. - -If method is nil, this field will not be encoded.") - -(defvar eword-generate-X-Nsubject nil - "*If it is not nil, X-Nsubject field is generated -when Subject field is encoded by `eword-encode-header'.") - -(defvar eword-charset-encoding-alist - '((us-ascii . nil) - (iso-8859-1 . "Q") - (iso-8859-2 . "Q") - (iso-8859-3 . "Q") - (iso-8859-4 . "Q") - (iso-8859-5 . "Q") - (koi8-r . "Q") - (iso-8859-7 . "Q") - (iso-8859-8 . "Q") - (iso-8859-9 . "Q") - (iso-2022-jp . "B") - (iso-2022-kr . "B") - (gb2312 . "B") - (cn-gb . "B") - (cn-gb-2312 . "B") - (euc-kr . "B") - (iso-2022-jp-2 . "B") - (iso-2022-int-1 . "B") - )) - - -;;; @ encoded-text encoder -;;; - -(defun eword-encode-text (charset encoding string &optional mode) - "Encode STRING as an encoded-word, and return the result. -CHARSET is a symbol to indicate MIME charset of the encoded-word. -ENCODING allows \"B\" or \"Q\". -MODE is allows `text', `comment', `phrase' or nil. Default value is -`phrase'." - (let ((text - (cond ((string= encoding "B") - (base64-encode-string string)) - ((string= encoding "Q") - (q-encoding-encode-string string mode)) - ) - )) - (if text - (concat "=?" (upcase (symbol-name charset)) "?" - encoding "?" text "?=") - ))) - - -;;; @ charset word -;;; - -(defsubst eword-encode-char-type (character) - (if (or (eq character ? )(eq character ?\t)) - nil - (char-charset character) - )) - -(defun eword-encode-divide-into-charset-words (string) - (let ((len (length string)) - dest) - (while (> len 0) - (let* ((chr (sref string 0)) - (charset (eword-encode-char-type chr)) - (i (char-bytes chr)) - ) - (while (and (< i len) - (setq chr (sref string i)) - (eq charset (eword-encode-char-type chr)) - ) - (setq i (+ i (char-bytes chr))) - ) - (setq dest (cons (cons charset (substring string 0 i)) dest) - string (substring string i) - len (- len i) - ))) - (nreverse dest) - )) - - -;;; @ word -;;; - -(defun eword-encode-charset-words-to-words (charset-words) - (let (dest) - (while charset-words - (let* ((charset-word (car charset-words)) - (charset (car charset-word)) - ) - (if charset - (let ((charsets (list charset)) - (str (cdr charset-word)) - ) - (catch 'tag - (while (setq charset-words (cdr charset-words)) - (setq charset-word (car charset-words) - charset (car charset-word)) - (if (null charset) - (throw 'tag nil) - ) - (or (memq charset charsets) - (setq charsets (cons charset charsets)) - ) - (setq str (concat str (cdr charset-word))) - )) - (setq dest (cons (cons charsets str) dest)) - ) - (setq dest (cons charset-word dest) - charset-words (cdr charset-words) - )))) - (nreverse dest) - )) - - -;;; @ rule -;;; - -(defmacro tm-eword::make-rword (text charset encoding type) - (` (list (, text)(, charset)(, encoding)(, type)))) -(defmacro tm-eword::rword-text (rword) - (` (car (, rword)))) -(defmacro tm-eword::rword-charset (rword) - (` (car (cdr (, rword))))) -(defmacro tm-eword::rword-encoding (rword) - (` (car (cdr (cdr (, rword)))))) -(defmacro tm-eword::rword-type (rword) - (` (car (cdr (cdr (cdr (, rword))))))) - -(defun tm-eword::find-charset-rule (charsets) - (if charsets - (let* ((charset (charsets-to-mime-charset charsets)) - (encoding (cdr (assq charset eword-charset-encoding-alist))) - ) - (list charset encoding) - ))) - -(defun tm-eword::words-to-ruled-words (wl &optional mode) - (mapcar (function - (lambda (word) - (let ((ret (tm-eword::find-charset-rule (car word)))) - (tm-eword::make-rword (cdr word) (car ret)(nth 1 ret) mode) - ))) - wl)) - -(defun tm-eword::space-process (seq) - (let (prev a ac b c cc) - (while seq - (setq b (car seq)) - (setq seq (cdr seq)) - (setq c (car seq)) - (setq cc (tm-eword::rword-charset c)) - (if (null (tm-eword::rword-charset b)) - (progn - (setq a (car prev)) - (setq ac (tm-eword::rword-charset a)) - (if (and (tm-eword::rword-encoding a) - (tm-eword::rword-encoding c)) - (cond ((eq ac cc) - (setq prev (cons - (cons (concat (car a)(car b)(car c)) - (cdr a)) - (cdr prev) - )) - (setq seq (cdr seq)) - ) - (t - (setq prev (cons - (cons (concat (car a)(car b)) - (cdr a)) - (cdr prev) - )) - )) - (setq prev (cons b prev)) - )) - (setq prev (cons b prev)) - )) - (reverse prev) - )) - -(defun tm-eword::split-string (str &optional mode) - (tm-eword::space-process - (tm-eword::words-to-ruled-words - (eword-encode-charset-words-to-words - (eword-encode-divide-into-charset-words str)) - mode))) - - -;;; @ length -;;; - -(defun tm-eword::encoded-word-length (rword) - (let ((string (tm-eword::rword-text rword)) - (charset (tm-eword::rword-charset rword)) - (encoding (tm-eword::rword-encoding rword)) - ret) - (setq ret - (cond ((string-equal encoding "B") - (setq string (encode-mime-charset-string string charset)) - (base64-encoded-length string) - ) - ((string-equal encoding "Q") - (setq string (encode-mime-charset-string string charset)) - (q-encoding-encoded-length string - (tm-eword::rword-type rword)) - ))) - (if ret - (cons (+ 7 (length (symbol-name charset)) ret) string) - ))) - - -;;; @ encode-string -;;; - -(defun tm-eword::encode-string-1 (column rwl) - (let* ((rword (car rwl)) - (ret (tm-eword::encoded-word-length rword)) - string len) - (if (null ret) - (cond ((and (setq string (car rword)) - (or (<= (setq len (+ (length string) column)) 76) - (<= column 1)) - ) - (setq rwl (cdr rwl)) - ) - (t - (setq string "\n ") - (setq len 1) - )) - (cond ((and (setq len (car ret)) - (<= (+ column len) 76) - ) - (setq string - (eword-encode-text - (tm-eword::rword-charset rword) - (tm-eword::rword-encoding rword) - (cdr ret) - (tm-eword::rword-type rword) - )) - (setq len (+ (length string) column)) - (setq rwl (cdr rwl)) - ) - (t - (setq string (car rword)) - (let* ((p 0) np - (str "") nstr) - (while (and (< p len) - (progn - (setq np (+ p (char-bytes (sref string p)))) - (setq nstr (substring string 0 np)) - (setq ret (tm-eword::encoded-word-length - (cons nstr (cdr rword)) - )) - (setq nstr (cdr ret)) - (setq len (+ (car ret) column)) - (<= len 76) - )) - (setq str nstr - p np)) - (if (string-equal str "") - (setq string "\n " - len 1) - (setq rwl (cons (cons (substring string p) (cdr rword)) - (cdr rwl))) - (setq string - (eword-encode-text - (tm-eword::rword-charset rword) - (tm-eword::rword-encoding rword) - str - (tm-eword::rword-type rword))) - (setq len (+ (length string) column)) - ) - ))) - ) - (list string len rwl) - )) - -(defun tm-eword::encode-rwl (column rwl) - (let (ret dest ps special str ew-f pew-f) - (while rwl - (setq ew-f (nth 2 (car rwl))) - (if (and pew-f ew-f) - (setq rwl (cons '(" ") rwl) - pew-f nil) - (setq pew-f ew-f) - ) - (setq ret (tm-eword::encode-string-1 column rwl)) - (setq str (car ret)) - (if (eq (elt str 0) ?\n) - (if (eq special ?\() - (progn - (setq dest (concat dest "\n (")) - (setq ret (tm-eword::encode-string-1 2 rwl)) - (setq str (car ret)) - )) - (cond ((eq special ? ) - (if (string= str "(") - (setq ps t) - (setq dest (concat dest " ")) - (setq ps nil) - )) - ((eq special ?\() - (if ps - (progn - (setq dest (concat dest " (")) - (setq ps nil) - ) - (setq dest (concat dest "(")) - ) - ))) - (cond ((string= str " ") - (setq special ? ) - ) - ((string= str "(") - (setq special ?\() - ) - (t - (setq special nil) - (setq dest (concat dest str)) - )) - (setq column (nth 1 ret) - rwl (nth 2 ret)) - ) - (list dest column) - )) - -(defun tm-eword::encode-string (column str &optional mode) - (tm-eword::encode-rwl column (tm-eword::split-string str mode)) - ) - - -;;; @ converter -;;; - -(defun tm-eword::phrase-to-rwl (phrase) - (let (token type dest str) - (while phrase - (setq token (car phrase)) - (setq type (car token)) - (cond ((eq type 'quoted-string) - (setq str (concat "\"" (cdr token) "\"")) - (setq dest - (append dest - (list - (let ((ret (tm-eword::find-charset-rule - (find-non-ascii-charset-string str)))) - (tm-eword::make-rword - str (car ret)(nth 1 ret) 'phrase) - ) - ))) - ) - ((eq type 'comment) - (setq dest - (append dest - '(("(" nil nil)) - (tm-eword::words-to-ruled-words - (eword-encode-charset-words-to-words - (eword-encode-divide-into-charset-words - (cdr token))) - 'comment) - '((")" nil nil)) - )) - ) - (t - (setq dest - (append dest - (tm-eword::words-to-ruled-words - (eword-encode-charset-words-to-words - (eword-encode-divide-into-charset-words - (cdr token)) - ) 'phrase))) - )) - (setq phrase (cdr phrase)) - ) - (tm-eword::space-process dest) - )) - -(defun tm-eword::phrase-route-addr-to-rwl (phrase-route-addr) - (if (eq (car phrase-route-addr) 'phrase-route-addr) - (let ((phrase (nth 1 phrase-route-addr)) - (route (nth 2 phrase-route-addr)) - dest) - (if (eq (car (car phrase)) 'spaces) - (setq phrase (cdr phrase)) - ) - (setq dest (tm-eword::phrase-to-rwl phrase)) - (if dest - (setq dest (append dest '((" " nil nil)))) - ) - (append - dest - (list (list (concat "<" (std11-addr-to-string route) ">") nil nil)) - )))) - -(defun tm-eword::addr-spec-to-rwl (addr-spec) - (if (eq (car addr-spec) 'addr-spec) - (list (list (std11-addr-to-string (cdr addr-spec)) nil nil)) - )) - -(defun tm-eword::mailbox-to-rwl (mbox) - (let ((addr (nth 1 mbox)) - (comment (nth 2 mbox)) - dest) - (setq dest (or (tm-eword::phrase-route-addr-to-rwl addr) - (tm-eword::addr-spec-to-rwl addr) - )) - (if comment - (setq dest - (append dest - '((" " nil nil) - ("(" nil nil)) - (tm-eword::split-string comment 'comment) - '((")" nil nil)) - ))) - dest)) - -(defun tm-eword::addresses-to-rwl (addresses) - (let ((dest (tm-eword::mailbox-to-rwl (car addresses)))) - (if dest - (while (setq addresses (cdr addresses)) - (setq dest (append dest - '(("," nil nil)) - '((" " nil nil)) - (tm-eword::mailbox-to-rwl (car addresses)) - )) - )) - dest)) - -(defun tm-eword::encode-address-list (column str) - (tm-eword::encode-rwl - column - (tm-eword::addresses-to-rwl (std11-parse-addresses-string str)) - )) - - -;;; @ application interfaces -;;; - -(defun eword-encode-field (string) - "Encode header field STRING, and return the result. -A lexical token includes non-ASCII character is encoded as MIME -encoded-word. ASCII token is not encoded." - (setq string (std11-unfold-string string)) - (let ((ret (string-match std11-field-head-regexp string))) - (or (if ret - (let ((field-name (substring string 0 (1- (match-end 0)))) - (field-body (eliminate-top-spaces - (substring string (match-end 0)))) - ) - (if (setq ret - (cond ((string-equal field-body "") "") - ((memq (intern (downcase field-name)) - '(reply-to - from sender - resent-reply-to resent-from - resent-sender to resent-to - cc resent-cc - bcc resent-bcc dcc) - ) - (car (tm-eword::encode-address-list - (+ (length field-name) 2) field-body)) - ) - (t - (car (tm-eword::encode-string - (1+ (length field-name)) - field-body 'text)) - )) - ) - (concat field-name ": " ret) - ))) - (car (tm-eword::encode-string 0 string)) - ))) - -(defun eword-in-subject-p () - (let ((str (std11-field-body "Subject"))) - (if (and str (string-match eword-encoded-word-regexp str)) - str))) - -(defun eword-encode-header (&optional code-conversion) - "Encode header fields to network representation, such as MIME encoded-word. - -It refer variable `eword-field-encoding-method-alist'." - (interactive "*") - (save-excursion - (save-restriction - (std11-narrow-to-header mail-header-separator) - (goto-char (point-min)) - (let ((default-cs (mime-charset-to-coding-system default-mime-charset)) - beg end field-name) - (while (re-search-forward std11-field-head-regexp nil t) - (setq beg (match-beginning 0)) - (setq field-name (buffer-substring beg (1- (match-end 0)))) - (setq end (std11-field-end)) - (and (find-non-ascii-charset-region beg end) - (let ((ret (or (let ((fname (downcase field-name))) - (assoc-if - (function - (lambda (str) - (and (stringp str) - (string= fname (downcase str)) - ))) - eword-field-encoding-method-alist)) - (assq t eword-field-encoding-method-alist) - ))) - (if ret - (let ((method (cdr ret))) - (cond ((eq method 'mime) - (let ((field - (buffer-substring-no-properties beg end) - )) - (delete-region beg end) - (insert (eword-encode-field field)) - )) - (code-conversion - (let ((cs - (or (mime-charset-to-coding-system - method) - default-cs))) - (encode-coding-region beg end cs) - ))) - )) - )) - )) - (and eword-generate-X-Nsubject - (or (std11-field-body "X-Nsubject") - (let ((str (eword-in-subject-p))) - (if str - (progn - (setq str - (eword-decode-string - (std11-unfold-string str))) - (if code-conversion - (setq str - (encode-mime-charset-string - str - (or (cdr (assoc-if - (function - (lambda (str) - (and (stringp str) - (string= "x-nsubject" - (downcase str)) - ))) - eword-field-encoding-method-alist)) - 'iso-2022-jp-2))) - ) - (insert (concat "\nX-Nsubject: " str)) - ))))) - ))) - -(defun eword-encode-string (str &optional column mode) - (car (tm-eword::encode-rwl (or column 0) (tm-eword::split-string str mode))) - ) - - -;;; @ end -;;; - -(provide 'eword-encode) - -;;; eword-encode.el ends here diff --git a/mail-mime-setup.el b/mail-mime-setup.el deleted file mode 100644 index efa7107..0000000 --- a/mail-mime-setup.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; mail-mime-setup.el --- setup file for mail-mode. - -;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Version: -;; $Id: mail-mime-setup.el,v 0.0 1997-03-14 08:47:06 morioka Exp $ -;; Keywords: mail-mode, MIME, multimedia, multilingual, encoded-word - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'semi-setup) - - -(autoload 'turn-on-mime-edit "mime-edit" - "Unconditionally turn on MIME-Edit minor mode." t) - -(autoload 'eword-decode-header "eword-decode" - "Decode MIME encoded-words in header fields." t) - - -;;; @ for mail-mode, RMAIL and VM -;;; - -(add-hook 'mail-setup-hook 'eword-decode-header) -(add-hook 'mail-setup-hook 'turn-on-mime-edit 'append) -(add-hook 'mail-send-hook 'mime-edit-maybe-translate) -(set-alist 'mime-edit-split-message-sender-alist - 'mail-mode (function - (lambda () - (interactive) - (funcall send-mail-function) - ))) - - -;;; @ end -;;; - -(provide 'mail-mime-setup) - -;;; mail-mime-setup.el ends here diff --git a/mailcap.el b/mailcap.el deleted file mode 100644 index c39f76e..0000000 --- a/mailcap.el +++ /dev/null @@ -1,175 +0,0 @@ -;;; mailcap.el --- mailcap parser - -;; Copyright (C) 1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Created: 1997/6/27 -;; Version: $Id: mailcap.el,v 0.0 1997-06-27 10:15:46 morioka Exp $ -;; Keywords: mailcap, setting, configuration, MIME, multimedia - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -;;; @ comment -;;; - -(defsubst mailcap-skip-comment () - (let ((chr (char-after (point)))) - (when (or (= chr ?\n) - (= chr ?#)) - (forward-line) - t))) - - -;;; @ token -;;; - -(defsubst mailcap-look-at-token () - (if (looking-at mime/token-regexp) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (goto-char end) - (buffer-substring beg end) - ))) - - -;;; @ typefield -;;; - -(defsubst mailcap-look-at-type-field () - (let ((type (mailcap-look-at-token))) - (if (and type - (eq (char-after (point)) ?/) - ) - (progn - (forward-char) - (let ((subtype (mailcap-look-at-token))) - (if subtype - (cons (cons 'type type) - (unless (string= subtype "*") - (list (cons 'subtype subtype)) - )))))))) - - -;;; @ field separator -;;; - -(defsubst mailcap-skip-field-separator () - (let ((ret (looking-at "\\([ \t]\\|\\\\\n\\)*;\\([ \t]\\|\\\\\n\\)*"))) - (when ret - (goto-char (match-end 0)) - t))) - - -;;; @ mtext -;;; - -(defsubst mailcap-look-at-schar () - (let ((chr (char-after (point)))) - (if (and (>= chr ? ) - (/= chr ?\;) - (/= chr ?\\) - ) - (prog1 - chr - (forward-char))))) - -(defsubst mailcap-look-at-qchar () - (let ((chr (char-after (point)))) - (when (eq chr ?\\) - (forward-char 2) - (char-before (point)) - ))) - -(defsubst mailcap-look-at-mtext () - (let ((beg (point))) - (while (or (mailcap-look-at-schar) - (mailcap-look-at-schar))) - (buffer-substring beg (point)) - )) - - -;;; @ field -;;; - -(defsubst mailcap-look-at-field () - (let ((token (mailcap-look-at-token))) - (if token - (if (eq (char-after (point)) ?=) - (let ((value (progn - (forward-char) - (mailcap-look-at-mtext)))) - (if value - (cons token value) - )) - (list token) - )))) - - -;;; @ mailcap entry -;;; - -(defun mailcap-look-at-entry () - (let ((type (mailcap-look-at-type-field))) - (if (and type (mailcap-skip-field-separator)) - (let ((view (mailcap-look-at-mtext)) - fields field) - (when view - (while (and (mailcap-skip-field-separator) - (setq field (mailcap-look-at-field)) - ) - (setq fields (cons field fields)) - ) - (nconc type - (list (cons 'view view)) - fields)))))) - - -;;; @ main -;;; - -(defun mailcap-parse-buffer (&optional buffer order) - "Parse BUFFER as a mailcap, and return the result. -If optional argument ORDER is a function, result is sorted by it. -If optional argument ORDER is not specified, result is sorted original -order. Otherwise result is not sorted." - (save-excursion - (if buffer - (set-buffer buffer)) - (goto-char (point-min)) - (let (entries entry) - (while (progn - (while (mailcap-skip-comment)) - (setq entry (mailcap-look-at-entry)) - ) - (setq entries (cons entry entries)) - (forward-line) - ) - (cond ((functionp order) (sort entries order)) - ((null order) (nreverse entries)) - (t entries) - )))) - - -;;; @ end -;;; - -(provide 'mailcap) - -;;; mailcap.el ends here diff --git a/mime-bbdb.el b/mime-bbdb.el deleted file mode 100644 index b6695b0..0000000 --- a/mime-bbdb.el +++ /dev/null @@ -1,304 +0,0 @@ -;;; mime-bbdb.el --- SEMI shared module for BBDB - -;; Copyright (C) 1995,1996 Shuhei KOBAYASHI -;; Copyright (C) 1996 Artur Pioro -;; Copyright (C) 1997 MORIOKA Tomohiko - -;; Author: Shuhei KOBAYASHI -;; Artur Pioro -;; Maintainer: Shuhei KOBAYASHI -;; Version: $Id: mime-bbdb.el,v 0.3 1997-03-18 14:44:39 morioka Exp $ -;; Keywords: BBDB, MIME, multimedia, multilingual, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'file-detect) -(require 'std11) -(require 'mime-view) - -(if (module-installed-p 'bbdb-com) - (require 'bbdb-com) - (eval-when-compile - ;; imported from bbdb-1.51 - (defmacro bbdb-pop-up-elided-display () - '(if (boundp 'bbdb-pop-up-elided-display) - bbdb-pop-up-elided-display - bbdb-elided-display)) - (defmacro bbdb-user-mail-names () - "Returns a regexp matching the address of the logged-in user" - '(or bbdb-user-mail-names - (setq bbdb-user-mail-names - (concat "\\b" (regexp-quote (user-login-name)) "\\b")))) - )) - - -;;; @ User Variables -;;; - -(defvar mime-bbdb/use-mail-extr t - "*If non-nil, `mail-extract-address-components' is used. -Otherwise `mime-bbdb/extract-address-components' overrides it.") - -(defvar mime-bbdb/auto-create-p nil - "*If t, create new BBDB records automatically. -If function, then it is called with no arguments to decide whether an -entry should be automatically creaded. - -mime-bbdb uses this variable instead of `bbdb/mail-auto-create-p' or -`bbdb/news-auto-create-p' unless other tm-MUA overrides it.") - -(defvar mime-bbdb/delete-empty-window nil - "*If non-nil, delete empty BBDB window. -All bbdb-MUAs but bbdb-gnus display BBDB window even if it is empty. -If you prefer behavior of bbdb-gnus, set this variable to t. - -For framepop users: If empty, `framepop-banish' is used instead.") - -;;; @ mail-extr -;;; - -(defun mime-bbdb/extract-address-components (str) - (let* ((ret (std11-extract-address-components str)) - (phrase (car ret)) - (address (car (cdr ret))) - (methods mime-bbdb/canonicalize-full-name-methods)) - (while (and phrase methods) - (setq phrase (funcall (car methods) phrase) - methods (cdr methods))) - (if (string= address "") (setq address nil)) - (if (string= phrase "") (setq phrase nil)) - (list phrase address) - )) - -(or mime-bbdb/use-mail-extr - (progn - (require 'mail-extr) ; for `what-domain' - (or (fboundp 'tm:mail-extract-address-components) - (fset 'tm:mail-extract-address-components - (symbol-function 'mail-extract-address-components))) - (fset 'mail-extract-address-components - (symbol-function 'mime-bbdb/extract-address-components)) - )) - - -;;; @ bbdb-extract-field-value -;;; - -(or (fboundp 'tm:bbdb-extract-field-value) - (progn - ;; (require 'bbdb-hooks) ; not provided. - ;; (or (fboundp 'bbdb-extract-field-value) ; defined as autoload - (or (fboundp 'bbdb-header-start) - (load "bbdb-hooks")) - (fset 'tm:bbdb-extract-field-value - (symbol-function 'bbdb-extract-field-value)) - (defun bbdb-extract-field-value (field) - (let ((value (tm:bbdb-extract-field-value field))) - (and value - (eword-decode-string value)))) - )) - - -;;; @ full-name canonicalization methods -;;; - -(defun mime-bbdb/canonicalize-spaces (str) - (let (dest) - (while (string-match "\\s +" str) - (setq dest (cons (substring str 0 (match-beginning 0)) dest)) - (setq str (substring str (match-end 0))) - ) - (or (string= str "") - (setq dest (cons str dest))) - (setq dest (nreverse dest)) - (mapconcat 'identity dest " ") - )) - -(defun mime-bbdb/canonicalize-dots (str) - (let (dest) - (while (string-match "\\." str) - (setq dest (cons (substring str 0 (match-end 0)) dest)) - (setq str (substring str (match-end 0))) - ) - (or (string= str "") - (setq dest (cons str dest))) - (setq dest (nreverse dest)) - (mapconcat 'identity dest " ") - )) - -(defvar mime-bbdb/canonicalize-full-name-methods - '(eword-decode-string - mime-bbdb/canonicalize-dots - mime-bbdb/canonicalize-spaces)) - - -;;; @ BBDB functions for mime-view-mode -;;; - -(defun mime-bbdb/update-record (&optional offer-to-create) - "Return the record corresponding to the current MIME previewing message. -Creating or modifying it as necessary. A record will be created if -mime-bbdb/auto-create-p is non-nil, or if OFFER-TO-CREATE is non-nil and -the user confirms the creation." - (save-excursion - (if (and mime-view-buffer - (get-buffer mime-view-buffer)) - (set-buffer mime-view-buffer)) - (if bbdb-use-pop-up - (mime-bbdb/pop-up-bbdb-buffer offer-to-create) - (let* ((from (std11-field-body "From")) - (addr (if from - (car (cdr (mail-extract-address-components from)))))) - (if (or (null from) - (null addr) - (string-match (bbdb-user-mail-names) addr)) - (setq from (or (std11-field-body "To") from)) - ) - (if from - (bbdb-annotate-message-sender - from t - (or (bbdb-invoke-hook-for-value mime-bbdb/auto-create-p) - offer-to-create) - offer-to-create)) - )))) - -(defun mime-bbdb/annotate-sender (string) - "Add a line to the end of the Notes field of the BBDB record -corresponding to the sender of this message." - (interactive - (list (if bbdb-readonly-p - (error "The Insidious Big Brother Database is read-only.") - (read-string "Comments: ")))) - (bbdb-annotate-notes (mime-bbdb/update-record t) string)) - -(defun mime-bbdb/edit-notes (&optional arg) - "Edit the notes field or (with a prefix arg) a user-defined field -of the BBDB record corresponding to the sender of this message." - (interactive "P") - (let ((record (or (mime-bbdb/update-record t) - (error "")))) - (bbdb-display-records (list record)) - (if arg - (bbdb-record-edit-property record nil t) - (bbdb-record-edit-notes record t)))) - -(defun mime-bbdb/show-sender () - "Display the contents of the BBDB for the sender of this message. -This buffer will be in bbdb-mode, with associated keybindings." - (interactive) - (let ((record (mime-bbdb/update-record t))) - (if record - (bbdb-display-records (list record)) - (error "unperson")))) - -(defun mime-bbdb/pop-up-bbdb-buffer (&optional offer-to-create) - "Make the *BBDB* buffer be displayed along with the MIME preview window(s), -displaying the record corresponding to the sender of the current message." - (let ((framepop (eq temp-buffer-show-function 'framepop-display-buffer))) - (or framepop - (bbdb-pop-up-bbdb-buffer - (function - (lambda (w) - (let ((b (current-buffer))) - (set-buffer (window-buffer w)) - (prog1 (eq major-mode 'mime-view-mode) - (set-buffer b))))))) - (let ((bbdb-gag-messages t) - (bbdb-use-pop-up nil) - (bbdb-electric-p nil)) - (let ((record (mime-bbdb/update-record offer-to-create)) - (bbdb-elided-display (bbdb-pop-up-elided-display)) - (b (current-buffer))) - (if framepop - (if record - (bbdb-display-records (list record)) - (framepop-banish)) - (bbdb-display-records (if record (list record) nil)) - (if (and (null record) - mime-bbdb/delete-empty-window) - (delete-windows-on (get-buffer "*BBDB*")))) - (set-buffer b) - record)))) - -(defun mime-bbdb/define-keys () - (let ((mime-view-mode-map (current-local-map))) - (define-key mime-view-mode-map ";" 'mime-bbdb/edit-notes) - (define-key mime-view-mode-map ":" 'mime-bbdb/show-sender) - )) - -(add-hook 'mime-view-define-keymap-hook 'mime-bbdb/define-keys) - - -;;; @ for signature.el -;;; - -(defun signature/get-bbdb-sigtype (addr) - "Extract sigtype information from BBDB." - (let ((record (bbdb-search-simple nil addr))) - (and record - (bbdb-record-getprop record 'sigtype)) - )) - -(defun signature/set-bbdb-sigtype (sigtype addr) - "Add sigtype information to BBDB." - (let* ((bbdb-notice-hook nil) - (record (bbdb-annotate-message-sender - addr t - (bbdb-invoke-hook-for-value - bbdb/mail-auto-create-p) - t))) - (if record - (progn - (bbdb-record-putprop record 'sigtype sigtype) - (bbdb-change-record record nil)) - ))) - -(defun signature/get-sigtype-from-bbdb (&optional verbose) - (let* ((to (std11-field-body "To")) - (addr (and to - (car (cdr (mail-extract-address-components to))))) - (sigtype (signature/get-bbdb-sigtype addr)) - return - ) - (if addr - (if verbose - (progn - (setq return (signature/get-sigtype-interactively sigtype)) - (if (and (not (string-equal return sigtype)) - (y-or-n-p - (format "Register \"%s\" for <%s>? " return addr)) - ) - (signature/set-bbdb-sigtype return addr) - ) - return) - (or sigtype - (signature/get-signature-file-name)) - )) - )) - - -;;; @ end -;;; - -(provide 'mime-bbdb) - -(run-hooks 'mime-bbdb-load-hook) - -;;; end of mime-bbdb.el diff --git a/mime-def.el b/mime-def.el deleted file mode 100644 index 3181194..0000000 --- a/mime-def.el +++ /dev/null @@ -1,298 +0,0 @@ -;;; mime-def.el --- definition module for SEMI - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Version: $Id: mime-def.el,v 0.52 1997-06-21 04:08:04 morioka Exp $ -;; Keywords: definition, MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'cl) -(require 'emu) - -(autoload 'mule-caesar-region "mule-caesar" - "Caesar rotation of current region." t) - - -;;; @ variables -;;; - -(defvar mime/use-multi-frame - (and (>= emacs-major-version 19) window-system)) - -(defvar mime/find-file-function - (if mime/use-multi-frame - (function find-file-other-frame) - (function find-file) - )) - - -;;; @ constants -;;; - -(defconst mime-echo-buffer-name "*MIME-echo*" - "Name of buffer to display MIME-playing information.") - -(defconst mime/temp-buffer-name " *MIME-temp*") - - -;;; @ definitions about MIME -;;; - -(defconst mime/tspecials "][\000-\040()<>@,\;:\\\"/?.=") -(defconst mime/token-regexp (concat "[^" mime/tspecials "]+")) -(defconst mime-charset-regexp mime/token-regexp) - -(defconst mime/content-type-subtype-regexp - (concat mime/token-regexp "/" mime/token-regexp)) - -(defconst mime/disposition-type-regexp mime/token-regexp) - - -;;; @ button -;;; - -(defvar mime-button-face 'bold - "Face used for content-button or URL-button of MIME-Preview buffer.") - -(defvar mime-button-mouse-face 'highlight - "Face used for MIME-preview buffer mouse highlighting.") - -(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))) - ;;(add-text-properties from to (list 'keymap widget-keymap)) - )) - -(defsubst mime-insert-button (string function &optional data) - "Insert STRING as button with callback FUNCTION and DATA." - (save-restriction - (narrow-to-region (point)(point)) - (insert (concat "[" string "]")) - ;; (widget-push-button-value-create - ;; (widget-convert 'push-button - ;; :notify (lambda (&rest ignore) - ;; (mime-view-play-current-entity) - ;; ) - ;; string)) - (insert "\n") - (mime-add-button (point-min)(point-max) function data) - )) - -(defvar mime-button-mother-dispatcher nil) - -(defun mime-button-dispatcher (event) - "Select the button under point." - (interactive "e") - (let (buf point func data) - (save-window-excursion - (mouse-set-point event) - (setq buf (current-buffer) - point (point) - func (get-text-property (point) 'mime-button-callback) - data (get-text-property (point) 'mime-button-data) - ) - ) - (save-excursion - (set-buffer buf) - (goto-char point) - (if func - (apply func data) - (if (fboundp mime-button-mother-dispatcher) - (funcall mime-button-mother-dispatcher event) - ) - )))) - - -;;; @ 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." - (` (car (cdr (assq (, method) (symbol-value 'pgp-function-alist))))) - ) - -(mapcar (function - (lambda (method) - (autoload (second method)(third method)) - )) - pgp-function-alist) - - -;;; @ method selector kernel -;;; - -(require 'atype) - -;;; @@ field unifier -;;; - -(defun field-unifier-for-mode (a b) - (let ((va (cdr a))) - (if (if (consp va) - (member (cdr b) va) - (equal va (cdr b)) - ) - (list nil b nil) - ))) - - -;;; @ field -;;; - -(defsubst regexp-or (&rest args) - (concat "\\(" (mapconcat (function identity) args "\\|") "\\)")) - -(defun tm:set-fields (sym field-list &optional regexp-sym) - (or regexp-sym - (setq regexp-sym - (let ((name (symbol-name sym))) - (intern - (concat (if (string-match "\\(.*\\)-list" name) - (substring name 0 (match-end 1)) - name) - "-regexp") - ))) - ) - (set sym field-list) - (set regexp-sym - (concat "^" (apply (function regexp-or) field-list) ":")) - ) - -(defun tm:add-fields (sym field-list &optional regexp-sym) - (or regexp-sym - (setq regexp-sym - (let ((name (symbol-name sym))) - (intern - (concat (if (string-match "\\(.*\\)-list" name) - (substring name 0 (match-end 1)) - name) - "-regexp") - ))) - ) - (let ((fields (eval sym))) - (mapcar (function - (lambda (field) - (or (member field fields) - (setq fields (cons field fields)) - ) - )) - (reverse field-list) - ) - (set regexp-sym - (concat "^" (apply (function regexp-or) fields) ":")) - (set sym fields) - )) - -(defun tm:delete-fields (sym field-list &optional regexp-sym) - (or regexp-sym - (setq regexp-sym - (let ((name (symbol-name sym))) - (intern - (concat (if (string-match "\\(.*\\)-list" name) - (substring name 0 (match-end 1)) - name) - "-regexp") - ))) - ) - (let ((fields (eval sym))) - (mapcar (function - (lambda (field) - (setq fields (delete field fields)) - )) - field-list) - (set regexp-sym - (concat "^" (apply (function regexp-or) fields) ":")) - (set sym fields) - )) - - -;;; @ RCS version -;;; - -(defsubst get-version-string (id) - "Return a version-string from RCS ID." - (and (string-match ",v \\([0-9][0-9.][0-9.]+\\)" id) - (substring id (match-beginning 1)(match-end 1)) - )) - - -;;; @ Other Utility -;;; - -(defsubst eliminate-top-spaces (string) - "Eliminate top sequence of space or tab in STRING." - (if (string-match "^[ \t]+" string) - (substring string (match-end 0)) - string)) - -(defun call-after-loaded (module func &optional hook-name) - "If MODULE is provided, then FUNC is called. -Otherwise func is set to MODULE-load-hook. -If optional argument HOOK-NAME is specified, -it is used as hook to set." - (if (featurep module) - (funcall func) - (or hook-name - (setq hook-name (intern (concat (symbol-name module) "-load-hook"))) - ) - (add-hook hook-name func) - )) - - -;;; @ end -;;; - -(provide 'mime-def) - -;;; mime-def.el ends here diff --git a/mime-edit.el b/mime-edit.el deleted file mode 100644 index 577f539..0000000 --- a/mime-edit.el +++ /dev/null @@ -1,2617 +0,0 @@ -;;; mime-edit.el --- Simple MIME Composer for GNU Emacs - -;; Copyright (C) 1993,1994,1995,1996,1997 Free Software Foundation, Inc. - -;; Author: UMEDA Masanobu -;; MORIOKA Tomohiko -;; Maintainer: MORIOKA Tomohiko -;; Created: 1994/08/21 renamed from mime.el -;; Renamed: 1997/2/21 from tm-edit.el -;; Version: $Revision: 0.82 $ -;; Keywords: MIME, multimedia, multilingual, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This is an Emacs minor mode for editing Internet multimedia -;; messages formatted in MIME (RFC 2045, 2046, 2047, 2048 and 2049). -;; All messages in this mode are composed in the tagged MIME format, -;; that are described in the following examples. The messages -;; composed in the tagged MIME format are automatically translated -;; into a MIME compliant message when exiting the mode. - -;; Mule (multilingual feature of Emacs 20 and multilingual extension -;; for XEmacs 20) has a capability of handling multilingual text in -;; limited ISO-2022 manner that is based on early experiences in -;; Japanese Internet community and resulted in RFC 1468 (ISO-2022-JP -;; charset for MIME). In order to enable multilingual capability in -;; single text message in MIME, charset of multilingual text written -;; in Mule is declared as either `ISO-2022-JP-2' [RFC 1554]. Mule is -;; required for reading the such messages. - -;; This MIME composer can work with Mail mode, mh-e letter Mode, and -;; News mode. First of all, you need the following autoload -;; definition to load mime-edit-mode automatically: -;; -;; (autoload 'turn-on-mime-edit "mime-edit" -;; "Minor mode for editing MIME message." t) -;; -;; In case of Mail mode (includes VM mode), you need the following -;; hook definition: -;; -;; (add-hook 'mail-mode-hook 'turn-on-mime-edit) -;; (add-hook 'mail-send-hook 'mime-edit-maybe-translate) -;; -;; In case of MH-E, you need the following hook definition: -;; -;; (add-hook 'mh-letter-mode-hook -;; (function -;; (lambda () -;; (turn-on-mime-edit) -;; (make-local-variable 'mail-header-separator) -;; (setq mail-header-separator "--------") -;; )))) -;; (add-hook 'mh-before-send-letter-hook 'mime-edit-maybe-translate) -;; -;; In case of News mode, you need the following hook definition: -;; -;; (add-hook 'news-reply-mode-hook 'turn-on-mime-edit) -;; (add-hook 'news-inews-hook 'mime-edit-maybe-translate) -;; -;; In case of Emacs 19, it is possible to emphasize the message tags -;; using font-lock mode as follows: -;; -;; (add-hook 'mime-edit-mode-hook -;; (function -;; (lambda () -;; (font-lock-mode 1) -;; (setq font-lock-keywords (list mime-edit-tag-regexp)) -;; )))) - -;; The message tag looks like: -;; -;; --[[TYPE/SUBTYPE;PARAMETERS][ENCODING]] -;; -;; The tagged MIME message examples: -;; -;; This is a conventional plain text. It should be translated into -;; text/plain. -;; -;;--[[text/plain]] -;; This is also a plain text. But, it is explicitly specified as is. -;;--[[text/plain; charset=ISO-8859-1]] -;; This is also a plain text. But charset is specified as iso-8859-1. -;; -;; ¡Hola! Buenos días. ¿Cómo está usted? -;;--[[text/enriched]] -;;
This is a richtext.
-;; -;;--[[image/gif][base64]]^M...image encoded in base64 comes here... -;; -;;--[[audio/basic][base64]]^M...audio encoded in base64 comes here... - -;;; Code: - -(require 'emu) -(require 'sendmail) -(require 'mail-utils) -(require 'mel) -(require 'mime-view) -(require 'eword-encode) -(require 'signature) -(require 'alist) - - -;;; @ version -;;; - -(defconst mime-edit-RCS-ID - "$Id: mime-edit.el,v 0.82 1997-05-27 03:26:23 morioka Exp $") - -(defconst mime-edit-version (get-version-string mime-edit-RCS-ID)) - -(defconst mime-edit-version-name - (concat "SEMI MIME-Edit " mime-edit-version)) - - -;;; @ variables -;;; - -(defvar mime-ignore-preceding-spaces nil - "*Ignore preceding white spaces if non-nil.") - -(defvar mime-ignore-trailing-spaces nil - "*Ignore trailing white spaces if non-nil.") - -(defvar mime-ignore-same-text-tag t - "*Ignore preceding text content-type tag that is same with new one. -If non-nil, the text tag is not inserted unless something different.") - -(defvar mime-auto-hide-body t - "*Hide non-textual body encoded in base64 after insertion if non-nil.") - -(defvar mime-edit-voice-recorder - (function mime-edit-voice-recorder-for-sun) - "*Function to record a voice message and encode it. [mime-edit.el]") - -(defvar mime-edit-mode-hook nil - "*Hook called when enter MIME mode.") - -(defvar mime-edit-translate-hook nil - "*Hook called before translating into a MIME compliant message. -To insert a signature file automatically, call the function -`mime-edit-insert-signature' from this hook.") - -(defvar mime-edit-exit-hook nil - "*Hook called when exit MIME mode.") - -(defvar mime-content-types - '(("text" - ;; Charset parameter need not to be specified, since it is - ;; defined automatically while translation. - ("plain" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("richtext" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("enriched" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("x-latex" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("html" - ;;("charset" "" "ISO-2022-JP" "US-ASCII" "ISO-8859-1" "ISO-8859-8") - ) - ("x-rot13-47-48") - ) - ("message" - ("external-body" - ("access-type" - ("anon-ftp" - ("site" "ftp.jaist.ac.jp" "wnoc-fuk.wide.ad.jp" "nic.karrn.ad.jp") - ("directory" "/pub/GNU/elisp/mime") - ("name") - ("mode" "image" "ascii" "local8")) - ("ftp" - ("site") - ("directory") - ("name") - ("mode" "image" "ascii" "local8")) - ("tftp" ("site") ("name")) - ("afs" ("site") ("name")) - ("local-file" ("site") ("name")) - ("mail-server" ("server" "ftpmail@nic.karrn.ad.jp")) - )) - ("rfc822") - ) - ("application" - ("octet-stream" ("type" "" "tar" "shar")) - ("postscript") - ("x-kiss" ("x-cnf"))) - ("image" - ("gif") - ("jpeg") - ("png") - ("tiff") - ("x-pic") - ("x-mag") - ("x-xwd") - ("x-xbm") - ) - ("audio" ("basic")) - ("video" ("mpeg")) - ) - "*Alist of content-type, subtype, parameters and its values.") - -(defvar mime-file-types - '(("\\.rtf$" - "text" "richtext" nil - nil - nil nil) - ("\\.html$" - "text" "html" nil - nil - nil nil) - ("\\.ps$" - "application" "postscript" nil - "quoted-printable" - "attachment" (("filename" . file)) - ) - ("\\.jpg$" - "image" "jpeg" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.gif$" - "image" "gif" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.png$" - "image" "png" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.tiff$" - "image" "tiff" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.pic$" - "image" "x-pic" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.mag$" - "image" "x-mag" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.xbm$" - "image" "x-xbm" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.xwd$" - "image" "x-xwd" nil - "base64" - "inline" (("filename" . file)) - ) - ("\\.au$" - "audio" "basic" nil - "base64" - "attachment" (("filename" . file)) - ) - ("\\.mpg$" - "video" "mpeg" nil - "base64" - "attachment" (("filename" . file)) - ) - ("\\.el$" - "application" "octet-stream" (("type" . "emacs-lisp")) - "7bit" - "attachment" (("filename" . file)) - ) - ("\\.lsp$" - "application" "octet-stream" (("type" . "common-lisp")) - "7bit" - "attachment" (("filename" . file)) - ) - ("\\.tar\\.gz$" - "application" "octet-stream" (("type" . "tar+gzip")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.tgz$" - "application" "octet-stream" (("type" . "tar+gzip")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.tar\\.Z$" - "application" "octet-stream" (("type" . "tar+compress")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.taz$" - "application" "octet-stream" (("type" . "tar+compress")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.gz$" - "application" "octet-stream" (("type" . "gzip")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.Z$" - "application" "octet-stream" (("type" . "compress")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.lzh$" - "application" "octet-stream" (("type" . "lha")) - "base64" - "attachment" (("filename" . file)) - ) - ("\\.zip$" - "application" "zip" nil - "base64" - "attachment" (("filename" . file)) - ) - ("\\.diff$" - "application" "octet-stream" (("type" . "patch")) - nil - "attachment" (("filename" . file)) - ) - ("\\.patch$" - "application" "octet-stream" (("type" . "patch")) - nil - "attachment" (("filename" . file)) - ) - ("\\.signature" - "text" "plain" nil nil) - (".*" - "application" "octet-stream" nil - nil - "attachment" (("filename" . file)) - ) - ) - "*Alist of file name, types, parameters, and default encoding. -If encoding is nil, it is determined from its contents.") - - -;;; @@ about charset, encoding and transfer-level -;;; - -(defvar mime-charset-type-list - '((us-ascii 7 nil) - (iso-8859-1 8 "quoted-printable") - (iso-8859-2 8 "quoted-printable") - (iso-8859-3 8 "quoted-printable") - (iso-8859-4 8 "quoted-printable") - (iso-8859-5 8 "quoted-printable") - (koi8-r 8 "quoted-printable") - (iso-8859-7 8 "quoted-printable") - (iso-8859-8 8 "quoted-printable") - (iso-8859-9 8 "quoted-printable") - (iso-2022-jp 7 "base64") - (iso-2022-kr 7 "base64") - (euc-kr 8 "base64") - (cn-gb2312 8 "quoted-printable") - (cn-big5 8 "base64") - (gb2312 8 "quoted-printable") - (big5 8 "base64") - (iso-2022-jp-2 7 "base64") - (iso-2022-int-1 7 "base64") - )) - -(defvar mime-transfer-level 7 - "*A number of network transfer level. It should be bigger than 7.") -(make-variable-buffer-local 'mime-transfer-level) - -(defsubst mime-encoding-name (transfer-level &optional not-omit) - (cond ((> transfer-level 8) "binary") - ((= transfer-level 8) "8bit") - (not-omit "7bit") - )) - -(defvar mime-transfer-level-string - (mime-encoding-name mime-transfer-level 'not-omit) - "A string formatted version of mime-transfer-level") -(make-variable-buffer-local 'mime-transfer-level-string) - -(defun mime-make-charset-default-encoding-alist (transfer-level) - (mapcar (function - (lambda (charset-type) - (let ((charset (car charset-type)) - (type (nth 1 charset-type)) - (encoding (nth 2 charset-type)) - ) - (if (<= type transfer-level) - (cons charset (mime-encoding-name type)) - (cons charset encoding) - )))) - mime-charset-type-list)) - -(defvar mime-edit-charset-default-encoding-alist - (mime-make-charset-default-encoding-alist mime-transfer-level)) -(make-variable-buffer-local 'mime-edit-charset-default-encoding-alist) - - -;;; @@ about message inserting -;;; - -(defvar mime-edit-yank-ignored-field-list - '("Received" "Approved" "Path" "Replied" "Status" - "Xref" "X-UIDL" "X-Filter" "X-Gnus-.*" "X-VM-.*") - "Delete these fields from original message when it is inserted -as message/rfc822 part. -Each elements are regexp of field-name. [mime-edit.el]") - -(defvar mime-edit-yank-ignored-field-regexp - (concat "^" - (apply (function regexp-or) mime-edit-yank-ignored-field-list) - ":")) - -(defvar mime-edit-message-inserter-alist nil) -(defvar mime-edit-mail-inserter-alist nil) - - -;;; @@ about message splitting -;;; - -(defvar mime-edit-split-message t - "*Split large message if it is non-nil. [mime-edit.el]") - -(defvar mime-edit-message-default-max-lines 1000 - "*Default maximum lines of a message. [mime-edit.el]") - -(defvar mime-edit-message-max-lines-alist - '((news-reply-mode . 500)) - "Alist of major-mode vs maximum lines of a message. -If it is not specified for a major-mode, -`mime-edit-message-default-max-lines' is used. [mime-edit.el]") - -(defconst mime-edit-split-ignored-field-regexp - "\\(^Content-\\|^Subject:\\|^Mime-Version:\\)") - -(defvar mime-edit-split-blind-field-regexp - "\\(^[BDFbdf]cc:\\|^cc:[ \t]*$\\)") - -(defvar mime-edit-split-message-sender-alist nil) - -(defvar mime-edit-news-reply-mode-server-running nil) - - -;;; @@ about PGP -;;; - -(defvar mime-edit-signing-type 'pgp-elkins - "*PGP signing type (pgp-elkins, pgp-kazu or nil). [mime-edit.el]") - -(defvar mime-edit-encrypting-type 'pgp-elkins - "*PGP encrypting type (pgp-elkins, pgp-kazu or nil). [mime-edit.el]") - - -;;; @@ about tag -;;; - -(defconst mime-edit-single-part-tag-regexp - "--[[][[]\\([^]]*\\)]\\([[]\\([^]]*\\)]\\|\\)]" - "*Regexp of MIME tag in the form of [[CONTENT-TYPE][ENCODING]].") - -(defconst mime-edit-quoted-single-part-tag-regexp - (concat "- " (substring mime-edit-single-part-tag-regexp 1))) - -(defconst mime-edit-multipart-beginning-regexp "--<<\\([^<>]+\\)>>-{\n") - -(defconst mime-edit-multipart-end-regexp "--}-<<\\([^<>]+\\)>>\n") - -(defconst mime-edit-beginning-tag-regexp - (regexp-or mime-edit-single-part-tag-regexp - mime-edit-multipart-beginning-regexp)) - -(defconst mime-edit-end-tag-regexp - (regexp-or mime-edit-single-part-tag-regexp - mime-edit-multipart-end-regexp)) - -(defconst mime-edit-tag-regexp - (regexp-or mime-edit-single-part-tag-regexp - mime-edit-multipart-beginning-regexp - mime-edit-multipart-end-regexp)) - -(defvar mime-tag-format "--[[%s]]" - "*Control-string making a MIME tag.") - -(defvar mime-tag-format-with-encoding "--[[%s][%s]]" - "*Control-string making a MIME tag with encoding.") - - -;;; @@ multipart boundary -;;; - -(defvar mime-multipart-boundary "Multipart" - "*Boundary of a multipart message.") - - -;;; @@ optional header fields -;;; - -(defvar mime-edit-insert-x-emacs-field t - "*If non-nil, insert X-Emacs header field.") - -(defvar mime-edit-x-emacs-value - (if running-xemacs - (concat emacs-version - (if (featurep 'mule) - " with mule" - " without mule")) - (let ((ver (if (string-match "\\.[0-9]+$" emacs-version) - (substring emacs-version 0 (match-beginning 0)) - emacs-version))) - (if (featurep 'mule) - (concat "Emacs " ver ", MULE " mule-version) - ver)))) - - -;;; @ constants -;;; - -(defconst mime-tspecials-regexp "[][()<>@,;:\\\"/?.= \t]" - "*Specify MIME tspecials. -Tspecials means any character that matches with it in header must be quoted.") - -(defconst mime-edit-mime-version-value - (concat "1.0 (generated by " mime-edit-version-name ")") - "MIME version number.") - - -;;; @ keymap and menu -;;; - -(defvar mime-edit-mode-flag nil) -(make-variable-buffer-local 'mime-edit-mode-flag) - -(defvar mime-edit-mode-map (make-sparse-keymap) - "Keymap for MIME-Edit mode commands.") - -(define-key mime-edit-mode-map - "\C-c\C-x\C-t" 'mime-edit-insert-text) -(define-key mime-edit-mode-map - "\C-c\C-x\C-i" 'mime-edit-insert-file) -(define-key mime-edit-mode-map - "\C-c\C-x\C-e" 'mime-edit-insert-external) -(define-key mime-edit-mode-map - "\C-c\C-x\C-v" 'mime-edit-insert-voice) -(define-key mime-edit-mode-map - "\C-c\C-x\C-y" 'mime-edit-insert-message) -(define-key mime-edit-mode-map - "\C-c\C-x\C-m" 'mime-edit-insert-mail) -(define-key mime-edit-mode-map - "\C-c\C-x\C-w" 'mime-edit-insert-signature) -(define-key mime-edit-mode-map - "\C-c\C-x\C-s" 'mime-edit-insert-signature) -(define-key mime-edit-mode-map - "\C-c\C-x\C-k" 'mime-edit-insert-key) -(define-key mime-edit-mode-map - "\C-c\C-xt" 'mime-edit-insert-tag) - -(define-key mime-edit-mode-map - "\C-c\C-m\C-a" 'mime-edit-enclose-alternative-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-p" 'mime-edit-enclose-parallel-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-m" 'mime-edit-enclose-mixed-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-d" 'mime-edit-enclose-digest-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-s" 'mime-edit-enclose-signed-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-e" 'mime-edit-enclose-encrypted-region) -(define-key mime-edit-mode-map - "\C-c\C-m\C-q" 'mime-edit-enclose-quote-region) - -(define-key mime-edit-mode-map - "\C-c\C-x7" 'mime-edit-set-transfer-level-7bit) -(define-key mime-edit-mode-map - "\C-c\C-x8" 'mime-edit-set-transfer-level-8bit) -(define-key mime-edit-mode-map - "\C-c\C-x/" 'mime-edit-set-split) -(define-key mime-edit-mode-map - "\C-c\C-xs" 'mime-edit-set-sign) -(define-key mime-edit-mode-map - "\C-c\C-xv" 'mime-edit-set-sign) -(define-key mime-edit-mode-map - "\C-c\C-xe" 'mime-edit-set-encrypt) -(define-key mime-edit-mode-map - "\C-c\C-xh" 'mime-edit-set-encrypt) -(define-key mime-edit-mode-map - "\C-c\C-x\C-p" 'mime-edit-preview-message) -(define-key mime-edit-mode-map - "\C-c\C-x\C-z" 'mime-edit-exit) -(define-key mime-edit-mode-map - "\C-c\C-x?" 'mime-edit-help) - -(defconst mime-edit-menu-title "MIME-Edit") - -(defconst mime-edit-menu-list - '((mime-help "Describe MIME editor mode" mime-edit-help) - (file "Insert File" mime-edit-insert-file) - (external "Insert External" mime-edit-insert-external) - (voice "Insert Voice" mime-edit-insert-voice) - (message "Insert Message" mime-edit-insert-message) - (mail "Insert Mail" mime-edit-insert-mail) - (signature "Insert Signature" mime-edit-insert-signature) - (text "Insert Text" mime-edit-insert-text) - (tag "Insert Tag" mime-edit-insert-tag) - (alternative "Enclose as alternative" - mime-edit-enclose-alternative-region) - (parallel "Enclose as parallel" mime-edit-enclose-parallel-region) - (mixed "Enclose as serial" mime-edit-enclose-mixed-region) - (digest "Enclose as digest" mime-edit-enclose-digest-region) - (signed "Enclose as signed" mime-edit-enclose-signed-region) - (encrypted "Enclose as encrypted" mime-edit-enclose-encrypted-region) - (quote "Verbatim region" mime-edit-enclose-quote-region) - (key "Insert Public Key" mime-edit-insert-key) - (split "About split" mime-edit-set-split) - (sign "About sign" mime-edit-set-sign) - (encrypt "About encryption" mime-edit-set-encrypt) - (preview "Preview Message" mime-edit-preview-message) - (level "Toggle transfer-level" mime-edit-toggle-transfer-level) - ) - "MIME-edit menubar entry.") - -(cond (running-xemacs - ;; modified by Pekka Marjola - ;; 1995/9/5 (c.f. [tm-en:69]) - (defun mime-edit-define-menu-for-xemacs () - "Define menu for Emacs 19." - (cond ((featurep 'menubar) - (make-local-variable 'current-menubar) - (set-buffer-menubar current-menubar) - (add-submenu - nil - (cons mime-edit-menu-title - (mapcar (function - (lambda (item) - (vector (nth 1 item)(nth 2 item) - mime-edit-mode-flag) - )) - mime-edit-menu-list))) - ))) - - ;; modified by Steven L. Baur - ;; 1995/12/6 (c.f. [tm-en:209]) - (or (boundp 'mime-edit-popup-menu-for-xemacs) - (setq mime-edit-popup-menu-for-xemacs - (append '("MIME Commands" "---") - (mapcar (function (lambda (item) - (vector (nth 1 item) - (nth 2 item) - t))) - mime-edit-menu-list))) - ) - ) - ((>= emacs-major-version 19) - (define-key mime-edit-mode-map [menu-bar mime-edit] - (cons mime-edit-menu-title - (make-sparse-keymap mime-edit-menu-title))) - (mapcar (function - (lambda (item) - (define-key mime-edit-mode-map - (vector 'menu-bar 'mime-edit (car item)) - (cons (nth 1 item)(nth 2 item)) - ) - )) - (reverse mime-edit-menu-list) - ) - )) - - -;;; @ functions -;;; - -;;;###autoload -(defun mime-edit-mode () - "MIME minor mode for editing the tagged MIME message. - -In this mode, basically, the message is composed in the tagged MIME -format. The message tag looks like: - - --[[text/plain; charset=ISO-2022-JP][7bit]] - -The tag specifies the MIME content type, subtype, optional parameters -and transfer encoding of the message following the tag. Messages -without any tag are treated as `text/plain' by default. Charset and -transfer encoding are automatically defined unless explicitly -specified. Binary messages such as audio and image are usually -hidden. The messages in the tagged MIME format are automatically -translated into a MIME compliant message when exiting this mode. - -Available charsets depend on Emacs version being used. The following -lists the available charsets of each emacs. - -Without mule: US-ASCII and ISO-8859-1 (or other charset) are available. -With mule: US-ASCII, ISO-8859-* (except for ISO-8859-5), KOI8-R, - ISO-2022-JP, ISO-2022-JP-2, EUC-KR, CN-GB-2312, - CN-BIG5 and ISO-2022-INT-1 are available. - -ISO-2022-JP-2 and ISO-2022-INT-1 charsets used in mule is expected to -be used to represent multilingual text in intermixed manner. Any -languages that has no registered charset are represented as either -ISO-2022-JP-2 or ISO-2022-INT-1 in mule. - -If you want to use non-ISO-8859-1 charset in Emacs 19 or XEmacs -without mule, please set variable `default-mime-charset'. This -variable must be symbol of which name is a MIME charset. - -If you want to add more charsets in mule, please set variable -`charsets-mime-charset-alist'. This variable must be alist of which -key is list of charset and value is symbol of MIME charset. If name -of coding-system is different as MIME charset, please set variable -`mime-charset-coding-system-alist'. This variable must be alist of -which key is MIME charset and value is coding-system. - -Following commands are available in addition to major mode commands: - -\[make single part\] -\\[mime-edit-insert-text] insert a text message. -\\[mime-edit-insert-file] insert a (binary) file. -\\[mime-edit-insert-external] insert a reference to external body. -\\[mime-edit-insert-voice] insert a voice message. -\\[mime-edit-insert-message] insert a mail or news message. -\\[mime-edit-insert-mail] insert a mail message. -\\[mime-edit-insert-signature] insert a signature file at end. -\\[mime-edit-insert-key] insert PGP public key. -\\[mime-edit-insert-tag] insert a new MIME tag. - -\[make enclosure (maybe multipart)\] -\\[mime-edit-enclose-alternative-region] enclose as multipart/alternative. -\\[mime-edit-enclose-parallel-region] enclose as multipart/parallel. -\\[mime-edit-enclose-mixed-region] enclose as multipart/mixed. -\\[mime-edit-enclose-digest-region] enclose as multipart/digest. -\\[mime-edit-enclose-signed-region] enclose as PGP signed. -\\[mime-edit-enclose-encrypted-region] enclose as PGP encrypted. -\\[mime-edit-enclose-quote-region] enclose as verbose mode (to avoid to expand tags) - -\[other commands\] -\\[mime-edit-set-transfer-level-7bit] set transfer-level as 7. -\\[mime-edit-set-transfer-level-8bit] set transfer-level as 8. -\\[mime-edit-set-split] set message splitting mode. -\\[mime-edit-set-sign] set PGP-sign mode. -\\[mime-edit-set-encrypt] set PGP-encryption mode. -\\[mime-edit-preview-message] preview editing MIME message. -\\[mime-edit-exit] exit and translate into a MIME compliant message. -\\[mime-edit-help] show this help. -\\[mime-edit-maybe-translate] exit and translate if in MIME mode, then split. - -Additional commands are available in some major modes: -C-c C-c exit, translate and run the original command. -C-c C-s exit, translate and run the original command. - -The following is a message example written in the tagged MIME format. -TABs at the beginning of the line are not a part of the message: - - This is a conventional plain text. It should be translated - into text/plain. - --[[text/plain]] - This is also a plain text. But, it is explicitly specified as - is. - --[[text/plain; charset=ISO-8859-1]] - This is also a plain text. But charset is specified as - iso-8859-1. - - ¡Hola! Buenos días. ¿Cómo está usted? - --[[text/enriched]] - This is a enriched text. - --[[image/gif][base64]]...image encoded in base64 here... - --[[audio/basic][base64]]...audio encoded in base64 here... - -User customizable variables (not documented all of them): - mime-edit-prefix - Specifies a key prefix for MIME minor mode commands. - - mime-ignore-preceding-spaces - Preceding white spaces in a message body are ignored if non-nil. - - mime-ignore-trailing-spaces - Trailing white spaces in a message body are ignored if non-nil. - - mime-auto-hide-body - Hide a non-textual body message encoded in base64 after insertion - if non-nil. - - mime-transfer-level - A number of network transfer level. It should be bigger than 7. - If you are in 8bit-through environment, please set 8. - - mime-edit-voice-recorder - Specifies a function to record a voice message and encode it. - The function `mime-edit-voice-recorder-for-sun' is for Sun - SparcStations. - - mime-edit-mode-hook - Turning on MIME mode calls the value of mime-edit-mode-hook, if - it is non-nil. - - mime-edit-translate-hook - The value of mime-edit-translate-hook is called just before translating - the tagged MIME format into a MIME compliant message if it is - non-nil. If the hook call the function mime-edit-insert-signature, - the signature file will be inserted automatically. - - mime-edit-exit-hook - Turning off MIME mode calls the value of mime-edit-exit-hook, if it is - non-nil." - (interactive) - (if mime-edit-mode-flag - (mime-edit-exit) - (if (and (boundp 'mime-edit-touched-flag) - mime-edit-touched-flag) - (mime-edit-again) - (make-local-variable 'mime-edit-touched-flag) - (setq mime-edit-touched-flag t) - (turn-on-mime-edit) - ))) - - -(cond (running-xemacs - (add-minor-mode 'mime-edit-mode-flag - '((" MIME-Edit " mime-transfer-level-string)) - mime-edit-mode-map - nil - 'mime-edit-mode) - ) - (t - (set-alist 'minor-mode-alist - 'mime-edit-mode-flag - '((" MIME-Edit " mime-transfer-level-string))) - (set-alist 'minor-mode-map-alist - 'mime-edit-mode-flag - mime-edit-mode-map) - )) - - -;;;###autoload -(defun turn-on-mime-edit () - "Unconditionally turn on MIME-Edit mode." - (interactive) - (if mime-edit-mode-flag - (error "You are already editing a MIME message.") - (setq mime-edit-mode-flag t) - - ;; Set transfer level into mode line - ;; - (setq mime-transfer-level-string - (mime-encoding-name mime-transfer-level 'not-omit)) - (force-mode-line-update) - - ;; Define menu for XEmacs. - (if running-xemacs - (mime-edit-define-menu-for-xemacs) - ) - - (enable-invisible) - - ;; I don't care about saving these. - (setq paragraph-start - (regexp-or mime-edit-single-part-tag-regexp - paragraph-start)) - (setq paragraph-separate - (regexp-or mime-edit-single-part-tag-regexp - paragraph-separate)) - (run-hooks 'mime-edit-mode-hook) - (message - (substitute-command-keys - "Type \\[mime-edit-exit] to exit MIME mode, and type \\[mime-edit-help] to get help.")) - )) - -;;;###autoload -(defalias 'edit-mime 'turn-on-mime-edit) ; for convenience - - -(defun mime-edit-exit (&optional nomime no-error) - "Translate the tagged MIME message into a MIME compliant message. -With no argument encode a message in the buffer into MIME, otherwise -just return to previous mode." - (interactive "P") - (if (not mime-edit-mode-flag) - (if (null no-error) - (error "You aren't editing a MIME message.") - ) - (if (not nomime) - (progn - (run-hooks 'mime-edit-translate-hook) - (mime-edit-translate-buffer))) - ;; Restore previous state. - (setq mime-edit-mode-flag nil) - (if (and running-xemacs - (featurep 'menubar)) - (delete-menu-item (list mime-edit-menu-title)) - ) - (end-of-invisible) - (set-buffer-modified-p (buffer-modified-p)) - (run-hooks 'mime-edit-exit-hook) - (message "Exit MIME editor mode.") - )) - -(defun mime-edit-maybe-translate () - (interactive) - (mime-edit-exit nil t) - (call-interactively 'mime-edit-maybe-split-and-send) - ) - -(defun mime-edit-help () - "Show help message about MIME mode." - (interactive) - (with-output-to-temp-buffer "*Help*" - (princ "MIME editor mode:\n") - (princ (documentation 'mime-edit-mode)) - (print-help-return-message))) - -(defun mime-edit-insert-text () - "Insert a text message. -Charset is automatically obtained from the `charsets-mime-charset-alist'." - (interactive) - (let ((ret (mime-edit-insert-tag "text" nil nil))) - (if ret - (progn - (if (looking-at mime-edit-single-part-tag-regexp) - (progn - ;; Make a space between the following message. - (insert "\n") - (forward-char -1) - )) - (if (and (member (second ret) '("enriched" "richtext")) - (fboundp 'enriched-mode) - ) - (enriched-mode t) - (if (boundp 'enriched-mode) - (enriched-mode nil) - )))))) - -(defun mime-edit-insert-file (file &optional verbose) - "Insert a message from a file." - (interactive "fInsert file as MIME message: \nP") - (let* ((guess (mime-find-file-type file)) - (type (nth 0 guess)) - (subtype (nth 1 guess)) - (parameters (nth 2 guess)) - (encoding (nth 3 guess)) - (disposition-type (nth 4 guess)) - (disposition-params (nth 5 guess)) - ) - (if verbose - (setq type (mime-prompt-for-type type) - subtype (mime-prompt-for-subtype type subtype) - )) - (if (or (interactive-p) verbose) - (setq encoding (mime-prompt-for-encoding encoding)) - ) - (if (or (consp parameters) (stringp disposition-type)) - (let ((rest parameters) cell attribute value) - (setq parameters "") - (while rest - (setq cell (car rest)) - (setq attribute (car cell)) - (setq value (cdr cell)) - (if (eq value 'file) - (setq value (std11-wrap-as-quoted-string - (file-name-nondirectory file))) - ) - (setq parameters (concat parameters "; " attribute "=" value)) - (setq rest (cdr rest)) - ) - (if disposition-type - (progn - (setq parameters - (concat parameters "\n" - "Content-Disposition: " disposition-type)) - (setq rest disposition-params) - (while rest - (setq cell (car rest)) - (setq attribute (car cell)) - (setq value (cdr cell)) - (if (eq value 'file) - (setq value (std11-wrap-as-quoted-string - (file-name-nondirectory file))) - ) - (setq parameters - (concat parameters "; " attribute "=" value)) - (setq rest (cdr rest)) - ) - )) - )) - (mime-edit-insert-tag type subtype parameters) - (mime-edit-insert-binary-file file encoding) - )) - -(defun mime-edit-insert-external () - "Insert a reference to external body." - (interactive) - (mime-edit-insert-tag "message" "external-body" nil ";\n\t") - ;;(forward-char -1) - ;;(insert "Content-Description: " (read-string "Content-Description: ") "\n") - ;;(forward-line 1) - (let* ((pritype (mime-prompt-for-type)) - (subtype (mime-prompt-for-subtype pritype)) - (parameters (mime-prompt-for-parameters pritype subtype ";\n\t"))) - (and pritype - subtype - (insert "Content-Type: " - pritype "/" subtype (or parameters "") "\n"))) - (if (and (not (eobp)) - (not (looking-at mime-edit-single-part-tag-regexp))) - (insert (mime-make-text-tag) "\n"))) - -(defun mime-edit-insert-voice () - "Insert a voice message." - (interactive) - (let ((encoding - (completing-read - "What transfer encoding: " - mime-file-encoding-method-alist nil t nil))) - (mime-edit-insert-tag "audio" "basic" nil) - (mime-edit-define-encoding encoding) - (save-restriction - (narrow-to-region (1- (point))(point)) - (unwind-protect - (funcall mime-edit-voice-recorder encoding) - (progn - (insert "\n") - (invisible-region (point-min)(point-max)) - (goto-char (point-max)) - ))))) - -(defun mime-edit-insert-signature (&optional arg) - "Insert a signature file." - (interactive "P") - (let ((signature-insert-hook - (function - (lambda () - (apply (function mime-edit-insert-tag) - (mime-find-file-type signature-file-name)) - ))) - ) - (insert-signature arg) - )) - - -;; Insert a new tag around a point. - -(defun mime-edit-insert-tag (&optional pritype subtype parameters delimiter) - "Insert new MIME tag and return a list of PRITYPE, SUBTYPE, and PARAMETERS. -If nothing is inserted, return nil." - (interactive) - (let ((p (point))) - (mime-edit-goto-tag) - (if (and (re-search-forward mime-edit-tag-regexp nil t) - (< (match-beginning 0) p) - (< p (match-end 0)) - ) - (goto-char (match-beginning 0)) - (goto-char p) - )) - (let ((oldtag nil) - (newtag nil) - (current (point)) - ) - (setq pritype - (or pritype - (mime-prompt-for-type))) - (setq subtype - (or subtype - (mime-prompt-for-subtype pritype))) - (setq parameters - (or parameters - (mime-prompt-for-parameters pritype subtype delimiter))) - ;; Make a new MIME tag. - (setq newtag (mime-make-tag pritype subtype parameters)) - ;; Find an current MIME tag. - (setq oldtag - (save-excursion - (if (mime-edit-goto-tag) - (buffer-substring (match-beginning 0) (match-end 0)) - ;; Assume content type is 'text/plan'. - (mime-make-tag "text" "plain") - ))) - ;; We are only interested in TEXT. - (if (and oldtag - (not (mime-test-content-type - (mime-edit-get-contype oldtag) "text"))) - (setq oldtag nil)) - ;; Make a new tag. - (if (or (not oldtag) ;Not text - (or mime-ignore-same-text-tag - (not (string-equal oldtag newtag)))) - (progn - ;; Mark the beginning of the tag for convenience. - (push-mark (point) 'nomsg) - (insert newtag "\n") - (list pritype subtype parameters) ;New tag is created. - ) - ;; Restore previous point. - (goto-char current) - nil ;Nothing is created. - ) - )) - -(defun mime-edit-insert-binary-file (file &optional encoding) - "Insert binary FILE at point. -Optional argument ENCODING specifies an encoding method such as base64." - (let* ((tagend (1- (point))) ;End of the tag - (hide-p (and mime-auto-hide-body - (stringp encoding) - (not - (let ((en (downcase encoding))) - (or (string-equal en "7bit") - (string-equal en "8bit") - (string-equal en "binary") - ))))) - ) - (save-restriction - (narrow-to-region tagend (point)) - (mime-insert-encoded-file file encoding) - (if hide-p - (progn - (invisible-region (point-min) (point-max)) - (goto-char (point-max)) - ) - (goto-char (point-max)) - )) - (or hide-p - (looking-at mime-edit-tag-regexp) - (= (point)(point-max)) - (mime-edit-insert-tag "text" "plain") - ) - ;; Define encoding even if it is 7bit. - (if (stringp encoding) - (save-excursion - (goto-char tagend) ; Make sure which line the tag is on. - (mime-edit-define-encoding encoding) - )) - )) - - -;; Commands work on a current message flagment. - -(defun mime-edit-goto-tag () - "Search for the beginning of the tagged MIME message." - (let ((current (point))) - (if (looking-at mime-edit-tag-regexp) - t - ;; At first, go to the end. - (cond ((re-search-forward mime-edit-beginning-tag-regexp nil t) - (goto-char (1- (match-beginning 0))) ;For multiline tag - ) - (t - (goto-char (point-max)) - )) - ;; Then search for the beginning. - (re-search-backward mime-edit-end-tag-regexp nil t) - (or (looking-at mime-edit-beginning-tag-regexp) - ;; Restore previous point. - (progn - (goto-char current) - nil - )) - ))) - -(defun mime-edit-content-beginning () - "Return the point of the beginning of content." - (save-excursion - (let ((beg (save-excursion - (beginning-of-line) (point)))) - (if (mime-edit-goto-tag) - (let ((top (point))) - (goto-char (match-end 0)) - (if (and (= beg top) - (= (following-char) ?\^M)) - (point) - (forward-line 1) - (point))) - ;; Default text/plain tag. - (goto-char (point-min)) - (re-search-forward - (concat "\n" (regexp-quote mail-header-separator) - (if mime-ignore-preceding-spaces - "[ \t\n]*\n" "\n")) nil 'move) - (point)) - ))) - -(defun mime-edit-content-end () - "Return the point of the end of content." - (save-excursion - (if (mime-edit-goto-tag) - (progn - (goto-char (match-end 0)) - (if (invisible-p (point)) - (next-visible-point (point)) - ;; Move to the end of this text. - (if (re-search-forward mime-edit-tag-regexp nil 'move) - ;; Don't forget a multiline tag. - (goto-char (match-beginning 0)) - ) - (point) - )) - ;; Assume the message begins with text/plain. - (goto-char (mime-edit-content-beginning)) - (if (re-search-forward mime-edit-tag-regexp nil 'move) - ;; Don't forget a multiline tag. - (goto-char (match-beginning 0))) - (point)) - )) - -(defun mime-edit-define-charset (charset) - "Set charset of current tag to CHARSET." - (save-excursion - (if (mime-edit-goto-tag) - (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))) - (delete-region (match-beginning 0) (match-end 0)) - (insert - (mime-create-tag - (mime-edit-set-parameter - (mime-edit-get-contype tag) - "charset" (upcase (symbol-name charset))) - (mime-edit-get-encoding tag))) - )))) - -(defun mime-edit-define-encoding (encoding) - "Set encoding of current tag to ENCODING." - (save-excursion - (if (mime-edit-goto-tag) - (let ((tag (buffer-substring (match-beginning 0) (match-end 0)))) - (delete-region (match-beginning 0) (match-end 0)) - (insert (mime-create-tag (mime-edit-get-contype tag) encoding))) - ))) - -(defun mime-edit-choose-charset () - "Choose charset of a text following current point." - (detect-mime-charset-region (point) (mime-edit-content-end)) - ) - -(defun mime-make-text-tag (&optional subtype) - "Make a tag for a text after current point. -Subtype of text type can be specified by an optional argument SUBTYPE. -Otherwise, it is obtained from mime-content-types." - (let* ((pritype "text") - (subtype (or subtype - (car (car (cdr (assoc pritype mime-content-types))))))) - ;; Charset should be defined later. - (mime-make-tag pritype subtype))) - - -;; Tag handling functions - -(defun mime-make-tag (pritype subtype &optional parameters encoding) - "Make a tag of MIME message of PRITYPE, SUBTYPE and optional PARAMETERS." - (mime-create-tag (concat (or pritype "") "/" (or subtype "") - (or parameters "")) - encoding)) - -(defun mime-create-tag (contype &optional encoding) - "Make a tag with CONTENT-TYPE and optional ENCODING." - (format (if encoding mime-tag-format-with-encoding mime-tag-format) - contype encoding)) - -(defun mime-edit-get-contype (tag) - "Return Content-Type (including parameters) of TAG." - (and (stringp tag) - (or (string-match mime-edit-single-part-tag-regexp tag) - (string-match mime-edit-multipart-beginning-regexp tag) - (string-match mime-edit-multipart-end-regexp tag) - ) - (substring tag (match-beginning 1) (match-end 1)) - )) - -(defun mime-edit-get-encoding (tag) - "Return encoding of TAG." - (and (stringp tag) - (string-match mime-edit-single-part-tag-regexp tag) - (match-beginning 3) - (not (= (match-beginning 3) (match-end 3))) - (substring tag (match-beginning 3) (match-end 3)))) - -(defun mime-get-parameter (contype parameter) - "For given CONTYPE return value for PARAMETER. -Nil if no such parameter." - (if (string-match - (concat - ";[ \t\n]*" - (regexp-quote parameter) - "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\([ \t\n]*;\\|$\\)") - contype) - (substring contype (match-beginning 1) (match-end 1)) - nil ;No such parameter - )) - -(defun mime-edit-set-parameter (contype parameter value) - "For given CONTYPE set PARAMETER to VALUE." - (let (ctype opt-fields) - (if (string-match "\n[^ \t\n\r]+:" contype) - (setq ctype (substring contype 0 (match-beginning 0)) - opt-fields (substring contype (match-beginning 0))) - (setq ctype contype) - ) - (if (string-match - (concat - ";[ \t\n]*\\(" - (regexp-quote parameter) - "[ \t\n]*=[ \t\n]*\\([^\" \t\n;]*\\|\"[^\"]*\"\\)\\)[ \t\n]*\\(;\\|$\\)") - ctype) - ;; Change value - (concat (substring ctype 0 (match-beginning 1)) - parameter "=" value - (substring contype (match-end 1)) - opt-fields) - (concat ctype "; " parameter "=" value opt-fields) - ))) - -(defun mime-strip-parameters (contype) - "Return primary content-type and subtype without parameters for CONTYPE." - (if (string-match "^[ \t]*\\([^; \t\n]*\\)" contype) - (substring contype (match-beginning 1) (match-end 1)) nil)) - -(defun mime-test-content-type (contype type &optional subtype) - "Test if CONTYPE is a TYPE and an optional SUBTYPE." - (and (stringp contype) - (stringp type) - (string-match - (concat "^[ \t]*" (downcase type) "/" (downcase (or subtype ""))) - (downcase contype)))) - - -;; Basic functions - -(defun mime-find-file-type (file) - "Guess Content-Type, subtype, and parameters from FILE." - (let ((guess nil) - (guesses mime-file-types)) - (while (and (not guess) guesses) - (if (string-match (car (car guesses)) file) - (setq guess (cdr (car guesses)))) - (setq guesses (cdr guesses))) - guess - )) - -(defun mime-prompt-for-type (&optional default) - "Ask for Content-type." - (let ((type "")) - ;; Repeat until primary content type is specified. - (while (string-equal type "") - (setq type - (completing-read "What content type: " - mime-content-types - nil - 'require-match ;Type must be specified. - default - )) - (if (string-equal type "") - (progn - (message "Content type is required.") - (beep) - (sit-for 1) - )) - ) - type)) - -(defun mime-prompt-for-subtype (type &optional default) - "Ask for subtype of media-type TYPE." - (let ((subtypes (cdr (assoc type mime-content-types)))) - (or (and default - (assoc default subtypes)) - (setq default (car (car subtypes))) - )) - (let* ((answer - (completing-read - (if default - (concat - "What content subtype: (default " default ") ") - "What content subtype: ") - (cdr (assoc type mime-content-types)) - nil - 'require-match ;Subtype must be specified. - nil - ))) - (if (string-equal answer "") default answer))) - -(defun mime-prompt-for-parameters (pritype subtype &optional delimiter) - "Ask for Content-type parameters of Content-Type PRITYPE and SUBTYPE. -Optional DELIMITER specifies parameter delimiter (';' by default)." - (let* ((delimiter (or delimiter "; ")) - (parameters - (mapconcat - (function identity) - (delq nil - (mime-prompt-for-parameters-1 - (cdr (assoc subtype - (cdr (assoc pritype mime-content-types)))))) - delimiter - ))) - (if (and (stringp parameters) - (not (string-equal parameters ""))) - (concat delimiter parameters) - "" ;"" if no parameters - ))) - -(defun mime-prompt-for-parameters-1 (optlist) - (apply (function append) - (mapcar (function mime-prompt-for-parameter) optlist))) - -(defun mime-prompt-for-parameter (parameter) - "Ask for PARAMETER. -Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." - (let* ((prompt (car parameter)) - (choices (mapcar (function - (lambda (e) - (if (consp e) e (list e)))) - (cdr parameter))) - (default (car (car choices))) - (answer nil)) - (if choices - (progn - (setq answer - (completing-read - (concat "What " prompt - ": (default " - (if (string-equal default "") "\"\"" default) - ") ") - choices nil nil "")) - ;; If nothing is selected, use default. - (if (string-equal answer "") - (setq answer default))) - (setq answer - (read-string (concat "What " prompt ": ")))) - (cons (if (and answer - (not (string-equal answer ""))) - (concat prompt "=" - ;; Note: control characters ignored! - (if (string-match mime-tspecials-regexp answer) - (concat "\"" answer "\"") answer))) - (mime-prompt-for-parameters-1 (cdr (assoc answer (cdr parameter))))) - )) - -(defun mime-prompt-for-encoding (default) - "Ask for Content-Transfer-Encoding. [mime-edit.el]" - (let (encoding) - (while (string= - (setq encoding - (completing-read - "What transfer encoding: " - mime-file-encoding-method-alist nil t default) - ) - "")) - encoding)) - - -;;; @ Translate the tagged MIME messages into a MIME compliant message. -;;; - -(defvar mime-edit-translate-buffer-hook - '(mime-edit-pgp-enclose-buffer - mime-edit-translate-body - mime-edit-translate-header)) - -(defun mime-edit-translate-header () - "Encode the message header into network representation." - (eword-encode-header 'code-conversion) - (run-hooks 'mime-edit-translate-header-hook) - ) - -(defun mime-edit-translate-buffer () - "Encode the tagged MIME message in current buffer in MIME compliant message." - (interactive) - (if (catch 'mime-edit-error - (save-excursion - (run-hooks 'mime-edit-translate-buffer-hook) - )) - (progn - (undo) - (error "Translation error!") - ))) - -(defun mime-edit-find-inmost () - (goto-char (point-min)) - (if (re-search-forward mime-edit-multipart-beginning-regexp nil t) - (let ((bb (match-beginning 0)) - (be (match-end 0)) - (type (buffer-substring (match-beginning 1)(match-end 1))) - end-exp eb ee) - (setq end-exp (format "--}-<<%s>>\n" type)) - (widen) - (if (re-search-forward end-exp nil t) - (progn - (setq eb (match-beginning 0)) - (setq ee (match-end 0)) - ) - (setq eb (point-max)) - (setq ee (point-max)) - ) - (narrow-to-region be eb) - (goto-char be) - (if (re-search-forward mime-edit-multipart-beginning-regexp nil t) - (let (ret) - (narrow-to-region (match-beginning 0)(point-max)) - (mime-edit-find-inmost) - ) - (widen) - (list type bb be eb) - )))) - -(defun mime-edit-process-multipart-1 (boundary) - (let ((ret (mime-edit-find-inmost))) - (if ret - (let ((type (car ret)) - (bb (nth 1 ret))(be (nth 2 ret)) - (eb (nth 3 ret)) - ) - (narrow-to-region bb eb) - (delete-region bb be) - (setq bb (point-min)) - (setq eb (point-max)) - (widen) - (goto-char eb) - (if (looking-at mime-edit-multipart-end-regexp) - (let ((beg (match-beginning 0)) - (end (match-end 0)) - ) - (delete-region beg end) - (or (looking-at mime-edit-beginning-tag-regexp) - (eobp) - (insert (concat (mime-make-text-tag) "\n")) - ))) - (cond ((string-equal type "quote") - (mime-edit-enquote-region bb eb) - ) - ((string-equal type "signed") - (cond ((eq mime-edit-signing-type 'pgp-elkins) - (mime-edit-sign-pgp-elkins bb eb boundary) - ) - ((eq mime-edit-signing-type 'pgp-kazu) - (mime-edit-sign-pgp-kazu bb eb boundary) - )) - ) - ((string-equal type "encrypted") - (cond ((eq mime-edit-encrypting-type 'pgp-elkins) - (mime-edit-encrypt-pgp-elkins bb eb boundary) - ) - ((eq mime-edit-encrypting-type 'pgp-kazu) - (mime-edit-encrypt-pgp-kazu bb eb boundary) - ))) - (t - (setq boundary - (nth 2 (mime-edit-translate-region bb eb - boundary t))) - (goto-char bb) - (insert - (format "--[[multipart/%s; - boundary=\"%s\"][7bit]]\n" - type boundary)) - )) - boundary)))) - -(defun mime-edit-enquote-region (beg end) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (while (re-search-forward mime-edit-single-part-tag-regexp nil t) - (let ((tag (buffer-substring (match-beginning 0)(match-end 0)))) - (replace-match (concat "- " (substring tag 1))) - ))))) - -(defun mime-edit-dequote-region (beg end) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (while (re-search-forward - mime-edit-quoted-single-part-tag-regexp nil t) - (let ((tag (buffer-substring (match-beginning 0)(match-end 0)))) - (replace-match (concat "-" (substring tag 2))) - ))))) - -(defun mime-edit-sign-pgp-elkins (beg end boundary) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret)) - (parts (nth 3 ret)) - (pgp-boundary (concat "pgp-sign-" boundary)) - ) - (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)) - (throw 'mime-edit-error 'pgp-error) - ) - )))) - -(defvar mime-edit-encrypt-recipient-fields-list '("To" "cc")) - -(defun mime-edit-make-encrypt-recipient-header () - (let* ((names mime-edit-encrypt-recipient-fields-list) - (values - (std11-field-bodies (cons "From" names) - nil mail-header-separator)) - (from (prog1 - (car values) - (setq values (cdr values)))) - (header (and (stringp from) - (if (string-equal from "") - "" - (format "From: %s\n" from) - ))) - recipients) - (while (and names values) - (let ((name (car names)) - (value (car values)) - ) - (and (stringp value) - (or (string-equal value "") - (progn - (setq header (concat header name ": " value "\n") - recipients (if recipients - (concat recipients " ," value) - value)) - )))) - (setq names (cdr names) - values (cdr values)) - ) - (vector from recipients header) - )) - -(defun mime-edit-encrypt-pgp-elkins (beg end boundary) - (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)) - ) - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret)) - (parts (nth 3 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) - (throw 'mime-edit-error 'pgp-error) - ) - (goto-char beg) - (insert (format "--[[multipart/encrypted; - boundary=\"%s\"; - protocol=\"application/pgp-encrypted\"][7bit]] ---%s -Content-Type: application/pgp-encrypted - ---%s -Content-Type: application/octet-stream -Content-Transfer-Encoding: 7bit - -" pgp-boundary pgp-boundary pgp-boundary)) - (goto-char (point-max)) - (insert (format "\n--%s--\n" pgp-boundary)) - ))))) - -(defun mime-edit-sign-pgp-kazu (beg end boundary) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret)) - (parts (nth 3 ret)) - ) - (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 'traditional-sign) - beg (point-max))) - (throw 'mime-edit-error 'pgp-error) - ) - (goto-char beg) - (insert - "--[[application/pgp; format=mime][7bit]]\n") - )) - )) - -(defun mime-edit-encrypt-pgp-kazu (beg end boundary) - (save-excursion - (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)) - ) - (save-restriction - (narrow-to-region beg end) - (let* ((ret - (mime-edit-translate-region beg end boundary)) - (ctype (car ret)) - (encoding (nth 1 ret)) - (parts (nth 3 ret)) - ) - (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 (as-binary-process - (funcall (pgp-function 'encrypt) - recipients beg (point-max) nil 'maybe) - ) - (throw 'mime-edit-error 'pgp-error) - ) - (goto-char beg) - (insert - "--[[application/pgp; format=mime][7bit]]\n") - )) - ))) - -(defsubst replace-space-with-underline (str) - (mapconcat (function - (lambda (arg) - (char-to-string - (if (eq arg ?\ ) - ?_ - arg)))) str "") - ) - -(defun mime-edit-make-boundary () - (concat mime-multipart-boundary "_" - (replace-space-with-underline (current-time-string)) - )) - -(defun mime-edit-translate-body () - "Encode the tagged MIME body in current buffer in MIME compliant message." - (interactive) - (save-excursion - (let ((boundary (mime-edit-make-boundary)) - (i 1) - ret) - (while (mime-edit-process-multipart-1 - (format "%s-%d" boundary i)) - (setq i (1+ i)) - ) - (save-restriction - ;; We are interested in message body. - (let* ((beg - (progn - (goto-char (point-min)) - (re-search-forward - (concat "\n" (regexp-quote mail-header-separator) - (if mime-ignore-preceding-spaces - "[ \t\n]*\n" "\n")) nil 'move) - (point))) - (end - (progn - (goto-char (point-max)) - (and mime-ignore-trailing-spaces - (re-search-backward "[^ \t\n]\n" beg t) - (forward-char 1)) - (point)))) - (setq ret (mime-edit-translate-region - beg end - (format "%s-%d" boundary i))) - )) - (mime-edit-dequote-region (point-min)(point-max)) - (let ((contype (car ret)) ;Content-Type - (encoding (nth 1 ret)) ;Content-Transfer-Encoding - ) - ;; Insert X-Emacs field - (and mime-edit-insert-x-emacs-field - (or (mail-position-on-field "X-Emacs") - (insert mime-edit-x-emacs-value) - )) - ;; Make primary MIME headers. - (or (mail-position-on-field "Mime-Version") - (insert mime-edit-mime-version-value)) - ;; Remove old Content-Type and other fields. - (save-restriction - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t) - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (mime-delete-field "Content-Type") - (mime-delete-field "Content-Transfer-Encoding")) - ;; Then, insert Content-Type and Content-Transfer-Encoding fields. - (mail-position-on-field "Content-Type") - (insert contype) - (if encoding - (progn - (mail-position-on-field "Content-Transfer-Encoding") - (insert encoding))) - )))) - -(defun mime-edit-translate-single-part-tag (&optional prefix) - "Translate single-part-tag to MIME header." - (if (re-search-forward mime-edit-single-part-tag-regexp nil t) - (let* ((beg (match-beginning 0)) - (end (match-end 0)) - (tag (buffer-substring beg end)) - ) - (delete-region beg end) - (let ((contype (mime-edit-get-contype tag)) - (encoding (mime-edit-get-encoding tag)) - ) - (insert (concat prefix "--" boundary "\n")) - (save-restriction - (narrow-to-region (point)(point)) - (insert "Content-Type: " contype "\n") - (if encoding - (insert "Content-Transfer-Encoding: " encoding "\n")) - (eword-encode-header) - )) - t))) - -(defun mime-edit-translate-region (beg end &optional boundary multipart) - (or boundary - (setq boundary (mime-edit-make-boundary)) - ) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (let ((tag nil) ;MIME tag - (contype nil) ;Content-Type - (encoding nil) ;Content-Transfer-Encoding - (nparts 0)) ;Number of body parts - ;; Normalize the body part by inserting appropriate message - ;; tags for every message contents. - (mime-edit-normalize-body) - ;; Counting the number of Content-Type. - (goto-char (point-min)) - (while (re-search-forward mime-edit-single-part-tag-regexp nil t) - (setq nparts (1+ nparts))) - ;; Begin translation. - (cond - ((and (<= nparts 1)(not multipart)) - ;; It's a singular message. - (goto-char (point-min)) - (while (re-search-forward - mime-edit-single-part-tag-regexp nil t) - (setq tag - (buffer-substring (match-beginning 0) (match-end 0))) - (delete-region (match-beginning 0) (1+ (match-end 0))) - (setq contype (mime-edit-get-contype tag)) - (setq encoding (mime-edit-get-encoding tag)) - )) - (t - ;; It's a multipart message. - (goto-char (point-min)) - (and (mime-edit-translate-single-part-tag) - (while (mime-edit-translate-single-part-tag "\n")) - ) - ;; Define Content-Type as "multipart/mixed". - (setq contype - (concat "multipart/mixed;\n boundary=\"" boundary "\"")) - ;; Content-Transfer-Encoding must be "7bit". - ;; The following encoding can be `nil', but is - ;; specified as is since there is no way that a user - ;; specifies it. - (setq encoding "7bit") - ;; Insert the trailer. - (goto-char (point-max)) - (insert "\n--" boundary "--\n") - )) - (list contype encoding boundary nparts) - )))) - -(defun mime-edit-normalize-body () - "Normalize the body part by inserting appropriate message tags." - ;; Insert the first MIME tags if necessary. - (goto-char (point-min)) - (if (not (looking-at mime-edit-single-part-tag-regexp)) - (insert (mime-make-text-tag) "\n")) - ;; Check each tag, and add new tag or correct it if necessary. - (goto-char (point-min)) - (while (re-search-forward mime-edit-single-part-tag-regexp nil t) - (let* ((tag (buffer-substring (match-beginning 0) (match-end 0))) - (contype (mime-edit-get-contype tag)) - (charset (mime-get-parameter contype "charset")) - (encoding (mime-edit-get-encoding tag))) - ;; Remove extra whitespaces after the tag. - (if (looking-at "[ \t]+$") - (delete-region (match-beginning 0) (match-end 0))) - (let ((beg (point)) - (end (mime-edit-content-end)) - ) - (if (= end (point-max)) - nil - (goto-char end) - (or (looking-at mime-edit-beginning-tag-regexp) - (eobp) - (insert (mime-make-text-tag) "\n") - )) - (visible-region beg end) - (goto-char beg) - ) - (cond - ((mime-test-content-type contype "message") - ;; Content-type "message" should be sent as is. - (forward-line 1) - ) - ((mime-test-content-type contype "text") - ;; Define charset for text if necessary. - (setq charset (if charset - (intern (downcase charset)) - (mime-edit-choose-charset))) - (mime-edit-define-charset charset) - (cond ((string-equal contype "text/x-rot13-47-48") - (save-excursion - (forward-line) - (mule-caesar-region (point) (mime-edit-content-end)) - )) - ((string-equal contype "text/enriched") - (save-excursion - (let ((beg (progn - (forward-line) - (point))) - (end (mime-edit-content-end)) - ) - ;; Patch for hard newlines - ;; (save-excursion - ;; (goto-char beg) - ;; (while (search-forward "\n" end t) - ;; (put-text-property (match-beginning 0) - ;; (point) - ;; 'hard t))) - ;; End patch for hard newlines - (enriched-encode beg end) - (goto-char beg) - (if (search-forward "\n\n") - (delete-region beg (match-end 0)) - ) - )))) - ;; Point is now on current tag. - ;; Define encoding and encode text if necessary. - (or encoding ;Encoding is not specified. - (let* ((encoding - (cdr - (assq charset - mime-edit-charset-default-encoding-alist) - )) - (beg (mime-edit-content-beginning)) - ) - (encode-mime-charset-region beg (mime-edit-content-end) - charset) - (mime-encode-region beg (mime-edit-content-end) encoding) - (mime-edit-define-encoding encoding) - )) - (goto-char (mime-edit-content-end)) - ) - ((null encoding) ;Encoding is not specified. - ;; Application, image, audio, video, and any other - ;; unknown content-type without encoding should be - ;; encoded. - (let* ((encoding "base64") ;Encode in BASE64 by default. - (beg (mime-edit-content-beginning)) - (end (mime-edit-content-end)) - (body (buffer-substring beg end)) - ) - (mime-encode-region beg end encoding) - (mime-edit-define-encoding encoding)) - (forward-line 1) - )) - ))) - -(defun mime-delete-field (field) - "Delete header FIELD." - (let ((regexp (format "^%s:[ \t]*" field))) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point))) - ))) - - -;;; -;;; Platform dependent functions -;;; - -;; Sun implementations - -(defun mime-edit-voice-recorder-for-sun (encoding) - "Record voice in a buffer using Sun audio device, -and insert data encoded as ENCODING. [mime-edit.el]" - (message "Start the recording on %s. Type C-g to finish the recording..." - (system-name)) - (mime-insert-encoded-file "/dev/audio" encoding) - ) - - -;;; @ Other useful commands. -;;; - -;; Message forwarding commands as content-type "message/rfc822". - -(defun mime-edit-insert-message (&optional message) - (interactive) - (let ((inserter (cdr (assq major-mode mime-edit-message-inserter-alist)))) - (if (and inserter (fboundp inserter)) - (progn - (mime-edit-insert-tag "message" "rfc822") - (funcall inserter message) - ) - (message "Sorry, I don't have message inserter for your MUA.") - ))) - -(defun mime-edit-insert-mail (&optional message) - (interactive) - (let ((inserter (cdr (assq major-mode mime-edit-mail-inserter-alist)))) - (if (and inserter (fboundp inserter)) - (progn - (mime-edit-insert-tag "message" "rfc822") - (funcall inserter message) - ) - (message "Sorry, I don't have mail inserter for your MUA.") - ))) - -(defun mime-edit-inserted-message-filter () - (save-excursion - (save-restriction - (let ((header-start (point)) - (case-fold-search t) - beg end) - ;; for Emacs 18 - ;; (if (re-search-forward "^$" (marker-position (mark-marker))) - (if (re-search-forward "^$" (mark t)) - (narrow-to-region header-start (match-beginning 0)) - ) - (goto-char header-start) - (while (and (re-search-forward - mime-edit-yank-ignored-field-regexp nil t) - (setq beg (match-beginning 0)) - (setq end (1+ (std11-field-end))) - ) - (delete-region beg end) - ) - )))) - - -;;; @ multipart enclosure -;;; - -(defun mime-edit-enclose-region (type beg end) - (save-excursion - (goto-char beg) - (let ((current (point))) - (save-restriction - (narrow-to-region beg end) - (insert (format "--<<%s>>-{\n" type)) - (goto-char (point-max)) - (insert (format "--}-<<%s>>\n" type)) - (goto-char (point-max)) - ) - (or (looking-at mime-edit-beginning-tag-regexp) - (eobp) - (insert (mime-make-text-tag) "\n") - ) - ))) - -(defun mime-edit-enclose-quote-region (beg end) - (interactive "*r") - (mime-edit-enclose-region "quote" beg end) - ) - -(defun mime-edit-enclose-mixed-region (beg end) - (interactive "*r") - (mime-edit-enclose-region "mixed" beg end) - ) - -(defun mime-edit-enclose-parallel-region (beg end) - (interactive "*r") - (mime-edit-enclose-region "parallel" beg end) - ) - -(defun mime-edit-enclose-digest-region (beg end) - (interactive "*r") - (mime-edit-enclose-region "digest" beg end) - ) - -(defun mime-edit-enclose-alternative-region (beg end) - (interactive "*r") - (mime-edit-enclose-region "alternative" beg end) - ) - -(defun mime-edit-enclose-signed-region (beg end) - (interactive "*r") - (if mime-edit-signing-type - (mime-edit-enclose-region "signed" beg end) - (message "Please specify signing type.") - )) - -(defun mime-edit-enclose-encrypted-region (beg end) - (interactive "*r") - (if mime-edit-signing-type - (mime-edit-enclose-region "encrypted" beg end) - (message "Please specify encrypting type.") - )) - -(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)) - ) - - -;;; @ flag setting -;;; - -(defun mime-edit-set-split (arg) - (interactive - (list - (y-or-n-p "Do you want to enable split?") - )) - (setq mime-edit-split-message arg) - (if arg - (message "This message is enabled to split.") - (message "This message is not enabled to split.") - )) - -(defun mime-edit-toggle-transfer-level (&optional transfer-level) - "Toggle transfer-level is 7bit or 8bit through. - -Optional TRANSFER-LEVEL is a number of transfer-level, 7 or 8." - (interactive) - (if (numberp transfer-level) - (setq mime-transfer-level transfer-level) - (if (< mime-transfer-level 8) - (setq mime-transfer-level 8) - (setq mime-transfer-level 7) - )) - (setq mime-edit-charset-default-encoding-alist - (mime-make-charset-default-encoding-alist mime-transfer-level)) - (message (format "Current transfer-level is %d bit" - mime-transfer-level)) - (setq mime-transfer-level-string - (mime-encoding-name mime-transfer-level 'not-omit)) - (force-mode-line-update) - ) - -(defun mime-edit-set-transfer-level-7bit () - (interactive) - (mime-edit-toggle-transfer-level 7) - ) - -(defun mime-edit-set-transfer-level-8bit () - (interactive) - (mime-edit-toggle-transfer-level 8) - ) - - -;;; @ pgp -;;; - -(defun mime-edit-set-sign (arg) - (interactive - (list - (y-or-n-p "Do you want to sign?") - )) - (if arg - (if mime-edit-signing-type - (progn - (setq mime-edit-pgp-processing 'sign) - (message "This message will be signed.") - ) - (message "Please specify signing type.") - ) - (if (eq mime-edit-pgp-processing 'sign) - (setq mime-edit-pgp-processing nil) - ) - (message "This message will not be signed.") - )) - -(defun mime-edit-set-encrypt (arg) - (interactive - (list - (y-or-n-p "Do you want to encrypt?") - )) - (if arg - (if mime-edit-encrypting-type - (progn - (setq mime-edit-pgp-processing 'encrypt) - (message "This message will be encrypt.") - ) - (message "Please specify encrypting type.") - ) - (if (eq mime-edit-pgp-processing 'encrypt) - (setq mime-edit-pgp-processing nil) - ) - (message "This message will not be encrypt.") - )) - -(defvar mime-edit-pgp-processing nil) -(make-variable-buffer-local 'mime-edit-pgp-processing) - -(defun mime-edit-pgp-enclose-buffer () - (let ((beg (save-excursion - (goto-char (point-min)) - (if (search-forward (concat "\n" mail-header-separator "\n")) - (match-end 0) - ))) - (end (point-max)) - ) - (if beg - (cond ((eq mime-edit-pgp-processing 'sign) - (mime-edit-enclose-signed-region beg end) - ) - ((eq mime-edit-pgp-processing 'encrypt) - (mime-edit-enclose-encrypted-region beg end) - )) - ))) - - -;;; @ split -;;; - -(defun mime-edit-insert-partial-header - (fields subject id number total separator) - (insert fields) - (insert (format "Subject: %s (%d/%d)\n" subject number total)) - (insert (format "Mime-Version: 1.0 (split by %s)\n" - mime-edit-version-name)) - (insert (format "\ -Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" - id number total separator)) - ) - -(defun mime-edit-split-and-send - (&optional cmd lines mime-edit-message-max-length) - (interactive) - (or lines - (setq lines - (count-lines (point-min) (point-max))) - ) - (or mime-edit-message-max-length - (setq mime-edit-message-max-length - (or (cdr (assq major-mode mime-edit-message-max-lines-alist)) - mime-edit-message-default-max-lines)) - ) - (let* ((mime-edit-draft-file-name - (or (buffer-file-name) - (make-temp-name - (expand-file-name "mime-draft" mime-temp-directory)))) - (separator mail-header-separator) - (id (concat "\"" - (replace-space-with-underline (current-time-string)) - "@" (system-name) "\""))) - (run-hooks 'mime-edit-before-split-hook) - (let ((the-buf (current-buffer)) - (copy-buf (get-buffer-create " *Original Message*")) - (header (std11-header-string-except - mime-edit-split-ignored-field-regexp separator)) - (subject (mail-fetch-field "subject")) - (total (+ (/ lines mime-edit-message-max-length) - (if (> (mod lines mime-edit-message-max-length) 0) - 1))) - (command - (or cmd - (cdr - (assq major-mode - mime-edit-split-message-sender-alist)) - (function - (lambda () - (interactive) - (error "Split sender is not specified for `%s'." major-mode) - )) - )) - (mime-edit-partial-number 1) - data) - (save-excursion - (set-buffer copy-buf) - (erase-buffer) - (insert-buffer the-buf) - (save-restriction - (if (re-search-forward - (concat "^" (regexp-quote separator) "$") nil t) - (let ((he (match-beginning 0))) - (replace-match "") - (narrow-to-region (point-min) he) - )) - (goto-char (point-min)) - (while (re-search-forward mime-edit-split-blind-field-regexp nil t) - (delete-region (match-beginning 0) - (1+ (std11-field-end))) - ))) - (while (< mime-edit-partial-number total) - (erase-buffer) - (save-excursion - (set-buffer copy-buf) - (setq data (buffer-substring - (point-min) - (progn - (goto-line mime-edit-message-max-length) - (point)) - )) - (delete-region (point-min)(point)) - ) - (mime-edit-insert-partial-header - header subject id mime-edit-partial-number total separator) - (insert data) - (save-excursion - (message (format "Sending %d/%d..." - mime-edit-partial-number total)) - (call-interactively command) - (message (format "Sending %d/%d... done" - mime-edit-partial-number total)) - ) - (setq mime-edit-partial-number - (1+ mime-edit-partial-number)) - ) - (erase-buffer) - (save-excursion - (set-buffer copy-buf) - (setq data (buffer-string)) - (erase-buffer) - ) - (mime-edit-insert-partial-header - header subject id mime-edit-partial-number total separator) - (insert data) - (save-excursion - (message (format "Sending %d/%d..." - mime-edit-partial-number total)) - (message (format "Sending %d/%d... done" - mime-edit-partial-number total)) - ) - ))) - -(defun mime-edit-maybe-split-and-send (&optional cmd) - (interactive) - (run-hooks 'mime-edit-before-send-hook) - (let ((mime-edit-message-max-length - (or (cdr (assq major-mode mime-edit-message-max-lines-alist)) - mime-edit-message-default-max-lines)) - (lines (count-lines (point-min) (point-max))) - ) - (if (and (> lines mime-edit-message-max-length) - mime-edit-split-message) - (mime-edit-split-and-send cmd lines mime-edit-message-max-length) - ))) - - -;;; @ preview message -;;; - -(defvar mime-edit-buffer nil) ; buffer local variable - -(defun mime-edit-preview-message () - "preview editing MIME message. [mime-edit.el]" - (interactive) - (let* ((str (buffer-string)) - (separator mail-header-separator) - (the-buf (current-buffer)) - (buf-name (buffer-name)) - (temp-buf-name (concat "*temp-article:" buf-name "*")) - (buf (get-buffer temp-buf-name)) - ) - (if buf - (progn - (switch-to-buffer buf) - (erase-buffer) - ) - (setq buf (get-buffer-create temp-buf-name)) - (switch-to-buffer buf) - ) - (insert str) - (setq major-mode 'mime-temp-message-mode) - (make-local-variable 'mail-header-separator) - (setq mail-header-separator separator) - (make-local-variable 'mime-edit-buffer) - (setq mime-edit-buffer the-buf) - - (run-hooks 'mime-edit-translate-hook) - (mime-edit-translate-buffer) - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote separator) "$")) - (replace-match "") - ) - (mime-view-mode) - )) - -(defun mime-edit-quitting-method () - "Quitting method for mime-view." - (let ((temp mime-raw-buffer) - buf) - (mime-view-kill-buffer) - (set-buffer temp) - (setq buf mime-edit-buffer) - (kill-buffer temp) - (switch-to-buffer buf) - )) - -(set-alist 'mime-view-quitting-method-alist - 'mime-temp-message-mode - (function mime-edit-quitting-method) - ) - - -;;; @ edit again -;;; - -(defvar mime-edit-again-ignored-field-regexp - (concat "^\\(" "Content-.*\\|Mime-Version" - (if mime-edit-insert-x-emacs-field "\\|X-Emacs") - "\\):") - "Regexp for deleted header fields when `mime-edit-again' is called.") - -(defun mime-edit-decode-buffer (not-decode-text) - (save-excursion - (goto-char (point-min)) - (let ((ctl (mime/Content-Type))) - (if ctl - (let ((ctype (car ctl)) - (params (cdr ctl)) - type stype) - (if (string-match "/" ctype) - (progn - (setq type (substring ctype 0 (match-beginning 0))) - (setq stype (substring ctype (match-end 0))) - ) - (setq type ctype) - ) - (cond - ((string= ctype "application/pgp-signature") - (delete-region (point-min)(point-max)) - ) - ((string= type "multipart") - (let* ((boundary (cdr (assoc "boundary" params))) - (boundary-pat - (concat "\n--" (regexp-quote boundary) "[ \t]*\n")) - ) - (re-search-forward boundary-pat nil t) - (let ((bb (match-beginning 0)) eb tag) - (setq tag (format "\n--<<%s>>-{\n" stype)) - (goto-char bb) - (insert tag) - (setq bb (+ bb (length tag))) - (re-search-forward - (concat "\n--" (regexp-quote boundary) "--[ \t]*\n") - nil t) - (setq eb (match-beginning 0)) - (replace-match (format "--}-<<%s>>\n" stype)) - (save-restriction - (narrow-to-region bb eb) - (goto-char (point-min)) - (while (re-search-forward boundary-pat nil t) - (let ((beg (match-beginning 0)) - end) - (delete-region beg (match-end 0)) - (save-excursion - (if (re-search-forward boundary-pat nil t) - (setq end (match-beginning 0)) - (setq end (point-max)) - ) - (save-restriction - (narrow-to-region beg end) - (mime-edit-decode-buffer not-decode-text) - (goto-char (point-max)) - )))) - )) - (goto-char (point-min)) - (or (= (point-min) 1) - (delete-region (point-min) - (if (search-forward "\n\n" nil t) - (match-end 0) - (point-min) - ))) - )) - (t - (let* (charset - (pstr - (let ((bytes (+ 14 (length ctype)))) - (mapconcat (function - (lambda (attr) - (if (string-equal (car attr) "charset") - (progn - (setq charset (cdr attr)) - "") - (let* ((str - (concat (car attr) - "=" (cdr attr)) - ) - (bs (length str)) - ) - (setq bytes (+ bytes bs 2)) - (if (< bytes 76) - (concat "; " str) - (setq bytes (+ bs 1)) - (concat ";\n " str) - ) - )))) - params ""))) - encoding - encoded) - (save-excursion - (if (re-search-forward - "Content-Transfer-Encoding:" nil t) - (let ((beg (match-beginning 0)) - (hbeg (match-end 0)) - (end (std11-field-end))) - (setq encoding - (eliminate-top-spaces - (std11-unfold-string - (buffer-substring hbeg end)))) - (if (or charset (string-equal type "text")) - (progn - (delete-region beg (1+ end)) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (progn - (mime-decode-region - (match-end 0)(point-max) encoding) - (setq encoded t - encoding nil) - ))))))) - (if (or encoded (not not-decode-text)) - (decode-mime-charset-region - (point-min)(point-max) - (or charset default-mime-charset)) - ) - (let ((he - (if (re-search-forward "^$" nil t) - (match-end 0) - (point-min) - ))) - (if (= (point-min) 1) - (progn - (goto-char he) - (insert - (concat "\n" - (mime-create-tag - (concat type "/" stype pstr) encoding))) - ) - (delete-region (point-min) he) - (insert - (mime-create-tag - (concat type "/" stype pstr) encoding)) - )) - )))) - (or not-decode-text - (decode-mime-charset-region (point-min) (point-max) - default-mime-charset) - ) - )))) - -(defun mime-edit-again (&optional not-decode-text no-separator not-turn-on) - "Convert current buffer to MIME-Edit buffer and turn on MIME-Edit mode. -Content-Type and Content-Transfer-Encoding header fields will be -converted to MIME-Edit tags." - (interactive) - (goto-char (point-min)) - (if (search-forward - (concat "\n" (regexp-quote mail-header-separator) "\n") - nil t) - (replace-match "\n\n") - ) - (mime-edit-decode-buffer not-decode-text) - (goto-char (point-min)) - (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))) - )) - (or no-separator - (and (re-search-forward "^$") - (replace-match mail-header-separator) - )) - (or not-turn-on - (turn-on-mime-edit) - )) - - -;;; @ end -;;; - -(provide 'mime-edit) - -(run-hooks 'mime-edit-load-hook) - -;;; mime-edit.el ends here diff --git a/mime-file.el b/mime-file.el deleted file mode 100644 index fa2e692..0000000 --- a/mime-file.el +++ /dev/null @@ -1,97 +0,0 @@ -;;; mime-file.el --- mime-view internal method for file extraction - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; modified by Shuhei KOBAYASHI -;; Version: $Id: mime-file.el,v 0.2 1997-05-12 12:28:38 morioka Exp $ -;; Keywords: file, extract, MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'mime-view) - -(defun mime-article/extract-file (beg end cal) - (goto-char beg) - (let* ((name - (save-restriction - (narrow-to-region beg end) - (mime-article/get-filename cal) - )) - (encoding (cdr (assq 'encoding cal))) - (filename - (if (and name (not (string-equal name ""))) - (expand-file-name name - (call-interactively - (function - (lambda (dir) - (interactive "DDirectory: ") - dir)))) - (call-interactively - (function - (lambda (file) - (interactive "FFilename: ") - (expand-file-name file)))))) - (tmp-buf (generate-new-buffer (file-name-nondirectory filename))) - ) - (if (file-exists-p filename) - (or (yes-or-no-p (format "File %s exists. Save anyway? " filename)) - (error ""))) - (re-search-forward "\n\n") - (append-to-buffer tmp-buf (match-end 0) end) - (save-excursion - (set-buffer tmp-buf) - (mime-decode-region (point-min)(point-max) encoding) - (let ((coding-system-for-write 'no-conversion) - jka-compr-compression-info-list ; for jka-compr - jam-zcat-filename-list ; for jam-zcat - require-final-newline) - (write-file filename) - ) - (kill-buffer tmp-buf) - ))) - - -;;; @ setup -;;; - -(set-atype 'mime-acting-condition - '((type . "application/octet-stream") - (method . mime-article/extract-file) - ) - 'ignore '(method) - 'replacement) - -(set-atype 'mime-acting-condition - '((mode . "extract") - (method . mime-article/extract-file) - ) - 'remove - '((method "mime-file" nil 'file 'type 'encoding 'mode 'name) - (mode . "extract")) - 'replacement) - - -;;; @ end -;;; - -(provide 'mime-file) - -;;; end of mime-file.el diff --git a/mime-image.el b/mime-image.el deleted file mode 100644 index 1a7f937..0000000 --- a/mime-image.el +++ /dev/null @@ -1,225 +0,0 @@ -;;; mime-image.el --- mime-view filter to display images - -;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko -;; Copyright (C) 1996 Dan Rich - -;; Author: MORIOKA Tomohiko -;; Dan Rich -;; Maintainer: MORIOKA Tomohiko -;; Created: 1995/12/15 -;; Renamed: 1997/2/21 from tm-image.el -;; Version: -;; $Id: mime-image.el,v 0.11 1997-05-27 03:11:47 morioka Exp $ - -;; Keywords: image, picture, X-Face, MIME, multimedia, mail, news - -;; This file is part of XEmacs. - -;; 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 XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; If you use this program with MULE, please install -;; etl8x16-bitmap.bdf font included in tl package. - -;;; Code: - -(require 'mime-view) -(require 'alist) - -(cond (running-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-view-content-header-filter-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 (file-installed-p uncompface-program exec-path) - (add-hook 'mime-view-content-header-filter-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) "") - )) - ) - -(defvar mime-view-image-converter-alist nil) - -(mapcar (function - (lambda (rule) - (let ((ctype (car rule)) - (format (cdr rule)) - ) - (if (image-inline-p format) - (progn - (set-alist 'mime-view-content-filter-alist - ctype - (function mime-view-filter-for-image)) - (set-alist 'mime-view-image-converter-alist - ctype format) - (add-to-list - 'mime-view-visible-media-type-list - ctype) - ) - )))) - '(("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) - )) - -(defvar mime-view-ps-to-gif-command "pstogif") - - -;;; @ content filter for images -;;; -;; (for XEmacs 19.12 or later) - -(defun mime-view-filter-for-image (ctype params encoding) - (let ((beg (point-min)) - (end (point-max))) - (remove-text-properties beg end '(face nil)) - (message "Decoding image...") - (mime-decode-region beg end encoding) - (let* ((minor (cdr (assoc ctype mime-view-image-converter-alist))) - (gl (image-normalize minor (buffer-string))) - e) - (delete-region (point-min)(point-max)) - (cond ((image-invalid-glyph-p gl) - (setq gl nil) - (message "Invalid glyph!") - ) - ((eq (aref gl 0) 'xbm) - (let ((xbm-file - (make-temp-name - (expand-file-name "tm" mime-temp-directory)))) - (insert (aref gl 2)) - (write-region (point-min)(point-max) xbm-file) - (message "Decoding image...") - (delete-region (point-min)(point-max)) - (bitmap-insert-xbm-file xbm-file) - (delete-file xbm-file) - ) - (message "Decoding image... done") - ) - (t - (setq gl (make-glyph gl)) - (setq e (make-extent (point) (point))) - (set-extent-end-glyph e gl) - (message "Decoding image... done") - )) - ) - (insert "\n") - )) - - -;;; @ content filter for Postscript -;;; -;; (for XEmacs 19.14 or later) - -(defun mime-view-filter-for-application/postscript (ctype params encoding) - (let* ((beg (point-min)) (end (point-max)) - (file-base - (make-temp-name (expand-file-name "tm" mime-temp-directory))) - (ps-file (concat file-base ".ps")) - (gif-file (concat file-base ".gif")) - ) - (remove-text-properties beg end '(face nil)) - (message "Decoding Postscript...") - (mime-decode-region beg end encoding) - (write-region (point-min)(point-max) ps-file) - (message "Decoding Postscript...") - (delete-region (point-min)(point-max)) - (call-process mime-view-ps-to-gif-command nil nil nil ps-file) - (set-extent-end-glyph (make-extent (point) (point)) - (make-glyph (vector 'gif :file gif-file))) - (message "Decoding Postscript... done") - (delete-file ps-file) - (delete-file gif-file) - )) - -(set-alist 'mime-view-content-filter-alist - "application/postscript" - (function mime-view-filter-for-application/postscript)) - -(if (featurep 'gif) - (add-to-list 'mime-view-visible-media-type-list "application/postscript") - ) - - -;;; @ end -;;; - -(provide 'mime-image) - -;;; mime-image.el ends here diff --git a/mime-mc.el b/mime-mc.el deleted file mode 100644 index 75ba129..0000000 --- a/mime-mc.el +++ /dev/null @@ -1,165 +0,0 @@ -;;; mime-mc.el --- Mailcrypt interface for SEMI - -;; Copyright (C) 1996,1997 MORIOKA Tomohiko - -;; Author: MORIOKA Tomohiko -;; Version: $Id: mime-mc.el,v 0.0 1997-02-27 08:03:48 tmorioka Exp $ -;; Keywords: PGP, security, MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'mailcrypt) -(load "mc-pgp") - -(defun mime-mc-pgp-generic-parser (result) - (let ((ret (mc-pgp-generic-parser result))) - (if (consp ret) - (vector (car ret)(cdr ret)) - ))) - -(defun mime-mc-process-region - (beg end passwd program args parser &optional buffer boundary) - (let ((obuf (current-buffer)) - (process-connection-type nil) - mybuf result rgn proc) - (unwind-protect - (progn - (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp"))) - (set-buffer mybuf) - (erase-buffer) - (set-buffer obuf) - (buffer-disable-undo mybuf) - (setq proc - (apply 'start-process "*PGP*" mybuf program args)) - (if passwd - (progn - (process-send-string proc (concat passwd "\n")) - (or mc-passwd-timeout (mc-deactivate-passwd t)))) - (process-send-region proc beg end) - (process-send-eof proc) - (while (eq 'run (process-status proc)) - (accept-process-output proc 5)) - (setq result (process-exit-status proc)) - ;; Hack to force a status_notify() in Emacs 19.29 - (delete-process proc) - (set-buffer mybuf) - (goto-char (point-max)) - (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t) - (delete-region (match-beginning 0) (match-end 0))) - (goto-char (point-min)) - ;; CRNL -> NL - (while (search-forward "\r\n" nil t) - (replace-match "\n")) - ;; Hurm. FIXME; must get better result codes. - (if (stringp result) - (error "%s exited abnormally: '%s'" program result) - (setq rgn (funcall parser result)) - ;; If the parser found something, migrate it - (if (consp rgn) - (progn - (set-buffer obuf) - (if boundary - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (insert (format "--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s -Content-Type: application/pgp-signature -Content-Transfer-Encoding: 7bit - -" boundary)) - (insert-buffer-substring mybuf (car rgn) (cdr rgn)) - (goto-char (point-max)) - (insert (format "\n--%s--\n" boundary)) - ) - (delete-region beg end) - (goto-char beg) - (insert-buffer-substring mybuf (car rgn) (cdr rgn)) - ) - (set-buffer mybuf) - (delete-region (car rgn) (cdr rgn))))) - ;; Return nil on failure and exit code on success - (if rgn result)) - ;; Cleanup even on nonlocal exit - (if (and proc (eq 'run (process-status proc))) - (interrupt-process proc)) - (set-buffer obuf) - (or buffer (null mybuf) (kill-buffer mybuf))))) - -(defun mime-mc-pgp-sign-region (start end &optional id unclear boundary) - ;; (if (not (boundp 'mc-pgp-user-id)) - ;; (load "mc-pgp") - ;; ) - (let ((process-environment process-environment) - (buffer (get-buffer-create mc-buffer-name)) - passwd args key - (parser (function mc-pgp-generic-parser)) - (pgp-path mc-pgp-path) - ) - (setq key (mc-pgp-lookup-key (or id mc-pgp-user-id))) - (setq passwd - (mc-activate-passwd - (cdr key) - (format "PGP passphrase for %s (%s): " (car key) (cdr key)))) - (setenv "PGPPASSFD" "0") - (setq args - (cons - (if boundary - "-fbast" - "-fast") - (list "+verbose=1" "+language=en" - (format "+clearsig=%s" (if unclear "off" "on")) - "+batchmode" "-u" (cdr key)))) - (if mc-pgp-comment - (setq args (cons (format "+comment=%s" mc-pgp-comment) args)) - ) - (message "Signing as %s ..." (car key)) - (if (mime-mc-process-region - start end passwd pgp-path args parser buffer boundary) - (progn - (if boundary - (progn - (goto-char (point-min)) - (insert - (format "\ ---[[multipart/signed; protocol=\"application/pgp-signature\"; - boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary)) - )) - (message "Signing as %s ... Done." (car key)) - t) - nil))) - -(defun mime-mc-pgp-encrypt-region (recipients start end &optional id sign) - (let ((mc-pgp-always-sign (if (eq sign 'maybe) - mc-pgp-always-sign - 'never))) - (mc-pgp-encrypt-region - (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients) - start end id nil) - )) - - -;;; @ end -;;; - -(provide 'mime-mc) - -;;; mime-mc.el ends here diff --git a/mime-parse.el b/mime-parse.el deleted file mode 100644 index ebf5a63..0000000 --- a/mime-parse.el +++ /dev/null @@ -1,278 +0,0 @@ -;;; mime-parse.el --- MIME message parser - -;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Version: $Id: mime-parse.el,v 0.8 1997-03-15 20:11:46 morioka Exp $ -;; Keywords: parse, MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'emu) -(require 'std11) -(require 'mime-def) - -(defsubst symbol-concat (&rest args) - "Return a symbol whose name is concatenation of arguments ARGS -which are string or symbol." - (intern (apply (function concat) - (mapcar (function - (lambda (s) - (cond ((symbolp s) (symbol-name s)) - ((stringp s) s) - ))) - args)))) - -(defmacro define-structure (name &rest slots) - (let ((pred (symbol-concat name '-p))) - (cons 'progn - (nconc - (list - (` (defun (, pred) (obj) - (and (vectorp obj) - (eq (elt obj 0) '(, name)) - )) - ) - (` (defun (, (symbol-concat name '/create)) (, slots) - (, (cons 'vector (cons (list 'quote name) slots))) - ) - )) - (let ((i 1)) - (mapcar (function - (lambda (slot) - (prog1 - (` (defun (, (symbol-concat name '/ slot)) (obj) - (if ((, pred) obj) - (elt obj (, i)) - )) - ) - (setq i (+ i 1)) - ) - )) slots) - ) - (list (list 'quote name)) - )))) - - -;;; @ field parser -;;; - -(defsubst regexp-* (regexp) - (concat regexp "*")) - -(defconst rfc822/quoted-pair-regexp "\\\\.") -(defconst rfc822/qtext-regexp - (concat "[^" (char-list-to-string std11-non-qtext-char-list) "]")) -(defconst rfc822/quoted-string-regexp - (concat "\"" - (regexp-* - (regexp-or rfc822/qtext-regexp rfc822/quoted-pair-regexp) - ) - "\"")) - -(defconst mime/content-parameter-value-regexp - (concat "\\(" - rfc822/quoted-string-regexp - "\\|[^; \t\n]*\\)")) - -(defconst mime::parameter-regexp - (concat "^[ \t]*\;[ \t]*\\(" mime/token-regexp "\\)" - "[ \t]*=[ \t]*\\(" mime/content-parameter-value-regexp "\\)")) - -(defun mime-parse-parameter (str) - (if (string-match mime::parameter-regexp str) - (let ((e (match-end 2))) - (cons - (cons (downcase (substring str (match-beginning 1) (match-end 1))) - (std11-strip-quoted-string - (substring str (match-beginning 2) e)) - ) - (substring str e) - )))) - -(defconst mime::ctype-regexp (concat "^" mime/content-type-subtype-regexp)) - -(defun mime-parse-Content-Type (string) - "Parse STRING as field-body of Content-Type field. [mime-parse.el]" - (setq string (std11-unfold-string string)) - (if (string-match mime::ctype-regexp string) - (let* ((e (match-end 0)) - (ctype (downcase (substring string 0 e))) - ret dest) - (setq string (substring string e)) - (while (setq ret (mime-parse-parameter string)) - (setq dest (cons (car ret) dest) - string (cdr ret)) - ) - (cons ctype (nreverse dest)) - ))) - -(defconst mime::dtype-regexp (concat "^" mime/disposition-type-regexp)) - -(defun mime-parse-Content-Disposition (string) - "Parse STRING as field-body of Content-Disposition field. [mime-parse.el]" - (setq string (std11-unfold-string string)) - (if (string-match mime::dtype-regexp string) - (let* ((e (match-end 0)) - (ctype (downcase (substring string 0 e))) - ret dest) - (setq string (substring string e)) - (while (setq ret (mime-parse-parameter string)) - (setq dest (cons (car ret) dest) - string (cdr ret)) - ) - (cons ctype (nreverse dest)) - ))) - - -;;; @ field reader -;;; - -(defun mime/Content-Type () - "Read field-body of Content-Type field from current-buffer, -and return parsed it. [mime-parse.el]" - (let ((str (std11-field-body "Content-Type"))) - (if str - (mime-parse-Content-Type str) - ))) - -(defun mime/Content-Transfer-Encoding (&optional default-encoding) - "Read field-body of Content-Transfer-Encoding field from -current-buffer, and return it. -If is is not found, return DEFAULT-ENCODING. [mime-parse.el]" - (let ((str (std11-field-body "Content-Transfer-Encoding"))) - (if str - (progn - (if (string-match "[ \t\n\r]+$" str) - (setq str (substring str 0 (match-beginning 0))) - ) - (downcase str) - ) - default-encoding) - )) - -(defun mime/Content-Disposition () - "Read field-body of Content-Disposition field from current-buffer, -and return parsed it. [mime-parse.el]" - (let ((str (std11-field-body "Content-Disposition"))) - (if str - (mime-parse-Content-Disposition str) - ))) - - -;;; @ message parser -;;; - -(define-structure mime::content-info - rcnum point-min point-max type parameters encoding children) - - -(defun mime-parse-multipart (boundary ctype params encoding rcnum) - (goto-char (point-min)) - (let* ((dash-boundary (concat "--" boundary)) - (delimiter (concat "\n" (regexp-quote dash-boundary))) - (close-delimiter (concat delimiter "--[ \t]*$")) - (beg (point-min)) - (end (progn - (goto-char (point-max)) - (if (re-search-backward close-delimiter nil t) - (match-beginning 0) - (point-max) - ))) - (rsep (concat delimiter "[ \t]*\n")) - (dc-ctl - (if (string-equal ctype "multipart/digest") - '("message/rfc822") - '("text/plain") - )) - cb ce ret ncb children (i 0)) - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (re-search-forward rsep nil t) - (setq cb (match-end 0)) - (while (re-search-forward rsep nil t) - (setq ce (match-beginning 0)) - (setq ncb (match-end 0)) - (save-restriction - (narrow-to-region cb ce) - (setq ret (mime-parse-message dc-ctl "7bit" (cons i rcnum))) - ) - (setq children (cons ret children)) - (goto-char (mime::content-info/point-max ret)) - (goto-char (setq cb ncb)) - (setq i (1+ i)) - ) - (setq ce (point-max)) - (save-restriction - (narrow-to-region cb ce) - (setq ret (mime-parse-message dc-ctl "7bit" (cons i rcnum))) - ) - (setq children (cons ret children)) - ) - (mime::content-info/create rcnum beg (point-max) - ctype params encoding - (nreverse children)) - )) - -(defun mime-parse-message (&optional ctl encoding rcnum) - "Parse current-buffer as a MIME message. [mime-parse.el]" - (setq ctl (or (mime/Content-Type) ctl)) - (setq encoding (or (mime/Content-Transfer-Encoding) encoding)) - (let ((ctype (car ctl)) - (params (cdr ctl)) - ) - (let ((boundary (assoc "boundary" params))) - (cond (boundary - (setq boundary (std11-strip-quoted-string (cdr boundary))) - (mime-parse-multipart boundary ctype params encoding rcnum) - ) - ((or (string-equal ctype "message/rfc822") - (string-equal ctype "message/news") - ) - (goto-char (point-min)) - (mime::content-info/create rcnum - (point-min) (point-max) - ctype params encoding - (save-restriction - (narrow-to-region - (if (re-search-forward "^$" nil t) - (1+ (match-end 0)) - (point-min) - ) - (point-max)) - (list (mime-parse-message - nil nil (cons 0 rcnum))) - ) - ) - ) - (t - (mime::content-info/create rcnum (point-min) (point-max) - ctype params encoding nil) - )) - ))) - - -;;; @ end -;;; - -(provide 'mime-parse) - -;;; mime-parse.el ends here diff --git a/mime-partial.el b/mime-partial.el deleted file mode 100644 index 8fd9fe9..0000000 --- a/mime-partial.el +++ /dev/null @@ -1,111 +0,0 @@ -;;; mime-partial.el --- Grabbing all MIME "message/partial"s. - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: OKABE Yasuo @ Kyoto University -;; MORIOKA Tomohiko -;; Version: $Id: mime-partial.el,v 0.9 1997-06-19 03:27:21 morioka Exp $ -;; Keywords: message/partial, MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'mime-view) -(require 'mime-play) - -(defvar mime-view-partial-message-method-alist nil - "Alist major-mode vs. function to view partial message for mime-partial.") - -;; display Article at the cursor in Subject buffer. -(defsubst mime-view-partial-message (target) - (save-window-excursion - (let ((f (assq target mime-view-partial-message-method-alist))) - (if f - (funcall (cdr f)) - (error "Fatal. Unsupported mode") - )))) - -(defun mime-combine-message/partials-automatically (beg end cal) - "Internal method for mime-view to combine message/partial messages -automatically. This function refers variable -`mime-view-partial-message-method-alist' to select function to display -partial messages using mime-view." - (interactive) - (let* ((id (cdr (assoc "id" cal))) - (target (cdr (assq 'major-mode cal))) - (article-buffer (buffer-name (current-buffer))) - (subject-buf (eval (cdr (assq 'summary-buffer-exp cal)))) - subject-id - (root-dir (expand-file-name - (concat "m-prts-" (user-login-name)) mime-temp-directory)) - full-file) - (setq root-dir (concat root-dir "/" (replace-as-filename id))) - (setq full-file (concat root-dir "/FULL")) - - (if (null target) - (error "%s is not supported. Sorry." target) - ) - - ;; if you can't parse the subject line, try simple decoding method - (if (or (file-exists-p full-file) - (not (y-or-n-p "Merge partials?")) - ) - (mime-display-message/partial beg end cal) - (let (the-id parameters) - (setq subject-id (std11-field-body "Subject")) - (if (string-match "[0-9\n]+" subject-id) - (setq subject-id (substring subject-id 0 (match-beginning 0))) - ) - (save-excursion - (set-buffer subject-buf) - (while (search-backward subject-id nil t)) - (catch 'tag - (while t - (mime-view-partial-message target) - (set-buffer article-buffer) - (setq parameters (mime::content-info/parameters - mime::article/content-info)) - (setq the-id (cdr (assoc "id" parameters))) - (if (string= the-id id) - (progn - (mime-display-message/partial - (point-min)(point-max) parameters) - (if (file-exists-p full-file) - (throw 'tag nil) - ) - )) - (if (not (progn - (set-buffer subject-buf) - (end-of-line) - (search-forward subject-id nil t) - )) - (error "not found") - ) - ) - )))))) - - -;;; @ end -;;; - -(provide 'mime-partial) - -(run-hooks 'mime-partial-load-hook) - -;;; mime-partial.el ends here diff --git a/mime-pgp.el b/mime-pgp.el deleted file mode 100644 index 7b262a7..0000000 --- a/mime-pgp.el +++ /dev/null @@ -1,310 +0,0 @@ -;;; mime-pgp.el --- mime-view internal methods for PGP. - -;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko - -;; Author: MORIOKA Tomohiko -;; Created: 1995/12/7 -;; Renamed: 1997/2/27 from tm-pgp.el -;; Version: $Id: mime-pgp.el,v 0.19 1997-05-12 12:29:13 morioka Exp $ -;; Keywords: PGP, security, MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This module is based on 2 drafts about PGP MIME integration: - -;; - RFC 2015: "MIME Security with Pretty Good Privacy (PGP)" -;; by Michael Elkins (1996/6) -;; -;; - draft-kazu-pgp-mime-00.txt: "PGP MIME Integration" -;; by Kazuhiko Yamamoto -;; (1995/10; expired) -;; -;; These drafts may be contrary to each other. You should decide -;; which you support. (Maybe you should use PGP/MIME) - -;;; Code: - -(require 'mime-play) - - -;;; @ internal method for application/pgp -;;; -;;; It is based on draft-kazu-pgp-mime-00.txt - -(defun mime-article/view-application/pgp (beg end cal) - (let* ((cnum (mime-article/point-content-number beg)) - (p-win (or (get-buffer-window mime-view-buffer) - (get-largest-window))) - (new-name (format "%s-%s" (buffer-name) cnum)) - (the-buf (current-buffer)) - (mother mime-view-buffer) - (mode major-mode) - text-decoder) - (set-buffer (get-buffer-create new-name)) - (erase-buffer) - (insert-buffer-substring the-buf beg end) - (cond ((progn - (goto-char (point-min)) - (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t) - ) - (funcall (pgp-function 'verify)) - (goto-char (point-min)) - (delete-region - (point-min) - (and - (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n") - (match-end 0)) - ) - (delete-region - (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+") - (match-beginning 0)) - (point-max) - ) - (goto-char (point-min)) - (while (re-search-forward "^- -" nil t) - (replace-match "-") - ) - (setq text-decoder - (cdr (or (assq mode mime-text-decoder-alist) - (assq t mime-text-decoder-alist)))) - ) - ((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 text-decoder (function mime-text-decode-buffer)) - )) - (setq major-mode 'mime-show-message-mode) - (setq mime-text-decoder text-decoder) - (save-window-excursion (mime-view-mode mother)) - (set-window-buffer p-win mime-view-buffer) - )) - -(set-atype 'mime-acting-condition - '((type . "application/pgp") - (method . mime-article/view-application/pgp) - )) - -(set-atype 'mime-acting-condition - '((type . "text/x-pgp") - (method . mime-article/view-application/pgp) - )) - - -;;; @ Internal method for application/pgp-signature -;;; -;;; It is based on RFC 2015. - -(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::article/call-pgp-to-check-signature (output-buffer 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 - 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"))) - )))) - -(defun mime-article/check-pgp-signature (beg end cal) - "Internal method to check PGP/MIME signature." - (let* ((encoding (cdr (assq 'encoding cal))) - (cnum (mime-article/point-content-number beg)) - (rcnum (reverse cnum)) - (rmcnum (cdr rcnum)) - (knum (car rcnum)) - (onum (if (> knum 0) - (1- knum) - (1+ knum))) - (raw-buf (current-buffer)) - (oinfo (mime-article/rcnum-to-cinfo (cons onum rmcnum) - mime::article/content-info)) - kbuf - (basename (expand-file-name "tm" mime-temp-directory)) - (orig-file (make-temp-name basename)) - (sig-file (concat orig-file ".sig")) - ) - (save-excursion - (let ((p-min (mime::content-info/point-min oinfo)) - (p-max (mime::content-info/point-max oinfo)) - ) - (set-buffer (get-buffer-create mime/temp-buffer-name)) - (insert-buffer-substring raw-buf p-min p-max) - ) - (goto-char (point-min)) - (while (re-search-forward "\n" nil t) - (replace-match "\r\n") - ) - (as-binary-output-file (write-file orig-file)) - (kill-buffer (current-buffer)) - ) - (save-excursion (mime-show-echo-buffer)) - (save-excursion - (let ((p-min (save-excursion - (goto-char beg) - (and (search-forward "\n\n") - (match-end 0)) - ))) - (set-buffer (setq kbuf (get-buffer-create mime/temp-buffer-name))) - (insert-buffer-substring raw-buf p-min end) - ) - (mime-decode-region (point-min)(point-max) encoding) - (as-binary-output-file (write-file sig-file)) - (or (mime::article/call-pgp-to-check-signature - mime-echo-buffer-name orig-file) - (let (pgp-id) - (save-excursion - (set-buffer mime-echo-buffer-name) - (goto-char (point-min)) - (let ((regexp (cdr (assq (or mime-pgp-default-language 'en) - mime-pgp-key-expected-regexp-alist)))) - (cond ((not (stringp regexp)) - (message - "Please specify right regexp for specified language") - ) - ((re-search-forward regexp nil t) - (setq pgp-id - (concat "0x" (buffer-substring-no-properties - (match-beginning 1) - (match-end 1)))) - )))) - (if (and pgp-id - (y-or-n-p - (format "Key %s not found; attempt to fetch? " pgp-id)) - ) - (progn - (funcall (pgp-function 'fetch-key) (cons nil pgp-id)) - (mime::article/call-pgp-to-check-signature - mime-echo-buffer-name orig-file) - )) - )) - (let ((other-window-scroll-buffer mime-echo-buffer-name)) - (scroll-other-window 8) - ) - (kill-buffer kbuf) - (delete-file orig-file) - (delete-file sig-file) - ))) - -(set-atype 'mime-acting-condition - '((type . "application/pgp-signature") - (method . mime-article/check-pgp-signature) - )) - - -;;; @ Internal method for application/pgp-encrypted -;;; -;;; It is based on RFC 2015. - -(defun mime-article/decrypt-pgp (beg end cal) - (let* ((cnum (mime-article/point-content-number beg)) - (rcnum (reverse cnum)) - (rmcnum (cdr rcnum)) - (knum (car rcnum)) - (onum (if (> knum 0) - (1- knum) - (1+ knum))) - (oinfo (mime-article/rcnum-to-cinfo (cons onum rmcnum) - mime::article/content-info)) - (obeg (mime::content-info/point-min oinfo)) - (oend (mime::content-info/point-max oinfo)) - ) - (mime-article/view-application/pgp obeg oend cal) - )) - -(set-atype 'mime-acting-condition - '((type . "application/pgp-encrypted") - (method . mime-article/decrypt-pgp) - )) - - -;;; @ Internal method for application/pgp-keys -;;; -;;; It is based on RFC 2015. - -(defun mime-article/add-pgp-keys (beg end cal) - (let* ((cnum (mime-article/point-content-number beg)) - (new-name (format "%s-%s" (buffer-name) cnum)) - (encoding (cdr (assq 'encoding cal))) - str) - (setq str (buffer-substring beg 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)) - )) - -(set-atype 'mime-acting-condition - '((type . "application/pgp-keys") - (method . mime-article/add-pgp-keys) - )) - - -;;; @ end -;;; - -(provide 'mime-pgp) - -(run-hooks 'mime-pgp-load-hook) - -;;; mime-pgp.el ends here diff --git a/mime-play.el b/mime-play.el deleted file mode 100644 index 0191d1a..0000000 --- a/mime-play.el +++ /dev/null @@ -1,495 +0,0 @@ -;;; mime-play.el --- decoder for mime-view.el - -;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Created: 1995/9/26 (separated from tm-view.el) -;; Renamed: 1997/2/21 from tm-play.el -;; Version: $Id: mime-play.el,v 0.45 1997-06-19 03:27:22 morioka Exp $ -;; Keywords: MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'mime-view) -(require 'alist) -(require 'filename) - - -;;; @ content decoder -;;; - -(defvar mime-preview/after-decoded-position nil) - -(defun mime-view-play-current-entity (&optional mode) - "Play current entity. -It decodes current 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\"." - (interactive) - (or mode - (setq mode "play") - ) - (let ((cinfo (get-text-property (point) 'mime-view-cinfo))) - (if cinfo - (let ((the-buf (current-buffer)) - (raw-buffer (get-text-property (point) 'mime-view-raw-buffer)) - ) - (setq mime-preview/after-decoded-position (point)) - (set-buffer raw-buffer) - (mime-display-content cinfo mode) - (if (eq (current-buffer) raw-buffer) - (progn - (set-buffer the-buf) - (goto-char mime-preview/after-decoded-position) - )) - )))) - -(defun mime-display-content (cinfo &optional mode) - (let ((beg (mime::content-info/point-min cinfo)) - (end (mime::content-info/point-max cinfo)) - (ctype (or (mime::content-info/type cinfo) "text/plain")) - (params (mime::content-info/parameters cinfo)) - (encoding (mime::content-info/encoding cinfo)) - ) - ;; Check for VM - (if (< beg (point-min)) - (setq beg (point-min)) - ) - (if (< (point-max) end) - (setq end (point-max)) - ) - (let (method cal ret) - (setq cal (list* (cons 'type ctype) - (cons 'encoding encoding) - (cons 'major-mode major-mode) - params)) - (if mode - (setq cal (cons (cons 'mode mode) cal)) - ) - (setq ret (mime/get-content-decoding-alist cal)) - (setq method (cdr (assq 'method ret))) - (cond ((and (symbolp method) - (fboundp method)) - (funcall method beg end ret) - ) - ((and (listp method)(stringp (car method))) - (mime-article/start-external-method-region beg end ret) - ) - (t - (mime-show-echo-buffer - "No method are specified for %s\n" ctype) - )) - ) - )) - - -;;; @ method selector -;;; - -(defun mime/get-content-decoding-alist (al) - (get-unified-alist mime-acting-condition al) - ) - - -;;; @ external decoder -;;; - -(defun mime-article/start-external-method-region (beg end cal) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char beg) - (let ((method (cdr (assoc 'method cal))) - (name (mime-article/get-filename cal)) - ) - (if method - (let ((file (make-temp-name - (expand-file-name "TM" mime-temp-directory))) - b args) - (if (nth 1 method) - (setq b beg) - (setq b - (if (re-search-forward "^$" nil t) - (1+ (match-end 0)) - (point-min) - )) - ) - (goto-char b) - (write-region b end file) - (message "External method is starting...") - (setq cal (put-alist - 'name (replace-as-filename name) cal)) - (setq cal (put-alist 'file file cal)) - (setq args (nconc - (list (car method) - mime-echo-buffer-name (car method) - ) - (mime-article/make-method-args cal - (cdr (cdr method))) - )) - (apply (function start-process) args) - (mime-show-echo-buffer) - )) - )))) - -(defun mime-article/make-method-args (cal format) - (mapcar (function - (lambda (arg) - (if (stringp arg) - arg - (let* ((item (eval arg)) - (ret (cdr (assoc item cal))) - ) - (if ret - ret - (if (eq item 'encoding) - "7bit" - "")) - )) - )) - format)) - -(defvar mime-echo-window-is-shared-with-bbdb t - "*If non-nil, mime-echo window is shared with BBDB window.") - -(defvar mime-echo-window-height - (function - (lambda () - (/ (window-height) 5) - )) - "*Size of mime-echo window. -It allows function or integer. If it is function, -`mime-show-echo-buffer' calls it to get height of mime-echo window. -Otherwise `mime-show-echo-buffer' uses it as height of mime-echo -window.") - -(defun mime-show-echo-buffer (&rest forms) - "Show mime-echo buffer to display MIME-playing information." - (get-buffer-create mime-echo-buffer-name) - (let ((the-win (selected-window)) - (win (get-buffer-window mime-echo-buffer-name)) - ) - (or win - (if (and mime-echo-window-is-shared-with-bbdb - (boundp 'bbdb-buffer-name) - (setq win (get-buffer-window bbdb-buffer-name)) - ) - (set-window-buffer win mime-echo-buffer-name) - (select-window (get-buffer-window mime-view-buffer)) - (setq win (split-window-vertically - (- (window-height) - (if (functionp mime-echo-window-height) - (funcall mime-echo-window-height) - mime-echo-window-height) - ))) - (set-window-buffer win mime-echo-buffer-name) - )) - (select-window win) - (goto-char (point-max)) - (if forms - (insert (apply (function format) forms)) - ) - (select-window the-win) - )) - - -;;; @ file name -;;; - -(defvar mime-view-file-name-char-regexp "[A-Za-z0-9+_-]") - -(defvar mime-view-file-name-regexp-1 - (concat mime-view-file-name-char-regexp "+\\." - mime-view-file-name-char-regexp "+")) - -(defvar mime-view-file-name-regexp-2 - (concat (regexp-* mime-view-file-name-char-regexp) - "\\(\\." mime-view-file-name-char-regexp "+\\)*")) - -(defun mime-article/get-original-filename (param &optional encoding) - (or (mime-article/get-uu-filename param encoding) - (let (ret) - (or (if (or (and (setq ret (mime/Content-Disposition)) - (setq ret (assoc "filename" (cdr ret))) - ) - (setq ret (assoc "name" param)) - (setq ret (assoc "x-name" param)) - ) - (std11-strip-quoted-string (cdr ret)) - ) - (if (setq ret - (std11-find-field-body '("Content-Description" - "Subject"))) - (if (or (string-match mime-view-file-name-regexp-1 ret) - (string-match mime-view-file-name-regexp-2 ret)) - (substring ret (match-beginning 0)(match-end 0)) - )) - )) - )) - -(defun mime-article/get-filename (param) - (replace-as-filename (mime-article/get-original-filename param)) - ) - - -;;; @ mail/news message -;;; - -(defun mime-view-quitting-method-for-mime-show-message-mode () - "Quitting method for mime-view. -It is registered to variable `mime-view-quitting-method-alist'." - (let ((mother mime-mother-buffer) - (win-conf mime::preview/original-window-configuration) - ) - (kill-buffer mime-raw-buffer) - (mime-view-kill-buffer) - (set-window-configuration win-conf) - (pop-to-buffer mother) - )) - -(defun mime-article/view-message/rfc822 (beg end cal) - (let* ((cnum (mime-article/point-content-number beg)) - (new-name (format "%s-%s" (buffer-name) cnum)) - (mother mime-view-buffer) - (text-decoder - (cdr (or (assq major-mode mime-text-decoder-alist) - (assq t mime-text-decoder-alist)))) - str) - (setq str (buffer-substring beg end)) - (switch-to-buffer new-name) - (erase-buffer) - (insert str) - (goto-char (point-min)) - (if (re-search-forward "^\n" nil t) - (delete-region (point-min) (match-end 0)) - ) - (setq major-mode 'mime-show-message-mode) - (setq mime-text-decoder text-decoder) - (mime-view-mode mother) - )) - - -;;; @ message/partial -;;; - -(defvar mime-article/coding-system-alist - (list '(mh-show-mode . no-conversion) - (cons t (mime-charset-to-coding-system default-mime-charset)) - )) - -(defun mime-article::write-region (start end file) - (let ((coding-system-for-write - (cdr - (or (assq major-mode mime-article/coding-system-alist) - (assq t mime-article/coding-system-alist) - )))) - (write-region start end file) - )) - -(defun mime-display-message/partial (beg end cal) - (goto-char beg) - (let* ((root-dir - (expand-file-name - (concat "m-prts-" (user-login-name)) mime-temp-directory)) - (id (cdr (assoc "id" cal))) - (number (cdr (assoc "number" cal))) - (total (cdr (assoc "total" cal))) - file - (mother mime-view-buffer) - ) - (or (file-exists-p root-dir) - (make-directory root-dir) - ) - (setq id (replace-as-filename id)) - (setq root-dir (concat root-dir "/" id)) - (or (file-exists-p root-dir) - (make-directory root-dir) - ) - (setq file (concat root-dir "/FULL")) - (if (file-exists-p file) - (let ((full-buf (get-buffer-create "FULL")) - (pwin (or (get-buffer-window mother) - (get-largest-window))) - ) - (save-window-excursion - (set-buffer full-buf) - (erase-buffer) - (as-binary-input-file (insert-file-contents file)) - (setq major-mode 'mime-show-message-mode) - (mime-view-mode mother) - ) - (set-window-buffer pwin - (save-excursion - (set-buffer full-buf) - mime-view-buffer)) - (select-window pwin) - ) - (re-search-forward "^$") - (goto-char (1+ (match-end 0))) - (setq file (concat root-dir "/" number)) - (mime-article::write-region (point) (point-max) file) - (let ((total-file (concat root-dir "/CT"))) - (setq total - (if total - (progn - (or (file-exists-p total-file) - (save-excursion - (set-buffer - (get-buffer-create mime/temp-buffer-name)) - (erase-buffer) - (insert total) - (write-file total-file) - (kill-buffer (current-buffer)) - )) - (string-to-number total) - ) - (and (file-exists-p total-file) - (save-excursion - (set-buffer (find-file-noselect total-file)) - (prog1 - (and (re-search-forward "[0-9]+" nil t) - (string-to-number - (buffer-substring (match-beginning 0) - (match-end 0))) - ) - (kill-buffer (current-buffer)) - ))) - ))) - (if (and total (> total 0)) - (catch 'tag - (save-excursion - (set-buffer (get-buffer-create mime/temp-buffer-name)) - (let ((full-buf (current-buffer))) - (erase-buffer) - (let ((i 1)) - (while (<= i total) - (setq file (concat root-dir "/" (int-to-string i))) - (or (file-exists-p file) - (throw 'tag nil) - ) - (as-binary-input-file (insert-file-contents file)) - (goto-char (point-max)) - (setq i (1+ i)) - )) - (as-binary-output-file (write-file (concat root-dir "/FULL"))) - (let ((i 1)) - (while (<= i total) - (let ((file (format "%s/%d" root-dir i))) - (and (file-exists-p file) - (delete-file file) - )) - (setq i (1+ i)) - )) - (let ((file (expand-file-name "CT" root-dir))) - (and (file-exists-p file) - (delete-file file) - )) - (save-window-excursion - (setq major-mode 'mime-show-message-mode) - (mime-view-mode mother) - ) - (let ((pwin (or (get-buffer-window mother) - (get-largest-window) - )) - (pbuf (save-excursion - (set-buffer full-buf) - mime-view-buffer))) - (set-window-buffer pwin pbuf) - (select-window pwin) - ))))) - ))) - - -;;; @ message/external-body -;;; - -(defvar mime-article/dired-function - (if mime/use-multi-frame - (function dired-other-frame) - (function mime-article/dired-function-for-one-frame) - )) - -(defun mime-article/dired-function-for-one-frame (dir) - (let ((win (or (get-buffer-window mime-view-buffer) - (get-largest-window)))) - (select-window win) - (dired dir) - )) - -(defun mime-display-message/external-ftp (beg end cal) - (let* ((site (cdr (assoc "site" cal))) - (directory (cdr (assoc "directory" cal))) - (name (cdr (assoc "name" cal))) - ;;(mode (cdr (assoc "mode" cal))) - (pathname (concat "/anonymous@" site ":" directory)) - ) - (message (concat "Accessing " (expand-file-name name pathname) "...")) - (funcall mime-article/dired-function pathname) - (goto-char (point-min)) - (search-forward name) - )) - - -;;; @ rot13-47 -;;; - -(defun mime-display-caesar (start end cal) - "Internal method for mime-view to display ROT13-47-48 message." - (let* ((cnum (mime-article/point-content-number start)) - (new-name (format "%s-%s" (buffer-name) cnum)) - (the-buf (current-buffer)) - (mother mime-view-buffer) - (charset (cdr (assoc "charset" cal))) - (encoding (cdr (assq 'encoding cal))) - (mode major-mode) - ) - (let ((pwin (or (get-buffer-window mother) - (get-largest-window))) - (buf (get-buffer-create new-name)) - ) - (set-window-buffer pwin buf) - (set-buffer buf) - (select-window pwin) - ) - (setq buffer-read-only nil) - (erase-buffer) - (insert-buffer-substring the-buf start end) - (goto-char (point-min)) - (if (re-search-forward "^\n" nil t) - (delete-region (point-min) (match-end 0)) - ) - (let ((m (cdr (or (assq mode mime-text-decoder-alist) - (assq t mime-text-decoder-alist))))) - (and (functionp m) - (funcall m charset encoding) - )) - (mule-caesar-region (point-min) (point-max)) - (set-buffer-modified-p nil) - (set-buffer mother) - (view-buffer new-name) - )) - - -;;; @ end -;;; - -(provide 'mime-play) - -;;; mime-play.el ends here diff --git a/mime-setup.el b/mime-setup.el deleted file mode 100644 index e533375..0000000 --- a/mime-setup.el +++ /dev/null @@ -1,49 +0,0 @@ -;;; mime-setup.el --- setup file for MIME viewer and composer. - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Version: -;; $Id: mime-setup.el,v 0.11 1997-03-14 08:46:50 morioka Exp $ -;; Keywords: MIME, multimedia, multilingual, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(load "mail-mime-setup") - -(condition-case err - (load "gnus-mime-setup") - (error (message "gnus-mime-setup is not found.")) - ) - -(condition-case err - (load "emh-setup") - (error (message "emh-setup is not found.")) - ) - - -;;; @ end -;;; - -(provide 'mime-setup) - -(run-hooks 'mime-setup-load-hook) - -;;; mime-setup.el ends here diff --git a/mime-tar.el b/mime-tar.el deleted file mode 100644 index 129820c..0000000 --- a/mime-tar.el +++ /dev/null @@ -1,359 +0,0 @@ -;;; mime-tar.el --- mime-view internal method for tar or tar+gzip format - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: Hiroshi Ueno -;; modified by MORIOKA Tomohiko -;; Renamed: 1997/2/26 from tm-tar.el -;; Version: $Id: mime-tar.el,v 0.7 1997-05-12 12:30:42 morioka Exp $ -;; Keywords: tar, tar+gzip, MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Internal viewer for -;; - application/x-tar -;; - application/x-gzip, type="tar" -;; - aplication/octet-stream, type="tar" -;; - aplication/octet-stream, type="tar+gzip" - -;;; Code: - -(require 'mime-view) - - -;;; @ constants -;;; - -(defconst mime-tar-list-buffer "*mime-tar-List*") -(defconst mime-tar-view-buffer "*mime-tar-View*") -(defconst mime-tar-file-search-regexp "[0-9]+\:[0-9\:]+[ ]+[0-9]+[ ]+") -(defconst mime-tar-popup-menu-title "Action Menu") - - -;;; @ variables -;;; - -(defvar mime-tar-program "gtar") -(defvar mime-tar-decompress-arg '("-z")) -(defvar mime-tar-gzip-program "gzip") -(defvar mime-tar-mmencode-program "mmencode") -(defvar mime-tar-uudecode-program "uudecode") - -(defvar mime-tar-popup-menu-items - '(("View File" . mime-tar-view-file) - ("Key Help" . mime-tar-helpful-message) - ("Quit mime-tar Mode" . exit-recursive-edit) - )) - -(cond ((string-match "XEmacs\\|Lucid" emacs-version) - (defvar mime-tar-popup-menu - (cons mime-tar-popup-menu-title - (mapcar (function - (lambda (item) - (vector (car item)(cdr item) t) - )) - mime-tar-popup-menu-items))) - - (defun mime-tar-mouse-button-2 (event) - (popup-menu mime-tar-popup-menu) - ) - ) - ((>= emacs-major-version 19) - (defun mime-tar-mouse-button-2 (event) - (let ((menu - (cons mime-tar-popup-menu-title - (list (cons "Menu Items" mime-tar-popup-menu-items)) - ))) - (let ((func (x-popup-menu event menu))) - (if func - (funcall func) - )) - )) - )) - -(defvar mime-tar-mode-map nil) -(if mime-tar-mode-map - nil - (setq mime-tar-mode-map (make-keymap)) - (suppress-keymap mime-tar-mode-map) - (define-key mime-tar-mode-map "\C-c" 'exit-recursive-edit) - (define-key mime-tar-mode-map "q" 'exit-recursive-edit) - (define-key mime-tar-mode-map "n" 'mime-tar-next-line) - (define-key mime-tar-mode-map " " 'mime-tar-next-line) - (define-key mime-tar-mode-map "\C-m" 'mime-tar-next-line) - (define-key mime-tar-mode-map "p" 'mime-tar-previous-line) - (define-key mime-tar-mode-map "\177" 'mime-tar-previous-line) - (define-key mime-tar-mode-map "\C-\M-m" 'mime-tar-previous-line) - (define-key mime-tar-mode-map "v" 'mime-tar-view-file) - (define-key mime-tar-mode-map "\C-h" 'Helper-help) - (define-key mime-tar-mode-map "?" 'mime-tar-helpful-message) - (if mouse-button-2 - (define-key mime-tar-mode-map - mouse-button-2 'mime-button-dispatcher)) - ) - - -;;; @@ mime-tar mode functions -;;; - -(defun mime-tar-mode (&optional prev-buf) - "Major mode for listing the contents of a tar archive file." - (unwind-protect - (let ((buffer-read-only t) - (mode-name "mime-tar") - (mode-line-buffer-identification '("%17b")) - ) - (goto-char (point-min)) - (mime-tar-move-to-filename) - (catch 'mime-tar-mode (mime-tar-command-loop)) - ) - (if prev-buf - (switch-to-buffer prev-buf) - ) - )) - -(defun mime-tar-command-loop () - (let ((old-local-map (current-local-map))) - (unwind-protect - (progn - (use-local-map mime-tar-mode-map) - (mime-tar-helpful-message) - (recursive-edit) - ) - (save-excursion - (use-local-map old-local-map) - )) - )) - -(defun mime-tar-next-line () - (interactive) - (next-line 1) - (mime-tar-move-to-filename) - ) - -(defun mime-tar-previous-line () - (interactive) - (previous-line 1) - (mime-tar-move-to-filename) - ) - -(defun mime-tar-view-file () - (interactive) - (let ((name (mime-tar-get-filename)) - ) - (save-excursion - (switch-to-buffer mime-tar-view-buffer) - (setq buffer-read-only nil) - (erase-buffer) - (message "Reading a file from an archive. Please wait...") - (apply 'call-process mime-tar-program - nil t nil (append mime-tar-view-args (list name))) - (goto-char (point-min)) - ) - (view-buffer mime-tar-view-buffer) - )) - -(defun mime-tar-get-filename () - (let (eol) - (save-excursion - (end-of-line) - (setq eol (point)) - (beginning-of-line) - (save-excursion - (if (re-search-forward "^d" eol t) - (error "Cannot view a directory")) - ) - (if (re-search-forward mime-tar-file-search-regexp eol t) - (let ((beg (point))) - (skip-chars-forward "^ \n") - (buffer-substring beg (point)) - ) - (error "No file on this line") - )) - )) - -(defun mime-tar-move-to-filename () - (let ((eol (progn (end-of-line) (point)))) - (beginning-of-line) - (re-search-forward mime-tar-file-search-regexp eol t) - )) - -(defun mime-tar-set-properties () - (if mouse-button-2 - (let ((beg (point-min)) - (end (point-max)) - ) - (goto-char beg) - (save-excursion - (while (re-search-forward mime-tar-file-search-regexp end t) - (mime-add-button (point) - (progn - (end-of-line) - (point)) - 'mime-tar-view-file) - )) - ))) - -(defun mime-tar-helpful-message () - (interactive) - (message "Type %s, %s, %s, %s, %s, %s." - (substitute-command-keys "\\[Helper-help] for help") - (substitute-command-keys "\\[mime-tar-helpful-message] for keys") - (substitute-command-keys "\\[mime-tar-next-line] to next") - (substitute-command-keys "\\[mime-tar-previous-line] to prev") - (substitute-command-keys "\\[mime-tar-view-file] to view") - (substitute-command-keys "\\[exit-recursive-edit] to quit") - )) - -(defun mime-tar-y-or-n-p (prompt) - (prog1 - (y-or-n-p prompt) - (message "") - )) - -;;; @@ tar message decoder -;; - -(defun mime-decode-message/tar (beg end cal) - (if (mime-tar-y-or-n-p "Do you want to enter mime-tar mode? ") - (let ((coding (cdr (assoc 'encoding cal))) - (cur-buf (current-buffer)) - (mime-tar-file-name - (expand-file-name - (concat (make-temp-name - (expand-file-name "tm" mime-temp-directory)) ".tar"))) - (mime-tar-tmp-file-name - (expand-file-name - (make-temp-name (expand-file-name "tm" mime-temp-directory)))) - new-buf) - (find-file mime-tar-tmp-file-name) - (setq new-buf (current-buffer)) - (setq buffer-read-only nil) - (erase-buffer) - (save-excursion - (set-buffer cur-buf) - (goto-char beg) - (re-search-forward "^$") - (append-to-buffer new-buf (+ (match-end 0) 1) end) - ) - (if (member coding mime-view-uuencode-encoding-name-list) - (progn - (goto-char (point-min)) - (if (re-search-forward "^begin [0-9]+ " nil t) - (progn - (kill-line) - (insert mime-tar-file-name) - ) - (progn - (set-buffer-modified-p nil) - (kill-buffer new-buf) - (error "uuencode file signature was not found") - )))) - (save-buffer) - (kill-buffer new-buf) - (message "Listing the contents of an archive. Please wait...") - (cond ((string-equal coding "base64") - (call-process mime-tar-mmencode-program nil nil nil "-u" - "-o" mime-tar-file-name mime-tar-tmp-file-name) - ) - ((string-equal coding "quoted-printable") - (call-process mime-tar-mmencode-program nil nil nil "-u" "-q" - "-o" mime-tar-file-name mime-tar-tmp-file-name) - ) - ((member coding mime-view-uuencode-encoding-name-list) - (call-process mime-tar-uudecode-program nil nil nil - mime-tar-tmp-file-name) - ) - (t - (copy-file mime-tar-tmp-file-name mime-tar-file-name t) - )) - (delete-file mime-tar-tmp-file-name) - (setq mime-tar-list-args (list "-tvf" mime-tar-file-name)) - (setq mime-tar-view-args (list "-xOf" mime-tar-file-name)) - (if (eq 0 (call-process mime-tar-gzip-program - nil nil nil "-t" mime-tar-file-name)) - (progn - (setq mime-tar-list-args - (append mime-tar-decompress-arg mime-tar-list-args)) - (setq mime-tar-view-args - (append mime-tar-decompress-arg mime-tar-view-args)) - )) - (switch-to-buffer mime-tar-view-buffer) - (switch-to-buffer mime-tar-list-buffer) - (setq buffer-read-only nil) - (erase-buffer) - (apply 'call-process mime-tar-program - nil t nil mime-tar-list-args) - (if mouse-button-2 - (progn - (make-local-variable 'mime-button-mother-dispatcher) - (setq mime-button-mother-dispatcher 'mime-tar-mouse-button-2) - )) - (mime-tar-set-properties) - (mime-tar-mode mime-view-buffer) - (kill-buffer mime-tar-view-buffer) - (kill-buffer mime-tar-list-buffer) - (delete-file mime-tar-file-name) - ) - )) - -;;; @@ program/buffer coding system -;;; - -(cond ((boundp 'MULE) - (define-program-coding-system mime-tar-view-buffer nil '*autoconv*) - ) - ((boundp 'NEMACS) - (define-program-kanji-code mime-tar-view-buffer nil 1) - )) - -;;; @@ message types to use mime-tar -;;; - -(set-atype 'mime-acting-condition - '((type . "application/octet-stream") - (method . mime-decode-message/tar) - (mode . "play") ("type" . "tar") - )) - -(set-atype 'mime-acting-condition - '((type . "application/octet-stream") - (method . mime-decode-message/tar) - (mode . "play") ("type" . "tar+gzip") - )) - -(set-atype 'mime-acting-condition - '((type . "application/x-gzip") - (method . mime-decode-message/tar) - (mode . "play") ("type" . "tar") - )) - -(set-atype 'mime-acting-condition - '((type . "application/x-tar") - (method . mime-decode-message/tar) - (mode . "play") - )) - -;;; @ end -;;; - -(provide 'mime-tar) - -;;; mime-tar.el ends here diff --git a/mime-view.el b/mime-view.el deleted file mode 100644 index 40990d5..0000000 --- a/mime-view.el +++ /dev/null @@ -1,1211 +0,0 @@ -;;; mime-view.el --- interactive MIME viewer for GNU Emacs - -;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Created: 1994/7/13 -;; Renamed: 1994/8/31 from tm-body.el -;; Renamed: 1997/02/19 from tm-view.el -;; Version: $Revision: 0.95 $ -;; Keywords: MIME, multimedia, mail, news - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'cl) -(require 'std11) -(require 'mel) -(require 'eword-decode) -(require 'mime-parse) -(require 'mime-text) - - -;;; @ version -;;; - -(defconst mime-view-RCS-ID - "$Id: mime-view.el,v 0.95 1997-06-24 16:21:46 morioka Exp $") - -(defconst mime-view-version (get-version-string mime-view-RCS-ID)) - - -;;; @ variables -;;; - -(defvar mime-acting-condition - '(((type . "text/plain") - (method "tm-plain" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . "text/html") - (method "tm-html" nil 'file 'type 'encoding 'mode 'name) - (mode . "play") - ) - ((type . "text/x-rot13-47") - (method . mime-display-caesar) - (mode . "play") - ) - ((type . "text/x-rot13-47-48") - (method . mime-display-caesar) - (mode . "play") - ) - ((type . "audio/basic") - (method "tm-au" nil 'file 'type 'encoding 'mode 'name) - (mode . "play") - ) - - ((type . "image/jpeg") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . "image/gif") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . "image/png") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . "image/tiff") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . "image/x-tiff") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . "image/x-xbm") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . "image/x-pic") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . "image/x-mag") - (method "tm-image" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - - ((type . "video/mpeg") - (method "tm-mpeg" nil 'file 'type 'encoding 'mode 'name) - (mode . "play") - ) - - ((type . "application/postscript") - (method "tm-ps" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - ((type . "application/octet-stream") - (method "tm-file" nil 'file 'type 'encoding 'mode 'name) - (mode "play" "print") - ) - - ;;((type . "message/external-body") - ;; (method "xterm" nil - ;; "-e" "showexternal" - ;; 'file '"access-type" '"name" '"site" '"directory")) - ((type . "message/external-body") - ("access-type" . "anon-ftp") - (method . mime-display-message/external-ftp) - ) - ((type . "message/rfc822") - (method . mime-article/view-message/rfc822) - (mode . "play") - ) - ((type . "message/partial") - (method . mime-display-message/partial) - (mode . "play") - ) - - ((method "metamail" t "-m" "tm" "-x" "-d" "-z" "-e" 'file) - (mode . "play") - ) - ((method "tm-file" nil 'file 'type 'encoding 'mode 'name) - (mode . "extract") - ) - )) - -(defvar mime-view-childrens-header-showing-Content-Type-list - '("message/rfc822" "message/news")) - -(defvar mime-view-visible-media-type-list - '("text/plain" nil "text/richtext" "text/enriched" - "text/rfc822-headers" - "text/x-latex" "application/x-latex" - "message/delivery-status" - "application/pgp" "text/x-pgp" - "application/octet-stream" - "application/x-selection" "application/x-comment") - "*List of media-types to be able to display in MIME-View buffer. -Each elements are string of TYPE/SUBTYPE, e.g. \"text/plain\".") - -(defvar mime-view-content-button-visible-ctype-list - '("application/pgp")) - -(defvar mime-view-uuencode-encoding-name-list '("x-uue" "x-uuencode")) - -(defvar mime-view-ignored-field-list - '(".*Received" ".*Path" ".*Id" "References" - "Replied" "Errors-To" - "Lines" "Sender" ".*Host" "Xref" - "Content-Type" "Precedence" - "Status" "X-VM-.*") - "All fields that match this list will be hidden in MIME preview buffer. -Each elements are regexp of field-name. [mime-view.el]") - -(defvar mime-view-ignored-field-regexp - (concat "^" - (apply (function regexp-or) mime-view-ignored-field-list) - ":")) - -(defvar mime-view-visible-field-list '("Dnas.*" "Message-Id") - "All fields that match this list will be displayed in MIME preview buffer. -Each elements are regexp of field-name.") - -(defvar mime-view-redisplay nil) - -(defvar mime-view-announcement-for-message/partial - (if (and (>= emacs-major-version 19) window-system) - "\ -\[[ This is message/partial style split message. ]] -\[[ Please press `v' key in this buffer ]] -\[[ or click here by mouse button-2. ]]" - "\ -\[[ This is message/partial style split message. ]] -\[[ Please press `v' key in this buffer. ]]" - )) - - -;;; @@ predicate functions -;;; - -(defun mime-view-header-visible-p (rcnum cinfo) - "Return non-nil if header of current entity is visible." - (or (null rcnum) - (member (mime::content-info/type - (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo)) - mime-view-childrens-header-showing-Content-Type-list) - )) - -(defun mime-view-body-visible-p (rcnum cinfo &optional ctype) - (let (ccinfo) - (or ctype - (setq ctype - (mime::content-info/type - (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo)) - )) - ) - (and (member ctype mime-view-visible-media-type-list) - (if (string-equal ctype "application/octet-stream") - (progn - (or ccinfo - (setq ccinfo (mime-article/rcnum-to-cinfo rcnum cinfo)) - ) - (member (mime::content-info/encoding ccinfo) - '(nil "7bit" "8bit")) - ) - t)) - )) - - -;;; @@ entity button -;;; - -(defun mime-view-insert-entity-button (rcnum cinfo ctype params subj encoding) - "Insert entity-button." - (mime-insert-button - (let ((access-type (assoc "access-type" params)) - (num (or (cdr (assoc "x-part-number" params)) - (if (consp rcnum) - (mapconcat (function - (lambda (num) - (format "%s" (1+ num)) - )) - (reverse rcnum) ".") - "0")) - )) - (cond (access-type - (let ((server (assoc "server" params))) - (setq access-type (cdr access-type)) - (if server - (format "%s %s ([%s] %s)" - num subj access-type (cdr server)) - (let ((site (cdr (assoc "site" params))) - (dir (cdr (assoc "directory" params))) - ) - (format "%s %s ([%s] %s:%s)" - num subj access-type site dir) - ))) - ) - (t - (let ((charset (cdr (assoc "charset" params)))) - (concat - num " " subj - (let ((rest - (concat " <" ctype - (if charset - (concat "; " charset) - (if encoding (concat " (" encoding ")")) - ) - ">"))) - (if (>= (+ (current-column)(length rest))(window-width)) - "\n\t") - rest))) - ))) - (function mime-view-play-current-entity)) - ) - -(defun mime-view-entity-button-function - (rcnum cinfo ctype params subj encoding) - "Insert entity button conditionally. -Please redefine this function if you want to change default setting." - (or (null rcnum) - (string= ctype "application/x-selection") - (and (string= ctype "application/octet-stream") - (string= (mime::content-info/type - (mime-article/rcnum-to-cinfo (cdr rcnum) cinfo)) - "multipart/encrypted")) - (mime-view-insert-entity-button rcnum cinfo ctype params subj encoding) - )) - - -;;; @@ content header filter -;;; - -(defsubst mime-view-cut-header () - (goto-char (point-min)) - (while (re-search-forward mime-view-ignored-field-regexp nil t) - (let* ((beg (match-beginning 0)) - (end (match-end 0)) - (name (buffer-substring beg end)) - ) - (or (member-if (function - (lambda (regexp) - (string-match regexp name) - )) mime-view-visible-field-list) - (delete-region beg - (save-excursion - (if (re-search-forward "^\\([^ \t]\\|$\\)" nil t) - (match-beginning 0) - (point-max)))) - )))) - -(defun mime-view-default-content-header-filter () - (mime-view-cut-header) - (eword-decode-header) - ) - -(defvar mime-view-content-header-filter-alist nil) - - -;;; @@ content filter -;;; - -(defvar mime-view-content-filter-alist - '(("text/enriched" . mime-view-filter-for-text/enriched) - ("text/richtext" . mime-view-filter-for-text/richtext) - (t . mime-view-filter-for-text/plain) - ) - "Alist of media-types vs. corresponding MIME-View filter functions. -Each element looks like (TYPE/SUBTYPE . FUNCTION) or (t . FUNCTION). -TYPE/SUBTYPE is a string of media-type and FUNCTION is a filter -function. t means default media-type.") - - -;;; @@ entity separator -;;; - -(defun mime-view-entity-separator-function (rcnum cinfo ctype params subj) - "Insert entity separator conditionally. -Please redefine this function if you want to change default setting." - (or (mime-view-header-visible-p rcnum cinfo) - (mime-view-body-visible-p rcnum cinfo ctype) - (progn - (goto-char (point-max)) - (insert "\n") - ))) - - -;;; @@ buffer local variables -;;; - -;;; @@@ in raw buffer -;;; - -(defvar mime::article/content-info - "Information about structure of message. -Please use reference function `mime::content-info/SLOT-NAME' to -reference slot of content-info. Their argument is only content-info. - -Following is a list of slots of the structure: - -rcnum reversed content-number (list) -point-min beginning point of region in raw-buffer -point-max end point of region in raw-buffer -type media-type/subtype (string or nil) -parameters parameter of Content-Type field (association list) -encoding Content-Transfer-Encoding (string or nil) -children entities included in this entity (list of content-infos) - -If a entity includes other entities in its body, such as multipart or -message/rfc822, content-infos of other entities are included in -`children', so content-info become a tree.") -(make-variable-buffer-local 'mime::article/content-info) - -(defvar mime-view-buffer nil - "MIME View buffer corresponding with the (raw) buffer.") -(make-variable-buffer-local 'mime-view-buffer) - - -;;; @@@ in view buffer -;;; - -(defvar mime-mother-buffer nil - "Mother buffer corresponding with the (MIME-View) buffer. -If current MIME-View buffer is generated by other buffer, such as -message/partial, it is called `mother-buffer'.") -(make-variable-buffer-local 'mime-mother-buffer) - -(defvar mime-raw-buffer nil - "Raw buffer corresponding with the (MIME-View) buffer.") -(make-variable-buffer-local 'mime-raw-buffer) - -(defvar mime-view-original-major-mode nil - "Major-mode in mime-raw-buffer.") -(make-variable-buffer-local 'mime-view-original-major-mode) - -(make-variable-buffer-local 'mime::preview/original-window-configuration) - - -;;; @@ quitting method -;;; - -(defvar mime-view-quitting-method-alist - '((mime-show-message-mode - . mime-view-quitting-method-for-mime-show-message-mode)) - "Alist of major-mode vs. quitting-method of mime-view.") - -(defvar mime-view-over-to-previous-method-alist nil) -(defvar mime-view-over-to-next-method-alist nil) - -(defvar mime-view-show-summary-method nil - "Alist of major-mode vs. show-summary-method.") - - -;;; @@ following method -;;; - -(defvar mime-view-following-method-alist nil - "Alist of major-mode vs. following-method of mime-view.") - -(defvar mime-view-following-required-fields-list - '("From")) - - -;;; @@ X-Face -;;; - -;; hack from Gnus 5.0.4. - -(defvar mime-view-x-face-to-pbm-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm") - -(defvar mime-view-x-face-command - (concat mime-view-x-face-to-pbm-command - " | xv -quit -") - "String to be executed to display an X-Face field. -The command will be executed in a sub-shell asynchronously. -The compressed face will be piped to this command.") - -(defun mime-view-x-face-function () - "Function to display X-Face field. You can redefine to customize." - ;; 1995/10/12 (c.f. tm-eng:130) - ;; fixed by Eric Ding - (save-restriction - (narrow-to-region (point-min) (re-search-forward "^$" nil t)) - ;; end - (goto-char (point-min)) - (if (re-search-forward "^X-Face:[ \t]*" nil t) - (let ((beg (match-end 0)) - (end (std11-field-end)) - ) - (call-process-region beg end "sh" nil 0 nil - "-c" mime-view-x-face-command) - )))) - - -;;; @ buffer setup -;;; - -(defun mime-view-setup-buffers (&optional ctl encoding ibuf obuf) - (if ibuf - (progn - (get-buffer ibuf) - (set-buffer ibuf) - )) - (or mime-view-redisplay - (setq mime::article/content-info (mime-parse-message ctl encoding)) - ) - (let* ((cinfo mime::article/content-info) - (pcl (mime/flatten-content-info cinfo)) - (the-buf (current-buffer)) - (mode major-mode) - ) - (or obuf - (setq obuf (concat "*Preview-" (buffer-name the-buf) "*"))) - (set-buffer (get-buffer-create obuf)) - (let ((inhibit-read-only t)) - ;;(setq buffer-read-only nil) - (widen) - (erase-buffer) - (setq mime-raw-buffer the-buf) - (setq mime-view-original-major-mode mode) - (setq major-mode 'mime-view-mode) - (setq mode-name "MIME-View") - (while pcl - (mime-view-display-entity (car pcl) cinfo the-buf obuf) - (setq pcl (cdr pcl)) - ) - (set-buffer-modified-p nil) - ) - (setq buffer-read-only t) - (set-buffer the-buf) - ) - (setq mime-view-buffer obuf) - ) - -(defun mime-view-display-entity (content cinfo ibuf obuf) - "Display entity from content-info CONTENT." - (let* ((beg (mime::content-info/point-min content)) - (end (mime::content-info/point-max content)) - (ctype (mime::content-info/type content)) - (params (mime::content-info/parameters content)) - (encoding (mime::content-info/encoding content)) - (rcnum (mime::content-info/rcnum content)) - he e nb ne subj) - (set-buffer ibuf) - (goto-char beg) - (setq he (if (re-search-forward "^$" nil t) - (1+ (match-end 0)) - end)) - (if (> he end) - (setq he end) - ) - (save-restriction - (narrow-to-region beg end) - (setq subj - (eword-decode-string - (mime-article/get-subject params encoding))) - ) - (set-buffer obuf) - (setq nb (point)) - (narrow-to-region nb nb) - (mime-view-entity-button-function rcnum cinfo ctype params subj encoding) - (if (mime-view-header-visible-p rcnum cinfo) - (mime-preview/display-header beg he) - ) - (if (and (null rcnum) - (member - ctype mime-view-content-button-visible-ctype-list)) - (save-excursion - (goto-char (point-max)) - (mime-view-insert-entity-button - rcnum cinfo ctype params subj encoding) - )) - (cond ((mime-view-body-visible-p rcnum cinfo ctype) - (mime-preview/display-body he end - rcnum cinfo ctype params subj encoding) - ) - ((equal ctype "message/partial") - (mime-view-insert-message/partial-button) - ) - ((and (null rcnum) - (null (mime::content-info/children cinfo)) - ) - (goto-char (point-max)) - (mime-view-insert-entity-button - rcnum cinfo ctype params subj encoding) - )) - (mime-view-entity-separator-function rcnum cinfo ctype params subj) - (setq ne (point-max)) - (widen) - (put-text-property nb ne 'mime-view-raw-buffer ibuf) - (put-text-property nb ne 'mime-view-cinfo content) - (goto-char ne) - )) - -(defun mime-preview/display-header (beg end) - (save-restriction - (narrow-to-region (point)(point)) - (insert-buffer-substring mime-raw-buffer beg end) - (let ((f (cdr (assq mime-view-original-major-mode - mime-view-content-header-filter-alist)))) - (if (functionp f) - (funcall f) - (mime-view-default-content-header-filter) - )) - (run-hooks 'mime-view-content-header-filter-hook) - )) - -(defun mime-preview/display-body (beg end - rcnum cinfo ctype params subj encoding) - (save-restriction - (narrow-to-region (point-max)(point-max)) - (insert-buffer-substring mime-raw-buffer beg end) - (let ((f (cdr (or (assoc ctype mime-view-content-filter-alist) - (assq t mime-view-content-filter-alist))))) - (and (functionp f) - (funcall f ctype params encoding) - ) - ))) - -(defun mime-view-insert-message/partial-button () - (save-restriction - (goto-char (point-max)) - (if (not (search-backward "\n\n" nil t)) - (insert "\n") - ) - (goto-char (point-max)) - (narrow-to-region (point-max)(point-max)) - (insert mime-view-announcement-for-message/partial) - (mime-add-button (point-min)(point-max) - (function mime-view-play-current-entity)) - )) - -(defun mime-article/get-uu-filename (param &optional encoding) - (if (member (or encoding - (cdr (assq 'encoding param)) - ) - mime-view-uuencode-encoding-name-list) - (save-excursion - (or (if (re-search-forward "^begin [0-9]+ " nil t) - (if (looking-at ".+$") - (buffer-substring (match-beginning 0)(match-end 0)) - )) - "")) - )) - -(defun mime-article/get-subject (param &optional encoding) - (or (std11-find-field-body '("Content-Description" "Subject")) - (let (ret) - (if (or (and (setq ret (mime/Content-Disposition)) - (setq ret (assoc "filename" (cdr ret))) - ) - (setq ret (assoc "name" param)) - (setq ret (assoc "x-name" param)) - ) - (std11-strip-quoted-string (cdr ret)) - )) - (mime-article/get-uu-filename param encoding) - "")) - - -;;; @ content information -;;; - -(defun mime-article/point-content-number (p &optional cinfo) - (or cinfo - (setq cinfo mime::article/content-info) - ) - (let ((b (mime::content-info/point-min cinfo)) - (e (mime::content-info/point-max cinfo)) - (c (mime::content-info/children cinfo)) - ) - (if (and (<= b p)(<= p e)) - (or (let (co ret (sn 0)) - (catch 'tag - (while c - (setq co (car c)) - (setq ret (mime-article/point-content-number p co)) - (cond ((eq ret t) (throw 'tag (list sn))) - (ret (throw 'tag (cons sn ret))) - ) - (setq c (cdr c)) - (setq sn (1+ sn)) - ))) - t)))) - -(defun mime-article/rcnum-to-cinfo (rcnum &optional cinfo) - (or cinfo - (setq cinfo mime::article/content-info) - ) - (find-if (function - (lambda (ci) - (equal (mime::content-info/rcnum ci) rcnum) - )) - (mime/flatten-content-info cinfo) - )) - -(defun mime-article/cnum-to-cinfo (cn &optional cinfo) - (or cinfo - (setq cinfo mime::article/content-info) - ) - (if (eq cn t) - cinfo - (let ((sn (car cn))) - (if (null sn) - cinfo - (let ((rc (nth sn (mime::content-info/children cinfo)))) - (if rc - (mime-article/cnum-to-cinfo (cdr cn) rc) - )) - )))) - -(defun mime/flatten-content-info (&optional cinfo) - (or cinfo - (setq cinfo mime::article/content-info) - ) - (let ((dest (list cinfo)) - (rcl (mime::content-info/children cinfo)) - ) - (while rcl - (setq dest (nconc dest (mime/flatten-content-info (car rcl)))) - (setq rcl (cdr rcl)) - ) - dest)) - - -;;; @ MIME viewer mode -;;; - -(defconst mime-view-menu-title "MIME-View") -(defconst mime-view-menu-list - '((up "Move to upper content" mime-view-move-to-upper) - (previous "Move to previous content" mime-view-move-to-previous) - (next "Move to next content" mime-view-move-to-next) - (scroll-down "Scroll to previous content" mime-view-scroll-down-entity) - (scroll-up "Scroll to next content" mime-view-scroll-up-entity) - (play "Play Content" mime-view-play-current-entity) - (extract "Extract Content" mime-view-extract-current-entity) - (print "Print" mime-view-print-current-entity) - (x-face "Show X Face" mime-view-display-x-face) - ) - "Menu for MIME Viewer") - -(cond (running-xemacs - (defvar mime-view-xemacs-popup-menu - (cons mime-view-menu-title - (mapcar (function - (lambda (item) - (vector (nth 1 item)(nth 2 item) t) - )) - mime-view-menu-list))) - (defun mime-view-xemacs-popup-menu (event) - "Popup the menu in the MIME Viewer buffer" - (interactive "e") - (select-window (event-window event)) - (set-buffer (event-buffer event)) - (popup-menu 'mime-view-xemacs-popup-menu)) - (defvar mouse-button-2 'button2) - ) - (t - (defvar mouse-button-2 [mouse-2]) - )) - -(defun mime-view-define-keymap (&optional default) - (let ((mime-view-mode-map (if (keymapp default) - (copy-keymap default) - (make-sparse-keymap) - ))) - (define-key mime-view-mode-map - "u" (function mime-view-move-to-upper)) - (define-key mime-view-mode-map - "p" (function mime-view-move-to-previous)) - (define-key mime-view-mode-map - "n" (function mime-view-move-to-next)) - (define-key mime-view-mode-map - "\e\t" (function mime-view-move-to-previous)) - (define-key mime-view-mode-map - "\t" (function mime-view-move-to-next)) - (define-key mime-view-mode-map - " " (function mime-view-scroll-up-entity)) - (define-key mime-view-mode-map - "\M- " (function mime-view-scroll-down-entity)) - (define-key mime-view-mode-map - "\177" (function mime-view-scroll-down-entity)) - (define-key mime-view-mode-map - "\C-m" (function mime-view-next-line-content)) - (define-key mime-view-mode-map - "\C-\M-m" (function mime-view-previous-line-content)) - (define-key mime-view-mode-map - "v" (function mime-view-play-current-entity)) - (define-key mime-view-mode-map - "e" (function mime-view-extract-current-entity)) - (define-key mime-view-mode-map - "\C-c\C-p" (function mime-view-print-current-entity)) - (define-key mime-view-mode-map - "a" (function mime-view-follow-current-entity)) - (define-key mime-view-mode-map - "q" (function mime-view-quit)) - (define-key mime-view-mode-map - "h" (function mime-view-show-summary)) - (define-key mime-view-mode-map - "\C-c\C-x" (function mime-view-kill-buffer)) - ;; (define-key mime-view-mode-map - ;; "<" (function beginning-of-buffer)) - ;; (define-key mime-view-mode-map - ;; ">" (function end-of-buffer)) - (define-key mime-view-mode-map - "?" (function describe-mode)) - (define-key mime-view-mode-map - [tab] (function mime-view-move-to-next)) - (define-key mime-view-mode-map - [delete] (function mime-view-scroll-down-entity)) - (define-key mime-view-mode-map - [backspace] (function mime-view-scroll-down-entity)) - (if (functionp default) - (cond (running-xemacs - (set-keymap-default-binding mime-view-mode-map default) - ) - (t - (setq mime-view-mode-map - (append mime-view-mode-map (list (cons t default)))) - ))) - (if mouse-button-2 - (define-key mime-view-mode-map - mouse-button-2 (function mime-button-dispatcher)) - ) - (cond (running-xemacs - (define-key mime-view-mode-map - mouse-button-3 (function mime-view-xemacs-popup-menu)) - ) - ((>= emacs-major-version 19) - (define-key mime-view-mode-map [menu-bar mime-view] - (cons mime-view-menu-title - (make-sparse-keymap mime-view-menu-title))) - (mapcar (function - (lambda (item) - (define-key mime-view-mode-map - (vector 'menu-bar 'mime-view (car item)) - (cons (nth 1 item)(nth 2 item)) - ) - )) - (reverse mime-view-menu-list) - ) - )) - (use-local-map mime-view-mode-map) - (run-hooks 'mime-view-define-keymap-hook) - )) - -(defsubst mime-hide-echo-buffer () - "Hide mime-echo buffer." - (let ((win (get-buffer-window mime-echo-buffer-name))) - (if win - (delete-window win) - ))) - -(defun mime-view-mode (&optional mother ctl encoding ibuf obuf - default-keymap-or-function) - "Major mode for viewing MIME message. - -Here is a list of the standard keys for mime-view-mode. - -key feature ---- ------- - -u Move to upper content -p or M-TAB Move to previous content -n or TAB Move to next content -SPC Scroll up or move to next content -M-SPC or DEL Scroll down or move to previous content -RET Move to next line -M-RET Move to previous line -v Decode current content as `play mode' -e Decode current content as `extract mode' -C-c C-p Decode current content as `print mode' -a Followup to current content. -x Display X-Face -q Quit -button-2 Move to point under the mouse cursor - and decode current content as `play mode' -" - (interactive) - (let ((buf (get-buffer mime-echo-buffer-name))) - (if buf - (save-excursion - (set-buffer buf) - (erase-buffer) - (mime-hide-echo-buffer) - ))) - (let ((ret (mime-view-setup-buffers ctl encoding ibuf obuf)) - (win-conf (current-window-configuration)) - ) - (prog1 - (switch-to-buffer ret) - (setq mime::preview/original-window-configuration win-conf) - (if mother - (progn - (setq mime-mother-buffer mother) - )) - (mime-view-define-keymap default-keymap-or-function) - (let ((point (next-single-property-change (point-min) 'mime-view-cinfo))) - (if point - (goto-char point) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - )) - (run-hooks 'mime-view-mode-hook) - ))) - - -;;; @@ playing -;;; - -(autoload 'mime-view-play-current-entity "mime-play" "Play current entity." t) - -(defun mime-view-extract-current-entity () - "Extract current entity into file (maybe). -It decodes current entity to call internal or external method as -\"extract\" mode. The method is selected from variable -`mime-acting-condition'." - (interactive) - (mime-view-play-current-entity "extract") - ) - -(defun mime-view-print-current-entity () - "Print current entity (maybe). -It decodes current entity to call internal or external method as -\"print\" mode. The method is selected from variable -`mime-acting-condition'." - (interactive) - (mime-view-play-current-entity "print") - ) - - -;;; @@ following -;;; - -(defun mime-view-get-original-major-mode () - "Return major-mode of original buffer. -If a current buffer has mime-mother-buffer, return original major-mode -of the mother-buffer." - (if mime-mother-buffer - (save-excursion - (set-buffer mime-mother-buffer) - (mime-view-get-original-major-mode) - ) - mime-view-original-major-mode)) - -(defun mime-view-follow-current-entity () - "Write follow message to current entity. -It calls following-method selected from variable -`mime-view-following-method-alist'." - (interactive) - (let ((root-cinfo (get-text-property (point-min) 'mime-view-cinfo)) - cinfo) - (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo))) - (backward-char) - ) - (let* ((p-beg (previous-single-property-change (point) 'mime-view-cinfo)) - p-end - (rcnum (mime::content-info/rcnum cinfo)) - (len (length rcnum)) - ) - (cond ((null p-beg) - (setq p-beg - (if (eq (next-single-property-change (point-min) - 'mime-view-cinfo) - (point)) - (point) - (point-min))) - ) - ((eq (next-single-property-change p-beg 'mime-view-cinfo) - (point)) - (setq p-beg (point)) - )) - (setq p-end (next-single-property-change p-beg 'mime-view-cinfo)) - (cond ((null p-end) - (setq p-end (point-max)) - ) - ((null rcnum) - (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-cinfo)) - (goto-char e) - (let ((rc (mime::content-info/rcnum - (get-text-property (point) - 'mime-view-cinfo)))) - (or (equal rcnum (nthcdr (- (length rc) len) rc)) - (throw 'tag nil) - )) - (setq p-end e) - )) - (setq p-end (point-max)) - )) - )) - (let* ((mode (mime-view-get-original-major-mode)) - (new-name (format "%s-%s" (buffer-name) (reverse rcnum))) - new-buf - (the-buf (current-buffer)) - (a-buf mime-raw-buffer) - fields) - (save-excursion - (set-buffer (setq new-buf (get-buffer-create new-name))) - (erase-buffer) - (insert-buffer-substring the-buf p-beg p-end) - (goto-char (point-min)) - (if (mime-view-header-visible-p rcnum root-cinfo) - (delete-region (goto-char (point-min)) - (if (re-search-forward "^$" nil t) - (match-end 0) - (point-min))) - ) - (goto-char (point-min)) - (insert "\n") - (goto-char (point-min)) - (let ((rcnum (mime::content-info/rcnum cinfo)) ci str) - (while (progn - (setq str - (save-excursion - (set-buffer a-buf) - (setq ci (mime-article/rcnum-to-cinfo rcnum)) - (save-restriction - (narrow-to-region - (mime::content-info/point-min ci) - (mime::content-info/point-max ci) - ) - (std11-header-string-except - (concat "^" - (apply (function regexp-or) fields) - ":") "")))) - (if (string= (mime::content-info/type ci) - "message/rfc822") - nil - (if str - (insert str) - ) - rcnum)) - (setq fields (std11-collect-field-names) - rcnum (cdr rcnum)) - ) - ) - (let ((rest mime-view-following-required-fields-list)) - (while rest - (let ((field-name (car rest))) - (or (std11-field-body field-name) - (insert - (format - (concat field-name - ": " - (save-excursion - (set-buffer the-buf) - (set-buffer mime-mother-buffer) - (set-buffer mime-raw-buffer) - (std11-field-body field-name) - ) - "\n"))) - )) - (setq rest (cdr rest)) - )) - (eword-decode-header) - ) - (let ((f (cdr (assq mode mime-view-following-method-alist)))) - (if (functionp f) - (funcall f new-buf) - (message - (format - "Sorry, following method for %s is not implemented yet." - mode)) - )) - )))) - - -;;; @@ X-Face -;;; - -(defun mime-view-display-x-face () - (interactive) - (save-window-excursion - (set-buffer mime-raw-buffer) - (mime-view-x-face-function) - )) - - -;;; @@ moving -;;; - -(defun mime-view-move-to-upper () - "Move to upper entity. -If there is no upper entity, call function `mime-view-quit'." - (interactive) - (let (cinfo) - (while (null (setq cinfo (get-text-property (point) 'mime-view-cinfo))) - (backward-char) - ) - (let ((r (mime-article/rcnum-to-cinfo - (cdr (mime::content-info/rcnum cinfo)) - (get-text-property 1 'mime-view-cinfo))) - point) - (catch 'tag - (while (setq point (previous-single-property-change - (point) 'mime-view-cinfo)) - (goto-char point) - (if (eq r (get-text-property (point) 'mime-view-cinfo)) - (throw 'tag t) - ) - ) - (mime-view-quit) - )))) - -(defun mime-view-move-to-previous () - "Move to previous entity. -If there is no previous entity, it calls function registered in -variable `mime-view-over-to-previous-method-alist'." - (interactive) - (while (null (get-text-property (point) 'mime-view-cinfo)) - (backward-char) - ) - (let ((point (previous-single-property-change (point) 'mime-view-cinfo))) - (if point - (goto-char point) - (let ((f (assq mime-view-original-major-mode - mime-view-over-to-previous-method-alist))) - (if f - (funcall (cdr f)) - )) - ))) - -(defun mime-view-move-to-next () - "Move to next entity. -If there is no previous entity, it calls function registered in -variable `mime-view-over-to-next-method-alist'." - (interactive) - (let ((point (next-single-property-change (point) 'mime-view-cinfo))) - (if point - (goto-char point) - (let ((f (assq mime-view-original-major-mode - mime-view-over-to-next-method-alist))) - (if f - (funcall (cdr f)) - )) - ))) - -(defun mime-view-scroll-up-entity (&optional h) - "Scroll up current entity. -If reached to (point-max), it calls function registered in variable -`mime-view-over-to-next-method-alist'." - (interactive) - (or h - (setq h (1- (window-height))) - ) - (if (= (point) (point-max)) - (let ((f (assq mime-view-original-major-mode - mime-view-over-to-next-method-alist))) - (if f - (funcall (cdr f)) - )) - (let ((point - (or (next-single-property-change (point) 'mime-view-cinfo) - (point-max)))) - (forward-line h) - (if (> (point) point) - (goto-char point) - ) - ))) - -(defun mime-view-scroll-down-entity (&optional h) - "Scroll down current entity. -If reached to (point-min), it calls function registered in variable -`mime-view-over-to-previous-method-alist'." - (interactive) - (or h - (setq h (1- (window-height))) - ) - (if (= (point) (point-min)) - (let ((f (assq mime-view-original-major-mode - mime-view-over-to-previous-method-alist))) - (if f - (funcall (cdr f)) - )) - (let (point) - (save-excursion - (catch 'tag - (while (> (point) 1) - (if (setq point - (previous-single-property-change (point) - 'mime-view-cinfo)) - (throw 'tag t) - ) - (backward-char) - ) - (setq point (point-min)) - )) - (forward-line (- h)) - (if (< (point) point) - (goto-char point) - )))) - -(defun mime-view-next-line-content () - (interactive) - (mime-view-scroll-up-entity 1) - ) - -(defun mime-view-previous-line-content () - (interactive) - (mime-view-scroll-down-entity 1) - ) - - -;;; @@ quitting -;;; - -(defun mime-view-quit () - "Quit from MIME-View buffer. -It calls function registered in variable -`mime-view-quitting-method-alist'." - (interactive) - (let ((r (assq mime-view-original-major-mode - mime-view-quitting-method-alist))) - (if r - (funcall (cdr r)) - ))) - -(defun mime-view-show-summary () - "Show summary. -It calls function registered in variable -`mime-view-show-summary-method'." - (interactive) - (let ((r (assq mime-view-original-major-mode - mime-view-show-summary-method))) - (if r - (funcall (cdr r)) - ))) - -(defun mime-view-kill-buffer () - (interactive) - (kill-buffer (current-buffer)) - ) - - -;;; @ end -;;; - -(provide 'mime-view) - -(run-hooks 'mime-view-load-hook) - -;;; mime-view.el ends here diff --git a/semi-setup.el b/semi-setup.el deleted file mode 100644 index 1eecdbb..0000000 --- a/semi-setup.el +++ /dev/null @@ -1,128 +0,0 @@ -;;; semi-setup.el --- setup file for MIME-View. - -;; Copyright (C) 1994,1995,1996,1997 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Version: $Id: semi-setup.el,v 0.16 1997-03-18 13:06:09 morioka Exp $ -;; Keywords: mail, news, MIME, multimedia, multilingual, encoded-word - -;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'mime-def) -(require 'file-detect) - - -;; for image/* and X-Face -(defvar mime-setup-enable-inline-image - (and window-system - (or running-xemacs - (and (featurep 'mule)(module-installed-p 'bitmap)) - )) - "*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) - ))) - ) - - -(defvar mime-setup-enable-pgp - (module-installed-p 'mailcrypt) - "*If it is non-nil, semi-setup sets uf to use mime-pgp.") - -;; for PGP -(if mime-setup-enable-pgp - (call-after-loaded 'mime-view - (function - (lambda () - (require 'mime-pgp) - ))) - ) - - -;;; @ 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) - )) - (eword-decode-header) - (set-buffer-modified-p nil) - ))) - -(add-hook 'mime-edit-mode-hook 'mime-setup-decode-message-header) - - -;;; @@ variables -;;; - -(defvar mime-setup-use-signature t - "If it is not nil, mime-setup sets up to use signature.el.") - -(defvar mime-setup-default-signature-key "\C-c\C-s" - "*Key to insert signature.") - -(defvar mime-setup-signature-key-alist '((mail-mode . "\C-c\C-w")) - "Alist of major-mode vs. key to insert signature.") - - -;;; @@ for signature -;;; - -(defun mime-setup-set-signature-key () - (let ((key (or (cdr (assq major-mode mime-setup-signature-key-alist)) - mime-setup-default-signature-key))) - (define-key (current-local-map) key (function insert-signature)) - )) - -(if mime-setup-use-signature - (progn - (autoload 'insert-signature "signature" "Insert signature" t) - (add-hook 'mime-edit-mode-hook 'mime-setup-set-signature-key) - (setq gnus-signature-file nil) - (setq mail-signature nil) - (setq message-signature nil) - )) - - -;;; @ for mu-cite -;;; - -(add-hook 'mu-cite/pre-cite-hook 'eword-decode-header) - - -;;; @ end -;;; - -(provide 'semi-setup) - -;;; semi-setup.el ends here