pax_global_header00006660000000000000000000000064143677357330014534gustar00rootroot0000000000000052 comment=2cf5a7891090faca8de725b1d3743dcedf233ea2 wanderlust-flim-2cf5a78/000077500000000000000000000000001436773573300152725ustar00rootroot00000000000000wanderlust-flim-2cf5a78/ChangeLog.1000066400000000000000000005147041436773573300172160ustar00rootroot000000000000002020-08-24 Kazuhiro Ito * mime-def.el: Change product name to 'FLIM-LB'. 2020-08-19 Kazuhiro Ito Change non-ASCII text files's coding-system to UTF-8 * ChangeLog: Likewise. * README.ja: Likewise. * mime-ja.texi: Likewize. Assume LuaTex for typesetting. * mime-en.texi: Likewise. Assume LuaTex for typesetting, because this file is partially written in Japanese. 2020-08-05 Naoya Yamashita Fix closing parens position (cosmetic change only). Cf. https://github.com/wanderlust/flim/pull/11 2020-08-03 Naoya Yamashita Use ?\s instead of ?(whitespace). Cf. https://github.com/wanderlust/flim/pull/10 * eword-decode.el (eword-decode-encoded-words): Likewise. * eword-encode.el (eword-encode-rword-list, ew-encode-rword-1) (tm-eword::string-to-ruled-words): Likewise. * mel-q-ccl.el (mel-ccl-decode-quoted-printable-generic) (mel-ccl-encode-quoted-printable-generic, mel-ccl-decode-q): Likewise. * mel-q.el (quoted-printable-internal-encode-region): Likewise. * mel.el (Q-encoded-text-length): Likewise. * mime-conf.el (mime-mailcap-look-at-schar): Likewise * smtp.el (smtp-deduce-address-list): Likewise. * std11.el (std11-space-char-list): Likewise. 2020-06-26 Kazuhiro Ito * std11.el (std11-addr-to-string): Fix typo. Cf. https://github.com/wanderlust/wanderlust/issues/175 2020-06-14 Kazuhiro Ito Minor refactorings. * eword-decode.el (eword-decode-encoded-words) (eword-analyze-comment, eword-decode-token): Reduce use of concat function. * sasl.el (sasl-unique-id-number-base36): Replace char-to-string by list for concat function's arguments. * smtp.el (smtp-send-data): Minor refactoring. * std11.el (std11-header-string, std11-header-string-except) (std11-fill-msg-id-list-string): Reduce use of concat function. (std11-parse-group, std11-addr-to-string): Minor refactorings. 2020-06-05 Kazuhiro Ito * FLIM-MK: Assume Emacs 24 or later. 2020-06-03 Kazuhiro Ito Use following-char and preceding-char instead of char-after and char-before for the current point. * mel-q.el (quoted-printable-internal-encode-region) (quoted-printable-internal-decode-region): Likewise. * mime-conf.el (mime-mailcap-skip-comment) (mime-mailcap-look-at-type-field, mime-mailcap-look-at-schar) (mime-mailcap-look-at-qchar): Likewise. * mime-parse.el (mime-decode-parameter-encode-segment) (mime-divide-extended-parameter, mime-encode-extended-parameter) (mime-divide-regular-parameter, mime-encode-regular-parameter): Likewise. 2020-06-02 Kazuhiro Ito Strip use of function wrapping lambda. * eword-encode.el (eword-encode-Content-Disposition-field-body-broken-mime) (eword-encode-Content-Type-field-body-broken-mime) (eword-encode-Content-Disposition-field-body) (eword-encode-Content-Type-field-body): Likewise. * mel-q.el (q-encoding-decode-string, q-encoding-encode-string): Likewise. * std11.el (std11-full-name-string, std11-addr-to-string): Likewise. 2020-05-30 Kazuhiro Ito * eword-decode.el (eword-decode-encoded-words): Fix cl dependencies. * eword-encode.el: Adjust dependencies. * mel-q.el: Adjust dependencies. (quoted-printable-internal-decode-region): Use string-to-list instead of string-to-char-list. * mel.el: Adjust dependencies. * mime-parse.el: Adjust dependencies. * std11.el: Adjust dependencies. 2020-05-23 Kazuhiro Ito Use lexical binding. * eword-decode.el: Likewise. * eword-encode.el: Likewise. * hmac-md5.el: Likewise. * hmac-sha1.el: Likewise. * luna.el: Likewise. * lunit.el: Likewise. * md5.el: Likewise. * mel-g.el: Likewise. * mel-q-ccl.el: Likewise. * mel-q.el: Likewise. * mel-u.el: Likewise. * mel.el: Likewise. * mime-conf.el: Likewise. * mime-def.el: Likewise. * mime-parse.el: Likewise. * mime.el: Likewise. * mmbuffer.el: Likewise. * mmcooked.el: Likewise. * mmexternal.el: Likewise. * mmgeneric.el: Likewise. * qmtp.el: Likewise. * sasl-cram.el: Likewise. * sasl-digest.el: Likewise. * sasl-scram.el: Likewise. * sasl-xoauth2.el: Likewise. * sasl.el: Likewise. * sha1.el: Likewise. * smtp.el: Likewise. * std11.el: Likewise. 2020-05-23 Kazuhiro Ito Support additional SASL mechanism libraries. * sasl.el (sasl-additional-mechanism-alist): New variable. (sasl-mechanism-alist): Include entries for additional libraries. (sasl-mechanisms): Calculate from sasl-mechanism-alist. 2020-05-23 Kazuhiro Ito Rmove some files which are inluded in Emacs. * hmac-def.el: Removed. * hex-utils.el: Removed. * sasl-ntlm.el: Removed. * FLIM-ELS (flim-modules, hmac-modules): Remove removed files. 2020-05-23 Kazuhiro Ito Suppress byte-compiler's warnings. * eword-decode.el (eword-decode-header): Add obsolete date. * eword-encode.el: Fix dependency. (eword-encode-header, eword-in-subject-p) (eword-encode-field-body): Add obsolete date. * mime-def.el: Remove dependecy on static.el. (eval-when-compile): Assume Emacs24 or later. (mime-message-structure): Add obsolete date. * mime-parse.el: Fix dependency. (mime-parse-parameters-from-list): Add obsolete date. * qmtp.el (qmtp-via-qmtp): Add obsolete date. * smtp.el (smtp-via-smtp): Add obsolete date. * std11.el (std11-parse-in-reply-to): Add obsolete date. 2020-05-23 Kazuhiro Ito Drop old platforms support, dependency on cl.el. Now supported Emacsen are version 24 and later. * FLIM-ELS: Assume Emacs version 24 or later. * eword-encode.el: Likewise. * md5.el: Likewise. * mel-q-ccl.el: Likewise. * mel-q.el: Likewise. * mel.el: Likewise. * sha1.el: Likewise. * eword-decode.el: Use cl-lib instead of cl. * md5-dl.el: Removed. * md5-el.el: Removed. * mel-b-ccl.el: Removed. * mel-b-dl.el: Removed. * mel-b-el.el: Removed. * sha1-el.el: Removed. * sha1-dl.el: Removed. * md4.el: Removed. Included in Emacs. * ntlm.el: Removed. Included in Emacs. * smtpmail.el: Removed. Included in Emacs. 2020-03-03 Kazuhiro Ito * sasl-xoauth2.el (sasl-xoauth2-response): Fix typo in variable name. 2020-02-28 Kazuhiro Ito * sasl.el (sasl-mechanism-alist, sasl-mechanisms): Add OAUTHBEARER as alias for XOAUTH2. 2019-05-26 Kazuhiro Ito * eword-decode.el (eword-decode-token): Escape characters which cause warning from byte compiler. 2018-03-29 Kazuhiro Ito Fix EHLO command is sent twice after STARTTLS command when built-in GnuTLS library is used. * smtp.el (smtp-open-gnutls-starttls-stream): Abolished. (smtp-open-connection): Do not use smtp-open-gnutls-starttls-stream. (smtp-primitive-starttls): Use gnutls-negotiate when built-in GnuTLS is used for STARTTLS connection. 2018-01-18 Kazuhiro Ito XOAUTH2 authentication support is introduced (experimental). * FLIM-ELS: Install sasl-xoauth2.el when oauth2.el is installed. * sasl.el (sasl-mechanisms, sasl-mechanism-alist): Add entry for XOAUTH2. * sasl-xoauth2.el: New file. 2016-12-06 Piotr Trojanek * luna.el (luna-class-find-member) (luna-class-find-or-make-member): do not modify input argument. 2016-11-30 Piotr Trojanek * luna.el (luna-define-class-function): simplify iteration with dolist. 2016-10-30 Kazuhiro Ito * std11.el (std11-full-name-string): Refactored. 2016-10-30 Kazuhiro Ito * eword-decode.el (eword-decode-structured-field-body) (eword-decode-and-unfold-structured-field-body) (eword-decode-and-fold-structured-field-body): Decrease number of times for calling concat function. * std11.el (std11-wrap-as-quoted-pairs, std11-strip-quoted-pair) (std11-comment-value-to-string): Likewise. 2016-10-30 Kazuhiro Ito * smtp.el (smtp-send-buffer, smtp-send-buffer-by-myself): Call kill-buffer with nil. Only Emacs 23 and later support omitting an argument for kill-buffer. Reported By Tatsuya Kinoshita . Cf. [wl:14662] 2016-08-31 Kazuhiro Ito * eword-decode.el (eword-analyze-encoded-word): Fix the check for non-atom special chars to permit space chars. 2016-08-14 Erik Hetzner * mime-en.texi: Add dir entry * mime-ja.texi: Likewise 2016-08-13 Kazuhiro Ito * eword-decode.el (eword-analyze-encoded-word): Quote decoded word when it contains non-atom special chars and not quoted. Cf. https://github.com/wanderlust/wanderlust/issues/126 2016-03-12 Kazuhiro Ito * mel.el (mel-prompt-for-encoding): New function. (mime-encode-region, mime-decode-region) (mime-insert-encoded-file, mime-write-decoded-region): Use it. 2015-12-13 Kazuhiro Ito * smtp.el (smtp-send-buffer, smtp-send-buffer-by-myself): Kill trace buffer after sending when smtp-debug is nil and network stream is disconnected. Suggested by Herbert J. Skuhra 2015-07-30 Kazuhiro Ito * smtp.el (smtp-primitive-auth): Fix the case that server returns human readable string for AUTH command. 2015-05-23 Kazuhiro Ito * smtp.el (smtp-make-fqdn): Show more informative message for invalid FQDN. Cf. https://github.com/wanderlust/wanderlust/issues/96 2015-05-02 Kazuhiro Ito * eword-encode.el: Require poem.el for non-mule. 2015-04-30 Kazuhiro Ito * mime-parse.el (mime-default-ccl-lexical-analyzer) (mime-ccl-lexical-analyzer): Fix for CCL unusable environments. * std11.el (std11-default-ccl-lexical-analyzer) (std11-ccl-lexical-analyzer): Likeswise. 2015-04-27 Kazuhiro Ito * mime-parse.el (mime-default-ccl-lexical-analyzer): Fix wrong program is build on XEmacs. Cf. https://github.com/wanderlust/flim/commit/488a4d70fb4ae57bdd30dc75c2d75579894e28a2 * std11.el (std11-default-ccl-lexical-analyzer): Likewise. 2015-03-10 Kazuhiro Ito * mime-parse.el (mime-default-ccl-lexical-analyzer): Fix the case input is terminated with space characters or non-closing comment. 2014-12-21 Kazuhiro Ito * std11.el (std11-ignored-token-p): Simplified. 2014-12-16 Kazuhiro Ito CCL base lexical analyzers are available. They are much faster. If you modify `std11-lexical-analyzer' or `mime-lexical-analyzer', you also need to modify `std11-ccl-lexical-analyzer' or `mime-ccl-lexical-analyzer', respectively. * mime-parse.el (mime-default-ccl-lexical-analyzer): New CCL program. (mime-ccl-lexical-analyzer): New customizable variable. (mime-lexical-analyze): Use CCL based lexical analyzer if mime-ccl-lexical-analyzer is non-nil. * std11.el (std11-default-ccl-lexical-analyzer): New CCL program. (std11-ccl-lexical-analyzer): New customizable variable. (std11-lexical-analyze): Use CCL based lexical analyzer if std11-ccl-lexical-analyzer is non-nil. 2014-11-09 Kazuhiro Ito * mime-en.texi (7bit): Fix typo. * mime-ja.texi: Fix missing cross-references. 2014-11-09 Erik Hetzner * flim-pkg.el: New file. 2014-11-09 Erik Hetzner * mime-en.texi: Fix headers and missing cross-references. * mime-ja.texi: Fix headers. * mime-en.sgml: Removed. * mime-ja.sgml: Removed. 2014-09-15 Kazuhiro Ito * mime-conf.el (mime-format-mailcap-command): Minor refactoring. 2014-09-13 Erik Hetzner * mime-conf.el (mime-format-mailcap-command): Add quotes for quoted file name to unquote. Cf. https://github.com/wanderlust/flim/pull/3 2014-08-31 Kazuhiro Ito * mime-parse.el (mime-decode-parameter-value) (mime-decode-parameters): Use string-to-number instead of string-to-int. 2014-08-31 Kazuhiro Ito * eword-encode.el (eword-encode-char-type): Defined as macro. 2014-08-31 Kazuhiro Ito * lunit.el (lunit-generate-template): Use `with-current-buffer' rather than save-excursion+set-buffer. * mmbuffer.el (initialize-instance, mime-write-entity) (mime-entity-body, mime-write-entity-body, mime-entity-content) (mime-write-entity-content, mime-entity-fetch-field): Likewise. * mmcooked.el (write-entity-content, write-entity) (write-entity-body): Likewise. * mmgeneric.el (mime-insert-header-from-buffer): Likewise. * qmtp.el (qmtp-send-buffer): Likewise. * smtp.el (smtp-package-buffer-internal-size, smtp-send-buffer) (smtp-send-buffer-by-myself, smtp-primitive-data) (smtp-process-filter, smtp-send-command) (smtp-deduce-address-list): Likewise. 2014-06-20 Kazuhiro Ito Un-encoded garbage handling is available when built-in base64 decoder is used. * mel.el (mel-b-builtin-garbage-strategy): New customizable variable. (mel-b-builtin-encoded-line-regexp): New variable. (mel-b-builtin-decode-string, mel-b-builtin-decode-region): New functions. (mime-decode-string, mime-decode-region) (mime-write-decoded-region): (mel-b-builtin) Use them. 2014-05-31 Juliusz Chroboczek * mel.el (mime-insert-encoded-file): Avoid going through an intermediary string, work inline. (mime-write-decoded-region): likewise. 2014-04-23 Kazuhiro Ito * FLIM-ELS: Check whether secure-hash function is defined. Cf. https://github.com/ikazuhiro/flim/commit/85bbe382c4812fd041207aa727acba8ece2e7a39#commitcomment-6082738 * hmac-md5.el: Likewise. * hmac-sha1.el: Likewise. * sha1.el (TOP, sha1-dl-module): Likewise. 2014-04-15 Kazuhiro Ito * FLIM-ELS: Install sha1-el.el when dynamic-link is available and built-in sha1 library is not available. 2014-04-05 Kazuhiro Ito * std11.el (std11-narrow-to-header) (std11-field-bodies): Minor refactoring. 2014-03-30 Kazuhiro Ito * sasl-cram.el: Require hex-util.el. * sasl-digest.el: Require hex-util.el. * hmac-md5.el: Do not require hex-util.el. Define autoload for decode-hex-string only when needed. (md5-binary): Use built-in functionality if available. * hmac-sha1.el: Linkewise. (sha1-binary): Use built-in functionality if available. 2014-03-29 Kazuhiro Ito * FLIM-ELS: Do not install sha1-el.el when built-in SHA1 library is available. * sha1.el: Do not require sha1-el.el in the above case. (sha1-dl-module): set to nil in the above case. 2014-02-22 Kazuhiro Ito * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): Call insert-file-contents-literally directly. 2013-07-05 Kazuhiro Ito * eword-encode.el: Fix the previous change for really checking. 2013-07-04 Kazuhiro Ito * eword-encode.el: Check whether the mule-vesion variable is defined. 2013-06-26 Kazuhiro Ito * mailcap.el: Removed to resolve compatibility problem when run in expanded place. 2013-03-23 Kazuhiro Ito Many encoder/decoder functions now always encode/decode regardless buffer's multibyteness. * mime-def.el (mime-charset-decode-string) (mime-charset-encode-string): New functions. * mime-parse.el (mime-decode-parameter-value) (mime-encode-extended-parameter): Use them. * eword-decode.el (eword-decode-unstructured-field-body) (eword-decode-and-unfold-unstructured-field-body) (eword-decode-unfolded-unstructured-field-body) (eword-decode-encoded-words, eword-analyze-quoted-string) (eword-analyze-comment, eword-analyze-atom): Use mime-charset-decode-string instead of decode-mime-charset-string. * eword-encode.el (tm-eword::encoded-word-length) (tm-eword::encoded-word-length): Use mime-charset-encode-string instead of encode-mime-charset-string. 2012-08-14 Kazuhiro Ito * std11.el (std11-unfold-strip-leading-tab): New variable. (std11-unfold-string): Use it. Workaround for incorrect folding. 2012-08-10 Kazuhiro Ito * mel-q-ccl.el (q-encoding-ccl-decode-string): Remove duplicate definition for Emacs 23.1. 2012-07-29 Kazuhiro Ito * eword-encode.el (ew-find-string-rule): Define own function for Emacs23 which has APEL with detect-mime-charset-string for it. (ew-find-charset-rule): Define only when needed. 2012-07-29 Kazuhiro Ito * eword-encode.el (ew-find-string-rule): New function. (eword-encode-phrase-to-rword-list): Use it. 2012-07-29 Kazuhiro Ito * eword-encode.el (tm-eword::string-to-ruled-words): Define own function for Emacs23 which has APEL with detect-mime-charset-string for it. (eword-encode-char-type, eword-encode-divide-into-charset-words) (eword-encode-charset-words-to-words): Define only when needed. 2012-07-29 Kazuhiro Ito * eword-encode.el (tm-eword::string-to-ruled-words): New function. (eword-encode-split-string, eword-encode-phrase-to-rword-list): Use it. 2012-04-28 MORIOKA Tomohiko * README.ja, README.en (Bug reports): Use "Emacs-MIME" instead of "EMACS-MIME". 2001-02-27 Martin Buchholz * mime-en.sgml: Typo fix. 2012-04-28 MORIOKA Tomohiko * README.ja, README.en (Bug reports): Modify for emacs-mime-{en|ja}@lists.chise.org. 2012-04-20 Kazuhiro Ito * mime-parse.el (mime-parse-message): Use mime-read-Content-Type instead of mime-parse-Content-Type. 2012-04-07 Kazuhiro Ito * smtp.el (smtp-open-connection): Raise error when open connection function failed. 2012-03-20 Kazuhiro Ito Support built-in GnuTLS for STARTTLS connection. * smtp.el (smtp-use-gnutls): New cutomizable variable. (smtp-open-gnutls-starttls-stream): New function. (smtp-submit-package): Respect smtp-use-gnutls's value. (smtp-send-buffer, smtp-send-buffer-by-myself): Do not decide smtp-open-connection-function's value here. (smtp-open-connection): Decide which open-connection-function is called here. Respect smtp-use-gnutls's value. 2011-06-27 Kazuhiro Ito * mel-q.el (quoted-printable-num-to-raw-byte-char): Enclose with eval-and-compile(). 2011-06-24 Kazuhiro Ito * mime-parse.el (mime-encode-parameters-broken-mime): New function. * eword-encode.el (eword-encode-Content-Type-field-body-broken-mime) (eword-encode-Content-Disposition-field-body-broken-mime): New functions. If you want to use them, modify `mime-header-encode-method-alist'. 2011-06-19 Kazuhiro Ito Revert the change of 2004-02-17. * smtp.el (smtp-starttls-program, smtp-starttls-extra-args): Abolished. (smtp-send-buffer): Likewise. 2011-06-09 Kazuhiro Ito * mime.el (mime-entity-filename): When a result is got from entity header, decode it. 2011-06-07 Kazuhiro Ito Merged from rfc2231-encoder branch. * eword-encode.el (eword-encode-Content-Type-field-body) (eword-encode-Content-Disposition-field-body): New functions. * mime-def.el (mime-attribute-char-regexp): Update for RFC2231. (mime-non-attribute-char-regexp): New constant. * mime-parse.el (mime-divide-extended-parameter) (mime-encode-extended-parameter, mime-divide-regular-parameter) (mime-encode-regular-parameter, mime-encode-parameters): New functions. 2011-05-16 David Maus * md4.el (md4-make-step): Use new style backqoutes. Slipped through 2010-11-14. 2010-11-14 HAMANO Kiyoto * sha1-el.el (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1) (sha1-S5, sha1-S30, sha1-OP, sha1-add-to-H): Use new style backquotes. * md5-el.el: Dto. * md4.el (md4-make-step): Dto. * hmac-def.el (define-hmac-function): Dto. * hex-util.el (hex-char-to-num, hex-char-to-char): Dto. * eword-encode.el (make-ew-rword, ew-rword-text) (ew-rword-charset, ew-rword-encoding, ew-rword-type): Dto. 2010-11-13 Kazuhiro Ito * mime-parse.el (mime-uri-parse-cid): Respect mime-field-parser-alist's value. 2010-08-05 Tetsurou Okazaki * smtp.el (smtp-submit-package): Handle the case that `smtp-find-connection' returns nil in unwind forms. 2010-06-21 Katsumi Yamaoka * FLIM-CFG: Add emu subdirectory to load-path when LISPDIR is specified. Suggested by Kazuhiro NISHIYAMA . 2010-03-10 Kazuhiro Ito * mel-q-ccl.el (quoted-printable-ccl-decode-string) (q-encoding-ccl-decode-string): Use ccl-execute-on-string() when encoder for CCL coding system is broken. (quoted-printable-ccl-decode-region) (quoted-printable-ccl-write-decoded-region): Use quoted-printable-ccl-decode-string in the above environment. (TOP): Check facility for them. Another check for decoder for ccl coding system is added. * mel-q.el (quoted-printable-num-to-raw-byte-char): New inline function. (quoted-printable-internal-decode-region) (q-encoding-decode-string): Use it. 2010-02-20 Kazuhiro Ito * mel-q-ccl.el (quoted-printable-ccl-encode-string) (quoted-printable-ccl-insert-encoded-file) (q-encoding-ccl-encode-string): Change branches to facility based. (TOP): Check facility for them. 2010-02-18 Kazuhiro Ito * mel-q-ccl.el (quoted-printable-ccl-encode-string) (quoted-printable-ccl-insert-encoded-file) (q-encoding-ccl-encode-string): Make new vector instead of use of the one that is hard-coded in the program. 2010-02-14 Tetsurou Okazaki * smtp.el (smtp-primitive-mailfrom): Fixed two spaces may be used as a separator before "BODY=8BITMIME". 2010-02-09 Kazuhiro Ito * mel-q-ccl.el (quoted-printable-ccl-encode-string) (quoted-printable-ccl-insert-encoded-file) (q-encoding-ccl-encode-string): Use ccl-execute-on-string() on Emacs 23.1. (quoted-printable-ccl-encode-region): Use quoted-printable-ccl-encode-string() on Emacs 23.1. 2010-01-25 Kazuhiro Ito * mel-q-ccl.el (mel-ccl-encode-quoted-printable-generic): Output invalid character as is. 2010-01-24 Kazuhiro Ito * mel.el (8bit-write-decoded-region): Use no-conversion coding system for writing. * mel-q.el (quoted-printable-quote-char) (quoted-printable-internal-encode-region): Support Emacs 23 raw-byte characters in multibyte string. * mel-q-ccl.el (mel-ccl-decode-q) (mel-ccl-encode-q-generic) (mel-ccl-encode-quoted-printable-generic): Ditto. (quoted-printable-ccl-write-decoded-region): Use LF eol coding system explicitly. 2008-11-25 Katsumi Yamaoka * eword-decode.el (eword-decode-string, eword-decode-region): Mention language info in doc string. 2008-11-25 Katsumi Yamaoka * eword-decode.el (eword-decode-string, eword-decode-region) (eword-analyze-encoded-word): Express the language portion of an encoded word as a symbol. * tests/test-rfc2231.el (test-rfc2231-encoded-word-1) (test-rfc2231-encoded-word-2, test-rfc2231-encoded-word-3): Use eword-decode-string instead of eword-decode-encoded-word. 2008-09-20 Yoichi NAKAYAMA * mel-q-ccl.el (mel-ccl-256-to-16-table): Accept (illegal) lower case representation for decoding. 2007-11-28 MORIOKA Tomohiko * FLIM: Version 1.14.9 (Gojō) released. 2006-12-20 MORIOKA Tomohiko * mime-def.el (mime-library-product): Update to 1.14.9. 2007-06-18 Wencheng Fang * mel.el (mime-write-decoded-region): Define method function that uses built-in base64-decode-region. [cf. ] 2006-12-20 MORIOKA Tomohiko * README.ja, README.en (Installation): Update required version of APEL to 10.7 or later. * FLIM-CFG (PACKAGEDIR): Use `install-get-default-package-directory'. 2006-12-13 Katsumi Yamaoka * FLIM-CFG (PACKAGEDIR): Avoid an error with Emacs. 2006-12-12 Katsumi Yamaoka * FLIM-MK (compile-flim-package): Use batch-update-directory-autoloads if it is available instead of batch-update-directory. 2006-12-11 Katsumi Yamaoka * FLIM-CFG (PACKAGEDIR): Check for (early|late|last)-package-hierarchies and configure-package-path as well as (early|late|last)-packages. 2006-09-24 Daiki Ueno * smtp.el (smtp-progress-message-format): Abolished; reverted the change 2004-08-11 Katsumi Yamaoka . 2006-09-24 Daiki Ueno * smtp.el (smtp-end-of-line): Abolished; reverted the change 2002-07-24 Katsumi Yamaoka . 2006-06-15 Yoichi NAKAYAMA * smtp.el (smtp-submit-package): Ignore error in `smtp-primitive-quit' where SMTP mail transaction is completed. 2006-06-12 Hiroya Murata * mel-b-ccl.el (base64-ccl-insert-encoded-file): Use `insert-file-contents-as-binary' instead of `insert-file-contents'. * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): Likewise. 2006-02-18 Hiroya Murata * smtp.el (smtp-debug): New user option. (smtp-read-response): Treat a line break code loosely. If smtp-debug is non-nil, show an invalid response. 2005-12-25 Katsumi Yamaoka * eword-decode.el: Change the way to decode successive encoded-words: decode B- or Q-encoding in each encoded-word, concatenate them, and decode it as charset. See the following threads for more information: http://news.gmane.org/group/gmane.emacs.pretest.bugs/thread=9541 http://news.gmane.org/group/gmane.emacs.gnus.general/thread=61176 (eword-decode-allow-incomplete-encoded-text): New variable. (eword-decode-encoded-words): New function. (eword-decode-string): Use it. (eword-decode-region): Use it. (eword-analyze-encoded-word): Use it. (eword-decode-encoded-word): Abolish. (eword-decode-encoded-text): Abolish. (eword-decode-encoded-word-error-handler): Abolish. (eword-warning-face): Abolish. (eword-decode-encoded-word-default-error-handler): Abolish. 2005-12-25 MORIOKA Tomohiko * FLIM: Version 1.14.8 (Shijō) released. 2005-12-25 MORIOKA Tomohiko * mime-def.el (mime-library-product): Update to 1.14.8. 2005-11-13 Yoichi NAKAYAMA * std11.el (std11-addr-to-string): Reconstruct domain literal. From Yuuichi Teranishi [cf. ] 2005-07-25 Daiki Ueno * smtp.el (smtp-read-response): Signal an error if connection is closed while reading response. From Hiroya Murata [cf. ] 2004-11-20 Daiki Ueno * ntlm.el (ntlm-ascii2unicode): Don't apply zerop to a character. (ntlm-smb-hash): Ditto. 2004-10-01 MORIOKA Tomohiko * FLIM: Version 1.14.7 (Sanjō) released. 2004-10-01 MORIOKA Tomohiko * mime-def.el (mime-library-product): Update to 1.14.7. 2004-09-27 Katsumi Yamaoka * mime-en.sgml, mime-ja.sgml (CVS based development): Remove the description about developers' pserver access. 2004-09-02 Katsumi Yamaoka * sha1-dl.el: Don't provide the sha1-dl feature twice. (sha1-region): Allow the optional argument `binary'. (sha1): Ditto. 2004-08-11 Katsumi Yamaoka * smtp.el (smtp-parse-progress-message-format): Fix regexp usage. 2004-08-11 Katsumi Yamaoka * smtp.el (smtp-progress-message-format): New user option. (smtp-primitive-data): Show progress message. (smtp-parse-progress-message-format): New function. (smtp-show-progress-message): New function. (smtp-deduce-address-list): Use insert instead of insert-string. 2004-07-27 Yoichi NAKAYAMA * mel-g.el (gzip64-external-encoder): Change default value to cause more recognizable error. (gzip64-external-decoder): Ditto. 2004-06-09 Yoichi NAKAYAMA * std11.el (std11-parse-word-or-comment-or-period): Renamed from `std11-parse-word-or-comment' and allow period. (std11-parse-phrase): Allow parsing obs-phrase in rfc2822. 2004-05-24 Len Trigg * mime-conf.el (mime-format-mailcap-command): Quote a file name which may contain spaces using `shell-quote-argument' in order to pass it to the shell safely. 2004-05-10 Katsumi Yamaoka * eword-encode.el (mime-encode-header-in-buffer): Don't ignore a space char at the beginning of a field body in order to honor the 76-column rule which is described in RFC 2047 section 2. 2004-04-15 MORIOKA Tomohiko * eword-decode.el (eword-decode-encoded-text): Fix bug when `must-unfold' is specified; eliminate CR too when `must-unfold' is specified. 2004-04-13 Kenichi Okada * mel-u.el (mime-write-decoded-region): Use make-temp-file. (uuencode-external-decode-region): Ditto. 2004-04-12 Kenichi Okada * mel-u.el (mime-write-decoded-region): Use temporary filename. 2004-03-05 Jesper Harder * sha1-el.el (sha1-maximum-internal-length): Doc fix. 2004-02-23 TAKAHASHI Kaoru * lunit.el (lunit-make-test-suite-from-class): Fix regexp. Use "^test" instead of "^test-". 2004-02-19 TAKAHASHI Kaoru * lunit.el (lunit-assert): Avoid double-eval `condtion-expr'. Use ,(not (not condition)) instead of ,condition. 2004-02-18 TAKAHASHI Kaoru * lunit.el (lunit-make-test-suite-from-class): Restrict test method name to test-*. 2004-02-17 Daiki Ueno * smtp.el (smtp-starttls-program): New user option. (smtp-starttls-extra-args): New user option. (smtp-send-buffer): Bind starttls-program and starttls-extra-args. 2004-01-27 Yuuichi Teranishi * mel-q.el (quoted-printable-external-decoder-option-to-specify-file): Accept nil. (mime-write-decoded-region): If the value of the variable `quoted-printable-external-decoder-option-to-specify-file' is nil, write stdout to the output file. * mel-b-el.el (base64-external-decoder-option-to-specify-file): Accept nil. (base64-write-decoded-region): If the value of the variable `base64-external-decoder-option-to-specify-file' is nil, write stdout to the output file. 2004-01-12 Daiki Ueno * sasl.texi: Texinfo markup fixes. From Jesper Harder . 2004-01-07 Katsumi Yamaoka * sha1-el.el (sha1-string-external): Use with-temp-buffer. 2004-01-07 Katsumi Yamaoka * sha1-el.el (sha1-string-external): Make it can return a string in binary form. (sha1-region-external): Ditto. (sha1-string-internal): Ditto. (sha1-region-internal): Ditto. (sha1-region): Ditto. (sha1-string): Ditto. (sha1): Ditto. 2003-12-16 Simon Josefsson * sha1-el.el (autoload): Don't use ignore-errors. (sha1-use-external): Use condition-case. Suggested by Katsumi Yamaoka . 2003-12-15 Simon Josefsson * sha1-el.el (autoload): Ignore errors for executable-find. (XEmacs ecrypto does not require sh-script where executable.el is located.) (sha1-use-external): Likewise. * sha1-el.el (sha1): Add defgroup. (sha1-maximum-internal-length, sha1-program, sha1-use-external) (sha1-program): Use 'sha1sum' from GNU CoreUtils instead of OpenSSL. (sha1): Autoload. 2001-12-29 ShengHuo ZHU * sha1-el.el (sha1-use-external): New variable. (sha1-region): Use it. (sha1-string): Ditto. 2004-01-05 Katsumi Yamaoka * ntlm.el (ntlm-string-as-unibyte): New macro. (ntlm-build-auth-response): Use it. 2004-01-05 Simon Josefsson * ntlm.el: Fix namespace. Change smb-passwd-hash into ntlm-smb-passwd-hash, smb-owf-encrypt into ntlm-smb-owf-encrypt, smb-passwd-hash into ntlm-smb-passwd-hash, smbdes-e-p16 into ntlm-smb-des-e-p16, smbdes-e-p24 into ntlm-smb-des-e-p24, smbhash into ntlm-smb-hash, smb-sp8 into ntlm-smb-sp8, smb-str-to-key into ntlm-smb-str-to-key, smb-dohash into ntlm-smb-dohash, smb-perm1 into ntlm-smb-perm1, smb-perm2 into ntlm-smb-perm2, smb-perm3 into ntlm-smb-perm3, smb-perm4 into ntlm-smb-perm4, smb-perm5 into ntlm-smb-perm5, smb-perm6 into ntlm-smb-perm6, smb-sc into ntlm-smb-sc, smb-sbox into ntlm-smb-sbox, string-permute into ntlm-string-permute, string-lshift into ntlm-string-lshift, string-xor into ntlm-string-xor. Suggested by Jesper Harder . * ntlm.el: Don't include poem. * md4.el (print-int32, print-string-hexa): Remove. Suggested by Jesper Harder . 2003-12-20 MORIOKA Tomohiko * FLIM: Version 1.14.6 (Marutamachi) released. 2003-12-14 MORIOKA Tomohiko * mime-def.el (mime-header-accept-quoted-encoded-words): Change default value to nil. 2003-03-10 MORIOKA Tomohiko * eword-decode.el (eword-analyze-quoted-string): Decode quoted-encoded-words when `mime-header-accept-quoted-encoded-words' is not nil. * mime.el (mime-entity-filename): Decode quoted-encoded-words when `mime-header-accept-quoted-encoded-words' is not nil. * mime-def.el (mime-header-accept-quoted-encoded-words): New user option. 2003-12-14 Tatsuya Kinoshita * eword-encode.el (mime-header-charset-encoding-alist): Add entry for iso-8859-1[45]. 2003-11-13 Yoichi NAKAYAMA * FLIM-ELS (flim-modules): Install mel-b-el also for mel-b-builtin case. (from Tatsuya Kinoshita) 2003-09-18 Yoichi NAKAYAMA * FLIM-ELS (flim-modules): Don't install smtpmail. 2003-04-30 Yoichi NAKAYAMA * std11.el (std11-field-end): Return end of field correctly even in case of existence of invisible header. 2003-02-05 Yoichi NAKAYAMA * eword-encode.el (mime-encode-header-in-buffer): Do not eliminate white spaces. 2002-11-05 MORIOKA Tomohiko * eword-encode.el (tm-eword::words-to-ruled-words): New implementation for UTF-2000 implementations. 2002-12-27 MORIOKA Tomohiko * FLIM: Version 1.14.5 (Demachiyanagi) released. 2002-11-15 Katsumi Yamaoka * smtp.el (smtp-send-buffer): Error if `smtp-server' is nil. 2002-11-15 Yoichi NAKAYAMA * FLIM-ELS (flim-version-specific-modules): Don't install mailcap.el. * FLIM-MK (install-flim): Avoid creating empty directory. 2002-11-06 Yoichi NAKAYAMA * mime-parse.el (mime-parse-buffer): Require mmbuffer. 2002-09-26 TSUCHIYA Masatoshi * luna.el (luna-define-method): Clear method cache of child classes. 2002-09-24 TSUCHIYA Masatoshi * mime-ja.texi (CVS): Escape @. * luna.el (luna-define-method): Fix the bug that method cache is not cleard. 2002-09-14 KOSEKI Yoshinori * mime-en.texi (CVS): Fix Typo. (@ to @@). mime-ja.texi (CVS): Ditto. 2002-08-26 MORIOKA Tomohiko * std11.el: Update Copyright header. 2002-07-30 MORIOKA Tomohiko * std11.el (std11-non-atom-regexp): New constant. (std11-analyze-atom): New implementation to avoid error in current XEmacs UTF-2000 [may be caused by a bug about regexp]. 2002-07-26 Katsumi Yamaoka * smtp.el (smtp-open-connection-function): Add doc. (smtp-end-of-line): Doc fix. 2002-07-24 Katsumi Yamaoka * smtp.el (smtp-end-of-line): New variable. (smtp-read-response): Use it. (smtp-send-command): Use it. (smtp-send-data): Use it. 2002-06-03 MORIOKA Tomohiko * FLIM: Version 1.14.4 (Kashiharajingū-mae) released. 2002-01-16 Hiroya Murata * luna.el (luna-class-find-member): Don't search parents' method-spaces. 2002-02-01 Kenichi OKADA * eword-encode.el (mime-header-encode-method-alist): New variable. (mime-encode-field-body): Use `mime-header-encode-method-alist'. (mime-encode-header-in-buffer): Error if cannot encode. 2001-11-19 Kenichi OKADA * smtp.el (smtp-find-server): Fix. 2001-11-18 Kenichi OKADA * smtp.el (smtp-send-by-myself): Fix. 2001-11-18 Kenichi OKADA * smtp.el (smtp-send-by-myself): New variable. (smtp-use-starttls-ignore-error): New variable. (smtp-find-mx): New function. (smtp-dig): New function. (smtp-find-server): New function. (smtp-send-buffer-by-myself): New funcion. (smtp-send-buffer): Change for `smtp-send-buffer-by-myself'. 2001-11-03 Shuhei KOBAYASHI * hmac-md5.el: Removed kludge for Emacs 21 prerelease versions. 2001-09-21 Kenichi OKADA * smtp.el(smtp-submit-package): Check extensions for starttls. 2001-07-16 Katsumi Yamaoka * smtpmail.el (smtpmail-send-it): Work even if the first line of the subject field has no content (synch with Emacs 20.3). 2001-07-30 AMAKAWA Shuhei * smtp.el (smtp-submit-package): Send EHLO after starttls. 2001-06-01 MORIOKA Tomohiko * FLIM: Version 1.14.3 (Unebigoryōmae) released. 2001-06-01 Katsumi Yamaoka * mel-b-el.el: Require `pces' for the macro `as-binary-process' when compiling. * mel-q.el: Add a comment that the feature `poem' is also required for the macro `as-binary-process'. 2001-05-31 Shuhei KOBAYASHI Merged MIME Parameter Value decoder. * mime-parse.el (mime-decode-parameters): Renamed from `mime-decode-parameter-plist'. (mime-decode-parameter-alist): Removed. (mime-decode-alist-to-plist): Ditto. * FLIM-API.en (mime-entity-encoding): Abolish optional argument `default-encoding'. (mime-parse-Content-Tranfer-Encoding): Ditto. 2001-05-02 Shuhei KOBAYASHI * eword-decode.el (eword-decode-encoded-word): Don't use `let'. * mime-parse.el (mime-decode-parameter-plist): Modified description of return value. (mime-parse-Content-Type): Ditto. (mime-read-Content-Type): Ditto. (mime-parse-Content-Disposition): Ditto. (mime-read-Content-Disposition): Ditto. (mime-parse-Content-Transfer-Encoding): Ditto. (mime-read-Content-Transfer-Encoding): Ditto. 2001-05-01 Shuhei KOBAYASHI * mime-parse.el (mime-parse-parameters): Don't use `equal' for strings. (mime-parse-Content-Type): Ditto. 2001-04-30 Shuhei KOBAYASHI * mime-parse.el (mime-decode-parameter-value): Use one temporary buffer. (mime-decode-parameter-plist): Changed internal data structure. 2001-04-28 Shuhei KOBAYASHI * eword-decode.el (eword-encoded-word-regexp): Match for language. (eword-decode-region): Refer the 7th parens, not 6th. (eword-decode-encoded-word): Extract language information. (eword-decode-encoded-text): New optional argument `language'. * mime-def.el (mime-charset-regexp): Updated for RFC2231. * mime-parse.el (mime-decode-parameter-plist): Fix regexp. Use symbol for language information. * tests/test-rfc2231.el: Renamed all testcases. 2001-04-27 Shuhei KOBAYASHI * mime-parse.el (mime-decode-parameter-value): Don't use `int-char'. 2001-04-27 Shuhei KOBAYASHI * mime.el (mime-entity-read-field): Would capitalize twice. * mmbuffer.el (mime-entity-fetch-field): Ditto. * mmexternal.el (mime-entity-fetch-field): Ditto. * mmgeneric.el (mime-entity-fetch-field): Ditto. 2001-04-26 Shuhei KOBAYASHI * mime-parse.el (mime-decode-parameter-plist): Modified description of return value. (mime-parse-Content-Type): Ditto. (mime-read-Content-Type): Ditto. (mime-parse-Content-Disposition): Ditto. (mime-read-Content-Disposition): Ditto. (mime-read-Content-Transfer-Encoding): Ditto. 2001-04-25 Shuhei KOBAYASHI * mime-parse.el (mime-lexical-analyze): Removed comments. 2001-04-22 Shuhei KOBAYASHI * mime-parse.el (mime-decode-parameter-value): New implementation; use temporary buffer for conversion. (mime-decode-parameter-encode-segment): Ditto. (mime-decode-parameter-plist): Would put empty language info. * test/test-rfc2231.el (test-rfc2231-10, test-rfc2231-11, test-rfc2231-12): New testcases for language info. 2001-04-22 Shuhei KOBAYASHI * mime-parse.el: Fixed comments. * test/test-rfc2231.el (test-rfc2231-9): New testcase. 2001-04-22 Shuhei KOBAYASHI * test/test-rfc2231.el (test-rfc2231-7, test-rfc2231-8): New testcases. 2001-04-22 Shuhei KOBAYASHI * mime-def.el (mime-content-type-parameter): Expand `mime-content-type-parameters'. * mime-parse.el (mime-parse-Content-Disposition): Add description of return value to the docstring. (mime-parse-Content-Transfer-Encoding): Ditto. * test/test-rfc2231.el: Made independent of internal representation of Content-Type. 2001-04-22 Shuhei KOBAYASHI * FLIM-MK (check-flim): Limit filename of test files. * test/test-rfc2231.el: New file. 2001-04-19 Shuhei KOBAYASHI * mime-parse.el (mime-decode-parameter-plist): Shortcut for parameters without extensions. 2001-04-19 Shuhei KOBAYASHI * mime-def.el (make-mime-content-type): Don't reverse parameters. (make-mime-content-disposition): New function. * mime-parse.el (mime-decode-parameter-value): Removed comments. (mime-decode-parameter-encode-segment): New function. (mime-decode-parameter-plist): New implementation. Switched from decode-then-concat to concat-then-decode model. (mime-parse-parameters): Strip quoted-pair in quoted-string. (mime-parse-Content-Type): Use `make-mime-content-type'. (mime-parse-Content-Disposition): Use `make-mime-content-disposition'. 2001-04-15 Shuhei KOBAYASHI * eword-decode.el (eword-lexical-analyze-internal): Fix typo. [cf. ] 2001-04-11 Shuhei KOBAYASHI * mime-parse.el (mime-decode-parameter-value): Allow lowercase. (mime-decode-parameter-plist): Ditto. 2001-04-10 Akihiro Arisawa * std11.el (std11-lexical-analyze): Fix typo. 2001-04-01 Daiki Ueno * lunit.el (lunit-test-listener-*): Abolish generic interface. (lunit-test-result-notify): New function. (lunit-test-result-run): Use it. (lunit-test-result-error): Use it. (lunit-test-result-failure): Use it. (lunit-create-index-function): New function. (lunit-generate-template): New command. 2001-03-19 Shuhei KOBAYASHI * hmac-md5.el, hmac-sha1.el: Revert to load-time check. Don't require 'poe. 2001-03-18 Shuhei KOBAYASHI * mel-b-dl.el: Don't do `dynamic-call' at compile-time. (base64-dl-handle): Don't eval at compile-time. 2001-03-18 Shuhei KOBAYASHI * hmac-md5.el, sha1.el: Update Copyright header. 2001-03-18 Shuhei KOBAYASHI Support for built-in `md5' of Emacs 21. * md5.el (md5-dl-module): Moved from md5-dl.el. Use it for test whether to require 'md5-dl. * md5-dl.el: Removed hack for compiler. (md5-dl-handle): Do `dynamic-link' unconditionally. (md5-region): Not interactive. (md5): Removed autoload cookie. * sha1.el: Removed hack for compiler. Use `sha1-dl-module' for test whether to require 'sha1-dl. (sha1-encode, sha1-encode-binary): Removed compatibility code for another sha1.el since it was broken. * sha1-dl.el: Removed hack for compiler. (sha1-dl-handle): Do `dynamic-link' unconditionally. 2001-03-18 Shuhei KOBAYASHI * hmac-md5.el: Require 'poe. Provide 'md5 if built-in `md5' is found. (md5-binary): Define with `defun-maybe-cond'. (md5-binary) [v21]: Removed extra arguments. (hmac-md5-96): New function. * hmac-sha1.el: Require 'poe. (sha1-binary): Define with `defun-maybe'. (hmac-sha1-96): New function. 2001-03-11 Shuhei KOBAYASHI * mel-g.el: Update Copyright header. 2001-03-09 Akihiro Arisawa * mime.el (mime-find-root-entity): Find root recursively. 2001-02-26 Shuhei KOBAYASHI * hmac-md5.el, hmac-sha1.el: Modify comments. 2001-02-25 Shuhei KOBAYASHI * hex-util.el, hmac-def.el, hmac-md5.el, hmac-sha1.el, md5-dl.el, md5.el, sha1-dl.el, sha1-el.el, sha1.el: Update Copyright header. 2001-02-28 Shuhei KOBAYASHI * mime-parse.el (mime-decode-parameter-plist, mime-decode-parameter-alist, mime-decode-parameters): Add doc string. 2001-02-28 Shuhei KOBAYASHI * mime-parse.el (mime-decode-parameter-value): Decode MIME charset in multibyte buffer. [cf. ] (mime-decode-parameter-plist): Downcase attributes. [cf. ] (mime-decode-parameters): Alias for `mime-decode-parameter-plist' instead of `mime-decode-parameter-alist'. Add autoload cookie. (mime-parse-parameters-from-list): Make obsolete. (mime-parse-parameters): Return results as a plist. (mime-parse-Content-Type, mime-read-Content-Type): Moved type check to the caller side. (mime-parse-Content-Disposition, mime-read-Content-Disposition): Ditto. (mime-parse-Content-Transfer-Encoding, mime-read-Content-Transfer-Encoding): Ditto. 2001-02-27 Shuhei KOBAYASHI MIME Parameter Value decoder support. * mime-def.el (std11-quoted-pair-regexp, std11-non-qtext-char-list, std11-qtext-regexp, std11-quoted-string-regexp): Removed. (mime-media-type/subtype-regexp): Ditto. (mime-attribute-char-regexp, mime-language-regexp, mime-encoding-regexp): New constants. * mime-parse.el (mime-lexical-analyze): New function. (mime/content-parameter-value-regexp, mime::parameter-regexp): Removed. (mime-parse-parameter): Ditto. (mime-decode-parameter-value, mime-decode-parameter-plist, mime-parse-alist-to-plist, mime-decode-parameter-alist): New functions. (mime-parse-parameters-from-list): New alias for `mime-decode-parameter-plist'. (mime-decode-parameters): New alias for `mime-decode-parameter-alist'. (mime-parse-parameters): New function. (mime-disposition-type-regexp): Removed. (mime-parse-Content-Type, mime-parse-Content-Disposition, mime-parse-Content-Transfer-Encoding): New implementation. (mime-read-Content-Type, mime-read-Content-Disposition, mime-read-Content-Transfer-Encoding): Ditto. 2001-02-26 Shuhei KOBAYASHI * hmac-md5.el, hmac-sha1.el: Modify comments. 2001-02-25 Shuhei KOBAYASHI * hex-util.el, hmac-def.el, hmac-md5.el, hmac-sha1.el, md5-dl.el, md5.el, sha1-dl.el, sha1-el.el, sha1.el: Update Copyright header. 2001-02-20 Kenichi OKADA * tests/test-sasl.el(test-sasl-ntlm-imap): Fix `sasl-read-passphrase' 2001-02-20 Kenichi OKADA * tests/test-sasl.el(test-sasl-ntlm-imap): Change name. Delete wrong lines. 2001-02-20 Taro Kawagishi * tests/test-sasl.el(test-sasl-digest-ntlm-imap): New test. 2001-02-17 Kenichi OKADA * sasl-ntlm.el(sasl-ntlm-response): self-Hash. 2001-02-17 Kenichi OKADA * ntlm.el(smb-passwd-hash): Fix `upcase' for XEmacs. 2001-02-17 Kenichi OKADA * ntlm.el(TopLevel): Require `poem' (ntlm-build-auth-request): Omit `request-bufIndex' (ntlm-build-auth-response): Omit `response', `ident' and `msgType' Use `string-as-unibyte' of `poem'. 2001-02-17 Kenichi OKADA * sasl-scram.el(sasl-scram-md5-parse-server-msg-1): Error if server's response cannot be parsed. 2001-02-17 Kenichi OKADA * sasl-scram.el(sasl-scram-md5-server-salt): New function. (sasl-scram-md5-response-2): Use `sasl-scram-md5-server-salt' 2001-02-17 Kenichi OKADA * sasl-scram.el(sasl-scram-md5-make-unique-nonce): Rewrite. 2001-02-17 Kenichi OKADA * sasl-scram.el: Add comment. (sasl-scram-md5-steps): New variable. (sasl-scram-md5-make-client-msg-1): Add optional nonce. (sasl-scram-md5-make-client-msg-2): New function. (sasl-scram-md5-make-server-msg-2): Rewrite. (sasl-scram-md5-response-1): New function. (sasl-scram-md5-response-2): New function. (sasl-scram-md5-authenticate-server): New function. * test/test-sasl.el(test-sasl-scram-md5-imap): New function. 2001-02-16 Kenichi OKADA * sasl-scram.el: rename from scram-md5.el (TopLevel): Provide `sasl-scram'. Fix prefix. Fix comments. require `sasl'. (sasl-scram-make-unique-nonce): use `sasl-unique-id'. (sasl-scram-md5-unique-id-function): New variable. * sasl.el(sasl-mechanisms): Add SCRAM-MD5. (sasl-mechanism-alist): Ditto. 2001-02-16 Kenichi OKADA * md4.el(md4-pack-int16): Taken form ntlm.el (md4-pack-int32): Ditto. (md4-unpack-int16): Ditto. (md4-unpack-int32): Ditto. * ntlm.el (pack-int16): Delete. (pack-int32): Delete. (unpack-int16): Delete. (unpack-int32): Delete. 2001-02-16 Kenichi OKADA * sasl.el(sasl-mechanisms): Add NTLM. (sasl-mechanism-alist): Add NTLM. 2001-02-16 Kenichi OKADA * test/test-sasl.el: New file. 2001-02-16 Taro Kawagishi * md4.el: New file. * ntlm.el: New file. * sasl-ntlm.el: New file. 2000-12-27 MORIOKA Tomohiko * mime-conf.el (mime-mailcap-file): Turn to non user option. 2000-12-25 MORIOKA Tomohiko * FLIM: Version 1.14.2 (Yagi-Nishiguchi) released. 2000-12-23 MORIOKA Tomohiko * smtpmail.el (smtpmail-send-it): Use `binary-write-decoded-region' instead of `binary-write-region'. * mmexternal.el (mmexternal-require-buffer): Use `binary-insert-encoded-file' instead of `binary-insert-file-contents'. (mime-write-entity-body): Use `binary-write-decoded-region' instead of `binary-write-region'. * mmbuffer.el (mime-write-entity-body): Use `binary-write-decoded-region' instead of `binary-write-region'. * mel.el: - Don't require `raw-io'. (8bit-insert-encoded-file): New function. (8bit-write-decoded-region): New function. (7bit-insert-encoded-file): New alias. (7bit-write-decoded-region): New alias. (binary-insert-encoded-file): New alias. (binary-find-file-noselect): New function. (binary-funcall): New function. (binary-to-text-funcall): New function. (mime-insert-encoded-file of "base64"): Use `binary-insert-encoded-file' instead of `binary-insert-file-contents'. * FLIM-API.en (base64-decode-string): New function. (base64-encode-string): New function. (ENCODING-write-decoded-region): New function. (ENCODING-insert-encoded-file): New function. * raw-io.el: Deleted. * FLIM-ELS (flim-modules): Delete `raw-io'. 2000-12-22 MORIOKA Tomohiko * smtp.el (smtp-open-connection-function): Revert initial value to `open-network-stream'. (qmtp-open-connection): Use `binary-funcall'. * qmtp.el (qmtp-open-connection-function): Revert initial value to `open-network-stream'. (qmtp-send-buffer): Use `binary-funcall'. 2000-12-23 OKAZAKI Tetsurou * FLIM-ELS (flim-modules): Delete `mmdbuffer'. 2000-12-22 MORIOKA Tomohiko * FLIM: Version 1.14.1 (Yagi) released. 2000-12-22 Keiichi Suzuki * mel-q.el: Require `poem' for `string-to-char-list' when compiling. 2000-12-22 MORIOKA Tomohiko * eword-decode.el (eword-decode-header): Revert to obsolete alias. 2000-12-22 MORIOKA Tomohiko * mmgeneric.el: Add comment for eword-decode. 2000-12-21 MORIOKA Tomohiko * mailcap.el: Require `poe' for `define-obsolete-function-alias'. 2000-12-21 Daiki Ueno * smtp.el (smtp-send-buffer): Add DOC. (smtp-via-smtp): Add DOC. * FLIM-API.en (QMTP): Remove section. (smtp-send-buffer): Add description. (smtp-via-smtp): Likewise. 2000-12-20 MORIOKA Tomohiko * FLIM: Version 1.14.0 (Ninokuchi) released. * mime.el (mime-entity-media-type): Add DOC. (mime-entity-media-subtype): Add DOC. (mime-entity-parameters): Add DOC. (mime-entity-type/subtype): Add DOC. * FLIM-API.en: Add some usages. (mime-entity-media-type): New description. (mime-entity-media-subtype): Likewise. (mime-entity-type/subtype): Likewise. (mime-entity-parameters): Likewise. 2000-12-20 MORIOKA Tomohiko * eword-encode.el (eword-encode-text): Specify `mode' of `encoded-text-encode-string'. * mel.el (encoded-text-encode-string): Add optional argument `mode'; use `base64-encode-string' directly for "B"-encoding. 2000-12-20 MORIOKA Tomohiko * FLIM-API.en: Renamed from FLIM-1.14-API.en; reordered and add some sections. * mime.el (mime-entity-set-content-type): Add DOC. (mime-entity-set-encoding): Add DOC. * mime-def.el (mime-content-type-subtype): Fix DOC. (mime-content-type-parameters): Fix DOC. 2000-12-19 MORIOKA Tomohiko * FLIM-1.14-API.en: New file. * smtp.el (smtp-open-connection-function): Add autoload cookie. * qmtp.el (qmtp-open-connection-function): Add autoload cookie. * mime.el (mime-entity-children): Add DOC. (mime-entity-node-id): Add DOC. (mime-entity-content-type): Add DOC. (mime-entity-content-disposition): Add DOC. (mime-entity-encoding): Add DOC. 2000-12-19 MORIOKA Tomohiko * mime.el (mime-encode-field-body): Add autoload setting. * eword-encode.el (mime-encode-field-body): Renamed from `eword-encode-field-body'; declare `eword-encode-field-body' as obsolete alias. (mime-encode-header-in-buffer): Use `mime-encode-field-body' instead of `eword-encode-field-body'. 2000-12-19 MORIOKA Tomohiko * mime.el (mime-encode-header-in-buffer): Renamed from `eword-encode-header'. * mmdbuffer.el: Deleted. * mime-def.el (mime-header): New group. (mime-field-decoding-max-size): New user option [moved from eword-decode.el]. (mime-field-encoding-method-alist): New user option [moved from eword-encode.el]. * eword-encode.el (eword-field-encoding-method-alist): Moved to mime-def.el and renamed to `mime-field-encoding-method-alist'. (mime-header-charset-encoding-alist): Renamed from `eword-charset-encoding-alist'. (mime-header-default-charset-encoding): New variable. (ew-find-charset-rule): Use `mime-header-default-charset-encoding'. (eword-in-subject-p): Declare as obsolete function. (mime-encode-header-in-buffer): Renamed from `eword-encode-header'; declare `eword-encode-header' as obsolete alias. * eword-decode.el (eword-max-size-to-decode): Moved to mime-def.el and renamed to `mime-field-decoding-max-size'. (mime-header-lexical-analyzer): Renamed from `eword-lexical-analyzer'; switch to variable. * FLIM-ELS (flim-modules): Add `raw-io'. 2000-12-19 MORIOKA Tomohiko * eword-encode.el (eword-encode-default-start-column): Switch to variable. 2000-12-19 MORIOKA Tomohiko * raw-io.el (start-process): New function. (binary-start-process-shell-command): New function. 2000-12-17 MORIOKA Tomohiko * mel-g.el (gzip64-external-encode-region): Don't use `as-binary-process'; comment out code to regularize line break code for OS/2 [if it is needed, it is better to implement by coding-system]. (gzip64-external-decode-region): Don't use `as-binary-process'. (mime-write-decoded-region): Likewise. * mime-parse.el: Require `luna'. 2000-12-16 MORIOKA Tomohiko * eword-encode.el (eword-encode-divide-into-charset-words): Use `aref' instead of `sref'. (ew-encode-rword-1): Use `1+' instead of `char-next-index'. (eword-encode-phrase-to-rword-list): Use `find-charset-string' instead of `find-non-ascii-charset-string'. (eword-encode-addr-seq-to-rword-list): Don't use `butlast'. (eword-encode-header): Use `find-charset-region' instead of `find-non-ascii-charset-string'. * mel.el: Require `raw-io'. * mime-def.el (binary-insert-file-contents): Moved to raw-io.el. (binary-write-region): Likewise. * mmbabyl.el (mime-write-entity): Use `raw-message-write-region' instead of `write-region-as-raw-text-CRLF'. * raw-io.el: New file. * smtpmail.el: - Require `raw-io'. - Delete definition of obsolete variable aliases for XEmacs. (smtpmail-send-queued-mail): Use `binary-find-file-noselect' instead of `find-file-noselect-as-binary'. * smtp.el (smtp-open-connection-function): Use `binary-open-network-stream' instead of `open-network-stream' as initial value. (smtp-open-connection): Don't guard as `binary'. * qmtp.el (qmtp-open-connection-function): Use `binary-open-network-stream' instead of `open-network-stream' as initial value. (qmtp-send-buffer): Don't guard as `binary'. 2000-12-15 MORIOKA Tomohiko * mime/eword-decode.el: Don't use `define-obsolete-function-alias'; so `eword-decode-header' is deleted. * mime/mmexternal.el: Don't require `pces'. 2000-12-15 TAKAHASHI Kaoru * Makefile (tar): Use `cvs tag -R' instead of `cvs tag -RF'. 2000-12-15 MORIOKA Tomohiko * mime-def.el (char-int): New alias. * eword-encode.el (eword-encode-divide-into-charset-words): Don't use `char-length' and `char-next-index'. 2000-12-15 Katsumi Yamaoka * eword-decode.el: Fix typo in doc-string of `mime-set-field-decoder'. 2000-12-15 MORIOKA Tomohiko * mel.el: Don't require `path-util'. 2000-12-15 MORIOKA Tomohiko * std11.el, smtpmail.el, mime-def.el: Don't require `poe'. * mel.el: Don't require `poem'. 2000-12-14 MORIOKA Tomohiko * mmexternal.el (mime-write-entity): Don't use `write-region-as-raw-text-CRLF'. (mmexternal-require-buffer): Use `binary-insert-file-contents' instead of `insert-file-contents-as-binary'. (mime-write-entity-body): Use `binary-write-region' instead of `write-region-as-binary'. * smtpmail.el (smtpmail-send-it): Use `binary-write-region' instead of `write-region-as-binary'. * smtp.el (smtp-open-connection): Don't use `as-binary-process'. * mel.el (mime-insert-encoded-file of "base64"): Use `binary-insert-file-contents' instead of `insert-file-contents-as-binary'. (mime-insert-encoded-file of "7bit"): Use `binary-insert-file-contents' instead of `insert-file-contents-as-binary'. (mime-write-decoded-region of "7bit"): Use `binary-write-region' instead of `write-region-as-binary'. * mmbuffer.el (mime-write-entity-body): Use `binary-write-region' instead of `write-region-as-binary'. (mime-write-entity): Don't use `write-region-as-raw-text-CRLF'. * mime-def.el: Don't require `poem'. (binary-insert-file-contents): New function. (binary-write-region): New function. * mel-u.el (uuencode-external-encode-region): Don't use `as-binary-process'. (uuencode-external-decode-region): Don't use `as-binary-process' and `as-binary-input-file'. (mime-write-decoded-region): Don't use `as-binary-process'. * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): Don't use `insert-file-contents-as-coding-system'. (quoted-printable-ccl-write-decoded-region): Don't use `write-region-as-coding-system'. * mel-b-ccl.el (base64-ccl-insert-encoded-file): Don't use `insert-file-contents-as-coding-system'. (base64-ccl-write-decoded-region): Don't use `write-region-as-coding-system'. * std11.el: Don't require `poem'. (std11-parse-ascii-token): Don't use `find-non-ascii-charset-string'. * qmtp.el: Don't require `poem'. (qmtp-send-buffer): Don't use `as-binary-process'. 2000-12-14 MORIOKA Tomohiko * mime-def.el, qmtp.el, smtp.el, smtpmail.el, std11.el: Require `custom' instead of `pcustom'. 2000-12-12 Daiki Ueno * sasl.el: Rewrite with luna. 2000-12-06 Daiki Ueno * FLIM-ELS: Don't install md5-dl.el, md5-el.el, sha1-dl.el and sha1-el.el if the running emacs has builtin message digest functions. * md5-dl.el, sha1-dl.el: Don't bind `dynamic-link' and `dynamic-call'. * md5.el (md5-dl-module): Moved from md5-dl.el. * sha1.el: Don't bind `sha1-string'. 2000-12-04 Daiki Ueno * README.ja, README.en (load-path): Remove section. (What's FLIM): Specify prerequisite version of Emacsen. 2000-11-21 Daiki Ueno * sasl.el (sasl-client-set-encoder): New function. (sasl-client-set-decoder): New function. (sasl-client-encoder): New function. (sasl-client-decoder): New function. * sasl-digest.el: Require 'cl' when compiling. (sasl-digest-md5-signing-encode-magic): New constant. (sasl-digest-md5-signing-decode-magic): New constant. (sasl-digest-md5-htonl-string): New function. (sasl-digest-md5-make-integrity-encoder): New function. (sasl-digest-md5-make-integrity-decoder): New function. (sasl-digest-md5-ha1): New function. (sasl-digest-md5-response-value): Accept the 1st argument `ha1'. (sasl-digest-md5-response): Use `sasl-digest-md5-ha1'. - Set integrity encoder and decoder of the client. * smtp.el: Require `luna'. (smtp-read-response): Accept `smtp-connection' object rather than process-object. (smtp-send-command): Likewise. (smtp-send-data): Likewise. 2000-11-10 Daiki Ueno * tests/test-sasl.el (test-sasl-digest-md5-imap): New testcase. (test-sasl-digest-md5-acap): New testcase. 2000-11-10 Daiki Ueno * lunit.el (lunit-make-test-suite-from-class): New function. (lunit-class): Abolish. (lunit-test-results-buffer): Abolish. * FLIM-ELS (check-flim): New function. * Makefile (check): New target. * tests: New directory. 2000-11-09 Daiki Ueno * lunit.el (lunit-test-method-regexp): New variable. (lunit-class): New function. 2000-11-09 Daiki Ueno * lunit.el: New file. 2000-12-13 Kenichi Handa * luna.el: Fix and add DOCs and comments; fix coding style. 2000-12-09 MORIOKA Tomohiko * mmbuffer.el (mmbuffer-parse-multipart): Add new optional argument `representation-type'. (mmbuffer-parse-encapsulated): Likewise. 2000-12-07 MORIOKA Tomohiko * mmexternal.el: Must require `mmgeneric'. * sha1.el: Don't use `defun-maybe'. 2000-12-04 Daiki Ueno * luna.el (luna-class-find-functions): Don't quote colon keywords. (luna-send): Ditto. (luna-call-next-method): Ditto. 2000-11-28 Daiki Ueno * luna.el: Don't require `static'. (luna-define-class-function): Don't bind colon keywords. (luna-class-find-functions): Quote colon keywords. (luna-send): Likewise. (luna-call-next-method): Likewise. 2000-11-12 Daiki Ueno * luna.el (luna-define-method): Clear method cache. (luna-apply-generic): New function. (luna-define-generic): Use `luna-apply-generic' instead of `luna-send'. 2000-12-04 Daiki Ueno * smtpmail.el (smtpmail-send-it): Use `smtp-send-buffer' instead of `smtp-via-smtp'. (smtpmail-send-queued-mail): Ditto. 2000-11-24 MORIOKA Tomohiko * FLIM-MK (compile-flim): Compile `flim-version-specific-modules'. (install-flim): Install `flim-version-specific-modules' to `FLIM_VERSION_SPECIFIC_DIR'. (compile-flim-package): Compile `flim-version-specific-modules'. (install-flim-package): Install `flim-version-specific-modules'. * FLIM-ELS (flim-modules): Add `mime-conf' instead of `mailcap'. (flim-version-specific-modules): New variable; specify `mailcap'. * FLIM-CFG (FLIM_VERSION_SPECIFIC_DIR): New variable. * mailcap.el: Completely rewrote to use mime-conf.el. * mime-conf.el: New file. 2000-11-16 Kenichi OKADA * sasl-digest.el (sasl-digest-md5-response): Fix typo. 2000-11-12 Daiki Ueno * smtp.el (smtp-primitive-data): Use `beginning-of-line' instead of `forward-char'. (smtp-read-response): Don't bind `case-fold-search'. (smtp-send-data): Don't save excursion. 2000-11-10 Daiki Ueno * sasl-digest.el (sasl-digest-md5-challenge): Abolish. (sasl-digest-md5-syntax-table): Rename from `sasl-digest-md5-parse-digest-challenge-syntax-table'. (sasl-digest-md5-parse-string): Rename from `sasl-digest-md5-parse-digest-challenge'; only return a property list. (sasl-digest-md5-challenge): Abolish. (sasl-digest-md5-build-response-value-1): Abolish. (sasl-digest-md5-response-value): Define as function. (sasl-digest-md5-response): Rewrite. 2000-11-07 Kenichi OKADA * sasl.el (sasl-login-response-1): Fix. (sasl-login-response-2): Fix. 2000-11-07 Daiki Ueno * smtp.el (smtp-sasl-properties): New user option. (smtp-sasl-user-realm): Abolish. 2000-11-05 Daiki Ueno * qmtp.el (qmtp-send-package): Don't check "K" reply per recipient. (qmtp-via-smtp): Mark as obsolete. (qmtp-send-buffer): New function. * sasl.texi: New file. 2000-11-05 Daiki Ueno * sasl.el (sasl-step-data): New function. (sasl-step-set-data): New function. 2000-11-04 Daiki Ueno * sasl.el: Don't require 'poe' - Rename `sasl-*instantiator*' to `sasl-*client*'. - Rename `sasl-*authenticator*' to `sasl-*mechanism*'. - Rename `sasl-*continuations*' to `sasl-*steps*'. (sasl-make-client): Accept 1st argument `mechanism'. (sasl-next-step): Rename from `sasl-evaluate-challenge'. 2000-11-04 Daiki Ueno * sasl.el (sasl-make-instantiator): Define as function. (sasl-instantiator-name): Ditto. (sasl-instantiator-service): Ditto. (sasl-instantiator-server): Ditto. (sasl-instantiator-set-properties): Ditto. (sasl-instantiator-set-property): Ditto. (sasl-instantiator-property): Ditto. (sasl-instantiator-properties): Ditto. (sasl-authenticator-mechanism): Ditto. (sasl-authenticator-continuations): Ditto. 2000-11-02 Daiki Ueno * sasl.el: Rename `sasl-*principal*' to `sasl-*instantiator*'. (sasl-make-instantiator): Abolish optional 4th argument. (sasl-instantiator-set-properties): New function. (sasl-instantiator-put-property): New function. (sasl-instantiator-property): New function. (sasl-instantiator-properties): New function. * smtp.el (smtp-sasl-user-name): Rename from `smtp-sasl-principal-user'. (smtp-sasl-user-realm): Rename from `smtp-sasl-principal-realm'. 2000-11-02 Daiki Ueno * sasl.el (sasl-mechanisms): Add `LOGIN' and `ANONYMOUS'. (sasl-mechanism-alist): Likewise. (sasl-error): Define. (sasl-login-continuations): New variable. (sasl-login-response-1): New function. (sasl-login-response-2): New function. (sasl-anonymous-continuations): New variable. (sasl-anonymous-response): New function. * smtp.el (smtp-error): Define. (smtp-via-smtp): Use it. 2000-11-02 Daiki Ueno * smtp.el (smtp-via-smtp): Mark as obsolete. (smtp-send-buffer): Rename from `smtp-via-smtp'. 2000-11-02 Daiki Ueno * sasl.el (sasl-make-authenticator): Allocate a freshly generated symbol for each continuation. 2000-11-02 Daiki Ueno * sasl-digest.el (sasl-digest-md5-response-1): Rename from `sasl-digest-md5-digest-response'. (sasl-digest-md5-response-2): New alias. (sasl-digest-md5-parse-digest-challenge): Save excursion. * sasl.el (sasl-mechanism-alist): Rename from `sasl-mechanisms'. (sasl-mechanisms): New variable. (sasl-find-authenticator): Check `sasl-mechanisms' rather than `sasl-mechanism-alist'. * smtp.el (smtp-submit-package): Use `smtp-primitive-ehlo'. (smtp-primitive-auth): Check authenticator. 2000-11-02 Daiki Ueno * FLIM-ELS (hmac-modules): New variable. (flim-modules): Move HMAC modules to `hmac-modules' - Add `sasl-digest'. * smtp.el (smtp-sasl-principal-realm): New user option. * sasl.el (sasl-plain-response): New function. (sasl-mechanisms): Add `DIGEST-MD5' and `PLAIN'. (sasl-unique-id-function): New variable. (sasl-plain-continuations): New variable. (sasl-unique-id): New function. (sasl-unique-id-char): New variable. * sasl-digest.el: New file. 2000-11-01 Daiki Ueno * smtp.el: Bind `sasl-mechanisms'; add autoload settings for `sasl-make-principal', `sasl-find-authenticator', `sasl-authenticator-mechanism-internal' and `sasl-evaluate-challenge'. (smtp-use-sasl): New user option. (smtp-sasl-principal-name): New user option. (smtp-sasl-mechanisms): New user option. (smtp-submit-package): Call `smtp-primitive-starttls' and `smtp-primitive-auth'. (smtp-primitive-ehlo): Don't modify the rest of a extension line. (smtp-primitive-auth): New function. (smtp-primitive-starttls): Check the response code. * sasl.el: New implementation. * sasl-cram.el: New file. * FLIM-ELS (flim-modules): Add `md5', `md5-el', `md5-dl', `hex-util', `hmac-def', `hmac-md5', `sasl' and `sasl-cram'. 2000-11-01 Daiki Ueno * smtp.el: Add autoload settings for `starttls-open-stream' and `starttls-negotiate'. (smtp-connection-set-extensions-internal): New macro. (smtp-connection-extensions-internal): New macro. (smtp-make-connection): Set the `extension' slot to nil. (smtp-primitive-ehlo): New function. (smtp-submit-package): Rename from `smtp-commit'. (smtp-submit-package-function): Rename from `smtp-commit-function'. (smtp-primitive-starttls): New function. (smtp-extensions): New group. (smtp-use-8bitmime): New variable. (smtp-use-size): New variable. (smtp-use-starttls): New variable. (smtp-via-smtp): Bind `smtp-open-connection-function'. 2000-10-31 Daiki Ueno * smtp.el: New implementation. 2000-08-16 Daiki Ueno * FLIM-ELS (flim-modules): Add `qmtp'. * qmtp.el: New file. 2000-08-28 Yuuichi Teranishi * eword-encode.el (eword-encode-mailboxes-to-rword-list): New inline function. (eword-encode-address-to-rword-list): Ditto. (eword-encode-addresses-to-rword-list): Use `eword-encode-address-to-rword-list' instead of `eword-encode-mailbox-to-rword-list'. * std11.el (std11-address-string): Fix for group list. 2000-08-10 MORIOKA Tomohiko * mmgeneric.el: Enclose definition of class `mime-entity' and its internal accessors by `eval-and-compile'. * luna.el: Define `luna-class-name' before it is used in macros. 2000-07-12 MORIOKA Tomohiko * FLIM-Chao: Version 1.14.1 (Rokujizō) released. 2000-07-10 MORIOKA Tomohiko * mmexternal.el (initialize-instance): Deleted. (mmexternal-require-file-name): New function. (mmexternal-require-buffer): Use `mmexternal-require-file-name'. 2000-06-30 MORIOKA Tomohiko * mime.el (mime-entity-read-field): Fix a bug when FIELD-NAME is a string. 2000-06-23 MORIOKA Tomohiko * mmexternal.el (initialize-instance): New method. (mime-entity-name): Fixed. (mmexternal-require-buffer): New function. (mime-insert-entity): New implementation. (mime-write-entity): Likewise. (mime-entity-body): New method. (mime-insert-entity-body): New method. (mime-write-entity-body): New implementation. (mime-entity-content): Likewise. (mime-insert-entity-content): Likewise. (mime-write-entity-content): Likewise. (mime-entity-fetch-field): Likewise. (mime-insert-header): Likewise. * mmbuffer.el (initialize-instance): Store buffer instead of name of buffer to `buffer' slot. 2000-06-21 MORIOKA Tomohiko * mmgeneric.el (mime-entity-children): Deleted. * mmbuffer.el (mime-insert-entity-body): New method. (mmbuffer-parse-multipart): New function. (mmbuffer-parse-encapsulated): New function. (mime-entity-children): New function. 2000-06-21 MORIOKA Tomohiko * mime.el (mime-find-root-entity): New function. (mime-entity-header-buffer): Comment out. (mime-goto-header-start-point): Likewise. (mime-entity-header-start-point): Likewise. (mime-entity-header-end-point): Likewise. (mime-entity-body-buffer): Likewise. (mime-goto-body-start-point): Likewise. (mime-goto-body-end-point): Likewise. (mime-entity-body-start-point): Likewise. (mime-entity-body-end-point): Likewise. (mime-entity-body-start): Likewise. (mime-entity-body-end): Likewise. (mime-entity-buffer): Likewise. (mime-entity-point-min): Likewise. (mime-entity-point-max): Likewise. (mime-insert-entity-body): New generic function. (mime-entity-uu-filename): Use `mime-insert-entity-body'. (mime-entity-set-content-type): New function. (mime-entity-set-encoding): New function. * mime-parse.el (mime-parse-multipart): Comment out. (mime-parse-encapsulated): Likewise. (mime-parse-external): Likewise. * mmbuffer.el (mime-entity-header-buffer): Comment out. (mime-goto-header-start-point): Likewise. (mime-entity-header-start-point): Likewise. (mime-entity-header-end-point): Likewise. (mime-entity-body-buffer): Likewise. (mime-goto-body-start-point): Likewise. (mime-goto-body-end-point): Likewise. (mime-entity-body-start-point): Likewise. (mime-entity-body-end-point): Likewise. (mime-entity-buffer): Likewise. (mime-entity-point-min): Likewise. (mime-entity-point-max): Likewise. 2000-05-30 MORIOKA Tomohiko * eword-encode.el (eword-charset-encoding-alist): Add `iso-2022-jp-3'. 2000-05-25 Tanaka Akira * mime-en.sgml, mime-ja.sgml: Update for CVS via SSH. 2000-05-09 Katsumi Yamaoka * smtp.el (smtp-deduce-address-list): Set `case-fold-search' to `t' in the working buffer. 2000-04-26 Yoshiki Hayashi * mime.el (mime-entity-body): New function. * mmbuffer.el (mime-entity-body): Implement it. 2000-03-03 Keiichi Suzuki * mime.el (mime-entity-node-id): Change to function. 2000-03-03 MORIOKA Tomohiko * mmdbuffer.el, mmbuffer.el (initialize-instance): Don't setup `mime-message-structure'. * mime-parse.el (mime-parse-buffer): Don't setup `mime-message-structure'. 2000-03-02 MORIOKA Tomohiko * mmgeneric.el (mime-visible-field-p): Moved from mmbuffer.el. (mime-insert-header-from-buffer): Moved from mmbuffer.el. * mmexternal.el, mmdbuffer.el, mmbuffer.el (mime-visible-field-p): Moved to mmgeneric.el. (mime-insert-header-from-buffer): Moved to mmgeneric.el. 2000-03-02 MORIOKA Tomohiko * FLIM-ELS (flim-modules): Add `mmgeneric'. * mmgeneric.el: New file. * mmbuffer.el: Require `mmgeneric'. * mime.el: Require `mmgeneric' when compiling. * mime-def.el: Move mime-entity related definitions to mmgeneric.el. 2000-03-01 MORIOKA Tomohiko * mime.el (mime-find-entity-from-number): Now second argument `message' is not an optional argument. (mime-find-entity-from-node-id): Likewise. (mime-find-entity-from-content-id): Likewise. (mime-fetch-field): Delete obsolete function. (mime-read-field): Likewise. 2000-03-01 MORIOKA Tomohiko * mime.el (mime-entity-header-buffer): Mark it as obsolete. (mime-goto-header-start-point): Likewise. (mime-entity-header-start-point): Likewise. (mime-entity-header-end-point): Likewise. (mime-entity-body-start): Use `defalias'; don't recommend to use `mime-entity-body-start-point' instead. (mime-entity-body-end): Use `defalias'; don't recommend to use `mime-entity-body-end-point' instead. (mime-entity-body-buffer): Mark it as obsolete. (mime-goto-body-start-point): Likewise. (mime-goto-body-end-point): Likewise. (mime-entity-body-start-point): Likewise. (mime-entity-body-end-point): Likewise. (mime-entity-buffer): Don't recommend to use `mime-entity-header-buffer' or `mime-entity-body-buffer' instead. (mime-entity-point-min): Don't recommend to use `mime-entity-header-start-point' instead. (mime-entity-point-max): Don't recommend to use `mime-entity-body-end-point' instead. * mime-def.el (mime-library-version): update to 1.14.1. - Add autoload setting for `mime-parse-external'. 2000-03-01 MORIOKA Tomohiko * Chao: Version 1.14.0 (Momoyama) released. 2000-01-05 Katsumi Yamaoka * Makefile, mime-en.sgml, mime-ja.sgml: Update for the new CVS server. 1999-12-20 Katsumi Yamaoka * mel-b-el.el (base64-encode-region): Allow the optional second arg `no-line-break'. (base64-external-encode-region): Likewise. (base64-internal-encode-region): Likewise. (base64-encode-string): Likewise. 1999-12-16 MORIOKA Tomohiko * FLIM-ELS (flim-modules): Add `mmexternal'. * mime-parse.el (mime-parse-external): New function. * mime-def.el (mime-entity-children [mime-entity]): Use `mime-parse-external' for message/external-body. * mmexternal.el: New module. 1999-12-13 Katsumi Yamaoka * README.en, README.ja, mime-en.sgml, mime-ja.sgml: Update for the recent ML address and ftp site. 1999-10-17 Yoshiki Hayashi * FLIM-MK (install-flim-package): Delete auto-autoloads.el and custom-load.el 1999-09-20 Katsumi Yamaoka * mailcap.el (mailcap-look-at-schar): Protect against unexpected eof. [cf. ] 1999-09-13 Katsumi Yamaoka * smtpmail.el (smtpmail-send-it): Remove needless `concat'. 1999-09-08 Yoshiki Hayashi * mime-ja.sgml, mime-en.sgml (Entity creation): Fix typo. 1999-09-01 Katsumi Yamaoka * smtpmail.el (smtpmail-send-it): Make directory `smtpmail-queue-dir' if it does not exist; convert filename of queued mail using `convert-standard-filename'. (smtpmail-queue-index): Treat `smtpmail-queue-dir' as a directory name using `file-name-as-directory'. (smtpmail-queue-dir, smtpmail-queue-mail): Remove "*" from doc strings. 1999-08-26 Katsumi Yamaoka * smtpmail.el (smtpmail-send-it): Use `time-stamp-yyyy-mm-dd' and `time-stamp-hh:mm:ss' instead of `current-time'. 1999-08-25 Katsumi Yamaoka * FLIM-ELS: Use `if' instead of `unless'. 1999-08-17 MORIOKA Tomohiko * FLIM: Version 1.13.2 (Kasanui) released. 1999-08-03 Yuuichi Teranishi * smtp.el (smtp-notify-success): New option. * (smtp-via-smtp): Request return receipt (defined in RFC1891) to SMTP server if `smtp-notify-success' is non-nil. [cf. ] 1999-08-02 MORIOKA Tomohiko * mime.el (mime-entity-header-start-point): New generic function. (mime-entity-header-end-point): New generic function. * mmbuffer.el (mime-entity-header-start-point): New method. (mime-entity-header-end-point): New method. 1999-08-09 MORIOKA Tomohiko * FLIM-ELS (flim-modules): Add `mmdbuffer'. 1999-07-27 MORIOKA Tomohiko * mmdbuffer.el: New module. 1999-07-28 MORIOKA Tomohiko * mime-parse.el: Add autoload setting for `mime-entity-body-buffer', `mime-entity-body-start-point' and `mime-entity-body-end-point'. * mime.el (mime-entity-point-min): Define as an obsolete function. (mime-entity-point-max): Likewise. 1999-07-27 MORIOKA Tomohiko * mmbuffer.el (entity-point-min): Deleted because it is duplicated. (entity-point-max): Deleted because it is duplicated. 1999-07-24 MORIOKA Tomohiko * mmbuffer.el (mime-insert-text-content): Deleted [moved to mime-def.el]. * mime-def.el: Add autoload settings for `mime-entity-content' [to avoid warning]. (mime-insert-text-content): New method of `mime-entity' [moved from mmbuffer.el]. 1999-07-24 MORIOKA Tomohiko * mmbuffer.el (mime-entity-children): Deleted [moved to mime-def.el]. * mime-def.el: Add autoload settings for `mime-entity-content-type', `mime-parse-multipart' and `mime-parse-encapsulated' [to avoid warning]. (mime-entity-children): New method of `mime-entity' [moved from mmbuffer.el]. 1999-07-22 MORIOKA Tomohiko * FLIM: Version 1.13.1 (Tawaramoto) released. 1999-07-21 MORIOKA Tomohiko * mime-parse.el (mime-parse-buffer): Fixed. 1999-07-16 MORIOKA Tomohiko * FLIM: Version 1.13.0 (Iwami) released. 1999-07-09 Nakagawa, Makoto * smtpmail.el (smtpmail-send-it): Use current-time to get rid of time-stamp-strftime. (smtpmail-send-it): Use write-region-as-binary instead of write-file. (smtpmail-send-queued-mail); Use find-file-noselect-as-binary instead of find-file-noselect. 1999-06-23 MORIOKA Tomohiko * FLIM-CFG: Delete code to detect APEL 7.3 or later. 1999-06-16 Katsumi Yamaoka * smtpmail.el (smtpmail-send-it): Extend the search bound to the end of the field for fetching the recipients from Resent-To. 1999-06-11 Katsumi Yamaoka * luna.el (luna-define-class-function): Check for the improbable name of variable beginning with colon whether we should bind the sort of symbol or not. (TopLevel): Likewise. 1999-06-10 Katsumi Yamaoka * luna.el (luna-define-class-function): Bind member variables statically for old Emacsen. (TopLevel): Require `static'; bind `:before', `:after' and `:around' statically for old Emacsen. [cf. ] 1999-06-01 MORIOKA Tomohiko * Chao: Version 1.13.0 (JR Fujinomori) released. 1999-05-29 MORIOKA Tomohiko * mmbuffer.el (mime-entity-fetch-field): New implementation. * mime-def.el (mime-entity-fetch-field): New method of luna-class `mime-entity'. * luna.el (luna-define-method): Allow `:around' qualifier. (luna-class-find-functions): Likewise. (luna-send): Likewise. (luna-call-next-method): New function. 1999-05-26 MORIOKA Tomohiko * mime-def.el (eval-module-depended-macro): Abolished. Use `def-edebug-spec' directly. * luna.el (luna-define-method): Allow `:before' qualifier. (luna-class-find-functions): Likewise. * mime-def.el (mime-message-structure): Define as obsolete variable. 1999-05-26 MORIOKA Tomohiko * mime-parse.el (mime-parse-encapsulated): Use `mime-entity-body-start-point' and `mime-entity-body-end-point'. * mime.el (mime-parse-buffer): Revert to auto-load from "mime-parse". * mime-parse.el (mime-parse-multipart): Move from mime-parse.el again. (mime-parse-encapsulated): Likewise. (mime-parse-message): Likewise. (mime-parse-buffer): Likewise. * mmbuffer.el (mime-parse-multipart): Move to mime-parse.el again. (mime-parse-encapsulated): Likewise. (mime-parse-message): Likewise. (mime-parse-buffer): Likewise. * mmbuffer.el (mime-parse-encapsulated): Run in body-buffer of an entity. 1999-05-26 MORIOKA Tomohiko * mmbuffer.el (initialize-instance): Don't initialize slots if they are initialized. (mime-parse-multipart): Run in body-buffer of an entity. (mime-entity-body-start-point): New method. 1999-05-25 MORIOKA Tomohiko * mmbuffer.el (mime-entity-body-end-point): New method. (mime-goto-header-start-point): New method. (mime-goto-body-start-point): New method. (mime-goto-body-end-point): New method. * mime.el (mime-goto-body-end-point): New generic function. * mel.el (Q-encoded-text-length): Fixed. 1999-05-24 MORIOKA Tomohiko * mmbuffer.el (mime-parse-multipart): Refer body-start instead of header-end. * mmcooked.el (mime-insert-header): Fix typo. 1999-05-23 MORIOKA Tomohiko * mmcooked.el (mime-insert-header): Use `luna-class-find-functions'. * mime.el (mime-entity-buffer): Define as obsolete function. (mime-entity-body-end-point): New generic function; define `mime-entity-body-end' as obsolete function. (mime-goto-body-start-point): New generic function. (mime-entity-uu-filename): Use `mime-goto-body-start-point' and `mime-entity-body-end-point'. * mmbuffer.el (initialize-instance): Define as after method; return initialized instance. * luna.el (luna-define-class): Add `standard-object' as a parent. (luna-define-method): Allow `:after' qualifier. (luna-class-find-parents-functions): New function. (luna-class-find-functions): New function [abolish `luna-class-find-function']. (luna-find-functions): New function [abolish `luna-find-function']. (luna-send): Modify for new method dispatch mechanism. (luna-make-entity): New implementation. (standard-object): New class. (initialize-instance): New method. 1999-05-22 MORIOKA Tomohiko * Delete mmgeneric.el. * mmcooked.el: Modify for mmbuffer.el. * mmbuffer.el: - Don't require `mmgeneric' and `mime-parse'. - Require mime. - Use `luna'. (mime-buffer-entity-buffer-internal): Renamed from `mime-entity-set-buffer-internal'. (mime-buffer-entity-set-buffer-internal): Likewise. (mime-buffer-entity-header-start-internal): Likewise. (mime-buffer-entity-set-header-start-internal): Likewise. (mime-buffer-entity-header-end-internal): Likewise. (mime-buffer-entity-set-header-end-internal): Likewise. (mime-buffer-entity-body-start-internal): Likewise. (mime-buffer-entity-set-body-start-internal): Likewise. (mime-buffer-entity-body-end-internal): Likewise. (mime-buffer-entity-set-body-end-internal): Likewise. (mime-entity-name): New method. (mime-parse-multipart): New function [moved from mime-parse.el]. (mime-parse-encapsulated): Likewise. (mime-parse-message): Likewise. (mime-entity-children): New method. (mime-goto-header-start-point): New method. (mime-visible-field-p): New function [moved from mmgeneric.el]. (mime-insert-header-from-buffer): Likewise. (mime-insert-header): New method. (mime-entity-content): Use `luna-define-method'. (mime-insert-text-content): New method. ((mime-entity-fetch-field): Use `luna-define-method'. (mime-entity-header-buffer): New method. (mime-entity-body-buffer): Likewise. (mime-entity-buffer): Likewise. (mime-entity-point-min): Use `luna-define-method'. (mime-entity-point-max): Use `luna-define-method'. (mime-parse-buffer): New function [moved from mmgeneric.el]. * mime-parse.el (mime-parse-multipart): Moved to mmbuffer.el. (mime-parse-encapsulated): Likewise. (mime-parse-message): Likewise. (mime-parse-buffer): Likewise. * mime.el (mime-parse-buffer): Auto-loaded from "mmbufer". (mime-find-function): Abolished. (mime-entity-function): Abolished. (mime-entity-send): Use `luna-send'. (mime-open-entity): Use `luna-make-entity' and `mm-expand-class-name'. (mime-entity-cooked-p): Use `luna-define-generic'. (mime-entity-children): Use `luna-send'. (mime-find-entity-from-content-id): Use `mime-entity-read-field'. (mime-entity-buffer): Change to generic function. (mime-entity-header-buffer): New generic function. (mime-entity-body-buffer): Likewise. (mime-entity-point-min): Use `luna-define-generic'. (mime-entity-point-max): Likewise. (mime-entity-header-start): Abolished. (mime-entity-header-end): Abolished. (mime-entity-body-start): Abolished. (mime-entity-body-end): Abolished. (mime-goto-header-start-point): New generic function. (mime-entity-fetch-field): New generic function. (mime-fetch-field): Use `mime-entity-fetch-field'; declare as obsolete function. (mime-entity-content-type): Use `mime-entity-fetch-field'. (mime-entity-content-disposition): Likewise. (mime-entity-encoding): Likewise. (mime-entity-read-field): New function. (mime-read-field): Use `mime-entity-read-field'; declare as obsolete function. (mime-insert-header): Use `luna-define-generic'; abolish obsolete alias `mime-insert-decoded-header'. (mime-entity-name): New generic function. (mime-entity-content): Use `luna-define-generic'. (mime-insert-entity-content): Likewise. (mime-write-entity-content): Likewise. (mime-insert-text-content): Likewise. (mime-insert-entity): Likewise. (mime-write-entity): Likewise. (mime-write-entity-body): Likewise. * mime-def.el: - Use `luna'. (make-mime-entity-internal): Abolished. (mime-entity-representation-type-internal): Change to alias for `luna-class-name'. (mime-entity-set-representation-type-internal): Change to alias for `luna-set-class-name'. (mime-entity-location-internal): Defined by `luna-define-internal-accessors'. (mime-entity-set-location-internal): Likewise. (mime-entity-content-type-internal): Likewise. (mime-entity-set-content-type-internal): Likewise. (mime-entity-content-disposition-internal): Likewise. (mime-entity-set-content-disposition-internal): Likewise. (mime-entity-encoding-internal): Likewise. (mime-entity-set-encoding-internal): Likewise. (mime-entity-children-internal): Likewise. (mime-entity-set-children-internal): Likewise. (mime-entity-parent-internal): Likewise. (mime-entity-set-parent-internal): Likewise. (mime-entity-node-id-internal): Likewise. (mime-entity-decoded-subject-internal): Abolished. (mime-entity-set-decoded-subject-internal): Abolished. (mime-entity-decoded-from-internal): Abolished. (mime-entity-set-decoded-from-internal): Abolished. (mime-entity-date-internal): Abolished. (mime-entity-set-date-internal): Abolished. (mime-entity-message-id-internal): Abolished. (mime-entity-set-message-id-internal): Abolished. (mime-entity-references-internal): Abolished. (mime-entity-set-references-internal): Abolished. (mime-entity-chars-internal): Abolished. (mime-entity-set-chars-internal): Abolished. (mime-entity-lines-internal): Abolished. (mime-entity-set-lines-internal): Abolished. (mime-entity-xref-internal): Abolished. (mime-entity-set-xref-internal): Abolished. (mime-entity-original-header-internal): Defined by `luna-define-internal-accessors'. (mime-entity-set-original-header-internal): Likewise. (mime-entity-parsed-header-internal): Likewise. (mime-entity-set-parsed-header-internal): Likewise. (mime-entity-buffer-internal): Abolished. (mime-entity-set-buffer-internal): Abolished. (mime-entity-header-start-internal): Abolished. (mime-entity-set-header-start-internal): Abolished. (mime-entity-header-end-internal): Abolished. (mime-entity-set-header-end-internal): Abolished. (mime-entity-body-start-internal): Abolished. (mime-entity-set-body-start-internal): Abolished. (mime-entity-body-end-internal): Abolished. (mime-entity-set-body-end-internal): Abolished. (mm-expand-class-name): New macro. (mm-define-backend): Use `luna-define-class' and `mm-expand-class-name'. (mm-define-method): Use `luna-define-method' and `mm-expand-class-name'. (mm-arglist-to-arguments): Abolished. (mel-define-service): Use `luna-arglist-to-arguments' instead of `mm-arglist-to-arguments'. * mel.el: Require `alist'. * FLIM-ELS (flim-modules): Add `luna' and delete `mmgeneric'. * luna.el: - Rename property `luna-member-index' to `luna-slot-index'. - Rearrangement to avoid byte-compiling problem. (luna-define-class-function): New function. (luna-define-class): Use `luna-define-class-function'. (luna-define-generic): Fixed. (luna-define-internal-accessors): New function. 1999-05-15 MORIOKA Tomohiko * luna.el (luna-make-entity-function): Send `initialize-instance'. 1999-05-14 MORIOKA Tomohiko * luna.el: New module. 1999-05-31 MORIOKA Tomohiko * FLIM: Version 1.12.7 (Yūzaki) released. 1999-05-31 MORIOKA Tomohiko * mime-en.sgml (Network representation of header): Translate. 1999-05-27 Shuhei KOBAYASHI * mel-b-el.el (pack-sequence): Eliminate local variable `i'. (base64-encode-1): Avoid concat. (base64-encode-string): Fixed last change; extra padding. 1999-05-26 MORIOKA Tomohiko * smtpmail.el (smtpmail-default-smtp-server): Define obsolete variable alias for XEmacs. (smtpmail-smtp-server): Likewise. (smtpmail-smtp-service): Likewise. (smtpmail-local-domain): Likewise. (smtpmail-debug-info): Likewise. (smtpmail-send-it): Check function `expand-mail-aliases' is defined. 1999-05-26 MORIOKA Tomohiko * smtp.el (smtp-debug-info): Now a user option. 1999-05-25 Yoshiki Hayashi * README.ja: Modify URL and required version of APEL. 1999-05-24 Tanaka Akira * mel-b-ccl.el (base64-encode-string): New alias. (base64-encode-region): Ditto. (base64-decode-string): Ditto. (base64-decode-region): Ditto. 1999-05-24 Tanaka Akira * mel-b-ccl.el, mel-q-ccl.el: Sync up with doodle-1.12.5. 1999-05-24 MORIOKA Tomohiko * eword-encode.el (ew-space-process): Renamed from `tm-eword::space-process'. 1999-05-24 MORIOKA Tomohiko * eword-encode.el (tm-eword::space-process): Don't concatenate `special's. (ew-encode-rword-1): Renamed from `tm-eword::encode-string-1'; add new optional argument `must-output'; return nil if it can't encode literally. (eword-encode-rword-list): Fold SPACE or TAB in the encoded string if `ew-encode-rword-1' can't encode literally and it is possible to encode the rest literally with the folding. (eword-encode-phrase-to-rword-list): Add `special' flag to brackets of comments. 1999-05-22 Shuhei KOBAYASHI * smtpmail.el: Require 'poe and 'pcustom. 1999-05-22 Shuhei KOBAYASHI * mel.el: Update header. Require 'path-util and don't require 'poem. (mel-use-module): Eliminate local variable `encoding'. (mime-insert-encoded-file for mel-b-builtin): Use built-in `interactive' spec. (encoded-text-decode-string): Anchor regexp with "\\`" and "\\'". (mime-encode-region): Capitalize prompt string. (mime-decode-region): Ditto. (mime-insert-encoded-file): Ditto. (mime-write-decoded-region): Ditto. * mel-b-ccl.el: Update header. (base64-ccl-encode-region): Use read-only `interactive' spec. (base64-ccl-decode-region): Ditto. (base64-ccl-insert-encoded-file): Use built-in `interactive' spec. (base64-ccl-write-decoded-region): Ditto. (encoded-text-decode-string): Anchor regexp with "\\`" and "\\'". * mel-b-dl.el: Update header. Don't require 'poe; it is required implicitly via 'mime-def. (base64-dl-handle): Chech whether `base64-dl-module' is string. Defalias `base64-encode-string' and `base64-decode-string' just after `dynamic-call'ing "emacs_base64_init". (base64-encode-region): Use read-only `interactive' spec. Use `base64-encode-string'. Changed order of evaluation to "encode, delete, then insert". (base64-decode-region): Renamed from `decode-base64-region'. Use read-only `interactive' spec. Use `base64-decode-string'. Changed order of evaluation to "decode, delete, then insert". (mime-encode-string): Use `base64-encode-string'. (mime-decode-string): Use `base64-decode-string'. (mime-decode-region): Use `base64-decode-region'. (encoded-text-encode-string): Use `base64-encode-string'. (encoded-text-decode-string): Anchor regexp with "\\`" and "\\'". (mime-insert-encoded-file): Use built-in `interactive' spec. (mime-write-decoded-region in comment): Ditto. * mel-b-el.el: Update header. Don't require 'poe; it is required implicitly via 'mime-def. (pack-sequence): Moved to top of the function definitions. (base64-encode-string): Calculate padding first. (base64-internal-encode-region): Changed order of evaluation to "encode, delete, then insert". (base64-internal-decode-string): Changed order of evaluation to "decode, delete, then insert". (base64-encode-region): Use read-only `interactive' spec. (base64-decode-region): Ditto. (base64-decode-string): Not interactive. (encoded-text-decode-string): Anchor regexp with "\\`" and "\\'". (base64-insert-encoded-file): Use built-in `interactive' spec. (base64-write-decoded-region): Ditto. * mel-g.el: Update header. Require 'mime-def instead of 'poem and 'mel. (mime-insert-encoded-file): Use built-in `interactive' spec. (mime-write-decoded-region): Ditto. * mel-q-ccl.el: Update header. (quoted-printable-ccl-encode-region): Use read-only `interactive' spec. (quoted-printable-ccl-decode-region): Ditto. (quoted-printable-ccl-insert-encoded-file): Use built-in `interactive' spec. (quoted-printable-ccl-write-decoded-region): Ditto. (encoded-text-decode-string): Anchor regexp with "\\`" and "\\'". * mel-q.el: Update header. Require 'path-util instead of 'emu. (quoted-printable-internal-encode-region): Rewrite without regexp. (quoted-printable-internal-decode-region): Ditto. (quoted-printable-encode-region): Use read-only `interactive' spec. (quoted-printable-decode-region): Ditto. (mime-insert-encoded-file): Use built-in `interactive' spec. (mime-write-decoded-region): Ditto. (encoded-text-decode-string): Anchor regexp with "\\`" and "\\'". * mel-u.el: Update header. Require 'path-util instead of 'emu. (mime-insert-encoded-file): Use built-in `interactive' spec. (mime-write-decoded-region): Ditto. 1999-05-22 Shuhei KOBAYASHI * mime-def.el: Require 'poe, 'poem, and 'pcustom. (mime): Declare `default-mime-charset' as an initial member. * mime-parse.el: Don't require 'cl at compile-time. * mailcap.el (mailcap-look-at-qchar): Use `char-after'. * std11.el: Require 'poe, 'poem, and 'pcustom. * smtp.el: Update header. Require 'poe, 'poem, and 'pcustom. Require 'cl at compile-time. 1999-05-21 MORIOKA Tomohiko * README.en (Installation): Modify URL and required version of APEL. * eword-encode.el (ew-find-charset-rule): Renamed from `tm-eword::find-charset-rule'; use `find-mime-charset-by-charsets'. 1999-05-11 MORIOKA Tomohiko * FLIM: Version 1.12.6 (Family-Kōenmae) released. 1999-04-27 Shuhei KOBAYASHI * mel-b-ccl.el (TopLevel): Suppress warning. mel-q-ccl.el (TopLevel): Ditto. mime.el (TopLevel): Ditto. 1999-04-26 Shuhei KOBAYASHI * eword-decode.el (eword-encoded-word-regexp): Accept "b" and "q" for "encoding". * mime-def.el (std11-qtext-regexp): Don't use `string'. (mime-tspecial-char-list): Eval at compile time. 1999-04-22 Katsumi Yamaoka * mime.el: Delete autoload setting for `eword-encode-field'. 1999-04-22 MORIOKA Tomohiko * eword-encode.el: Require `poem' instead of `emu'. Don't use `cl' for `caar'. 1999-04-09 Katsumi Yamaoka * smtp.el (smtp-via-smtp): Funcall `smtp-server' if it is a function. (smtp-server): Make it can also be a function called from `smtp-via-smtp' with arguments SENDER and RECIPIENTS. 1999-04-05 Shuhei KOBAYASHI * FLIM-CFG: Make easier to install in VERSION_SPECIFIC_LISPDIR. 1999-03-29 Shuhei KOBAYASHI * mime.el (mime-read-field): Correct argument of `mime-decode-field-body'; 'native -> 'plain. 1999-03-27 Shuhei KOBAYASHI * eword-encode.el (TopLevel): Require 'cl when compiling. (eword-encode-rword-list): Suppress insertion of extra spaces. (eword-encode-msg-id-to-rword-list): Treat surrounding angle brackets atomically. ([tm-ja:4244] by Kazuhiro Ohta ) 1999-03-11 MORIOKA Tomohiko * eword-encode.el (eword-charset-encoding-alist): Add `tis-620'. 1999-03-01 MORIOKA Tomohiko * mel.el (mime-decode-string): Return STRING if return value of `(mel-find-function 'mime-decode-string encoding)' is nil. 1999-02-10 MORIOKA Tomohiko * mime-def.el (mel-define-service): Change size of obarray to 7. 1999-02-01 Yoshiki Hayashi * mime-ja.sgml: Tranlate all untranslated parts. 1999-01-27 MORIOKA Tomohiko * FLIM: Version 1.12.5 (Hirahata) released. * mime-ja.sgml, mime-en.sgml: Sync with FLIM API 1.12. 1999-01-26 MORIOKA Tomohiko * NEWS (New optional argument of `std11-field-end'): New subsection. * std11.el (std11-field-end): Add new optional argument `bound'. 1999-01-24 MORIOKA Tomohiko * FLIM: Version 1.12.4 (Tsutsui) released. 1999-01-24 MORIOKA Tomohiko * README.en: Sync with latest FLIM. * README.ja: fixed. 1999-01-24 MORIOKA Tomohiko * mmbuffer.el, mmgeneric.el (insert-entity-content): New method. * mime.el (mime-insert-entity-content): New generic function. 1999-01-24 MORIOKA Tomohiko * NEWS (New function `mime-find-entity-from-content-id'): New subsection. (New function `mime-parse-msg-id'): New subsection. (New function `mime-uri-parse-cid'): New subsection. 1999-01-24 MORIOKA Tomohiko * mime.el (mime-find-entity-from-content-id): New function. (mime-field-parser-alist): Use `mime-parse-msg-id' instead of `std11-parse-msg-id' to parse `Message-Id', `Recent-Message-Id' and `Content-Id' field. * mime-parse.el (mime-parse-msg-id): New function. (mime-uri-parse-cid): New function. 1999-01-23 MORIOKA Tomohiko * FLIM: Version 1.12.3 (Kintetsu-Kōriyama) released. 1999-01-23 MORIOKA Tomohiko * NEWS (Function `std11-parse-in-reply-to'): New subsection. (New function `std11-parse-msg-id-string'): Likewise. (New function `std11-parse-msg-ids-string'): Likewise. (New generic function `mime-insert-entity'): Likewise. 1999-01-23 MORIOKA Tomohiko * mime.el (mime-field-parser-alist): Change to set parser for tokens instead of parser for string. (mime-read-field): Use `eword-lexical-analyze' before parsing. * eword-encode.el (eword-encode-in-reply-to): Use `std11-parse-msg-ids-string' instead of `std11-parse-in-reply-to' and `std11-lexical-analyze'. * std11.el (std11-parse-msg-ids): Renamed from `std11-parse-in-reply-to'; define `std11-parse-in-reply-to' as obsolete alias. (std11-parse-msg-id-string): New function. (std11-parse-msg-ids-string): New function. 1999-01-23 MORIOKA Tomohiko * mime.el (mime-field-parser-alist): New variable. (mime-read-field): Refer `mime-field-parser-alist'. 1999-01-23 MORIOKA Tomohiko * mmbuffer.el, mmgeneric.el (insert-entity): New method. * mime.el (mime-insert-entity): New generic function. 1999-01-22 Katsumi Yamaoka * std11.el (TopLevel): Require `custom'. 1999-01-21 MORIOKA Tomohiko * FLIM: Version 1.12.2 (Kujō) released. 1999-01-16 MORIOKA Tomohiko * mime-parse.el (mime-lexical-analyzer): New user option. (mime-analyze-tspecial): New function. (mime-analyze-token): New function. (mime-parse-Content-Transfer-Encoding): Use `std11-lexical-analyze' with `mime-lexical-analyzer'. * mime-def.el (mime-tspecial-char-list): Renamed from `mime-tspecials'; changed from string to list. (mime-token-regexp): Use `eval-when-compile'. 1999-01-16 MORIOKA Tomohiko * eword-decode.el (eword-lexical-analyzer): Modify DOC-string about interface change. (eword-analyze-comment): Renamed from `eword-parse-comment'; change second argument `from' to required argument; abolish alias `eword-analyze-comment' of `eword-parse-comment'. 1999-01-16 MORIOKA Tomohiko * NEWS (User option `eword-lexical-analyzers' -> `eword-lexical-analyzer'): New subsection. * eword-decode.el (eword-lexical-analyzer): Renamed from user option `eword-lexical-analyzers'. 1999-01-16 MORIOKA Tomohiko * NEWS (New user option `std11-lexical-analyzer'): New subsection. * std11.el (std11-lexical-analyzer): Renamed from user option `std11-lexical-analyzers'. 1999-01-16 MORIOKA Tomohiko * std11.el (std11-lexical-analyze): Change interface to add new optional argument `analyzers'. 1999-01-16 MORIOKA Tomohiko * std11.el (std11-lexical-analyzers): New user option. (std11-lexical-analyze): New implementation; refer `std11-lexical-analyzers'. 1999-01-16 MORIOKA Tomohiko * NEWS (Change interface of lexical-analyzers): New subsection. 1999-01-16 MORIOKA Tomohiko * eword-decode.el (eword-encoded-word-regexp): Must define when this module is compiled. (eword-decode-structured-field-body): Add new optional argument `start'. (eword-decode-and-unfold-structured-field-body): Likewise. (eword-decode-and-fold-structured-field-body): Likewise. (eword-analyze-quoted-string): Add new argument `start'; return `( . )' instead of `( . )'. (std11-analyze-domain-literal): Likewise. (eword-analyze-domain-literal): Likewise. (eword-analyze-comment): Changed to alias of `eword-parse-comment'. (eword-analyze-spaces): Add new argument `start'; return `( . )' instead of `( . )'. (std11-analyze-domain-literal): Likewise. (eword-analyze-special): Likewise. (eword-analyze-encoded-word): Likewise. (eword-analyze-atom): Likewise. (eword-lexical-analyze-internal): Add new argument `start'. (eword-lexical-analyze): Change interface to add new optional argument `start'. (eword-extract-address-components): Add new optional argument `start'. * std11.el (std11-atom-regexp): Modify to match non-top atom. (std11-analyze-spaces): Add new argument `start'; return `( . )' instead of `( . )'. (std11-analyze-special): Likewise. (std11-analyze-atom): Likewise. (std11-analyze-quoted-string): Likewise. (std11-analyze-domain-literal): Likewise. (std11-analyze-comment): Likewise. (std11-lexical-analyze): Add new optional argument `start'. 1999-01-15 MORIOKA Tomohiko * std11.el (std11-fetch-field): Add autoload cookie. (std11-narrow-to-header): Likewise. (std11-field-body): Likewise. (std11-unfold-string): Likewise. (std11-lexical-analyze): Add DOC-string; add autoload cookie. * std11.el (std11-space-char-list): Renamed from `std11-space-chars'; changed from string to list. 1999-01-15 MORIOKA Tomohiko * std11.el (std11-fetch-field): Don't define as inline function. (std11-field-body): Enclose `std11-narrow-to-header' and `std11-fetch-field' by `inline'. 1999-01-15 MORIOKA Tomohiko * std11.el (std11-special-char-list): Evaluate when it is compiled. (std11-atom-regexp): Use `eval-when-compile'. 1999-01-15 MORIOKA Tomohiko * std11.el (std11-space-chars): Must evaluate when it is compiled. (std11-analyze-spaces): Don't use `std11-spaces-regexp'; abolist constant `std11-spaces-regexp'. * mime-parse.el (mime-disposition-type-regexp): Must evaluate when it is compiled. * mime-parse.el: Don't require emu. * mime-parse.el (mime-parse-Content-Disposition): Use `eval-when-compile'. * mime-parse.el (mime-parse-Content-Transfer-Encoding): New implementation. 1998-12-22 Katsumi Yamaoka * README.en (Installation): Modify for APEL 9.12. * README.ja (Installation): Likewise. 1998-12-14 Katsumi Yamaoka * mel-b-ccl.el (base64-ccl-insert-encoded-file): Call `insert-file-contents-as-coding-system' with CODING-SYSTEM as the 1st arg. * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): Likewise. * mel-b-ccl.el (base64-ccl-write-decoded-region): Call `write-region-as-coding-system' with CODING-SYSTEM as the 1st arg. * mel-q-ccl.el (quoted-printable-ccl-write-decoded-region): Likewise. 1998-12-14 Katsumi Yamaoka * mel-b-ccl.el (base64-ccl-insert-encoded-file): Use `insert-file-contents-as-coding-system' (renamed from `insert-file-contents-as-specified-coding-system'). * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): Likewise. * mel-b-ccl.el (base64-ccl-write-decoded-region): Use `write-region-as-coding-system' (renamed from `write-region-as-specified-coding-system'). * mel-q-ccl.el (quoted-printable-ccl-write-decoded-region): Likewise. 1998-12-08 Katsumi Yamaoka * smtp.el (smtp-coding-system): Abolished. (smtp-via-smtp): Use `open-network-stream-as-binary' instead of `open-network-stream'. 1998-12-04 Katsumi Yamaoka * mel-b-ccl.el (base64-ccl-insert-encoded-file): Use `insert-file-contents-as-specified-coding-system' instead of `insert-file-contents'. * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): Likewise. * mel-b-ccl.el (base64-ccl-write-decoded-region): Use `write-region-as-specified-coding-system' instead of `write-region'. * mel-q-ccl.el (quoted-printable-ccl-write-decoded-region): Likewise. 1998-12-02 MORIOKA Tomohiko * FLIM: Version 1.12.1 (Nishinokyō) released. 1998-11-30 MORIOKA Tomohiko * smtpmail.el (smtpmail-send-it): Add autoload cookie; use `smtpmail-do-bcc' instead of `smtp-do-bcc'; modify for interface change of `smtp-via-smtp'. (smtpmail-do-bcc): New function (moved and renamed from `smtp-do-bcc' of smtp.el). 1998-08-06 Katsumi Yamaoka * lisp/smtp.el: Do not insert empty line at the end of message. 1998-06-18 Shuhei KOBAYASHI * lisp/smtp.el (smtp-use-8bitmime): New variable. (smtp-debug-info): Internal variable, now. (smtp-make-fqdn): Renamed from `smtp-fqdn'. (smtp-via-smtp): New implementation. (smtp-send-command): Treat "PASS" as usual. (smtp-do-bcc): Removed. 1998-11-30 MORIOKA Tomohiko * smtpmail.el: New module (copied from Semi-gnus 6.8). * smtp.el: New module (copied from Semi-gnus 6.8). * FLIM-ELS: Add smtp.el and smtpmail.el. 1998-11-30 MORIOKA Tomohiko * mime-def.el: Abolish function `eliminate-top-spaces' because it is not used in FLIM. 1998-11-29 MORIOKA Tomohiko * eword-encode.el (eword-encode-mailbox-to-rword-list): Fix problem in `eword-encode-addresses-to-rword-list'. 1998-11-26 MORIOKA Tomohiko * std11.el (std11-full-name-string): fixed. * std11.el (std11-comment-value-to-string): fixed. 1998-11-25 MORIOKA Tomohiko * NEWS (Changes in FLIM 1.12): New section. 1998-11-25 MORIOKA Tomohiko * std11.el (std11-comment-value-to-string): New function. (std11-full-name-string): Use `std11-comment-value-to-string'. * eword-decode.el (eword-parse-comment): New function. (eword-analyze-comment): New implementation; use `eword-parse-comment'; change representation. (eword-decode-token): Modify for representation change of comment. 1998-11-16 MORIOKA Tomohiko * FLIM: Version 1.12.0 (Amagatsuji) was released. 1998-11-14 Tanaka Akira * mel-b-ccl.el (ccl-cascading-read): Check consistency. 1998-11-13 MORIOKA Tomohiko * eword-decode.el (eword-decode-structured-field-body): Abolish non-used local variable. 1998-11-12 Tanaka Akira * mel-b-ccl.el (mel-ccl-decode-b): Check `ccl-cascading-read' to select implementation. 1998-11-12 Tanaka Akira * mel-q-ccl.el (mel-ccl-encode-quoted-printable-generic): workaround for mule-2.3@19.34. 1998-11-12 Tanaka Akira * mel.el (mel-b-builtin): New variable. 1998-11-10 Tanaka Akira * FLIM-ELS: require 'pccl. (flim-modules): Check CCL availability by broken facility. 1998-11-08 MORIOKA Tomohiko * eword-decode.el (eword-decode-structured-field-body): New implementation; abolish optional argument `must-unfold'; delete DOC-string. (eword-decode-and-unfold-structured-field-body): Renamed from `eword-decode-and-unfold-structured-field'; delete DOC-string. (eword-decode-and-fold-structured-field-body): Renamed from `eword-decode-and-fold-structured-field'; abolish optional argument `must-unfold'; delete DOC-string. (eword-decode-unstructured-field-body): Abolish optional argument `must-unfold'; delete DOC-string. (eword-decode-and-unfold-unstructured-field-body): Renamed from `eword-decode-and-unfold-unstructured-field'; delete DOC-string. (eword-decode-unfolded-unstructured-field-body): New function. 1998-11-08 MORIOKA Tomohiko * mmgeneric.el (mime-insert-header-from-buffer): Use `mime-find-field-presentation-method' and `mime-find-field-decoder-internal'. * eword-decode.el (mime-find-field-presentation-method): New macro. (mime-find-field-decoder-internal): New function. (mime-find-field-decoder): New implementation (use mime-find-field-decoder-internal). (mime-decode-header-in-region): Use `mime-find-field-presentation-method' and `mime-find-field-decoder-internal'. 1998-11-08 MORIOKA Tomohiko * mmgeneric.el (mime-insert-header-from-buffer): Rename field-presentation-mode `folding' to `wide'. * eword-decode.el: Rename field-presentation-modes from `native', `folding', `unfolding', `unfolding-xover' to `plain', `wide', `summary', `nov'. 1998-11-07 Tanaka Akira * eword-decode.el (mime-set-field-decoder): Add mode `unfolding-xover'. (mime-find-field-decoder): Ditto. 1998-11-04 MORIOKA Tomohiko * eword-encode.el (eword-encode-phrase-route-addr-to-rword-list): Don't delete the front spaces. (eword-encode-addresses-to-rword-list): Don't supplement space; use `nconc' instead of `append'. (eword-encode-msg-id-to-rword-list): Supplement the front space; use `nconc' instead of `append'. 1998-11-02 Tanaka Akira * eword-decode.el (mime-field-decoder-cache): New variable. (mime-find-field-decoder): Use `mime-field-decoder-cache'. (mime-update-field-decoder-cache): New variable. (mime-update-field-decoder-cache): New function. (mime-decode-header-in-region): Use `mime-field-decoder-cache'. * mmgeneric.el (mime-insert-header-from-buffer): Use `mime-field-decoder-cache'. 1998-11-02 MORIOKA Tomohiko * eword-decode.el (mime-decode-header-in-region): New function. (mime-decode-header-in-buffer): Use function `mime-decode-header-in-region'. 1998-10-28 MORIOKA Tomohiko * mmgeneric.el (mime-insert-header-from-buffer): Refer `mime-field-decoder-alist' instead of hard-coding. * mime.el (mime-read-field): Use `mime-decode-field-body'. * eword-decode.el (eword-decode-and-unfold-structured-field): Add optional dummy argument `start-column' and `max-column'. (eword-decode-structured-field-body): Change interface. (eword-decode-unstructured-field-body): Change interface to add optional dummy argument `start-column' and `max-column'. (eword-decode-and-unfold-unstructured-field): Add optional dummy argument `start-column' and `max-column'. (mime-field-decoder-alist): New variable; abolish user option `eword-decode-ignored-field-list' and `eword-decode-structured-field-list'. (mime-set-field-decoder): New function. (mime-find-field-decoder): New function. (mime-decode-field-body): New function; abolish function `eword-decode-field-body'. (mime-decode-header-in-buffer): Renamed from `eword-decode-header'; refer `mime-field-decoder-alist' instead of hard-coding; add obsolete alias `eword-decode-header'. 1998-10-28 MORIOKA Tomohiko * mime-def.el: Avoid compile error when edebug is missing. 1998-10-28 MORIOKA Tomohiko * FLIM: Version 1.11.3 (Saidaiji) was released. 1998-10-27 MORIOKA Tomohiko * VERSION: New file (Renamed from FLIM-VERSION). 1998-10-27 MORIOKA Tomohiko * eword-encode.el (eword-encode-char-type): Return nil for ?\n. 1998-10-27 Tanaka Akira * eword-encode.el (eword-encode-field-body): Unfold `field-body'. 1998-10-27 Yoshiki Hayashi * README.ja: Update. 1998-10-26 MORIOKA Tomohiko * FLIM: Version 1.11.2 (Heijō) was released. * NEWS (Abolish variable `mime-temp-directory'): New subsection. * README.en (Installation): Modify for APEL 9.6. 1998-10-26 MORIOKA Tomohiko * eword-encode.el (eword-encode-field-body): Don't eliminate top-spaces. 1998-10-25 MORIOKA Tomohiko * FLIM-ELS (flim-modules): Don't install mel-b-el for Emacs 20.4. 1998-10-25 Tanaka Akira * eword-decode.el (eword-decode-field-body): Refine implementation. 1998-10-24 Tanaka Akira * mel-b-ccl.el, mel-q-ccl.el, mel.el, FLIM-ELS: Divide mel-ccl.el into mel-b-ccl.el and mel-q-ccl.el. 1998-09-11 Tanaka Akira * mel.el (base64-encoded-length): New implementation. 1998-10-25 Tanaka Akira * eword-decode.el (eword-decode-field-body): New function. 1998-10-25 MORIOKA Tomohiko * eword-encode.el (eword-encode-field-body): Change interface. (eword-encode-header): Use `eword-encode-field-body'; abolish function `eword-encode-field'. 1998-10-25 Tanaka Akira * eword-encode.el (eword-encode-field-body): New function. (eword-encode-field): Use `eword-encode-field-body'. 1998-10-24 MORIOKA Tomohiko * mel.el, mel-b-el.el, FLIM-ELS: Rename mel-b.el -> mel-b-el.el. 1998-10-24 MORIOKA Tomohiko * mel-u.el (uuencode-external-decode-region): Use `temporary-file-directory' instead of `mime-temp-directory'. (mime-write-decoded-region): Likewise. * mime-def.el: Abolish variable `mime-temp-directory'. 1998-10-24 MORIOKA Tomohiko * mmgeneric.el (mime-insert-header-from-buffer): New function. (insert-header): Use `mime-insert-header-from-buffer'. 1998-10-24 MORIOKA Tomohiko * FLIM-ELS: Don't install mel-b-dl.el if the running emacs has builtin base64 encoder/decoder. * mel.el: Set up builtin base64 encoder/decoder if they are available. * mime-def.el (base64-dl-module): Set nil as initial value if the running emacs has builtin base64 encoder/decoder. * mel-b.el: Require `poe' instead of `emu'. (base64-encode-string): Use `defun-maybe'. (base64-encode-region): Likewise. (base64-decode-region): Likewise. (base64-decode-string): Likewise. * mel-b-dl.el: Require `poe' instead of `emu'. 1998-10-23 MORIOKA Tomohiko * FLIM: Version 1.11.1 (Takanohara) was released. 1998-10-22 Yoshiki Hayashi * README.ja: New file. 1998-10-20 MORIOKA Tomohiko * mime-def.el: Require mcharset. 1998-10-20 Katsumi Yamaoka * mel-u.el (mime-write-decoded-region): Fix typo. * mime-def.el: Enclose defining procedure for the constants `std11-quoted-pair-regexp', `std11-non-qtext-char-list' and `std11-qtext-regexp' with `eval-and-compile'. 1998-10-19 MORIOKA Tomohiko * NEWS (Behavior change of `mime-insert-header'): New subsection. * mmgeneric.el (insert-header): Include `:' in field-name. 1998-10-19 MORIOKA Tomohiko * mime-def.el (std11-qtext-regexp): Use `eval-when-compile'; don't use `char-list-to-string'. (std11-quoted-string-regexp): Use `eval-when-compile'. - Use `def-edebug-spec' to define edebug-form-spec of mm-define-method; fix definition of edebug-form-spec of mm-define-method. 1998-10-18 MORIOKA Tomohiko * mime-en.sgml, mime-ja.sgml (Header encoder/decoder): Add description about `eword-field-encoding-method-alist'. * mime-en.sgml (Header encoder/decoder): Modify description about `eword-encode-header'. * mime-ja.sgml (Header encoder/decoder): Translate. 1998-10-18 MORIOKA Tomohiko * mime-en.sgml (entity formatting): Fix typo in description of `default-mime-charset'. * mime-en.sgml (Header encoder/decoder): Modify description of `eword-decode-header'. * mime-ja.sgml, mime-en.sgml (Header encoder/decoder): fix typo. * mime-en.sgml (encoder/decoder): Translate description of `mime-decode-string'. 1998-10-18 MORIOKA Tomohiko * mime-en.sgml (Content-Disposition parser): Modify description. * mime-en.sgml (Content-Type parser): Modify description. 1998-10-18 MORIOKA Tomohiko * mime-en.sgml (Content-Transfer-Encoding parser): Translate. 1998-10-18 MORIOKA Tomohiko * FLIM: Version 1.11.0 (Yamadagawa) was released. 1998-10-17 MORIOKA Tomohiko * mime-ja.sgml, mime-en.sgml (entity formatting): Add description about `mime-insert-text-content'. 1998-10-17 MORIOKA Tomohiko * mime-ja.sgml, mime-en.sgml (entity formatting): New node; move `mime-insert-header' from `Entity-header'; move `default-mime-charset' from `custom'. 1998-10-17 MORIOKA Tomohiko * mime-en.sgml, mime-ja.sgml (Entity-header): Generic function `mime-insert-decoded-header' was renamed to `mime-insert-header'. 1998-10-17 MORIOKA Tomohiko * NEWS: New file. 1998-10-16 MORIOKA Tomohiko * mime.el (mime-insert-header): Renamed from `mime-insert-decoded-header'; define `mime-insert-decoded-header' as an obsolete alias. * mmgeneric.el, mmcooked.el (insert-header): Renamed from `insert-decoded-header'. * README.en (Installation): Add required version of APEL. 1998-10-16 MORIOKA Tomohiko * mel-g.el: Require mel. * mel-g.el: Require poem instead of emu. 1998-10-16 MORIOKA Tomohiko * mime.el (mime-insert-text-content): New generic function. * mmcooked.el, mmgeneric.el (insert-text-content): New method. 1998-10-02 MORIOKA Tomohiko * std11.el (std11-unfold-string): New implementation. 1998-10-02 MORIOKA Tomohiko * mmgeneric.el: New module. * mmbuffer.el: Use `generic' as mother backend. * FLIM-ELS (flim-modules): Add mmgeneric. 1998-10-01 MORIOKA Tomohiko * mime-parse.el (mime-parse-message): Modify for `make-mime-entity-internal'. * mime-def.el (make-mime-entity-internal): Change interface to be able to specify original-header and parsed-header. 1998-09-30 MORIOKA Tomohiko * eword-decode.el (eword-decode-and-unfold-unstructured-field): New function. 1998-09-30 MORIOKA Tomohiko * mime.el (mime-entity-content-type): New implementation. (mime-entity-content-disposition): New implementation. (mime-entity-encoding): New implementation. * mime.el (mime-fetch-field): Refer internal slots for Date, Message-Id and References fields. * mime-parse.el (mime-parse-message): Modify for `make-mime-entity-internal'. * mime-def.el: Change `mime-entity-*-internal' and `mime-entity-set-*-internal' to macro. (make-mime-entity-internal): Change interface and data format for NOV data; changed to macro. (mime-entity-set-location-internal): New macro. (mime-entity-decoded-subject-internal): New macro. (mime-entity-set-decoded-subject-internal): New macro. (mime-entity-decoded-from-internal): New macro. (mime-entity-set-decoded-from-internal): New macro. (mime-entity-date-internal): New macro. (mime-entity-set-date-internal): New macro. (mime-entity-message-id-internal): New macro. (mime-entity-set-message-id-internal): New macro. (mime-entity-references-internal): New macro. (mime-entity-set-references-internal): New macro. (mime-entity-chars-internal): New macro. (mime-entity-set-chars-internal): New macro. (mime-entity-lines-internal): New macro. (mime-entity-set-lines-internal): New macro. (mime-entity-xref-internal): New macro. (mime-entity-set-xref-internal): New macro. (mime-entity-original-header-internal): Modify for new structure; changed to macro. (mime-entity-set-original-header-internal): Likewise. (mime-entity-parsed-header-internal): Likewise. (mime-entity-set-parsed-header-internal): Likewise. (mime-entity-buffer-internal): Likewise. (mime-entity-set-buffer-internal): Likewise. (mime-entity-header-start-internal): Likewise. (mime-entity-set-header-start-internal): Likewise. (mime-entity-header-end-internal): Likewise. (mime-entity-set-header-end-internal): Likewise. (mime-entity-body-start-internal): Likewise. (mime-entity-set-body-start-internal): Likewise. (mime-entity-body-end-internal): Likewise. (mime-entity-set-body-end-internal): Likewise. 1998-10-14 MORIOKA Tomohiko * FLIM: Version 1.10.5 (Kizugawadai) was released. * mel.el: Must require poem. 1998-10-12 MORIOKA Tomohiko * FLIM: Version 1.10.4 (Shin-Hōsono) was released. 1998-10-12 Katsumi Yamaoka * README.en: Add explanation about `VERSION_SPECIFIC_LISPDIR'. * Makefile (install): Add new arg `VERSION_SPECIFIC_LISPDIR'. (elc): Likewise. * FLIM-MK (config-flim): Refer to `VERSION_SPECIFIC_LISPDIR'. * FLIM-CFG (VERSION_SPECIFIC_LISPDIR): New variable. 1998-10-12 MORIOKA Tomohiko * mel.el (mel-ccl-module): Require path-util when the running emacs has MULE. * mel.el: Don't require emu. 1998-10-11 MORIOKA Tomohiko * FLIM-ELS: Don't install mel-ccl in anything older than XEmacs 21 with MULE. 1998-10-10 MORIOKA Tomohiko * FLIM: Version 1.10.3 (Komada) was released. * mel-ccl.el (base64-ccl-write-decoded-region): bind `jka-compr-compression-info-list' with nil. * mel-b.el (base64-internal-decoding-limit): Switch default value between XEmacs-mule and other emacsen. Abolish function `base64-decode-string!'. (base64-internal-decode-region): New implementation. (base64-insert-encoded-file): New function. (mime-insert-encoded-file): Use `base64-insert-encoded-file'. (base64-write-decoded-region): New function. (mime-write-decoded-region): Use `base64-write-decoded-region'. * mel-b-dl.el (decode-base64-region): Renamed from `base64-decode-region'. (mime-insert-encoded-file): Change temporary-buffer to unibyte representation. Abolish method `mime-write-decoded-region' because it is slower than CCL based implementation. 1998-10-09 Tanaka Akira * mel-ccl.el: Check `ccl-execute-eof-block-on-decoding-some' facility instead of `ccl-execute-eof-block-on-encoding-some'. 1998-10-09 MORIOKA Tomohiko * mel-b.el (base64-characters): Enclose with `eval-and-compile'. * eword-decode.el (eword-encoded-text-regexp): Enclose with `eval-and-compile'. (eword-encoded-word-regexp): Use `eval-when-compile'. 1998-10-09 MORIOKA Tomohiko * eword-decode.el (eword-max-size-to-decode): New user option. (eword-decode-and-fold-structured-field): Do nothing if size of input is bigger than `eword-max-size-to-decode'. 1998-10-08 MORIOKA Tomohiko * mel-b.el (base64-numbers): Use `eval-when-compile'. 1998-10-09 Katsumi Yamaoka * FLIM-CFG: Use `add-latest-path' instead of `add-path' for adding "custom" to load-path. 1998-10-09 Katsumi Yamaoka * mime-def.el (mime-library-product): Enclose with `eval-and-compile'. * FLIM-CFG: Add "custom" to load-path. 1998-10-08 MORIOKA Tomohiko * FLIM: Version 1.10.2 (Kintetsu-Miyazu) was released. * mime-def.el, mel.el, mel-b-dl.el: Move variable `base64-dl-module' from mel-b-dl.el and mel.el to mime-def.el. 1998-10-08 MORIOKA Tomohiko * mel.el (mel-ccl-module): New variable; use it to check mel-ccl is available. * FLIM-ELS: Don't install mel-ccl for anything older than MULE 2.3. 1998-10-08 MORIOKA Tomohiko * mel-u.el: Use `mel-define-backend' to define "x-uue". Define "x-uuencode" as a clone of "x-uue". * Move variable `mel-encoding-module-alist' from mel.el to mime-def.el. * mel.el (mel-find-function): Use function `mel-find-function-from-obarray'. Use `mel-define-backend' to define "7bit", "8bit" and "binary"; don't define methods of "8bit" and "binary"; inherit methods from "7bit". * mime-def.el (mel-service-list): New variable. (mel-define-service): New implementation. (mel-find-function-from-obarray): New inline function. (mel-copy-method): New inline function. (mel-copy-backend): New inline function. (mel-define-backend): New macro. 1998-10-08 MORIOKA Tomohiko * mel-u.el: Define method functions of mel. (mime-encode-region): Use `mel-define-method-function'; abolish `uuencode-encode-region'. (mime-decode-region): Use `mel-define-method-function'; abolish `uuencode-decode-region'. (mime-encode-string): New method. (mime-decode-string): New method. (mime-insert-encoded-file): Use `mel-define-method'; abolish `uuencode-insert-encoded-file'. (mime-write-decoded-region): Use `mel-define-method'; abolish `uuencode-write-decoded-region'. 1998-10-07 MORIOKA Tomohiko * mime-def.el (mel-define-service): Add DOC. (mel-define-method): Add DOC. (mel-define-method-function): Add DOC. * mime-en.sgml, mime-ja.sgml: Modify for FLIM 1.10. 1998-10-07 MORIOKA Tomohiko * FLIM: Version 1.10.1 (Miyamaki) was released. 1998-10-06 MORIOKA Tomohiko * mel-g.el: Define method functions of mel. (mime-encode-region): Use `mel-define-method-function'; abolish `gzip64-encode-region'. (mime-decode-region): Use `mel-define-method-function'; abolish `gzip64-decode-region'. (mime-encode-string): New method. (mime-decode-string): New method. (mime-insert-encoded-file): Use `mel-define-method'; abolish `gzip64-insert-encoded-file'. (mime-write-decoded-region): Use `mel-define-method'; abolish `gzip64-write-decoded-region'. * mime-def.el (mime-library-product): New variable; abolish `mime-library-version'. (mime-product-name): New macro. (mime-product-version): New macro. (mime-product-code-name): New macro. (mime-library-version): Renamed from `mime-library-version-string'; use `mime-library-product', `mime-product-name', `mime-product-version' and `mime-product-code-name'. * mime-def.el (mm-define-backend): Add DOC. (mm-define-method): Add DOC. * mel.el (mime-encoding-list): Modify DOC to add description about optional argument SERVICE. 1998-10-04 MORIOKA Tomohiko * mime-ja.sgml, mime-en.sgml (mm-backend module): Write description of `mm-define-backend' and `mm-define-method'. 1998-09-29 MORIOKA Tomohiko * FLIM: Version 1.10.0 (Kōdo) was released. * README.en (What's FLIM): Add mel-ccl.el. 1998-09-21 Tanaka Akira * mel-ccl.el: - Require 'pccl instead of 'emu. - Use `unless-broken' to check facility. 1998-09-27 MORIOKA Tomohiko * mel.el (mime-encoding-list): New user option (renamed from `mime-content-transfer-encoding-list'). (mime-encoding-list): New function. (mime-encoding-alist): New function. (mime-encode-region): Use `mime-encoding-alist' for completion. (mime-decode-region): Likewise. (mime-insert-encoded-file): Likewise. (mime-write-decoded-region): Likewise. 1998-09-24 MORIOKA Tomohiko * eword-decode.el (eword-decode-structured-field-list): Add Mail-Followup-To field. 1998-09-20 MORIOKA Tomohiko * eword-encode.el (eword-charset-encoding-alist): Add utf-8. 1998-09-20 MORIOKA Tomohiko * mel.el (mime-content-transfer-encoding-list): New user option. (mime-encode-region): Use `mime-content-transfer-encoding-list' for completion. (mime-decode-region): Likewise. (mime-insert-encoded-file): Likewise. (mime-write-decoded-region): Likewise. * mel.el (mime-write-decoded-region): fix typo. 1998-09-20 MORIOKA Tomohiko * mime-def.el (mel-define-method-function): Don't override. 1998-09-20 MORIOKA Tomohiko * mel.el, mel-ccl.el, FLIM-ELS: Add mel-ccl.el. 1998-09-20 MORIOKA Tomohiko * mel-dl.el, README.en, FLIM-ELS: Rename mel-dl.el to mel-b-dl.el. * mel.el: - Rename mel-dl.el to mel-b-dl.el. - Move `mel-define-service' to mime-def.el. * mime-def.el (mel-define-service): New macro (moved from mel.el); fixed problem in Emacs. (mel-define-method): Use `mel-define-service'. (mel-define-method-function): Use `mel-define-service'. 1998-09-20 MORIOKA Tomohiko * mel.el (mime-encode-region): Don't regard nil encoding as "7bit". 1998-09-19 MORIOKA Tomohiko * eword-encode.el (eword-encode-text): Use `encoded-text-encode-string'. (tm-eword::encoded-word-length): `q-encoding-encoded-length' was renamed to `Q-encoded-text-length'. * eword-decode.el: Move `base64-token-regexp', `base64-token-padding-regexp', `eword-B-encoded-text-regexp' and `eword-Q-encoded-text-regexp' to mime-def.el. (eword-decode-encoded-text): Use `encoded-text-decode-string'. * mel-q.el: Define method functions of mel. (mime-insert-encoded-file): Use `mel-define-method'; abolish `quoted-printable-insert-encoded-file'. (mime-write-decoded-region): Use `mel-define-method'; abolish `quoted-printable-write-decoded-region'. - Move `q-encoding-printable-char-p' and `q-encoding-encoded-length' to mel.el. * mel-b.el: Define method functions of mel. (mime-insert-encoded-file): Use `mel-define-method'; abolish `base64-insert-encoded-file'. (mime-write-decoded-region): Use `mel-define-method'; abolish `base64-write-decoded-region'. - Move `base64-encoded-length' to mel.el. * mel-dl.el (base64-encode-region): Define directly (abolish `base64-dl-encode-region'). (base64-decode-region): Define directly (abolish `base64-dl-decode-region'). Define method functions of mel. (mime-insert-encoded-file): Use `mel-define-method'; abolish `base64-insert-encoded-file'; don't use external encoder. (mime-write-decoded-region): Use `mel-define-method'; abolish `base64-write-decoded-region'; don't use external decoder. - Move `base64-encoded-length' to mel.el. * mime.el: Move `mm-arglist-to-arguments' to mime-def.el. * mime-def.el (base64-token-regexp): New constant (moved from eword-decode.el). (base64-token-padding-regexp): Likewise. (B-encoded-text-regexp): New constant (moved from eword-decode.el, and renamed from `eword-B-encoded-text-regexp'). (Q-encoded-text-regexp): New constant (moved from eword-decode.el, and renamed from `eword-Q-encoded-text-regexp'. (mm-arglist-to-arguments): New function (moved from mime.el). (mel-define-method): New macro. (mel-define-method-function): New macro. (mel-define-function): New macro. * mel.el (mel-encoding-module-alist): New variable. (mel-use-module): New function. (mel-find-function): New function. (mel-define-service): New macro. (mime-encode-region): Use `mel-find-function'; abolish variable `mime-encoding-method-alist'. (mime-decode-region): Use `mel-find-function'; abolish variable `mime-decoding-method-alist'. (mime-decode-string): Use `mel-find-function'; abolish variable `mime-string-decoding-method-alist'. (encoded-text-encode-string): New function. (encoded-text-decode-string): New function. (base64-encoded-length): New function (moved from mel-b.el and mel-dl.el). (Q-encoding-printable-char-p): New function (moved from mel-q.el, and renamed from `q-encoding-printable-char-p'). (Q-encoded-text-length): New function (moved from mel-q.el, and renamed from `q-encoding-encoded-length'). (mime-insert-encoded-file): Use `mel-find-function'; abolish variable `mime-file-encoding-method-alist'. (mime-write-decoded-region): Use `mel-find-function'; abolish variable `mime-file-decoding-method-alist'. 1998-09-16 MORIOKA Tomohiko * mel-b.el (base64-internal-encoding-limit): modify :type. (base64-internal-decoding-limit): Change initial value to 70000; modify :type. * mel-b.el (base64-decode-string!): Renamed from `base64-internal-decode-string!'. 1998-09-16 MORIOKA Tomohiko * mel-b.el (base64-characters): New constant. (base64-num-to-char): Use `base64-characters'. (base64-numbers): Use `base64-characters'. (base64-internal-decode): Modify calculation third byte. * mel-dl.el (base64-dl-encode-string): New alias. (base64-dl-decode-string): New alias. (base64-dl-encode-region): Renamed from `base64-encode-region'; don't save-excursion and save-restriction. (base64-dl-decode-region): Renamed from `base64-decode-region'; don't save-excursion and save-restriction; convert all at once. (base64-encode-region): New alias. (base64-decode-region): New alias. * mel-b.el (base64-internal-decode): New function. (base64-internal-decode-string): Use `base64-internal-decode'. (base64-internal-decode-string!): New function. (base64-internal-decode-region): Use `base64-internal-decode-string!' instead of `base64-internal-decode-string'. 1998-09-15 Tanaka Akira * mel-b.el (base64-numbers): Fix a position of 63. 1998-09-15 MORIOKA Tomohiko * mel-b.el (base64-numbers): New constant. (base64-char-to-num): New macro. (base64-internal-decode-string): Don't use memq. 1998-09-15 MORIOKA Tomohiko * mel-b.el (base64): New group. (base64-external-encoder): Now a user option. (base64-external-decoder): Now a user option. (base64-external-decoder-option-to-specify-file): Now a user option. (base64-internal-encoding-limit): Now a user option. (base64-internal-decoding-limit): Now a user option. * mel-b.el (base64-internal-decode-string): New implementation; abolish function `base64-decode-unit'. 1998-09-15 MORIOKA Tomohiko * README.en (Installation): Fix typo. 1998-09-15 MORIOKA Tomohiko * FLIM: Version 1.9.2 (Shin-Tanabe) was released. * README.en (Installation): Add `install as a XEmacs package'. 1998-09-15 MORIOKA Tomohiko * mime-en.sgml (Encoding Method): Translate. 1998-09-15 MORIOKA Tomohiko * eword-encode.el (eword-encode-msg-id-to-rword-list): New function. (eword-encode-in-reply-to-to-rword-list): New function. (eword-encode-in-reply-to): New function. (eword-encode-field): Use `eword-encode-in-reply-to' for `In-Reply-To' field. * std11.el (std11-parse-in-reply-to): New function. 1998-09-14 MORIOKA Tomohiko * eword-decode.el (eword-decode-structured-field-list): Add `User-Agent'. 1998-09-11 MORIOKA Tomohiko * Makefile (package): Don't update auto-autoloads.el and custom-load.el. * FLIM-MK (compile-flim-package): Update auto-autoloads.el and custom-load.el. 1998-09-11 MORIOKA Tomohiko * mime-def.el: Abolish function `butlast' and `nbutlast'. * mime-def.el (mime-library-version): New constant. (mime-library-version-string): Refer `mime-library-version'. 1998-09-11 MORIOKA Tomohiko * Makefile (XEMACS): New variable. (PACKAGEDIR): New variable. (package): New target. (install-package): New target. * FLIM-CFG (PACKAGEDIR): New variable. * FLIM-MK (config-flim-package): New function. (compile-flim-package): New function. (install-flim-package): New function. 1998-09-10 MORIOKA Tomohiko * mime-en.sgml (Content-Type field): Translate. (mime-content-type): Translate. (Content-Type parser): Translate. (Content-Disposition): Translate. (mime-content-disposition): Translate. (Content-Disposition parser): Translate. 1998-09-10 MORIOKA Tomohiko * Makefile (GOMI): Add Texinfo related garbages. (clean): Delete historical setting. 1998-09-03 MORIOKA Tomohiko * mime-en.sgml (mm-backend): Translate. (Request for entity): Likewise. (mm-backend module): Likewise. * mime.el (mime-entity-send): Add DOC-string. 1998-09-01 MORIOKA Tomohiko * mime-en.sgml (Entity hierarchy): Translate. 1998-09-01 MORIOKA Tomohiko * mime-en.sgml, mime-ja.sgml (Entity): Rearrangement. 1998-08-31 MORIOKA Tomohiko * FLIM: Version 1.9.1 (Tonoshō) was released. * mime-en.sgml (mm-backend): Translate a little. 1998-08-31 MORIOKA Tomohiko * eword-encode.el (eword-encode-default-start-column): New user option. (eword-encode-string): Use `eword-encode-default-start-column'. (eword-encode-address-list): Likewise. (eword-encode-structured-field-body): Likewise. (eword-encode-unstructured-field-body): Likewise. 1998-08-31 MORIOKA Tomohiko * eword-encode.el (eword-encode): New group. (eword-field-encoding-method-alist): Now a user option (was: variable). 1998-08-31 MORIOKA Tomohiko * eword-encode.el: Rename `tm-eword::mailbox-to-rwl' -> `eword-encode-mailbox-to-rword-list'. * eword-encode.el: Rename `tm-eword::phrase-to-rwl' -> `eword-encode-phrase-to-rword-list'. * eword-encode.el: Rename `eword-addr-spec-to-rwl' -> `eword-encode-addr-spec-to-rword-list'. * eword-encode.el: Rename `eword-phrase-route-addr-to-rwl' -> `eword-encode-phrase-route-addr-to-rword-list'. * eword-encode.el: Rename `eword-addr-seq-to-rwl' -> `eword-encode-addr-seq-to-rword-list'. * eword-encode.el: Rename `tm-eword::split-string' -> `eword-encode-split-string'. * eword-encode.el: Rename `tm-eword::addresses-to-rwl' -> `eword-encode-addresses-to-rword-list'. * eword-encode.el: Rename `tm-eword::encode-rwl' -> `eword-encode-rword-list'. * eword-encode.el (eword-encode-unstructured-field-body): New function. (eword-encode-field): Use `eword-encode-unstructured-field-body'. 1998-08-31 MORIOKA Tomohiko * eword-encode.el (eword-encode-string): Add DOC-string. (eword-encode-address-list): Likewise. (eword-encode-structured-field-body): Likewise. * eword-encode.el (eword-encode-field): Regard `In-Reply-To' as a structured field. 1998-08-28 MORIOKA Tomohiko * eword-encode.el (eword-encode-field): Use `capitalize' instead of `downcase' for `field-name'. * eword-encode.el (eword-encode-structured-field-body): New function. (eword-encode-field): Use `eword-encode-structured-field-body' for "MIME-Version" and "User-Agent" field. 1998-08-26 Shuhei KOBAYASHI * mime-def.el (mm-define-method): Put `edebug-form-spec'. 1998-08-28 MORIOKA Tomohiko * eword-encode.el (eword-encode-address-list): New function. (eword-encode-field): Use `eword-encode-address-list' instead of `tm-eword::encode-address-list'; abolish `tm-eword::encode-address-list'. * eword-encode.el (eword-encode-field): Use `eword-encode-string' instead of `tm-eword::encode-string'; abolish `tm-eword::encode-string'. * eword-encode.el: Rename `tm-eword::make-rword' -> `make-ew-rword'; rename `tm-eword::rword-' -> `ew-rword-'. 1998-08-26 Shuhei KOBAYASHI * mel-b.el (base64-insert-encoded-file): Conditionally use internal converter. (cf. [tm-ja:3320]) (base64-write-decoded-region): Ditto. 1998-08-25 MORIOKA Tomohiko * FLIM-ELS (flim-modules): Don't add `mel-dl' unconditionally. 1998-08-25 MORIOKA Tomohiko * Delete mime-lib.el. 1998-08-10 MORIOKA Tomohiko * mmbuffer.el (write-entity): `write-region-as-CRLF' was renamed to `write-region-as-raw-text-CRLF'. 1998-08-07 MORIOKA Tomohiko * mmbuffer.el (write-entity): Use `write-region-as-CRLF' instead of `write-region-as-binary'. 1998-07-15 MORIOKA Tomohiko * FLIM: Version 1.9.0 (Terada) was released. 1998-07-10 MORIOKA Tomohiko * mime-parse.el (mime-parse-multipart): Set message/x-broken if parsing is failed. 1998-07-10 MORIOKA Tomohiko * mmbuffer.el (entity-children): Don't use `mime-entity-children-internal'. * mime-parse.el (mime-parse-multipart): Modify for `mime-parse-message'; return children. (mime-parse-encapsulated): Likewise. (mime-parse-message): Change interface; delete DOC-string; don't parse children instantly. (mime-parse-buffer): Modify for `mime-parse-message'. * mime-parse.el (mime-parse-message): Delete autoload cookie. * mime.el: Delete autoload setting for `mime-parse-message'. * mime-en.sgml, mime-ja.sgml (Entity creation): Delete description of `mime-parse-message'; modify description of `mime-parse-buffer' to add `representation-type'. 1998-07-07 MORIOKA Tomohiko * FLIM-Chao: Version 1.8.0 (Shijō) was released. 1998-07-07 MORIOKA Tomohiko * mmcooked.el: Abolish method `open'. * mmbuffer.el (initialize-instance): New method; abolish `open'. (entity-children): New method. * mime.el (mime-open-entity): Send `initialize-instance' to created message. (mime-entity-children): New implementation. (mime-entity-parent): New implementation. (mime-root-entity-p): New implementation. * mime-parse.el (mime-parse-multipart): Specify current entity as parent. (mime-parse-encapsulated): Likewise. (mime-parse-message): Change interface to specify parent; modify for `make-mime-entity-internal'. (mime-parse-buffer): Modify for `mime-parse-message'. * mime-def.el (make-mime-entity-internal): Change interface; add format of `mime-entity' to add `parent'. 1998-07-07 MORIOKA Tomohiko * mmbuffer.el (mime-visible-field-p): Renamed from `eword-visible-field-p'. 1998-07-07 MORIOKA Tomohiko * mime.el (mm-arglist-to-arguments): New function. (mm-define-generic): New macro. (mime-entity-cooked-p): Use `mm-define-generic'. (mime-entity-point-min): Use `mm-define-generic'. (mime-insert-decoded-header): Use `mm-define-generic'. (mime-entity-content): Use `mm-define-generic'. (mime-write-entity-content): Use `mm-define-generic'. (mime-write-entity): Use `mm-define-generic'. (mime-write-entity-body): Use `mm-define-generic'. 1998-07-07 MORIOKA Tomohiko * mmbuffer.el (eword-visible-field-p): Moved from mime.el. * mime.el: Move `eword-visible-field-p' to mmbuffer.el. (mime-write-entity-body): Change message to `write-body'. 1998-07-07 MORIOKA Tomohiko * mmcooked.el, mmbuffer.el (open): Renamed from `open-entity'. * mime.el (mime-open-entity): Change message to `open'. * mime-def.el (mm-define-backend): Must `copy-alist'. 1998-07-07 MORIOKA Tomohiko * mmcooked.el, mmbuffer.el: Use `mm-define-backend' and `mm-define-method'. * mime.el: Move `mime-entity-implementation-alist' to mime-def.el. (mime-find-function): New implementation. (mime-entity-cooked-p): Use `mime-entity-send'. * mime-def.el (mime-entity-implementation-alist): Moved from mime.el. (mm-define-backend): New macro. (mm-define-method): New macro. 1998-07-05 MORIOKA Tomohiko * FLIM: Version 1.8.1 (Kutsukawa) was released. 1998-07-04 MORIOKA Tomohiko * mime-en.sgml, mime-ja.sgml (Entity Attributes): Add description about `default-encoding' of `mime-entity-encoding'. * mime-en.texi, mime-en.sgml: New files. * mime-ja.sgml (media-type): Fix typo. * mime-ja.sgml (Glossary): Fix order. * mime-ja.sgml (Entity Attributes): Use tag for nil. * mime-ja.sgml (Entity Attributes): Fix typo. 1998-07-03 MORIOKA Tomohiko * mime.el (mime-entity-encoding): Add new optional argument `default-encoding'; set default encoding if Content-Transfer-Encoding field is not found. 1998-07-03 MORIOKA Tomohiko * mmbuffer.el (mmbuffer-write-entity): Use `mime-entity-buffer-internal', `mmbuffer-entity-point-min' and `mmbuffer-entity-point-max'. (mmbuffer-write-entity-body): Use `mime-entity-buffer-internal', `mime-entity-body-start-internal' and `mime-entity-body-end-internal'. (mmbuffer-insert-decoded-header): Use `mime-entity-buffer-internal', `mime-entity-header-start-internal' and `mime-entity-header-end-internal'. 1998-07-01 MORIOKA Tomohiko * FLIM: Version 1.8.0 (Ōkubo) was released. * README.en: Delete `How to use'. 1998-07-01 MORIOKA Tomohiko * mime-ja.sgml (Entity creation): Add reference for `mm-backend' in description of `mime-open-entity'. * mime-ja.sgml (mm-backend): New section. 1998-07-01 MORIOKA Tomohiko * mime-ja.sgml (Entity-header): Modify description about `mime-insert-decoded-header'. * mmcooked.el (mmcooked-insert-decoded-header): New function. * mmbuffer.el (mmbuffer-insert-decoded-header): New function. * mime.el (mime-insert-decoded-header): Use implementation of mm-backend; abolish optional argument `code-conversion'. 1998-06-30 MORIOKA Tomohiko * eword-decode.el (eword-decode-encoded-text): Use `decode-mime-charset-string'. 1998-06-30 MORIOKA Tomohiko * mmcooked.el (mmcooked-write-entity-body): New function. * mmbuffer.el (mmbuffer-write-entity-body): New function. * mime.el (mime-write-entity-body): Use implementation of mm-backend. 1998-06-30 MORIOKA Tomohiko * mmcooked.el (mmcooked-write-entity): New function. * mmbuffer.el (mmbuffer-write-entity): New function. * mime.el (mime-write-entity): Use implementation of mm-backend. 1998-06-30 MORIOKA Tomohiko * mmcooked.el (mmcooked-entity-content): New alias for `mmbuffer-entity-content'. (mmcooked-write-entity-content): New function. * mmbuffer.el (mmbuffer-entity-content): New function. (mmbuffer-write-entity-content): New function. * mime.el (mime-entity-send): New function. (mime-entity-buffer): Use `mime-entity-send'. (mime-entity-point-min): Likewise. (mime-entity-point-max): Likewise. (mime-entity-header-start): Likewise. (mime-entity-header-end): Likewise. (mime-entity-body-start): Likewise. (mime-entity-body-end): Likewise. (mime-fetch-field): Likewise. (mime-entity-content): Use implementation of mm-backend. (mime-write-entity-content): Likewise. 1998-06-30 MORIOKA Tomohiko * FLIM: Version 1.7.0 (Iseda) was released. * mime-ja.sgml (Entity creation): Add description of `mime-open-entity'. (Entity Attributes): Add description of `mime-entity-cooked-p'. (Entity-content): Add description of `mime-write-entity-content', `mime-write-entity' and `mime-write-entity-body'. 1998-06-29 MORIOKA Tomohiko * mime.el (mime-write-entity-content): New function. 1998-06-28 MORIOKA Tomohiko * mime.el (mime-write-entity-body): New function. * mime.el (mime-write-entity): New function. 1998-06-28 MORIOKA Tomohiko * mime-parse.el (mime-parse-multipart): Change media-type of entity to application/octet-stream if the first delimiter is not found. 1998-06-28 MORIOKA Tomohiko * FLIM-ELS (flim-modules): Add `mmbuffer' and `mmcooked'. * mmcooked.el: New file. * mmbuffer.el: New file. * mime.el (mime-entity-implementation-alist): New variable. (mime-find-function): New function. (mime-open-entity): New function. (mime-entity-function): New function. (mime-entity-cooked-p): New function. (mime-entity-buffer): Use backend-module. (mime-entity-point-min): Likewise. (mime-entity-point-max): Likewise. (mime-entity-header-start): Likewise. (mime-entity-header-end): Likewise. (mime-entity-body-start): Likewise. (mime-entity-body-end): Likewise. (mime-fetch-field): Likewise. * mime-parse.el (mime-parse-message): New optional argument `representation-type'. (mime-parse-buffer): Likewise. * mime-def.el: Change format of mime-entity-internal to add `representation-type' and `location'. 1998-06-28 MORIOKA Tomohiko * FLIM-Chao: Version 1.7.0 (Gojō) was released. 1998-06-26 MORIOKA Tomohiko * mime-ja.sgml: Modify for FLIM 1.7. * mime.el (mime-entity-number): Add DOC. 1998-06-26 MORIOKA Tomohiko * mime.el (mime-entity-encoding): New implementation. * mime-parse.el (mime-parse-message): Abolish argument `encoding'. * mime-def.el (make-mime-entity-internal): Abolish argument `encoding'. (mime-entity-set-encoding-internal): New function. 1998-06-26 MORIOKA Tomohiko * mime.el (mime-entity-content-disposition): New implementation. * mime-parse.el (mime-parse-message): Don't parse Content-Disposition. * mime-def.el (make-mime-entity-internal): Delete argument `content-disposition'. (mime-entity-set-content-disposition-internal): New function. 1998-06-25 MORIOKA Tomohiko * eword-decode.el: Move function `eword-visible-field-p' and `mime-insert-decoded-header' to mime.el. * mime-parse.el: Use internal functions of mime-entity. * mime.el (mime-entity-children): Moved from mime-def.el; use `mime-entity-children-internal'. (mime-entity-node-id): Moved from mime-def.el; use `mime-entity-node-id-internal'. (mime-entity-number): Moved from mime-def.el; use `mime-entity-node-id-internal'. (mime-entity-buffer): Moved from mime-def.el; use `mime-entity-buffer-internal'. (mime-entity-point-min): Moved from mime-def.el; use `mime-entity-header-start-internal'. (mime-entity-point-max): Moved from mime-def.el; use `mime-entity-body-end-internal'. (mime-entity-header-start): Moved from mime-def.el; use `mime-entity-header-start-internal'. (mime-entity-header-end): Moved from mime-def.el; use `mime-entity-header-end-internal'. (mime-entity-content-type): Moved from mime-def.el; use `mime-entity-content-type-internal'. (mime-entity-content-disposition): Moved from mime-def.el; use `mime-entity-content-disposition-internal'. (mime-entity-encoding): Moved from mime-def.el; use `mime-entity-encoding-internal'. (mime-fetch-field): Use `mime-entity-original-header-internal' and `mime-entity-set-original-header-internal'. (mime-read-field): Use `mime-entity-parsed-header-internal' and `mime-entity-set-parsed-header-internal'. (eword-visible-field-p): Moved from eword-decode.el. (mime-insert-decoded-header): Moved from eword-decode.el. (mime-entity-body-start): Moved from mime-def.el; use `mime-entity-body-start-internal'. (mime-entity-body-end): Moved from mime-def.el; use `mime-entity-body-end-internal'. (mime-entity-media-type): Moved from mime-def.el. (mime-entity-media-subtype): Moved from mime-def.el. (mime-entity-parameters): Moved from mime-def.el. (mime-entity-type/subtype): Moved from mime-def.el. * mime-def.el (make-mime-entity-internal): Renamed from `make-mime-entity'. (mime-entity-buffer-internal): New function. (mime-entity-header-start-internal): New function. (mime-entity-header-end-internal): New function. (mime-entity-body-start-internal): New function. (mime-entity-body-end-internal): New function. (mime-entity-node-id-internal): New function. (mime-entity-content-type-internal): New function. (mime-entity-content-disposition-internal): New function. (mime-entity-encoding-internal): New function. (mime-entity-original-header-internal): New function. (mime-entity-children-internal): New function. (mime-entity-parsed-header-internal): New function. (mime-entity-set-original-header-internal): Renamed from `mime-entity-set-original-header'. (mime-entity-set-children-internal): Renamed from `mime-entity-set-children'. (mime-entity-set-parsed-header-internal): Renamed from `mime-entity-set-parsed-header'. Move `mime-entity-SLOT' functions to mime.el. 1998-06-25 MORIOKA Tomohiko * mime-ja.sgml (CVS): Fix typo. 1998-06-24 MORIOKA Tomohiko * mime-parse.el (mime-parse-encapsulated): New function. (mime-parse-message): Use `mime-parse-encapsulated'. 1998-06-24 MORIOKA Tomohiko * mime-def.el (mime-entity-set-children): New function. * mime-parse.el (mime-parse-multipart): Change interface. (mime-parse-message): Use `mime-entity-set-children'. 1998-06-24 Shuhei KOBAYASHI * mime.el (mime-read-field): Fix typo. 1998-06-24 MORIOKA Tomohiko * FLIM: Version 1.6.0 (Ogura) was released. * mime-ja.sgml (Entity Attributes): New section. * mime-ja.sgml (Entity as node in message): Add description of `mime-find-entity-from-number' and `mime-find-entity-from-node-id'. * mime.el (mime-find-entity-from-number): New function. (mime-find-entity-from-node-id): New function. (mime-entity-parent): New function (moved from SEMI MIME-View). (mime-entity-uu-filename): New function (moved from SEMI MIME-View). (mime-entity-filename): New function (moved from SEMI MIME-View). * mime-def.el (mime-uuencode-encoding-name-list): New variable. 1998-06-24 MORIOKA Tomohiko * mime-ja.sgml: Modify for FLIM 1.6. * mime.el (mime-fetch-field): New function; abolish `mime-entity-fetch-field'. (mime-read-field): New function; abolish `mime-entity-read-field'. 1998-06-23 MORIOKA Tomohiko * mime-ja.sgml, mime-ja.texi: New files. 1998-06-22 Shuhei KOBAYASHI * mime-parse.el (mime-parse-message): Would error if empty body. 1998-06-22 MORIOKA Tomohiko * FLIM: Version 1.5.0 (Mukaijima) was released. 1998-06-21 MORIOKA Tomohiko * README.en (What's FLIM): Modify for mime.el. * FLIM-ELS (flim-modules): Add `mime'. * mime-lib.el: Move every definitions to mime.el. * mime.el: New module (renamed from mime-lib.el). 1998-06-21 MORIOKA Tomohiko * mime-lib.el: Add autoload setting for eword-encode.el. * mime-lib.el (mime-entity-content): New function. 1998-06-20 MORIOKA Tomohiko * mel.el: Abolish constant `mel-version'. * mel.el (mime-string-decoding-method-alist): New variable. (mime-decode-string): New function. 1998-06-20 MORIOKA Tomohiko * mel-b.el (base64-external-decode-string): New function. (base64-decode-string): New function. 1998-06-20 MORIOKA Tomohiko * mel-q.el (quoted-printable-decode-string): New implementation. 1998-06-20 MORIOKA Tomohiko * mel-q.el (quoted-printable-internal-decode-region): New implementation. 1998-06-20 MORIOKA Tomohiko * mel-q.el (q-encoding-decode-string): Use `quoted-printable-hex-char-to-num'. * mel-q.el (quoted-printable-hex-char-to-num): New function. (quoted-printable-decode-string): Use `quoted-printable-hex-char-to-num'. 1998-06-19 MORIOKA Tomohiko * mime-def.el, mime-parse.el: Move `mime-message-structure' from mime-parse.el to mime-def.el. 1998-06-19 MORIOKA Tomohiko * mime-lib.el, mime-parse.el: Move `mime-root-entity-p' from mime-parse.el to mime-lib.el. * mime-lib.el: Add autoload setting for mime-parse.el. 1998-06-19 MORIOKA Tomohiko * mime-parse.el, mime-def.el: Move `mime-entity-point-min', `mime-entity-point-max', `mime-entity-media-type', `mime-entity-media-subtype', `mime-entity-parameters' and `mime-entity-type/subtype' from mime-parse.el to mime-def.el. * mime-parse.el, mime-def.el: Move `mime-content-disposition' reference functions from mime-parse.el to mime-def.el. * mime-parse.el, mime-def.el: Move structure `mime-content-type' from mime-parse.el to mime-def.el. 1998-06-19 MORIOKA Tomohiko * mel-b.el (base64-internal-decode-string): Renamed from `base64-decode-string'. (base64-decode-string): New alias for `base64-internal-decode-string'. 1998-06-19 MORIOKA Tomohiko * mel-b.el (base64-decode-unit): New function; abolish `base64-decode-1'. (base64-decode-string): New implementation. (base64-internal-decode-region): New implementation. 1998-06-19 MORIOKA Tomohiko * mime-parse.el (mime-message-structure): New variable. (mime-parse-buffer): New function. 1998-06-19 Shuhei KOBAYASHI * mime-def.el: Require 'cl when it is compiled. * mime-lib.el (mime-entity-read-field): Fix typo. Use `eword-decode-ignored-field-list'. * mime-parse.el (mime-parse-multipart): Fix typo. (mime-parse-message): Parse message/external-body. 1998-06-19 MORIOKA Tomohiko * FLIM: Version 1.4.1 (Momoyama-Goryōmae) was released. 1998-06-18 MORIOKA Tomohiko * eword-decode.el (mime-insert-decoded-header): Fix typo. 1998-06-18 MORIOKA Tomohiko * FLIM: Version 1.4.0 (Kintetsu-Tanbabashi) was released. 1998-06-18 MORIOKA Tomohiko * README.en (What's FLIM): Add description about mime-lib.el and mime-parse.el. 1998-06-17 MORIOKA Tomohiko * mime-parse.el: Require 'cl when it is compiled. * eword-decode.el (eword-visible-field-p): New function. (mime-insert-decoded-header): Use `eword-visible-field-p'. 1998-06-17 MORIOKA Tomohiko * mime-def.el (mime-library-version-string): Renamed from `mime-spadework-module-version-string'. * mime-parse.el: New file; moved from SEMI layer. * FLIM-ELS (flim-modules): Add `mime-parse'. 1998-06-17 MORIOKA Tomohiko * FLIM-ELS (flim-modules): Add `mime-lib'. * mime-lib.el: New module. * mime-def.el (mime-entity): Add new slots for original-header and parsed-header. (mime-entity-set-original-header): New function. (mime-entity-set-parsed-header): New function. 1998-06-16 MORIOKA Tomohiko * mime-def.el (mime-entity-number): New function (moved from SEMI layer). 1998-06-16 MORIOKA Tomohiko * mime-def.el: Move definition of structure `mime-entity' from SEMI layer. 1998-06-16 MORIOKA Tomohiko * eword-decode.el (eword-decode-ignored-field-list): Capitalize default value. (eword-decode-structured-field-list): Capitalize default value. (eword-decode-header): Regularize field name by `capitalize'. (mime-insert-decoded-header): New function. 1998-06-15 MORIOKA Tomohiko * mailcap.el (mailcap-file): Use `defcustom'. 1998-06-01 MORIOKA Tomohiko * FLIM: Version 1.3.0 (Fushimi) was released. 1998-05-28 MORIOKA Tomohiko * std11.el (std11-fetch-field): New function. (std11-field-body): Use 'std11-fetch-field. 1998-05-28 MORIOKA Tomohiko * mime-def.el (regexp-*): New function (moved from mime-parse.el of SEMI (REMI)). (regexp-or): New function (moved from mime-parse.el of SEMI (REMI)). (std11-quoted-pair-regexp): New constant (moved from mime-parse.el of SEMI (REMI)). (std11-non-qtext-char-list): New constant (copied from std11.el). (std11-qtext-regexp): New constant (moved from mime-parse.el of SEMI (REMI)). (std11-quoted-string-regexp): New constant (moved from mime-parse.el of SEMI (REMI)). 1998-05-17 MORIOKA Tomohiko * FLIM: Version 1.2.2 (Takeda) was released. * FLIM-VERSION: New file. 1998-05-15 MORIOKA Tomohiko * mel-q.el (quoted-printable-internal-encode-region): Use 'looking-at-as-unibyte instead of local binding for enable-multibyte-characters. 1998-05-09 MORIOKA Tomohiko * FLIM: Version 1.2.1 (Kamitobaguchi) was released. 1998-05-09 MORIOKA Tomohiko * mel-q.el (quoted-printable-internal-decode-region): Use 'string-as-multibyte to avoid problem in Emacs 20.3. 1998-05-08 Katsumi Yamaoka * mel-u.el: Use mime-temp-directory instead of TMP. 1998-05-06 MORIOKA Tomohiko * FLIM: Version 1.2.0 (Jūjō) was released. * README.en (What's FLIM): Delete description about std11-parse.el; add description about mailcap.el. 1998-05-06 MORIOKA Tomohiko * eword-decode.el (eword-decode-encoded-word-error-handler): New variable. (eword-decode-encoded-word-default-error-handler): New function. (eword-decode-encoded-word): Use 'eword-decode-encoded-word-error-handler. 1998-05-06 MORIOKA Tomohiko * mailcap.el: Require 'mime-def. * mime-def.el (mime-type/subtype-string): New function (moved from semi/mime-parse.el). 1998-05-06 MORIOKA Tomohiko * std11-parse.el: Abolish std11-parse.el. * FLIM-ELS (flim-modules): Abolish 'std11-parse. * eword-decode.el: Require 'std11 instead of 'std11-parse. * std11.el: Merge std11-parse.el. 1998-05-06 MORIOKA Tomohiko * mime-def.el (mime-temp-directory): Use 'defcustom. * mel-u.el: Require 'mime-def instead of 'mel. * mime-def.el (mime-temp-directory): New variable (moved from mel.el). * mel.el: Move definition of 'mime-temp-directory to mime-def.el. 1998-05-06 MORIOKA Tomohiko * mailcap.el (mailcap-format-command): New function. * mailcap.el (mailcap-look-at-mtext): Don't strip quoted character again. 1998-05-05 MORIOKA Tomohiko * FLIM: Version 1.1.0 (Tōji) was released. 1998-05-04 MORIOKA Tomohiko * mime-def.el (quoted-printable-hex-chars): New constant. (quoted-printable-octet-regexp): New constant. * mel-q.el, eword-decode.el: Move definition of constant 'quoted-printable-hex-chars and 'quoted-printable-octet-regexp to mime-def.el. 1998-05-03 MORIOKA Tomohiko * mailcap.el (mailcap-look-at-mtext): Strip quoted character. 1998-05-03 MORIOKA Tomohiko * mailcap.el (mailcap-look-at-mtext): Fix typo. 1998-05-03 MORIOKA Tomohiko * FLIM-ELS (flim-modules): Add mailcap. * mailcap.el: New file (copied from SEMI). 1998-04-23 Shuhei KOBAYASHI * eword-decode.el (eword-decode-ignored-field-list): Add `received'. * mel.el (mime-temp-directory): Use TMPDIR, TMP, or TEMP environment variables. 1998-04-17 MORIOKA Tomohiko * FLIM: Version 1.0.1 (Kyōto) was released. * mime-def.el (mime-spadework-module-version-string): New constant. * eword-encode.el: Abolish constant 'eword-encode-version. * eword-decode.el: Abolish constant 'eword-decode-version. 1998-04-17 MORIOKA Tomohiko * eword-encode.el (eword-encode-divide-into-charset-words): Use 'char-length or 'char-next-index instead of 'char-bytes. (tm-eword::encode-string-1): Use 'char-next-index instead of 'char-bytes. 1998-04-17 MORIOKA Tomohiko * mel.el (base64-dl-module): Must check base64.so actually exists. 1998-04-13 MORIOKA Tomohiko * FLIM: Version 1.0.0 was released. * README.en: Modify for FLIM. * ChangeLog: New file. 1998-04-13 MORIOKA Tomohiko * FLIM-CFG, FLIM-ELS, FLIM-MK: New files. * Makefile: Modify for FLIM. 1998-04-10 MORIOKA Tomohiko * Makefile: New file. * mime-def.el, std11-parse.el, std11.el, eword-decode.el, eword-encode.el: Copied from MEL, SEMI (mime-def.el eword-decode.el eword-encode.el) and APEL (std11-parse.el std11.el). wanderlust-flim-2cf5a78/FLIM-API.en000066400000000000000000000530541436773573300167630ustar00rootroot00000000000000 FLIM (Faithful Library about Internet Message) API Version 1.14 Draft Release 3 * Notation Each function is described by following notation: [Function] NAME-OF-FUNCTION (SIGNATURE) DESCRIPTIONS [ILEVEL] Each inline function is described by following notation: [Inline function] NAME-OF-FUNCTION (SIGNATURE) DESCRIPTIONS [ILEVEL] Each macro is described by following notation: [Macro] NAME-OF-MACRO (SIGNATURE) DESCRIPTIONS [ILEVEL] Each variable is described by following notation: [Variable] NAME-OF-VARIABLE DESCRIPTIONS [ILEVEL] ILEVEL specifies implementation level: Required: Must implement Suggest: Should implement Optional: Optional ULEVEL specifies implementation level: Suggest: Should use Not Suggest: Should not use Obsolete: Should not use (historical) * MIME entity ** How to use (require 'mime) ** MIME-Entity Creation [Function] mime-open-entity (type location) Open an entity and return it. TYPE is representation-type. LOCATION is location of entity. Specification of it is depended on representation-type. [Required] (Usage: SEMI 1.14 MIME-View) [Function] mime-parse-buffer (&optional buffer representation-type) Parse BUFFER as a MIME message. If buffer is omitted, it parses current-buffer. [Optional] ** MIME-Entity Hierarchy [Function] mime-entity-children (entity) Return list of entities included in the ENTITY. [Required] (Usage: SEMI 1.14 MIME-View, MIME-PGP) [Function] mime-entity-parent (entity &optional message) Return mother entity of ENTITY. If MESSAGE is specified, it is regarded as root entity. [Suggest] (Usage: SEMI 1.14 MIME-View, MIME-PGP) [Function] mime-find-root-entity (entity) Return root entity of ENTITY. [Suggest] [Function] mime-root-entity-p (entity &optional message) Return t if ENTITY is root-entity (message). If MESSAGE is specified, it is regarded as root entity. [Suggest] [Function] mime-entity-node-id (entity) Return node-id of ENTITY. [Suggest] (Usage: SEMI 1.14 MIME-View, MIME-PGP) [Function] mime-entity-number (entity) Return entity-number of ENTITY. [Optional] (Usage: SEMI 1.14 MIME-View, MIME-PGP) ** MIME-Entity Search [Function] mime-find-entity-from-node-id (entity-node-id message) Return entity from ENTITY-NODE-ID in MESSAGE. [Suggest] [Function] mime-find-entity-from-number (entity-number message) Return entity from ENTITY-NUMBER in MESSAGE. [Optional] [Function] mime-find-entity-from-content-id (cid message) Return entity from CID in MESSAGE. [Suggest] ** MIME-Entity Attributes [Function] mime-entity-content-type (entity) Return content-type of ENTITY. (cf. <** Content-Type>) [Suggest] (Usage: SEMI 1.14 MIME-View) [Inline function] mime-entity-media-type (entity) Return primary media-type of ENTITY. [Suggest] (Usage: SEMI 1.14 MIME-View) [Inline function] mime-entity-media-subtype (entity) Return media-subtype of ENTITY. [Suggest] (Usage: SEMI 1.14 MIME-View) [Inline function] mime-entity-type/subtype (entity) Return media-type/subtype of ENTITY. [Suggest] (Usage: SEMI 1.14 MIME-W3) [Inline function] mime-entity-parameters (entity) Return parameters of Content-Type of ENTITY. [Suggest] (Usage: SEMI 1.14 MIME-View) [Function] mime-entity-set-content-type (entity content-type) Set ENTITY's content-type to CONTENT-TYPE. (cf. <** Content-Type>) [Suggest] (Usage: SEMI 1.14 MIME-View) [Function] mime-entity-content-disposition (entity) Return content-disposition of ENTITY. (cf. <** Content-Disposition>) [Suggest] (Usage: SEMI 1.14 MIME-View) [Function] mime-entity-filename (entity) Return filename of ENTITY. [Suggest] (Usage: SEMI 1.14 MIME-View) [Function] mime-entity-encoding (entity) Return content-transfer-encoding of ENTITY. If the ENTITY does not have valid Content-Transfer-Encoding field, return nil. [Suggest] (Usage: SEMI 1.14 MIME-View) [Function] mime-entity-set-encoding (entity encoding) Set ENTITY's content-transfer-encoding to ENCODING. [Suggest] (Usage: SEMI 1.14 MIME-View) [Function] mime-entity-cooked-p (entity) Return non-nil if contents of ENTITY has been already code-converted. [Suggest] (Usage: SEMI 1.14 MIME-PGP) [Function] mime-entity-name (entity) Return unique name of the ENTITY. [Suggest] (Usage: SEMI 1.14 MIME-View) ** MIME-Entity Header [Function] mime-entity-fetch-field (entity field-name) Return the value of the ENTITY's header field whose type is FIELD-NAME. The results is network representation. If FIELD-NAME field is not found, this function returns nil. [Required] (Usage: SEMI 1.14 MIME-View, MIME-BBDB) [Function] mime-entity-read-field (entity field-name) Parse FIELD-NAME field in header of ENTITY, and return the result. Format of result is depended on kind of field. For non-structured field, this function returns string. For structured field, it returns list corresponding with structure of the field. Strings in the result will be converted to internal representation of Emacs. If FIELD-NAME field is not found, this function returns nil. [Suggest] (Usage: SEMI 1.14 MIME-View, MIME-BBDB) ** Text Presentation of MIME-Entity Content [Function] mime-insert-header (entity &optional invisible-fields visible-fields) Insert before point a decoded header of ENTITY. INVISIBLE-FIELDS is list of regexps to match field-name to hide. VISIBLE-FIELDS is list of regexps to match field-name to hide. If a field-name is matched with some elements of INVISIBLE-FIELDS and matched with none of VISIBLE-FIELDS, this function don't insert the field. Each encoded-word in the header is decoded. ``Raw non us-ascii characters'' are also decoded as `default-mime-charset'. [Suggest] [Function] mime-insert-text-content (entity) Insert before point a contents of ENTITY as text entity. Contents of the ENTITY are decoded as MIME charset. If the ENTITY does not have charset parameter of Content-Type field, `default-mime-charset' is used as default value. [Required] [Variable] default-mime-charset Symbol to indicate default value of MIME charset. It is used when MIME charset is not specified. It is originally variable of APEL. [Required] ** Bytes Representation of MIME-Entity Content [Function] mime-entity-content (entity) Return content of ENTITY as byte sequence (string). [Required] (Usage: SEMI 1.14 MIME-View, Postpet) [Function] mime-insert-entity-content (entity) Insert content of ENTITY (byte sequence) at point. [Suggest] [Function] mime-write-entity-content (entity filename) Write content of ENTITY (byte sequence) into FILENAME. [Required] ** Network Representation of MIME-Entity [Function] mime-entity-string (entity) Return header and body of ENTITY (string). [Optional] [Function] mime-insert-entity (entity) Insert header and body of ENTITY at point. [Required] [Function] mime-write-entity (entity filename) Write header and body of ENTITY into FILENAME. [Required] [Function] mime-entity-header (entity) Return network representation of ENTITY header (string). [Optional] [Function] mime-insert-entity-header (entity) Insert network representation of ENTITY header at point. [Optional] [Function] mime-write-entity-header (entity filename) Write network representation of ENTITY header FILENAME. [Optional] [Function] mime-entity-body (entity) Return network representation of ENTITY body (string). [Optional] [Function] mime-insert-entity-body (entity) Insert network representation of ENTITY body at point. [Required] [Function] mime-write-entity-body (entity filename) Write body of ENTITY into FILENAME. [Required] * MIME content information ** How to use (require 'mime) ** Content-Type [Function] mime-parse-Content-Type (string) Parse STRING as field-body of Content-Type field, and return the result as `mime-content-type' structure. [Suggest] [Function] mime-read-Content-Type () Read field-body of Content-Type field from current-buffer, and return the parsed result. Format of return value is as same as `mime-parse-Content-Type'. Return `nil' if Content-Type field is not found. [Suggest] [Inline function] mime-content-type-primary-type (content-type) Return primary-type of CONTENT-TYPE. [Required] [Inline function] mime-content-type-subtype (content-type) Return subtype of CONTENT-TYPE. [Required] [Inline function] mime-content-type-parameter (content-type parameter) Return PARAMETER value of CONTENT-TYPE. [Required] [Inline function] mime-content-type-parameters (content-type) Return parameters of CONTENT-TYPE. [Suggest] [Inline function] mime-type/subtype-string (type &optional subtype) Return type/subtype string from TYPE and SUBTYPE. [Suggest] ** Content-Disposition [Function] mime-parse-Content-Disposition (string) Parse STRING as field-body of Content-Disposition field. [Suggest] [Function] mime-read-Content-Disposition () Read field-body of Content-Disposition field from current-buffer, and return parsed it. [Suggest] [Inline function] mime-content-disposition-type (content-disposition) Return disposition-type of CONTENT-DISPOSITION. [Required] [Inline function] mime-content-disposition-parameter (content-disposition parameter) Return PARAMETER value of CONTENT-DISPOSITION. [Required] [Inline function] mime-content-disposition-filename (content-disposition) Return filename of CONTENT-DISPOSITION. [Suggest] [Inline function] mime-content-disposition-parameters (content-disposition) Return disposition-parameters of CONTENT-DISPOSITION. [Suggest] * encoded-word ** How to use (require 'mime) ** decoder [Function] mime-decode-header-in-buffer (&optional code-conversion separator) Decode MIME encoded-words in header fields. If CODE-CONVERSION is nil, it decodes only encoded-words. If it is mime-charset, it decodes non-ASCII bit patterns as the mime-charset. Otherwise it decodes non-ASCII bit patterns as the default-mime-charset. If SEPARATOR is not nil, it is used as header separator. [Suggest] [Function] eword-decode-header (&optional code-conversion separator) As same as `mime-decode-header-in-buffer', q.v. Note that (require 'eword-decode) is necessary to use this function. [Optional] (Usage: cmail 2.61) [Function] mime-decode-header-in-region (start end &optional code-conversion) Decode MIME encoded-words in region between START and END. If CODE-CONVERSION is nil, it decodes only encoded-words. If it is mime-charset, it decodes non-ASCII bit patterns as the mime-charset. Otherwise it decodes non-ASCII bit patterns as the default-mime-charset. [Suggest] [Function] mime-decode-field-body (field-body field-name &optional mode max-column) Decode FIELD-BODY as FIELD-NAME in MODE, and return the result. Optional argument MODE must be `plain', `wide', `summary' or `nov'. Default mode is `summary'. If MODE is `wide' and MAX-COLUMN is non-nil, the result is folded with MAX-COLUMN. Non MIME encoded-word part in FILED-BODY is decoded with `default-mime-charset'. [Required] [Function] mime-set-field-decoder (field &rest specs) Set decoder of FIELD. SPECS must be like `MODE1 DECODER1 MODE2 DECODER2 ...'. Each mode must be `nil', `plain', `wide', `summary' or `nov'. If mode is `nil', corresponding decoder is set up for every modes. [Suggest] [Macro] mime-find-field-presentation-method (name) Return field-presentation-method from NAME. NAME must be `plain', `wide', `summary' or `nov'. [Suggest] [Function] mime-find-field-decoder (field &optional mode) Return function to decode field-body of FIELD in MODE. Optional argument MODE must be object or name of field-presentation-method. Name of field-presentation-method must be `plain', `wide', `summary' or `nov'. Default value of MODE is `summary'. [Suggest] [Function] mime-update-field-decoder-cache (field mode &optional function) Update field decoder cache `mime-field-decoder-cache'. [Suggest] ** encoder [Function] mime-encode-header-in-buffer (&optional code-conversion) Encode header fields to network representation, such as MIME encoded-word. It refer variable `mime-field-encoding-method-alist'. [Suggest] [Function] mime-encode-field-body (field-body field-name) Encode FIELD-BODY as FIELD-NAME, and return the result. A lexical token includes non-ASCII character is encoded as MIME encoded-word. ASCII token is not encoded. [Required] * Content-Transfer-Encoding ** How to use (require 'mel) ** Encoding Name [Variable] mime-encoding-list List of Content-Transfer-Encoding. Each encoding must be string. [Suggest] [Function] mime-encoding-list (&optional service) Return list of Content-Transfer-Encoding. If SERVICE is specified, it returns available list of Content-Transfer-Encoding for it. [Required] [Function] mime-encoding-alist (&optional service) Return table of Content-Transfer-Encoding for completion. [Suggest] ** String [Function] mime-decode-string (string encoding) Decode STRING using ENCODING. ENCODING must be string. If ENCODING is found in `mime-encoding-list', this function decodes the STRING by its value. [Required] [Function] mime-encode-string (string encoding) Encode STRING using ENCODING. ENCODING must be string. [Required] [Function] base64-decode-string (STRING) Base64-decode STRING and return the result. [Required] [Function] base64-encode-string (STRING &optional NO-LINE-BREAK) Base64-encode STRING and return the result. Optional second argument NO-LINE-BREAK means do not break long lines into shorter lines. [Required] ** File [Command] mime-write-decoded-region (start end filename encoding) Decode and write current region encoded by ENCODING into FILENAME. START and END are buffer positions. [Required] [Command] mime-insert-encoded-file (filename encoding) Insert file FILENAME encoded by ENCODING format. [Required] [Command] 7bit-write-decoded-region (start end filename) Decode and write current region encoded by "7bit" into FILENAME. START and END are buffer positions. [Optional] [Command] 7bit-insert-encoded-file (filename) Insert file FILENAME encoded by "7bit" format. [Optional] [Command] 8bit-write-decoded-region (start end filename) Decode and write current region encoded by "8bit" into FILENAME. START and END are buffer positions. [Optional] [Command] 8bit-insert-encoded-file (filename) Insert file FILENAME encoded by "8bit" format. [Optional] [Command] binary-write-decoded-region (start end filename) Decode and write current region encoded by "binary" into FILENAME. START and END are buffer positions. [Required] [Command] binary-insert-encoded-file (filename) Insert file FILENAME encoded by "binary" format. [Required] [Command] base64-write-decoded-region (start end filename) Decode and write current region encoded by "base64" into FILENAME. START and END are buffer positions. [Optional] [Command] base64-insert-encoded-file (filename) Insert file FILENAME encoded by "base64" format. [Optional] [Command] quoted-printable-write-decoded-region (start end filename) Decode and write current region encoded by "quoted-printable" into FILENAME. START and END are buffer positions. [Optional] [Command] quoted-printable-insert-encoded-file (filename) Insert file FILENAME encoded by "quoted-printable" format. [Optional] ** Region [Command] mime-decode-region (start end encoding) Decode region START to END of current buffer using ENCODING. ENCODING must be string. [Suggest] [Command] mime-encode-region (start end encoding) Encode region START to END of current buffer using ENCODING. ENCODING must be string. [Suggest] [Command] base64-decode-region (BEG END) Base64-decode the region between BEG and END. Return the length of the decoded text. If the region can't be decoded, return nil and don't modify the buffer. [Suggest] [Command] base64-encode-region (BEG END &optional NO-LINE-BREAK) Base64-encode the region between BEG and END. Return the length of the encoded text. Optional third argument NO-LINE-BREAK means do not break long lines into shorter lines. [Suggest] ** encoded-text [Function] encoded-text-decode-string (string encoding) Decode STRING as encoded-text using ENCODING. ENCODING must be string. [Suggest] [Function] encoded-text-encode-string (string encoding &optional mode) Encode STRING as encoded-text using ENCODING. ENCODING must be string. MODE allows `text', `comment', `phrase' or nil. Default value is `phrase'. [Suggest] [Function] base64-encoded-length (string) Return length of B-encoded STRING. [Suggest] [Function] Q-encoded-text-length (string &optional mode) Return length of Q-encoded STRING. MODE allows `text', `comment', `phrase' or nil. Default value is `phrase'. [Suggest] * Mailcap ** How to use (require 'mime-conf) ** Parsing [Function] mime-parse-mailcap-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. [Required] [Variable] mime-mailcap-file File name of user's mailcap file. [Required] (default value may be "~/.mailcap") [Function] mime-parse-mailcap-file (&optional filename order) Parse FILENAME 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. [Required] ** Apply [Function] mime-format-mailcap-command (mtext situation) Return formated command string from MTEXT and SITUATION. MTEXT is a command text of mailcap specification, such as view-command. SITUATION is an association-list about information of entity. Its key may be: 'type primary media-type 'subtype media-subtype 'filename filename STRING parameter of Content-Type field [Required] * MIME Field ** How to use (require 'mime) ** Parsing [Variable] mime-field-parser-alist Alist to specify field parser. [Suggest] [Function] mime-parse-msg-id (tokens) Parse TOKENS as msg-id of Content-Id or Message-Id field. [Suggest] [Function] mime-uri-parse-cid (string) Parse STRING as cid URI. [Suggest] [Function] mime-parse-Content-Transfer-Encoding (string) Parse STRING as field-body of Content-Transfer-Encoding field. If STRING is not a valid Content-Transfer-Encoding field, return nil. [Suggest] [Function] mime-read-Content-Transfer-Encoding () Read field-body of Content-Transfer-Encoding field from current-buffer, and return it. [Suggest] * STD 11 ** How to use (require 'std11) ** Header [Function] std11-narrow-to-header (&optional boundary) Narrow to the message header. If BOUNDARY is not nil, it is used as message header separator. [Required] ** Field [Function] std11-fetch-field (name) Return the value of the header field NAME. The buffer is expected to be narrowed to just the headers of the message. [Required] [Function] std11-field-body (name &optional boundary) Return the value of the header field NAME. If BOUNDARY is not nil, it is used as message header separator. [Required] [Function] std11-unfold-string (string) Unfold STRING as message header field. [Required] ** Lexical Analysis [Function] std11-lexical-analyze (string &optional analyzer start) Analyze STRING as lexical tokens of STD 11. [Suggest] ** Address [Function] std11-address-string (address) Return string of address part from parsed ADDRESS of RFC 822. [Suggest] [Function] std11-full-name-string (address) Return string of full-name part from parsed ADDRESS of RFC 822. [Suggest] [Function] std11-parse-address-string (string) Parse STRING as mail address. [Suggest] [Function] std11-parse-addresses-string (string) Parse STRING as mail address list. [Suggest] [Function] std11-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. [Suggest] ** Message-ID [Function] std11-msg-id-string (msg-id) Return string from parsed MSG-ID of RFC 822. [Suggest] [Function] std11-parse-msg-id-string (string) Parse STRING as msg-id. [Suggest] [Function] std11-parse-msg-ids-string (string) Parse STRING as `*(phrase / msg-id)'. [Suggest] [Function] std11-fill-msg-id-list-string (string &optional column) Fill list of msg-id in STRING, and return the result. [Suggest] * SMTP ** How to use (require 'smtp) ** Features [Function] smtp-send-buffer (sender recipients buffer) Send a message. SENDER is an envelope sender address. RECIPIENTS is a list of envelope recipient addresses. BUFFER may be a buffer or a buffer name which contains mail message. [Suggest] [Function] smtp-via-smtp (sender recipients buffer) Like `smtp-send-buffer', but sucks in any errors. [Optional] wanderlust-flim-2cf5a78/FLIM-CFG000066400000000000000000000036361436773573300163510ustar00rootroot00000000000000;;; -*-Emacs-Lisp-*- ;; FLIM-CFG: installation setting about FLIM. ;;; Code: (defvar default-load-path load-path) (add-to-list 'load-path (expand-file-name "../../site-lisp/apel" data-directory)) (if (boundp 'LISPDIR) (progn (add-to-list 'default-load-path LISPDIR) (add-to-list 'load-path LISPDIR) (add-to-list 'load-path (expand-file-name "emu" LISPDIR)) (add-to-list 'load-path (expand-file-name "apel" LISPDIR)))) (if (boundp 'VERSION_SPECIFIC_LISPDIR) (add-to-list 'load-path VERSION_SPECIFIC_LISPDIR)) (if (boundp 'PACKAGE_LISPDIR) (let ((default-directory PACKAGE_LISPDIR)) (normal-top-level-add-subdirs-to-load-path))) (require 'install) (add-latest-path "custom") (add-path default-directory) ;; (or (fboundp 'write-region-as-binary) ;; (error "Please install latest APEL 7.3 or later.")) ;; (or (fboundp 'insert-file-contents-as-binary) ;; (error "Please install latest APEL 7.3 or later.")) ;;; @ 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 prefix for ``FLIM'' [optional] (setq FLIM_PREFIX "flim") ;;; @ 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") (defvar VERSION_SPECIFIC_LISPDIR (install-detect-elisp-directory PREFIX nil 'version-specific)) ;; (setq FLIM_DIR (expand-file-name FLIM_PREFIX VERSION_SPECIFIC_LISPDIR)) (setq FLIM_DIR (expand-file-name FLIM_PREFIX LISPDIR)) (setq FLIM_VERSION_SPECIFIC_DIR (expand-file-name FLIM_PREFIX VERSION_SPECIFIC_LISPDIR)) (defvar PACKAGEDIR (install-get-default-package-directory)) ;;; FLIM-CFG ends here wanderlust-flim-2cf5a78/FLIM-ELS000066400000000000000000000012761436773573300163730ustar00rootroot00000000000000;;; -*-Emacs-Lisp-*- ;; FLIM-ELS: list of FLIM modules to install ;;; Code: (setq flim-modules '(std11 luna lunit mime-def mel mel-q mel-u mel-g eword-decode eword-encode mime mime-parse mmgeneric mmbuffer mmcooked mmexternal mime-conf sasl sasl-scram smtp qmtp)) (setq flim-version-specific-modules nil) (setq hmac-modules '(md5 sha1 hmac-sha1)) (require 'pccl) (unless-broken ccl-usable (setq flim-modules (cons 'mel-q-ccl flim-modules))) (require 'path-util) (when (module-installed-p 'oauth2) (setq flim-modules (append flim-modules '(sasl-xoauth2)))) (setq flim-modules (nconc hmac-modules flim-modules)) ;;; FLIM-ELS ends here wanderlust-flim-2cf5a78/FLIM-MK000066400000000000000000000043221436773573300162520ustar00rootroot00000000000000;;; -*-Emacs-Lisp-*- ;; FLIM-MK: installer for FLIM. ;;; Code: (defun config-flim () (let (prefix lisp-dir version-specific-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 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)) (and (setq version-specific-lisp-dir (car command-line-args-left)) (or (string-equal "NONE" version-specific-lisp-dir) (progn (defvar VERSION_SPECIFIC_LISPDIR version-specific-lisp-dir) (princ (format "VERSION_SPECIFIC_LISPDIR=%s\n" VERSION_SPECIFIC_LISPDIR))))) (setq command-line-args-left (cdr command-line-args-left)) (and (setq package-lisp-dir (car command-line-args-left)) (or (string-equal "NONE" package-lisp-dir) (progn (defvar PACKAGE_LISPDIR (if (boundp (intern package-lisp-dir)) (symbol-value (intern package-lisp-dir)) package-lisp-dir)) (princ (format "PACKAGE_LISPDIR=%s\n" PACKAGE_LISPDIR))))) (setq command-line-args-left (cdr command-line-args-left)) (load-file "FLIM-CFG") (load-file "FLIM-ELS") (princ (format "PREFIX=%s LISPDIR=%s\n" PREFIX LISPDIR)))) (defun compile-flim () (config-flim) (compile-elisp-modules flim-version-specific-modules ".") (compile-elisp-modules flim-modules ".")) (defun install-flim () (config-flim) (if flim-version-specific-modules (install-elisp-modules flim-version-specific-modules "./" FLIM_VERSION_SPECIFIC_DIR)) (install-elisp-modules flim-modules "./" FLIM_DIR)) (defun check-flim () (config-flim) (require 'lunit) (let ((files (directory-files "tests" t "^test-.*\\.el$")) (suite (lunit-make-test-suite))) (while files (if (file-regular-p (car files)) (progn (load-file (car files)) (lunit-test-suite-add-test suite (lunit-make-test-suite-from-class (intern (file-name-sans-extension (file-name-nondirectory (car files)))))))) (setq files (cdr files))) (lunit suite))) ;;; FLIM-MK ends here wanderlust-flim-2cf5a78/Makefile000066400000000000000000000023201436773573300167270ustar00rootroot00000000000000# # Makefile for FLIM. # PACKAGE = flim API = 1.14 RELEASE = 9 TAR = tar RM = /bin/rm -f CP = /bin/cp -p EMACS = emacs XEMACS = xemacs FLAGS = -batch -q -no-site-file -l FLIM-MK PREFIX = NONE LISPDIR = NONE PACKAGEDIR = NONE VERSION_SPECIFIC_LISPDIR = NONE PACKAGE_LISPDIR = package-user-dir GOMI = *.elc \ *.cp *.cps *.ky *.kys *.fn *.fns *.vr *.vrs \ *.pg *.pgs *.tp *.tps *.toc *.aux *.log FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog VERSION = $(API).$(RELEASE) ARC_DIR_PREFIX = /home/kanji/tomo/public_html/lemi/dist ARC_DIR = $(ARC_DIR_PREFIX)/flim/flim-$(API) SEMI_ARC_DIR = $(ARC_DIR_PREFIX)/semi/semi-1.14-for-flim-$(API) elc: $(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) \ $(VERSION_SPECIFIC_LISPDIR) $(PACKAGE_LISPDIR) check: $(EMACS) $(FLAGS) -f check-flim $(PREFIX) $(LISPDIR) \ $(VERSION_SPECIFIC_LISPDIR) $(PACKAGE_LISPDIR) install: elc $(EMACS) $(FLAGS) -f install-flim $(PREFIX) $(LISPDIR) \ $(VERSION_SPECIFIC_LISPDIR) $(PACKAGE_LISPDIR) clean: -$(RM) $(GOMI) release: -$(RM) $(ARC_DIR)/$(PACKAGE)-$(VERSION).tar.gz mv /tmp/$(PACKAGE)-$(VERSION).tar.gz $(ARC_DIR) cd $(SEMI_ARC_DIR) ; \ ln -s ../../flim/flim-$(API)/$(PACKAGE)-$(VERSION).tar.gz . wanderlust-flim-2cf5a78/NEWS000066400000000000000000000104741436773573300157770ustar00rootroot00000000000000FLIM NEWS --- history of major-changes. Copyright (C) 1998,1999 Free Software Foundation, Inc. * Changes in FLIM 1.12 ** Restructure of field decoding features Introduce backend mechanism of field-decoder and field-presentation-method to restructure field decoding features. Field-decoder is registered into variable `mime-field-decoder-alist'. Each decoding function uses decoding method found from variable `mime-field-decoder-alist'. New function `mime-set-field-decoder' is added to register field decoding method. New function `mime-find-field-presentation-method' is added to get `field-presentation-method' object corresponding with specified field-presentation-mode. Field-presentation-mode must be `plain', `wide', `summary' or `nov'. New function `mime-find-field-decoder' is added to find field decoding method corresponding with field-name and field-presentation-mode. New function `mime-decode-field-body' is added. It is general field decoder. ** Function `mime-decode-header-in-buffer' Renamed from `eword-decode-header'. `eword-decode-header' is defined as obsolete alias. ** New function `mime-decode-header-in-region' ** Changes about lexical-analyzers *** New user option `std11-lexical-analyzer' Now function `std11-lexical-analyze' refers user option `std11-lexical-analyzer'. *** User option `eword-lexical-analyzers' -> `eword-lexical-analyzer' User option `eword-lexical-analyzers' was renamed to `eword-lexical-analyzer'. *** Change interface of lexical-analyzers Interface of function `eword-lexical-analyze' was changed from `(string &optional must-unfold)' to `(string &optional start must-unfold)'. Interface of lexical analyzer specified by user option `eword-lexical-analyzer' was changed likewise. Function `eword-extract-address-components' was added new optional argument `START' to specify start position of `STRING' to parse. Function `std11-lexical-analyze' was added new optional arguments `ANALYZER' to specify lexical-analyzer and `START' to specify start position of `STRING' to analyze. Interface of lexical analyzers for STD 11 was changed from `(string)' to `(string &optional start)'. ** Function `std11-parse-in-reply-to' -> `std11-parse-msg-ids' Rename function `std11-parse-in-reply-to' to `std11-parse-msg-ids'. Function `std11-parse-in-reply-to' was defined as obsolete alias. ** New function `std11-parse-msg-id-string' ** New function `std11-parse-msg-ids-string' ** New function `mime-find-entity-from-content-id' ** New function `mime-parse-msg-id' ** New function `mime-uri-parse-cid' ** New generic function `mime-insert-entity' Add new generic function `mime-insert-entity' to insert header and body of ENTITY at point. Each mm-backend must have new method `insert-entity'. ** New optional argument of `std11-field-end' Now `std11-field-end' can accept new optional argument BOUND. Thus current interface is: std11-field-end (&optional BOUND) If the optional argument BOUND is specified, it bounds the search; it is a buffer position. * Changes in FLIM 1.11 ** New function `mime-insert-text-content' Add new generic function `mime-insert-text-content' and new mm-service `insert-text-content'. ** `insert-decoded-header' -> `insert-header' mm-service `insert-decoded-header' was renamed to `insert-header'. Similarly generic function `mime-insert-decoded-header' was renamed to `mime-insert-header'. However `mime-insert-decoded-header' was left as an obsolete alias. ** Behavior change of `mime-insert-header' Each field-name of second and third argument of function `mime-insert-header' can include `:'. ** Abolish variable `mime-temp-directory' Now FLIM uses `temporary-file-directory' instead of `mime-temp-directory'. So environment variable "MIME_TMP_DIR" and "TM_TMP_DIR" are not effective to specify temporary directory of FLIM. ** Add new function `eword-decode-and-unfold-unstructured-field' ** Add new mm-backend `generic' Add new mm-backend `generic'. mm-backend `buffer' inherits the mm-backend `generic'. ** Change internal representation of `mime-entity' structure Internal representation of `mime-entity' structure was changed to add NOV entries. ** `mime-entity-*-internal' and `mime-entity-set-*-internal' Change `mime-entity-*-internal' and `mime-entity-set-*-internal' to macro. Local variables: mode: outline paragraph-separate: "[ ]*$" end: wanderlust-flim-2cf5a78/README000066400000000000000000000021061436773573300161510ustar00rootroot00000000000000-*- outline -*- [README for FLIM-LB] * What's FLIM-LB? FLIM-LB is a variant of FLIM. The most remarkable feature is that it uses lexical binding and supports only Emacs 24.5 and later. Furthermore, wide int feature is required on 32-bit machines. See README.[en|ja] for details of original FLIM. * GitHub Development of FLIM-LB uses Git. The latest developing version is available at the following Git repository: % git clone https://github.com/wanderlust/flim.git Or you can view the FLIM-LB repository via WWW at: https://github.com/wanderlust/flim We hope you will join the open development. * Bug reports If you write bug-reports and/or suggestions for improvement, please send them to the Wanderlust Mailing List. See https://wanderlust.github.io/wl-docs/wl.html#Wanderlust-Mailing-List for details. Alternatively, You can also use GitHub. If you send a pull request, please embed unindented ChangeLog entries in commit messages like Emacs's. See "Commit messages" section of Emacs's CONTRIBUTE file. https://git.savannah.gnu.org/cgit/emacs.git/plain/CONTRIBUTE wanderlust-flim-2cf5a78/README.en000066400000000000000000000077771436773573300165750ustar00rootroot00000000000000[README for FLIM (English Version)] by MORIOKA Tomohiko What's FLIM =========== FLIM is a library to provide basic features about message representation or encoding. It consists of following modules: std11.el --- STD 11 (RFC 822) parser and utility mime.el --- to provide various services about MIME-entities mime-def.el --- Definitions about MIME format mime-parse.el --- MIME parser mel.el --- MIME encoder/decoder mel-b-dl.el --- base64 (B-encoding) encoder/decoder (for Emacs 20 with dynamic loading support) mel-b-ccl.el --- base64 (B-encoding) encoder/decoder (using CCL) mel-b-en.el --- base64 (B-encoding) encoder/decoder (for other emacsen) mel-q-ccl.el --- quoted-printable and Q-encoding encoder/decoder (using CCL) mel-q.el --- quoted-printable and Q-encoding encoder/decoder mel-u.el --- unofficial backend for uuencode mel-g.el --- unofficial backend for gzip64 eword-decode.el --- encoded-word decoder eword-encode.el --- encoded-word encoder This library should work on: Emacs 20.4 and up XEmacs 21.1 and up Installation ============ (0) before installing it, please install APEL (10.7 or later) package. APEL package is available at: ftp://ftp.m17n.org/pub/mule/apel/ (1-a) run in expanded place If you don't want to install other directories, please do only following: % make You can specify the emacs command name, for example % make EMACS=xemacs If `EMACS=...' is omitted, EMACS=emacs is used. (1-b) make install If you want to install other directories, please do following: % 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, 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/site-lisp/flim/ --- FLIM 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). If the emu modules (included in APEL package) have been installed in the non-standard directory, you should specify where they will be found, for example: % make install VERSION_SPECIFIC_LISPDIR=~/elisp Following make target is available to find what files are parts of emu / APEL package, and where are directories to install them: % make what-where LISPDIR=~/elisp VERSION_SPECIFIC_LISPDIR=~/elisp You can specify other optional settings by editing the file FLIM-CFG. Please read comments in it. (1-c) install as a XEmacs package If you want to install to XEmacs package directory, please do following: % make install-package You can specify the XEmacs command name, for example % make install-package XEMACS=xemacs-21 If `XEMACS=...' is omitted, XEMACS=xemacs is used. You can specify the package directory, for example: % make install PACKAGEDIR=~/.xemacs If `PACKAGEDIR=...' is omitted, the first existing package directory is used. Notice that XEmacs package system requires XEmacs 21.0 or later. Bug reports =========== If you write bug-reports and/or suggestions for improvement, please send them to the Emacs-MIME Mailing Lists: emacs-mime-en@lists.chise.org (English) emacs-mime-ja@lists.chise.org (Japanese) Via the Emacs-MIME ML, you can report FLIM bugs, obtain the latest release of FLIM, and discuss future enhancements to FLIM. To join the Emacs-MIME ML, please see the descriptions of the following pages: http://lists.chise.org/mailman/listinfo/emacs-mime-en (English) http://lists.chise.org/mailman/listinfo/emacs-mime-ja (Japanese) wanderlust-flim-2cf5a78/README.ja000066400000000000000000000124001436773573300165400ustar00rootroot00000000000000[FLIM の README (日本語版)] FLIM とは？ =========== FLIM は Internet message に関する様々な表現形式や符号化に関する基礎 的な機能を提供するための汎用部品です。FLIM は以下のモジュールから構 成されています: std11.el --- STD 11 (RFC 822) 形式に基づく解析処理等 mime.el --- MIME-entity に関する諸機能の提供 mime-def.el --- MIME 形式に関する定義 mime-parse.el --- MIME 解析器 mel.el --- MIME 符号器/復号器 mel-b-dl.el --- base64 (B-encoding) 符号器/復号器 (dynamic loading 機能付き Emacs 20 用) mel-b-ccl.el --- base64 (B-encoding) encoder/decoder (using CCL) mel-b-el.el --- base64 (B-encoding) 符号器/復号器 (他の emacsen 用) mel-q-ccl.el --- quoted-printable and Q-encoding encoder/decoder (using CCL) mel-q.el --- quoted-printable と Q-encoding 符号器/復号器 mel-u.el --- uuencode のための非公式 backend mel-g.el --- gzip64 のための非公式 backend eword-decode.el --- encoded-word 復号器 eword-encode.el --- encoded-word 符号器 以下の環境で動作します： Emacs 20.4 以降 XEmacs 21.1 以降 導入 (Installation) =================== (0) 導入 (install) する前に、APEL (10.7 以降) を導入してください。APEL は以下のところで取得できます: ftp://ftp.m17n.org/pub/mule/apel/ (1-a) 展開した場所への導入 展開した場所とは異なる場所に導入したくないなら、 % make だけを実行してください。 emacs のコマンド名を指定することができます。例えば、 % make EMACS=xemacs `EMACS=...' が省略されると、Emacs=emacs が使われます。 (b) make install 展開した場所とは異なる場所に導入したいなら、 % make install を実行してください。 emacs のコマンド名を指定することができます。例えば、 % make install EMACS=xemacs `EMACS=...' が省略されると、Emacs=emacs が使われます。 Emacs Lisp プログラムのためのディレクトリー木の接頭辞 (prefix) を指 定することができます。例えば、 % make install PREFIX=~/ `PREFIX=...' が省略されると、指定された emacs コマンドのディレクトリー 木の接頭辞が使用されます (おそらく /usr/local です)。 例えば、PREFIX=/usr/local と Emacs 20.7 が指定されれば、以下のディレ クトリー木が作成されます。 /usr/local/share/emacs/site-lisp/flim/ --- FLIM /usr/local/share/emacs/20.7/site-lisp/flim/ --- FLIM Emacs Lisp プログラムのための lisp ディレクトリーを指定することがで きます。例えば、: % make install LISPDIR=~/share/emacs/elisp `LISPDIR=...' が省略されると、指定された emacs のコマンドの site-lisp ディレクトリーが使われます (おそらく /usr/local/share/emacs/site-lisp か /usr/local/lib/xemacs/site-lisp) です。 emu モジュール (APEL パッケージに入っています) が標準でないディレク トリーに導入されている場合は、それらのある場所を指定する必要 があります。例えば： % make install VERSION_SPECIFIC_LISPDIR=~/elisp どのファイルが emu モジュールか APEL モジュールの一部なのか、それら がどこに導入されるかを知りたいときは、次のようなコマンドを入 力することができます。 % make what-where LISPDIR=~/elisp VERSION_SPECIFIC_LISPDIR=~/elisp また、FLIM-CFG ファイルを編集することで他の選択可能な設定を指定する ことができます。その詳細に関しては FLIM-CFG ファイルの注釈 (comment) を読んでください。 (1-c) XEmacs のパッケージとして導入する XEmacs のパッケージ・ディレクトリーに導入する場合は、 % make install-package を実行してください。 XEmacs のコマンド名を指定することができます。例： % make install-package XEMACS=xemacs-21 `XEMACS=...' が省略されると、XEMACS=xemacs が使用されます。 パッケージ・ディレクトリーを指定することができます。例： % make install PACKAGEDIR=~/.xemacs `PACKAGEDIR=...' が省略されると、存在するパッケージ・ディレクトリー の最初のものが使われます。 ［注意］XEmacs のパッケージ・システムは XEmacs 21.0 かそれ以降が必要 です。 バグ報告 ======== バグ報告や改善の提案を書いたときは、是非 Emacs-MIME メーリングリスト に送ってください: emacs-mime-ja@lists.chise.org （日本語） emacs-mime-en@lists.chise.org （英語） Emacs-MIME ML を通して、FLIM のバグを報告したり、FLIM の最新のリリー スを取得したり、FLIM の将来の拡張の議論をしたりすることができます。 Emacs-MIME ML に参加したい方は、以下の頁の記述を見て購読手続きを行っ てください： http://lists.chise.org/mailman/listinfo/emacs-mime-ja （日本語） http://lists.chise.org/mailman/listinfo/emacs-mime-en （英語） wanderlust-flim-2cf5a78/VERSION000066400000000000000000000107221436773573300163440ustar00rootroot00000000000000[FLIM Version names] 1.0.0 ----- ;;------------------------------------------------------------------------- ;; Kinki Nippon Railway $(B6a5&F|K\E4F;(B http://www.kintetsu.co.jp/ ;; Ky-Dto Line $(B5~ET@~(B-A ;;------------------------------------------------------------------------- 1.0.1 Ky-Dto $(B5~ET(B ; <=> JR, $(B5~ET;T8rDL6I(B-A 1.1.0 T-Dji $(BEl;{(B-A 1.2.0 J-Dj $(B==>r(B-A 1.2.1 Kamitobaguchi $(B>eD;1)8}(B 1.2.2 Takeda $(BC]ED(B ; = $(B5~ET;T8rDL6I(B $(B1(4]@~(B 1.3.0 Fushimi $(BIz8+(B 1.4.0 Kintetsu-Tambabashi $(B6aE4C0GH66(B ; <=> $(B5~:e(B $(BC0GH66(B 1.4.1 Momoyama-Gory-Dmae $(BEm;38fNMA0(B-A 1.5.0 Mukaijima $(B8~Eg(B 1.6.0 Ogura $(B>.AR(B 1.7.0 Iseda $(B0K@*ED(B 1.8.0 -Dkubo $(BBg5WJ](B-A 1.8.1 Kutsukawa $(B5WDE@n(B 1.9.0 Terada $(B;{ED(B 1.9.1 Tonosh-D $(BIYLnAq(B-A 1.9.2 Shin-Tanabe $(B?7EDJU(B 1.10.0 K-Ddo $(B6=8M(B-A 1.10.1 Miyamaki $(B;0;3LZ(B 1.10.2 Kintetsu-Miyazu $(B6aE45\DE(B 1.10.3 Komada $(B9}ED(B 1.10.4 Shin-H-Dsono $(B?7=K1`(B ; <=> JR $(BJRD.@~(B $(B=K1`(B-A 1.10.5 Kizugawadai $(BLZDE@nBf(B 1.11.0 Yamadagawa $(B;3ED@n(B 1.11.1 Takanohara $(B9b$N86(B 1.11.2 Heij-D $(BJ?>k(B-A 1.11.3 Saidaiji $(B@>Bg;{(B ; = $(B6aE4(B $(BF`NI@~(B ;;------------------------------------------------------------------------- ;; Kinki Nippon Railway $(B6a5&F|K\E4F;(B http://www.kintetsu.co.jp/ ;; Ky-Dto Line $(B3`86@~(B-A ;;------------------------------------------------------------------------- (Saidaiji) ($(B@>Bg;{(B) 1.12.0 Amagatsuji $(BFt%vDT(B 1.12.1 Nishinoky-D $(B@>$N5~(B-A 1.12.2 Kuj-D $(B6e>r(B-A 1.12.3 Kintetsu-K-Driyama $(B6aE474;3(B-A 1.12.4 Tsutsui $(BE{0f(B 1.12.5 Hirahata $(BJ?C<(B ; = $(B6aE4(B $(BE7M}@~(B 1.12.6 Family-K-Denmae $(B%U%!%_%j!<8x1`A0(B-A 1.12.7 Y-Dzaki $(B7k:j(B-A 1.13.0 Iwami $(B@P8+(B 1.13.1 Tawaramoto $(BED86K\(B ; <=> $(B6aE4(B $(B@>ED86K\(B 1.13.2 Kasanui $(B3^K%(B 1.14.0 Ninokuchi $(B?7%N8}(B 1.14.1 Yagi $(BH,LZ(B ; = $(B6aE4(B $(BBg:e@~(B 1.14.2 Yagi-Nishiguchi $(BH,LZ@>8}(B 1.14.3 Unebigory-Dmae $(B@&K58fNMA0(B-A 1.14.4 Kashiharajing-D-mae $(B3`86?@5\A0(B ; = $(B6aE4(B $(BFnBg:e@~!"5HLn@~(B-A ;;------------------------------------------------------------------------- ;; Keihan Electric Railway $(B5~:eEE5$E4F;(B http://www.keihan.co.jp/ ;; -Dt Line $(B3{El@~(B-A ;;------------------------------------------------------------------------- 1.14.5 Demachiyanagi $(B=PD.Lx(B ; <=> $(B1CEE(B 1.14.6 Marutamachi $(B4]B@D.(B 1.14.7 Sanj-D $(B;0>r(B ; = $(B5~ET;T8rDL6I(B $(BEl@>@~(B-A ;;------------------------------------------------------------------------- ;; Keihan Electric Railway $(B5~:eEE5$E4F;(B http://www.keihan.co.jp/ ;; Main Line $(BK\@~(B ;;------------------------------------------------------------------------- (Sanj-D) ($(B;0>r(B)-A 1.14.8 Shij-D $(B;M>r(B-A 1.14.9 Goj-D $(B8^>r(B-A [Chao Version names] ;;------------------------------------------------------------------------- ;; Kyoto Municipal Transfer Bureau ;; $(B5~ET;T8rDL6I(B ;; http://www.city.kyoto.jp/kotsu/main.htm ;; Karasuma Line $(B1(4]@~(B ;;------------------------------------------------------------------------- 1.2.0 Takeda $(BC]ED(B ; = $(B6aE4(B $(B5~ET@~(B 1.3.0 Kuinabashi $(B$/$$$J66(B 1.4.0 J-Dj $(B==>r(B-A 1.6.0 Kuj-D $(B6e>r(B-A 1.6.1 Ky-Dto $(B5~ET(B ; <=> JR, $(B6aE4(B-A 1.7.0 Goj-D $(B8^>r(B-A 1.8.0 Shij-D $(B;M>r(B ; <=> $(B:e5^(B $(B5~ET@~(B-A 1.9.0 Karasuma Oike $(B1(4]8fCS(B ; = $(B5~ET;T8rDL6I(B $(BEl@>@~(B 1.10.0 Marutamach $(B4]B@D.(B 1.11.0 Imadegawa $(B:#=P@n(B 1.11.1 Kuramaguchi $(B0HGO8}(B 1.11.2 Kita-Dji $(BKLBgO)(B-A 1.11.3 Kitayama $(BKL;3(B 1.11.4 Matugasaki $(B>>%v:j(B 1.11.5 Kokusaikaikan $(B9q:]2q4[(B ;;------------------------------------------------------------------------- ;; West Japan Railway $(B@>F|K\N95RE4F;(B http://www.westjr.co.jp/ ;; Nara Line $(BF`NI@~(B ;;------------------------------------------------------------------------- 1.12.0 [JR] Ky-Dto $(B5~ET(B ; <=> $(B6aE4(B, $(B5~ET;T8rDL6I(B-A 1.12.1 T-Dfukuji $(BElJ!;{(B ; <=> $(B5~:e(B-A 1.12.2 Inari $(B0p2Y(B 1.13.0 JR Fujinomori JR $(BF#?9(B 1.14.0 Momoyama $(BEm;3(B 1.14.1 Rokujiz-D $(BO;COB"(B-A ------ Kohata $(BLZH((B wanderlust-flim-2cf5a78/eword-decode.el000066400000000000000000000653761436773573300201760ustar00rootroot00000000000000;;; eword-decode.el --- RFC 2047 based encoded-word decoder for GNU Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004, ;; 2005 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo ;; MORIOKA Tomohiko ;; TANAKA Akira ;; Created: 1995/10/03 ;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'. ;; Renamed: 1993/06/03 to tiny-mime.el by MORIOKA Tomohiko ;; Renamed: 1995/10/03 to tm-ew-d.el (split off encoder) ;; by MORIOKA Tomohiko ;; Renamed: 1997/02/22 from tm-ew-d.el by MORIOKA Tomohiko ;; Keywords: encoded-word, MIME, multilingual, header, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mime-def) (require 'mel) (require 'std11) (require 'cl-lib) ;;; @ Variables ;;; ;; User options are defined in mime-def.el. ;;; @ MIME encoded-word definition ;;; (eval-and-compile (defconst eword-encoded-text-regexp "[!->@-~]+") (defconst eword-encoded-word-regexp (eval-when-compile (concat (regexp-quote "=?") "\\(" mime-charset-regexp ; 1 "\\)" "\\(" (regexp-quote "*") mime-language-regexp ; 2 "\\)?" (regexp-quote "?") "\\(" mime-encoding-regexp ; 3 "\\)" (regexp-quote "?") "\\(" eword-encoded-text-regexp ; 4 "\\)" (regexp-quote "?="))))) ;;; @ 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). The language informations specified in the encoded words, if any, are put to the decoded text as the `mime-language' text property." (setq string (std11-unfold-string string)) (let ((regexp (concat "[\n\t ]*\\(" eword-encoded-word-regexp "\\)")) (next 0) match start words) (while (setq match (string-match regexp string next)) (setq start (match-beginning 1) words nil) (while match (setq next (match-end 0)) (push (list (match-string 2 string) ;; charset (when (match-beginning 3) ;; language (intern (downcase (substring string (1+ (match-beginning 3)) (match-end 3))))) (match-string 4 string) ;; encoding (match-string 5 string) ;; encoded-text (match-string 1 string)) ;; encoded-word words) (setq match (and (string-match regexp string next) (= next (match-beginning 0))))) (setq words (eword-decode-encoded-words (nreverse words) must-unfold) string (concat (substring string 0 start) words (substring string next)) next (+ start (length words))))) string) (defun eword-decode-structured-field-body (string &optional _start-column _max-column start) (let ((tokens (eword-lexical-analyze string start 'must-unfold)) result token) (while tokens (setq token (car tokens)) (setq result (cons (eword-decode-token token) result)) (setq tokens (cdr tokens))) (apply 'concat (nreverse result)))) (defun eword-decode-and-unfold-structured-field-body (string &optional _start-column _max-column start) "Decode and unfold STRING as structured field body. 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." (let ((tokens (eword-lexical-analyze string start 'must-unfold)) result) (while tokens (let* ((token (car tokens)) (type (car token))) (setq tokens (cdr tokens)) (setq result (cons (if (eq type 'spaces) " " (eword-decode-token token)) result)))) (apply 'concat (nreverse result)))) (defun eword-decode-and-fold-structured-field-body (string start-column &optional max-column start) (if (and mime-field-decoding-max-size (> (length string) mime-field-decoding-max-size)) string (or max-column (setq max-column fill-column)) (let ((c start-column) (tokens (eword-lexical-analyze string start 'must-unfold)) result token) (while (and (setq token (car tokens)) (setq tokens (cdr tokens))) (let* ((type (car token))) (if (eq type 'spaces) (let* ((next-token (car tokens)) (next-str (eword-decode-token next-token)) (next-len (string-width next-str)) (next-c (+ c next-len 1))) (if (< next-c max-column) (setq result (cons next-str (cons " " result)) c next-c) (setq result (cons next-str (cons "\n " result)) c (1+ next-len))) (setq tokens (cdr tokens))) (let* ((str (eword-decode-token token))) (setq result (cons str result) c (+ c (string-width str))))))) (apply 'concat (nreverse (cons (when token (eword-decode-token token)) result)))))) (defun eword-decode-unstructured-field-body (string &optional _start-column _max-column) (eword-decode-string (mime-charset-decode-string string default-mime-charset))) (defun eword-decode-and-unfold-unstructured-field-body (string &optional _start-column _max-column) (eword-decode-string (mime-charset-decode-string (std11-unfold-string string) default-mime-charset) 'must-unfold)) (defun eword-decode-unfolded-unstructured-field-body (string &optional _start-column _max-column) (eword-decode-string (mime-charset-decode-string string default-mime-charset) 'must-unfold)) ;;; @ 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). The language informations specified in the encoded words, if any, are put to the decoded text as the `mime-language' text property." (interactive "*r") (save-excursion (save-restriction (narrow-to-region start end) (if unfolding (eword-decode-unfold)) (goto-char (point-min)) (let ((regexp (concat "[\n\t ]*\\(" eword-encoded-word-regexp "\\)")) match words) (while (setq match (re-search-forward regexp nil t)) (setq start (match-beginning 1) words nil) (while match (goto-char (setq end (match-end 0))) (push (list (match-string 2) ;; charset (when (match-beginning 3) ;; language (intern (downcase (buffer-substring (1+ (match-beginning 3)) (match-end 3))))) (match-string 4) ;; encoding (match-string 5) ;; encoded-text (match-string 1)) ;; encoded-word words) (setq match (looking-at regexp))) (delete-region start end) (insert (eword-decode-encoded-words (nreverse words) must-unfold))))))) (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))))))) ;;; @ for message header ;;; (defvar mime-field-decoder-alist nil) (defvar mime-field-decoder-cache nil) (defvar mime-update-field-decoder-cache 'mime-update-field-decoder-cache "*Field decoder cache update function.") ;;;###autoload (defun mime-set-field-decoder (field &rest specs) "Set decoder of FIELD. SPECS must be like `MODE1 DECODER1 MODE2 DECODER2 ...'. Each mode must be `nil', `plain', `wide', `summary' or `nov'. If mode is `nil', corresponding decoder is set up for every modes." (when specs (let ((mode (pop specs)) (function (pop specs))) (if mode (progn (let ((cell (assq mode mime-field-decoder-alist))) (if cell (setcdr cell (put-alist field function (cdr cell))) (setq mime-field-decoder-alist (cons (cons mode (list (cons field function))) mime-field-decoder-alist)))) (apply (function mime-set-field-decoder) field specs)) (mime-set-field-decoder field 'plain function 'wide function 'summary function 'nov function))))) ;;;###autoload (defmacro mime-find-field-presentation-method (name) "Return field-presentation-method from NAME. NAME must be `plain', `wide', `summary' or `nov'." (cond ((eq name nil) `(or (assq 'summary mime-field-decoder-cache) '(summary))) ((and (consp name) (car name) (consp (cdr name)) (symbolp (car (cdr name))) (null (cdr (cdr name)))) `(or (assq ,name mime-field-decoder-cache) (cons ,name nil))) (t `(or (assq (or ,name 'summary) mime-field-decoder-cache) (cons (or ,name 'summary) nil))))) (defun mime-find-field-decoder-internal (field &optional mode) "Return function to decode field-body of FIELD in MODE. Optional argument MODE must be object of field-presentation-method." (cdr (or (assq field (cdr mode)) (prog1 (funcall mime-update-field-decoder-cache field (car mode)) (setcdr mode (cdr (assq (car mode) mime-field-decoder-cache))))))) ;;;###autoload (defun mime-find-field-decoder (field &optional mode) "Return function to decode field-body of FIELD in MODE. Optional argument MODE must be object or name of field-presentation-method. Name of field-presentation-method must be `plain', `wide', `summary' or `nov'. Default value of MODE is `summary'." (if (symbolp mode) (let ((p (cdr (mime-find-field-presentation-method mode)))) (if (and p (setq p (assq field p))) (cdr p) (cdr (funcall mime-update-field-decoder-cache field (or mode 'summary))))) (inline (mime-find-field-decoder-internal field mode)))) ;;;###autoload (defun mime-update-field-decoder-cache (field mode &optional function) "Update field decoder cache `mime-field-decoder-cache'." (cond ((eq function 'identity) (setq function nil)) ((null function) (let ((decoder-alist (cdr (assq (or mode 'summary) mime-field-decoder-alist)))) (setq function (cdr (or (assq field decoder-alist) (assq t decoder-alist))))))) (let ((cell (assq mode mime-field-decoder-cache)) ret) (if cell (if (setq ret (assq field (cdr cell))) (setcdr ret function) (setcdr cell (cons (setq ret (cons field function)) (cdr cell)))) (setq mime-field-decoder-cache (cons (cons mode (list (setq ret (cons field function)))) mime-field-decoder-cache))) ret)) ;; ignored fields (mime-set-field-decoder 'Archive nil nil) (mime-set-field-decoder 'Content-Md5 nil nil) (mime-set-field-decoder 'Control nil nil) (mime-set-field-decoder 'Date nil nil) (mime-set-field-decoder 'Distribution nil nil) (mime-set-field-decoder 'Followup-Host nil nil) (mime-set-field-decoder 'Followup-To nil nil) (mime-set-field-decoder 'Lines nil nil) (mime-set-field-decoder 'Message-Id nil nil) (mime-set-field-decoder 'Newsgroups nil nil) (mime-set-field-decoder 'Nntp-Posting-Host nil nil) (mime-set-field-decoder 'Path nil nil) (mime-set-field-decoder 'Posted-And-Mailed nil nil) (mime-set-field-decoder 'Received nil nil) (mime-set-field-decoder 'Status nil nil) (mime-set-field-decoder 'X-Face nil nil) (mime-set-field-decoder 'X-Face-Version nil nil) (mime-set-field-decoder 'X-Info nil nil) (mime-set-field-decoder 'X-Pgp-Key-Info nil nil) (mime-set-field-decoder 'X-Pgp-Sig nil nil) (mime-set-field-decoder 'X-Pgp-Sig-Version nil nil) (mime-set-field-decoder 'Xref nil nil) ;; structured fields (let ((fields '(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc Mail-Followup-To Mime-Version Content-Type Content-Transfer-Encoding Content-Disposition User-Agent)) field) (while fields (setq field (pop fields)) (mime-set-field-decoder field 'plain #'eword-decode-structured-field-body 'wide #'eword-decode-and-fold-structured-field-body 'summary #'eword-decode-and-unfold-structured-field-body 'nov #'eword-decode-and-unfold-structured-field-body))) ;; unstructured fields (default) (mime-set-field-decoder t 'plain #'eword-decode-unstructured-field-body 'wide #'eword-decode-unstructured-field-body 'summary #'eword-decode-and-unfold-unstructured-field-body 'nov #'eword-decode-unfolded-unstructured-field-body) ;;;###autoload (defun mime-decode-field-body (field-body field-name &optional mode max-column) "Decode FIELD-BODY as FIELD-NAME in MODE, and return the result. Optional argument MODE must be `plain', `wide', `summary' or `nov'. Default mode is `summary'. If MODE is `wide' and MAX-COLUMN is non-nil, the result is folded with MAX-COLUMN. Non MIME encoded-word part in FILED-BODY is decoded with `default-mime-charset'." (let (field-name-symbol len decoder) (if (symbolp field-name) (setq field-name-symbol field-name len (1+ (string-width (symbol-name field-name)))) (setq field-name-symbol (intern (capitalize field-name)) len (1+ (string-width field-name)))) (setq decoder (mime-find-field-decoder field-name-symbol mode)) (if decoder (funcall decoder field-body len max-column) ;; Don't decode (if (eq mode 'summary) (std11-unfold-string field-body) field-body)))) ;;;###autoload (defun mime-decode-header-in-region (start end &optional code-conversion) "Decode MIME encoded-words in region between START and END. If CODE-CONVERSION is nil, it decodes only encoded-words. If it is mime-charset, it decodes non-ASCII bit patterns as the mime-charset. Otherwise it decodes non-ASCII bit patterns as the default-mime-charset." (interactive "*r") (save-excursion (save-restriction (narrow-to-region start end) (let ((default-charset (if code-conversion (if (mime-charset-to-coding-system code-conversion) code-conversion default-mime-charset)))) (if default-charset (let ((mode-obj (mime-find-field-presentation-method 'wide)) beg p end field-name len field-decoder) (goto-char (point-min)) (while (re-search-forward std11-field-head-regexp nil t) (setq beg (match-beginning 0) p (match-end 0) field-name (buffer-substring beg (1- p)) len (string-width field-name) field-name (intern (capitalize field-name)) field-decoder (inline (mime-find-field-decoder-internal field-name mode-obj))) (when field-decoder (setq end (std11-field-end)) (let ((body (buffer-substring p end)) (default-mime-charset default-charset)) (delete-region p end) (insert (funcall field-decoder body (1+ len))))))) (eword-decode-region (point-min) (point-max) t)))))) ;;;###autoload (defun mime-decode-header-in-buffer (&optional code-conversion separator) "Decode MIME encoded-words in header fields. If CODE-CONVERSION is nil, it decodes only encoded-words. If it is mime-charset, it decodes non-ASCII bit patterns as the mime-charset. Otherwise it decodes non-ASCII bit patterns as the default-mime-charset. If SEPARATOR is not nil, it is used as header separator." (interactive "*") (mime-decode-header-in-region (point-min) (save-excursion (goto-char (point-min)) (if (re-search-forward (concat "^\\(" (regexp-quote (or separator "")) "\\)?$") nil t) (match-beginning 0) (point-max))) code-conversion)) (defalias 'eword-decode-header 'mime-decode-header-in-buffer) (make-obsolete 'eword-decode-header 'mime-decode-header-in-buffer "28 Oct 1998") ;;; @ encoded-words decoder ;;; (defvar eword-decode-allow-incomplete-encoded-text t "*Non-nil means allow incomplete encoded-text in successive encoded-words. Dividing of encoded-text in the place other than character boundaries violates RFC2047 section 5, while we have a capability to decode it. If it is non-nil, the decoder will decode B- or Q-encoding in each encoded-word, concatenate them, and decode it by charset. Otherwise, the decoder will fully decode each encoded-word before concatenating them.") (defun eword-decode-encoded-words (words must-unfold) "Decode successive encoded-words in WORDS and return a decoded string. Each element of WORDS looks like (CHARSET LANGUAGE ENCODING ENCODED-TEXT ENCODED-WORD). 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)." (let (word language charset encoding text rest) (while words (setq word (pop words) language (nth 1 word)) (if (and (or (mime-charset-to-coding-system (setq charset (car word))) (progn (message "Unknown charset: %s" charset) nil)) (cond ((member (setq encoding (nth 2 word)) '("B" "Q")) t) ((member encoding '("b" "q")) (setq encoding (upcase encoding))) (t (message "Invalid encoding: %s" encoding) nil)) (condition-case err (setq text (encoded-text-decode-string (nth 3 word) encoding)) (error (message "%s" (error-message-string err)) nil))) (if (and eword-decode-allow-incomplete-encoded-text rest (cl-caaar rest) (string-equal (downcase charset) (downcase (cl-caaar rest))) (equal language (cl-cdaar rest))) ;; Concatenate text of which the charset is the same. (setcdr (car rest) (concat (cdar rest) text)) (push (cons (cons charset language) text) rest)) ;; Don't decode encoded-word. (push (cons (cons nil language) (nth 4 word)) rest))) (while rest (setq word (or (and (setq charset (cl-caaar rest)) (condition-case err (mime-charset-decode-string (cdar rest) charset) (error (message "%s" (error-message-string err)) nil))) (concat (when (cdr rest) " ") (cdar rest) (when (and words (not (eq (string-to-char (car words)) ?\s))) " ")))) (when must-unfold (setq word (mapconcat (lambda (chr) (cond ((memq chr '(?\n ?\r)) nil) ((eq chr ?\t) " ") (t (list chr)))) (std11-unfold-string word) nil))) (when (setq language (cl-cdaar rest)) (put-text-property 0 (length word) 'mime-language language word)) (when (> (length word) 0) (setq words (cons word words))) (setq rest (cdr rest))) (apply 'concat words))) ;;; @ 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.") (defvar mime-header-lexical-analyzer '(eword-analyze-quoted-string eword-analyze-domain-literal eword-analyze-comment eword-analyze-spaces eword-analyze-special eword-analyze-encoded-word eword-analyze-atom) "*List of functions to return result of lexical analyze. Each function must have three arguments: STRING, START and MUST-UNFOLD. STRING is the target string to be analyzed. START is start position of STRING to analyze. If MUST-UNFOLD is not nil, each function must unfold and eliminate bare-CR and bare-LF from the result even if they are included in content of the encoded-word. Each function must return nil if it can not analyze STRING as its format. Previous function is preferred to next function. If a function returns nil, next function is used. Otherwise the return value will be the result.") (defun eword-analyze-quoted-string (string start &optional _must-unfold) (let ((p (std11-check-enclosure string ?\" ?\" nil start)) ret) (when p (setq ret (mime-charset-decode-string (std11-strip-quoted-pair (substring string (1+ start) (1- p))) default-mime-charset)) (if mime-header-accept-quoted-encoded-words (setq ret (eword-decode-string ret))) (cons (cons 'quoted-string ret) p)))) (defun eword-analyze-domain-literal (string start &optional _must-unfold) (std11-analyze-domain-literal string start)) (defun eword-analyze-comment (string from &optional must-unfold) (let ((len (length string)) (i (or from 0)) dest last-str chr ret) (when (and (> len i) (eq (aref string i) ?\()) (setq i (1+ i) from i) (catch 'tag (while (< i len) (setq chr (aref string i)) (cond ((eq chr ?\\) (setq i (1+ i)) (if (>= i len) (throw 'tag nil)) (setq last-str (cons (list (aref string i)) (cons (substring string from (1- i)) last-str)) i (1+ i) from i)) ((eq chr ?\)) (setq ret (apply 'concat (substring string from i) (nreverse last-str))) (throw 'tag (cons (cons 'comment (nreverse (if (string= ret "") dest (cons (eword-decode-string (mime-charset-decode-string ret default-mime-charset) must-unfold) dest)))) (1+ i)))) ((eq chr ?\() (if (setq ret (eword-analyze-comment string i must-unfold)) (setq last-str (apply 'concat (substring string from i) (nreverse last-str)) dest (if (string= last-str "") (cons (car ret) dest) (cl-list* (car ret) (eword-decode-string (mime-charset-decode-string last-str default-mime-charset) must-unfold) dest)) i (cdr ret) from i last-str nil) (throw 'tag nil))) (t (setq i (1+ i))))))))) (defun eword-analyze-spaces (string start &optional _must-unfold) (std11-analyze-spaces string start)) (defun eword-analyze-special (string start &optional _must-unfold) (std11-analyze-special string start)) (defun eword-analyze-encoded-word (string start &optional must-unfold) (let* ((regexp (concat "[\n\t ]*\\(" eword-encoded-word-regexp "\\)")) (match (and (string-match regexp string start) (= start (match-beginning 0)))) next words) (while match (setq next (match-end 0)) (push (list (match-string 2 string) ;; charset (when (match-beginning 3) ;; language (intern (downcase (substring string (1+ (match-beginning 3)) (match-end 3))))) (match-string 4 string) ;; encoding (match-string 5 string) ;; encoded-text (match-string 1 string)) ;; encoded-word words) (setq match (and (string-match regexp string next) (= next (match-beginning 0))))) (when words (setq words (eword-decode-encoded-words (nreverse words) must-unfold)) (cons (cons 'atom (if (and (string-match (eval-when-compile (concat "[" std11-special-char-list "]")) words) (null (eq (cdr (std11-analyze-quoted-string words 0)) (length words)))) ;; Docoded words contains non-atom special chars and are ;; not quoted. (std11-wrap-as-quoted-string words) words)) next)))) (defun eword-analyze-atom (string start &optional _must-unfold) (if (and (string-match std11-atom-regexp string start) (= (match-beginning 0) start)) (let ((end (match-end 0))) (cons (cons 'atom (mime-charset-decode-string (substring string start end) default-mime-charset)) ;;(substring string end) end)))) (defun eword-lexical-analyze-internal (string start must-unfold) (let ((len (length string)) dest ret) (while (< start len) (setq ret (let ((rest mime-header-lexical-analyzer) func r) (while (and (setq func (car rest)) (null (setq r (funcall func string start must-unfold)))) (setq rest (cdr rest))) (or r (cons (cons 'error (substring string start)) (1+ len))))) (setq dest (cons (car ret) dest) start (cdr ret))) (nreverse dest))) (defun eword-lexical-analyze (string &optional start 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 (substring-no-properties string start)) ret cell) (if (setq ret (assoc key eword-lexical-analyze-cache)) (cdr ret) (setq ret (eword-lexical-analyze-internal key 0 must-unfold) eword-lexical-analyze-cache (cons (cons key ret) eword-lexical-analyze-cache)) (when (cdr (setq cell (nthcdr eword-lexical-analyze-cache-max eword-lexical-analyze-cache))) (setcdr cell nil)) ret))) (defun eword-decode-token (token) (let ((type (car token)) (value (cdr token))) (cond ((eq type 'quoted-string) (std11-wrap-as-quoted-string value)) ((eq type 'comment) (let (dest) (while value (setq dest (cons (if (stringp (car value)) (std11-wrap-as-quoted-pairs (car value) '(?\( ?\))) (eword-decode-token (car value))) dest) value (cdr value))) (apply 'concat "(" (nreverse (cons ")" dest))))) (t value)))) (defun eword-extract-address-components (string &optional start) "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) start '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 wanderlust-flim-2cf5a78/eword-encode.el000066400000000000000000000516631436773573300202020ustar00rootroot00000000000000;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1995,1996,1997,1998,1999,2000,2002,2003,2004 Free ;; Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: encoded-word, MIME, multilingual, header, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mime-def) (require 'mel) (require 'std11) (require 'eword-decode) ;;; @ variables ;;; ;; User options are defined in mime-def.el. (defvar mime-header-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-8859-14 . "Q") (iso-8859-15 . "Q") (iso-2022-jp . "B") (iso-2022-jp-3 . "B") (iso-2022-kr . "B") (gb2312 . "B") (cn-gb . "B") (cn-gb-2312 . "B") (euc-kr . "B") (tis-620 . "B") (iso-2022-jp-2 . "B") (iso-2022-int-1 . "B") (utf-8 . "B"))) (defvar mime-header-default-charset-encoding "Q") (defvar mime-header-encode-method-alist '((eword-encode-address-list . (Reply-To From Sender Resent-Reply-To Resent-From Resent-Sender To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc)) (eword-encode-in-reply-to . (In-Reply-To)) (eword-encode-structured-field-body . (Mime-Version User-Agent)) (eword-encode-Content-Disposition-field-body . (Content-Disposition)) (eword-encode-Content-Type-field-body . (Content-Type)) (eword-encode-unstructured-field-body))) ;;; @ 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 (encoded-text-encode-string string encoding mode))) (if text (concat "=?" (upcase (symbol-name charset)) "?" encoding "?" text "?=")))) ;;; @ charset word ;;; ;;; @ word ;;; ;;; @ rule ;;; (defmacro make-ew-rword (text charset encoding type) `(list ,text ,charset ,encoding ,type)) (defmacro ew-rword-text (rword) `(car ,rword)) (defmacro ew-rword-charset (rword) `(car (cdr ,rword))) (defmacro ew-rword-encoding (rword) `(car (cdr (cdr ,rword)))) (defmacro ew-rword-type (rword) `(car (cdr (cdr (cdr ,rword))))) (defun ew-find-string-rule (string) (let ((charset (detect-mime-charset-string string))) (list charset (cdr (or (assq charset mime-header-charset-encoding-alist) (cons nil mime-header-default-charset-encoding)))))) (defun tm-eword::string-to-ruled-words (string &optional mode) (let ((len (length string)) (beg 0) (i 1) spacep dest mcs) (when (> len 0) (mapcar (lambda (elt) (if (cdr elt) (make-ew-rword (car elt) nil nil mode) (setq mcs (detect-mime-charset-string (car elt))) (make-ew-rword (car elt) mcs (cdr (or (assq mcs mime-header-charset-encoding-alist) (cons nil mime-header-default-charset-encoding))) mode))) (progn (setq spacep (memq (aref string 0) '(?\s ?\t ?\n))) (while (< i len) (unless (eq spacep (memq (aref string i) '(?\s ?\t ?\n))) (setq dest (cons (cons (substring string beg i) spacep) dest)) (setq beg i) (setq spacep (null spacep))) (setq i (1+ i))) (nreverse (cons (cons (substring string beg len) spacep) dest))))))) (defun ew-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 (ew-rword-charset c)) (if (and (null (ew-rword-charset b)) (not (eq (ew-rword-type b) 'special))) (progn (setq a (car prev)) (setq ac (ew-rword-charset a)) (if (and (ew-rword-encoding a) (ew-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 eword-encode-split-string (str &optional mode) (ew-space-process (tm-eword::string-to-ruled-words str mode))) ;;; @ length ;;; (defun tm-eword::encoded-word-length (rword) (let ((string (ew-rword-text rword)) (charset (ew-rword-charset rword)) (encoding (ew-rword-encoding rword)) ret) (setq ret (cond ((string-equal encoding "B") (setq string (mime-charset-encode-string string charset)) (base64-encoded-length string)) ((string-equal encoding "Q") (setq string (mime-charset-encode-string string charset)) (Q-encoded-text-length string (ew-rword-type rword))))) (if ret (cons (+ 7 (length (symbol-name charset)) ret) string)))) ;;; @ encode-string ;;; (defun ew-encode-rword-1 (column rwl &optional must-output) (catch 'can-not-output (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))) ((memq (aref string 0) '(?\s ?\t)) (setq string (concat "\n" string) len (length string) rwl (cdr rwl))) (must-output (setq string "\n " len 1)) (t (throw 'can-not-output nil))) (cond ((and (setq len (car ret)) (<= (+ column len) 76)) (setq string (eword-encode-text (ew-rword-charset rword) (ew-rword-encoding rword) (cdr ret) (ew-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 (1+ p)) ;;(setq np (char-next-index (sref string p) 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 "") (if must-output (setq string "\n " len 1) (throw 'can-not-output nil)) (setq rwl (cons (cons (substring string p) (cdr rword)) (cdr rwl))) (setq string (eword-encode-text (ew-rword-charset rword) (ew-rword-encoding rword) str (ew-rword-type rword))) (setq len (+ (length string) column))))))) (list string len rwl)))) (defun eword-encode-rword-list (column rwl) (let (ret dest str ew-f pew-f folded-points) (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)) (if (null (setq ret (ew-encode-rword-1 column rwl))) (let ((i (1- (length dest))) c s r-dest r-column) (catch 'success (while (catch 'found (while (>= i 0) (cond ((memq (setq c (aref dest i)) '(?\s ?\t)) (if (memq i folded-points) (throw 'found nil) (setq folded-points (cons i folded-points)) (throw 'found i))) ((eq c ?\n) (throw 'found nil))) (setq i (1- i)))) (setq s (substring dest i) r-column (length s) r-dest (concat (substring dest 0 i) "\n" s)) (when (setq ret (ew-encode-rword-1 r-column rwl)) (setq dest r-dest column r-column) (throw 'success t))) (setq ret (ew-encode-rword-1 column rwl 'must-output))))) (setq str (car ret)) (setq dest (concat dest str)) (setq column (nth 1 ret) rwl (nth 2 ret))) (list dest column))) ;;; @ converter ;;; (defun eword-encode-phrase-to-rword-list (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 (ew-find-string-rule str))) (make-ew-rword str (car ret)(nth 1 ret) 'phrase)))))) ((eq type 'comment) (setq dest (append dest '(("(" nil nil special)) (tm-eword::string-to-ruled-words (cdr token) 'comment) '((")" nil nil special))))) (t (setq dest (append dest (tm-eword::string-to-ruled-words (cdr token) 'phrase))))) (setq phrase (cdr phrase))) (ew-space-process dest))) (defun eword-encode-addr-seq-to-rword-list (seq) (let (dest pname) (while seq (let* ((token (car seq)) (name (car token))) (cond ((eq name 'spaces) (setq dest (nconc dest (list (list (cdr token) nil nil))))) ((eq name 'comment) (setq dest (nconc dest (list (list "(" nil nil)) (eword-encode-split-string (cdr token) 'comment) (list (list ")" nil nil))))) ((eq name 'quoted-string) (setq dest (nconc dest (list (list (concat "\"" (cdr token) "\"") nil nil))))) (t (setq dest (if (or (eq pname 'spaces) (eq pname 'comment)) (nconc dest (list (list (cdr token) nil nil))) (nconc (nreverse (cdr (reverse dest))) ;; (butlast dest) (list (list (concat (car (car (last dest))) (cdr token)) nil nil))))))) (setq seq (cdr seq) pname name))) dest)) (defun eword-encode-phrase-route-addr-to-rword-list (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 (eword-encode-phrase-to-rword-list phrase)) (if dest (setq dest (append dest '((" " nil nil))))) (append dest (eword-encode-addr-seq-to-rword-list (append '((specials . "<")) route '((specials . ">")))))))) (defun eword-encode-addr-spec-to-rword-list (addr-spec) (if (eq (car addr-spec) 'addr-spec) (eword-encode-addr-seq-to-rword-list (cdr addr-spec)))) (defun eword-encode-mailbox-to-rword-list (mbox) (let ((addr (nth 1 mbox)) (comment (nth 2 mbox)) dest) (setq dest (or (eword-encode-phrase-route-addr-to-rword-list addr) (eword-encode-addr-spec-to-rword-list addr))) (if comment (setq dest (append dest '((" " nil nil) ("(" nil nil)) (eword-encode-split-string comment 'comment) (list '(")" nil nil))))) dest)) (defsubst eword-encode-mailboxes-to-rword-list (mboxes) (let ((dest (eword-encode-mailbox-to-rword-list (car mboxes)))) (if dest (while (setq mboxes (cdr mboxes)) (setq dest (nconc dest (list '("," nil nil)) (eword-encode-mailbox-to-rword-list (car mboxes)))))) dest)) (defsubst eword-encode-address-to-rword-list (address) (cond ((eq (car address) 'mailbox) (eword-encode-mailbox-to-rword-list address)) ((eq (car address) 'group) (nconc (eword-encode-phrase-to-rword-list (nth 1 address)) (list (list ":" nil nil)) (eword-encode-mailboxes-to-rword-list (nth 2 address)) (list (list ";" nil nil)))))) (defsubst eword-encode-addresses-to-rword-list (addresses) (let ((dest (eword-encode-address-to-rword-list (car addresses)))) (if dest (while (setq addresses (cdr addresses)) (setq dest (nconc dest (list '("," nil nil)) ;; (list '(" " nil nil)) (eword-encode-address-to-rword-list (car addresses)))))) dest)) (defsubst eword-encode-msg-id-to-rword-list (msg-id) (list (list (concat "<" (caar (eword-encode-addr-seq-to-rword-list (cdr msg-id))) ">") nil nil))) (defsubst eword-encode-in-reply-to-to-rword-list (in-reply-to) (let (dest) (while in-reply-to (setq dest (append dest (let ((elt (car in-reply-to))) (if (eq (car elt) 'phrase) (eword-encode-phrase-to-rword-list (cdr elt)) (eword-encode-msg-id-to-rword-list elt))))) (setq in-reply-to (cdr in-reply-to))) dest)) ;;; @ application interfaces ;;; (provide 'eword-encode) (require 'mime-parse) (defvar eword-encode-default-start-column 10 "Default start column if it is omitted.") (defun eword-encode-string (string &optional column mode) "Encode STRING as encoded-words, and return the result. Optional argument COLUMN is start-position of the field. Optional argument MODE allows `text', `comment', `phrase' or nil. Default value is `phrase'." (car (eword-encode-rword-list (or column eword-encode-default-start-column) (eword-encode-split-string string mode)))) (defun eword-encode-address-list (string &optional column) "Encode header field STRING as list of address, and return the result. Optional argument COLUMN is start-position of the field." (car (eword-encode-rword-list (or column eword-encode-default-start-column) (eword-encode-addresses-to-rword-list (std11-parse-addresses-string string))))) (defun eword-encode-in-reply-to (string &optional column) "Encode header field STRING as In-Reply-To field, and return the result. Optional argument COLUMN is start-position of the field." (car (eword-encode-rword-list (or column 13) (eword-encode-in-reply-to-to-rword-list (std11-parse-msg-ids-string string))))) (defun eword-encode-structured-field-body (string &optional column) "Encode header field STRING as structured field, and return the result. Optional argument COLUMN is start-position of the field." (car (eword-encode-rword-list (or column eword-encode-default-start-column) (eword-encode-addr-seq-to-rword-list (std11-lexical-analyze string))))) (defun eword-encode-unstructured-field-body (string &optional column) "Encode header field STRING as unstructured field, and return the result. Optional argument COLUMN is start-position of the field." (car (eword-encode-rword-list (or column eword-encode-default-start-column) (eword-encode-split-string string 'text)))) (defun eword-encode-Content-Type-field-body (field-body &optional _column) "Encode FIELD-BODY with MIME Parameter-Value Extensions, if necessary. Optional second arg COLUMN is ignored." (let ((tokens (mime-lexical-analyze field-body)) primary-type) (unless (eq (car (car tokens)) 'mime-token) (error "Invalid Content-Type value: %s" field-body)) (setq primary-type (downcase (cdr (car tokens))) tokens (cdr tokens)) (unless (and (eq (car (car tokens)) 'tspecials) (string= (cdr (car tokens)) "/") (setq tokens (cdr tokens)) (eq (car (car tokens)) 'mime-token)) (error "Invalid Content-Type value: %s" field-body)) (concat " " primary-type "/" (downcase (cdr (car tokens))) (mapconcat (lambda (param) (concat ";\n " (car param) "=" (cdr param))) (mime-encode-parameters (mime-parse-parameters (cdr tokens))) "")))) (defun eword-encode-Content-Disposition-field-body (field-body &optional _column) "Encode FIELD-BODY with MIME Parameter-Value Extensions, if necessary. Optional second arg COLUMN is ignored." (let ((tokens (mime-lexical-analyze field-body))) (unless (eq (car (car tokens)) 'mime-token) (error "Invalid Content-Disposition value: %s" field-body)) (concat " " (cdr (car tokens)) (mapconcat (lambda (param) (concat ";\n " (car param) "=" (cdr param))) (mime-encode-parameters (mime-parse-parameters (cdr tokens))) "")))) (defun eword-encode-Content-Type-field-body-broken-mime (field-body &optional _column) "Encode FIELD-BODY compatibly with Outlook, if necessary. Optional second arg COLUMN is ignored." (let ((tokens (mime-lexical-analyze field-body)) primary-type) (unless (eq (car (car tokens)) 'mime-token) (error "Invalid Content-Type value: %s" field-body)) (setq primary-type (downcase (cdr (car tokens))) tokens (cdr tokens)) (unless (and (eq (car (car tokens)) 'tspecials) (string= (cdr (car tokens)) "/") (setq tokens (cdr tokens)) (eq (car (car tokens)) 'mime-token)) (error "Invalid Content-Type value: %s" field-body)) (concat " " primary-type "/" (downcase (cdr (car tokens))) (mapconcat (lambda (param) (concat ";\n " (car param) "=\"" (cdr param) "\"")) (mime-encode-parameters-broken-mime (mime-parse-parameters (cdr tokens))) "")))) (defun eword-encode-Content-Disposition-field-body-broken-mime (field-body &optional _column) "Encode FIELD-BODY compatibly with Outlook, if necessary. Optional second arg COLUMN is ignored." (let ((tokens (mime-lexical-analyze field-body))) (unless (eq (car (car tokens)) 'mime-token) (error "Invalid Content-Disposition value: %s" field-body)) (concat " " (cdr (car tokens)) (mapconcat (lambda (param) (concat ";\n " (car param) "=\"" (cdr param) "\"")) (mime-encode-parameters-broken-mime (mime-parse-parameters (cdr tokens))) "")))) ;;;###autoload (defun mime-encode-field-body (field-body field-name) "Encode FIELD-BODY as FIELD-NAME, and return the result. A lexical token includes non-ASCII character is encoded as MIME encoded-word. ASCII token is not encoded." (setq field-body (std11-unfold-string field-body)) (if (string= field-body "") "" (let ((method-alist mime-header-encode-method-alist) start ret) (if (symbolp field-name) (setq start (1+ (length (symbol-name field-name)))) (setq start (1+ (length field-name)) field-name (intern (capitalize field-name)))) (while (car method-alist) (if (or (not (cdr (car method-alist))) (memq field-name (cdr (car method-alist)))) (progn (setq ret (apply (caar method-alist) (list field-body start))) (setq method-alist nil))) (setq method-alist (cdr method-alist))) ret))) (defalias 'eword-encode-field-body 'mime-encode-field-body) (make-obsolete 'eword-encode-field-body 'mime-encode-field-body "19 Dec 2000") (defun eword-in-subject-p () (let ((str (std11-field-body "Subject"))) (if (and str (string-match eword-encoded-word-regexp str)) str))) (make-obsolete 'eword-in-subject-p "Don't use it." "19 Dec 2000") (defsubst eword-find-field-encoding-method (field-name) (setq field-name (downcase field-name)) (let ((alist mime-field-encoding-method-alist)) (catch 'found (while alist (let* ((pair (car alist)) (str (car pair))) (if (and (stringp str) (string= field-name (downcase str))) (throw 'found (cdr pair)))) (setq alist (cdr alist))) (cdr (assq t mime-field-encoding-method-alist))))) ;;;###autoload (defun mime-encode-header-in-buffer (&optional code-conversion) "Encode header fields to network representation, such as MIME encoded-word. It refers the `mime-field-encoding-method-alist' variable." (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)) bbeg end field-name) (while (re-search-forward std11-field-head-regexp nil t) (setq bbeg (match-end 0) field-name (buffer-substring-no-properties (match-beginning 0) (1- bbeg)) end (std11-field-end)) (and (delq 'ascii (find-charset-region bbeg end)) (let ((method (eword-find-field-encoding-method (downcase field-name)))) (cond ((eq method 'mime) (let* ((field-body (buffer-substring-no-properties bbeg end)) (encoded-body (mime-encode-field-body field-body field-name))) (if (not encoded-body) (error "Cannot encode %s:%s" field-name field-body) (delete-region bbeg end) (insert encoded-body)))) (code-conversion (let ((cs (or (mime-charset-to-coding-system method) default-cs))) (encode-coding-region bbeg end cs))))))))))) (defalias 'eword-encode-header 'mime-encode-header-in-buffer) (make-obsolete 'eword-encode-header 'mime-encode-header-in-buffer "19 Dec 2000") ;;; @ end ;;; (provide 'eword-encode) ;;; eword-encode.el ends here wanderlust-flim-2cf5a78/flim-pkg.el000066400000000000000000000002551436773573300173240ustar00rootroot00000000000000(define-package "flim" "1.14.9" "A library to provide basic features about message representation or encoding." '((emacs "24.5") (apel "10.8") (oauth2 "0.11"))) wanderlust-flim-2cf5a78/ftp.in000066400000000000000000000006631436773573300164200ustar00rootroot00000000000000--<>-{ It is available from http://www.kanji.zinbun.kyoto-u.ac.jp/~tomo/lemi/dist/flim/flim-API/ --[[message/external-body; access-type=URL; URL*0="http://"; URL*1="www.kanji.zinbun.kyoto-u.ac.jp/~tomo/"; URL*2="lemi/dist/"; URL*3="flim/flim-API/"; URL*4="PACKAGE-VERSION.tar.gz"]] Content-Type: application/octet-stream Content-Disposition: attachment; filename="PACKAGE-VERSION.tar.gz" --}-<> wanderlust-flim-2cf5a78/hmac-sha1.el000066400000000000000000000052221436773573300173570ustar00rootroot00000000000000;;; hmac-sha1.el --- Compute HMAC-SHA1. -*- lexical-binding: t -*- ;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keywords: HMAC, RFC 2104, HMAC-SHA1, SHA1, Cancel-Lock ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1". ;; ;; (encode-hex-string (hmac-sha1 "Hi There" (make-string 20 ?\x0b))) ;; => "b617318655057264e28bc0b6fb378c8ef146be00" ;; ;; (encode-hex-string (hmac-sha1 "what do ya want for nothing?" "Jefe")) ;; => "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79" ;; ;; (encode-hex-string (hmac-sha1 (make-string 50 ?\xdd) (make-string 20 ?\xaa))) ;; => "125d7342b9ac11cd91a39af48aa17b4f63f175d3" ;; ;; (encode-hex-string ;; (hmac-sha1 ;; (make-string 50 ?\xcd) ;; (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819"))) ;; => "4c9007f4026250c6bc8414f9bf50c86c2d7235da" ;; ;; (encode-hex-string ;; (hmac-sha1 "Test With Truncation" (make-string 20 ?\x0c))) ;; => "4c1a03424b55e07fe7f27be1d58bb9324a9a5a04" ;; ;; (encode-hex-string ;; (hmac-sha1-96 "Test With Truncation" (make-string 20 ?\x0c))) ;; => "4c1a03424b55e07fe7f27be1" ;; ;; (encode-hex-string ;; (hmac-sha1 ;; "Test Using Larger Than Block-Size Key - Hash Key First" ;; (make-string 80 ?\xaa))) ;; => "aa4ae5e15272d00e95705637ce8a3b55ed402112" ;; ;; (encode-hex-string ;; (hmac-sha1 ;; "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" ;; (make-string 80 ?\xaa))) ;; => "e8e99d0f45237d786d6bbaa7965c7808bbff1a91" ;;; Code: (eval-when-compile (require 'hmac-def)) (defun sha1-binary (string) "Return the SHA1 of STRING in binary form." (secure-hash 'sha1 string nil nil t)) (define-hmac-function hmac-sha1 sha1-binary 64 20) ; => (hmac-sha1 TEXT KEY) (define-hmac-function hmac-sha1-96 sha1-binary 64 20 96) (provide 'hmac-sha1) ;;; hmac-sha1.el ends here wanderlust-flim-2cf5a78/luna.el000066400000000000000000000325711436773573300165630ustar00rootroot00000000000000;;; luna.el --- tiny OOP system kernel -*- lexical-binding: t -*- ;; Copyright (C) 1999,2000,2002 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: OOP ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: ;;; @ class ;;; (defmacro luna-find-class (name) "Return a luna-class that has NAME." `(get ,name 'luna-class)) ;; Give NAME (symbol) the luna-class CLASS. (defmacro luna-set-class (name class) `(put ,name 'luna-class ,class)) ;; Return the obarray of luna-class CLASS. (defmacro luna-class-obarray (class) `(aref ,class 1)) ;; Return the parents of luna-class CLASS. (defmacro luna-class-parents (class) `(aref ,class 2)) ;; Return the number of slots of luna-class CLASS. (defmacro luna-class-number-of-slots (class) `(aref ,class 3)) (defmacro luna-define-class (class &optional parents slots) "Define CLASS as a luna-class. CLASS always inherits the luna-class `standard-object'. The optional 1st arg PARENTS is a list luna-class names. These luna-classes are also inheritted by CLASS. The optional 2nd arg SLOTS is a list of slots CLASS will have." `(luna-define-class-function ',class ',(append parents '(standard-object)) ',slots)) ;; Define CLASS as a luna-class. PARENTS, if non-nil, is a list of ;; luna-class names inherited by CLASS. SLOTS, if non-nil, is a list ;; of slots belonging to CLASS. (defun luna-define-class-function (class &optional parents slots) (let ((oa (make-vector 31 0)) name (i 2) b j) (dolist (parent parents) (setq b (- i 2)) (mapatoms (lambda (sym) (when (setq j (get sym 'luna-slot-index)) (setq name (symbol-name sym)) (unless (intern-soft name oa) (put (intern name oa) 'luna-slot-index (+ j b)) (setq i (1+ i))))) (luna-class-obarray (luna-find-class parent)))) (dolist (slot slots) (setq name (symbol-name slot)) (unless (intern-soft name oa) (put (intern name oa) 'luna-slot-index i) (setq i (1+ i)))) (luna-set-class class (vector 'class oa parents i)))) ;; Return a member (slot or method) of CLASS that has name ;; MEMBER-NAME. (defun luna-class-find-member (class member-name) (intern-soft (if (stringp member-name) member-name (symbol-name member-name)) (luna-class-obarray class))) ;; Return a member (slot or method) of CLASS that has name ;; MEMBER-NAME. If CLASS doesnt' have such a member, make it in ;; CLASS. (defsubst luna-class-find-or-make-member (class member-name) (intern (if (stringp member-name) member-name (symbol-name member-name)) (luna-class-obarray class))) ;; Return the index number of SLOT-NAME in CLASS. (defmacro luna-class-slot-index (class slot-name) `(get (luna-class-find-member ,class ,slot-name) 'luna-slot-index)) (defmacro luna-define-method (name &rest definition) "Define NAME as a method of a luna class. Usage of this macro follows: (luna-define-method NAME [METHOD-QUALIFIER] ARGLIST [DOCSTRING] BODY...) The optional 1st argument METHOD-QUALIFIER specifies when and how the method is called. If it is :before, call the method before calling the parents' methods. If it is :after, call the method after calling the parents' methods. If it is :around, call the method only. The parents' methods can be executed by calling the function `luna-call-next-method' in BODY. Otherwize, call the method only, and the parents' methods are never executed. In this case, METHOD-QUALIFIER is treated as ARGLIST. ARGLIST has the form ((VAR CLASS) METHOD-ARG ...), where VAR is a variable name that should be bound to an entity that receives the message NAME, CLASS is a class name. The first argument to the method is VAR, and the remaining arguments are METHOD-ARGs. If VAR is nil, arguments to the method are METHOD-ARGs. This kind of methods can't be called from generic-function (see `luna-define-generic'). The optional 4th argument DOCSTRING is the documentation of the method. If it is not string, it is treated as BODY. The optional 5th BODY is the body of the method." (let ((method-qualifier (pop definition)) args specializer class self) (if (memq method-qualifier '(:before :after :around)) (setq args (pop definition)) (setq args method-qualifier method-qualifier nil)) (setq specializer (car args) class (nth 1 specializer) self (car specializer)) `(let ((func (lambda ,(if self (cons self (cdr args)) (cdr args)) ,@definition)) (sym (luna-class-find-or-make-member (luna-find-class ',class) ',name)) (cache (get ',name 'luna-method-cache))) (and cache (fboundp sym) (mapatoms (lambda (s) (if (memq (symbol-function sym) (symbol-value s)) (unintern s cache))) cache)) (fset sym func) (put sym 'luna-method-qualifier ,method-qualifier)))) (put 'luna-define-method 'lisp-indent-function 'defun) (def-edebug-spec luna-define-method (&define name [&optional &or ":before" ":after" ":around"] ((arg symbolp) [&rest arg] [&optional ["&optional" arg &rest arg]] &optional ["&rest" arg]) def-body)) ;; Return a list of method functions named SERVICE registered in the ;; parents of CLASS. (defun luna-class-find-parents-functions (class service) (let ((parents (luna-class-parents class)) ret) (while (and parents (null (setq ret (luna-class-find-functions (luna-find-class (pop parents)) service))))) ret)) ;; Return a list of method functions named SERVICE registered in CLASS ;; and the parents.. (defun luna-class-find-functions (class service) (let ((sym (luna-class-find-member class service))) (if (fboundp sym) (cond ((eq (get sym 'luna-method-qualifier) :before) (cons (symbol-function sym) (luna-class-find-parents-functions class service))) ((eq (get sym 'luna-method-qualifier) :after) (nconc (luna-class-find-parents-functions class service) (list (symbol-function sym)))) ((eq (get sym 'luna-method-qualifier) :around) (cons sym (luna-class-find-parents-functions class service))) (t (list (symbol-function sym)))) (luna-class-find-parents-functions class service)))) ;;; @ instance (entity) ;;; (defvar luna-next-methods nil) (defvar luna-current-method-arguments nil) (defmacro luna-class-name (entity) "Return class-name of the ENTITY." `(aref ,entity 0)) (defmacro luna-set-class-name (entity name) `(aset ,entity 0 ,name)) (defmacro luna-get-obarray (entity) `(aref ,entity 1)) (defmacro luna-set-obarray (entity array) `(aset ,entity 1 ,array)) (defmacro luna-slot-index (entity slot-name) `(luna-class-slot-index (luna-find-class (luna-class-name ,entity)) ,slot-name)) (defsubst luna-slot-value (entity slot) "Return the value of SLOT of ENTITY." (aref entity (luna-slot-index entity slot))) (defsubst luna-set-slot-value (entity slot value) "Store VALUE into SLOT of ENTITY." (aset entity (luna-slot-index entity slot) value)) (defmacro luna-find-functions (entity service) `(luna-class-find-functions (luna-find-class (luna-class-name ,entity)) ,service)) (defsubst luna-send (entity message &rest arguments) "Send MESSAGE to ENTITY, and return the result. ENTITY is an instance of a luna class, and MESSAGE is a method name of the luna class. ARGUMENTS is arguments of the MESSAGE." (let ((luna-current-method-arguments arguments) (luna-next-methods (luna-find-functions entity message)) luna-current-method luna-previous-return-value) (while (and luna-next-methods (progn (setq luna-current-method (pop luna-next-methods) luna-previous-return-value (apply luna-current-method luna-current-method-arguments)) (if (symbolp luna-current-method) (not (eq (get luna-current-method 'luna-method-qualifier) :around)) t)))) luna-previous-return-value)) (defun luna-call-next-method () "Call the next method in the current method function. A method function that has :around qualifier should call this function to execute the parents' methods." (let (luna-current-method luna-previous-return-value) (while (and luna-next-methods (progn (setq luna-current-method (pop luna-next-methods) luna-previous-return-value (apply luna-current-method luna-current-method-arguments)) (if (symbolp luna-current-method) (not (eq (get luna-current-method 'luna-method-qualifier) :around)) t)))) luna-previous-return-value)) (defun luna-make-entity (class &rest init-args) "Make an entity (instance) of luna-class CLASS and return it. INIT-ARGS is a plist of the form (:SLOT1 VAL1 :SLOT2 VAL2 ...), where SLOTs are slots of CLASS and the VALs are initial values of the corresponding SLOTs." (let* ((c (get class 'luna-class)) (v (make-vector (luna-class-number-of-slots c) nil))) (luna-set-class-name v class) (luna-set-obarray v (make-vector 7 0)) (apply #'luna-send v 'initialize-instance v init-args))) ;;; @ interface (generic function) ;;; ;; Find a method of ENTITY that handles MESSAGE, and call it with ;; arguments ARGUMENTS. (defun luna-apply-generic (entity message &rest arguments) (let* ((luna-current-method-arguments arguments) (class (luna-class-name entity)) (cache (get message 'luna-method-cache)) (sym (intern-soft (symbol-name class) cache)) luna-next-methods) (if sym (setq luna-next-methods (symbol-value sym)) (setq luna-next-methods (luna-find-functions entity message)) (set (intern (symbol-name class) cache) luna-next-methods)) (luna-call-next-method))) ;; Convert ARGLIST (argument list spec for a method function) to the ;; actual list of arguments. (defsubst luna-arglist-to-arguments (arglist) (let (dest) (while arglist (let ((arg (car arglist))) (or (memq arg '(&optional &rest)) (setq dest (cons arg dest)))) (setq arglist (cdr arglist))) (nreverse dest))) (defmacro luna-define-generic (name args &optional doc) "Define a function NAME that provides a generic interface to the method NAME. ARGS is the argument list for NAME. The first element of ARGS is an entity. The function handles a message sent to the entity by calling the method with proper arguments. The optional 3rd argument DOC is the documentation string for NAME." (if doc `(progn (defun ,(intern (symbol-name name)) ,args ,doc (luna-apply-generic ,(car args) ',name ,@(luna-arglist-to-arguments args))) (put ',name 'luna-method-cache (make-vector 31 0))) `(progn (defun ,(intern (symbol-name name)) ,args (luna-apply-generic ,(car args) ',name ,@(luna-arglist-to-arguments args))) (put ',name 'luna-method-cache (make-vector 31 0))))) (put 'luna-define-generic 'lisp-indent-function 'defun) ;;; @ accessor ;;; (defun luna-define-internal-accessors (class-name) "Define internal accessors for instances of the luna class CLASS-NAME. Internal accessors are macros to refer and set a slot value of the instances. For instance, if the class has SLOT, macros CLASS-NAME-SLOT-internal and CLASS-NAME-set-SLOT-internal are defined. CLASS-NAME-SLOT-internal accepts one argument INSTANCE, and returns the value of SLOT. CLASS-NAME-set-SLOT-internal accepts two arguemnt INSTANCE and VALUE, and sets SLOT to VALUE." (let ((entity-class (luna-find-class class-name)) parents parent-class) (mapatoms (lambda (slot) (if (luna-class-slot-index entity-class slot) (catch 'derived (setq parents (luna-class-parents entity-class)) (while parents (setq parent-class (luna-find-class (car parents))) (if (luna-class-slot-index parent-class slot) (throw 'derived nil)) (setq parents (cdr parents))) (eval `(progn (defmacro ,(intern (format "%s-%s-internal" class-name slot)) (entity) (list 'aref entity ,(luna-class-slot-index entity-class (intern (symbol-name slot))))) (defmacro ,(intern (format "%s-set-%s-internal" class-name slot)) (entity value) (list 'aset entity ,(luna-class-slot-index entity-class (intern (symbol-name slot))) value))))))) (luna-class-obarray entity-class)))) ;;; @ standard object ;;; ;; Define super class of all luna classes. (luna-define-class-function 'standard-object) (luna-define-method initialize-instance ((entity standard-object) &rest init-args) "Initialize slots of ENTITY by INIT-ARGS." (let* ((c (luna-find-class (luna-class-name entity))) (oa (luna-class-obarray c)) s i) (while init-args (setq s (intern-soft (substring (symbol-name (pop init-args)) 1) oa) i (pop init-args)) (if s (aset entity (get s 'luna-slot-index) i))) entity)) ;;; @ end ;;; (provide 'luna) ;; luna.el ends here wanderlust-flim-2cf5a78/lunit.el000066400000000000000000000247051436773573300167570ustar00rootroot00000000000000;;; lunit.el --- simple testing framework for luna -*- lexical-binding: t -*- ;; Copyright (C) 2000 Daiki Ueno. ;; Author: Daiki Ueno ;; Keywords: OOP, XP ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module is inspired by "JUnit A Cook's Tour". ;; ;; (require 'lunit) ;; ;; (luna-define-class silly-test-case (lunit-test-case)) ;; ;; (luna-define-method test-1 ((case silly-test-case)) ;; (lunit-assert (integerp "a"))) ;; ;; (luna-define-method test-2 ((case silly-test-case)) ;; (lunit-assert (stringp "b"))) ;; ;; (with-output-to-temp-buffer "*Lunit Results*" ;; (lunit (lunit-make-test-suite-from-class 'silly-test-case))) ;; ______________________________________________________________________ ;; Starting test `silly-test-case#test-1' ;; failure: (integerp "a") ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;; ______________________________________________________________________ ;; Starting test `silly-test-case#test-2' ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;; 2 runs, 1 failures, 0 errors ;;; Code: (require 'luna) ;;; @ test ;;; (eval-and-compile (luna-define-class lunit-test () (name)) (luna-define-internal-accessors 'lunit-test)) (luna-define-generic lunit-test-number-of-tests (test) "Count the number of test cases that will be run by the test.") (luna-define-generic lunit-test-run (test result) "Run the test and collects its result in result.") (luna-define-generic lunit-test-suite-add-test (suite test) "Add the test to the suite.") ;;; @ test listener ;;; (luna-define-class lunit-test-listener) ;;; @ test result ;;; (put 'lunit-error 'error-message "test error") (put 'lunit-error 'error-conditions '(lunit-error error)) (put 'lunit-failure 'error-message "test failure") (put 'lunit-failure 'error-conditions '(lunit-failure lunit-error error)) (eval-and-compile (luna-define-class lunit-test-result () (errors failures listeners)) (luna-define-internal-accessors 'lunit-test-result)) (luna-define-generic lunit-test-result-run (result case) "Run the test case.") (luna-define-generic lunit-test-result-notify (result message &rest args) "Report the current state of execution.") (luna-define-generic lunit-test-result-error (result case error) "Add error to the list of errors. The passed in exception caused the error.") (luna-define-generic lunit-test-result-failure (result case failure) "Add failure to the list of failures. The passed in exception caused the failure.") (luna-define-generic lunit-test-result-add-listener (result listener) "Add listener to the list of listeners.") (defun lunit-make-test-result (&rest listeners) "Return a newly allocated `lunit-test-result' instance with LISTENERS." (luna-make-entity 'lunit-test-result :listeners listeners)) (luna-define-method lunit-test-result-notify ((result lunit-test-result) message args) (let ((listeners (lunit-test-result-listeners-internal result))) (dolist (listener listeners) (apply #'luna-send listener message listener args)))) (luna-define-method lunit-test-result-run ((result lunit-test-result) case) (lunit-test-result-notify result 'lunit-test-listener-start case) (condition-case error (lunit-test-case-run case) (lunit-failure (lunit-test-result-failure result case (nth 1 error))) (lunit-error (lunit-test-result-error result case (cdr error)))) (lunit-test-result-notify result 'lunit-test-listener-end case)) (luna-define-method lunit-test-result-error ((result lunit-test-result) case error) (let ((errors (lunit-test-result-errors-internal result))) (setq errors (nconc errors (list (cons case error)))) (lunit-test-result-set-errors-internal result errors)) (lunit-test-result-notify result 'lunit-test-listener-error case error)) (luna-define-method lunit-test-result-failure ((result lunit-test-result) case failure) (let ((failures (lunit-test-result-failures-internal result))) (setq failures (nconc failures (list (cons case failure)))) (lunit-test-result-set-failures-internal result failures)) (lunit-test-result-notify result 'lunit-test-listener-failure case failure)) (luna-define-method lunit-test-result-add-listener ((result lunit-test-result) listener) (let ((listeners (lunit-test-result-listeners-internal result))) (setq listeners (nconc listeners (list listener))) (lunit-test-result-set-listeners-internal result listeners))) ;;; @ test case ;;; (luna-define-class lunit-test-case (lunit-test)) (luna-define-generic lunit-test-case-run (case) "Run the test case.") (luna-define-generic lunit-test-case-setup (case) "Setup the test case.") (luna-define-generic lunit-test-case-teardown (case) "Clear the test case.") (defun lunit-make-test-case (class name) "Return a newly allocated `lunit-test-case'. CLASS is a symbol for class derived from `lunit-test-case'. NAME is name of the method to be tested." (luna-make-entity class :name name)) (luna-define-method lunit-test-number-of-tests ((_case lunit-test-case)) 1) (luna-define-method lunit-test-run ((case lunit-test-case) result) (lunit-test-result-run result case)) (luna-define-method lunit-test-case-setup ((_case lunit-test-case))) (luna-define-method lunit-test-case-teardown ((_case lunit-test-case))) (luna-define-method lunit-test-case-run ((case lunit-test-case)) (lunit-test-case-setup case) (unwind-protect (let* ((name (lunit-test-name-internal case)) (functions (luna-find-functions case name))) (unless functions (error "Method \"%S\" not found" name)) (condition-case error (funcall (car functions) case) (lunit-failure (signal (car error)(cdr error))) (error (signal 'lunit-error error)))) (lunit-test-case-teardown case))) ;;; @ test suite ;;; (eval-and-compile (luna-define-class lunit-test-suite (lunit-test) (tests)) (luna-define-internal-accessors 'lunit-test-suite)) (defun lunit-make-test-suite (&rest tests) "Return a newly allocated `lunit-test-suite' instance. TESTS holds a number of instances of `lunit-test'." (luna-make-entity 'lunit-test-suite :tests tests)) (luna-define-method lunit-test-suite-add-test ((suite lunit-test-suite) test) (let ((tests (lunit-test-suite-tests-internal suite))) (lunit-test-suite-set-tests-internal suite (nconc tests (list test))))) (luna-define-method lunit-test-number-of-tests ((suite lunit-test-suite)) (let ((tests (lunit-test-suite-tests-internal suite)) (accu 0)) (dolist (test tests) (setq accu (+ accu (lunit-test-number-of-tests test)))) accu)) (luna-define-method lunit-test-run ((suite lunit-test-suite) result) (let ((tests (lunit-test-suite-tests-internal suite))) (dolist (test tests) (lunit-test-run test result)))) ;;; @ test runner ;;; (defmacro lunit-assert (condition-expr) "Verify that CONDITION-EXPR returns non-nil; signal an error if not." (let ((condition (eval condition-expr))) `(when ,(not condition) (signal 'lunit-failure (list ',condition-expr))))) (luna-define-class lunit-test-printer (lunit-test-listener)) (luna-define-method lunit-test-listener-error ((_printer lunit-test-printer) _case error) (princ (format " error: %S" error))) (luna-define-method lunit-test-listener-failure ((_printer lunit-test-printer) _case failure) (princ (format " failure: %S" failure))) (luna-define-method lunit-test-listener-start ((_printer lunit-test-printer) case) (princ (format "Running `%S#%S'..." (luna-class-name case) (lunit-test-name-internal case)))) (luna-define-method lunit-test-listener-end ((_printer lunit-test-printer) _case) (princ "\n")) (defun lunit-make-test-suite-from-class (class) "Make a test suite from all test methods of the CLASS." (let (tests) (mapatoms (lambda (symbol) (if (and (fboundp symbol) (string-match "^test" (symbol-name symbol)) (null (get symbol 'luna-method-qualifier))) (push (lunit-make-test-case class symbol) tests))) (luna-class-obarray (luna-find-class class))) (apply #'lunit-make-test-suite tests))) (defun lunit (test) "Run TEST and display the result." (let* ((printer (luna-make-entity 'lunit-test-printer)) (result (lunit-make-test-result printer))) (lunit-test-run test result) (let ((failures (lunit-test-result-failures-internal result)) (errors (lunit-test-result-errors-internal result))) (princ (format "%d runs, %d failures, %d errors\n" (lunit-test-number-of-tests test) (length failures) (length errors)))))) (defvar imenu-create-index-function) (defun lunit-create-index-function () (require 'imenu) (save-excursion (unwind-protect (progn (goto-char (point-min)) (setq imenu-generic-expression '((nil "^\\s-*(def\\(un\\|subst\\|macro\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2))) (funcall imenu-create-index-function)) (setq imenu-create-index-function lisp-imenu-generic-expression)))) (defun lunit-generate-template (file) (interactive "fGenerate lunit template for: ") (with-current-buffer (find-file-noselect file) (let ((index-alist (lunit-create-index-function))) (with-output-to-temp-buffer "*Lunit template*" (let* ((feature (file-name-sans-extension (file-name-nondirectory file))) (class (concat "test-" feature))) (set-buffer standard-output) (insert "\ \(require 'lunit) \(require '" feature ") \(luna-define-class " class " (lunit-test-case)) ") (dolist (index index-alist) (insert "\ \(luna-define-method " class "-" (car index) " ((case " class ")) (lunit-assert nil)) "))))))) (provide 'lunit) ;;; lunit.el ends here wanderlust-flim-2cf5a78/md5.el000066400000000000000000000032451436773573300163050ustar00rootroot00000000000000;;; md5.el --- MD5 Message Digest Algorithm. -*- lexical-binding: t -*- ;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keywords: MD5, RFC 1321 ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Test cases from RFC 1321. ;; ;; (md5 "") ;; => d41d8cd98f00b204e9800998ecf8427e ;; ;; (md5 "a") ;; => 0cc175b9c0f1b6a831c399e269772661 ;; ;; (md5 "abc") ;; => 900150983cd24fb0d6963f7d28e17f72 ;; ;; (md5 "message digest") ;; => f96b697d7cb7938d525a2f31aaf161d0 ;; ;; (md5 "abcdefghijklmnopqrstuvwxyz") ;; => c3fcd3d76192e4007dfb496cca67e13b ;; ;; (md5 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") ;; => d174ab98d277d9f5a5611c2c9f419d9f ;; ;; (md5 "12345678901234567890123456789012345678901234567890123456789012345678901234567890") ;; => 57edf4a22be3c955ac49da2e2107b67a ;;; Code: (defvar md5-dl-module nil) (provide 'md5) ;;; md5.el ends here wanderlust-flim-2cf5a78/mel-g.el000066400000000000000000000075171436773573300166270ustar00rootroot00000000000000;;; mel-g.el --- Gzip64 encoder/decoder. -*- lexical-binding: t -*- ;; Copyright (C) 1995,96,97,98,99,2001 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; MORIOKA Tomohiko ;; Maintainer: Shuhei KOBAYASHI ;; Created: 1995/10/25 ;; Keywords: Gzip64, base64, gzip, MIME ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;;; NOTE: Gzip64 is an experimental Content-Transfer-Encoding and its ;;; use is STRONGLY DISCOURAGED except for private communication. ;;; Code: (require 'mime-def) (require 'path-util) ;;; @ variables ;;; (defvar gzip64-external-encoder '("sh" "-c" "gzip -c | mmencode") "*list of gzip64 encoder program name and its arguments.") (defvar gzip64-external-decoder '("sh" "-c" "mmencode -u | gzip -dc") "*list of gzip64 decoder program name and its arguments.") ;;; @ encoder/decoder for region ;;; (defun gzip64-external-encode-region (beg end) (interactive "*r") (save-excursion (let ((coding-system-for-write 'binary)) (apply (function call-process-region) beg end (car gzip64-external-encoder) t t nil (cdr gzip64-external-encoder))) ;; for OS/2 ;; regularize line break code ;;(goto-char (point-min)) ;;(while (re-search-forward "\r$" nil t) ;; (replace-match "")) )) (defun gzip64-external-decode-region (beg end) (interactive "*r") (save-excursion (let ((coding-system-for-read 'binary)) (apply (function call-process-region) beg end (car gzip64-external-decoder) t t nil (cdr gzip64-external-decoder))))) (mel-define-method-function (mime-encode-region start end (nil "x-gzip64")) 'gzip64-external-encode-region) (mel-define-method-function (mime-decode-region start end (nil "x-gzip64")) 'gzip64-external-decode-region) ;;; @ encoder/decoder for string ;;; (mel-define-method mime-encode-string (string (nil "x-gzip64")) (with-temp-buffer (insert string) (gzip64-external-encode-region (point-min)(point-max)) (buffer-string))) (mel-define-method mime-decode-string (string (nil "x-gzip64")) (with-temp-buffer (insert string) (gzip64-external-decode-region (point-min)(point-max)) (buffer-string))) ;;; @ encoder/decoder for file ;;; (mel-define-method mime-insert-encoded-file (filename (nil "x-gzip64")) (interactive "*fInsert encoded file: ") (apply (function call-process) (car gzip64-external-encoder) filename t nil (cdr gzip64-external-encoder))) (mel-define-method mime-write-decoded-region (start end filename (nil "x-gzip64")) "Decode and write current region encoded by gzip64 into FILENAME. START and END are buffer positions." (interactive "*r\nFWrite decoded region to file: ") (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (apply (function call-process-region) start end (car gzip64-external-decoder) nil nil nil (let ((args (cdr gzip64-external-decoder))) (append (butlast args) (list (concat (car (last args)) ">" filename))))))) ;;; @ end ;;; (provide 'mel-g) ;;; mel-g.el ends here wanderlust-flim-2cf5a78/mel-q-ccl.el000066400000000000000000000760761436773573300174060ustar00rootroot00000000000000;;; mel-q-ccl.el --- Quoted-Printable encoder/decoder using CCL. -*- lexical-binding: t -*- ;; Copyright (C) 1998,1999 Tanaka Akira ;; Author: Tanaka Akira ;; Created: 1998/9/17 ;; Keywords: MIME, Quoted-Printable, Q-encoding ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'ccl) (require 'pccl) (require 'mime-def) ;;; @ constants ;;; (eval-when-compile (defconst mel-ccl-16-table '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)) (defconst mel-ccl-28-table '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27)) (defconst mel-ccl-256-table '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255)) (defconst mel-ccl-256-to-16-table '(nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 0 1 2 3 4 5 6 7 8 9 nil nil nil nil nil nil nil 10 11 12 13 14 15 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil 10 11 12 13 14 15 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil)) (defconst mel-ccl-16-to-256-table (string-to-list "0123456789ABCDEF")) (defconst mel-ccl-high-table (vconcat (mapcar (lambda (v) (nth (ash v -4) mel-ccl-16-to-256-table)) mel-ccl-256-table))) (defconst mel-ccl-low-table (vconcat (mapcar (lambda (v) (nth (logand v 15) mel-ccl-16-to-256-table)) mel-ccl-256-table))) (defconst mel-ccl-u-raw (mapcar 'identity "0123456789\ ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz\ !@#$%&'()*+,-./:;<>@[\\]^`{|}~")) (defconst mel-ccl-c-raw (string-to-list "0123456789\ ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz\ !@#$%&'*+,-./:;<>@[]^`{|}~")) (defconst mel-ccl-p-raw (string-to-list "0123456789\ ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz\ !*+-/")) (defconst mel-ccl-qp-table [enc enc enc enc enc enc enc enc enc wsp lf enc enc cr enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc wsp raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw enc raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc])) ;;; @ CCL programs ;;; ;;; Q (define-ccl-program mel-ccl-decode-q `(1 ((loop (read r0) (branch (r0 & 255) ,@(mapcar (lambda (r0) (cond ((= r0 ?_) `(write-repeat ?\s)) ((= r0 ?=) `((loop (read-branch r1 ,@(mapcar (lambda (v) (if (integerp v) `((r0 = ,v) (break)) '(repeat))) mel-ccl-256-to-16-table))) (loop (read-branch r1 ,@(mapcar (lambda (v) (if (integerp v) `((write r0 ,(vconcat (mapcar (lambda (r0) (logior (ash r0 4) v)) mel-ccl-16-table))) (break)) '(repeat))) mel-ccl-256-to-16-table))) (repeat))) (t `(write-repeat ,r0)))) mel-ccl-256-table)))))) (eval-when-compile (defun mel-ccl-encode-q-generic (raw) `(3 (loop (loop (read r0) (r0 &= 255) (branch r0 ,@(mapcar (lambda (r0) (cond ((= r0 32) `(write-repeat ?_)) ((member r0 raw) `(write-repeat ,r0)) (t '(break)))) mel-ccl-256-table))) (write ?=) (write r0 ,mel-ccl-high-table) (write r0 ,mel-ccl-low-table) (repeat)))) ;; On xemacs, generated program counts iso-8859-1 8bit character as 6bytes. (defun mel-ccl-count-q-length (raw) `(0 ((r0 = 0) (loop (read-branch r1 ,@(mapcar (lambda (r1) (if (or (= r1 32) (member r1 raw)) '((r0 += 1) (repeat)) '((r0 += 3) (repeat)))) mel-ccl-256-table))))))) (define-ccl-program mel-ccl-encode-uq (mel-ccl-encode-q-generic mel-ccl-u-raw)) (define-ccl-program mel-ccl-encode-cq (mel-ccl-encode-q-generic mel-ccl-c-raw)) (define-ccl-program mel-ccl-encode-pq (mel-ccl-encode-q-generic mel-ccl-p-raw)) (define-ccl-program mel-ccl-count-uq (mel-ccl-count-q-length mel-ccl-u-raw)) (define-ccl-program mel-ccl-count-cq (mel-ccl-count-q-length mel-ccl-c-raw)) (define-ccl-program mel-ccl-count-pq (mel-ccl-count-q-length mel-ccl-p-raw)) ;; Quoted-Printable (eval-when-compile (defvar eof-block-branches) (defvar eof-block-reg) (defun mel-ccl-set-eof-block (branch) (let ((p (assoc branch eof-block-branches))) (unless p (setq p (cons branch (length eof-block-branches)) eof-block-branches (cons p eof-block-branches))) `(,eof-block-reg = ,(cdr p))))) (eval-when-compile (defun mel-ccl-try-to-read-crlf (input-crlf reg succ cr-eof cr-fail lf-eof lf-fail crlf-eof crlf-fail) (if input-crlf `(,(mel-ccl-set-eof-block cr-eof) (read-if (,reg == ?\r) (,(mel-ccl-set-eof-block lf-eof) (read-if (,reg == ?\n) ,succ ,lf-fail)) ,cr-fail)) `(,(mel-ccl-set-eof-block crlf-eof) (read-if (,reg == ?\n) ,succ ,crlf-fail))))) (eval-when-compile ;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK ;; is not executed. (defun mel-ccl-encode-quoted-printable-generic (input-crlf output-crlf) (let ((hard (if output-crlf "\r\n" "\n")) (soft (if output-crlf "=\r\n" "=\n")) (eof-block-branches nil) (eof-block-reg 'r4) (after-wsp 'r5) (column 'r6) (type 'r3) (type-raw 0) (type-enc 1) (type-wsp 2) (type-brk 3)) `(4 ((,column = 0) (,after-wsp = 0) ,(mel-ccl-set-eof-block '(end)) (read r0) (loop ; invariant: column <= 75 (loop (loop (r0 &= 255) (branch r0 ,@(mapcar (lambda (r0) (let ((tmp (aref mel-ccl-qp-table r0))) (cond ((eq r0 ?F) `(if (,column == 0) (,(mel-ccl-set-eof-block '((write "F") (end))) (read-if (r0 == ?r) (,(mel-ccl-set-eof-block '((write "Fr") (end))) (read-if (r0 == ?o) (,(mel-ccl-set-eof-block '((write "Fro") (end))) (read-if (r0 == ?m) (,(mel-ccl-set-eof-block '((write "From") (end))) (read-if (r0 == ?\s) ((,column = 7) (,after-wsp = 1) ,(mel-ccl-set-eof-block '((write "From=20") (end))) (read r0) (write-repeat "=46rom ")) ((,column = 4) (write-repeat "From")))) ((,column = 3) (write-repeat "Fro")))) ((,column = 2) (write-repeat "Fr")))) ((,column = 1) (write-repeat "F")))) ((,type = ,type-raw) (break)) ; RAW )) ((eq r0 ?.) `(if (,column == 0) ,(mel-ccl-try-to-read-crlf input-crlf 'r0 ;; "." CR LF (input-crlf: t) ;; "." LF (input-crlf: nil) `((write ,(concat "=2E" hard)) ,(mel-ccl-set-eof-block '(end)) (read r0) (repeat)) ;; "." '((write ".") (end)) ;; "." noCR (input-crlf: t) `((,column = 1) (write-repeat ".")) ;; "." CR (input-crlf: t) '((write ".=0D") (end)) ;; "." CR noLF (input-crlf: t) `((,column = 4) (write-repeat ".=0D")) ;; "." (input-crlf: nil) '((write ".") (end)) ;; "." noLF (input-crlf: nil) `((,column = 1) (write-repeat "."))) ((,type = ,type-raw) (break)) ; RAW )) ((eq tmp 'raw) `((,type = ,type-raw) (break))) ((eq tmp 'enc) `((,type = ,type-enc) (break))) ((eq tmp 'wsp) `((,type = ,type-wsp) (break))) ((eq tmp 'cr) `((,type = ,(if input-crlf type-brk type-enc)) (break))) ((eq tmp 'lf) `((,type = ,(if input-crlf type-enc type-brk)) (break)))))) mel-ccl-256-table))) ;; r0:type{raw,enc,wsp,brk} (branch ,type ;; r0:type-raw (if (,column < 75) ((,column += 1) (,after-wsp = 0) ,(mel-ccl-set-eof-block '(end)) (write-read-repeat r0)) ((r1 = (r0 + 0)) (,after-wsp = 0) ,@(mel-ccl-try-to-read-crlf input-crlf 'r0 `((,column = 0) (write r1) ,(mel-ccl-set-eof-block `((write ,hard) (end))) (read r0) (write-repeat ,hard)) '((write r1) (end)) `((,column = 1) (write ,soft) (write-repeat r1)) `((write ,soft) (write r1) (write "=0D") (end)) `((,column = 4) (write ,soft) (write r1) (write-repeat "=0D")) '((write r1) (end)) `((,column = 1) (write ,soft) (write-repeat r1))))) ;; r0:type-enc ((,after-wsp = 0) (if (,column < 73) ((,column += 3) (write "=") (write r0 ,mel-ccl-high-table) ,(mel-ccl-set-eof-block '(end)) (write-read-repeat r0 ,mel-ccl-low-table)) (if (,column < 74) ((r1 = (r0 + 0)) (,after-wsp = 0) ,@(mel-ccl-try-to-read-crlf input-crlf 'r0 `((,column = 0) (write "=") (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (write ,hard) ,(mel-ccl-set-eof-block '(end)) (read r0) (repeat)) `((write "=") (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (end)) `((,column = 3) (write ,(concat soft "=")) (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (repeat)) `((write ,(concat soft "=")) (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (write "=0D") (end)) `((,column = 6) (write ,(concat soft "=")) (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (write-repeat "=0D")) `((write "=") (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (end)) `((,column = 3) (write ,(concat soft "=")) (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (repeat)))) ((,column = 3) (write ,(concat soft "=")) (write r0 ,mel-ccl-high-table) ,(mel-ccl-set-eof-block '(end)) (write-read-repeat r0 ,mel-ccl-low-table))))) ;; r0:type-wsp (if (,column < 73) ((r1 = (r0 + 0)) ,@(mel-ccl-try-to-read-crlf input-crlf 'r0 `((,column = 0) (,after-wsp = 0) (write "=") (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (write ,hard) ,(mel-ccl-set-eof-block `(end)) (read r0) (repeat)) `((write "=") (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (end)) `((,column += 1) (,after-wsp = 1) (write-repeat r1)) `((write r1) (write "=0D") (end)) `((,column += 4) (,after-wsp = 0) (write r1) (write-repeat "=0D")) `((write "=") (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (end)) `((,column += 1) (,after-wsp = 1) (write-repeat r1)))) (if (,column < 74) ((r1 = (r0 + 0)) ,@(mel-ccl-try-to-read-crlf input-crlf 'r0 `((,column = 0) (,after-wsp = 0) (write "=") (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (write ,hard) ,(mel-ccl-set-eof-block `(end)) (read r0) (repeat)) `((write "=") (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (end)) `((,column += 1) (,after-wsp = 1) (write-repeat r1)) `((write r1) (write ,(concat soft "=0D")) (end)) `((,column = 3) (,after-wsp = 0) (write r1) (write-repeat ,(concat soft "=0D"))) `((write "=") (write r1 ,mel-ccl-high-table) (write r1 ,mel-ccl-low-table) (end)) `((,column += 1) (,after-wsp = 1) (write-repeat r1)))) (if (,column < 75) ((,column += 1) (,after-wsp = 1) ,(mel-ccl-set-eof-block `((write ,soft) (end))) (write-read-repeat r0)) ((write ,soft) (,column = 0) (,after-wsp = 0) (repeat))))) ;; r0:type-brk ,(if input-crlf ;; r0{CR}:type-brk `((if ((,column > 73) & ,after-wsp) ((,column = 0) (,after-wsp = 0) (write ,soft))) ,(mel-ccl-set-eof-block `((if (,column > 73) (write ,soft)) (write "=0D") (end))) (read-if (r0 == ?\n) (if ,after-wsp ((,after-wsp = 0) (,column = 0) (write ,(concat soft hard)) ,(mel-ccl-set-eof-block '(end)) (read r0) (repeat)) ((,after-wsp = 0) (,column = 0) (write ,hard) ,(mel-ccl-set-eof-block '(end)) (read r0) (repeat))) (if (,column < 73) ((,after-wsp = 0) (,column += 3) (write-repeat "=0D")) (if (,column < 74) (if (r0 == ?\r) ((,after-wsp = 0) ,(mel-ccl-set-eof-block `((write ,(concat soft "=0D=0D")) (end))) (read-if (r0 == ?\n) ((,column = 0) ,(mel-ccl-set-eof-block `((write ,(concat "=0D" hard)) (end))) (read r0) (write-repeat ,(concat "=0D" hard))) ((,column = 6) (write-repeat ,(concat soft "=0D=0D"))))) ((,after-wsp = 0) (,column = 3) (write-repeat ,(concat soft "=0D")))) ((,after-wsp = 0) (,column = 3) (write-repeat ,(concat soft "=0D"))))))) ;; r0{LF}:type-brk `(if ,after-wsp ;; WSP ; r0{LF}:type-brk ((,after-wsp = 0) (,column = 0) (write ,(concat soft (if output-crlf "\r" ""))) ,(mel-ccl-set-eof-block `(end)) (write-read-repeat r0)) ;; noWSP ; r0{LF}:type-brk ((,after-wsp = 0) (,column = 0) ,@(if output-crlf '((write ?\r)) '()) ,(mel-ccl-set-eof-block `(end)) (write-read-repeat r0)))))))) (branch ,eof-block-reg ,@(reverse (mapcar 'car eof-block-branches)))))) (defun mel-ccl-decode-quoted-printable-generic (input-crlf output-crlf) `(1 ((read r0) (loop (branch (r0 & 255) ,@(mapcar (lambda (r0) (let ((tmp (aref mel-ccl-qp-table r0))) (cond ((eq tmp 'raw) `(write-read-repeat r0)) ((eq tmp 'wsp) (if (eq r0 ?\s) `(r1 = 1) `(r1 = 0))) ((eq tmp 'cr) (if input-crlf ;; r0='\r' `((read r0) ;; '\r' r0 (if (r0 == ?\n) ;; '\r' r0='\n' ;; hard line break found. ,(if output-crlf '((write ?\r) (write-read-repeat r0)) '(write-read-repeat r0)) ;; '\r' r0:[^\n] ;; invalid control character (bare CR) found. ;; -> ignore it and rescan from r0. (repeat))) ;; r0='\r' ;; invalid character (bare CR) found. ;; -> ignore. `((read r0) (repeat)))) ((eq tmp 'lf) (if input-crlf ;; r0='\n' ;; invalid character (bare LF) found. ;; -> ignore. `((read r0) (repeat)) ;; r0='\r\n' ;; hard line break found. (if output-crlf '((write ?\r) (write-read-repeat r0)) '(write-read-repeat r0)))) ((eq r0 ?=) ;; r0='=' `((read r0) ;; '=' r0 (r1 = (r0 == ?\t)) (if ((r0 == ?\s) | r1) ;; '=' r0:[\t ] ;; Skip transport-padding. ;; It should check CR LF after ;; transport-padding. (loop (read-if (r0 == ?\t) (repeat) (if (r0 == ?\s) (repeat) (break))))) ;; '=' [\t ]* r0:[^\t ] (branch r0 ,@(mapcar (lambda (r0) (cond ((eq r0 ?\r) (if input-crlf ;; '=' [\t ]* r0='\r' `((read r0) ;; '=' [\t ]* '\r' r0 (if (r0 == ?\n) ;; '=' [\t ]* '\r' r0='\n' ;; soft line break found. ((read r0) (repeat)) ;; '=' [\t ]* '\r' r0:[^\n] ;; invalid input -> ;; output "=" and rescan from r0. ((write "=") (repeat)))) ;; '=' [\t ]* r0='\r' ;; invalid input (bare CR found) -> ;; output "=" and rescan from next. `((write ?=) (read r0) (repeat)))) ((eq r0 ?\n) (if input-crlf ;; '=' [\t ]* r0='\n' ;; invalid input (bare LF found) -> ;; output "=" and rescan from next. `((write ?=) (read r0) (repeat)) ;; '=' [\t ]* r0='\r\n' ;; soft line break found. `((read r0) (repeat)))) ((setq tmp (nth r0 mel-ccl-256-to-16-table)) ;; '=' [\t ]* r0:[0-9A-F] ;; upper nibble of hexadecimal digit found. `((r1 = (r0 + 0)) (r0 = ,tmp))) (t ;; '=' [\t ]* r0:[^\r0-9A-F] ;; invalid input -> ;; output "=" and rescan from r0. `((write ?=) (repeat))))) mel-ccl-256-table)) ;; '=' [\t ]* r1:r0:[0-9A-F] (read-branch r2 ,@(mapcar (lambda (r2) (if (setq tmp (nth r2 mel-ccl-256-to-16-table)) ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[0-9A-F] `(write-read-repeat r0 ,(vconcat (mapcar (lambda (r0) (logior (ash r0 4) tmp)) mel-ccl-16-table))) ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F] ;; invalid input `(r3 = 0) ; nop )) mel-ccl-256-table)) ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F] ;; invalid input -> ;; output "=" with hex digit and rescan from r2. (write ?=) (r0 = (r2 + 0)) (write-repeat r1))) (t ;; r0:[^\t\r -~] ;; invalid character found. ;; -> output as is. `((write-read-repeat r0)))))) mel-ccl-256-table)) ;; r1[0]:[\t ] (loop ,@(apply 'append (mapcar (lambda (regnum) (let ((reg (aref [r1 r2 r3 r4 r5] regnum))) (apply 'append (mapcar (lambda (bit) (if (= bit 0) (if (= regnum 0) nil `((read r0) (if (r0 == ?\t) (,reg = 0) (if (r0 == ?\ ) (,reg = 1) ((r6 = ,(+ (* regnum 28) bit)) (break)))))) `((read r0) (if (r0 == ?\ ) (,reg |= ,(ash 1 bit)) (if (r0 != ?\t) ((r6 = ,(+ (* regnum 28) bit)) (break))))))) mel-ccl-28-table)))) '(0 1 2 3 4))) ;; white space buffer exhaust. ;; error: line length limit (76bytes) violation. ;; -> ignore these white spaces. (repeat)) ,(if input-crlf `(if (r0 == ?\r) ((read r0) (if (r0 == ?\n) ;; trailing white spaces found. ;; -> ignore these white spacs. ((write ,(if output-crlf "\r\n" "\n")) (read r0) (repeat)) ;; [\t ]* \r r0:[^\n] ;; error: bare CR found. ;; -> output white spaces and ignore bare CR. )) ;; [\t ]* r0:[^\r] ;; middle white spaces found. ) `(if (r0 == ?\n) ;; trailing white spaces found. ;; -> ignore these white spacs. ((write ,(if output-crlf "\r\n" "\n")) (read r0) (repeat)) ;; [\t ]* r0:[^\n] ;; middle white spaces found. )) ,@(apply 'append (mapcar (lambda (regnum) (let ((reg (aref [r1 r2 r3 r4 r5] regnum))) (apply 'append (mapcar (lambda (bit) `((if (,reg & ,(ash 1 bit)) (write ?\ ) (write ?\t)) (if (r6 == ,(+ (* regnum 28) bit 1)) (repeat)))) mel-ccl-28-table)))) '(0 1 2 3 4))) (repeat)))))) (define-ccl-program mel-ccl-encode-quoted-printable-crlf-crlf (mel-ccl-encode-quoted-printable-generic t t)) (define-ccl-program mel-ccl-encode-quoted-printable-crlf-lf (mel-ccl-encode-quoted-printable-generic t nil)) (define-ccl-program mel-ccl-encode-quoted-printable-lf-crlf (mel-ccl-encode-quoted-printable-generic nil t)) (define-ccl-program mel-ccl-encode-quoted-printable-lf-lf (mel-ccl-encode-quoted-printable-generic nil nil)) (define-ccl-program mel-ccl-decode-quoted-printable-crlf-crlf (mel-ccl-decode-quoted-printable-generic t t)) (define-ccl-program mel-ccl-decode-quoted-printable-crlf-lf (mel-ccl-decode-quoted-printable-generic t nil)) (define-ccl-program mel-ccl-decode-quoted-printable-lf-crlf (mel-ccl-decode-quoted-printable-generic nil t)) (define-ccl-program mel-ccl-decode-quoted-printable-lf-lf (mel-ccl-decode-quoted-printable-generic nil nil)) ;;; @ coding system ;;; (make-ccl-coding-system 'mel-ccl-uq-rev ?Q "MIME Q-encoding in unstructured field (reversed)" 'mel-ccl-encode-uq 'mel-ccl-decode-q) (make-ccl-coding-system 'mel-ccl-cq-rev ?Q "MIME Q-encoding in comment (reversed)" 'mel-ccl-encode-cq 'mel-ccl-decode-q) (make-ccl-coding-system 'mel-ccl-pq-rev ?Q "MIME Q-encoding in phrase (reversed)" 'mel-ccl-encode-pq 'mel-ccl-decode-q) (make-ccl-coding-system 'mel-ccl-quoted-printable-crlf-crlf-rev ?Q "MIME Quoted-Printable-encoding (reversed)" 'mel-ccl-encode-quoted-printable-crlf-crlf 'mel-ccl-decode-quoted-printable-crlf-crlf) (make-ccl-coding-system 'mel-ccl-quoted-printable-lf-crlf-rev ?Q "MIME Quoted-Printable-encoding (LF encoding) (reversed)" 'mel-ccl-encode-quoted-printable-crlf-lf 'mel-ccl-decode-quoted-printable-lf-crlf) (make-ccl-coding-system 'mel-ccl-quoted-printable-crlf-lf-rev ?Q "MIME Quoted-Printable-encoding (LF internal) (reversed)" 'mel-ccl-encode-quoted-printable-lf-crlf 'mel-ccl-decode-quoted-printable-crlf-lf) (make-ccl-coding-system 'mel-ccl-quoted-printable-lf-lf-rev ?Q "MIME Quoted-Printable-encoding (LF encoding) (LF internal) (reversed)" 'mel-ccl-encode-quoted-printable-lf-lf 'mel-ccl-decode-quoted-printable-lf-lf) ;;; @ quoted-printable ;;; (check-broken-facility ccl-execute-eof-block-on-decoding-some) (unless-broken ccl-execute-eof-block-on-decoding-some (defun quoted-printable-ccl-encode-string (string) "Encode STRING with quoted-printable encoding." (decode-coding-string string 'mel-ccl-quoted-printable-lf-lf-rev)) (defun quoted-printable-ccl-encode-region (start end) "Encode the region from START to END with quoted-printable encoding." (interactive "*r") (decode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev)) (defun quoted-printable-ccl-insert-encoded-file (filename) "Encode contents of the file named as FILENAME, and insert it." (interactive "*fInsert encoded file: ") (insert (decode-coding-string (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents-literally filename) (buffer-string)) 'mel-ccl-quoted-printable-lf-lf-rev))) (mel-define-method-function (mime-encode-string string (nil "quoted-printable")) 'quoted-printable-ccl-encode-string) (mel-define-method-function (mime-encode-region start end (nil "quoted-printable")) 'quoted-printable-ccl-encode-region) (mel-define-method-function (mime-insert-encoded-file filename (nil "quoted-printable")) 'quoted-printable-ccl-insert-encoded-file)) (defun quoted-printable-ccl-decode-string (string) "Decode quoted-printable encoded STRING." (encode-coding-string string 'mel-ccl-quoted-printable-lf-lf-rev)) (defun quoted-printable-ccl-decode-region (start end) "Decode the region from START to END with quoted-printable encoding." (interactive "*r") (encode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev)) (defun quoted-printable-ccl-write-decoded-region (start end filename) "Decode quoted-printable encoded current region and write out to FILENAME." (interactive "*r\nFWrite decoded region to file: ") (defvar jam-zcat-filename-list) (let ((coding-system-for-write (if (coding-system-p 'mel-ccl-quoted-printable-lf-lf-rev-unix) 'mel-ccl-quoted-printable-lf-lf-rev-unix 'mel-ccl-quoted-printable-lf-lf-rev)) jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end filename))) (mel-define-method-function (mime-decode-string string (nil "quoted-printable")) 'quoted-printable-ccl-decode-string) (mel-define-method-function (mime-decode-region start end (nil "quoted-printable")) 'quoted-printable-ccl-decode-region) (mel-define-method-function (mime-write-decoded-region start end filename (nil "quoted-printable")) 'quoted-printable-ccl-write-decoded-region) ;;; @ Q ;;; (defun q-encoding-ccl-encode-string (string &optional mode) "Encode STRING to Q-encoding of encoded-word, and return the result. MODE allows `text', `comment', `phrase' or nil. Default value is `phrase'." (decode-coding-string string (cond ((eq mode 'text) 'mel-ccl-uq-rev) ((eq mode 'comment) 'mel-ccl-cq-rev) (t 'mel-ccl-pq-rev)))) (defun q-encoding-ccl-decode-string (string) "Decode Q encoded STRING and return the result." (encode-coding-string string 'mel-ccl-uq-rev)) (defun q-encoding-ccl-encoded-length (string &optional mode) (let ((status [nil nil nil nil nil nil nil nil nil])) (fillarray status nil) ; XXX: Is this necessary? (ccl-execute-on-string (cond ((eq mode 'text) 'mel-ccl-count-uq) ((eq mode 'comment) 'mel-ccl-count-cq) (t 'mel-ccl-count-pq)) status string) (aref status 0))) (mel-define-method-function (encoded-text-encode-string string (nil "Q")) 'q-encoding-ccl-encode-string) (mel-define-method encoded-text-decode-string (string (nil "Q")) (if (string-match (eval-when-compile (concat "\\`" Q-encoded-text-regexp "\\'")) string) (q-encoding-ccl-decode-string string) (error "Invalid encoded-text %s" string))) ;;; @ end ;;; (provide 'mel-q-ccl) ;;; mel-q-ccl.el ends here. wanderlust-flim-2cf5a78/mel-q.el000066400000000000000000000273061436773573300166370ustar00rootroot00000000000000;;; mel-q.el --- Quoted-Printable encoder/decoder. -*- lexical-binding: t -*- ;; Copyright (C) 1995,96,97,98,99,2000,2001 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Created: 1995/6/25 ;; Keywords: MIME, Quoted-Printable, Q-encoding ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mime-def) (require 'pces) ;;; @ Quoted-Printable encoder ;;; (defsubst quoted-printable-quote-char (character) (concat "=" (char-to-string (aref quoted-printable-hex-chars (ash (logand character 255) -4))) (char-to-string (aref quoted-printable-hex-chars (logand character 15))))) (defun quoted-printable-internal-encode-region (start end) (save-excursion (save-restriction (narrow-to-region (goto-char start) end) (let ((col 0) chr) (while (not (eobp)) (cond ((>= col 75) ; soft line break. (insert "=\n") (setq col 0)) ((eolp) ; end of line. (forward-char) (setq col 0)) (t (setq chr (logand (following-char) 255)) (cond ((and (memq chr '(?\s ?\t)) ; encode WSP char before CRLF. (eq (char-after (1+ (point))) ?\n)) (forward-char) (insert "=\n") (forward-char) (setq col 0)) ((and (bolp) ; "^From " is not safe. (eq chr ?F) (eq (char-after (1+ (point))) ?r) (eq (char-after (+ 2 (point))) ?o) (eq (char-after (+ 3 (point))) ?m) (eq (char-after (+ 4 (point))) ?\s)) (delete-region (point)(1+ (point))) (insert "=46") ; moved to ?r. (forward-char 4) ; skip "rom ". (setq col 7)) ((or (= chr ?\t) ; skip safe char. (and (<= 32 chr)(/= chr ?=)(< chr 127))) (forward-char) (setq col (1+ col))) ((>= col 73) ; soft line break. (insert "=\n") (setq col 0)) (t ; encode unsafe char. (delete-region (point)(1+ (point))) ;; (insert (quoted-printable-quote-char chr)) (insert ?= (aref quoted-printable-hex-chars (ash chr -4)) (aref quoted-printable-hex-chars (logand chr 15))) (setq col (+ col 3))))))))))) (defvar quoted-printable-external-encoder '("mmencode" "-q") "*list of quoted-printable encoder program name and its arguments.") (defun quoted-printable-external-encode-region (start end) (save-excursion (save-restriction (narrow-to-region start end) (as-binary-process (apply (function call-process-region) start end (car quoted-printable-external-encoder) t t nil (cdr quoted-printable-external-encoder))) ;; for OS/2 ;; regularize line break code (goto-char (point-min)) (while (re-search-forward "\r$" nil t) (replace-match ""))))) (declare-function exec-installed-p "path-util" (file &optional paths suffixes)) (defvar quoted-printable-internal-encoding-limit (progn (require 'path-util) (if (exec-installed-p "mmencode") 1000 ;; XXX: Fix this message, or simply remove it. ;; (message "Don't found external encoder for Quoted-Printable!") nil)) "*limit size to use internal quoted-printable encoder. If size of input to encode is larger than this limit, external encoder is called.") (defun quoted-printable-encode-region (start end) "Encode current region by quoted-printable. START and END are buffer positions. This function calls internal quoted-printable encoder if size of region is smaller than `quoted-printable-internal-encoding-limit', otherwise it calls external quoted-printable encoder specified by `quoted-printable-external-encoder'. In this case, you must install the program (maybe mmencode included in metamail or XEmacs package)." (interactive "*r") (if (and quoted-printable-internal-encoding-limit (> (- end start) quoted-printable-internal-encoding-limit)) (quoted-printable-external-encode-region start end) (quoted-printable-internal-encode-region start end))) (defun quoted-printable-encode-string (string) "Encode STRING to quoted-printable, and return the result." (with-temp-buffer (insert string) (quoted-printable-encode-region (point-min)(point-max)) (buffer-string))) (mel-define-method-function (mime-encode-string string (nil "quoted-printable")) 'quoted-printable-encode-string) (mel-define-method-function (mime-encode-region start end (nil "quoted-printable")) 'quoted-printable-encode-region) (mel-define-method mime-insert-encoded-file (filename (nil "quoted-printable")) "Encode contents of file FILENAME to quoted-printable, and insert the result. It calls external quoted-printable encoder specified by `quoted-printable-external-encoder'. So you must install the program \(maybe mmencode included in metamail or XEmacs package)." (interactive "*fInsert encoded file: ") (apply (function call-process) (car quoted-printable-external-encoder) filename t nil (cdr quoted-printable-external-encoder))) ;;; @ Quoted-Printable decoder ;;; (defsubst quoted-printable-hex-char-to-num (chr) (cond ((<= ?a chr) (+ (- chr ?a) 10)) ((<= ?A chr) (+ (- chr ?A) 10)) ((<= ?0 chr) (- chr ?0)))) (eval-and-compile (if (eval-when-compile (> (string-to-char (string-as-multibyte "\200")) 128)) (defsubst quoted-printable-num-to-raw-byte-char (chr) (if (and chr (> chr 127)) (logior chr (eval-when-compile (- (string-to-char (string-as-multibyte "\200")) 128))) chr)) (defsubst quoted-printable-num-to-raw-byte-char (chr) chr))) (defun quoted-printable-internal-decode-region (start end) (save-excursion (save-restriction (narrow-to-region start end) (goto-char (point-min)) (while (search-forward "=" nil t) (cond ((eolp) ;; unfold soft line break. (delete-region (1- (point))(1+ (point)))) ((and (memq (following-char) (eval-when-compile ;; XXX: should provide char-list instead. (string-to-list quoted-printable-hex-chars))) (memq (char-after (1+ (point))) (eval-when-compile ;; XXX: should provide char-list instead. (string-to-list quoted-printable-hex-chars)))) ;; encoded char. (insert (prog1 (quoted-printable-num-to-raw-byte-char (logior (ash (quoted-printable-hex-char-to-num (following-char)) 4) (quoted-printable-hex-char-to-num (char-after (1+ (point)))))) (delete-region (1- (point))(+ 2 (point)))))) (t ;; invalid encoding. )))))) (defvar quoted-printable-external-decoder '("mmencode" "-q" "-u") "*list of quoted-printable decoder program name and its arguments.") (defun quoted-printable-external-decode-region (start end) (save-excursion (as-binary-process (apply (function call-process-region) start end (car quoted-printable-external-decoder) t t nil (cdr quoted-printable-external-decoder))))) (defvar quoted-printable-internal-decoding-limit nil "*limit size to use internal quoted-printable decoder. If size of input to decode is larger than this limit, external decoder is called.") (defun quoted-printable-decode-region (start end) "Decode current region by quoted-printable. START and END are buffer positions. This function calls internal quoted-printable decoder if size of region is smaller than `quoted-printable-internal-decoding-limit', otherwise it calls external quoted-printable decoder specified by `quoted-printable-external-decoder'. In this case, you must install the program (maybe mmencode included in metamail or XEmacs package)." (interactive "*r") (if (and quoted-printable-internal-decoding-limit (> (- end start) quoted-printable-internal-decoding-limit)) (quoted-printable-external-decode-region start end) (quoted-printable-internal-decode-region start end))) (defun quoted-printable-decode-string (string) "Decode STRING which is encoded in quoted-printable, and return the result." (with-temp-buffer (insert string) (quoted-printable-decode-region (point-min)(point-max)) (buffer-string))) (mel-define-method-function (mime-decode-string string (nil "quoted-printable")) 'quoted-printable-decode-string) (mel-define-method-function (mime-decode-region start end (nil "quoted-printable")) 'quoted-printable-decode-region) (defvar quoted-printable-external-decoder-option-to-specify-file '("-o") "*list of options of quoted-printable decoder program to specify file. If the quoted-printable decoder does not have such option, set this as nil.") (mel-define-method mime-write-decoded-region (start end filename (nil "quoted-printable")) "Decode and write current region encoded by quoted-printable into FILENAME. START and END are buffer positions." (interactive "*r\nFWrite decoded region to file: ") (as-binary-process (apply (function call-process-region) start end (car quoted-printable-external-decoder) (null quoted-printable-external-decoder-option-to-specify-file) (unless quoted-printable-external-decoder-option-to-specify-file (list (current-buffer) nil)) nil (delq nil (append (cdr quoted-printable-external-decoder) quoted-printable-external-decoder-option-to-specify-file (when quoted-printable-external-decoder-option-to-specify-file (list filename)))))) (unless quoted-printable-external-decoder-option-to-specify-file (write-region-as-binary (point-min) (point-max) filename))) ;;; @ Q-encoding encode/decode string ;;; (defconst q-encoding-special-chars-alist '((text ?= ?? ?_) (comment ?= ?? ?_ ?\( ?\) ?\\) (phrase ?= ?? ?_ ?\( ?\) ?\\ ?\" ?# ?$ ?% ?& ?' ?, ?. ?/ ?: ?\; ?< ?> ?@ ?\[ ?\] ?^ ?` ?{ ?| ?} ?~) )) (defun q-encoding-encode-string (string &optional mode) "Encode STRING to Q-encoding of encoded-word, and return the result. MODE allows `text', `comment', `phrase' or nil. Default value is `phrase'." (let ((specials (cdr (or (assq mode q-encoding-special-chars-alist) (assq 'phrase q-encoding-special-chars-alist))))) (mapconcat (lambda (chr) (cond ((eq chr ?\s) "_") ((or (< chr 32) (< 126 chr) (memq chr specials)) (quoted-printable-quote-char chr)) (t (char-to-string chr)))) string ""))) (defun q-encoding-decode-string (string) "Decode STRING which is encoded in Q-encoding and return the result." (let (q h l) (mapconcat (lambda (chr) (cond ((eq chr ?_) " ") ((eq chr ?=) (setq q t) "") (q (setq h (quoted-printable-hex-char-to-num chr)) (setq q nil) "") (h (setq l (quoted-printable-hex-char-to-num chr)) (prog1 (char-to-string (quoted-printable-num-to-raw-byte-char (logior (ash h 4) l))) (setq h nil))) (t (char-to-string chr)))) string ""))) (mel-define-method-function (encoded-text-encode-string string (nil "Q")) 'q-encoding-encode-string) (mel-define-method encoded-text-decode-string (string (nil "Q")) (if (string-match (eval-when-compile (concat "\\`" Q-encoded-text-regexp "\\'")) string) (q-encoding-decode-string string) (error "Invalid encoded-text %s" string))) ;;; @ end ;;; (provide 'mel-q) ;;; mel-q.el ends here. wanderlust-flim-2cf5a78/mel-u.el000066400000000000000000000124001436773573300166300ustar00rootroot00000000000000;;; mel-u.el --- uuencode encoder/decoder. -*- lexical-binding: t -*- ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Created: 1995/10/25 ;; Keywords: uuencode ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mime-def) (require 'path-util) (mel-define-backend "x-uue") ;;; @ variables ;;; (defvar uuencode-external-encoder '("uuencode" "-") "*list of uuencode encoder program name and its arguments.") (defvar uuencode-external-decoder '("sh" "-c" "uudecode") "*list of uuencode decoder program name and its arguments.") ;;; @ uuencode encoder/decoder for region ;;; (defun uuencode-external-encode-region (start end) "Encode current region by unofficial uuencode format. This function uses external uuencode encoder which is specified by variable `uuencode-external-encoder'." (interactive "*r") (save-excursion (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (apply (function call-process-region) start end (car uuencode-external-encoder) t t nil (cdr uuencode-external-encoder))) ;; for OS/2 ;; regularize line break code (goto-char (point-min)) (while (re-search-forward "\r$" nil t) (replace-match "")))) (defun uuencode-external-decode-region (start end) "Decode current region by unofficial uuencode format. This function uses external uuencode decoder which is specified by variable `uuencode-external-decoder'." (interactive "*r") (save-excursion (let ((filename (make-temp-file "x-uue"))) (save-excursion (save-restriction (set-mark end) (narrow-to-region start end) (goto-char start) (when (and (re-search-forward "^begin [0-9]+ " nil t) (looking-at ".+$")) (replace-match filename) (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (apply (function call-process-region) start (mark) (car uuencode-external-decoder) t nil nil (cdr uuencode-external-decoder))) (insert-file-contents filename) ;; The previous line causes the buffer to be made read-only, I ;; do not pretend to understand the control flow leading to this ;; but suspect it has something to do with image-mode. -slb ;; Use `inhibit-read-only' to avoid to force ;; buffer-read-only nil. - tomo. (let ((inhibit-read-only t)) (delete-file filename)))))))) (mel-define-method-function (mime-encode-region start end (nil "x-uue")) 'uuencode-external-encode-region) (mel-define-method-function (mime-decode-region start end (nil "x-uue")) 'uuencode-external-decode-region) ;;; @ encoder/decoder for string ;;; (mel-define-method mime-encode-string (string (nil "x-uue")) (with-temp-buffer (insert string) (uuencode-external-encode-region (point-min)(point-max)) (buffer-string))) (mel-define-method mime-decode-string (string (nil "x-uue")) (with-temp-buffer (insert string) (uuencode-external-decode-region (point-min)(point-max)) (buffer-string))) ;;; @ uuencode encoder/decoder for file ;;; (mel-define-method mime-insert-encoded-file (filename (nil "x-uue")) "Insert file encoded by unofficial uuencode format. This function uses external uuencode encoder which is specified by variable `uuencode-external-encoder'." (interactive "*fInsert encoded file: ") (call-process (car uuencode-external-encoder) filename t nil (file-name-nondirectory filename))) (mel-define-method mime-write-decoded-region (start end filename (nil "x-uue")) "Decode and write current region encoded by uuencode into FILENAME. START and END are buffer positions." (interactive "*r\nFWrite decoded region to file: ") (save-excursion (let ((clone-buf (clone-buffer " *x-uue*")) (file (make-temp-file "x-uue"))) (save-excursion (save-restriction (set-buffer clone-buf) (narrow-to-region start end) (setq buffer-read-only nil) (goto-char start) (when (and (re-search-forward "^begin [0-9]+ " nil t) (looking-at ".+$")) (replace-match file) (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (apply (function call-process-region) (point-min) (point-max) (car uuencode-external-decoder) nil nil nil (cdr uuencode-external-decoder)) (rename-file file filename 'overwrites) (message (concat "Wrote " filename)))))) (kill-buffer clone-buf)))) ;;; @ end ;;; (provide 'mel-u) (mel-define-backend "x-uuencode" ("x-uue")) ;;; mel-u.el ends here. wanderlust-flim-2cf5a78/mel.el000066400000000000000000000323031436773573300163720ustar00rootroot00000000000000;;; mel.el --- A MIME encoding/decoding library. -*- lexical-binding: t -*- ;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Created: 1995/6/25 ;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64 ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mime-def) (require 'alist) (require 'pces) (defcustom mime-encoding-list '("7bit" "8bit" "binary" "base64" "quoted-printable") "List of Content-Transfer-Encoding. Each encoding must be string." :group 'mime :type '(repeat string)) (defun mime-encoding-list (&optional service) "Return list of Content-Transfer-Encoding. If SERVICE is specified, it returns available list of Content-Transfer-Encoding for it." (if service (let (dest) (mapatoms (lambda (sym) (or (eq sym nil) (setq dest (cons (symbol-name sym) dest)))) (symbol-value (intern (format "%s-obarray" service)))) (let ((rest mel-encoding-module-alist) pair) (while (setq pair (car rest)) (let ((key (car pair))) (or (member key dest) (<= (length key) 1) (setq dest (cons key dest)))) (setq rest (cdr rest)))) dest) mime-encoding-list)) (defun mime-encoding-alist (&optional service) "Return table of Content-Transfer-Encoding for completion." (mapcar #'list (mime-encoding-list service))) (defsubst mel-use-module (name encodings) (while encodings (set-alist 'mel-encoding-module-alist (car encodings) (cons name (cdr (assoc (car encodings) mel-encoding-module-alist)))) (setq encodings (cdr encodings)))) (defsubst mel-find-function (service encoding) (mel-find-function-from-obarray (symbol-value (intern (format "%s-obarray" service))) encoding)) (defun mel-prompt-for-encoding (&optional service) (completing-read "Encoding: (default base64) " (mime-encoding-alist service) nil t nil nil "base64")) ;;; @ setting for modules ;;; (defun 8bit-insert-encoded-file (filename) "Insert file FILENAME encoded by \"7bit\" format." (let ((coding-system-for-read 'raw-text) format-alist) ;; Returns list of absolute file name and length of data inserted. (insert-file-contents filename))) (defun 8bit-write-decoded-region (start end filename) "Decode and write current region encoded by \"8bit\" into FILENAME." (let ((coding-system-for-write 'no-conversion) format-alist) (write-region start end filename))) (mel-define-backend "8bit") (mel-define-method-function (mime-encode-string string (nil "8bit")) 'identity) (mel-define-method-function (mime-decode-string string (nil "8bit")) 'identity) (mel-define-method mime-encode-region (_start _end (nil "8bit"))) (mel-define-method mime-decode-region (_start _end (nil "8bit"))) (mel-define-method-function (mime-insert-encoded-file filename (nil "8bit")) '8bit-insert-encoded-file) (mel-define-method-function (mime-write-decoded-region start end filename (nil "8bit")) '8bit-write-decoded-region) (defalias '7bit-insert-encoded-file '8bit-insert-encoded-file) (defalias '7bit-write-decoded-region '8bit-write-decoded-region) (mel-define-backend "7bit" ("8bit")) (defun binary-write-decoded-region (start end filename) "Decode and write current region encoded by \"binary\" into FILENAME." (defvar jam-zcat-filename-list) (let ((coding-system-for-write 'binary) jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end filename))) (defalias 'binary-insert-encoded-file 'insert-file-contents-literally) (defun binary-find-file-noselect (filename &optional nowarn rawfile) "Like `find-file-noselect', q.v., but don't code and format conversion." (let ((coding-system-for-read 'binary) format-alist) (find-file-noselect filename nowarn rawfile))) (defun binary-funcall (name &rest args) "Like `funcall', q.v., but read and write as binary." (let ((coding-system-for-read 'binary) (coding-system-for-write 'binary)) (apply name args))) (defun binary-to-text-funcall (coding-system name &rest args) "Like `funcall', q.v., but write as binary and read as text. Read text is decoded as CODING-SYSTEM." (let ((coding-system-for-read coding-system) (coding-system-for-write 'binary)) (apply name args))) (mel-define-backend "binary") (mel-define-method-function (mime-encode-string string (nil "binary")) 'identity) (mel-define-method-function (mime-decode-string string (nil "binary")) 'identity) (mel-define-method mime-encode-region (_start _end (nil "binary"))) (mel-define-method mime-decode-region (_start _end (nil "binary"))) (mel-define-method-function (mime-insert-encoded-file filename (nil "binary")) 'binary-insert-encoded-file) (mel-define-method-function (mime-write-decoded-region start end filename (nil "binary")) 'binary-write-decoded-region) (defvar mel-b-builtin t) (defcustom mel-b-builtin-garbage-strategy 'asis "When non-nil, base64 decoder functions handle non-encoded garbage. When value is asis decoders keep garbage and when value is discard decoders delete garbage." :group 'mime :type '(choice (const :tag "Keep as is" asis) (const :tag "Discard" discard) (const :tag "Not handled" nil))) (defvar mel-b-builtin-encoded-line-regexp "^[A-Za-z0-9+/]+=*[\t ]*\r?\n?") (mel-define-backend "base64") (mel-define-method-function (mime-encode-string string (nil "base64")) 'base64-encode-string) (defun mel-b-builtin-decode-string (string) "Decode base64 encoded STRING with garbage handling. Garbage handling strategy is decided by `mel-b-builtin-garbage-strategy'. Return decoded string." (if (null mel-b-builtin-garbage-strategy) (base64-decode-string string) (condition-case error (base64-decode-string string) (error (if (string-match mel-b-builtin-encoded-line-regexp string) (let ((start (match-beginning 0)) end) (message "Base64 encoded string has garbage") (while (and (< (setq end (match-end 0)) (length string)) (eq end (and (string-match mel-b-builtin-encoded-line-regexp string end) (match-beginning 0))))) (if (eq mel-b-builtin-garbage-strategy 'discard) (base64-decode-string (substring string start end)) (concat (substring string 0 start) (base64-decode-string (substring string start end)) (substring string end)))) (signal (car error) (cdr error))))))) (mel-define-method-function (mime-decode-string string (nil "base64")) 'mel-b-builtin-decode-string) (mel-define-method-function (mime-encode-region start end (nil "base64")) 'base64-encode-region) (defun mel-b-builtin-decode-region (start end) "Decode base64 encoded region between START and END with garbage handling. Garbage handling strategy is decided by `mel-b-builtin-garbage-strategy'." (if (null mel-b-builtin-garbage-strategy) (base64-decode-region start end) (condition-case error (base64-decode-region start end) (error (save-excursion (let ((start (min start end)) (end (max start end)) base64-start) (goto-char start) (if (re-search-forward mel-b-builtin-encoded-line-regexp end t) (progn (message "Base64 encoded region contains garbage") (setq base64-start (match-beginning 0)) (while (eq (point) (and (re-search-forward mel-b-builtin-encoded-line-regexp end t) (match-beginning 0)))) (when (eq mel-b-builtin-garbage-strategy 'discard) (delete-region (match-end 0) end)) (base64-decode-region base64-start (point)) (when (eq mel-b-builtin-garbage-strategy 'discard) (delete-region start base64-start))) (signal (car error) (cdr error))))))))) (mel-define-method-function (mime-decode-region start end (nil "base64")) 'mel-b-builtin-decode-region) (mel-define-method mime-insert-encoded-file (filename (nil "base64")) "Encode contents of file FILENAME to base64, and insert the result." (interactive "*fInsert encoded file: ") ;; No need to make buffer unibyte if binary-insert-encoded-file only ;; inserts single-byte characters. (save-restriction (narrow-to-region (point) (point)) (binary-insert-encoded-file filename) (base64-encode-region (point-min) (point-max)) (goto-char (point-max))) (or (bolp) (insert ?\n))) (mel-define-method mime-write-decoded-region (start end filename (nil "base64")) "Decode the region from START to END and write out to FILENAME." (interactive "*r\nFWrite decoded region to file: ") (let ((buffer (current-buffer))) (with-temp-buffer (insert-buffer-substring buffer start end) (mel-b-builtin-decode-region (point-min) (point-max)) (write-region-as-binary (point-min) (point-max) filename)))) ;; (mel-define-method-function (encoded-text-encode-string string (nil "B")) ;; 'base64-encode-string) (mel-define-method encoded-text-decode-string (string (nil "B")) (if (string-match (eval-when-compile (concat "\\`" B-encoded-text-regexp "\\'")) string) (base64-decode-string string) (error "Invalid encoded-text %s" string))) (mel-use-module 'mel-q '("quoted-printable" "Q")) (mel-use-module 'mel-g '("x-gzip64")) (mel-use-module 'mel-u '("x-uue" "x-uuencode")) (declare-function module-installed-p "path-util" (module &optional paths)) (defvar mel-q-ccl-module (progn (require 'path-util) (module-installed-p 'mel-q-ccl))) (when mel-q-ccl-module (mel-use-module 'mel-q-ccl '("quoted-printable" "Q"))) ;;; @ region ;;; ;;;###autoload (defun mime-encode-region (start end encoding) "Encode region START to END of current buffer using ENCODING. ENCODING must be string." (interactive (list (region-beginning)(region-end) (mel-prompt-for-encoding))) (funcall (mel-find-function 'mime-encode-region encoding) start end)) ;;;###autoload (defun mime-decode-region (start end encoding) "Decode region START to END of current buffer using ENCODING. ENCODING must be string." (interactive (list (region-beginning)(region-end) (mel-prompt-for-encoding 'mime-decode-region))) (funcall (mel-find-function 'mime-decode-region encoding) start end)) ;;; @ string ;;; ;;;###autoload (defun mime-decode-string (string encoding) "Decode STRING using ENCODING. ENCODING must be string. If ENCODING is found in `mime-string-decoding-method-alist' as its key, this function decodes the STRING by its value." (let ((f (mel-find-function 'mime-decode-string encoding))) (if f (funcall f string) string))) (mel-define-service encoded-text-encode-string) (defun encoded-text-encode-string (string encoding &optional mode) "Encode STRING as encoded-text using ENCODING. ENCODING must be string. Optional argument MODE allows `text', `comment', `phrase' or nil. Default value is `phrase'." (if (string= encoding "B") (base64-encode-string string 'no-line-break) (let ((f (mel-find-function 'encoded-text-encode-string encoding))) (if f (funcall f string mode) string)))) (mel-define-service encoded-text-decode-string (string encoding) "Decode STRING as encoded-text using ENCODING. ENCODING must be string.") (defun base64-encoded-length (string) (* (/ (+ (length string) 2) 3) 4)) (defsubst Q-encoding-printable-char-p (chr mode) (and (not (memq chr '(?= ?? ?_))) (<= ?\ chr)(<= chr ?~) (cond ((eq mode 'text) t) ((eq mode 'comment) (not (memq chr '(?\( ?\) ?\\)))) (t (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr)))))) (defun Q-encoded-text-length (string &optional mode) (let ((l 0)(i 0)(len (length string)) chr) (while (< i len) (setq chr (aref string i)) (if (or (Q-encoding-printable-char-p chr mode) (eq chr ?\s)) (setq l (+ l 1)) (setq l (+ l 3))) (setq i (+ i 1))) l)) ;;; @ file ;;; ;;;###autoload (defun mime-insert-encoded-file (filename encoding) "Insert file FILENAME encoded by ENCODING format." (interactive (list (read-file-name "Insert encoded file: ") (mel-prompt-for-encoding))) (funcall (mel-find-function 'mime-insert-encoded-file encoding) filename)) ;;;###autoload (defun mime-write-decoded-region (start end filename encoding) "Decode and write current region encoded by ENCODING into FILENAME. START and END are buffer positions." (interactive (list (region-beginning)(region-end) (read-file-name "Write decoded region to file: ") (mel-prompt-for-encoding 'mime-write-decoded-region))) (funcall (mel-find-function 'mime-write-decoded-region encoding) start end filename)) ;;; @ end ;;; (provide 'mel) ;;; mel.el ends here. wanderlust-flim-2cf5a78/mime-conf.el000066400000000000000000000152501436773573300174710ustar00rootroot00000000000000;;; mime-conf.el --- mailcap parser and MIME playback configuration -*- lexical-binding: t -*- ;; Copyright (C) 1997,1998,1999,2000,2004 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Created: 1997-06-27 ;; Original: 1997-06-27 mailcap.el by MORIOKA Tomohiko ;; Renamed: 2000-11-24 to mime-conf.el by MORIOKA Tomohiko ;; Keywords: mailcap, setting, configuration, MIME, multimedia ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mime-def) ;;; @ comment ;;; (defsubst mime-mailcap-skip-comment () (let ((chr (following-char))) (when (and chr (or (= chr ?\n) (= chr ?#))) (forward-line) t))) ;;; @ token ;;; (defsubst mime-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 mime-mailcap-look-at-type-field () (let ((type (mime-mailcap-look-at-token))) (if type (if (eq (following-char) ?/) (progn (forward-char) (let ((subtype (mime-mailcap-look-at-token))) (if subtype (cons (cons 'type (intern type)) (unless (string= subtype "*") (list (cons 'subtype (intern subtype)))))))) (list (cons 'type (intern type))))))) ;;; @ field separator ;;; (defsubst mime-mailcap-skip-field-separator () (let ((ret (looking-at "\\([ \t]\\|\\\\\n\\)*;\\([ \t]\\|\\\\\n\\)*"))) (when ret (goto-char (match-end 0)) t))) ;;; @ mtext ;;; (defsubst mime-mailcap-look-at-schar () (let ((chr (following-char))) (if (and chr (>= chr ?\s) (/= chr ?\;) (/= chr ?\\)) (prog1 chr (forward-char))))) (defsubst mime-mailcap-look-at-qchar () (when (eq (following-char) ?\\) (prog2 (forward-char) (following-char) (forward-char)))) (defsubst mime-mailcap-look-at-mtext () (let ((beg (point))) (while (or (mime-mailcap-look-at-qchar) (mime-mailcap-look-at-schar))) (buffer-substring beg (point)))) ;;; @ field ;;; (defsubst mime-mailcap-look-at-field () (let ((token (mime-mailcap-look-at-token))) (if token (if (looking-at "[ \t]*=[ \t]*") (let ((value (progn (goto-char (match-end 0)) (mime-mailcap-look-at-mtext)))) (if value (cons (intern token) value))) (list (intern token)))))) ;;; @ mailcap entry ;;; (defun mime-mailcap-look-at-entry () (let ((type (mime-mailcap-look-at-type-field))) (if (and type (mime-mailcap-skip-field-separator)) (let ((view (mime-mailcap-look-at-mtext)) fields field) (when view (while (and (mime-mailcap-skip-field-separator) (setq field (mime-mailcap-look-at-field))) (setq fields (cons field fields))) (nconc type (list (cons 'view view)) fields)))))) ;;; @ main ;;; ;;;###autoload (defun mime-parse-mailcap-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 (mime-mailcap-skip-comment)) (setq entry (mime-mailcap-look-at-entry))) (setq entries (cons entry entries)) (forward-line)) (cond ((functionp order) (sort entries order)) ((null order) (nreverse entries)) (t entries))))) ;;;###autoload (defvar mime-mailcap-file "~/.mailcap" "*File name of user's mailcap file.") ;;;###autoload (defun mime-parse-mailcap-file (&optional filename order) "Parse FILENAME 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." (or filename (setq filename mime-mailcap-file)) (with-temp-buffer (insert-file-contents filename) (mime-parse-mailcap-buffer (current-buffer) order))) ;;;###autoload (defun mime-format-mailcap-command (mtext situation) "Return formated command string from MTEXT and SITUATION. MTEXT is a command text of mailcap specification, such as view-command. SITUATION is an association-list about information of entity. Its key may be: \\='type primary media-type \\='subtype media-subtype \\='filename filename STRING parameter of Content-Type field" (let ((i 0) (len (length mtext)) (p 0) dest) (while (< i len) (let ((chr (aref mtext i))) (cond ((eq chr ?%) (setq i (1+ i) chr (aref mtext i)) (cond ((eq chr ?s) (let ((file (cdr (assq 'filename situation)))) (if file (setq file (shell-quote-argument file)) (error "'filename is not specified in situation.")) (setq dest (concat dest (substring mtext p (1- i)) ;; if the situation (wrongly) quotes ;; the argument, fix it. (if (eq ?' (aref mtext (- i 2))) (concat "'" file "'") file)) i (1+ i) p i))) ((eq chr ?t) (let ((type (or (mime-type/subtype-string (cdr (assq 'type situation)) (cdr (assq 'subtype situation))) "text/plain"))) (setq dest (concat dest (substring mtext p (1- i)) type) i (1+ i) p i))) ((eq chr ?\{) (setq i (1+ i)) (unless (string-match "}" mtext i) (error "parse error!!!")) (let* ((me (match-end 0)) (attribute (substring mtext i (1- me))) (parameter (cdr (assoc attribute situation)))) (unless parameter (error "\"%s\" is not specified in situation." attribute)) (setq dest (concat dest (substring mtext p (- i 2)) parameter) i me p i))) (t (error "Invalid sequence `%%%c'." chr)))) ((eq chr ?\\) (setq dest (concat dest (substring mtext p i)) p (1+ i) i (+ i 2))) (t (setq i (1+ i)))))) (concat dest (substring mtext p)))) ;;; @ end ;;; (provide 'mime-conf) ;;; mime-conf.el ends here wanderlust-flim-2cf5a78/mime-def.el000066400000000000000000000275461436773573300173150ustar00rootroot00000000000000;;; mime-def.el --- definition module about MIME -*- lexical-binding: t -*- ;; Copyright (C) 1995,96,97,98,99,2000,2001,2002,2003,2004,2005,2006 ;; Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Keywords: definition, MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'custom) (require 'mcharset) (require 'alist) (eval-when-compile (require 'luna)) ; luna-arglist-to-arguments (eval-and-compile (defconst mime-library-product ["FLIM-LB" (1 14 9) "Gojō"] "Product name, version number and code name of MIME-library package.")) (defmacro mime-product-name (product) `(aref ,product 0)) (defmacro mime-product-version (product) `(aref ,product 1)) (defmacro mime-product-code-name (product) `(aref ,product 2)) (defconst mime-library-version (eval-when-compile (concat (mime-product-name mime-library-product) " " (mapconcat #'number-to-string (mime-product-version mime-library-product) ".") " - \"" (mime-product-code-name mime-library-product) "\""))) ;;; @ variables ;;; (defgroup mime '((default-mime-charset custom-variable)) "Emacs MIME Interfaces" :group 'news :group 'mail) (defcustom mime-uuencode-encoding-name-list '("x-uue" "x-uuencode") "*List of encoding names for uuencode format." :group 'mime :type '(repeat string)) ;;; @@ for encoded-word ;;; (defgroup mime-header nil "Header representation, specially encoded-word" :group 'mime) ;;; @@@ decoding ;;; (defcustom mime-field-decoding-max-size 1000 "*Max size to decode header field." :group 'mime-header :type '(choice (integer :tag "Limit (bytes)") (const :tag "Don't limit" nil))) (defcustom mime-header-accept-quoted-encoded-words nil "*Accept encoded-words in quoted-strings." :group 'mime-header :type 'boolean) ;;; @@@ encoding ;;; (defcustom mime-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." :group 'mime-header :type '(repeat (cons (choice :tag "Field" (string :tag "Name") (const :tag "Default" t)) (choice :tag "Method" (const :tag "MIME conversion" mime) (symbol :tag "non-MIME conversion") (const :tag "no-conversion" nil))))) ;;; @ required functions ;;; (defsubst regexp-* (regexp) (concat regexp "*")) (defsubst regexp-or (&rest args) (concat "\\(" (mapconcat (function identity) args "\\|") "\\)")) ;;; @ MIME constants ;;; (defconst mime-tspecial-char-list '(?\] ?\[ ?\( ?\) ?< ?> ?@ ?, ?\; ?: ?\\ ?\" ?/ ?? ?=)) (defconst mime-token-regexp (concat "[^" mime-tspecial-char-list "\000-\040]+")) (defconst mime-attribute-char-regexp (concat "[^" mime-tspecial-char-list "*'%" ; introduced in RFC 2231. "\000-\040" "]")) (defconst mime-non-attribute-char-regexp (concat "[" mime-tspecial-char-list "*'%" ; introduced in RFC 2231. "\000-\040\177-\377" ; non-printable, non-US-ASCII. "]")) (defconst mime-charset-regexp (concat "[^" mime-tspecial-char-list "\000-\040" "*'%" ; should not include "%"? "]+")) ;; More precisely, length of each "[A-Za-z]+" is limited to at most 8. ;; See RFC 3066 "Tags for the Identification of Languages". ;; (defconst mime-language-regexp "[A-Za-z]+\\(-[A-Za-z]+\\)*") (defconst mime-language-regexp "[-A-Za-z]+") (defconst mime-encoding-regexp mime-token-regexp) ;;; @@ base64 / B ;;; (defconst base64-token-regexp "[A-Za-z0-9+/]") (defconst base64-token-padding-regexp "[A-Za-z0-9+/=]") (defconst 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 / Q ;;; (defconst quoted-printable-hex-chars "0123456789ABCDEF") (defconst quoted-printable-octet-regexp (concat "=[" quoted-printable-hex-chars "][" quoted-printable-hex-chars "]")) (defconst Q-encoded-text-regexp (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+")) ;; (defconst eword-Q-encoding-and-encoded-text-regexp ;; (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp)) ;;; @ Content-Type ;;; (defsubst make-mime-content-type (type subtype &optional parameters) (cons (cons 'type type) (cons (cons 'subtype subtype) parameters))) (defsubst mime-content-type-primary-type (content-type) "Return primary-type of CONTENT-TYPE." (cdr (car content-type))) (defsubst mime-content-type-subtype (content-type) "Return subtype of CONTENT-TYPE." (cdr (car (cdr content-type)))) (defsubst mime-content-type-parameters (content-type) "Return parameters of CONTENT-TYPE." (cdr (cdr content-type))) (defsubst mime-content-type-parameter (content-type parameter) "Return PARAMETER value of CONTENT-TYPE." (cdr (assoc parameter (cdr (cdr content-type))))) (defsubst mime-type/subtype-string (type &optional subtype) "Return type/subtype string from TYPE and SUBTYPE." (if type (if subtype (format "%s/%s" type subtype) (format "%s" type)))) ;;; @ Content-Disposition ;;; (defsubst make-mime-content-disposition (type &optional parameters) (cons (cons 'type type) parameters)) (defsubst mime-content-disposition-type (content-disposition) "Return disposition-type of CONTENT-DISPOSITION." (cdr (car content-disposition))) (defsubst mime-content-disposition-parameters (content-disposition) "Return disposition-parameters of CONTENT-DISPOSITION." (cdr content-disposition)) (defsubst mime-content-disposition-parameter (content-disposition parameter) "Return PARAMETER value of CONTENT-DISPOSITION." (cdr (assoc parameter (cdr content-disposition)))) (defsubst mime-content-disposition-filename (content-disposition) "Return filename of CONTENT-DISPOSITION." (mime-content-disposition-parameter content-disposition "filename")) ;;; @ message structure ;;; (defvar mime-message-structure nil "Information about structure of message. Please use reference function `mime-entity-SLOT' to get value of SLOT. Following is a list of slots of the structure: node-id node-id (list of integers) content-type content-type (content-type) content-disposition content-disposition (content-disposition) encoding Content-Transfer-Encoding (string or nil) children entities included in this entity (list of entity) If an entity includes other entities in its body, such as multipart or message/rfc822, `mime-entity' structures of them are included in `children', so the `mime-entity' structure become a tree.") (make-variable-buffer-local 'mime-message-structure) (make-obsolete-variable 'mime-message-structure "should not use it." "26 May 1999") ;;; @ for mel-backend ;;; (defvar mel-service-list nil) (defmacro mel-define-service (name &optional args &rest rest) "Define NAME as a service for Content-Transfer-Encodings. If ARGS is specified, NAME is defined as a generic function for the service." `(progn (add-to-list 'mel-service-list ',name) (defvar ,(intern (format "%s-obarray" name)) (make-vector 7 0)) ,@(if args `((defun ,name ,args ,@rest (funcall (mel-find-function ',name ,(car (last args))) ,@(luna-arglist-to-arguments (butlast args)))))))) (put 'mel-define-service 'lisp-indent-function 'defun) (defvar mel-encoding-module-alist nil) (defsubst mel-find-function-from-obarray (ob-array encoding) (let* ((f (intern-soft encoding ob-array))) (or f (let ((rest (cdr (assoc encoding mel-encoding-module-alist)))) (while (and rest (progn (require (car rest)) (null (setq f (intern-soft encoding ob-array))))) (setq rest (cdr rest))) f)))) (defsubst mel-copy-method (service src-backend dst-backend) (let* ((oa (symbol-value (intern (format "%s-obarray" service)))) (f (mel-find-function-from-obarray oa src-backend)) sym) (when f (setq sym (intern dst-backend oa)) (or (fboundp sym) (fset sym (symbol-function f)))))) (defsubst mel-copy-backend (src-backend dst-backend) (let ((services mel-service-list)) (while services (mel-copy-method (car services) src-backend dst-backend) (setq services (cdr services))))) (defmacro mel-define-backend (type &optional parents) "Define TYPE as a mel-backend. If PARENTS is specified, TYPE inherits PARENTS. Each parent must be backend name (string)." (cons 'progn (mapcar (lambda (parent) `(mel-copy-backend ,parent ,type)) parents))) (defmacro mel-define-method (name args &rest body) "Define NAME as a method function of (nth 1 (car (last ARGS))) backend. ARGS is like an argument list of lambda, but (car (last ARGS)) must be specialized parameter. (car (car (last ARGS))) is name of variable and (nth 1 (car (last ARGS))) is name of backend (encoding)." (let* ((specializer (car (last args))) (class (nth 1 specializer))) `(progn (mel-define-service ,name) (fset (intern ,class ,(intern (format "%s-obarray" name))) (lambda ,(butlast args) ,@body))))) (put 'mel-define-method 'lisp-indent-function 'defun) (defmacro mel-define-method-function (spec function) "Set SPEC's function definition to FUNCTION. First element of SPEC is service. Rest of ARGS is like an argument list of lambda, but (car (last ARGS)) must be specialized parameter. (car (car (last ARGS))) is name of variable and (nth 1 (car (last ARGS))) is name of backend (encoding)." (let* ((name (car spec)) (args (cdr spec)) (specializer (car (last args))) (class (nth 1 specializer))) `(let (sym) (mel-define-service ,name) (setq sym (intern ,class ,(intern (format "%s-obarray" name)))) (or (fboundp sym) (fset sym (symbol-function ,function)))))) (defmacro mel-define-function (function spec) (let* ((name (car spec)) (args (cdr spec)) (specializer (car (last args))) (class (nth 1 specializer))) `(progn (define-function ,function (intern ,class ,(intern (format "%s-obarray" name))))))) (defvar base64-dl-module nil) (defsubst mime-charset-decode-string (string charset &optional lbt) "Decode the STRING as MIME CHARSET. Buffer's multibyteness is ignored." (let ((cs (mime-charset-to-coding-system charset lbt))) (if cs (decode-coding-string string cs) string))) (defsubst mime-charset-encode-string (string charset &optional lbt) "Encode the STRING as MIME CHARSET. Buffer's multibyteness is ignored." (let ((cs (mime-charset-to-coding-system charset lbt))) (if cs (encode-coding-string string cs) string))) ;;; @ end ;;; (provide 'mime-def) ;;; mime-def.el ends here wanderlust-flim-2cf5a78/mime-en.texi000066400000000000000000001306521436773573300175230ustar00rootroot00000000000000\input texinfo-ja @c -*-texinfo -*- coding: utf-8 -*- @c Generated automatically from mime-en.sgml by sinfo 3.7. @setfilename mime-en.info @settitle FLIM-LB 1.14 Reference Manual about MIME Features @documentencoding utf-8 @documentlanguage en @dircategory GNU Emacs Lisp @direntry * FLIM-LB (en): (mime-en). Internet message library. @end direntry @titlepage @title FLIM-LB 1.14 Reference Manual about MIME Features @author MORIOKA Tomohiko @author Kazuhiro Ito @subtitle 2020-09-17 @end titlepage @node Top, Introduction, (dir), (dir) @top FLIM-LB 1.14 Reference Manual about MIME Features @ifinfo This file documents MIME features of FLIM-LB, a fundamental library to process Internet Messages for GNU Emacsen. @end ifinfo @menu * Introduction:: What is FLIM-LB? * How to use:: How to use MIME features * Entity:: Message and Entity * Content-Type:: Information of Content-Type field * Content-Disposition:: Information of Content-Disposition field * Content-Transfer-Encoding:: Encoding Method * encoded-word:: Network representation of header * custom:: Various Customization * Appendix:: * Concept Index:: * Function Index:: * Variable Index:: @end menu @node Introduction, How to use, Top, Top @chapter What is FLIM-LB? FLIM is a library to provide basic features about message representation or encoding. FLIM-LB is a variant of FLIM, which features supports to latest Emacs. @node How to use, Entity, Introduction, Top @chapter How to use MIME features Please eval following to use MIME features provided by FLIM: @lisp (require 'mime) @end lisp @node Entity, Content-Type, How to use, Top @chapter Message and Entity @cindex mime-entity @cindex entity According to RFC 2045 (@ref{RFC 2045}), `The term ``entity'', refers specifically to the MIME-defined header fields and contents of either a message or one of the parts in the body of a multipart entity.' In this document, the term @strong{entity} indicates all of header fields and body.@refill The definition of RFC 2045 indicates that a MIME message is a tree, and each node of the tree is an entity. Namely MIME extends message to tree structure.@refill FLIM uses @strong{mime-entity} structure to represent information of entity. In this document, it is called simply `mime-entity'. @menu * Entity creation:: Functions to create mime-entity * Entity hierarchy:: Features about message tree * Entity Search:: Find Entity * Entity Attributes:: Functions about attributes of mime-entity * Entity-header:: Information of entity header * entity formatting:: Text presentation of entity * Entity-content:: Contents of Entity * Entity-network-representation:: Network representation of Entity * Entity buffer:: Entity as buffer representation * mm-backend:: Entity representations and implementations @end menu @node Entity creation, Entity hierarchy, Entity, Entity @section Functions to create mime-entity @defun mime-open-entity &optional type location Open an entity and return it.@refill @var{type} is representation-type. (cf. @ref{mm-backend}) @refill @var{location} is location of entity. Specification of it is depended on representation-type. @end defun @defun mime-parse-buffer &optional buffer type Parse @var{buffer} as message, and set the result to buffer local variable @code{mime-message-structure} of @var{buffer} as mime-entity.@refill If @var{buffer} is omitted, current buffer is used.@refill @var{type} is representation-type of created mime-entity. (cf. @ref{mm-backend}) Default value is @var{buffer}. @end defun @node Entity hierarchy, Entity Search, Entity creation, Entity @section Features about message tree @cindex node-id @cindex entity-number @cindex message @cindex root-entity Structure of a MIME message is tree.@refill In the tree, root node is the entity indicates all of the message. In this document, it is called @strong{root-entity} or @strong{message}. In FLIM, it is indicated by buffer local variable @code{mime-message-structure}.@refill Each entity except root-entity has a parent. An entity may have children. We can indicate an entity by relative position from a base entity, based on the parent-child relationship.@refill In addition, we can indicate an entity by absolute position of the message.@refill Each entity, which is a node of the tree, can be numbered by depth and left-to-right order of the depth. @example +-------+ | nil | +---+---+ +-------------------+-------------------+ +-+-+ +-+-+ +-+-+ | 0 | | 1 | | 2 | +-+-+ +-+-+ +-+-+ | +---------+---------+ | +--+--+ +--+--+ +--+--+ +--+--+ +--+--+ | 0.0 | | 1.0 | | 1.1 | | 1.2 | | 2.0 | +-----+ +-----+ +-----+ +-----+ +-----+ @end example Namely, if depth of a node is n, the node has a node-number, which is consists of n integers. In this document, it is called @strong{entity-number}. An entity-number is represented by list of integer, like @code{(1 2 3)}.@refill mime-entity has also @strong{node-id}. A node-id is represented by reversed list of entity-number. For example, node-id corresponding with 1.2.3 is @code{(3 2 1)}.@refill Each entity can be indicated by entity-number or node-id in @code{mime-message-structure}. @defvar mime-message-structure Buffer local variable to store mime-entity structure of message. @end defvar @defun mime-entity-children entity Return list of entities included in the @var{entity}. @end defun @defun mime-entity-parent entity &optional message Return parent entity of the @var{entity}.@refill If @var{message} is specified, it is regarded as root instead of @code{mime-message-structure}. @end defun @defun mime-root-entity-p entity Return non-@code{nil} if @var{entity} is root entity (message). @end defun @defun mime-entity-node-id entity Return node-id of @var{entity}. @end defun @defun mime-entity-number entity Return entity-number of @var{entity}. @end defun @node Entity Search, Entity Attributes, Entity hierarchy, Entity @section Find Entity @defun mime-find-entity-from-number entity-number &optional message Return entity from @var{entity-number} in @var{message}.@refill If @var{message} is not specified, @code{mime-message-structure} is used. @end defun @defun mime-find-entity-from-node-id entity-node-id &optional message Return entity from @var{entity-node-id} in @var{message}.@refill If @var{message} is not specified, @code{mime-message-structure} is used. @end defun @defun mime-find-entity-from-content-id cid &optional message Return entity from @var{cid} in @var{message}.@refill If @var{message} is not specified, @code{mime-message-structure} is used. @end defun @node Entity Attributes, Entity-header, Entity Search, Entity @section Functions about attributes of mime-entity @defun mime-entity-content-type entity Return content-type of @var{entity}. (cf. @ref{mime-content-type}) @end defun @defun mime-entity-content-disposition entity Return content-disposition of @var{entity}. (cf. @ref{mime-content-disposition}) @end defun @defun mime-entity-filename entity Return file name of @var{entity}. @end defun @defun mime-entity-encoding entity &optional default-encoding Return content-transfer-encoding of @var{entity}. (cf. @ref{Content-Transfer-Encoding}) @refill If the @var{entity} does not have Content-Transfer-Encoding field, this function returns @var{default-encoding}. If it is nil, @code{"7bit"} is used as default value. @end defun @defun mime-entity-cooked-p entity Return non-nil if contents of @var{entity} has been already code-converted. @end defun @node Entity-header, entity formatting, Entity Attributes, Entity @section Information of entity header @defun mime-fetch-field field-name &optional entity Return field-body of @var{field-name} field in header of @var{entity}.@refill The results is network representation.@refill If @var{entity} is omitted, @code{mime-message-structure} is used as default value.@refill If @var{field-name} field is not found, this function returns @code{nil}. @end defun @defun mime-read-field field-name &optional entity Parse @var{field-name} field in header of @var{entity}, and return the result.@refill Format of result is depended on kind of field. For non-structured field, this function returns string. For structured field, it returns list corresponding with structure of the field.@refill Strings in the result will be converted to internal representation of Emacs.@refill If @var{entity} is omitted, @code{mime-message-structure} is used as default value.@refill If @var{field-name} field is not found, this function returns @code{nil}. @end defun @node entity formatting, Entity-content, Entity-header, Entity @section Text presentation of entity @defun mime-insert-header entity &optional invisible-fields visible-fields Insert before point a decoded contents of header of @var{entity}.@refill @var{invisible-fields} is list of regexps to match field-name to hide. @var{visible-fields} is list of regexps to match field-name to hide.@refill If a field-name is matched with some elements of @var{invisible-fields} and matched with none of @var{visible-fields}, this function don't insert the field.@refill Each encoded-word (@ref{encoded-word}) in the header is decoded. ``Raw non us-ascii characters'' are also decoded as @code{default-mime-charset}. @end defun @defun mime-insert-text-content entity Insert before point a contents of @var{entity} as text entity.@refill Contents of the @var{entity} are decoded as MIME charset (@ref{MIME charset}). If the @var{entity} does not have charset parameter of Content-Type field, @code{default-mime-charset} is used as default value. @end defun @defvar default-mime-charset Symbol to indicate default value of MIME charset (@ref{MIME charset}).@refill It is used when MIME charset is not specified.@refill It is originally variable of APEL. @end defvar @node Entity-content, Entity-network-representation, entity formatting, Entity @section Contents of Entity @defun mime-entity-content entity Return content of @var{entity} as byte sequence. @end defun @defun mime-insert-entity-content entity Insert content of @var{entity} at point. @end defun @defun mime-write-entity-content entity filename Write content of @var{entity} into @var{filename}. @end defun @node Entity-network-representation, Entity buffer, Entity-content, Entity @section Network representation of Entity @defun mime-insert-entity entity Insert header and body of @var{entity} at point. @end defun @defun mime-write-entity entity filename Write representation of @var{entity} into @var{filename}. @end defun @defun mime-write-entity-body entity filename Write body of @var{entity} into @var{filename}. @end defun @node Entity buffer, mm-backend, Entity-network-representation, Entity @section Entity as buffer representation @defun mime-entity-buffer entity Return buffer, which contains @var{entity}. @end defun @defun mime-entity-point-min entity Return the start point of @var{entity} in the buffer which contains @var{entity}. @end defun @defun mime-entity-point-max entity Return the end point of @var{entity} in the buffer which contains @var{entity}. @end defun @defun mime-entity-header-start entity Return the start point of header of @var{entity} in the buffer which contains @var{entity}. @end defun @defun mime-entity-header-end entity Return the end point of header of @var{entity} in the buffer which contains @var{entity}. @end defun @defun mime-entity-body-start entity Return the start point of body of @var{entity} in the buffer which contains @var{entity}. @end defun @defun mime-entity-body-end entity Return the end point of body of @var{entity} in the buffer which contains @var{entity}. @end defun @node mm-backend, , Entity buffer, Entity @section Entity representations and implementations @cindex mm-backend @cindex entity processing method @cindex representation-type Entity is an abstraction. It is designed to use various data representations for their purposes.@refill Each entity has @strong{representation-type}. It must be specified when an entity is created. (cf. @ref{Entity creation}) @refill Functions about entity are implemented by request processing to the entity. Each entity knows its representation-type. Each entity calls processing function corresponding with the representation-type. Such kind of function is called @strong{entity processing method}. A module, consists of them corresponding with a representation-type, is called @strong{mm-backend}.@refill Module name of each mm-backend consists of the prefix @code{mm} and its representation-type. The module is required automatically when its entity is created at first. @menu * Request for entity:: Message-passing for entity * mm-backend module:: Definition of mm-backend @end menu @node Request for entity, mm-backend module, mm-backend, mm-backend @subsection Message-passing for entity @defun mime-entity-send entity message &rest args Send @var{message} to @var{entity} with @var{args}, and return the result.@refill @var{args} is arguments of the @var{message}. @end defun @node mm-backend module, , Request for entity, mm-backend @subsection Definition of mm-backend @defmac mm-define-backend type &optional parents Define @var{type} as a mm-backend.@refill If @var{PARENTS} is specified, @var{type} inherits parents. Each parent must be representation-type.@refill Example:@refill @lisp (mm-define-backend chao (generic)) @end lisp @end defmac @defmac mm-define-method name args &rest body Define @var{name} as a method function of (nth 1 (car @var{args})) backend.@refill @var{args} is like an argument list of lambda, but (car @var{args}) must be specialized parameter. (car (car @var{args})) is name of variable and (nth 1 (car @var{args})) is name of backend (representation-type).@refill Example:@refill @lisp (mm-define-method entity-cooked-p ((entity chao)) nil) @end lisp @end defmac @node Content-Type, Content-Disposition, Entity, Top @chapter Information of Content-Type field @cindex mime-content-type @cindex Content-Type field @strong{Content-Type field} is a field to indicate kind of contents or data format, such as media-type (@ref{media-type}) and MIME charset. It is defined in RFC 2045 (@ref{RFC 2045}). @noindent @strong{[Memo]} @quotation Historically, Content-Type field was proposed in RFC 1049. In it, Content-Type did not distinguish type and subtype, and there are no mechanism to represent kind of character code like MIME charset. @end quotation FLIM provides parser for Content-Type field and structure @strong{mime-content-type} to store information of Content-Type field. @menu * Content-Type field:: Format of Content-Type field * mime-content-type:: mime-content-type structure * Content-Type parser:: Parser * Content-Type utility:: Utility functions @end menu @node Content-Type field, mime-content-type, Content-Type, Content-Type @section Format of Content-Type field @cindex parameter @cindex subtype @cindex type Format of Content-Type field is defined as follows: @quotation ``Content-Type'' ``:'' @strong{type} ``/'' @strong{subtype} *( ``;'' @strong{parameter} ) @end quotation For example: @quotation @example Content-Type: image/jpeg @end example @end quotation @quotation @example Content-Type: text/plain; charset=iso-2022-jp @end example @end quotation `type' and `subtype' indicate format of an entity. In this document, pair of them is called `media-type'. `image/jpeg' or `text/plain' is a media-type. @noindent @strong{[Memo]} @quotation If an entity does not have Content-Type field, it is regarded as following: @quotation @example Content-Type: text/plain; charset=us-ascii @end example @end quotation @noindent (cf. @ref{us-ascii}) @end quotation @node mime-content-type, Content-Type parser, Content-Type field, Content-Type @section mime-content-type structure @deffn{Structure} mime-content-type Structure to store information of a Content-Type field.@refill Applications should use reference functions @code{mime-content-type-SLOT} to refer information of the structure.@refill Slots of the structure are following: @table @var @item primary-type primary type of media-type (symbol). @item subtype subtype of media-type (symbol). @item parameters parameters of Content-Type field (association-list). @end table @end deffn @defun make-mime-content-type type subtype &optional parameters Constructor of content-type. @end defun @defun mime-content-type-parameter content-type parameter Return value of @var{parameter} of @var{content-type}. @end defun @node Content-Type parser, Content-Type utility, mime-content-type, Content-Type @section Parser @defun mime-parse-Content-Type string Parse @var{string} as a field-body of Content-Type field, and return the result as mime-content-type (@ref{mime-content-type}) structure. @end defun @defun mime-read-Content-Type Parse Content-Type field of the current buffer, and return the result as mime-content-type (@ref{mime-content-type}) structure.@refill Return @code{nil} if Content-Type field is not found. @end defun @node Content-Type utility, , Content-Type parser, Content-Type @section Utility functions @defun mime-type/subtype-string type &optional subtype Return type/subtype string from @var{type} and @var{subtype}. @end defun @node Content-Disposition, Content-Transfer-Encoding, Content-Type, Top @chapter Information of Content-Disposition field @cindex mime-content-disposition @cindex RFC 2183 @cindex Standards Track @cindex Content-Disposition field @strong{Content-Disposition field} is an optional field to specify presentation of an entity or attributes of an entity, such as file name. @noindent [RFC 2183] @quotation S. Dorner, K. Moore and R. Troost, ``Communicating Presentation Information in Internet Messages: The Content-Disposition Header'', August 1997, Standards Track. @end quotation FLIM provides parser for Content-Disposition field and structure @strong{mime-content-disposition} to store information of Content-Disposition field. @menu * mime-content-disposition:: mime-content-disposition structure * Content-Disposition parser:: Parser for Content-Disposition field @end menu @node mime-content-disposition, Content-Disposition parser, Content-Disposition, Content-Disposition @section mime-content-disposition structure @deffn{Structure} mime-content-disposition Structure to store information of a Content-Disposition field.@refill Applications should use reference functions @code{mime-content-disposition-SLOT} to refer information of the structure.@refill Slots of the structure are following: @table @var @item disposition-type disposition-type (symbol). @item parameters parameters of Content-Disposition field (association-list). @end table @end deffn @defun mime-content-disposition-parameter content-disposition parameter Return value of @var{parameter} of @var{content-disposition}. @end defun @defun mime-content-disposition-filename content-disposition Return filename of @var{content-disposition}. @end defun @node Content-Disposition parser, , mime-content-disposition, Content-Disposition @section Parser for Content-Disposition field @defun mime-parse-Content-Disposition string Parse @var{string} as field-body of Content-Disposition field, and return the result as mime-content-disposition (@ref{mime-content-disposition}) structure. @end defun @defun mime-read-Content-Disposition Parse Content-Disposition field of the current buffer, and return the result as mime-content-disposition (@ref{mime-content-disposition}) structure.@refill Return @code{nil} if Content-Disposition field is not found. @end defun @node Content-Transfer-Encoding, encoded-word, Content-Disposition, Top @chapter Encoding Method @cindex Content-Transfer-Encoding field @strong{Content-Transfer-Encoding field} is a header field to indicate body encoding of a entity.@refill FLIM provides parser functions for Content-Transfer-Encoding field. They represent information of Content-Transfer-Encoding field as string.@refill In addition, FLIM provides encoder/decoder functions by Content-Transfer-Encoding. @menu * Content-Transfer-Encoding parser:: Parser * encoder/decoder:: Encoder/decoder * Encoding information:: Other utilities * mel-backend:: How to write encoder/decoder module * generic function for mel-backend:: How to add encoding/decoding service @end menu @node Content-Transfer-Encoding parser, encoder/decoder, Content-Transfer-Encoding, Content-Transfer-Encoding @section Parser @defun mime-parse-Content-Transfer-Encoding string Parse @var{string} as a field-body of Content-Transfer-Encoding field, and return the result. @end defun @defun mime-read-Content-Transfer-Encoding &optional default-encoding Parse Content-Transfer-Encoding field of the current buffer, and return the result.@refill Return @var{default-encoding} if Content-Transfer-Encoding field is not found. If it is not specified, @code{nil} is used as the default value. @end defun @node encoder/decoder, Encoding information, Content-Transfer-Encoding parser, Content-Transfer-Encoding @section Encoder/decoder @defun mime-encode-region start end encoding Encode region @var{start} to @var{end} of current buffer using @var{encoding}. @end defun @defun mime-decode-region start end encoding Decode region @var{start} to @var{end} of current buffer using @var{encoding}. @end defun @defun mime-decode-string string encoding Decode @var{string} which is encoded in @var{encoding}, and return the result. @end defun @defun mime-insert-encoded-file filename encoding Insert file @var{FILENAME} encoded by @var{ENCODING} format. @end defun @defun mime-write-decoded-region start end filename encoding Decode and write current region encoded by @var{encoding} into @var{filename}.@refill @var{start} and @var{end} are buffer positions. @end defun @node Encoding information, mel-backend, encoder/decoder, Content-Transfer-Encoding @section Other utilities @defun mime-encoding-list &optional SERVICE Return list of Content-Transfer-Encoding.@refill If @var{service} is specified, it returns available list of Content-Transfer-Encoding for it. @end defun @defun mime-encoding-alist &optional SERVICE Return table of Content-Transfer-Encoding for completion.@refill If @var{service} is specified, it returns available list of Content-Transfer-Encoding for it. @end defun @node mel-backend, generic function for mel-backend, Encoding information, Content-Transfer-Encoding @section How to write encoder/decoder module @defmac mel-define-method name args &rest body Define @var{name} as a method function of (nth 1 (car (last @var{args}))) backend.@refill @var{args} is like an argument list of lambda, but (car (last @var{args})) must be specialized parameter. (car (car (last @var{args}))) is name of variable and (nth 1 (car (last @var{args}))) is name of backend (encoding).@refill Example:@refill @lisp (mel-define-method mime-write-decoded-region (start end filename (nil "base64")) "Decode and write current region encoded by base64 into FILENAME. START and END are buffer positions." (interactive (list (region-beginning) (region-end) (read-file-name "Write decoded region to file: "))) (let ((str (buffer-substring start end))) (with-temp-buffer (insert (decode-base64-string str)) (write-region-as-binary (point-min) (point-max) filename) ))) @end lisp @end defmac @defmac mel-define-method-function spec function Set @var{spec}'s function definition to @var{function}.@refill First element of @var{spec} is service.@refill Rest of @var{args} is like an argument list of lambda, but (car (last @var{args})) must be specialized parameter. (car (car (last @var{args}))) is name of variable and (nth 1 (car (last @var{args}))) is name of backend (encoding).@refill Example:@refill @lisp (mel-define-method-function (mime-encode-string string (nil "base64")) 'encode-base64-string) @end lisp @end defmac @node generic function for mel-backend, , mel-backend, Content-Transfer-Encoding @section How to add encoding/decoding service @defmac mel-define-service name &optional args doc-string Define @var{name} as a service for Content-Transfer-Encodings.@refill If @var{args} is specified, @var{name} is defined as a generic function for the service.@refill Example:@refill @lisp (mel-define-service encoded-text-encode-string (string encoding) "Encode STRING as encoded-text using ENCODING. ENCODING must be string.") @end lisp @end defmac @node encoded-word, custom, Content-Transfer-Encoding, Top @chapter Network representation of header @cindex RFC 2047 @cindex Standards Track @cindex encoded-word @cindex RFC 2047 @strong{RFC 2047} defines the @strong{encoded-word} which is a format to represent non-ASCII (@ref{ASCII}) characters in a header.@refill @noindent [RFC 2047] @quotation K. Moore, ``MIME (Multipurpose Internet Mail Extensions) Part Three: Message Header Extensions for Non-ASCII Text'', November 1996, Standards Track (obsolete RFC 1521,1522,1590). @end quotation The encoded-word is the only valid format to represent non-ASCII (@ref{ASCII}) characters in a header, but there are also invalid styles. Such kinds of evil messages represent non-ASCII (@ref{ASCII}) characters in headers without encoded-words (it is called "raw" non-ASCII (@ref{ASCII}) characters).@refill FLIM provides encoding/decoding features of both encoded-word and invalid "raw" non-ASCII (@ref{ASCII}) characters. @menu * Header encoder/decoder:: Header encoding/decoding @end menu @node Header encoder/decoder, , encoded-word, encoded-word @section Header encoding/decoding @defun eword-decode-header &optional code-conversion separator Decode MIME encoded-words in header fields.@refill If @var{code-conversion} is @code{nil}, only encoded-words are decoded. If @var{code-conversion} is a MIME charset (@ref{MIME charset}), non-ASCII bit patterns are decoded as the MIME charset. Otherwise non-ASCII bit patterns are decoded as the @code{default-mime-charset}. (cf. @ref{entity formatting}) @refill If @var{separator} is not @code{nil}, it is used as header separator. @end defun @defun eword-encode-header &optional code-conversion Encode header fields to network representation, such as MIME encoded-word.@refill Each field is encoded as corresponding method specified by variable @code{mime-field-encoding-method-alist}. @end defun @defvar mime-field-encoding-method-alist Association list to specify field encoding method. Each element looks like (FIELD . METHOD).@refill If METHOD is @code{mime}, the FIELD will be encoded into MIME format (encoded-word).@refill If METHOD is @code{nil}, the FIELD will not be encoded.@refill If METHOD is a MIME charset, the FIELD will be encoded as the charset when it must be convert into network-code.@refill Otherwise the FIELD will be encoded as variable @code{default-mime-charset} when it must be convert into network-code. @end defvar @node custom, Appendix, encoded-word, Top @chapter Various Customization @deffn{group} mime The group associated with functions related to MIME.@refill It belongs to @code{mail} and @code{news}. @end deffn @node Appendix, Concept Index, custom, Top @chapter Appendix @menu * Glossary:: * Bug report:: How to report bugs * GitHub:: GitHub based development * History:: History of FLIM @end menu @node Glossary, Bug report, Appendix, Appendix @section Glossary @menu * 7bit:: * 8bit:: * ASCII:: * Base64:: * binary:: * coded character set:: Coded character set, Character code * media-type:: * message:: * MIME:: * MIME charset:: * MTA:: * MUA:: * Quoted-Printable:: * RFC 822:: * RFC 1036:: * RFC 2045:: * RFC 2046:: * RFC 2048:: * RFC 2049:: * plain text:: * us-ascii:: @end menu @node 7bit, 8bit, Glossary, Glossary @subsection 7bit @cindex 7bit (textual) string @cindex 7bit data @cindex 7bit @strong{7bit} means any integer between 0 .. 127.@refill Any data represented by 7bit integers is called @strong{7bit data}.@refill Textual string consisted of Control characters between 0 .. 31 and 127, and space represented by 32, and graphic characters between 33 .. 236 are called @strong{7bit (textual) string}.@refill Conventional Internet MTA (@ref{MTA}) can translate 7bit data, so it is no need to translate by Quoted-Printable (@ref{Quoted-Printable}) or Base64 (@ref{Base64}) for 7bit data.@refill However if there are too long lines, it can not translate by 7bit MTA even if it is 7bit data. RFC 822 (@ref{RFC 822}) and RFC 2045 (@ref{RFC 2045}) require lines in 7bit data must be less than 998 bytes. So if a ``7bit data'' has a line more than 999 bytes, it is regarded as binary (@ref{binary}). For example, Postscript file should be encoded by Quoted-Printable. @node 8bit, ASCII, 7bit, Glossary @subsection 8bit @cindex 8bit (textual) string @cindex 8bit data @cindex 8bit @strong{8bit} means any integer between 0 .. 255.@refill Any data represented by 8bit integers is called @strong{8bit data}.@refill Textual string consisted of Control characters between 0 .. 31, 127, and 128 .. 159, and space represented by 32, and graphic characters between 33 .. 236 and 160 .. 255 are called @strong{8bit (textual) string}.@refill For example, iso-8859-1 or euc-kr are coded-character-set represented by 8bit textual string.@refill Traditional Internet MTA (@ref{MTA}) can translate only 7bit (@ref{7bit}) data, so if a 8bit data will be translated such MTA, it must be encoded by Quoted-Printable (@ref{Quoted-Printable}) or Base64 (@ref{Base64}).@refill However 8bit MTA are increasing today.@refill However if there are too long lines, it can not translate by 8bit MTA even if it is 8bit data. RFC 2045 (@ref{RFC 2045}) require lines in 8bit data must be less than 998 bytes. So if a ``8bit data'' has a line more than 999 bytes, it is regarded as binary (@ref{binary}), so it must be encoded by Base64 or Quoted-Printable. @node ASCII, Base64, 8bit, Glossary @subsection ASCII @cindex ANSI X3.4:1986 @cindex ASCII @cindex ASCII @strong{ASCII} is a 94-character set contains primary latin characters (A-Z, a-z), numbers and some characters. It is a standard of the United States of America. It is a variant of ISO 646. @noindent [ASCII] @quotation ``Coded Character Set -- 7-Bit American Standard Code for Information Interchange'', ANSI X3.4:1986. @end quotation @node Base64, binary, ASCII, Glossary @subsection Base64 @cindex pad @cindex Base64 @strong{Base64} is a transfer encoding method of MIME (@ref{MIME}) defined in RFC 2045 (@ref{RFC 2045}).@refill The encoding process represents 24-bit groups of input bits as output strings of 4 encoded characters. Encoded characters represent integer 0 .. 63 or @strong{pad}. Base64 data must be 4 * n bytes, so pad is used to adjust size.@refill These 65 characters are subset of all versions of ISO 646, including US-ASCII, and all versions of EBCDIC. So it is safe even if it is translated by non-Internet gateways. @node binary, coded character set, Base64, Glossary @subsection binary @cindex binary Any byte stream is called @strong{binary}.@refill It does not require structureof lines. It differs from from 8bit (@ref{8bit}).@refill In addition, if line structured data contain too long line (more than 998 bytes), it is regarded as binary. @node coded character set, media-type, binary, Glossary @subsection Coded character set, Character code A set of unambiguous rules that establishes a character set and the one-to-one relationship between the characters of the set and their bit combinations. @node media-type, message, coded character set, Glossary @subsection media-type @cindex x-token @cindex message @cindex multipart @cindex application @cindex video @cindex audio @cindex image @cindex text @cindex subtype @cindex type @cindex media-type @strong{media-type} specifies the nature of the data in the body of MIME (@ref{MIME}) entity (@ref{Entity}). It consists of @strong{type} and @strong{subtype}. It is defined in RFC 2046 (@ref{RFC 2046}).@refill Currently there are following standard primary-types: @itemize @bullet @item @strong{text} @item @strong{image} @item @strong{audio} @item @strong{video} @item @strong{application} @item @strong{multipart} @item @strong{message} @end itemize And there are various subtypes, for example, application/octet-stream, audio/basic, image/jpeg, multipart/mixed, text/plain, video/mpeg... @refill You can refer registered media types at MEDIA TYPES (ftp://ftp.isi.edu/in-notes/iana/assignments/media-types).@refill In addition, you can use private type or subtype using @strong{x-token}, which as the prefix `x-'. However you can not use them in public.@refill (cf. @ref{Content-Type field}) @node message, MIME, media-type, Glossary @subsection message In this document, it means mail defined in RFC 822 (@ref{RFC 822}) and news message defined in RFC 1036 (@ref{RFC 1036}). @node MIME, MIME charset, message, Glossary @subsection MIME @cindex Multipurpose Internet Mail Extensions MIME stands for @strong{Multipurpose Internet Mail Extensions}, it is an extension for RFC 822 (@ref{RFC 822}).@refill According to RFC 2045:@refill STD 11, RFC 822, defines a message representation protocol specifying considerable detail about US-ASCII message headers, and leaves the message content, or message body, as flat US-ASCII text. This set of documents, collectively called the Multipurpose Internet Mail Extensions, or MIME, redefines the format of messages to allow for @enumerate @item textual message bodies in character sets other than US-ASCII, @item an extensible set of different formats for non-textual message bodies, @item multi-part message bodies, and @item textual header information in character sets other than US-ASCII. @end enumerate It is defined in RFC 2045 (@ref{RFC 2045}), RFC 2046 (@ref{RFC 2046}), RFC 2047 (@ref{encoded-word}), RFC 2048 (@ref{RFC 2048}) and RFC 2049 (@ref{RFC 2049}). @node MIME charset, MTA, MIME, Glossary @subsection MIME charset Coded character set (@ref{coded character set}) used in Content-Type field (@ref{Content-Type field}) or charset parameter of encoded-word (@ref{encoded-word}).@refill It is defined in RFC 2045 (@ref{RFC 2045}).@refill iso-2022-jp or euc-kr are kinds of it. (In this document, MIME charsets are written by small letters to distinguish graphic character set. For example, ISO 8859-1 is a graphic character set, and iso-8859-1 is a MIME charset) @node MTA, MUA, MIME charset, Glossary @subsection MTA @cindex Message Transfer Agent @strong{Message Transfer Agent}. It means mail transfer programs (ex. sendmail) and news servers.@refill (cf. @ref{MUA}) @node MUA, Quoted-Printable, MTA, Glossary @subsection MUA @cindex Message User Agent @strong{Message User Agent}. It means mail readers and news readers.@refill (cf. @ref{MTA}) @node Quoted-Printable, RFC 822, MUA, Glossary @subsection Quoted-Printable @cindex Quoted-Printable @strong{Quoted-Printable} is a transfer encoding method of MIME (@ref{MIME}) defined in RFC 2045 (@ref{RFC 2045}).@refill If the data being encoded are mostly US-ASCII text, the encoded form of the data remains largely recognizable by humans.@refill (cf. @ref{Base64}) @node RFC 822, RFC 1036, Quoted-Printable, Glossary @subsection RFC 822 @cindex RFC 822 @cindex STD 11 @cindex Internet mail @cindex Internet message @cindex message header A RFC defines format of Internet mail message, mainly @strong{message header}. @noindent @strong{[Memo]} @quotation news message is based on RFC 822, so @strong{Internet message} may be more suitable than @strong{Internet mail} . @end quotation @noindent [RFC 822] @quotation D. Crocker, ``Standard for the Format of ARPA Internet Text Messages'', August 1982, STD 11. @end quotation @node RFC 1036, RFC 2045, RFC 822, Glossary @subsection RFC 1036 @cindex RFC 1036 @cindex USENET A RFC defines format of USENET message. It is a subset of RFC 822 (@ref{RFC 822}). It is not Internet standard, but a lot of netnews excepting Usenet uses it. @noindent [USENET: RFC 1036] @quotation M. Horton and R. Adams, ``Standard for Interchange of USENET Messages'', December 1987, (obsolete RFC 850). @end quotation @node RFC 2045, RFC 2046, RFC 1036, Glossary @subsection RFC 2045 @cindex RFC 2045 @cindex Standards Track @noindent [RFC 2045] @quotation N. Freed and N. Borenstein, ``Multipurpose Internet Mail Extensions (MIME) Part One: Format of Internet Message Bodies'', November 1996, Standards Track (obsolete RFC 1521, 1522, 1590). @end quotation @node RFC 2046, RFC 2048, RFC 2045, Glossary @subsection RFC 2046 @cindex RFC 2046 @cindex Standards Track @noindent [RFC 2046] @quotation N. Freed and N. Borenstein, ``Multipurpose Internet Mail Extensions (MIME) Part Two: Media Types'', November 1996, Standards Track (obsolete RFC 1521, 1522, 1590). @end quotation @node RFC 2048, RFC 2049, RFC 2046, Glossary @subsection RFC 2048 @cindex RFC 2048 @cindex Standards Track @noindent [RFC 2048] @quotation N. Freed, J. Klensin and J. Postel, ``Multipurpose Internet Mail Extensions (MIME) Part Four: Registration Procedures'', November 1996, Standards Track (obsolete RFC 1521, 1522, 1590). @end quotation @node RFC 2049, plain text, RFC 2048, Glossary @subsection RFC 2049 @cindex RFC 2049 @cindex Standards Track @noindent [RFC 2049] @quotation N. Freed and N. Borenstein, ``Multipurpose Internet Mail Extensions (MIME) Part Five: Conformance Criteria and Examples'', November 1996, Standards Track (obsolete RFC 1521, 1522, 1590). @end quotation @node plain text, us-ascii, RFC 2049, Glossary @subsection plain text A textual data represented by only coded character set (@ref{coded character set}). It does not have information about font or typesetting. @node us-ascii, , plain text, Glossary @subsection us-ascii @cindex ASCII @cindex us-ascii A MIME charset (@ref{MIME charset}) for primary Latin script mainly written by English or other languages.@refill It is a 7bit coded character set (@ref{coded character set}) based on ISO 2022, it contains only ASCII (@ref{ASCII}) and code extension is not allowed.@refill It is standard coded character set of Internet mail. If MIME charset is not specified, @strong{us-ascii} is used as default.@refill In addition, @strong{ASCII} of RFC 822 (@ref{RFC 822}) should be interpreted as us-ascii. @node Bug report, GitHub, Glossary, Appendix @section How to report bugs @cindex good bug report Topics related to FLIM-LB are discussed in following mailing lists. The latest version is also announced there. @display Wanderlust Mailing List @t{} @end display In this list Japanese is mainly used for discussion. We also have a list for discussion in English: @display Wanderlust List in English @t{} @end display (Messages posted to this list are also forwarded to the former one.) A guide can be obtained automatically by sending mail to @t{wl-ctl@@ml.gentei.org} (or to @t{wl-en-ctl@@ml.gentei.org} for the English one) with the body @example # guide @end example Please send bug reports or patches to one of those lists. You have to subscribe the mailing list to post a message. Notice that, we do not welcome bug reports about too old version. Bugs in old version might be fixed. So please try latest version at first.@refill You should write @strong{good bug report}. If you write only ``FLIM does not work'', we can not find such situations. At least, you should write name, type, variants and version of OS, emacs, APEL, FLIM, SEMI and MUA, and setting. In addition, if error occurs, to send backtrace is very important. (cf. @ref{Bugs,Reporting Bugs ,Reporting Bugs, emacs, GNU Emacs Manual}) @refill Bug may not appear only your environment, but also in a lot of environment (otherwise it might not bug). Therefor if you send mail to author directly, we must write a lot of mails. So please send mail to address for EMACS-MIME Mailing List instead of author. @node GitHub, History, Bug report, Appendix @section GitHub based development FLIM-LB's repository is published in GitHub. @example @uref{https://github.com/wanderlust/flim} @end example If you send a pull request, please embed unindented @file{ChangeLog} entries in commit message like Emacs's. See @cite{Commit messages} section of Emacs's CONTRIBUTE file @footnote{@uref{https://git.savannah.gnu.org/cgit/emacs.git/plain/CONTRIBUTE}}. If you send a bug report, please attach Backtrace with it. @footnote{@uref{http://www.jpl.org/elips/BUGS-ja.html} describes how to in Japanese.} @node History, , GitHub, Appendix @section History of FLIM FLIM の code の最古の部分は 榎並 嗣智 氏が書いた @file{mime.el} に起源し ます。この小さな program は Nemacs で動作する iso-2022-jp の B-encoding 専用の encoded-word の復号化プログラムでした。@refill その後、守岡 知彦 は @file{mime.el} を元に@file{tiny-mime.el} というプロ グラムを書きます。これは、Nemacs と Mule で動作する encoded-word の符号 化・復号化プログラムでした。@file{tiny-mime.el} は B-encoding だけでなく Q-encoding もsupport し、また、MULE で扱うことができるさまざまな MIME charset (@ref{MIME charset}) を同時に使うことができました。この時、 Nemacs と Mule の双方を support するために用いられたテクニックは後に emu package にまとめられます。@refill この頃、守岡 知彦 は @file{tiny-mime.el} をさまざまな MUA で使うための設 定集も配布していましたが、それらは後に@file{tiny-mime.el} とともに１つの package にまとめられ、tm という名前で配布されます。@refill 守岡 知彦 はやがて、MIME message を閲覧するためのプログラムである @file{tm-body.el} を書きます。これは、すぐに@file{tm-view.el} という名前 に変わりましたが、やがて、これが@file{tiny-mime.el} に代わって、tm の中 核となります。@refill @file{tm-view.el} は当然、Content-Transfer-Encoding を扱う必要があります。 この目的のために、MEL が整備されはじめました。Base64 に関しては @file{tiny-mime.el} の code が移され、また、新たにQuoted-Printable の code が追加されました。これらが@file{mel-b.el} と @file{mel-q.el} になり ました。@refill また、後に、守岡 知彦 によって uuencode 用の @file{mel-u.el} が追加され、 その後に、小林 修平 氏によって x-gzip64 用の@file{mel-g.el} が追加されま した。@refill tm では後に、守岡 知彦 によって @file{tiny-mime.el} の再実装が行われ、こ の過程で、STD 11 の parser が書かれました。これは、現在の @file{std11.el} に当たります。また、この過程で @file{tiny-mime.el} は復 号化を行う @file{tm-ew-d.el} と符号化を行う @file{tm-ew-e.el} に分けられ ました。この両者が現在の @file{eword-decode.el} と @file{eword-encode.el} の先祖に当たります。@refill 後に、守岡 知彦 らによって tm の全面書き換え作業が行われ、この過程で、tm は APEL, MEL, SEMI, EMH, RMAIL-MIME, Gnus-MIME などに分けられました。こ のうちの MEL が FLIM の直接の先祖に当たります。@refill 後に、APEL から @file{std11.el} が移され、また、@file{mailcap.el}, @file{eword-decode.el} および @file{eword-encode.el} が SEMI から移され、 package の名前が FLIM となります。@refill この直前から田中 哲 氏がより RFC に忠実な実装を書き始め、これは、現在、 FLIM の枝である ``FLIM-FLAM'' となっています。 @node Concept Index, Function Index, Appendix, Top @chapter Concept Index @printindex cp @node Function Index, Variable Index, Concept Index, Top @chapter Function Index @printindex fn @node Variable Index, , Function Index, Top @chapter Variable Index @printindex vr @bye wanderlust-flim-2cf5a78/mime-ja.texi000066400000000000000000001447251436773573300175210ustar00rootroot00000000000000\input texinfo-ja @c -*-texinfo -*- coding: utf-8 -*- @c Generated automatically from mime-ja.sgml by sinfo 3.7. @setfilename mime-ja.info @documentlanguage ja @documentencoding utf-8 @settitle FLIM-LB 1.14 MIME 機能説明書 @dircategory GNU Emacs Lisp @direntry * FLIM-LB (ja): (mime-ja). Internet message library. @end direntry @titlepage @title FLIM-LB 1.14 MIME 機能説明書 @author 守岡 知彦 @author 伊藤 和博 @subtitle 2020-09-17 @end titlepage @node Top, Introduction, (dir), (dir) @top FLIM-LB 1.14 MIME 機能説明書 @ifinfo This file documents MIME features of FLIM-LB, a fundamental library to process Internet Messages for GNU Emacsen.@refill GNU Emacsen 用の Internet Message 処理のための基礎 library である FLIM-LB の MIME 機能に関して説明します。 @end ifinfo @menu * Introduction:: FLIM-LB って何？ * How to use:: FLIM の MIME 機能の使い方 * Entity:: Message と Entity * Content-Type:: Content-Type 欄の情報 * Content-Disposition:: Content-Disposition 欄の情報 * Content-Transfer-Encoding:: 符号化法 * encoded-word:: Header の network 表現 * custom:: 一般設定 * Appendix:: 付録 * Concept Index:: 概念索引 * Function Index:: 関数索引 * Variable Index:: 変数索引 @end menu @node Introduction, How to use, Top, Top @chapter FLIM-LB って何？ FLIM は Internet Message の表現や符号化に関する基礎的な機能を提供する ための library です。 FLIM-LB は FLIM のバリアントの一つで、 最新バージョンの Emacs への対応などを特徴とします。 @node How to use, Entity, Introduction, Top @chapter FLIM の MIME 機能の使い方 FLIM の提供する MIME 機能を使うためには @lisp (require 'mime) @end lisp @noindent を評価してください。 @node Entity, Content-Type, How to use, Top @chapter Message と Entity @cindex mime-entity @cindex entity RFC 2045 (@ref{RFC 2045}) によれば、「Entity という語は、message, もしく は、multipart entity の body 中の１つの部分の、MIME で定義された header field と内容を指す」となっています。ここでは、MIME で定義された header field 以外の全ての header と body を指す語として @strong{entity}を用いる ことにします。@refill RFC 2045 の定義は、MIME message が entity を節とする木構造であることを示 しています。つまり、MIME は message を木構造に拡張した訳です。@refill FLIM は entity の情報を表現するために@strong{mime-entity} 構 造体を用います。以下では単に mime-entity と呼ぶことにします。 @menu * Entity creation:: Entity の生成 * Entity hierarchy:: Entity 階層 * Entity Search:: Entity の検索 * Entity Attributes:: Entity の属性 * Entity-header:: Entity header の情報 * entity formatting:: Entity の文字表現 * Entity-content:: Entity の内容 * Entity-network-representation:: Entity のネットワーク表現 * Entity buffer:: Entity の buffer による表現 * mm-backend:: Entity の表現と実現 @end menu @node Entity creation, Entity hierarchy, Entity, Entity @section Entity の生成 @defun mime-open-entity type location Entity を開いて、それを返します。@refill @var{type} は representation-type です。(cf. @ref{mm-backend}) @refill @var{location} は entity の位置です。指定方法は representation-type に依って変わります。 @end defun @defun mime-parse-buffer &optional buffer type @var{buffer} を message として構文解析し、その結果の mime-entity を @var{buffer} の@code{mime-message-structure} に格納する。@refill @var{buffer} が省略された場合、現在の buffer を構文解析する。@refill @var{type} が指定された場合、その値を生成される mime-entity の表象型とし て用いる。省略された場合は @var{buffer} となる。(cf. @ref{mm-backend}) @end defun @node Entity hierarchy, Entity Search, Entity creation, Entity @section Entity 階層 @cindex node-id @cindex entity-number @cindex message @cindex root-entity MIME message は entity を単位とする木構造になっています。@refill この木において根となる節は message 全体を表す entity です。ここでは、こ れを @strong{root-entity} もしくは@strong{message} と呼びます。@refill root-entity 以外の entity は親を持ちます。また、entity は子供を持つかも 知れません。この親子関係を考えることで entity の相対関係を扱うことができ ます。@refill 一方、entity の message における位置を考えることもできます。@refill entity はこの木における節となりますが、この木には深さと同じ深さの中の 順番に従って番号が付けることができます。即ち、 @example ┌───┐ │ nil │ └─┬─┘ ┌─────────┼─────────┐ ┌┴┐ ┌┴┐ ┌┴┐ │０│ │１│ │２│ └┬┘ └┬┘ └┬┘ │ ┌────┼────┐ │ ┌─┴─┐┌─┴─┐┌─┴─┐┌─┴─┐┌─┴─┐ │ ０.０││ １.０││ １.１││ １.２││ ２.０│ └───┘└───┘└───┘└───┘└───┘ @end example @noindent のように深さ n の節には長さ n の整数列の節番号が振れます。これ を @strong{entity-number} と呼びます。entity-number は S 式と しては @code{(1 2 3)} のような整数のリストとして表現されます。 mime-entity では、これと同様の @strong{node-id} を用います。node-id はちょ うど entity-number を逆にしたリストで、entity-number 1.2.3 に対応する node-id は @code{(3 2 1)} です。@refill 前述のように、MIME message は entity を単位とした木構造になっているので、 この根である message 全体も mime-entity で表現することができ、buffer local 変数 @code{mime-message-structure} に格納することにします。@refill @code{mime-message-structure} を起点に entity-number や node-id で示される entity を取り出すことができます。 @defvar mime-message-structure 現在の buffer における message 全体の mime-entity 構造体を格納するbuffer local 変数。 @end defvar @defun mime-entity-children entity @var{entity} に含まれる entity の list を返す。 @end defun @defun mime-entity-parent entity &optional message @var{entity} の親の entity を返す。@refill @var{message} が指定された場合、これを根と見倣す。 @end defun @defun mime-root-entity-p entity @var{entity} が根（即ち、message 全体）である場合に、非-@code{nil} を返 す。 @end defun @defun mime-entity-node-id entity @var{entity} の node-id を返す。 @end defun @defun mime-entity-number entity @var{entity} の entity-number を返す。 @end defun @node Entity Search, Entity Attributes, Entity hierarchy, Entity @section Entity の検索 @defun mime-find-entity-from-number entity-number &optional message @var{message} から、@var{enity-number} の entity を返します。@refill @var{message} が指定されていない場合は、 @code{mime-message-structrue} が使われます。 @end defun @defun mime-find-entity-from-node-id entity-node-id &optional message @var{message} から、@var{entity-node-id} の entity を返します。@refill @var{message} が指定されていない場合は、 @code{mime-message-structure} が使われます。 @end defun @defun mime-find-entity-from-content-id cid &optional message @var{message} から、@var{cid} の entity を返します。@refill @var{message} が指定されていない場合は、 @code{mime-message-structure} が使われます。 @end defun @node Entity Attributes, Entity-header, Entity Search, Entity @section Entity の属性 @defun mime-entity-content-type entity @var{entity} の content-type を返す。(cf. @ref{mime-content-type}) @end defun @defun mime-entity-content-disposition entity @var{entity} の content-disposition を返す。 (cf. @ref{mime-content-disposition}) @end defun @defun mime-entity-filename entity @var{entity} の file 名を返す。 @end defun @defun mime-entity-encoding entity &optional default-encoding @var{entity} の content-transfer-encoding を返す。 (cf. @ref{Content-Transfer-Encoding}) @refill もし、@var{entity} に Content-Transfer-Encoding 欄が存在しない場合は、 @var{default-encoding} を返す。これが指定されない場合は、@code{"7bit"} を用いる。 @end defun @defun mime-entity-cooked-p entity @var{entity} の内容が既にコード変換されている場合は nil で無い値 を返す。 @end defun @node Entity-header, entity formatting, Entity Attributes, Entity @section Entity header の情報 @defun mime-fetch-field field-name &optional entity @var{entity} の header 中の @var{field-name} 欄の body を返す。@refill 結果の文字列は network 表現のままである。@refill @var{entity} が省略された場合は、@code{mime-message-structure} の値を用 いる。@refill @var{field-name} 欄が存在しない場合は @code{nil} を返す。 @end defun @defun mime-read-field field-name &optional entity @var{entity} の header 中の @var{field-name} 欄を構文解析した結果を返す。 @refill 結果の形式は欄毎に異なる。非構造化欄の場合は文字列を返し、構造化欄の場合 はその形式に従った list を返す。@refill 結果中の文字列は Emacs の内部表現に変換される。@refill @var{entity} が省略された場合は、@code{mime-message-structure} の値を用 いる。@refill @var{field-name} 欄が存在しない場合は nil を返す。 @end defun @node entity formatting, Entity-content, Entity-header, Entity @section Entity の文字表現 @defun mime-insert-header entity &optional invisible-fields visible-fields 現在位置に @var{entity} の復号した header を挿入する。@refill @var{invisible-fields} と @var{visible-fields} は正規表現のlist で、それ ぞれ、表示したくない field 名と表示したい欄名を表現したものである。 @refill @var{invisible-fields} の要素のどれかに match し、かつ、 @var{visible-fields} の要素のどれにも match しない欄は表示されない。 @refill encoded-word (@ref{encoded-word}) は復号される。『生の非 us-ascii 文字』 は @code{default-mime-charset} として解釈される。 @end defun @defun mime-insert-text-content entity point の前に @var{entity} を text entity として挿入します。@refill @var{entity} の内容は @ref{MIME charset} として復号化され ます。@var{entity} の Content-Type field に charset paramter が無 いと、@code{default-mime-charset} が初期値として使われます。 @end defun @defvar default-mime-charset 適切な MIME charset (@ref{MIME charset}) が見つからなかった場合に用いら れるMIME charset.@refill 本来は APEL の変数である。 @end defvar @node Entity-content, Entity-network-representation, entity formatting, Entity @section Entity の内容 @defun mime-entity-content entity @var{entity} の内容の byte 列を返す。 @end defun @defun mime-insert-entity-content entity point の位置に @var{entity} の内容を挿入します。 @end defun @defun mime-write-entity-content entity filename @var{entity} の内容を @var{filename} に書き込みます。 @end defun @node Entity-network-representation, Entity buffer, Entity-content, Entity @section Entity のネットワーク表現 @defun mime-insert-entity entity @var{entity} の header と body を point のところに挿入します。 @end defun @defun mime-write-entity entity filename @var{entity} の表現を @var{filename} に書き込みます。 @end defun @defun mime-write-entity-body entity filename @var{entity} の body を @var{filename} に書き込みます。 @end defun @node Entity buffer, mm-backend, Entity-network-representation, Entity @section Entity の buffer による表現 @defun mime-entity-buffer entity @var{entity} が存在する buffer を返す。 @end defun @defun mime-entity-point-min entity @var{entity} が存在する buffer における、@var{entity} が占める領域の先頭 位置を返す。 @end defun @defun mime-entity-point-max entity @var{entity} が存在する buffer における、@var{entity} が占める領域の末尾 位置を返す。 @end defun @defun mime-entity-header-start entity @var{entity} が存在する buffer における、header が占める領域の先頭位置を 返す。 @end defun @defun mime-entity-header-end entity @var{entity} が存在する buffer における、header が占める領域の末尾位置を 返す。 @end defun @defun mime-entity-body-start entity @var{entity} が存在する buffer における、body が占める領域の先頭位置を返 す。 @end defun @defun mime-entity-body-end entity @var{entity} が存在する buffer における、body が占める領域の末尾位置を返 す。 @end defun @node mm-backend, , Entity buffer, Entity @section Entity の表現と実現 @cindex mm-backend @cindex entity 処理 method @cindex representation-type Entity は抽象化されたデータ表現で、実際のデータ表現としては用途に応じて さまざまなものが利用できるように設計されています。@refill ここで、entity がどういう種類の表現を行っているかを示すのが @strong{representation-type} で、entity を生成する時にはこれを指定します。 (cf. @ref{Entity creation}) @refill 前節までに述べて来た entity に対する処理は、entity に対してその処理を依 頼することによって実現されています。Entity は自分の representation-type を知っており、その representation-type に応じて実際の処理を行う関数を呼 び出します。このような関数を @strong{entity 処理method} と呼びます。また、 representation-type 毎にこのような関数をまとめたものを @strong{mm-backend} と呼びます。@refill mm-backend は representation-type の名前の先頭に @code{mm} という 接頭辞を付けた関数名からなる module で、その module 名は同様に representation-type の名前の先頭に @code{mm} を付けたものになって います。この module は representation-type の entity が最初に生成される 時に自動的に require されます。 @menu * Request for entity:: Entity への便り * mm-backend module:: mm-backend の作り方 @end menu @node Request for entity, mm-backend module, mm-backend, mm-backend @subsection Entity への便り @defun mime-entity-send entity message &rest args @var{entity} に @var{message} を送る。@refill @var{args} は @var{message} の引数である。 @end defun @node mm-backend module, , Request for entity, mm-backend @subsection mm-backend の作り方 @defmac mm-define-backend type &optional parents @var{type} を mm-backend として定義します。@refill @var{PARENTS} が指定されている場合は、@var{type} は prents を継承します。それぞれの parent は representation-type である必要があ ります。 例:@refill @lisp (mm-define-backend chao (generic)) @end lisp @end defmac @defmac mm-define-method name args &rest body @var{name} を (nth 1 (car @var{args})) backend の method 関 数として定義します。@refill @var{args} は lambda の引数リストのようなものですが、(car @var{args}) は指定された parameter である必要があります。(car (car @var{args})) は変数の名前で、(nth 1 (car @var{args})) は backend の名前 (representation-type) です。@refill 例:@refill @lisp (mm-define-method entity-cooked-p ((entity chao)) nil) @end lisp @end defmac @node Content-Type, Content-Disposition, Entity, Top @chapter Content-Type 欄の情報 @cindex mime-content-type @cindex Content-Type 欄 @strong{Content-Type 欄} は media-type (@ref{media-type}) や MIME charset といった entity (@ref{Entity}) の内容の種類や表現形式などを記述 するためのもので、RFC 2045 (@ref{RFC 2045}) で定義されています。 @noindent @strong{[Memo]} @quotation 歴史的には RFC 1049 で Content-Type 欄が提案されている。但し、MIME の media-type のような type と subtype の区別はなく、MIME charset のような 文字符号の種類を表現することもできない。 @end quotation FLIM は Content-Type 欄を構文解析する関数と Content-Type 欄の解析結果を 格納する構造体 @strong{mime-content-type} を提供します。 @menu * Content-Type field:: Content-Type 欄の形式 * mime-content-type:: mime-content-type 構造体 * Content-Type parser:: Content-Type 欄の解析器 * Content-Type utility:: Content-Type に関する有用な関数 @end menu @node Content-Type field, mime-content-type, Content-Type, Content-Type @section Content-Type 欄の形式 @cindex parameter @cindex subtype @cindex type Content-Type 欄の形式は以下のように定義されています： @quotation ``Content-Type'' ``:'' @strong{type} ``/'' @strong{subtype} *( ``;'' @strong{parameter} ) @end quotation 例えば、 @quotation @example Content-Type: image/jpeg @end example @end quotation @noindent や @quotation @example Content-Type: text/plain; charset=iso-2022-jp @end example @end quotation @noindent などのように用いられます。 ここで、`type' と `subtype' は entity の形式を示すもので、両者を総称し て、`media-type' と呼ぶことにします。上記の例における `image/jpeg' や `text/plain' は media-type の１つです。 @noindent @strong{[Memo]} @quotation Content-Type 欄のない entity は @quotation @example Content-Type: text/plain; charset=us-ascii @end example @end quotation @noindent として解釈される。(cf. @ref{us-ascii}) @end quotation @node mime-content-type, Content-Type parser, Content-Type field, Content-Type @section mime-content-type 構造体 @deffn{Structure} mime-content-type Content-Type 欄の情報を格納するための構造体。@refill この構造体を参照するには @code{mime-content-type-要素名} という名前の参 照関数を用いる。@refill この構造体の要素は以下の通りである： @table @var @item primary-type media-type の主型 (symbol). @item subtype media-type の副型 (symbol). @item parameters Content-Type 欄の parameter (連想 list). @end table @end deffn @defun make-mime-content-type type subtype &optional parameters content-type の生成子。 @end defun @defun mime-content-type-parameter content-type parameter @var{content-type} の @var{parameter} の値を返す。 @end defun @node Content-Type parser, Content-Type utility, mime-content-type, Content-Type @section Content-Type 欄の解析器 @defun mime-parse-Content-Type string @var{string} を content-type として解析した結果を返す。 @end defun @defun mime-read-Content-Type 現在の buffer の Content-Type 欄を読み取り、解析した結果を返す。@refill Content-Type 欄が存在しない場合は nil を返す。 @end defun @node Content-Type utility, , Content-Type parser, Content-Type @section Content-Type に関する有用な関数 @defun mime-type/subtype-string type &optional subtype @var{type} と @var{subtype} から type/subtype 形式の文字列を返す。 @end defun @node Content-Disposition, Content-Transfer-Encoding, Content-Type, Top @chapter Content-Disposition 欄の情報 @cindex mime-content-disposition @cindex RFC 2183 @cindex Standards Track @cindex Content-Disposition 欄 @strong{Content-Disposition 欄} は entity の表示や file 名など の属性になどに関する情報を記述するためのものです。 @noindent [RFC 2183] @quotation S. Dorner, K. Moore and R. Troost, ``Communicating Presentation Information in Internet Messages: The Content-Disposition Header'', August 1997, Standards Track. @end quotation FLIM は Content-Disposition 欄を構文解析する関数と Content-Disposition 欄の解析結果を格納する構造体 @strong{mime-content-disposition} を提供します。 @menu * mime-content-disposition:: mime-content-disposition 構造体 * Content-Disposition parser:: Content-Disposition 欄の解析器 @end menu @node mime-content-disposition, Content-Disposition parser, Content-Disposition, Content-Disposition @section mime-content-disposition 構造体 @deffn{Structure} mime-content-disposition Content-Disposition 欄の解析結果を収めるための構造体。@refill この構造体を参照するには @code{mime-content-disposition-要素名} という名 前の参照関数を用いる。@refill この構造体の要素は以下の通りである： @table @var @item disposition-type disposition-type (symbol). @item parameters Content-Disposition 欄の parameter (連想 list). @end table @end deffn @defun mime-content-disposition-parameter content-disposition parameter @var{content-disposition} の @var{parameter} の値を返す。 @end defun @defun mime-content-disposition-filename content-disposition @var{content-disposition} の filename の値を返す。 @end defun @node Content-Disposition parser, , mime-content-disposition, Content-Disposition @section Content-Disposition 欄の解析器 @defun mime-parse-Content-Disposition string @var{string} を content-disposition として解析した結果を返す。 @end defun @defun mime-read-Content-Disposition 現在の buffer の Content-Disposition 欄を読み取り、解析した結果を返す。 @refill Content-Disposition 欄が存在しない場合は nil を返す。 @end defun @node Content-Transfer-Encoding, encoded-word, Content-Disposition, Top @chapter 符号化法 @cindex Content-Transfer-Encoding 欄 @strong{Content-Transfer-Encoding 欄} は entity の符号化法を記述するため のものです。@refill FLIM では Content-Transfer-Encoding 欄を構文解析する関数を提供します。こ れらの関数は Content-Transfer-Encoding 欄の情報は文字列で表現します。 @refill また、Content-Transfer-Encoding に基づいて符号化・復号化を行う関数も提 供されます。 @menu * Content-Transfer-Encoding parser:: Content-Transfer-Encoding 欄の解析器 * encoder/decoder:: 符号化・復号化 * Encoding information:: Other utilities * mel-backend:: How to write encoder/decoder module * generic function for mel-backend:: How to add encoding/decoding service @end menu @node Content-Transfer-Encoding parser, encoder/decoder, Content-Transfer-Encoding, Content-Transfer-Encoding @section Content-Transfer-Encoding 欄の解析器 @defun mime-parse-Content-Transfer-Encoding string @var{string} を content-transfer-encoding として解析した結果を返す。 @end defun @defun mime-read-Content-Transfer-Encoding &optional default-encoding 現在の buffer の Content-Transfer-Encoding 欄を読み取り、解析した結果を 返す。@refill Content-Transfer-Encoding 欄が存在しない場合は@var{default-encoding} を 返す。 @end defun @node encoder/decoder, Encoding information, Content-Transfer-Encoding parser, Content-Transfer-Encoding @section 符号化・復号化 @defun mime-encode-region start end encoding 現在の buffer の @var{start} から @var{end} までの region を @var{encoding} を使って符号化します。 @end defun @defun mime-decode-region start end encoding 現在の buffer の @var{start} から @var{end} までの region を @var{encoding} を使って復号化します。 @end defun @defun mime-decode-string string encoding @var{string} を @var{encoding} として復号した結果を返す。 @end defun @defun mime-insert-encoded-file filename encoding @var{ENCODING} format で符号化された file @var{FILENAME} を 挿入する。 @end defun @defun mime-write-decoded-region start end filename encoding @var{encoding} で符号化された現在の region を復号化して @var{filename}に書き込みます。 start と @var{end} は buffer の位置です。 @end defun @node Encoding information, mel-backend, encoder/decoder, Content-Transfer-Encoding @section Other utilities @defun mime-encoding-list &optional SERVICE Content-Transfer-Encoding の list を返します。@refill @var{service} が指定されていると、それに対する Content-Transfer-Encoding を返します。 @end defun @defun mime-encoding-alist &optional SERVICE 補完のための Content-Transfer-Encoding の表を返します。@refill @var{service} が指定されている場合はそれに対する Content-Transfer-Encoding の list を返します。 @end defun @node mel-backend, generic function for mel-backend, Encoding information, Content-Transfer-Encoding @section How to write encoder/decoder module @defmac mel-define-method name args &rest body @var{name} を (nth 1 (car (last @var{args}))) backend の method 関数として定義します。 @var{args} は lambda の引数 list と似ていますが、(car (last @var{args})) は指定された parameter である必要があります。(car (car (last @var{args}))) は変数の名前で、(nth 1 (car (last @var{args}))) は backend の名前 (encoding) です。@refill 例:@refill @lisp (mel-define-method mime-write-decoded-region (start end filename (nil "base64")) "Decode and write current region encoded by base64 into FILENAME. START and END are buffer positions." (interactive (list (region-beginning) (region-end) (read-file-name "Write decoded region to file: "))) (let ((str (buffer-substring start end))) (with-temp-buffer (insert (decode-base64-string str)) (write-region-as-binary (point-min) (point-max) filename) ))) @end lisp @end defmac @defmac mel-define-method-function spec function @var{spec} の関数定義を @var{function} に設定します。@refill @var{spec} の最初の要素は service です。@refill @var{args} の残りは lambda の引数 list 似ていますが、(car (last @var{args})) は指定された parameter である必要があります。(car (car (last @var{args}))) は変数の名前で、(nth 1 (car (last @var{args}))) は backend の名前 (encoding) です。@refill 例:@refill @lisp (mel-define-method-function (mime-encode-string string (nil "base64")) 'encode-base64-string) @end lisp @end defmac @node generic function for mel-backend, , mel-backend, Content-Transfer-Encoding @section 符号化/復号化 service を追加する方法 @defmac mel-define-service name &optional args doc-string @var{name} を Content-Transfer-Encoding の service として定義しま す。@refill @var{args} が指定されていると、@var{name} は service の generic function として定義されます。@refill 例:@refill @lisp (mel-define-service encoded-text-encode-string (string encoding) "Encode STRING as encoded-text using ENCODING. ENCODING must be string.") @end lisp @end defmac @node encoded-word, custom, Content-Transfer-Encoding, Top @chapter Header の network 表現 @cindex RFC 2047 @cindex Standards Track @cindex RFC 2047 encoded-word は header で非 ASCII (@ref{ASCII}) 文字を表現するための形式 で、@strong{RFC 2047} で定義されています。@refill @noindent [RFC 2047] @quotation K. Moore, ``MIME (Multipurpose Internet Mail Extensions) Part Three: Message Header Extensions for Non-ASCII Text'', November 1996, Standards Track (obsolete RFC 1521,1522,1590). @end quotation また、行儀の悪いことだと言えますが、encoded-word を用いずに非 ASCII (@ref{ASCII}) 文字を header に入れた記事も存在します。@refill FLIM はこれらを符号化・復号化する機能を提供します。 @menu * Header encoder/decoder:: Header の符号化・復号化 @end menu @node Header encoder/decoder, , encoded-word, encoded-word @section Header の符号化・復号化 @defun eword-decode-header &optional code-conversion separator Header 中の encoded-word を復号する。@refill もし @var{code-conversion} が @code{nil} なら、encoded-word だけが復号さ れる。もし、@var{code-conversion} が MIME charset (@ref{MIME charset}) なら、非 ASCII bit patterns はその MIME charset として復号される。これ以 外の場合、非 ASCII bit patterns は@code{default-mime-charset}. として復 号される。(cf. @ref{entity formatting}) @refill もし @var{separator} が @code{nil} でなければ、その値がheader separator として用いられる。 @end defun @defun eword-encode-header &optional code-conversion Header を network 表現に符号化する。@refill 各 field は @code{mime-field-encoding-method-alist} で指定された方式で 符号化される。 @end defun @defvar mime-field-encoding-method-alist Field を符号化する方法を指定する連想 list。各 element は (FIELD . METHOD) の様になっている。@refill METHOD が @code{mime} であれば、FIELD は MIME format に符号化さ れる (encoded-word)。 METHOD が @code{nil} であれば、FIELD は符号化されない。 METHOD が MIME charset であれば、FIELD はネットワークコードに変換しな ければならないときに charset に符号化される。@refill そうでなければ、FIELD はネットワークコードに変換しなければならないとき に 変数 @code{default-mime-charset} で符号化される @end defvar @node custom, Appendix, encoded-word, Top @chapter 一般設定 @deffn{group} mime MIME 関連機能に関する group.@refill @code{mail} と @code{news} に属する。 @end deffn @node Appendix, Concept Index, custom, Top @chapter 付録 @menu * Glossary:: 用語 * Bug report:: bug 報告の仕方 * GitHub:: GitHub による開発 * History:: 歴史 @end menu @node Glossary, Bug report, Appendix, Appendix @section 用語 @menu * 7bit:: * 8bit:: * ASCII:: * Base64:: * binary:: * Coded character set:: Coded character set（符号化文字集合）, Character code（文字符号） * media-type:: * message:: * MIME:: * MIME charset:: * MTA:: * MUA:: * Quoted-Printable:: * RFC 822:: * RFC 1036:: * RFC 2045:: * RFC 2046:: * RFC 2048:: * RFC 2049:: * plain text:: * us-ascii:: @end menu @node 7bit, 8bit, Glossary, Glossary @subsection 7bit ここでは 0 から 127 の整数を指す。@refill 0 から 127 の整数の列で表現できるような data を ``7bit の data'' と呼ぶ。 @refill また、0 から 31 および 127 で表現される制御文字と 32 で表現される空白と 33 から 126 で表現される図形文字からなる文字列のことを ``7bit の文字列'' と呼ぶ（これは ISO 2022 の「7 単位系」と同様）。 伝統的な Internet の MTA (@ref{MTA}) は 7bit の data を転送できるので、 7bit の data は Quoted-Printable (@ref{Quoted-Printable}) や Base64 (@ref{Base64}) といった変換を行わなくてもそのまま転送できる。@refill しかし、7bit であればどんな data でも良いとはいえない。なぜなら、１行の 長さがあまりに長いと、MTA はその message を転送することができないからで ある。ちなみに、RFC 822 (@ref{RFC 822}) は１行は改行文字を除いて 998 byte 以内であることを求めている。よって、これ以上の行が含まれる可能性の ある data, 例えば、Postscript の data などは Quoted-Printable 等で encodeする必用がある。 @node 8bit, ASCII, 7bit, Glossary @subsection 8bit @cindex binary ここでは 0 から 255 の整数を指す。@refill 0 から 255 の整数の列で表現できるような data を ``8bit の data'' と呼ぶ。 @refill また、0 から 31, 127 および 128 から 159 で表現される制御文字と 32 で表 現される空白と 33 から 126 と 160 から 255 で表現される図形文字からなる 文字列のことを ``8bit の文字列'' と呼ぶ（これは ISO 2022 の「8 単位系」と同様）。@refill iso-8859-1 や euc-kr といった符号化文 字集合は 8bit の文字列である。@refill 伝統的な Internet の MTA (@ref{MTA}) は 7bit (@ref{7bit}) の data しか転 送できないので、そうした MTA を経由する場合、Quoted-Printable (@ref{Quoted-Printable}) や Base64 (@ref{Base64}) といった変換を行わなく てはならない。@refill しかし、最近では 8bit の文字列をそのまま通すことができる MTA も登場して きたので、そのまま送ることができる場合も増えてきた。@refill しかし、8bit であればどんな data でも良いとはいえない。なぜなら、１行の 長さがあまりに長いと、MTA はその message を転送することができないからで ある。ちなみに、RFC 822 (@ref{RFC 822}) は１行は改行文字を除いて 998 byte 以内であることを求めている。よって、これ以上の行が含まれる可能性の ある data, 例えば、Postscript の data などは Quoted-Printable 等で encodeする必用がある。@refill また、こうした理由から、１行が 999 byte 以上の行が存在する可能性のある data は @strong{binary} (@ref{binary}) と呼ぶことにする。@refill ちなみに、7bit で表現できる data は 8bit でも表現できる。よって、 ``8bit'' と言った場合、１行が 998 byte 以下の任意の data を指すことが ある。 @node ASCII, Base64, 8bit, Glossary @subsection ASCII @cindex ANSI X3.4:1986 @cindex ASCII アメリカ連邦で使われる文字を符号化した符号化文字集合 (@ref{Coded character set})。A-Z, a-z の Latin 文字と数字、幾つかの記号からなる。ISO 646 の一つ で、現在は国際基準版 (IRV) になっている。 @noindent [ASCII] @quotation ``Coded Character Set -- 7-Bit American Standard Code for Information Interchange'', ANSI X3.4:1986. @end quotation @node Base64, binary, ASCII, Glossary @subsection Base64 @cindex pad RFC 2045 (@ref{RFC 2045}) で定義されている MIME (@ref{MIME}) における binary data (@ref{binary}) の network での変換法の１つ。@refill 『64 進数』という意味で、3 byte の data を 0 から 63 の数を表す ASCII (@ref{ASCII}) 4 文字に変換する方法。（もし、4 文字にならなければ @strong{pad} と呼ばれる詰め物をして長さを調整する）@refill この 65 種類の文字は ASCII と EBCDIC の共通部分から選ばれており、 Internet 以外の network を経由する場合でも安全に転送できるように設計さ れている。 @node binary, Coded character set, Base64, Glossary @subsection binary @cindex binary data @cindex binary 任意の byte 列を @strong{binary} と呼ぶ。@refill 8bit (@ref{8bit}) と異なるのは data に行の構造を仮定しないことである。 また、行の構造があっても、999 byte 以上からなる行がある場合も binary と 呼ぶことにする。@refill ちなみに、7bit (@ref{7bit}) や 8bit で表現できる data は binary でも表現 できる。よって、@strong{binary data} と言った場合、任意の data を指すこ とがある。 @node Coded character set, media-type, binary, Glossary @subsection Coded character set（符号化文字集合）, Character code（文字符号） 文字と byte 列と１対１に対応付ける曖昧でない規則の集合。 @node media-type, message, Coded character set, Glossary @subsection media-type @cindex x-token @cindex primary-type/subtype @cindex message @cindex multipart @cindex application @cindex video @cindex audio @cindex image @cindex text @cindex subtype @cindex primary-type MIME (@ref{MIME}) における entity (@ref{Entity}) の種類。 @strong{primary-type} と @strong{subtype} からなる。RFC 2046 (@ref{RFC 2046}) で定義されている。@refill primary-type は標準では @itemize @bullet @item @strong{text} @item @strong{image} @item @strong{audio} @item @strong{video} @item @strong{application} @item @strong{multipart} @item @strong{message} @end itemize @noindent が定義され、それぞれには application/octet-stream, audio/basic, image/jpeg, multipart/mixed, text/plain, video/mpeg などの さまざまな subtype が定義されている。 @noindent @strong{[注意]} @quotation ここでは、text/plain などの type/subtype の組をしばしば @strong{primary-type/subtype} と書く。 @end quotation media-type は、RFC 2046 で定義されているものに加えて、登録することもでき る。現在、登録されているものは MEDIA TYPES (ftp://ftp.isi.edu/in-notes/iana/assignments/media-types) で参照できる。 また、type もしくは subtype に、前に `x-' を付けた @strong{x-token} を用 いることにより、登録されていないものを私的に用いることもできる。しかし、 当然のことながら、こうした私的な media-type は諒解を得た者の間でしか解釈 できないので利用には注意すること。@refill (cf. @ref{Content-Type}) @node message, MIME, media-type, Glossary @subsection message ここでは mail と news 記事の総称として用いる。 @node MIME, MIME charset, message, Glossary @subsection MIME @cindex Multipurpose Internet Mail Extensions @strong{Multipurpose Internet Mail Extensions} の略で、Internet の mail や news で us-ascii plain text (@ref{us-ascii}) 以外の文字を使うための RFC 822 (@ref{RFC 822}) に対する拡張。@refill RFC 2045 は冒頭で次のように述べている：@refill STD 11, RFC 822 は、US-ASCII message header に関して非常に詳細に規定し た message 表現 protocol を定義している。しかし、それは単に flat な US-ASCII text のみに留まり、message の内容や message body に関する規定 はなされていない。Multipurpose Internet Mail Extensions, あるいは MIME と総称される、この一連の文書は、以下の事を可能とするために message の 形式を再定義した： @enumerate @item 文書 message body における US-ASCII 以外の文字集合 @item 非文書 message body @item 複数の部分からなる message body @item US-ASCII 以外の文字集合からなる文書 header 情報 @end enumerate RFC 2045 (@ref{RFC 2045}), RFC 2046 (@ref{RFC 2046}), RFC 2047 (@ref{encoded-word}), RFC 2048 (@ref{RFC 2048}), RFC 2049 (@ref{RFC 2049}) で定義されている。 @node MIME charset, MTA, MIME, Glossary @subsection MIME charset Content-Type (@ref{Content-Type}) 欄や encoded-word (@ref{encoded-word}) の charset parameter で用いられる登録された符号化文字集合(@ref{Coded character set})。@refill RFC 2045 (@ref{RFC 2045}) で定義されている。@refill iso-2022-jp や euc-kr はその１つ。 @node MTA, MUA, MIME charset, Glossary @subsection MTA @cindex Message Transfer Agent @strong{Message Transfer Agent} の略で、qmail や sendmail などの mail 配 送 program と inn などの news server の総称。@refill (cf. @ref{MUA}) @node MUA, Quoted-Printable, MTA, Glossary @subsection MUA @cindex Message User Agent @strong{Message User Agent} の略で、mail reader と news reader の総称。 @refill (cf. @ref{MTA}) @node Quoted-Printable, RFC 822, MUA, Glossary @subsection Quoted-Printable RFC 2045 (@ref{RFC 2045}) で定義されている MIME (@ref{MIME}) における binary data の network での変換法の１つ。@refill `=' や制御文字や 128 以上の文字などは `=AF' のように `=' の後に続く 16 進数で表現する。このため、ASCII (@ref{ASCII}) 文字中心の data では Base64 (@ref{Base64}) に比べると可読性が高くなる可能性がある。@refill しかしながら、EBCDIC には存在しない文字を利用する場合、EBCDIC を利用し ている network では安全に転送することができず、Base64 に比べて安全性は 低い。 @node RFC 822, RFC 1036, Quoted-Printable, Glossary @subsection RFC 822 @cindex RFC 822 @cindex STD 11 @cindex Internet message @cindex Internet mail @cindex message header Internet mail の主に @strong{message header} に関する形式に 関する標準を定めている RFC. @noindent @strong{[Memo]} @quotation news message もこれに準じているので、@strong{Internet mail} と書くよりも、 @strong{Internet message} と書いた方が良いかもしれない。 @end quotation @noindent [RFC 822] @quotation D. Crocker, ``Standard for the Format of ARPA Internet Text Messages'', August 1982, STD 11. @end quotation @node RFC 1036, RFC 2045, RFC 822, Glossary @subsection RFC 1036 @cindex RFC 1036 @cindex USENET USENET での message の形式を定めた RFC. RFC 822 (@ref{RFC 822}) の subset になっている。Internet の標準ではないが、USENET 以外の netnews で もこれに準じているものが多い。 @noindent [USENET: RFC 1036] @quotation M. Horton and R. Adams, ``Standard for Interchange of USENET Messages'', December 1987, (obsolete RFC 850). @end quotation @node RFC 2045, RFC 2046, RFC 1036, Glossary @subsection RFC 2045 @cindex RFC 2045 @cindex Standards Track @noindent [RFC 2045] @quotation N. Freed and N. Borenstein, ``Multipurpose Internet Mail Extensions (MIME) Part One: Format of Internet Message Bodies'', November 1996, Standards Track (obsolete RFC 1521, 1522, 1590). @end quotation @node RFC 2046, RFC 2048, RFC 2045, Glossary @subsection RFC 2046 @cindex RFC 2046 @cindex Standards Track @noindent [RFC 2046] @quotation N. Freed and N. Borenstein, ``Multipurpose Internet Mail Extensions (MIME) Part Two: Media Types'', November 1996, Standards Track (obsolete RFC 1521, 1522, 1590). @end quotation @node RFC 2048, RFC 2049, RFC 2046, Glossary @subsection RFC 2048 @cindex RFC 2048 @cindex Standards Track @noindent [RFC 2048] @quotation N. Freed, J. Klensin and J. Postel, ``Multipurpose Internet Mail Extensions (MIME) Part Four: Registration Procedures'', November 1996, Standards Track (obsolete RFC 1521, 1522, 1590). @end quotation @node RFC 2049, plain text, RFC 2048, Glossary @subsection RFC 2049 @cindex RFC 2049 @cindex Standards Track @noindent [RFC 2049] @quotation N. Freed and N. Borenstein, ``Multipurpose Internet Mail Extensions (MIME) Part Five: Conformance Criteria and Examples'', November 1996, Standards Track (obsolete RFC 1521, 1522, 1590). @end quotation @node plain text, us-ascii, RFC 2049, Glossary @subsection plain text 書体や組版に関する情報を持たない文字符号 (@ref{Coded character set}) のみ で表現される text 情報。 @node us-ascii, , plain text, Glossary @subsection us-ascii @cindex ASCII @cindex us-ascii アメリカ連邦などで使われる英語などを表現するための MIME charset (@ref{MIME charset}) の１つ。@refill ASCII (@ref{ASCII}) のみからなり ISO 2022 による符号拡張は許されない。 Internet message における標準の符号化文字集合 (@ref{Coded character set}) であり、明示的に MIME charset が示されない場合は原則として @strong{us-ascii} が使われる。@refill また、RFC 822 (@ref{RFC 822}) における @strong{ASCII} は us-ascii である。 @node Bug report, GitHub, Glossary, Appendix @section bug 報告の仕方 FLIM-LB に関する議論は以下のメーリングリストで行われます。 最新バージョンのアナウンスもこちらに流れます。 @display Wanderlust Mailing List @t{} @end display ここでは主に日本語での議論が行われています。また、英語専用のリストとして @display Wanderlust List in English @t{} @end display もあります(こちらに投稿されたメッセージは前者にも配送されます)。 これらのメーリングリストのガイドを得るには、@t{wl-ctl@@ml.gentei.org} 宛 (英語の方は @t{wl-en-ctl@@ml.gentei.org} 宛) で、本文に @example # guide @end example @noindent と書いたメールを送って下さい。 バグ報告やパッチの送付もこれらのメーリングリストへ送ってください。メーリ ングリストへの送信はメンバになる必要があります。 但し、あまりにも古い版に関する報告は歓迎されません。古い版の bug は、新 しい版では治っているかもしれません。まず、最新版で確認してみましょう。 @refill それから、適切な報告をしましょう。単に「うまく動かない」と言われてもど ういう状況なのかはさっぱり判りません。最低限、OS, emacs, APEL, FLIM, SEMI, 使っている MUA の種類および版、設定を書く必要があります。また、 error が起っている場合は backtrace を送ることも重要です。 (cf. @ref{Bugs,Reporting Bugs ,Reporting Bugs, emacs, GNU Emacs Manual}) また、bug は大抵複数の人が遭遇するものです（そうでなければ、bug ではな い可能性があります）。だから、作者に直接 mail を送ると作者は同じ mail を何通も書く羽目になります。だから、必ず bug 報告は上記の address に送っ てください。 @node GitHub, History, Bug report, Appendix @section GitHub による開発 FLIM-LB のリポジトリは GitHub で公開されています。 @example @uref{https://github.com/wanderlust/flim} @end example プルリクエストを送る場合は、Emacs の様に、コミットメッセージに従来の @file{ChangeLog} エントリに相当する内容をインデントせずに入力して下さい。 Emacs の @file{CONTRIBUTE} ファイル @footnote{@uref{https://git.savannah.gnu.org/cgit/emacs.git/plain/CONTRIBUTE}} にある @cite{Commit messages} セクションを参照して下さい。 また、バグ報告の場合はバックトレースを取って添付すると原因究明しやすくな ります。 @footnote{バックトレースの取り方は @uref{http://www.jpl.org/elips/BUGS-ja.html}が参考になります。} @node History, , GitHub, Appendix @section 歴史 FLIM の code の最古の部分は 榎並 嗣智 氏が書いた @file{mime.el} に起源し ます。この小さな program は Nemacs で動作する iso-2022-jp の B-encoding 専用の encoded-word の復号化プログラムでした。@refill その後、守岡 知彦 は @file{mime.el} を元に@file{tiny-mime.el} というプロ グラムを書きます。これは、Nemacs と Mule で動作する encoded-word の符号 化・復号化プログラムでした。@file{tiny-mime.el} は B-encoding だけでなく Q-encoding もsupport し、また、MULE で扱うことができるさまざまな MIME charset (@ref{MIME charset}) を同時に使うことができました。この時、 Nemacs と Mule の双方を support するために用いられたテクニックは後に emu package にまとめられます。@refill この頃、守岡 知彦 は @file{tiny-mime.el} をさまざまな MUA で使うための設 定集も配布していましたが、それらは後に@file{tiny-mime.el} とともに１つの package にまとめられ、tm という名前で配布されます。@refill 守岡 知彦 はやがて、MIME message を閲覧するためのプログラムである @file{tm-body.el} を書きます。これは、すぐに@file{tm-view.el} という名前 に変わりましたが、やがて、これが@file{tiny-mime.el} に代わって、tm の中 核となります。@refill @file{tm-view.el} は当然、Content-Transfer-Encoding を扱う必要があります。 この目的のために、MEL が整備されはじめました。Base64 に関しては @file{tiny-mime.el} の code が移され、また、新たにQuoted-Printable の code が追加されました。これらが@file{mel-b.el} と @file{mel-q.el} になり ました。@refill また、後に、守岡 知彦 によって uuencode 用の @file{mel-u.el} が追加され、 その後に、小林 修平 氏によって x-gzip64 用の@file{mel-g.el} が追加されま した。@refill tm では後に、守岡 知彦 によって @file{tiny-mime.el} の再実装が行われ、こ の過程で、STD 11 の parser が書かれました。これは、現在の @file{std11.el} に当たります。また、この過程で @file{tiny-mime.el} は復 号化を行う @file{tm-ew-d.el} と符号化を行う @file{tm-ew-e.el} に分けられ ました。この両者が現在の @file{eword-decode.el} と @file{eword-encode.el} の先祖に当たります。@refill 後に、守岡 知彦 らによって tm の全面書き換え作業が行われ、この過程で、tm は APEL, MEL, SEMI, EMH, RMAIL-MIME, Gnus-MIME などに分けられました。こ のうちの MEL が FLIM の直接の先祖に当たります。@refill 後に、APEL から @file{std11.el} が移され、また、@file{mailcap.el}, @file{eword-decode.el} および @file{eword-encode.el} が SEMI から移され、 package の名前が FLIM となります。@refill この直前から田中 哲 氏がより RFC に忠実な実装を書き始め、これは、現在、 FLIM の枝である ``FLIM-FLAM'' となっています。 @node Concept Index, Function Index, Appendix, Top @chapter 概念索引 @printindex cp @node Function Index, Variable Index, Concept Index, Top @chapter 関数索引 @printindex fn @node Variable Index, , Function Index, Top @chapter 変数索引 @printindex vr @bye wanderlust-flim-2cf5a78/mime-parse.el000066400000000000000000000663401436773573300176640ustar00rootroot00000000000000;;; mime-parse.el --- MIME message parser -*- lexical-binding: t -*- ;; Copyright (C) 1994,95,96,97,98,99,2001 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Shuhei KOBAYASHI ;; Keywords: parse, MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'pccl) (require 'broken) (require 'luna) (require 'mime-def) (require 'std11) (require 'mime) (autoload 'mime-entity-body-buffer "mime") (autoload 'mime-entity-body-start-point "mime") (autoload 'mime-entity-body-end-point "mime") ;;; @ lexical analyzer ;;; (unless-broken ccl-usable (define-ccl-program mime-default-ccl-lexical-analyzer ;; r0 input ;; r1 flag means any character exists. ;; r2 in parse flag ;; 1 atom, 2 spaces 3 comment (no output) 4 encloser 5 error ;; r3 comment depth (eval-when-compile (let* ((wrt `(if (r0 == ?\") (write "\\\"") (if (r0 == ?\\) (write "\\\\") (write r0)))) (atm `((branch r2 ((r2 = 1) (write "(mime-token . \"") (write-read-repeat r0)) (write-read-repeat r0) ((r2 = 1) (write "(mime-token . \"") (write-read-repeat r0))))) (ts `((if (r2 == 1) ((write "\")") (r2 = 0))) (write "(tspecials . \"") ,wrt (write "\")") (read r0) (repeat))) (sp `((branch r2 ((r2 = 2) (read r0) (repeat)) ((write "\")") (r2 = 2) (read r0) (repeat)) ((read r0) (repeat))))) (err `((branch r2 ((write "(error . \"")) ((write "\")") (write "(error . \"")) ((write "(error . \""))) (r2 = 5) (loop (write-read-repeat r0)))) (enc (lambda (name tag) `((if (r2 == 1) ((write "\")"))) (write ,(concat "(" name " . \"")) (r2 = 4) (loop (read-branch r0 ,@(let* ((count (1+ (max tag ?\\))) (result (make-vector count '(write-repeat r0)))) (aset result ?\\ `((write "\\\\") (read r0) ,wrt (repeat))) (aset result ?\" '((write "\\\"") (repeat))) (aset result tag '(break)) (mapcar 'identity result))) (write-repeat r0)) (write "\")") (r2 = 0) (read r0) (repeat)))) (qs (funcall enc "quoted-string" ?\")) (dl (funcall enc "domain-literal" ?\])) (cm `((if (r2 == 1) ((write "\")"))) (r2 = 3) (r3 = 1) (loop (read-branch r0 ,@(let* ((count (1+ (max ?\( ?\) ?\\))) (result (make-vector count '(repeat)))) (aset result ?\( '((r3 += 1) (repeat))) (aset result ?\) '((r3 -= 1) (if (r3 < 1) (break) (repeat)))) (aset result ?\\ `((read r0) (repeat))) (mapcar 'identity result))) (repeat)) (r2 = 0) (read r0) (repeat)))) `(8 ((r2 = 0) (read r0) (r1 = 1) (write "((") (loop (branch r0 ,@(mapcar (lambda (elt) (eval elt)) '(err err err err err err err err err sp sp err err err err err err err err err err err err err err err err err err err err err sp atm qs atm atm atm atm atm cm ts atm atm ts atm atm ts atm atm atm atm atm atm atm atm atm atm ts ts ts ts ts ts ts atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm dl ts ts))) ,@atm)) ((branch r1 (write "(nil . t)") (branch r2 (write ") . t)") (write "\")) . t)") (write ") . t)") (write "))") (write "\")))") (write "\")) . t)"))))))))) (defcustom mime-ccl-lexical-analyzer (static-unless (or (broken-p 'ccl-usable) (broken-p 'ccl-execute-eof-block)) 'mime-default-ccl-lexical-analyzer) "Specify CCL-program symbol for `mime-lexical-analyze'. When nil, do not use CCL. See docstring of `std11-ccl-lexical-analyzer' for details of CCL-program. If you modify `mime-lexical-analyzer', set this variable to nil or prepare corresponding CCL-program." :group 'mime :type '(choice symbol (const :tag "Do not use CCL." nil))) (defcustom mime-lexical-analyzer '(std11-analyze-quoted-string std11-analyze-domain-literal std11-analyze-comment std11-analyze-spaces mime-analyze-tspecial mime-analyze-token) "*List of functions to return result of lexical analyze. Each function must have two arguments: STRING and START. STRING is the target string to be analyzed. START is start position of STRING to analyze. Previous function is preferred to next function. If a function returns nil, next function is used. Otherwise the return value will be the result." :group 'mime :type '(repeat function)) (defun mime-analyze-tspecial (string start) (if (and (> (length string) start) (memq (aref string start) mime-tspecial-char-list)) (cons (cons 'tspecials (substring string start (1+ start))) (1+ start)))) (defun mime-analyze-token (string start) (if (and (string-match mime-token-regexp string start) (= (match-beginning 0) start)) (let ((end (match-end 0))) (cons (cons 'mime-token (substring string start end)) end)))) (defun mime-lexical-analyze (string) "Analyze STRING as lexical tokens of MIME." (let (ret prev tail) (if (and mime-ccl-lexical-analyzer (cdr (setq ret (read (ccl-execute-on-string mime-ccl-lexical-analyzer (make-vector 9 0) (or string "")))))) (car ret) (setq ret (std11-lexical-analyze string mime-lexical-analyzer)) ;; skip leading linear-white-space. (while (memq (car (car ret)) '(spaces comment)) (setq ret (cdr ret))) (setq prev ret tail (cdr ret)) ;; remove linear-white-space. (while tail (if (memq (car (car tail)) '(spaces comment)) (progn (setcdr prev (cdr tail)) (setq tail (cdr tail))) (setq prev (cdr prev) tail (cdr tail)))) ret))) ;;; @ field parser ;;; (defun mime-decode-parameter-value (text charset language) (with-temp-buffer (set-buffer-multibyte nil) (insert text) (goto-char (point-min)) (while (re-search-forward "%[0-9A-Fa-f][0-9A-Fa-f]" nil t) (insert (prog1 (string-to-number (buffer-substring (point)(- (point) 2)) 16) (delete-region (point)(- (point) 3))))) (setq text (buffer-string)) (when charset (setq text (mime-charset-decode-string text charset))) (when language (put-text-property 0 (length text) 'mime-language language text)) text)) (defun mime-decode-parameter-encode-segment (segment) (with-temp-buffer (set-buffer-multibyte nil) (insert segment) (goto-char (point-min)) (while (progn (when (looking-at (eval-when-compile (concat mime-attribute-char-regexp "+"))) (goto-char (match-end 0))) (not (eobp))) (insert (prog1 (format "%%%02X" (following-char)) (delete-region (point)(1+ (point)))))) (buffer-string))) (defun mime-decode-parameters (params) "Decode PARAMS as a property list of MIME parameter values. Return value is an association list of MIME parameter values. If parameter continuation is used, segments of values are concatenated. If parameters contain charset information, values are decoded. If parameters contain language information, it is set to `mime-language' property of the decoded-value." ;; (unless (zerop (% (length params) 2)) ...) (let ((len (/ (length params) 2)) dest eparams) (while params (if (and (string-match (eval-when-compile (concat "^\\(" mime-attribute-char-regexp "+\\)" "\\(\\*[0-9]+\\)?" ; continuation "\\(\\*\\)?$")) ; charset/language (car params)) (> (match-end 0) (match-end 1))) ;; parameter value extensions are used. (let* ((attribute (downcase (substring (car params) 0 (match-end 1)))) (section (if (match-beginning 2) (string-to-number (substring (car params) (1+ (match-beginning 2)) (match-end 2))) 0)) ;; EPARAM := (ATTRIBUTE VALUES CHARSET LANGUAGE) ;; VALUES := [1*VALUE] ; vector of LEN elements. (eparam (assoc attribute eparams)) (value (progn (setq params (cdr params)) (car params)))) (if eparam (setq eparam (cdr eparam)) (setq eparam (list (make-vector len nil) nil nil) eparams (cons (cons attribute eparam) eparams))) ;; if parameter-name ends with "*", it is an extended-parameter. (if (match-beginning 3) (if (zerop section) ;; extended-initial-parameter. (if (string-match (eval-when-compile (concat "^\\(" mime-charset-regexp "\\)?" "'\\(" mime-language-regexp "\\)?" "'\\(\\(" mime-attribute-char-regexp "\\|%[0-9A-Fa-f][0-9A-Fa-f]\\)+\\)$")) value) (progn ;; text (aset (car eparam) 0 (substring value (match-beginning 3))) (setq eparam (cdr eparam)) ;; charset (when (match-beginning 1) (setcar eparam (downcase (substring value 0 (match-end 1))))) (setq eparam (cdr eparam)) ;; language (when (match-beginning 2) (setcar eparam (intern (downcase (substring value (match-beginning 2) (match-end 2))))))) ;; invalid parameter-value. (aset (car eparam) 0 (mime-decode-parameter-encode-segment value))) ;; extended-other-parameter. (if (string-match (eval-when-compile (concat "^\\(\\(" mime-attribute-char-regexp "\\|%[0-9A-Fa-f][0-9A-Fa-f]\\)+\\)$")) value) (aset (car eparam) section value) ;; invalid parameter-value. (aset (car eparam) section (mime-decode-parameter-encode-segment value)))) ;; regular-parameter. parameter continuation only. (aset (car eparam) section (mime-decode-parameter-encode-segment value)))) ;; parameter value extensions are not used, ;; or invalid attribute-name (in RFC2231, although valid in RFC2045). (setq dest (cons (cons (downcase (car params)) ;;; ;; decode (invalid!) encoded-words. ;;; (eword-decode-string ;;; (decode-mime-charset-string ;;; (car (cdr params)) ;;; default-mime-charset) ;;; 'must-unfold) (car (cdr params))) dest) params (cdr params))) (setq params (cdr params))) ;; concat and decode parameters. (while eparams (setq dest (cons (cons (car (car eparams)) ; attribute (mime-decode-parameter-value (mapconcat (function identity) (nth 1 (car eparams)) ; values "") (nth 2 (car eparams)) ; charset (nth 3 (car eparams)) ; language )) dest) eparams (cdr eparams))) dest)) ;;; for compatibility with flim-1_13-rfc2231 API. (defalias 'mime-parse-parameters-from-list 'mime-decode-parameters) (make-obsolete 'mime-parse-parameters-from-list 'mime-decode-parameters "28 Feb 2001") ;;; @ parameter value encoder ;;; (defun mime-divide-extended-parameter (name value) "Divide MIME parameter value \"NAME=VALUE\" into segments. Each of \" NAME*n*=SEGMENT_n\;\" will be no more than 78 characters. Return value is a list of string when division is performed, otherwise return value is just a string." ;; `limit' must be more than (length "CHARSET'LANGUAGE'%XX"). ;; ;; Since MIME spec does not limit either length of CHARSET or length ;; of LANGUAGE, we choose 30 for minimum `limit' based on the longest ;; name of charset that Emacs supports ("ISO-2022-CN-EXT"; 15 chars). ;; ;; Anyway, if `name' is too long, we will ignore 78 chars limit. (let ((limit (max (- 78 4 (length name)) 30))); (length " *=;") => 4 (if (> limit (length value)) value (let ((count 0) result) (setq limit (max (- limit 2) 30)) ; (length "*n") => 2 (with-temp-buffer (set-buffer-multibyte nil) (insert value) (while (> (point-max) limit) (goto-char (- limit 3)) ; (length "%XX") => 3 (cond ((eq (following-char) ?%) (forward-char 3)) ((progn (forward-char) (eq (following-char) ?%))) ((progn (forward-char) (eq (following-char) ?%))) (t (forward-char))) (setq result (cons (prog1 (buffer-substring (point-min)(point)) (delete-region (point-min)(point))) result) count (1+ count)) (when (zerop (% count 10)) (setq limit (max (1- limit) 30)))) (nreverse (cons (buffer-substring (point-min)(point-max)) result))))))) (defun mime-encode-extended-parameter (name value) "Encode MIME parameter value \"NAME=VALUE\" as an extended-parameter. If encoding is unnecessary, return nil. If division is performed, return value is a list of string, otherwise return value is just a string." (let ((language (get-text-property 0 'mime-language value))) (when (or language (string-match "[^ -~]" value)) ; Nonmatching printable US-ASCII. (with-temp-buffer (let ((charset (find-mime-charset-by-charsets (find-charset-string value)))) (setq value (mime-charset-encode-string value charset)) (set-buffer-multibyte nil) (insert value) (goto-char (point-min)) (insert (symbol-name charset) ?' (if language (symbol-name language) "") ?') (while (re-search-forward mime-non-attribute-char-regexp nil t) (insert (prog1 (format "%%%02X" (preceding-char)) (delete-region (1- (point))(point))))) (mime-divide-extended-parameter name (buffer-string))))))) (defun mime-divide-regular-parameter (name value) "Divide MIME parameter value \"NAME=VALUE\" into segments. Each of \" NAME*n=SEGMENT_n\;\" will be no more than 78 characters. Return value is a list of string when division is performed, otherwise just a string is returned." (let ((limit (max (- (eval-when-compile (- 78 (length " =\"\";"))) (length name)) 30))) (if (> limit (length value)) (concat "\"" value "\"") (let ((count 0) result) (setq limit (max (- limit 2) 30)) ; (length "*n") => 2 (setq limit (1- limit)) ; XXX (with-temp-buffer (set-buffer-multibyte nil) (insert value) (while (> (point-max) limit) (goto-char (point-min)) (while (< (point) limit) (when (eq (following-char) ?\\) (forward-char)) (forward-char)) (setq result (cons (concat "\"" (prog1 (buffer-substring (point-min)(point)) (delete-region (point-min)(point))) "\"") result) count (1+ count)) (when (zerop (% count 10)) (setq limit (max (1- limit) 30)))) (nreverse (cons (concat "\"" (buffer-substring (point-min)(point-max)) "\"") result))))))) (defun mime-encode-regular-parameter (name value) "Encode MIME parameter value \"NAME=VALUE\" as a regular-parameter. If division is performed, return value is a list of string, otherwise return value is just a string." (with-temp-buffer (set-buffer-multibyte nil) (insert value) (goto-char (point-min)) (while (not (eobp)) (when (memq (following-char) '(?\\ ?\")) (insert ?\\)) (forward-char 1)) (mime-divide-regular-parameter name (buffer-string)))) (defun mime-encode-parameters (params) "Encode PARAMS plist with MIME Parameter-Value Extensions. Return value is an alist of MIME parameter values." (let (name value encoded result) (while params (setq name (car params) value (car (cdr params)) params (cdr (cdr params))) (cond ;; first two clauses are for backward compatibility, ;; especially for "ftp.in" in the distribution. ((not (string-match (eval-when-compile (concat "^\\(" mime-attribute-char-regexp "+\\)" "\\(\\*[0-9]+\\)?" ; continuation "\\(\\*\\)?$")) ; charset/language name)) ;; invalid parameter name. ;; XXX: Should we signal an error? ) ((> (match-end 0) (match-end 1)) ;; this parameter value is already encoded. (setq result (cons (cons name (if (match-beginning 3) ;; extended-parameter value ;; regular-parameter (std11-wrap-as-quoted-string value))) result))) ((setq encoded (mime-encode-extended-parameter name value)) ;; extended-parameter (if (stringp encoded) (setq result (cons (cons (concat name "*") encoded) result)) ;; with continuation (let ((section 0)) (while encoded (setq result (cons (cons (concat name "*" (int-to-string section) "*") (car encoded)) result) section (1+ section) encoded(cdr encoded)))))) (t ;; regular-parameter (setq encoded (mime-encode-regular-parameter name value)) (if (stringp encoded) (setq result (cons (cons name encoded) result)) ;; with continuation (let ((section 0)) (while encoded (setq result (cons (cons (concat name "*" (int-to-string section)) (car encoded)) result) section (1+ section) encoded (cdr encoded)))))))) (nreverse result))) (provide 'mime-parse) (require 'eword-encode) (defun mime-encode-parameters-broken-mime (params) "Encode PARAMS plist compatibly with Outlook. Return value is an alist of MIME parameter values." (let (result) (while (cadr params) (setq result `((,(car params) . ,(eword-encode-string (cadr params) (+ (length (car params)) 3))) . ,result) params (cddr params))) (nreverse result))) ;;; @ field parser ;;; (defun mime-parse-parameters (tokens) "Parse TOKENS as MIME parameter values. Return a property list, which is a list of the form (PARAMETER-NAME1 VALUE1 PARAMETER-NAME2 VALUE2...)." (let (params attribute) (while (and tokens (eq (car (car tokens)) 'tspecials) (string= (cdr (car tokens)) ";") (setq tokens (cdr tokens)) (eq (car (car tokens)) 'mime-token) (progn (setq attribute (cdr (car tokens))) (setq tokens (cdr tokens))) (eq (car (car tokens)) 'tspecials) (string= (cdr (car tokens)) "=") (setq tokens (cdr tokens)) (memq (car (car tokens)) '(mime-token quoted-string))) (setq params (cons (if (eq (car (car tokens)) 'quoted-string) (std11-strip-quoted-pair (cdr (car tokens))) (cdr (car tokens))) (cons attribute params)) tokens (cdr tokens))) (nreverse params))) ;;; @@ Content-Type ;;; ;;;###autoload (defun mime-parse-Content-Type (field-body) "Parse FIELD-BODY as a Content-Type field. FIELD-BODY is a string. Return value is a mime-content-type object. If FIELD-BODY is not a valid Content-Type field, return nil." (let ((tokens (mime-lexical-analyze field-body))) (when (eq (car (car tokens)) 'mime-token) (let ((primary-type (cdr (car tokens)))) (setq tokens (cdr tokens)) (when (and (eq (car (car tokens)) 'tspecials) (string= (cdr (car tokens)) "/") (setq tokens (cdr tokens)) (eq (car (car tokens)) 'mime-token)) (make-mime-content-type (intern (downcase primary-type)) (intern (downcase (cdr (car tokens)))) (mime-decode-parameters (mime-parse-parameters (cdr tokens))))))))) ;;;###autoload (defun mime-read-Content-Type () "Parse field-body of Content-Type field of current-buffer. Return value is a mime-content-type object. If Content-Type field is not found, return nil." (let ((field-body (std11-field-body "Content-Type"))) (if field-body (mime-parse-Content-Type field-body)))) ;;; @@ Content-Disposition ;;; ;;;###autoload (defun mime-parse-Content-Disposition (field-body) "Parse FIELD-BODY as a Content-Disposition field. FIELD-BODY is a string. Return value is a mime-content-disposition object. If FIELD-BODY is not a valid Content-Disposition field, return nil." (let ((tokens (mime-lexical-analyze field-body))) (when (eq (car (car tokens)) 'mime-token) (make-mime-content-disposition (intern (downcase (cdr (car tokens)))) (mime-decode-parameters (mime-parse-parameters (cdr tokens))))))) ;;;###autoload (defun mime-read-Content-Disposition () "Parse field-body of Content-Disposition field of current-buffer. Return value is a mime-content-disposition object. If Content-Disposition field is not found, return nil." (let ((field-body (std11-field-body "Content-Disposition"))) (if field-body (mime-parse-Content-Disposition field-body)))) ;;; @@ Content-Transfer-Encoding ;;; ;;;###autoload (defun mime-parse-Content-Transfer-Encoding (field-body) "Parse FIELD-BODY as a Content-Transfer-Encoding field. FIELD-BODY is a string. Return value is a string. If FIELD-BODY is not a valid Content-Transfer-Encoding field, return nil." (let ((tokens (mime-lexical-analyze field-body))) (when (eq (car (car tokens)) 'mime-token) (downcase (cdr (car tokens)))))) ;;;###autoload (defun mime-read-Content-Transfer-Encoding () "Parse field-body of Content-Transfer-Encoding field of current-buffer. Return value is a string. If Content-Transfer-Encoding field is not found, return nil." (let ((field-body (std11-field-body "Content-Transfer-Encoding"))) (if field-body (mime-parse-Content-Transfer-Encoding field-body)))) ;;; @@ Content-ID / Message-ID ;;; ;;;###autoload (defun mime-parse-msg-id (tokens) "Parse TOKENS as msg-id of Content-ID or Message-ID field." (car (std11-parse-msg-id tokens))) ;;;###autoload (defun mime-uri-parse-cid (string) "Parse STRING as cid URI." (when (string-match "^cid:" string) (setq string (concat "<" (substring string 4) ">")) (let ((parser (cdr (assq 'Content-Id mime-field-parser-alist)))) (if parser (funcall parser (eword-lexical-analyze string)) (mime-decode-field-body string 'Content-Id 'plain))))) ;;; @ message parser ;;; ;; (defun mime-parse-multipart (entity) ;; (with-current-buffer (mime-entity-body-buffer entity) ;; (let* ((representation-type ;; (mime-entity-representation-type-internal entity)) ;; (content-type (mime-entity-content-type-internal entity)) ;; (dash-boundary ;; (concat "--" ;; (mime-content-type-parameter content-type "boundary"))) ;; (delimiter (concat "\n" (regexp-quote dash-boundary))) ;; (close-delimiter (concat delimiter "--[ \t]*$")) ;; (rsep (concat delimiter "[ \t]*\n")) ;; (dc-ctl ;; (if (eq (mime-content-type-subtype content-type) 'digest) ;; (make-mime-content-type 'message 'rfc822) ;; (make-mime-content-type 'text 'plain) ;; )) ;; (body-start (mime-entity-body-start-point entity)) ;; (body-end (mime-entity-body-end-point entity))) ;; (save-restriction ;; (goto-char body-end) ;; (narrow-to-region body-start ;; (if (re-search-backward close-delimiter nil t) ;; (match-beginning 0) ;; body-end)) ;; (goto-char body-start) ;; (if (re-search-forward ;; (concat "^" (regexp-quote dash-boundary) "[ \t]*\n") ;; nil t) ;; (let ((cb (match-end 0)) ;; ce ncb ret children ;; (node-id (mime-entity-node-id-internal entity)) ;; (i 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 representation-type dc-ctl ;; entity (cons i node-id))) ;; ) ;; (setq children (cons ret children)) ;; (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 representation-type dc-ctl ;; entity (cons i node-id))) ;; ) ;; (setq children (cons ret children)) ;; (mime-entity-set-children-internal entity (nreverse children)) ;; ) ;; (mime-entity-set-content-type-internal ;; entity (make-mime-content-type 'message 'x-broken)) ;; nil) ;; )))) ;; (defun mime-parse-encapsulated (entity) ;; (mime-entity-set-children-internal ;; entity ;; (with-current-buffer (mime-entity-body-buffer entity) ;; (save-restriction ;; (narrow-to-region (mime-entity-body-start-point entity) ;; (mime-entity-body-end-point entity)) ;; (list (mime-parse-message ;; (mime-entity-representation-type-internal entity) nil ;; entity (cons 0 (mime-entity-node-id-internal entity)))) ;; )))) ;; (defun mime-parse-external (entity) ;; (require 'mmexternal) ;; (mime-entity-set-children-internal ;; entity ;; (with-current-buffer (mime-entity-body-buffer entity) ;; (save-restriction ;; (narrow-to-region (mime-entity-body-start-point entity) ;; (mime-entity-body-end-point entity)) ;; (list (mime-parse-message ;; 'mime-external-entity nil ;; entity (cons 0 (mime-entity-node-id-internal entity)))) ;; ;; [tomo] Should we unify with `mime-parse-encapsulated'? ;; )))) (defun mime-parse-message (representation-type &optional default-ctl parent node-id) (let ((header-start (point-min)) header-end body-start (body-end (point-max)) content-type) (goto-char header-start) (if (re-search-forward "^$" nil t) (setq header-end (match-end 0) body-start (if (= header-end body-end) body-end (1+ header-end))) (setq header-end (point-min) body-start (point-min))) (save-restriction (narrow-to-region header-start header-end) (setq content-type (or (mime-read-Content-Type) default-ctl))) (luna-make-entity representation-type :location (current-buffer) :content-type content-type :parent parent :node-id node-id :buffer (current-buffer) :header-start header-start :header-end header-end :body-start body-start :body-end body-end))) ;;; @ for buffer ;;; ;;;###autoload (defun mime-parse-buffer (&optional buffer representation-type) "Parse BUFFER as a MIME message. If buffer is omitted, it parses current-buffer." (require 'mmbuffer) (save-excursion (if buffer (set-buffer buffer)) (mime-parse-message (or representation-type 'mime-buffer-entity) nil))) ;;; @ end ;;; (provide 'mime-parse) ;;; mime-parse.el ends here wanderlust-flim-2cf5a78/mime.el000066400000000000000000000333561436773573300165550ustar00rootroot00000000000000;;; mime.el --- MIME library module -*- lexical-binding: t -*- ;; Copyright (C) 1998,1999,2000,2001,2003 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'alist) (require 'luna) (require 'std11) (require 'mime-def) (require 'eword-decode) (eval-when-compile (require 'mmgeneric)) (eval-and-compile (autoload 'mime-encode-header-in-buffer "eword-encode" "Encode header fields to network representation, such as MIME encoded-word.") (autoload 'mime-parse-Content-Type "mime-parse" "Parse STRING as field-body of Content-Type field.") (autoload 'mime-read-Content-Type "mime-parse" "Read field-body of Content-Type field from current-buffer, and return parsed it.") (autoload 'mime-parse-Content-Disposition "mime-parse" "Parse STRING as field-body of Content-Disposition field.") (autoload 'mime-read-Content-Disposition "mime-parse" "Read field-body of Content-Disposition field from current-buffer, and return parsed it.") (autoload 'mime-parse-Content-Transfer-Encoding "mime-parse" "Parse STRING as field-body of Content-Transfer-Encoding field.") (autoload 'mime-read-Content-Transfer-Encoding "mime-parse" "Read field-body of Content-Transfer-Encoding field from current-buffer, and return it.") (autoload 'mime-parse-msg-id "mime-parse" "Parse TOKENS as msg-id of Content-Id or Message-Id field.") (autoload 'mime-uri-parse-cid "mime-parse" "Parse STRING as cid URI.") (autoload 'mime-parse-buffer "mime-parse" "Parse BUFFER as a MIME message.")) (autoload 'mime-encode-field-body "eword-encode" "Encode FIELD-BODY as FIELD-NAME, and return the result.") ;;; @ Entity Representation and Implementation ;;; (defmacro mime-entity-send (entity message &rest args) `(luna-send ,entity ',(intern (format "mime-%s" (eval message))) ,@args)) (defun mime-open-entity (type location) "Open an entity and return it. TYPE is representation-type. LOCATION is location of entity. Specification of it is depended on representation-type." (require (intern (format "mm%s" type))) (luna-make-entity (mm-expand-class-name type) :location location)) (luna-define-generic mime-entity-cooked-p (entity) "Return non-nil if contents of ENTITY has been already code-converted.") ;;; @ Entity as node of message ;;; (defun mime-entity-children (entity) "Return list of entities included in the ENTITY." (or (mime-entity-children-internal entity) (luna-send entity 'mime-entity-children entity))) (defun mime-entity-node-id (entity) "Return node-id of ENTITY." (mime-entity-node-id-internal entity)) (defun mime-entity-number (entity) "Return entity-number of ENTITY." (reverse (mime-entity-node-id-internal entity))) (defun mime-find-entity-from-number (entity-number message) "Return entity from ENTITY-NUMBER in MESSAGE." (let ((sn (car entity-number))) (if (null sn) message (let ((rc (nth sn (mime-entity-children message)))) (if rc (mime-find-entity-from-number (cdr entity-number) rc)))))) (defun mime-find-entity-from-node-id (entity-node-id message) "Return entity from ENTITY-NODE-ID in MESSAGE." (mime-find-entity-from-number (reverse entity-node-id) message)) (defun mime-find-entity-from-content-id (cid message) "Return entity from CID in MESSAGE." (if (equal cid (mime-entity-read-field message "Content-Id")) message (let ((children (mime-entity-children message)) ret) (while (and children (null (setq ret (mime-find-entity-from-content-id cid (car children))))) (setq children (cdr children))) ret))) (defun mime-entity-parent (entity &optional message) "Return mother entity of ENTITY. If MESSAGE is specified, it is regarded as root entity." (if (equal entity message) nil (mime-entity-parent-internal entity))) (defun mime-root-entity-p (entity &optional message) "Return t if ENTITY is root-entity (message). If MESSAGE is specified, it is regarded as root entity." (null (mime-entity-parent entity message))) (defun mime-find-root-entity (entity) "Return root entity of ENTITY." (while (not (mime-root-entity-p entity)) (setq entity (mime-entity-parent entity))) entity) ;;; @ Header buffer (obsolete) ;;; ;; (luna-define-generic mime-entity-header-buffer (entity)) ;; (luna-define-generic mime-goto-header-start-point (entity) ;; "Set buffer and point to header-start-position of ENTITY.") ;; (luna-define-generic mime-entity-header-start-point (entity) ;; "Return header-start-position of ENTITY.") ;; (luna-define-generic mime-entity-header-end-point (entity) ;; "Return header-end-position of ENTITY.") ;; (make-obsolete 'mime-entity-header-buffer "don't use it.") ;; (make-obsolete 'mime-goto-header-start-point "don't use it.") ;; (make-obsolete 'mime-entity-header-start-point "don't use it.") ;; (make-obsolete 'mime-entity-header-end-point "don't use it.") ;;; @ Body buffer (obsolete) ;;; ;; (luna-define-generic mime-entity-body-buffer (entity)) ;; (luna-define-generic mime-goto-body-start-point (entity) ;; "Set buffer and point to body-start-position of ENTITY.") ;; (luna-define-generic mime-goto-body-end-point (entity) ;; "Set buffer and point to body-end-position of ENTITY.") ;; (luna-define-generic mime-entity-body-start-point (entity) ;; "Return body-start-position of ENTITY.") ;; (luna-define-generic mime-entity-body-end-point (entity) ;; "Return body-end-position of ENTITY.") ;; (defalias 'mime-entity-body-start 'mime-entity-body-start-point) ;; (defalias 'mime-entity-body-end 'mime-entity-body-end-point) ;; (make-obsolete 'mime-entity-body-buffer "don't use it.") ;; (make-obsolete 'mime-goto-body-start-point "don't use it.") ;; (make-obsolete 'mime-goto-body-end-point "don't use it.") ;; (make-obsolete 'mime-entity-body-start-point "don't use it.") ;; (make-obsolete 'mime-entity-body-end-point "don't use it.") ;; (make-obsolete 'mime-entity-body-start "don't use it.") ;; (make-obsolete 'mime-entity-body-end "don't use it.") ;;; @ Entity buffer (obsolete) ;;; ;; (luna-define-generic mime-entity-buffer (entity)) ;; (make-obsolete 'mime-entity-buffer "don't use it.") ;; (luna-define-generic mime-entity-point-min (entity)) ;; (make-obsolete 'mime-entity-point-min "don't use it.") ;; (luna-define-generic mime-entity-point-max (entity)) ;; (make-obsolete 'mime-entity-point-max "don't use it.") ;;; @ Entity ;;; (luna-define-generic mime-insert-entity (entity) "Insert header and body of ENTITY at point.") (luna-define-generic mime-write-entity (entity filename) "Write header and body of ENTITY into FILENAME.") ;;; @ Entity Body ;;; (luna-define-generic mime-entity-body (entity) "Return network representation of ENTITY body.") (luna-define-generic mime-insert-entity-body (entity) "Insert network representation of ENTITY body at point.") (luna-define-generic mime-write-entity-body (entity filename) "Write body of ENTITY into FILENAME.") ;;; @ Entity Content ;;; (luna-define-generic mime-entity-content (entity) "Return content of ENTITY as byte sequence (string).") (luna-define-generic mime-insert-entity-content (entity) "Insert content of ENTITY at point.") (luna-define-generic mime-write-entity-content (entity filename) "Write content of ENTITY into FILENAME.") (luna-define-generic mime-insert-text-content (entity) "Insert decoded text body of ENTITY.") ;;; @ Header fields ;;; (luna-define-generic mime-entity-fetch-field (entity field-name) "Return the value of the ENTITY's header field whose type is FIELD-NAME.") ;; (defun mime-fetch-field (field-name &optional entity) ;; "Return the value of the ENTITY's header field whose type is FIELD-NAME." ;; (if (symbolp field-name) ;; (setq field-name (symbol-name field-name)) ;; ) ;; (or entity ;; (setq entity mime-message-structure)) ;; (mime-entity-fetch-field entity field-name) ;; ) ;; (make-obsolete 'mime-fetch-field 'mime-entity-fetch-field) (defun mime-entity-content-type (entity) "Return content-type of ENTITY." (or (mime-entity-content-type-internal entity) (let ((ret (mime-entity-fetch-field entity "Content-Type"))) (if ret (mime-entity-set-content-type-internal entity (mime-parse-Content-Type ret)))))) (defun mime-entity-content-disposition (entity) "Return content-disposition of ENTITY." (or (mime-entity-content-disposition-internal entity) (let ((ret (mime-entity-fetch-field entity "Content-Disposition"))) (if ret (mime-entity-set-content-disposition-internal entity (mime-parse-Content-Disposition ret)))))) (defun mime-entity-encoding (entity &optional default-encoding) "Return content-transfer-encoding of ENTITY. If the ENTITY does not have Content-Transfer-Encoding field, this function returns DEFAULT-ENCODING. If it is nil, \"7bit\" is used as default value." (or (mime-entity-encoding-internal entity) (let ((ret (mime-entity-fetch-field entity "Content-Transfer-Encoding"))) (mime-entity-set-encoding-internal entity (or (and ret (mime-parse-Content-Transfer-Encoding ret)) default-encoding "7bit"))))) (defvar mime-field-parser-alist '((Return-Path . std11-parse-route-addr) (Reply-To . std11-parse-addresses) (Sender . std11-parse-mailbox) (From . std11-parse-addresses) (Resent-Reply-To . std11-parse-addresses) (Resent-Sender . std11-parse-mailbox) (Resent-From . std11-parse-addresses) (To . std11-parse-addresses) (Resent-To . std11-parse-addresses) (Cc . std11-parse-addresses) (Resent-Cc . std11-parse-addresses) (Bcc . std11-parse-addresses) (Resent-Bcc . std11-parse-addresses) (Message-Id . mime-parse-msg-id) (Recent-Message-Id . mime-parse-msg-id) (In-Reply-To . std11-parse-msg-ids) (References . std11-parse-msg-ids) (Content-Id . mime-parse-msg-id))) (defun mime-entity-read-field (entity field-name) (let ((sym (if (symbolp field-name) (prog1 field-name (setq field-name (symbol-name field-name))) (intern (capitalize field-name))))) (cond ((eq sym 'Content-Type) (mime-entity-content-type entity)) ((eq sym 'Content-Disposition) (mime-entity-content-disposition entity)) ((eq sym 'Content-Transfer-Encoding) (mime-entity-encoding entity)) (t (let* ((header (mime-entity-parsed-header-internal entity)) (field (cdr (assq sym header)))) (or field (let ((field-body (mime-entity-fetch-field entity field-name)) parser) (when field-body (setq parser (cdr (assq sym mime-field-parser-alist))) (setq field (if parser (funcall parser (eword-lexical-analyze field-body)) (mime-decode-field-body field-body sym 'plain))) (mime-entity-set-parsed-header-internal entity (put-alist sym field header)) field)))))))) ;; (defun mime-read-field (field-name &optional entity) ;; (or entity ;; (setq entity mime-message-structure)) ;; (mime-entity-read-field entity field-name) ;; ) ;; (make-obsolete 'mime-read-field 'mime-entity-read-field) (luna-define-generic mime-insert-header (entity &optional invisible-fields visible-fields) "Insert before point a decoded header of ENTITY.") ;;; @ Entity Attributes ;;; (luna-define-generic mime-entity-name (entity) "Return name of the ENTITY.") (defun mime-entity-uu-filename (entity) (if (member (mime-entity-encoding entity) mime-uuencode-encoding-name-list) (with-temp-buffer (mime-insert-entity-body entity) (if (re-search-forward "^begin [0-9]+ " nil t) (if (looking-at ".+$") (buffer-substring (match-beginning 0)(match-end 0))))))) (defun mime-entity-filename (entity) "Return filename of ENTITY." (or (mime-entity-uu-filename entity) (let ((ret (or (mime-content-disposition-filename (mime-entity-content-disposition entity)) (cdr (let ((param (mime-content-type-parameters (mime-entity-content-type entity)))) (or (assoc "name" param) (assoc "x-name" param))))))) (if ret (eword-decode-string ret) "")))) (defsubst mime-entity-media-type (entity) "Return primary media-type of ENTITY." (mime-content-type-primary-type (mime-entity-content-type entity))) (defsubst mime-entity-media-subtype (entity) "Return media-subtype of ENTITY." (mime-content-type-subtype (mime-entity-content-type entity))) (defsubst mime-entity-parameters (entity) "Return parameters of Content-Type of ENTITY." (mime-content-type-parameters (mime-entity-content-type entity))) (defsubst mime-entity-type/subtype (entity-info) "Return type/subtype of Content-Type of ENTITY." (mime-type/subtype-string (mime-entity-media-type entity-info) (mime-entity-media-subtype entity-info))) (defun mime-entity-set-content-type (entity content-type) "Set ENTITY's content-type to CONTENT-TYPE." (mime-entity-set-content-type-internal entity content-type)) (defun mime-entity-set-encoding (entity encoding) "Set ENTITY's content-transfer-encoding to ENCODING." (mime-entity-set-encoding-internal entity encoding)) ;;; @ end ;;; (provide 'mime) ;;; mime.el ends here wanderlust-flim-2cf5a78/mmbuffer.el000066400000000000000000000271471436773573300174320ustar00rootroot00000000000000;;; mmbuffer.el --- MIME entity module for binary buffer -*- lexical-binding: t -*- ;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mmgeneric) (require 'mime) (eval-and-compile (luna-define-class mime-buffer-entity (mime-entity) (buffer header-start header-end body-start body-end)) (luna-define-internal-accessors 'mime-buffer-entity)) (luna-define-method initialize-instance :after ((entity mime-buffer-entity) &rest _init-args) (or (mime-buffer-entity-buffer-internal entity) (mime-buffer-entity-set-buffer-internal entity (get-buffer (mime-entity-location-internal entity)))) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (let ((header-start (or (mime-buffer-entity-header-start-internal entity) (mime-buffer-entity-set-header-start-internal entity (point-min)))) (header-end (mime-buffer-entity-header-end-internal entity)) (body-start (mime-buffer-entity-body-start-internal entity)) (body-end (or (mime-buffer-entity-body-end-internal entity) (mime-buffer-entity-set-body-end-internal entity (point-max))))) (goto-char header-start) (unless (and header-end body-start) (if (re-search-forward "^$" body-end t) (setq header-end (match-end 0) body-start (if (= header-end body-end) body-end (1+ header-end))) (setq header-end (point-min) body-start (point-min))) (mime-buffer-entity-set-header-end-internal entity header-end) (mime-buffer-entity-set-body-start-internal entity body-start)) (or (mime-entity-content-type-internal entity) (save-restriction (narrow-to-region header-start header-end) (mime-entity-set-content-type-internal entity (let ((str (std11-fetch-field "Content-Type"))) (if str (mime-parse-Content-Type str)))))))) entity) (luna-define-method mime-entity-name ((entity mime-buffer-entity)) (buffer-name (mime-buffer-entity-buffer-internal entity))) ;;; @ entity ;;; (luna-define-method mime-insert-entity ((entity mime-buffer-entity)) (insert-buffer-substring (mime-buffer-entity-buffer-internal entity) (mime-buffer-entity-header-start-internal entity) (mime-buffer-entity-body-end-internal entity))) (luna-define-method mime-write-entity ((entity mime-buffer-entity) filename) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (let ((coding-system-for-write 'raw-text-dos)) (write-region (mime-buffer-entity-header-start-internal entity) (mime-buffer-entity-body-end-internal entity) filename)))) ;;; @ entity header ;;; ;;; @ entity body ;;; (luna-define-method mime-entity-body ((entity mime-buffer-entity)) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (buffer-substring (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity)))) (luna-define-method mime-insert-entity-body ((entity mime-buffer-entity)) (insert-buffer-substring (mime-buffer-entity-buffer-internal entity) (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity))) (luna-define-method mime-write-entity-body ((entity mime-buffer-entity) filename) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (binary-write-decoded-region (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity) filename))) ;;; @ entity content ;;; (luna-define-method mime-entity-content ((entity mime-buffer-entity)) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (mime-decode-string (buffer-substring (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity)) (mime-entity-encoding entity)))) (luna-define-method mime-insert-entity-content ((entity mime-buffer-entity)) (insert (with-current-buffer (mime-buffer-entity-buffer-internal entity) (mime-decode-string (buffer-substring (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity)) (mime-entity-encoding entity))))) (luna-define-method mime-write-entity-content ((entity mime-buffer-entity) filename) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity) filename (or (mime-entity-encoding entity) "7bit")))) ;;; @ header field ;;; (luna-define-method mime-entity-fetch-field :around ((entity mime-buffer-entity) field-name) (or (luna-call-next-method) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (save-restriction (narrow-to-region (mime-buffer-entity-header-start-internal entity) (mime-buffer-entity-header-end-internal entity)) (let ((ret (std11-fetch-field field-name))) (when ret (or (symbolp field-name) (setq field-name (intern (capitalize field-name)))) (mime-entity-set-original-header-internal entity (put-alist field-name ret (mime-entity-original-header-internal entity))) ret)))))) (luna-define-method mime-insert-header ((entity mime-buffer-entity) &optional invisible-fields visible-fields) (mime-insert-header-from-buffer (mime-buffer-entity-buffer-internal entity) (mime-buffer-entity-header-start-internal entity) (mime-buffer-entity-header-end-internal entity) invisible-fields visible-fields)) ;;; @ header buffer ;;; ;; (luna-define-method mime-entity-header-buffer ((entity mime-buffer-entity)) ;; (mime-buffer-entity-buffer-internal entity) ;; ) ;; (luna-define-method mime-goto-header-start-point ((entity mime-buffer-entity)) ;; (set-buffer (mime-buffer-entity-buffer-internal entity)) ;; (goto-char (mime-buffer-entity-header-start-internal entity)) ;; ) ;; (luna-define-method mime-entity-header-start-point ((entity ;; mime-buffer-entity)) ;; (mime-buffer-entity-header-start-internal entity) ;; ) ;; (luna-define-method mime-entity-header-end-point ((entity ;; mime-buffer-entity)) ;; (mime-buffer-entity-header-end-internal entity) ;; ) ;;; @ body buffer ;;; ;; (luna-define-method mime-entity-body-buffer ((entity mime-buffer-entity)) ;; (mime-buffer-entity-buffer-internal entity) ;; ) ;; (luna-define-method mime-goto-body-start-point ((entity mime-buffer-entity)) ;; (set-buffer (mime-buffer-entity-buffer-internal entity)) ;; (goto-char (mime-buffer-entity-body-start-internal entity)) ;; ) ;; (luna-define-method mime-goto-body-end-point ((entity mime-buffer-entity)) ;; (set-buffer (mime-buffer-entity-buffer-internal entity)) ;; (goto-char (mime-buffer-entity-body-end-internal entity)) ;; ) ;; (luna-define-method mime-entity-body-start-point ((entity mime-buffer-entity)) ;; (mime-buffer-entity-body-start-internal entity) ;; ) ;; (luna-define-method mime-entity-body-end-point ((entity mime-buffer-entity)) ;; (mime-buffer-entity-body-end-internal entity) ;; ) ;;; @ buffer (obsolete) ;;; ;; (luna-define-method mime-entity-buffer ((entity mime-buffer-entity)) ;; (mime-buffer-entity-buffer-internal entity) ;; ) ;; (luna-define-method mime-entity-point-min ((entity mime-buffer-entity)) ;; (mime-buffer-entity-header-start-internal entity) ;; ) ;; (luna-define-method mime-entity-point-max ((entity mime-buffer-entity)) ;; (mime-buffer-entity-body-end-internal entity) ;; ) ;;; @ children ;;; (defun mmbuffer-parse-multipart (entity &optional representation-type) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (or representation-type (setq representation-type (mime-entity-representation-type-internal entity))) (let* ((content-type (mime-entity-content-type-internal entity)) (dash-boundary (concat "--" (mime-content-type-parameter content-type "boundary"))) (delimiter (concat "\n" (regexp-quote dash-boundary))) (close-delimiter (concat delimiter "--[ \t]*$")) (rsep (concat delimiter "[ \t]*\n")) (dc-ctl (if (eq (mime-content-type-subtype content-type) 'digest) (make-mime-content-type 'message 'rfc822) (make-mime-content-type 'text 'plain))) (body-start (mime-buffer-entity-body-start-internal entity)) (body-end (mime-buffer-entity-body-end-internal entity))) (save-restriction (goto-char body-end) (narrow-to-region body-start (if (re-search-backward close-delimiter nil t) (match-beginning 0) body-end)) (goto-char body-start) (if (re-search-forward (concat "^" (regexp-quote dash-boundary) "[ \t]*\n") nil t) (let ((cb (match-end 0)) ce ncb ret children (node-id (mime-entity-node-id-internal entity)) (i 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 representation-type dc-ctl entity (cons i node-id)))) (setq children (cons ret children)) (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 representation-type dc-ctl entity (cons i node-id)))) (setq children (cons ret children)) (mime-entity-set-children-internal entity (nreverse children))) (mime-entity-set-content-type-internal entity (make-mime-content-type 'message 'x-broken)) nil))))) (defun mmbuffer-parse-encapsulated (entity &optional external representation-type) (mime-entity-set-children-internal entity (with-current-buffer (mime-buffer-entity-buffer-internal entity) (save-restriction (narrow-to-region (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity)) (list (mime-parse-message (if external (progn (require 'mmexternal) 'mime-external-entity) (or representation-type (mime-entity-representation-type-internal entity))) nil entity (cons 0 (mime-entity-node-id-internal entity)))))))) (luna-define-method mime-entity-children ((entity mime-buffer-entity)) (let* ((content-type (mime-entity-content-type entity)) (primary-type (mime-content-type-primary-type content-type)) sub-type) (cond ((eq primary-type 'multipart) (mmbuffer-parse-multipart entity)) ((eq primary-type 'message) (setq sub-type (mime-content-type-subtype content-type)) (cond ((eq sub-type 'external-body) (mmbuffer-parse-encapsulated entity 'external)) ((memq sub-type '(rfc822 news)) (mmbuffer-parse-encapsulated entity))))))) ;;; @ end ;;; (provide 'mmbuffer) ;;; mmbuffer.el ends here wanderlust-flim-2cf5a78/mmcooked.el000066400000000000000000000056451436773573300174240ustar00rootroot00000000000000;;; mmcooked.el --- MIME entity implementation for binary buffer -*- lexical-binding: t -*- ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mmbuffer) (mm-define-backend cooked (buffer)) (mm-define-method entity-cooked-p ((_entity cooked)) t) (mm-define-method write-entity-content ((entity cooked) filename) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (let ((encoding (or (mime-entity-encoding entity) "7bit"))) (if (member encoding '("7bit" "8bit" "binary")) (write-region (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity) filename) (mime-write-decoded-region (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity) filename encoding))))) (mm-define-method write-entity ((entity cooked) filename) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (write-region (mime-buffer-entity-header-start-internal entity) (mime-buffer-entity-body-end-internal entity) filename))) (mm-define-method write-entity-body ((entity cooked) filename) (with-current-buffer (mime-buffer-entity-buffer-internal entity) (write-region (mime-buffer-entity-body-start-internal entity) (mime-buffer-entity-body-end-internal entity) filename))) (luna-define-method mime-insert-header ((entity mime-cooked-entity) &optional invisible-fields visible-fields) (let (default-mime-charset) (funcall (car (luna-class-find-functions (luna-find-class 'mime-buffer-entity) 'mime-insert-header)) entity invisible-fields visible-fields))) (mm-define-method insert-text-content ((entity cooked)) (let ((str (mime-entity-content entity))) (insert (if (member (mime-entity-encoding entity) '(nil "7bit" "8bit" "binary")) str (decode-mime-charset-string str (or (mime-content-type-parameter (mime-entity-content-type entity) "charset") default-mime-charset) 'CRLF))))) ;;; @ end ;;; (provide 'mmcooked) ;;; mmcooked.el ends here wanderlust-flim-2cf5a78/mmexternal.el000066400000000000000000000135141436773573300177740ustar00rootroot00000000000000;;; mmexternal.el --- MIME entity module for external buffer -*- lexical-binding: t -*- ;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mmgeneric) (require 'mime) (eval-and-compile (luna-define-class mime-external-entity (mime-entity) (body-buffer body-file)) (luna-define-internal-accessors 'mime-external-entity) ;; In an external entity, information of media-type or other ;; information which are represented in a header in a non-external ;; entity are in the body of the parent entity. ) (luna-define-method mime-entity-name ((entity mime-external-entity)) (concat "child of " (mime-entity-name (mime-entity-parent-internal entity)))) (defun mmexternal-require-file-name (entity) (condition-case nil (or (mime-external-entity-body-file-internal entity) (let* ((ct (mime-entity-content-type (mime-entity-parent-internal entity))) (access-type (mime-content-type-parameter ct "access-type"))) (if (and access-type (string= access-type "anon-ftp")) (let ((site (mime-content-type-parameter ct "site")) (directory (mime-content-type-parameter ct "directory")) (name (mime-content-type-parameter ct "name"))) (mime-external-entity-set-body-file-internal entity (expand-file-name name (concat "/anonymous@" site ":" (file-name-as-directory directory)))))))) (error (message "Can't make file-name of external-body.")))) (defun mmexternal-require-buffer (entity) (unless (and (mime-external-entity-body-buffer-internal entity) (buffer-live-p (mime-external-entity-body-buffer-internal entity))) (condition-case nil (progn (mmexternal-require-file-name entity) (mime-external-entity-set-body-buffer-internal entity (with-current-buffer (get-buffer-create (concat " *Body of " (mime-entity-name entity) "*")) (binary-insert-encoded-file (mime-external-entity-body-file-internal entity)) (current-buffer)))) (error (message "Can't get external-body."))))) ;;; @ entity ;;; (luna-define-method mime-insert-entity ((entity mime-external-entity)) (mime-insert-entity-body (mime-entity-parent-internal entity)) (insert "\n") (mime-insert-entity-body entity)) (luna-define-method mime-write-entity ((entity mime-external-entity) filename) (with-temp-buffer (mime-insert-entity entity) (let ((coding-system-for-write 'raw-text-dos)) (write-region (point-min) (point-max) filename)))) ;;; @ entity header ;;; ;;; @ entity body ;;; (luna-define-method mime-entity-body ((entity mime-external-entity)) (mmexternal-require-buffer entity) (with-current-buffer (mime-external-entity-body-buffer-internal entity) (buffer-string))) (luna-define-method mime-insert-entity-body ((entity mime-external-entity)) (mmexternal-require-buffer entity) (insert-buffer-substring (mime-external-entity-body-buffer-internal entity))) (luna-define-method mime-write-entity-body ((entity mime-external-entity) filename) (mmexternal-require-buffer entity) (with-current-buffer (mime-external-entity-body-buffer-internal entity) (binary-write-decoded-region (point-min) (point-max) filename))) ;;; @ entity content ;;; (luna-define-method mime-entity-content ((entity mime-external-entity)) (let ((ret (mime-entity-body entity))) (if ret (mime-decode-string ret (mime-entity-encoding entity)) (message "Cannot get content") nil))) (luna-define-method mime-insert-entity-content ((entity mime-external-entity)) (insert (mime-entity-content entity))) (luna-define-method mime-write-entity-content ((entity mime-external-entity) filename) (mmexternal-require-buffer entity) (with-current-buffer (mime-external-entity-body-buffer-internal entity) (mime-write-decoded-region (point-min) (point-max) filename (or (mime-entity-encoding entity) "7bit")))) ;;; @ header field ;;; (luna-define-method mime-entity-fetch-field :around ((entity mime-external-entity) field-name) (or (luna-call-next-method) (with-temp-buffer (mime-insert-entity-body (mime-entity-parent-internal entity)) (let ((ret (std11-fetch-field field-name))) (when ret (or (symbolp field-name) (setq field-name (intern (capitalize field-name)))) (mime-entity-set-original-header-internal entity (put-alist field-name ret (mime-entity-original-header-internal entity))) ret))))) (luna-define-method mime-insert-header ((entity mime-external-entity) &optional invisible-fields visible-fields) (let ((the-buf (current-buffer)) buf p-min p-max) (with-temp-buffer (mime-insert-entity-body (mime-entity-parent-internal entity)) (setq buf (current-buffer) p-min (point-min) p-max (point-max)) (set-buffer the-buf) (mime-insert-header-from-buffer buf p-min p-max invisible-fields visible-fields)))) ;;; @ end ;;; (provide 'mmexternal) ;;; mmexternal.el ends here wanderlust-flim-2cf5a78/mmgeneric.el000066400000000000000000000115261436773573300175670ustar00rootroot00000000000000;;; mmgeneric.el --- MIME generic entity module -*- lexical-binding: t -*- ;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: definition, MIME, multimedia, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'mcharset) (require 'std11) (require 'luna) (require 'eword-decode) ;;; @ MIME entity ;;; (autoload 'mime-entity-content-type "mime") (autoload 'mime-parse-multipart "mime-parse") (autoload 'mime-parse-message "mime-parse") ;; (autoload 'mime-parse-encapsulated "mime-parse") ;; (autoload 'mime-parse-external "mime-parse") (autoload 'mime-entity-content "mime") (eval-and-compile (luna-define-class mime-entity () (location content-type children parent node-id content-disposition encoding ;; for other fields original-header parsed-header)) (luna-define-internal-accessors 'mime-entity)) (defalias 'mime-entity-representation-type-internal 'luna-class-name) (defalias 'mime-entity-set-representation-type-internal 'luna-set-class-name) (luna-define-method mime-entity-fetch-field ((entity mime-entity) field-name) (or (symbolp field-name) (setq field-name (intern (capitalize field-name)))) (cdr (assq field-name (mime-entity-original-header-internal entity)))) (luna-define-method mime-insert-text-content ((entity mime-entity)) (insert (decode-mime-charset-string (mime-entity-content entity) (or (mime-content-type-parameter (mime-entity-content-type entity) "charset") default-mime-charset) 'CRLF))) ;;; @ for mm-backend ;;; (defmacro mm-expand-class-name (type) `(intern (format "mime-%s-entity" ,type))) (defmacro mm-define-backend (type &optional parents) `(luna-define-class ,(mm-expand-class-name type) ,(nconc (mapcar (lambda (parent) (mm-expand-class-name parent)) parents) '(mime-entity)))) (defmacro mm-define-method (name args &rest body) (or (eq name 'initialize-instance) (setq name (intern (format "mime-%s" name)))) (let ((spec (car args))) (setq args (cons (list (car spec) (mm-expand-class-name (nth 1 spec))) (cdr args))) `(luna-define-method ,name ,args ,@body))) (put 'mm-define-method 'lisp-indent-function 'defun) (def-edebug-spec mm-define-method (&define name ((arg symbolp) [&rest arg] [&optional ["&optional" arg &rest arg]] &optional ["&rest" arg]) def-body)) ;;; @ header filter ;;; ;; [tomo] We should think about specification of better filtering ;; mechanism. Please discuss in the emacs-mime mailing lists. (defun mime-visible-field-p (field-name visible-fields invisible-fields) (let ((case-fold-search t)) (catch 'found (while visible-fields (when (string-match (car visible-fields) field-name) (throw 'found t)) (setq visible-fields (cdr visible-fields))) (while invisible-fields (when (string-match (car invisible-fields) field-name) (throw 'found nil)) (setq invisible-fields (cdr invisible-fields))) t))) (defun mime-insert-header-from-buffer (buffer start end &optional invisible-fields visible-fields) (let ((mode-obj (mime-find-field-presentation-method 'wide)) field-decoder f-b p field-name field-body result) (with-current-buffer buffer (goto-char start) (while (re-search-forward std11-field-head-regexp end t) (setq f-b (match-beginning 0) p (match-end 0) field-name (buffer-substring f-b p)) (when (mime-visible-field-p field-name visible-fields invisible-fields) (setq field-body (buffer-substring p (std11-field-end end)) field-decoder (mime-find-field-decoder-internal (intern (capitalize (buffer-substring-no-properties f-b (1- p)))) mode-obj) result (cons "\n" (cons (if field-decoder (funcall field-decoder field-body (string-width field-name)) ;; Don't decode field-body) (cons field-name result))))))) (when result (apply #'insert (nreverse result))))) ;;; @ end ;;; (provide 'mmgeneric) ;;; mmgeneric.el ends here wanderlust-flim-2cf5a78/qmtp.el000066400000000000000000000101131436773573300165710ustar00rootroot00000000000000;;; qmtp.el --- basic functions to send mail with QMTP server -*- lexical-binding: t -*- ;; Copyright (C) 2000 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Keywords: QMTP, qmail ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Installation: ;; To send mail using QMTP instead of SMTP, do ;; (fset 'smtp-send-buffer 'qmtp-send-buffer) ;;; Code: (require 'custom) (require 'mel) ; binary-funcall (defgroup qmtp nil "QMTP protocol for sending mail." :group 'mail) (defcustom qmtp-default-server nil "Specify default QMTP server." :type '(choice (const nil) string) :group 'qmtp) (defvar qmtp-server qmtp-default-server "The name of the host running QMTP server. It can also be a function called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.") (defcustom qmtp-service "qmtp" "QMTP service port number. \"qmtp\" or 209." :type '(choice (integer :tag "209" 209) (string :tag "qmtp" "qmtp")) :group 'qmtp) (defcustom qmtp-timeout 30 "Timeout for each QMTP session." :type 'integer :group 'qmtp) ;;;###autoload (defvar qmtp-open-connection-function (function open-network-stream)) (defvar qmtp-error-response-alist '((?Z "Temporary failure") (?D "Permanent failure"))) (defvar qmtp-read-point nil) (defun qmtp-encode-netstring-string (string) (format "%d:%s," (length string) string)) (defun qmtp-send-package (process sender recipients buffer) (with-temp-buffer (buffer-disable-undo) (erase-buffer) (set-buffer-multibyte nil) (insert (format "%d:\n" (with-current-buffer buffer (1+ (point-max));; for the "\n" ))) (insert-buffer-substring buffer) (insert "\n," (qmtp-encode-netstring-string sender) (qmtp-encode-netstring-string (mapconcat #'qmtp-encode-netstring-string recipients ""))) (process-send-region process (point-min)(point-max))) (goto-char qmtp-read-point) (while (and (memq (process-status process) '(open run)) (not (re-search-forward "^[0-9]+:" nil 'noerror))) (unless (accept-process-output process qmtp-timeout) (error "timeout expired: %d" qmtp-timeout)) (goto-char qmtp-read-point)) (let ((response (char-after (match-end 0)))) (unless (eq response ?K) (error (nth 1 (assq response qmtp-error-response-alist)))) (setq recipients (cdr recipients)) (beginning-of-line 2) (setq qmtp-read-point (point)))) ;;;###autoload (defun qmtp-via-qmtp (sender recipients buffer) (condition-case nil (progn (qmtp-send-buffer sender recipients buffer) t) (error))) (make-obsolete 'qmtp-via-qmtp "It's old API." "05 Nov 2000") ;;;###autoload (defun qmtp-send-buffer (sender recipients buffer) (with-current-buffer (get-buffer-create (format "*trace of QMTP session to %s*" qmtp-server)) (buffer-disable-undo) (erase-buffer) (make-local-variable 'qmtp-read-point) (setq qmtp-read-point (point-min)) (let (process) (unwind-protect (progn (setq process (binary-funcall qmtp-open-connection-function "QMTP" (current-buffer) qmtp-server qmtp-service)) (qmtp-send-package process sender recipients buffer)) (when (and process (memq (process-status process) '(open run))) ;; QUIT (process-send-eof process) (delete-process process)))))) (provide 'qmtp) ;;; qmtp.el ends here wanderlust-flim-2cf5a78/sasl-scram.el000066400000000000000000000213121436773573300176600ustar00rootroot00000000000000;;; sasl-scram.el --- Compute SCRAM-MD5. -*- lexical-binding: t -*- ;; Copyright (C) 1999 Shuhei KOBAYASHI ;; Author: Shuhei KOBAYASHI ;; Kenichi OKADA ;; Keywords: SCRAM-MD5, HMAC-MD5, SASL, IMAP, POP, ACAP ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This program is implemented from draft-newman-auth-scram-03.txt. ;; ;; It is caller's responsibility to base64-decode challenges and ;; base64-encode responses in IMAP4 AUTHENTICATE command. ;; ;; Passphrase should be longer than 16 bytes. (See RFC 2195) ;; Examples. ;; ;; (sasl-scram-md5-make-security-info nil t 0) ;; => "^A^@^@^@" ;; ;; (base64-encode-string ;; (sasl-scram-md5-make-client-msg-2 ;; (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3") ;; (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==") ;; (sasl-scram-md5-make-salted-pass ;; "secret stuff" "testsalt") ;; (sasl-scram-md5-make-security-info nil t 0))) ;; => "AQAAAMg9jU8CeB4KOfk7sUhSQPs=" ;; ;; (base64-encode-string ;; (sasl-scram-md5-make-server-msg-2 ;; (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3") ;; (base64-decode-string "AGNocmlzADx0NG40UGFiOUhCMEFtL1FMWEI3MmVnQGVsZWFub3IuaW5ub3NvZnQuY29tPg==") ;; (sasl-scram-md5-make-security-info nil t 0) ;; "testsalt" ;; (sasl-scram-md5-make-salted-pass ;; "secret stuff" "testsalt"))) ;; => "U0odqYw3B7XIIW0oSz65OQ==" ;;; Code: (require 'sasl) (require 'hmac-md5) (defvar sasl-scram-md5-unique-id-function sasl-unique-id-function) (defconst sasl-scram-md5-steps '(ignore ;no initial response sasl-scram-md5-response-1 sasl-scram-md5-response-2 sasl-scram-md5-authenticate-server)) (defmacro sasl-scram-md5-security-info-no-security-layer (security-info) `(eq (logand (aref ,security-info 0) 1) 1)) (defmacro sasl-scram-md5-security-info-integrity-protection-layer (security-info) `(eq (logand (aref ,security-info 0) 2) 2)) (defmacro sasl-scram-md5-security-info-buffer-size (security-info) `(let ((ssecinfo ,security-info)) (+ (lsh (aref ssecinfo 1) 16) (lsh (aref ssecinfo 2) 8) (aref ssecinfo 3)))) (defun sasl-scram-md5-make-security-info (integrity-protection-layer no-security-layer buffer-size) (let ((csecinfo (make-string 4 0))) (when integrity-protection-layer (aset csecinfo 0 2)) (if no-security-layer (aset csecinfo 0 (logior (aref csecinfo 0) 1)) (aset csecinfo 1 (ash (logand buffer-size (ash 255 16)) -16)) (aset csecinfo 2 (ash (logand buffer-size (ash 255 8)) -8)) (aset csecinfo 3 (logand buffer-size 255))) csecinfo)) (defun sasl-scram-md5-make-unique-nonce () ; 8*OCTET, globally unique. ;; For example, concatenated string of process-identifier, system-clock, ;; sequence-number, random-number, and domain-name. (let* ((sasl-unique-id-function sasl-scram-md5-unique-id-function) (id (sasl-unique-id))) (unwind-protect (concat "<" id "@" (system-name) ">") (fillarray id 0)))) (defun sasl-scram-md5-xor-string (str1 str2) ;; (length str1) == (length str2) == (length dst) == 16 (in SCRAM-MD5) (let* ((len (length str1)) (dst (make-string len 0)) (pos 0)) (while (< pos len) (aset dst pos (logxor (aref str1 pos) (aref str2 pos))) (setq pos (1+ pos))) dst)) (defun sasl-scram-md5-make-client-msg-1 (authenticate-id &optional authorize-id nonce) "Make an initial client message from AUTHENTICATE-ID and AUTHORIZE-ID. If AUTHORIZE-ID is the same as AUTHENTICATE-ID, it may be omitted." (concat authorize-id "\0" authenticate-id "\0" (or nonce (sasl-scram-md5-make-unique-nonce)))) (defun sasl-scram-md5-parse-server-msg-1 (server-msg-1) "Parse SERVER-MSG-1 and return a list of (SALT SECURITY-INFO SERVICE-ID)." (if (and (> (length server-msg-1) 16) (eq (string-match "[^@]+@[^\0]+\0" server-msg-1 12) 12)) (list (substring server-msg-1 0 8) ; salt (substring server-msg-1 8 12) ; server-security-info (substring server-msg-1 ; service-id 12 (1- (match-end 0)))) (sasl-error (format "Unexpected response: %s" server-msg-1)))) (defun sasl-scram-md5-server-salt (server-msg-1) (car (sasl-scram-md5-parse-server-msg-1 server-msg-1))) (defun sasl-scram-md5-make-salted-pass (passphrase salt) (hmac-md5 salt passphrase)) (defun sasl-scram-md5-make-client-key (salted-pass) (md5-binary salted-pass)) (defun sasl-scram-md5-make-client-verifier (client-key) (md5-binary client-key)) (defun sasl-scram-md5-make-shared-key (server-msg-1 client-msg-1 client-security-info client-verifier) (let (buff) (unwind-protect (hmac-md5 (setq buff (concat server-msg-1 client-msg-1 client-security-info)) client-verifier) (fillarray buff 0)))) (defun sasl-scram-md5-make-client-proof (client-key shared-key) (sasl-scram-md5-xor-string client-key shared-key)) (defun sasl-scram-md5-make-client-msg-2 (server-msg-1 client-msg-1 salted-pass client-security-info) (let (client-proof client-key shared-key client-verifier) (setq client-key (sasl-scram-md5-make-client-key salted-pass)) (setq client-verifier (sasl-scram-md5-make-client-verifier client-key)) (setq shared-key (unwind-protect (sasl-scram-md5-make-shared-key server-msg-1 client-msg-1 client-security-info client-verifier) (fillarray client-verifier 0))) (setq client-proof (unwind-protect (sasl-scram-md5-make-client-proof client-key shared-key) (fillarray client-key 0) (fillarray shared-key 0))) (unwind-protect (concat client-security-info client-proof) (fillarray client-proof 0)))) (defun sasl-scram-md5-make-server-msg-2 (server-msg-1 client-msg-1 client-security-info salt salted-pass) (let ((server-salt (hmac-md5 salt salted-pass)) buff) (unwind-protect (hmac-md5 (setq buff (concat client-msg-1 server-msg-1 client-security-info)) server-salt) (fillarray server-salt 0) (fillarray buff 0)))) (defun sasl-scram-md5-response-1 (client _step) (sasl-client-set-property client 'client-msg-1 (sasl-scram-md5-make-client-msg-1 (sasl-client-name client) (sasl-client-property client 'authorize-id) (sasl-client-property client 'nonce)))) (defun sasl-scram-md5-response-2 (client step) (let* ((server-msg-1 (sasl-client-set-property client 'server-msg-1 (sasl-step-data step))) (salted-pass (sasl-client-set-property client 'salted-pass (sasl-scram-md5-make-salted-pass (sasl-read-passphrase (format "SCRAM-MD5 passphrase for %s: " (sasl-client-name client))) (sasl-scram-md5-server-salt server-msg-1))))) (sasl-client-set-property client 'client-msg-2 (sasl-scram-md5-make-client-msg-2 server-msg-1 (sasl-client-property client 'client-msg-1) salted-pass (or (sasl-client-property client 'client-security-info) (sasl-scram-md5-make-security-info nil t 0)))))) (defun sasl-scram-md5-authenticate-server (client step) (let ((server-msg-2 (sasl-client-set-property client 'server-msg-2 (sasl-step-data step))) (server-msg-1 (sasl-client-property client 'server-msg-1))) (if (string= server-msg-2 (sasl-scram-md5-make-server-msg-2 server-msg-1 (sasl-client-property client 'client-msg-1) (or (sasl-client-property client 'client-security-info) (sasl-scram-md5-make-security-info nil t 0)) (sasl-scram-md5-server-salt server-msg-1) (sasl-client-property client 'salted-pass))) " " (sasl-error "SCRAM-MD5: authenticate server failed.")))) (put 'sasl-scram 'sasl-mechanism (sasl-make-mechanism "SCRAM-MD5" sasl-scram-md5-steps)) (provide 'sasl-scram) ;;; sasl-scram.el ends here wanderlust-flim-2cf5a78/sasl-xoauth2.el000066400000000000000000000226021436773573300201500ustar00rootroot00000000000000;;; sasl-xoauth2.el --- OAuth 2.0 module for the SASL client framework -*- lexical-binding: t -*- ;; Copyright (C) 2018 Kazuhiro Ito ;; Author: Kazuhiro Ito ;; Keywords: SASL, OAuth 2.0 ;; Version: 1.00 ;; Created: January 2018 ;; 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 3, 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This is a SASL interface layer for OAuth 2.0 authorization message. ;;; Requirements: ;; ;; * oauth2.el ;; https://elpa.gnu.org/packages/oauth2.html ;;; Usage ;; ;; 1. Set up sasl-xoauth2-host-url-table and ;; sasl-xoauth2-host-user-id-table variables. ;; ;; 2. When passphrase is asked, input client secret. ;;; Code: (require 'sasl) (require 'oauth2) (defconst sasl-xoauth2-steps '(sasl-xoauth2-response)) (defgroup sasl-xoauth2 nil "SASL interface layer for OAuth 2.0 authorization message." :group 'mail) (defcustom sasl-xoauth2-token-directory (expand-file-name "sasl-xoauth2" user-emacs-directory) "Directory name to store OAuth 2.0 tokens." :type 'directory :group 'sasl-xoauth2) (defcustom sasl-xoauth2-refresh-token-threshold 60 "Refresh token if expiration limit is left less than specified seconds." :type 'number :group 'sasl-xoauth2) (defcustom sasl-xoauth2-host-url-table '(;; Gmail ("\\.gmail\\.com$" "https://accounts.google.com/o/oauth2/v2/auth" "https://www.googleapis.com/oauth2/v4/token" "https://mail.google.com/" ;; redirect URI is required "http://localhost/result") ;; Outlook.com ("\\.outlook\\.com$" "https://login.live.com/oauth20_authorize.srf" "https://login.live.com/oauth20_token.srf" "wl.offline_access wl.imap" ;; You need register redirect URL at Application Registration Portal ;; https://apps.dev.microsoft.com/ "http://localhost/result") ;; office365 ("\\.office365\\.com$" "https://login.microsoftonline.com/common/oauth2/v2.0/authorize" "https://login.microsoftonline.com/common/oauth2/v2.0/token" "https://outlook.office365.com/IMAP.AccessAsUser.All https://outlook.office365.com/POP.AccessAsUser.All https://outlook.office365.com/SMTP.Send offline_access" nil) ;; yahoo.com ("\\.yahoo\\.com$" "https://api.login.yahoo.com/oauth2/request_auth" "https://api.login.yahoo.com/oauth2/get_token" "mail-w" nil) ;; aol.com ("\\.aol\\.com$" "https://api.login.aol.com/oauth2/request_auth" "https://api.login.aol.com/oauth2/get_token" "mail-w" nil)) "List of OAuth 2.0 URLs. Each element of list is regexp for host, auth-url, token-url, scope and redirect-uri (optional)." :type '(repeat (list (regexp :tag "Regexp for Host") (string :tag "Auth-URL") (string :tag "Token-URL") (string :tag "Scope") (choice string (const :tag "none" nil)))) :group 'sasl-xoauth2) (defcustom sasl-xoauth2-host-user-id-table nil "List of OAuth 2.0 Client IDs. Each element of list is regexp for host, regexp for User ID, client ID and client secret (optional). " :type '(repeat (list (regexp :tag "Regexp for Host") (regexp :tag "Regexp for User ID") (string :tag "Client ID") (choice :tag "Client Secret" string (const :tag "none" nil)))) :group 'sasl-xoauth2) ;; This advice makes oauth2.el to keep the time of getting token. (defadvice oauth2-make-access-request (after sasl-xoauth2 disable) (setq ad-return-value (cons `(auth_time . ,(current-time)) ad-return-value))) ;; Modified version of oauth2-refresh-access. It keeps refreshed time ;; and updates expires_in parameter. (defun sasl-xoauth2-refresh-access (token) "Refresh OAuth access TOKEN. TOKEN should be obtained with `oauth2-request-access'." ;; url package would fail on Windows without EOL conversion. (let* ((inhibit-eol-conversion nil) (coding-system-for-read nil) (response (oauth2-make-access-request (oauth2-token-token-url token) (concat "client_id=" (oauth2-token-client-id token) "&client_secret=" (oauth2-token-client-secret token) "&refresh_token=" (oauth2-token-refresh-token token) "&grant_type=refresh_token")))) (setf (oauth2-token-access-token token) (cdr (assq 'access_token response))) ;; Update authorization time. (setcdr (assq 'auth_time (oauth2-token-access-response token)) (current-time)) ;; Update expires_in parameter. (cond ((and (assq 'expires_in (oauth2-token-access-response token)) (assq 'expires_in response)) (setcdr (assq 'expires_in (oauth2-token-access-response token)) (cdr (assq 'expires_in response)))) ((assq 'expires_in (oauth2-token-access-response token)) (let ((list (memq (assq 'expires_in (oauth2-token-access-response token)) (oauth2-token-access-response token)))) (setcdr list (cdr list)))) ((assq 'expires_in response) (setf (oauth2-token-access-response token) (cons (assq 'expires_in response) (oauth2-token-access-response token)))))) ;; If the token has a plstore, update it (let ((plstore (oauth2-token-plstore token))) (when plstore (plstore-put plstore (oauth2-token-plstore-id token) nil `(:access-token ,(oauth2-token-access-token token) :refresh-token ,(oauth2-token-refresh-token token) :access-response ,(oauth2-token-access-response token))) (plstore-save plstore))) token) (defun sasl-xoauth2-resolve-urls (host user) (let (auth-url token-url client-id scope redirect-uri client-secret) (let ((table sasl-xoauth2-host-url-table)) (while table (when (string-match (caar table) host) (setq auth-url (nth 1 (car table)) token-url (nth 2 (car table)) scope (nth 3 (car table)) redirect-uri (nth 4 (car table)) table nil)) (setq table (cdr table)))) (let ((table sasl-xoauth2-host-user-id-table)) (while table (when (and (string-match (caar table) host) (string-match (nth 1 (car table)) user)) (setq client-id (nth 2 (car table)) client-secret (nth 3 (car table)) table nil)) (setq table (cdr table)))) (list auth-url token-url scope client-id client-secret redirect-uri))) (defun sasl-xoauth2-token-expired-p (token) (let ((access-response (oauth2-token-access-response token))) (or (null (assq 'expires_in access-response)) (time-less-p (time-add (cdr (assq 'auth_time access-response)) (cdr (assq 'expires_in access-response))) (time-add (current-time) (- sasl-xoauth2-refresh-token-threshold)))))) (defun sasl-xoauth2-response (client _step &optional _retry) (let ((host (sasl-client-server client)) (user (sasl-client-name client)) ;; url package would fail on Windows without EOL conversion. (inhibit-eol-conversion nil) (coding-system-for-read nil) info access-token oauth2-token auth-url token-url client-id scope redirect-uri client-secret) (setq info (sasl-xoauth2-resolve-urls host user) auth-url (or (car info) (read-string (format "Input OAuth 2.0 AUTH-URL for %s: " host))) token-url (or (nth 1 info) (read-string (format "Input OAuth 2.0 TOKEN-URL for %s: " host))) scope (or (nth 2 info) (read-string (format "Input OAuth 2.0 SCOPE for %s: " host))) client-id (or (nth 3 info) (read-string (format "Input OAuth 2.0 CLIENT-ID for %s@%s: " user host) user nil user)) client-secret (or (nth 4 info) (sasl-read-passphrase (format "Input Oauth 2.0 CLIENT-SECRET for %s@%s: " user host))) redirect-uri (or (nth 5 info) ;; Do not ask when sasl-xoauth2-host-url-table is ;; matched. (unless (car info) (read-string (format "Input OAuth 2.0 Redirect-URI for %s: " host))))) (setq oauth2-token (let ((oauth2-token-file (expand-file-name (concat (md5 (concat client-id client-secret (sasl-client-name client))) ".plstore") sasl-xoauth2-token-directory))) (ad-enable-advice 'oauth2-make-access-request 'after 'sasl-xoauth2) (ad-activate 'oauth2-make-access-request) (prog1 (oauth2-auth-and-store auth-url token-url scope client-id client-secret redirect-uri) (ad-disable-advice 'oauth2-make-access-request 'after 'sasl-xoauth2) (ad-activate 'oauth2-make-access-request)))) (when (sasl-xoauth2-token-expired-p oauth2-token) (setq oauth2-token (sasl-xoauth2-refresh-access oauth2-token))) (setq access-token (oauth2-token-access-token oauth2-token)) (format "user=%s\001auth=Bearer %s\001\001" (sasl-client-name client) access-token))) (put 'sasl-xoauth2 'sasl-mechanism (sasl-make-mechanism "XOAUTH2" sasl-xoauth2-steps)) (provide 'sasl-xoauth2) ;;; sasl-xoauth2.el ends here wanderlust-flim-2cf5a78/sasl.el000066400000000000000000000214041436773573300165570ustar00rootroot00000000000000;;; sasl.el --- SASL client framework -*- lexical-binding: t -*- ;; Copyright (C) 2000 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Keywords: SASL ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module provides common interface functions to share several ;; SASL mechanism drivers. The toplevel is designed to be mostly ;; compatible with [Java-SASL]. ;; ;; [SASL] J. Myers, "Simple Authentication and Security Layer (SASL)", ;; RFC 2222, October 1997. ;; ;; [Java-SASL] R. Weltman & R. Lee, "The Java SASL Application Program ;; Interface", draft-weltman-java-sasl-03.txt, March 2000. ;;; Code: (defvar sasl-additional-mechanism-alist '((sasl-scram-rfc "SCRAM-SHA-1") (sasl-scram-sha256 "SCRAM-SHA-256"))) (defvar sasl-mechanism-alist (append '(("CRAM-MD5" sasl-cram) ("DIGEST-MD5" sasl-digest) ("PLAIN" sasl-plain) ("LOGIN" sasl-login) ("ANONYMOUS" sasl-anonymous) ("NTLM" sasl-ntlm) ("SCRAM-MD5" sasl-scram) ("OAUTHBEARER" sasl-xoauth2) ("XOAUTH2" sasl-xoauth2)) (let (result) (mapc (lambda (elt) (when (locate-library (symbol-name (car elt))) (dolist (name (cdr elt)) (setq result (cons (list name (car elt)) result))))) sasl-additional-mechanism-alist) result))) (defvar sasl-mechanisms (mapcar 'car sasl-mechanism-alist)) (defvar sasl-unique-id-function #'sasl-unique-id-function) (put 'sasl-error 'error-message "SASL error") (put 'sasl-error 'error-conditions '(sasl-error error)) (defun sasl-error (datum) (signal 'sasl-error (list datum))) ;;; @ SASL client ;;; (defun sasl-make-client (mechanism name service server) "Return a newly allocated SASL client. NAME is name of the authorization. SERVICE is name of the service desired. SERVER is the fully qualified host name of the server to authenticate to." (vector mechanism name service server (make-symbol "sasl-client-properties"))) (defun sasl-client-mechanism (client) "Return the authentication mechanism driver of CLIENT." (aref client 0)) (defun sasl-client-name (client) "Return the authorization name of CLIENT, a string." (aref client 1)) (defun sasl-client-service (client) "Return the service name of CLIENT, a string." (aref client 2)) (defun sasl-client-server (client) "Return the server name of CLIENT, a string." (aref client 3)) (defun sasl-client-set-properties (client plist) "Destructively set the properties of CLIENT. The second argument PLIST is the new property list." (setplist (aref client 4) plist)) (defun sasl-client-set-property (client property value) "Add the given property/value to CLIENT." (put (aref client 4) property value)) (defun sasl-client-property (client property) "Return the value of the PROPERTY of CLIENT." (get (aref client 4) property)) (defun sasl-client-properties (client) "Return the properties of CLIENT." (symbol-plist (aref client 4))) ;;; @ SASL mechanism ;;; (defun sasl-make-mechanism (name steps) "Make an authentication mechanism. NAME is a IANA registered SASL mechanism name. STEPS is list of continuation function." (vector name (mapcar (lambda (step) (let ((symbol (make-symbol (symbol-name step)))) (fset symbol (symbol-function step)) symbol)) steps))) (defun sasl-mechanism-name (mechanism) "Return name of MECHANISM, a string." (aref mechanism 0)) (defun sasl-mechanism-steps (mechanism) "Return the authentication steps of MECHANISM, a list of functions." (aref mechanism 1)) (defun sasl-find-mechanism (mechanisms) "Retrieve an apropriate mechanism object from MECHANISMS hints." (let* ((sasl-mechanisms sasl-mechanisms) (mechanism (catch 'done (while sasl-mechanisms (if (member (car sasl-mechanisms) mechanisms) (throw 'done (nth 1 (assoc (car sasl-mechanisms) sasl-mechanism-alist)))) (setq sasl-mechanisms (cdr sasl-mechanisms)))))) (if mechanism (require mechanism)) (get mechanism 'sasl-mechanism))) ;;; @ SASL authentication step ;;; (defun sasl-step-data (step) "Return the data which STEP holds, a string." (aref step 1)) (defun sasl-step-set-data (step data) "Store DATA string to STEP." (aset step 1 data)) (defun sasl-next-step (client step) "Evaluate the challenge and prepare an appropriate next response. The data type of the value and optional 2nd argument STEP is nil or opaque authentication step which holds the reference to the next action and the current challenge. At the first time STEP should be set to nil." (let* ((steps (sasl-mechanism-steps (sasl-client-mechanism client))) (function (if (vectorp step) (nth 1 (memq (aref step 0) steps)) (car steps)))) (if function (vector function (funcall function client step))))) (defvar sasl-read-passphrase nil) (defun sasl-read-passphrase (prompt) (if (not sasl-read-passphrase) (if (functionp 'read-passwd) (setq sasl-read-passphrase 'read-passwd) (if (load "passwd" t) (setq sasl-read-passphrase 'read-passwd) (autoload 'ange-ftp-read-passwd "ange-ftp") (setq sasl-read-passphrase 'ange-ftp-read-passwd)))) (funcall sasl-read-passphrase prompt)) (defun sasl-unique-id () "Compute a data string which must be different each time. It contain at least 64 bits of entropy." (concat (funcall sasl-unique-id-function)(funcall sasl-unique-id-function))) (defvar sasl-unique-id-char nil) ;; stolen (and renamed) from message.el (defun sasl-unique-id-function () ;; Don't use microseconds from (current-time), they may be unsupported. ;; Instead we use this randomly inited counter. (setq sasl-unique-id-char (% (1+ (or sasl-unique-id-char (logand (random t) (1- (ash 1 20))))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) (let ((tm (floor (float-time)))) (concat (sasl-unique-id-number-base36 (+ (/ tm 65536) (ash (% sasl-unique-id-char 25) 16)) 4) (sasl-unique-id-number-base36 (+ (% tm 65536) (ash (/ sasl-unique-id-char 25) 16)) 4)))) (defun sasl-unique-id-number-base36 (num len) (if (if (< len 0) (<= num 0) (= len 0)) "" (concat (sasl-unique-id-number-base36 (/ num 36) (1- len)) (list (aref "zyxwvutsrqponmlkjihgfedcba9876543210" (% num 36)))))) ;;; PLAIN (RFC2595 Section 6) (defconst sasl-plain-steps '(sasl-plain-response)) (defun sasl-plain-response (client _step) (let ((passphrase (sasl-read-passphrase (format "PLAIN passphrase for %s: " (sasl-client-name client)))) (authenticator-name (sasl-client-property client 'authenticator-name)) (name (sasl-client-name client))) (unwind-protect (if (and authenticator-name (not (string= authenticator-name name))) (concat authenticator-name "\0" name "\0" passphrase) (concat "\0" name "\0" passphrase)) (fillarray passphrase 0)))) (put 'sasl-plain 'sasl-mechanism (sasl-make-mechanism "PLAIN" sasl-plain-steps)) (provide 'sasl-plain) ;;; LOGIN (No specification exists) (defconst sasl-login-steps '(ignore ;no initial response sasl-login-response-1 sasl-login-response-2)) (defun sasl-login-response-1 (client _step) ;;; (unless (string-match "^Username:" (sasl-step-data step)) ;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step)))) (sasl-client-name client)) (defun sasl-login-response-2 (client _step) ;;; (unless (string-match "^Password:" (sasl-step-data step)) ;;; (sasl-error (format "Unexpected response: %s" (sasl-step-data step)))) (sasl-read-passphrase (format "LOGIN passphrase for %s: " (sasl-client-name client)))) (put 'sasl-login 'sasl-mechanism (sasl-make-mechanism "LOGIN" sasl-login-steps)) (provide 'sasl-login) ;;; ANONYMOUS (RFC2245) (defconst sasl-anonymous-steps '(ignore ;no initial response sasl-anonymous-response)) (defun sasl-anonymous-response (client _step) (or (sasl-client-property client 'trace) (sasl-client-name client))) (put 'sasl-anonymous 'sasl-mechanism (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps)) (provide 'sasl-anonymous) (provide 'sasl) ;;; sasl.el ends here wanderlust-flim-2cf5a78/sasl.texi000066400000000000000000000154201436773573300171310ustar00rootroot00000000000000\input texinfo @c -*-texinfo-*- @setfilename sasl.info @set VERSION 0.2 @dircategory Emacs @direntry * SASL: (sasl). The Emacs SASL library. @end direntry @settitle Emacs SASL Library @value{VERSION} @ifinfo This file describes the Emacs SASL library. Copyright (C) 2000 Daiki Ueno. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.1 or any later version published by the Free Software Foundation; with no Invariant Sections, with no Front-Cover Texts, and with no Back-Cover Texts. A copy of the license is included in the section entitled "GNU Free Documentation License". @end ifinfo @tex @titlepage @title Emacs SASL Library @author by Daiki Ueno @page @vskip 0pt plus 1filll Copyright @copyright{} 2000 Daiki Ueno. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.1 or any later version published by the Free Software Foundation; with no Invariant Sections, with no Front-Cover Texts, and with no Back-Cover Texts. A copy of the license is included in the section entitled "GNU Free Documentation License". @end titlepage @page @end tex @node Top @top Emacs SASL This manual describes the Emacs SASL library. A common interface to share several authentication mechanisms between applications using different protocols. @menu * Overview:: What Emacs SASL library is. * How to use:: Adding authentication support to your applications. * Data types:: * Backend drivers:: Writing your own drivers. * Index:: * Function Index:: * Variable Index:: @end menu @node Overview @chapter Overview @sc{sasl} is short for @dfn{Simple Authentication and Security Layer}. This standard is documented in RFC2222. It provides a simple method for adding authentication support to various application protocols. The toplevel interface of this library is inspired by Java @sc{sasl} Application Program Interface. It defines an abstraction over a series of authentication mechanism drivers (@ref{Backend drivers}). Backend drivers are designed to be close as possible to the authentication mechanism. You can access the additional configuration information anywhere from the implementation. @node How to use @chapter How to use (Not yet written). To use Emacs SASL library, please evaluate following expression at the beginning of your application program. @lisp (require 'sasl) @end lisp If you want to check existence of sasl.el at runtime, instead you can list autoload settings for functions you want. @node Data types @chapter Data types There are three data types to be used for carrying a negotiated security layer---a mechanism, a client parameter and an authentication step. @menu * Mechanisms:: * Clients:: * Steps:: @end menu @node Mechanisms @section Mechanisms A mechanism (@code{sasl-mechanism} object) is a schema of the @sc{sasl} authentication mechanism driver. @defvar sasl-mechanisms A list of mechanism names. @end defvar @defun sasl-find-mechanism mechanisms Retrieve an apropriate mechanism. This function compares @var{mechanisms} and @code{sasl-mechanisms} then returns apropriate @code{sasl-mechanism} object. @example (let ((sasl-mechanisms '("CRAM-MD5" "DIGEST-MD5"))) (setq mechanism (sasl-find-mechanism server-supported-mechanisms))) @end example @end defun @defun sasl-mechanism-name mechanism Return name of mechanism, a string. @end defun If you want to write an authentication mechanism driver (@ref{Backend drivers}), use @code{sasl-make-mechanism} and modify @code{sasl-mechanisms} and @code{sasl-mechanism-alist} correctly. @defun sasl-make-mechanism name steps Allocate a @code{sasl-mechanism} object. This function takes two parameters---name of the mechanism, and a list of authentication functions. @example (defconst sasl-anonymous-steps '(identity ;no initial response sasl-anonymous-response)) (put 'sasl-anonymous 'sasl-mechanism (sasl-make-mechanism "ANONYMOUS" sasl-anonymous-steps)) @end example @end defun @node Clients @section Clients A client (@code{sasl-client} object) initialized with four parameters---a mechanism, a user name, name of the service and name of the server. @defun sasl-make-client mechanism name service server Prepare a @code{sasl-client} object. @end defun @defun sasl-client-mechanism client Return the mechanism (@code{sasl-mechanism} object) of client. @end defun @defun sasl-client-name client Return the authorization name of client, a string. @end defun @defun sasl-client-service client Return the service name of client, a string. @end defun @defun sasl-client-server client Return the server name of client, a string. @end defun If you want to specify additional configuration properties, please use @code{sasl-client-set-property}. @defun sasl-client-set-property client property value Add the given property/value to client. @end defun @defun sasl-client-property client property Return the value of the property of client. @end defun @defun sasl-client-set-properties client plist Destructively set the properties of client. The second argument is the new property list. @end defun @defun sasl-client-properties client Return the whole property list of client configuration. @end defun @node Steps @section Steps A step (@code{sasl-step} object) is an abstraction of authentication ``step'' which holds the response value and the next entry point for the authentication process (the latter is not accessible). @defun sasl-step-data step Return the data which @var{step} holds, a string. @end defun @defun sasl-step-set-data step data Store @var{data} string to @var{step}. @end defun To get the initial response, you should call the function @code{sasl-next-step} with the second argument @code{nil}. @example (setq name (sasl-mechanism-name mechanism)) @end example At this point we could send the command which starts a SASL authentication protocol exchange. For example, @example (process-send-string process (if (sasl-step-data step) ;initial response (format "AUTH %s %s\r\n" name (base64-encode-string (sasl-step-data step) t)) (format "AUTH %s\r\n" name))) @end example To go on with the authentication process, all you have to do is call @code{sasl-next-step} consecutively. @defun sasl-next-step client step Perform the authentication step. At the first time @var{step} should be set to @code{nil}. @end defun @node Backend drivers @chapter Backend drivers (Not yet written). @node Index @chapter Index @printindex cp @node Function Index @chapter Function Index @printindex fn @node Variable Index @chapter Variable Index @printindex vr @summarycontents @contents @bye @c End: wanderlust-flim-2cf5a78/sha1.el000066400000000000000000000027021436773573300164510ustar00rootroot00000000000000;;; sha1.el --- SHA1 Secure Hash Algorithm. -*- lexical-binding: t -*- ;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keywords: SHA1, FIPS 180-1 ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; Examples from FIPS PUB 180-1. ;; ;; ;; (sha1 "abc") ;; => a9993e364706816aba3e25717850c26c9cd0d89d ;; ;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") ;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1 ;; ;; (sha1 (make-string 1000000 ?a)) ;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f ;;; Code: (defvar sha1-dl-module nil) (provide 'sha1) ;;; sha1.el ends here wanderlust-flim-2cf5a78/smtp.el000066400000000000000000000603531436773573300166060ustar00rootroot00000000000000;;; smtp.el --- basic functions to send mail with SMTP server -*- lexical-binding: t -*- ;; Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001 ,2002, 2004 ;; Free Software Foundation, Inc. ;; Author: Tomoji Kagatani ;; Simon Leinen (ESMTP support) ;; Shuhei KOBAYASHI ;; Daiki Ueno ;; Keywords: SMTP, mail ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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 this program; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; ;;; Code: (require 'custom) (require 'mail-utils) ; mail-strip-quoted-names (require 'sasl) (require 'luna) (require 'mel) ; binary-funcall (defgroup smtp nil "SMTP protocol for sending mail." :group 'mail) (defgroup smtp-extensions nil "SMTP service extensions (RFC1869)." :group 'smtp) (defcustom smtp-default-server nil "Specify default SMTP server." :type '(choice (const nil) string) :group 'smtp) (defcustom smtp-server (or (getenv "SMTPSERVER") smtp-default-server) "The name of the host running SMTP server. It can also be a function called from `smtp-via-smtp' with arguments SENDER and RECIPIENTS." :type '(choice (string :tag "Name") (function :tag "Function")) :group 'smtp) (defcustom smtp-send-by-myself nil "If non-nil, smtp.el send a mail by myself without smtp-server. This option requires \"dig.el\"." :type 'boolean :group 'smtp) (defcustom smtp-service "smtp" "SMTP service port number. \"smtp\" or 25." :type '(choice (integer :tag "25" 25) (string :tag "smtp" "smtp")) :group 'smtp) (defcustom smtp-local-domain nil "Local domain name without a host name. If the function (system-name) returns the full internet address, don't define this value." :type '(choice (const nil) string) :group 'smtp) (defcustom smtp-fqdn nil "Fully qualified domain name used for SMTP HELO/EHLO." :type '(choice (const nil) string) :group 'smtp) (defcustom smtp-use-8bitmime t "If non-nil, use ESMTP 8BITMIME (RFC1652) if available." :type 'boolean :group 'smtp-extensions) (defcustom smtp-use-size t "If non-nil, use ESMTP SIZE (RFC1870) if available." :type 'boolean :group 'smtp-extensions) (defcustom smtp-use-starttls nil "If non-nil, use STARTTLS (RFC2595) if available." :type 'boolean :group 'smtp-extensions) (defcustom smtp-use-gnutls (gnutls-available-p) "If non-nil, use built-in GnuTLS for STARTTLS." :type 'boolean :group 'smtp-extensions) (defcustom smtp-use-starttls-ignore-error nil "If non-nil, do not use STARTTLS if STARTTLS is not available." :type 'boolean :group 'smtp-extensions) (defcustom smtp-use-sasl nil "If non-nil, use SMTP Authentication (RFC2554) if available." :type 'boolean :group 'smtp-extensions) (defcustom smtp-sasl-user-name (user-login-name) "Identification to be used for authorization." :type 'string :group 'smtp-extensions) (defcustom smtp-sasl-properties nil "Properties set to SASL client." :type 'string :group 'smtp-extensions) (defcustom smtp-sasl-mechanisms nil "List of authentication mechanisms." :type '(repeat string) :group 'smtp-extensions) (defcustom smtp-debug nil "*If non-nil, smtp debug info printout into messages." :type 'boolean :group 'smtp) (defvar sasl-mechanisms) ;;;###autoload (defvar smtp-open-connection-function #'open-network-stream "*Function used for connecting to a SMTP server. The function will be called with the same four arguments as `open-network-stream' and should return a process object. Here is an example: (setq smtp-open-connection-function #\\='(lambda (name buffer host service) (let ((process-connection-type nil)) (start-process name buffer \"ssh\" \"-C\" host \"nc\" host service)))) It connects to a SMTP server using \"ssh\" before actually connecting to the SMTP port. Where the command \"nc\" is the netcat executable; see http://www.atstake.com/research/tools/index.html#network_utilities for details.") (defvar smtp-read-point nil) (defvar smtp-connection-alist nil) (defvar smtp-submit-package-function #'smtp-submit-package) ;;; @ SMTP package ;;; A package contains a mail message, an envelope sender address, ;;; and one or more envelope recipient addresses. In ESMTP model ;;; the current sending package should be guaranteed to be accessible ;;; anywhere from the hook methods (or SMTP commands). (eval-and-compile (luna-define-class smtp-package () (sender recipients buffer)) (luna-define-internal-accessors 'smtp-package)) (defun smtp-make-package (sender recipients buffer) "Create a new package structure. A package is a unit of SMTP message SENDER specifies the package sender, a string. RECIPIENTS is a list of recipients. BUFFER may be a buffer or a buffer name which contains mail message." (luna-make-entity 'smtp-package :sender sender :recipients recipients :buffer buffer)) (defun smtp-package-buffer-internal-size (package) "Return the size of PACKAGE, an integer." (with-current-buffer (smtp-package-buffer-internal package) (let ((size (+ (buffer-size) ;; Add one byte for each change-of-line ;; because or CR-LF representation: (count-lines (point-min) (point-max)) ;; For some reason, an empty line is ;; added to the message. Maybe this ;; is a bug, but it can't hurt to add ;; those two bytes anyway: 2))) (goto-char (point-min)) (while (re-search-forward "^\\." nil t) (setq size (1+ size))) size))) ;;; @ SMTP connection ;;; We should consider the function `open-network-stream' is a emulation ;;; for another network stream. They are likely to be implemented with an ;;; external program and the function `process-contact' returns the ;;; process id instead of `(HOST SERVICE)' pair. (eval-and-compile (luna-define-class smtp-connection () (process server service extensions encoder decoder)) (luna-define-internal-accessors 'smtp-connection)) (defun smtp-make-connection (process server service) "Create a new connection structure. PROCESS is an internal subprocess-object. SERVER is name of the host to connect to. SERVICE is name of the service desired." (luna-make-entity 'smtp-connection :process process :server server :service service)) (luna-define-generic smtp-connection-opened (connection) "Say whether the CONNECTION to server has been opened.") (luna-define-generic smtp-close-connection (connection) "Close the CONNECTION to server.") (luna-define-method smtp-connection-opened ((connection smtp-connection)) (let ((process (smtp-connection-process-internal connection))) (if (memq (process-status process) '(open run)) t))) (luna-define-method smtp-close-connection ((connection smtp-connection)) (let ((process (smtp-connection-process-internal connection))) (delete-process process))) (defun smtp-make-fqdn () "Return user's fully qualified domain name." (if smtp-fqdn smtp-fqdn (let ((name (system-name))) (cond (smtp-local-domain (concat name "." smtp-local-domain)) ((string-match "[^.]\\.[^.]" name) name) (t (error "invalid FQDN. Set smtp-fqdn or smtp-local-domain correctly")))))) (defun smtp-find-connection (buffer) "Find the connection delivering to BUFFER." (let ((entry (assq buffer smtp-connection-alist)) connection) (when entry (setq connection (nth 1 entry)) (if (smtp-connection-opened connection) connection (setq smtp-connection-alist (delq entry smtp-connection-alist)) nil)))) (eval-and-compile (autoload 'starttls-open-stream "starttls") (autoload 'starttls-negotiate "starttls") (autoload 'gnutls-negotiate "gnutls")) (defun smtp-open-connection (buffer server service) "Open a SMTP connection for a service to a host. Return a newly allocated connection-object. BUFFER is the buffer to associate with the connection. SERVER is name of the host to connect to. SERVICE is name of the service desired." (let ((process (binary-funcall (cond ((and smtp-use-starttls (null smtp-use-gnutls)) 'starttls-open-stream) (t smtp-open-connection-function)) "SMTP" buffer server service)) connection) (unless (and (processp process) (memq (process-status process) '(open run))) (error "Open SMTP connection function to %s:%s failed" server (if (integerp service) (format "%d" service) service))) (when process (setq connection (smtp-make-connection process server service)) (set-process-filter process 'smtp-process-filter) (setq smtp-connection-alist (cons (list buffer connection) smtp-connection-alist)) connection))) (eval-and-compile (autoload 'dig-invoke "dig") (autoload 'dig-extract-rr "dig")) (defun smtp-find-mx (domain &optional doerror) (let (server) ;; dig.el resolves only primally MX. (cond ((setq server (smtp-dig domain "MX")) (progn (string-match " \\([^ ]*\\)$" server) (match-string 1 server))) ((smtp-dig domain "A") domain) (t (if doerror (error (format "SMTP cannot resolve %s" domain))))))) (defun smtp-dig (domain type) (let (dig-buf) (set-buffer (setq dig-buf (dig-invoke domain type))) (prog1 (dig-extract-rr domain type) (kill-buffer dig-buf)))) (defun smtp-find-server (recipients) (save-excursion (let ((rec (mapcar (lambda (recipient) (let (server) (if (and (string-match "@\\([^\t\n ]*\\)" recipient) (setq server (smtp-find-mx (match-string 1 recipient)))) (cons server (list recipient)) (error (format "cannot find server for %s." recipient))))) recipients)) ret rets rlist) (while (setq rets (pop rec)) (if (setq ret (assoc (car rets) rec)) (setcdr ret (append (cdr ret) (cdr rets))) (setq rlist (append rlist (list rets))))) rlist))) ;;;###autoload (defun smtp-via-smtp (sender recipients buffer) "Like `smtp-send-buffer', but sucks in any errors." (condition-case nil (progn (smtp-send-buffer sender recipients buffer) t) (smtp-error))) (make-obsolete 'smtp-via-smtp "It's old API." "02 Nov 2000") ;;;###autoload (defun smtp-send-buffer (sender recipients buffer) "Send a message. SENDER is an envelope sender address. RECIPIENTS is a list of envelope recipient addresses. BUFFER may be a buffer or a buffer name which contains mail message." (if smtp-send-by-myself (smtp-send-buffer-by-myself sender recipients buffer) (let* ((server (if (functionp smtp-server) (funcall smtp-server sender recipients) (or smtp-server (error "`smtp-server' not defined")))) (package (smtp-make-package sender recipients buffer))) (with-current-buffer (setq buffer (get-buffer-create (format "*trace of SMTP session to %s*" server))) (erase-buffer) (buffer-disable-undo) (unless (smtp-find-connection buffer) (smtp-open-connection buffer server smtp-service)) (make-local-variable 'smtp-read-point) (setq smtp-read-point (point-min)) (funcall smtp-submit-package-function package) (unless (or smtp-debug (smtp-find-connection buffer)) (setq smtp-connection-alist (delq (assq buffer smtp-connection-alist) smtp-connection-alist)) (kill-buffer nil)))))) (defun smtp-submit-package (package) (unwind-protect (progn (smtp-primitive-greeting package) (condition-case nil (smtp-primitive-ehlo package) (smtp-response-error (smtp-primitive-helo package))) (if smtp-use-starttls (if (assq 'starttls (smtp-connection-extensions-internal (smtp-find-connection (current-buffer)))) (progn (smtp-primitive-starttls package) (smtp-primitive-ehlo package)) (unless smtp-use-starttls-ignore-error (error "STARTTLS is not supported on this server")))) (if smtp-use-sasl (smtp-primitive-auth package)) (smtp-primitive-mailfrom package) (smtp-primitive-rcptto package) (smtp-primitive-data package)) (let ((connection (smtp-find-connection (current-buffer)))) (when (and connection (smtp-connection-opened connection)) (condition-case nil (smtp-primitive-quit package) (smtp-error)) (smtp-close-connection connection))))) (defun smtp-send-buffer-by-myself (sender recipients buffer) "Send a message by myself. SENDER is an envelope sender address. RECIPIENTS is a list of envelope recipient addresses. BUFFER may be a buffer or a buffer name which contains mail message." (let ((servers (smtp-find-server recipients)) server package) (while (car servers) (setq server (caar servers)) (setq recipients (cdar servers)) (if (not (and server recipients)) ;; MAILER-DAEMON is required. :) (error (format "Cannot send <%s>" (mapconcat 'concat recipients ">,<")))) (setq package (smtp-make-package sender recipients buffer)) (with-current-buffer (setq buffer (get-buffer-create (format "*trace of SMTP session to %s*" server))) (erase-buffer) (buffer-disable-undo) (unless (smtp-find-connection buffer) (smtp-open-connection buffer server smtp-service)) (make-local-variable 'smtp-read-point) (setq smtp-read-point (point-min)) (let ((smtp-use-sasl nil) (smtp-use-starttls-ignore-error t)) (funcall smtp-submit-package-function package)) (unless (or smtp-debug (smtp-find-connection buffer)) (setq smtp-connection-alist (delq (assq buffer smtp-connection-alist) smtp-connection-alist)) (kill-buffer nil))) (setq servers (cdr servers))))) ;;; @ hook methods for `smtp-submit-package' ;;; (defun smtp-primitive-greeting (_package) (let* ((connection (smtp-find-connection (current-buffer))) (response (smtp-read-response connection))) (if (/= (car response) 220) (smtp-response-error response)))) (defun smtp-primitive-ehlo (_package) (let* ((connection (smtp-find-connection (current-buffer))) response) (smtp-send-command connection (format "EHLO %s" (smtp-make-fqdn))) (setq response (smtp-read-response connection)) (if (/= (car response) 250) (smtp-response-error response)) (smtp-connection-set-extensions-internal connection (mapcar (lambda (extension) (let ((extensions (split-string extension))) (setcar extensions (car (read-from-string (downcase (car extensions))))) extensions)) (cdr response))))) (defun smtp-primitive-helo (_package) (let* ((connection (smtp-find-connection (current-buffer))) response) (smtp-send-command connection (format "HELO %s" (smtp-make-fqdn))) (setq response (smtp-read-response connection)) (if (/= (car response) 250) (smtp-response-error response)))) (defun smtp-primitive-auth (_package) (let* ((connection (smtp-find-connection (current-buffer))) (mechanisms (cdr (assq 'auth (smtp-connection-extensions-internal connection)))) (sasl-mechanisms (or smtp-sasl-mechanisms sasl-mechanisms)) (mechanism (sasl-find-mechanism mechanisms)) client name step response) (unless mechanism (error "No authentication mechanism available")) (setq client (sasl-make-client mechanism smtp-sasl-user-name "smtp" (smtp-connection-server-internal connection))) (if smtp-sasl-properties (sasl-client-set-properties client smtp-sasl-properties)) (setq name (sasl-mechanism-name mechanism) ;; Retrieve the initial response step (sasl-next-step client nil)) (smtp-send-command connection (if (sasl-step-data step) (format "AUTH %s %s" name (base64-encode-string (sasl-step-data step) t)) (format "AUTH %s" name))) (catch 'done (while t (setq response (smtp-read-response connection)) (when (= (car response) 235) ;; The authentication process is finished. (setq step (sasl-next-step client step)) (if (null step) (throw 'done nil)) (smtp-response-error response)) ;Bogus server? (if (/= (car response) 334) (smtp-response-error response)) ;; Server may return human readable string. ;; https://msdn.microsoft.com/en-us/library/cc246825.aspx (sasl-step-set-data step (condition-case nil (base64-decode-string (nth 1 response)) (error (nth 1 response)))) (setq step (sasl-next-step client step)) (smtp-send-command connection (if (sasl-step-data step) (base64-encode-string (sasl-step-data step) t) "")))) ;;; (smtp-connection-set-encoder-internal ;;; connection (sasl-client-encoder client)) ;;; (smtp-connection-set-decoder-internal ;;; connection (sasl-client-decoder client)) )) (defun smtp-primitive-starttls (_package) (let* ((connection (smtp-find-connection (current-buffer))) (process (smtp-connection-process-internal connection)) response) ;; STARTTLS --- begin a TLS negotiation (RFC 2595) (smtp-send-command connection "STARTTLS") (setq response (smtp-read-response connection)) (if (/= (car response) 220) (smtp-response-error response)) (if (memq (process-status process) '(run stop exit signal)) (starttls-negotiate process) (gnutls-negotiate :process process :hostname (smtp-connection-server-internal connection))))) (defun smtp-primitive-mailfrom (package) (let* ((connection (smtp-find-connection (current-buffer))) (extensions (smtp-connection-extensions-internal connection)) (sender (smtp-package-sender-internal package)) extension response) ;; SIZE --- Message Size Declaration (RFC1870) (if (and smtp-use-size (assq 'size extensions)) (setq extension (format " SIZE=%d" (smtp-package-buffer-internal-size package)))) ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652) (if (and smtp-use-8bitmime (assq '8bitmime extensions)) (setq extension (concat extension " BODY=8BITMIME"))) (smtp-send-command connection (if extension (format "MAIL FROM:<%s>%s" sender extension) (format "MAIL FROM:<%s>" sender))) (setq response (smtp-read-response connection)) (if (/= (car response) 250) (smtp-response-error response)))) (defun smtp-primitive-rcptto (package) (let* ((connection (smtp-find-connection (current-buffer))) (recipients (smtp-package-recipients-internal package)) response) (while recipients (smtp-send-command connection (format "RCPT TO:<%s>" (pop recipients))) (setq response (smtp-read-response connection)) (unless (memq (car response) '(250 251)) (smtp-response-error response))))) (defun smtp-primitive-data (package) (let* ((connection (smtp-find-connection (current-buffer))) response) (smtp-send-command connection "DATA") (setq response (smtp-read-response connection)) (if (/= (car response) 354) (smtp-response-error response)) (with-current-buffer (smtp-package-buffer-internal package) (goto-char (point-min)) (while (not (eobp)) (smtp-send-data connection (buffer-substring (point) (progn (end-of-line)(point)))) (beginning-of-line 2))) (smtp-send-command connection ".") (setq response (smtp-read-response connection)) (if (/= (car response) 250) (smtp-response-error response)))) (defun smtp-primitive-quit (_package) (let* ((connection (smtp-find-connection (current-buffer))) response) (smtp-send-command connection "QUIT") (setq response (smtp-read-response connection)) (if (/= (car response) 221) (smtp-response-error response)))) ;;; @ low level process manipulating function ;;; (defun smtp-process-filter (process output) (with-current-buffer (process-buffer process) (goto-char (point-max)) (insert output))) (put 'smtp-error 'error-message "SMTP error") (put 'smtp-error 'error-conditions '(smtp-error error)) (put 'smtp-response-error 'error-message "SMTP response error") (put 'smtp-response-error 'error-conditions '(smtp-response-error smtp-error error)) (defun smtp-response-error (response) (signal 'smtp-response-error response)) (defun smtp-read-response (connection) (let ((decoder (smtp-connection-decoder-internal connection)) (response-continue t) response) (while response-continue (goto-char smtp-read-point) (while (not (re-search-forward "\r?\n" nil t)) (unless (smtp-connection-opened connection) (signal 'smtp-error "Connection closed")) (accept-process-output (smtp-connection-process-internal connection)) (goto-char smtp-read-point)) (let ((bol smtp-read-point) (eol (match-beginning 0))) (when decoder (let ((string (buffer-substring bol eol))) (delete-region bol (point)) (insert (funcall decoder string)) (setq eol (point)) (insert "\r\n"))) (setq smtp-read-point (point)) (goto-char bol) (cond ((looking-at "[1-5][0-9][0-9]\\([ -]\\)") (setq response (nconc response (list (buffer-substring (match-end 0) eol)))) (when (string= (match-string 1) " ") (setq response (cons (read (point-marker)) response) response-continue nil))) (smtp-debug (message "Invalid response: %s" (buffer-substring bol eol)))))) response)) (defun smtp-send-command (connection command) (let ((process (smtp-connection-process-internal connection)) (encoder (smtp-connection-encoder-internal connection))) (with-current-buffer (process-buffer process) (goto-char (point-max)) (setq command (concat command "\r\n")) (insert command) (setq smtp-read-point (point)) (if encoder (setq command (funcall encoder command))) (process-send-string process command)))) (defun smtp-send-data (connection data) (let ((process (smtp-connection-process-internal connection)) (encoder (smtp-connection-encoder-internal connection))) ;; Escape "." at start of a line. (setq data (concat (when (eq (string-to-char data) ?.) ".") data "\r\n")) (if encoder (setq data (funcall encoder data))) (process-send-string process data))) (defun smtp-deduce-address-list (smtp-text-buffer header-start header-end) "Get address list suitable for smtp RCPT TO:
." (let ((simple-address-list "") this-line this-line-end addr-regexp (smtp-address-buffer (generate-new-buffer " *smtp-mail*"))) (unwind-protect (with-current-buffer smtp-address-buffer (setq case-fold-search t) (erase-buffer) (insert (with-current-buffer smtp-text-buffer (buffer-substring-no-properties header-start header-end))) (goto-char (point-min)) ;; RESENT-* fields should stop processing of regular fields. (save-excursion (if (re-search-forward "^RESENT-TO:" header-end t) (setq addr-regexp "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)") (setq addr-regexp "^\\(TO:\\|CC:\\|BCC:\\)"))) (while (re-search-forward addr-regexp header-end t) (replace-match "") (setq this-line (match-beginning 0)) (forward-line 1) ;; get any continuation lines. (while (and (looking-at "^[ \t]+") (< (point) header-end)) (forward-line 1)) (setq this-line-end (point-marker)) (setq simple-address-list (concat simple-address-list " " (mail-strip-quoted-names (buffer-substring this-line this-line-end))))) (erase-buffer) (insert " " simple-address-list "\n") ;; newline --> blank (subst-char-in-region (point-min) (point-max) 10 ?\s t) ;; comma --> blank (subst-char-in-region (point-min) (point-max) ?, ?\s t) ;; tab --> blank (subst-char-in-region (point-min) (point-max) 9 ?\s t) (goto-char (point-min)) ;; tidyness in case hook is not robust when it looks at this (while (re-search-forward "[ \t]+" header-end t) (replace-match " ")) (goto-char (point-min)) (let (recipient-address-list) (while (re-search-forward " \\([^ ]+\\) " (point-max) t) (backward-char 1) (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1)) recipient-address-list))) recipient-address-list)) (kill-buffer smtp-address-buffer)))) (provide 'smtp) ;;; smtp.el ends here wanderlust-flim-2cf5a78/std11.el000066400000000000000000000704501436773573300165560ustar00rootroot00000000000000;;; std11.el --- STD 11 functions for GNU Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1995,96,97,98,99,2000,01,02 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, RFC 822, STD 11 ;; This file is part of FLIM (Faithful Library about Internet Message). ;; 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., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Code: (require 'pccl) (require 'static) ;;; @ fetch ;;; (defconst std11-field-name-regexp "[!-9;-~]+") (defconst std11-field-head-regexp (concat "^" std11-field-name-regexp ":")) (defconst std11-next-field-head-regexp (concat "\n" std11-field-name-regexp ":")) (defun std11-field-end (&optional bound) "Move to end of field and return this point. The optional argument BOUNDs the search; it is a buffer position." (if (re-search-forward std11-next-field-head-regexp bound t) (goto-char (match-beginning 0)) (if (re-search-forward "^$" bound t) (goto-char (1- (match-beginning 0))) (end-of-line) (point)))) ;;;###autoload (defun std11-fetch-field (name) "Return the value of the header field NAME. The buffer is expected to be narrowed to just the headers of the message." (save-excursion (goto-char (point-min)) (let ((case-fold-search t)) (if (re-search-forward (concat "^" name ":[ \t]*") nil t) (buffer-substring-no-properties (match-end 0) (std11-field-end)))))) ;;;###autoload (defun std11-narrow-to-header (&optional boundary) "Narrow to the message header when needed. If BOUNDARY is not nil, it is used as message header separator." (goto-char (point-min)) (when (re-search-forward (if boundary (concat "^\\(" (regexp-quote boundary) "\\)?$") "^$") nil t) (narrow-to-region (point-min) (match-beginning 0)))) ;;;###autoload (defun std11-field-body (name &optional boundary) "Return the value of the header field NAME. If BOUNDARY is not nil, it is used as message header separator." (save-excursion (save-restriction (inline (std11-narrow-to-header boundary) (std11-fetch-field name))))) (defun std11-find-field-body (field-names &optional boundary) "Return the first found field-body specified by FIELD-NAMES of the message header in current buffer. If BOUNDARY is not nil, it is used as message header separator." (save-excursion (save-restriction (std11-narrow-to-header boundary) (let ((case-fold-search t) field-name) (catch 'tag (goto-char (point-min)) (while (setq field-name (car field-names)) (if (re-search-forward (concat "^" field-name ":[ \t]*") nil t) (throw 'tag (buffer-substring-no-properties (match-end 0) (std11-field-end)))) (setq field-names (cdr field-names)))))))) (defun std11-field-bodies (field-names &optional default-value boundary) "Return list of each field-bodies of FIELD-NAMES of the message header in current buffer. If BOUNDARY is not nil, it is used as message header separator." (save-excursion (save-restriction (std11-narrow-to-header boundary) (let* ((case-fold-search t) (dest (make-list (length field-names) default-value)) (s-rest field-names) (d-rest dest) field-name) (while (setq field-name (car s-rest)) (goto-char (point-min)) (if (re-search-forward (concat "^" field-name ":[ \t]*") nil t) (setcar d-rest (buffer-substring-no-properties (match-end 0) (std11-field-end)))) (setq s-rest (cdr s-rest) d-rest (cdr d-rest))) dest)))) (defun std11-header-string (regexp &optional boundary) "Return string of message header fields matched by REGEXP. If BOUNDARY is not nil, it is used as message header separator." (let ((case-fold-search t)) (save-excursion (save-restriction (std11-narrow-to-header boundary) (goto-char (point-min)) (let (field header) (while (re-search-forward std11-field-head-regexp nil t) (setq field (buffer-substring (match-beginning 0) (std11-field-end))) (when (string-match regexp field) (setq header (cons "\n" (cons field header))))) (apply 'concat (nreverse header))))))) (defun std11-header-string-except (regexp &optional boundary) "Return string of message header fields not matched by REGEXP. If BOUNDARY is not nil, it is used as message header separator." (let ((case-fold-search t)) (save-excursion (save-restriction (std11-narrow-to-header boundary) (goto-char (point-min)) (let (field header) (while (re-search-forward std11-field-head-regexp nil t) (setq field (buffer-substring (match-beginning 0) (std11-field-end))) (if (not (string-match regexp field)) (setq header (cons "\n" (cons field header))))) (apply 'concat (nreverse header))))))) (defun std11-collect-field-names (&optional boundary) "Return list of all field-names of the message header in current buffer. If BOUNDARY is not nil, it is used as message header separator." (save-excursion (save-restriction (std11-narrow-to-header boundary) (goto-char (point-min)) (let (dest name) (while (re-search-forward std11-field-head-regexp nil t) (setq name (buffer-substring-no-properties (match-beginning 0)(1- (match-end 0)))) (or (member name dest) (setq dest (cons name dest)))) dest)))) ;;; @ unfolding ;;; (defcustom std11-unfold-strip-leading-tab t "When non-nil, `std11-unfold-string' strips leading TAB, which is mainly added by incorrect folding." :group 'news :group 'mail :type 'boolean) ;;;###autoload (defun std11-unfold-string (string) "Unfold STRING as message header field." (let (dest (p 0)) (while (string-match "\\( ?\\)\n\\([ \t]\\)" string p) (setq dest (cons (unless (and std11-unfold-strip-leading-tab (< (match-beginning 0) (match-end 1)) (eq (aref string (match-beginning 2)) ?\t)) (match-string 2 string)) (cons (substring string p (match-end 1)) dest)) p (match-end 0))) (apply 'concat (nreverse (cons (substring string p) dest))))) ;;; @ quoted-string ;;; (defun std11-wrap-as-quoted-pairs (string specials) (let (dest (i 0) (b 0) (len (length string))) (while (< i len) (if (memq (aref string i) specials) (setq dest (cons "\\" (cons (substring string b i) dest)) b i)) (setq i (1+ i))) (apply 'concat (nreverse (cons (substring string b) dest))))) (defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n)) (defun std11-wrap-as-quoted-string (string) "Wrap STRING as RFC 822 quoted-string." (concat "\"" (std11-wrap-as-quoted-pairs string std11-non-qtext-char-list) "\"")) (defun std11-strip-quoted-pair (string) "Strip quoted-pairs in STRING." (let (dest (b 0) (i 0) (len (length string))) (while (< i len) (if (eq (aref string i) ?\\) (setq dest (cons (substring string b i) dest) b (1+ i) i (+ i 2)) (setq i (1+ i)))) (apply 'concat (nreverse (cons (substring string b) dest))))) (defun std11-strip-quoted-string (string) "Strip quoted-string STRING." (let ((len (length string))) (or (and (>= len 2) (let ((max (1- len))) (and (eq (aref string 0) ?\") (eq (aref string max) ?\") (std11-strip-quoted-pair (substring string 1 max))))) string))) ;;; @ lexical analyze ;;; (unless-broken ccl-usable (define-ccl-program std11-default-ccl-lexical-analyzer ;; r0 input ;; r1 flag means any character exists. ;; r2 in parse flag ;; 1 atom, 2 spaces, 3 quoted string or domain literal, 4 comment ;; r3 comment depth (eval-when-compile (let* ((wrt `(if (r0 == ?\") (write "\\\"") (if (r0 == ?\\) (write "\\\\") (write r0)))) (atm `((branch r2 ((r2 = 1) (write "(atom . \"") (write-read-repeat r0)) (write-read-repeat r0) ((write "\")") (r2 = 1) (write "(atom . \"") (write-read-repeat r0))))) (spc `((if r2 ((write "\")") (r2 = 0))) (write "(specials . \"") ,wrt (write "\")") (read r0) (repeat))) (sp `((branch r2 ((r2 = 2) (write "(spaces . \"") (write-read-repeat r0)) ((write "\")") (r2 = 2) (write "(spaces . \"") (write-read-repeat r0)) (write-read-repeat r0)))) (enc (lambda (name tag) `((if r2 ((write "\")"))) (write ,(concat "(" name " . \"")) (r2 = 3) (loop (read-branch r0 ,@(let* ((count (1+ (max tag ?\\))) (result (make-vector count '(write-repeat r0)))) (aset result ?\\ `((write "\\\\") (read r0) ,wrt (repeat))) (aset result ?\" '((write "\\\"") (repeat))) (aset result tag '(break)) (mapcar 'identity result))) (write-repeat r0)) (write "\")") (r2 = 0) (read r0) (repeat)))) (qs (funcall enc "quoted-string" ?\")) (dl (funcall enc "domain-literal" ?\])) (cm `((if r2 ((write "\")"))) (write "(comment . \"") (r2 = 4) (r3 = 1) (loop (read-branch r0 ,@(let* ((count (1+ (max ?\( ?\) ?\\))) (result (make-vector count '(write-repeat r0)))) (aset result ?\( '((r3 += 1) (write-repeat r0))) (aset result ?\) '((r3 -= 1) (if (r3 < 1) (break) (write-repeat r0)))) (aset result ?\\ `((write "\\\\") (read r0) ,wrt (repeat))) (aset result ?\" '((write "\\\"") (repeat))) (mapcar 'identity result))) (write-repeat r0)) (write "\")") (r2 = 0) (read r0) (repeat)))) `(8 ((r2 = 0) (read r0) (r1 = 1) (write "((") (loop (branch r0 ,@(mapcar (lambda (elt) (eval elt)) '(atm atm atm atm atm atm atm atm atm sp sp atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm sp atm qs atm atm atm atm atm cm spc atm atm spc atm spc atm atm atm atm atm atm atm atm atm atm atm spc spc spc atm spc atm spc atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm atm dl spc spc))) ,@atm)) ((branch r1 (write "(nil . t)") (branch r2 (write ") . t)") (write "\")) . t)") (write "\")) . t)") (write "\")))") (write "\")))"))))))))) (defcustom std11-ccl-lexical-analyzer (static-unless (or (broken-p 'ccl-execute-eof-block) (broken-p 'ccl-usable)) 'std11-default-ccl-lexical-analyzer) "Specify CCL-program symbol for `std11-lexical-analyze'. When nil, do not use CCL. CCL-program returns a string which expresses a cons. When cons's cdr is non-nil, CCL-program succeeds in analyzing and car is analyzed result. When cdr is nil, CCL-program fails in analyzing. If you modify `std11-lexical-analyzer', set this variable to nil or prepare corresponding CCL-program." :group 'news :group 'mail :type '(choice symbol (const :tag "Do not use CCL." nil))) (defcustom std11-lexical-analyzer '(std11-analyze-quoted-string std11-analyze-domain-literal std11-analyze-comment std11-analyze-spaces std11-analyze-special std11-analyze-atom) "*List of functions to return result of lexical analyze. Each function must have two arguments: STRING and START. STRING is the target string to be analyzed. START is start position of STRING to analyze. Previous function is preferred to next function. If a function returns nil, next function is used. Otherwise the return value will be the result." :group 'news :group 'mail :type '(repeat function)) (eval-and-compile (defconst std11-space-char-list '(?\s ?\t ?\n)) (defconst std11-special-char-list '(?\] ?\[ ?\( ?\) ?< ?> ?@ ?, ?\; ?: ?\\ ?\" ?.))) ;; (defconst std11-spaces-regexp ;; (eval-when-compile (concat "[" std11-space-char-list "]+"))) (defconst std11-non-atom-regexp (eval-when-compile (concat "[" std11-special-char-list std11-space-char-list "]"))) (defconst std11-atom-regexp (eval-when-compile (concat "[^" std11-special-char-list std11-space-char-list "]+"))) (defun std11-analyze-spaces (string start) (if (and (string-match (eval-when-compile (concat "[" std11-space-char-list "]+")) string start) (= (match-beginning 0) start)) (let ((end (match-end 0))) (cons (cons 'spaces (substring string start end)) ;;(substring string end) end)))) (defun std11-analyze-special (string start) (if (and (> (length string) start) (memq (aref string start) std11-special-char-list)) (cons (cons 'specials (substring string start (1+ start))) ;;(substring string 1) (1+ start)))) (defun std11-analyze-atom (string start) (if (string-match std11-non-atom-regexp string start) (if (> (match-beginning 0) start) (cons (cons 'atom (substring string start (match-beginning 0))) (match-beginning 0)) nil) (cons (cons 'atom (substring string start)) (length string))) ;; (if (and (string-match std11-atom-regexp string start) ;; (= (match-beginning 0) start)) ;; (let ((end (match-end 0))) ;; (cons (cons 'atom (substring string start end)) ;; ;;(substring string end) ;; end) ;; )) ) (defun std11-check-enclosure (string open close &optional recursive from) (let ((len (length string)) (i (or from 0))) (if (and (> len i) (eq (aref string i) open)) (let (p chr) (setq i (1+ i)) (catch 'tag (while (< i len) (setq chr (aref string i)) (cond ((eq chr ?\\) (setq i (1+ i)) (if (>= i len) (throw 'tag nil)) (setq i (1+ i))) ((eq chr close) (throw 'tag (1+ i))) ((eq chr open) (if (and recursive (setq p (std11-check-enclosure string open close recursive i))) (setq i p) (throw 'tag nil))) (t (setq i (1+ i)))))))))) (defun std11-analyze-quoted-string (string start) (let ((p (std11-check-enclosure string ?\" ?\" nil start))) (if p (cons (cons 'quoted-string (substring string (1+ start) (1- p))) ;;(substring string p)) p)))) (defun std11-analyze-domain-literal (string start) (let ((p (std11-check-enclosure string ?\[ ?\] nil start))) (if p (cons (cons 'domain-literal (substring string (1+ start) (1- p))) ;;(substring string p)) p)))) (defun std11-analyze-comment (string start) (let ((p (std11-check-enclosure string ?\( ?\) t start))) (if p (cons (cons 'comment (substring string (1+ start) (1- p))) ;;(substring string p)) p)))) ;;;###autoload (defun std11-lexical-analyze (string &optional analyzer start) "Analyze STRING as lexical tokens of STD 11." (let (len dest ret) (if (and std11-ccl-lexical-analyzer (null analyzer) (cdr (setq ret (read (ccl-execute-on-string std11-ccl-lexical-analyzer (make-vector 9 0) (if start (substring string start) (or string ""))))))) (car ret) (setq len (length string) analyzer (or analyzer std11-lexical-analyzer) start (or start 0)) (while (< start len) (setq ret (let ((rest analyzer) func r) (while (and (setq func (car rest)) (null (setq r (funcall func string start)))) (setq rest (cdr rest))) (or r (cons (cons 'error (substring string start)) (1+ len))))) (setq dest (cons (car ret) dest) start (cdr ret))) (nreverse dest)))) ;;; @ parser ;;; (defun std11-ignored-token-p (token) (memq (car token) '(spaces comment))) (defun std11-parse-token (lal) (let (token itl) (while (and lal (std11-ignored-token-p (setq token (car lal)))) (setq lal (cdr lal)) (setq itl (cons token itl))) (cons (nreverse (cons token itl)) (cdr lal)))) (defun std11-parse-ascii-token (lal) (let (token itl parsed token-value) (while (and lal (setq token (car lal)) (or (std11-ignored-token-p token) (if (and (setq token-value (cdr token)) (delq 'ascii (find-charset-string token-value))) (setq token nil)))) (setq lal (cdr lal)) (setq itl (cons token itl))) (if (and token (setq parsed (nreverse (cons token itl)))) (cons parsed (cdr lal))))) (defun std11-parse-token-or-comment (lal) (let (token itl) (while (and lal (eq (car (setq token (car lal))) 'spaces)) (setq lal (cdr lal)) (setq itl (cons token itl))) (cons (nreverse (cons token itl)) (cdr lal)))) (defun std11-parse-word (lal) (let ((ret (std11-parse-ascii-token lal))) (if ret (let ((elt (car ret)) (rest (cdr ret))) (if (or (assq 'atom elt) (assq 'quoted-string elt)) (cons (cons 'word elt) rest)))))) (defun std11-parse-word-or-comment-or-period (lal) (let ((ret (std11-parse-token-or-comment lal))) (if ret (let ((elt (car ret)) (rest (cdr ret))) (cond ((or (assq 'atom elt) (assq 'quoted-string elt)) (cons (cons 'word elt) rest)) ((assq 'comment elt) (cons (cons 'comment-word elt) rest)) ((string-equal (cdr (assq 'specials elt)) ".") (cons (cons 'period elt) rest))))))) (defun std11-parse-phrase (lal) (let (ret phrase) (while (setq ret (std11-parse-word-or-comment-or-period lal)) (setq phrase (append phrase (cdr (car ret)))) (setq lal (cdr ret))) (if phrase (cons (cons 'phrase phrase) lal)))) (defun std11-parse-local-part (lal) (let ((ret (std11-parse-word lal))) (if ret (let ((local-part (cdr (car ret))) dot) (setq lal (cdr ret)) (while (and (setq ret (std11-parse-ascii-token lal)) (setq dot (car ret)) (string-equal (cdr (assq 'specials dot)) ".") (setq ret (std11-parse-word (cdr ret))) (setq local-part (append local-part dot (cdr (car ret)))) (setq lal (cdr ret)))) (cons (cons 'local-part local-part) lal))))) (defun std11-parse-sub-domain (lal) (let ((ret (std11-parse-ascii-token lal))) (if ret (let ((sub-domain (car ret))) (if (or (assq 'atom sub-domain) (assq 'domain-literal sub-domain)) (cons (cons 'sub-domain sub-domain) (cdr ret))))))) (defun std11-parse-domain (lal) (let ((ret (std11-parse-sub-domain lal))) (if ret (let ((domain (cdr (car ret))) dot) (setq lal (cdr ret)) (while (and (setq ret (std11-parse-ascii-token lal)) (setq dot (car ret)) (string-equal (cdr (assq 'specials dot)) ".") (setq ret (std11-parse-sub-domain (cdr ret))) (setq domain (append domain dot (cdr (car ret)))) (setq lal (cdr ret)))) (cons (cons 'domain domain) lal))))) (defun std11-parse-at-domain (lal) (let ((ret (std11-parse-ascii-token lal)) at-sign) (if (and ret (setq at-sign (car ret)) (string-equal (cdr (assq 'specials at-sign)) "@") (setq ret (std11-parse-domain (cdr ret)))) (cons (cons 'at-domain (append at-sign (cdr (car ret)))) (cdr ret))))) (defun std11-parse-addr-spec (lal) (let ((ret (std11-parse-local-part lal)) addr) (if (and ret (prog1 (setq addr (cdr (car ret))) (setq lal (cdr ret)) (and (setq ret (std11-parse-at-domain lal)) (setq addr (append addr (cdr (car ret)))) (setq lal (cdr ret))))) (cons (cons 'addr-spec addr) lal)))) (defun std11-parse-route (lal) (let ((ret (std11-parse-at-domain lal)) route comma colon) (if (and ret (progn (setq route (cdr (car ret))) (setq lal (cdr ret)) (while (and (setq ret (std11-parse-ascii-token lal)) (setq comma (car ret)) (string-equal (cdr (assq 'specials comma)) ",") (setq ret (std11-parse-at-domain (cdr ret)))) (setq route (append route comma (cdr (car ret)))) (setq lal (cdr ret))) (and (setq ret (std11-parse-ascii-token lal)) (setq colon (car ret)) (string-equal (cdr (assq 'specials colon)) ":") (setq route (append route colon))))) (cons (cons 'route route) (cdr ret))))) (defun std11-parse-route-addr (lal) (let ((ret (std11-parse-ascii-token lal)) < route addr-spec >) (if (and ret (setq < (car ret)) (string-equal (cdr (assq 'specials <)) "<") (setq lal (cdr ret)) (progn (and (setq ret (std11-parse-route lal)) (setq route (cdr (car ret))) (setq lal (cdr ret))) (setq ret (std11-parse-addr-spec lal))) (setq addr-spec (cdr (car ret))) (setq lal (cdr ret)) (setq ret (std11-parse-ascii-token lal)) (setq > (car ret)) (string-equal (cdr (assq 'specials >)) ">")) (cons (cons 'route-addr (append route addr-spec)) (cdr ret))))) (defun std11-parse-phrase-route-addr (lal) (let ((ret (std11-parse-phrase lal)) phrase) (if ret (progn (setq phrase (cdr (car ret))) (setq lal (cdr ret)))) (if (setq ret (std11-parse-route-addr lal)) (cons (list 'phrase-route-addr phrase (cdr (car ret))) (cdr ret))))) (defun std11-parse-mailbox (lal) (let ((ret (or (std11-parse-phrase-route-addr lal) (std11-parse-addr-spec lal))) mbox comment) (if (and ret (prog1 (setq mbox (car ret)) (setq lal (cdr ret)) (if (and (setq ret (std11-parse-token-or-comment lal)) (setq comment (cdr (assq 'comment (car ret))))) (setq lal (cdr ret))))) (cons (list 'mailbox mbox comment) lal)))) (defun std11-parse-group (lal) (let ((ret (std11-parse-phrase lal)) phrase colon comma mbox semicolon) (if (and ret (setq phrase (cdr (car ret))) (setq lal (cdr ret)) (setq ret (std11-parse-ascii-token lal)) (setq colon (car ret)) (string-equal (cdr (assq 'specials colon)) ":") (setq lal (cdr ret)) (progn (and (setq ret (std11-parse-mailbox lal)) (setq mbox (list (car ret))) (setq lal (cdr ret)) (while (and (setq ret (std11-parse-ascii-token lal)) (setq comma (car ret)) (string-equal (cdr (assq 'specials comma)) ",") (setq lal (cdr ret)) (setq ret (std11-parse-mailbox lal)) (setq mbox (cons (car ret) mbox)) (setq lal (cdr ret))))) (and (setq ret (std11-parse-ascii-token lal)) (setq semicolon (car ret)) (string-equal (cdr (assq 'specials semicolon)) ";") ))) (cons (list 'group phrase (nreverse mbox)) (cdr ret))))) (defun std11-parse-address (lal) (or (std11-parse-group lal) (std11-parse-mailbox lal))) (defun std11-parse-addresses (lal) (let ((ret (std11-parse-address lal))) (if ret (let ((dest (list (car ret)))) (setq lal (cdr ret)) (while (and (setq ret (std11-parse-ascii-token lal)) (string-equal (cdr (assq 'specials (car ret))) ",") (setq ret (std11-parse-address (cdr ret)))) (setq dest (cons (car ret) dest)) (setq lal (cdr ret))) (nreverse dest))))) (defun std11-parse-msg-id (lal) (let ((ret (std11-parse-ascii-token lal)) < addr-spec >) (if (and ret (setq < (car ret)) (string-equal (cdr (assq 'specials <)) "<") (setq lal (cdr ret)) (setq ret (std11-parse-addr-spec lal)) (setq addr-spec (car ret)) (setq lal (cdr ret)) (setq ret (std11-parse-ascii-token lal)) (setq > (car ret)) (string-equal (cdr (assq 'specials >)) ">")) (cons (cons 'msg-id (cdr addr-spec)) (cdr ret))))) (defun std11-parse-msg-ids (tokens) "Parse lexical TOKENS as `*(phrase / msg-id)', and return the result." (let ((ret (or (std11-parse-msg-id tokens) (std11-parse-phrase tokens)))) (if ret (let ((dest (list (car ret)))) (setq tokens (cdr ret)) (while (setq ret (or (std11-parse-msg-id tokens) (std11-parse-phrase tokens))) (setq dest (cons (car ret) dest)) (setq tokens (cdr ret))) (nreverse dest))))) (defalias 'std11-parse-in-reply-to 'std11-parse-msg-ids) (make-obsolete 'std11-parse-in-reply-to 'std11-parse-msg-ids "23 Jan 1999") ;;; @ composer ;;; (defun std11-addr-to-string (seq) "Return string from lexical analyzed list SEQ represents addr-spec of RFC 822." (mapconcat (lambda (token) (let ((name (car token))) (cond ((memq name '(spaces comment)) nil) ((eq name 'quoted-string) (concat "\"" (cdr token) "\"")) ((eq name 'domain-literal) (concat "[" (cdr token) "]")) (t (cdr token))))) seq nil)) ;;;###autoload (defun std11-address-string (address) "Return string of address part from parsed ADDRESS of RFC 822." (cond ((eq (car address) 'group) (mapconcat (function std11-address-string) (nth 2 address) ", ")) ((eq (car address) 'mailbox) (let ((addr (nth 1 address))) (std11-addr-to-string (if (eq (car addr) 'phrase-route-addr) (nth 2 addr) (cdr addr))))))) (defun std11-comment-value-to-string (value) (if (stringp value) (std11-strip-quoted-pair value) (let (dest) (while value (setq dest (if (stringp (car value)) (cons (car value) dest) (cons ")" (cons (std11-comment-value-to-string (cdr (car value))) (cons "(" dest)))) value (cdr value))) (apply 'concat (nreverse dest))))) ;;;###autoload (defun std11-full-name-string (address) "Return string of full-name part from parsed ADDRESS of RFC 822." (cond ((eq (car address) 'group) (mapconcat 'cdr (nth 1 address) "")) ((eq (car address) 'mailbox) (let ((addr (nth 1 address)) (comment (nth 2 address)) phrase) (if (eq (car addr) 'phrase-route-addr) (setq phrase (mapconcat (lambda (token) (let ((type (car token))) (cond ((eq type 'quoted-string) (std11-strip-quoted-pair (cdr token))) ((eq type 'comment) (concat "(" (std11-comment-value-to-string (cdr token)) ")")) (t (cdr token))))) (nth 1 addr) ""))) (cond ((> (length phrase) 0) phrase) (comment (std11-comment-value-to-string comment))))))) ;;;###autoload (defun std11-msg-id-string (msg-id) "Return string from parsed MSG-ID of RFC 822." (concat "<" (std11-addr-to-string (cdr msg-id)) ">")) ;;;###autoload (defun std11-fill-msg-id-list-string (string &optional column) "Fill list of msg-id in STRING, and return the result." (or column (setq column 12)) (let ((lal (std11-lexical-analyze string)) dest) (let ((ret (std11-parse-msg-id lal))) (if ret (let* ((str (std11-msg-id-string (car ret))) (len (length str))) (setq lal (cdr ret)) (if (> (+ len column) 76) (setq dest (cons str (cons "\n " dest)) column (1+ len)) (setq dest str column (+ column len)))) (setq dest (cons (cdr (car lal)) dest) lal (cdr lal)))) (while lal (let ((ret (std11-parse-msg-id lal))) (if ret (let* ((str (std11-msg-id-string (car ret))) (len (1+ (length str)))) (setq lal (cdr ret)) (if (> (+ len column) 76) (setq dest (cons str (cons "\n " dest)) column len) (setq dest (cons str (cons " " dest)) column (+ column len)))) (setq dest (cons (cdr (car lal)) dest) lal (cdr lal))))) (apply 'concat (nreverse dest)))) ;;; @ parser with lexical analyzer ;;; ;;;###autoload (defun std11-parse-address-string (string) "Parse STRING as mail address." (std11-parse-address (std11-lexical-analyze string))) ;;;###autoload (defun std11-parse-addresses-string (string) "Parse STRING as mail address list." (std11-parse-addresses (std11-lexical-analyze string))) ;;;###autoload (defun std11-parse-msg-id-string (string) "Parse STRING as msg-id." (std11-parse-msg-id (std11-lexical-analyze string))) ;;;###autoload (defun std11-parse-msg-ids-string (string) "Parse STRING as `*(phrase / msg-id)'." (std11-parse-msg-ids (std11-lexical-analyze string))) ;;;###autoload (defun std11-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." (let* ((structure (car (std11-parse-address-string (std11-unfold-string string)))) (phrase (std11-full-name-string structure)) (address (std11-address-string structure))) (list phrase address))) ;;; @ end ;;; (provide 'std11) ;;; std11.el ends here wanderlust-flim-2cf5a78/tests/000077500000000000000000000000001436773573300164345ustar00rootroot00000000000000wanderlust-flim-2cf5a78/tests/test-hmac-md5.el000066400000000000000000000036421436773573300213330ustar00rootroot00000000000000(require 'lunit) (require 'hmac-md5) (luna-define-class test-hmac-md5 (lunit-test-case)) (luna-define-method test-hmac-md5-1 ((case test-hmac-md5)) (lunit-assert (string= (encode-hex-string (hmac-md5 "Hi There" (make-string 16 ?\x0b))) "9294727a3638bb1c13f48ef8158bfc9d"))) (luna-define-method test-hmac-md5-2 ((case test-hmac-md5)) (lunit-assert (string= (encode-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe")) "750c783e6ab0b503eaa86e310a5db738"))) (luna-define-method test-hmac-md5-3 ((case test-hmac-md5)) (lunit-assert (string= (encode-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa))) "56be34521d144c88dbb8c733f0e8b3f6"))) (luna-define-method test-hmac-md5-4 ((case test-hmac-md5)) (lunit-assert (string= (encode-hex-string (hmac-md5 (make-string 50 ?\xcd) (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819"))) "697eaf0aca3a3aea3a75164746ffaa79"))) (luna-define-method test-hmac-md5-5 ((case test-hmac-md5)) (lunit-assert (string= (encode-hex-string (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c))) "56461ef2342edc00f9bab995690efd4c"))) (luna-define-method test-hmac-md5-6 ((case test-hmac-md5)) (lunit-assert (string= (encode-hex-string (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c))) "56461ef2342edc00f9bab995"))) (luna-define-method test-hmac-md5-7 ((case test-hmac-md5)) (lunit-assert (string= (encode-hex-string (hmac-md5 "Test Using Larger Than Block-Size Key - Hash Key First" (make-string 80 ?\xaa))) "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"))) (luna-define-method test-hmac-md5-8 ((case test-hmac-md5)) (lunit-assert (string= (encode-hex-string (hmac-md5 "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" (make-string 80 ?\xaa))) "6f630fad67cda0ee1fb1f562db3aa53e"))) wanderlust-flim-2cf5a78/tests/test-hmac-sha1.el000066400000000000000000000037611436773573300215040ustar00rootroot00000000000000(require 'lunit) (require 'hmac-sha1) (luna-define-class test-hmac-sha1 (lunit-test-case)) (luna-define-method test-hmac-sha1-1 ((case test-hmac-sha1)) (lunit-assert (string= (encode-hex-string (hmac-sha1 "Hi There" (make-string 20 ?\x0b))) "b617318655057264e28bc0b6fb378c8ef146be00"))) (luna-define-method test-hmac-sha1-2 ((case test-hmac-sha1)) (lunit-assert (string= (encode-hex-string (hmac-sha1 "what do ya want for nothing?" "Jefe")) "effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"))) (luna-define-method test-hmac-sha1-3 ((case test-hmac-sha1)) (lunit-assert (string= (encode-hex-string (hmac-sha1 (make-string 50 ?\xdd) (make-string 20 ?\xaa))) "125d7342b9ac11cd91a39af48aa17b4f63f175d3"))) (luna-define-method test-hmac-sha1-4 ((case test-hmac-sha1)) (lunit-assert (string= (encode-hex-string (hmac-sha1 (make-string 50 ?\xcd) (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819"))) "4c9007f4026250c6bc8414f9bf50c86c2d7235da"))) (luna-define-method test-hmac-sha1-5 ((case test-hmac-sha1)) (lunit-assert (string= (encode-hex-string (hmac-sha1 "Test With Truncation" (make-string 20 ?\x0c))) "4c1a03424b55e07fe7f27be1d58bb9324a9a5a04"))) (luna-define-method test-hmac-sha1-6 ((case test-hmac-sha1)) (lunit-assert (string= (encode-hex-string (hmac-sha1-96 "Test With Truncation" (make-string 20 ?\x0c))) "4c1a03424b55e07fe7f27be1"))) (luna-define-method test-hmac-sha1-7 ((case test-hmac-sha1)) (lunit-assert (string= (encode-hex-string (hmac-sha1 "Test Using Larger Than Block-Size Key - Hash Key First" (make-string 80 ?\xaa))) "aa4ae5e15272d00e95705637ce8a3b55ed402112"))) (luna-define-method test-hmac-sha1-8 ((case test-hmac-sha1)) (lunit-assert (string= (encode-hex-string (hmac-sha1 "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" (make-string 80 ?\xaa))) "e8e99d0f45237d786d6bbaa7965c7808bbff1a91"))) wanderlust-flim-2cf5a78/tests/test-rfc2231.el000066400000000000000000000154561436773573300210300ustar00rootroot00000000000000(require 'lunit) (require 'mime) (luna-define-class test-rfc2231 (lunit-test-case)) ;;; ;;; Parameter Value Continuations ;;; ;; The content-type field ;; ;; Content-Type: message/external-body; access-type=URL; ;; URL*0="ftp://"; ;; URL*1="cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar" ;; ;; is semantically identical to ;; ;; Content-Type: message/external-body; access-type=URL; ;; URL="ftp://cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar" ;; (luna-define-method test-rfc2231-continuation-1 ((case test-rfc2231)) (lunit-assert (eq (mime-content-type-primary-type (mime-parse-Content-Type "message/external-body; access-type=URL; URL*0=\"ftp://\"; URL*1=\"cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar\"")) (mime-content-type-primary-type (mime-parse-Content-Type "message/external-body; access-type=URL; URL=\"ftp://cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar\""))))) (luna-define-method test-rfc2231-continuation-2 ((case test-rfc2231)) (lunit-assert (eq (mime-content-type-subtype (mime-parse-Content-Type "message/external-body; access-type=URL; URL*0=\"ftp://\"; URL*1=\"cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar\"")) (mime-content-type-subtype (mime-parse-Content-Type "message/external-body; access-type=URL; URL=\"ftp://cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar\""))))) (luna-define-method test-rfc2231-continuation-3 ((case test-rfc2231)) (lunit-assert (string= (mime-content-type-parameter (mime-parse-Content-Type "message/external-body; access-type=URL; URL*0=\"ftp://\"; URL*1=\"cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar\"") "access-type") (mime-content-type-parameter (mime-parse-Content-Type "message/external-body; access-type=URL; URL=\"ftp://cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar\"") "access-type")))) (luna-define-method test-rfc2231-continuation-4 ((case test-rfc2231)) (lunit-assert (string= (mime-content-type-parameter (mime-parse-Content-Type "message/external-body; access-type=URL; URL*0=\"ftp://\"; URL*1=\"cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar\"") "url") (mime-content-type-parameter (mime-parse-Content-Type "message/external-body; access-type=URL; URL=\"ftp://cs.utk.edu/pub/moore/bulk-mailer/bulk-mailer.tar\"") "url")))) ;;; ;;; Parameter Value Character Set and Language Information ;;; ;; Content-Type: application/x-stuff; ;; title*=us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A (luna-define-method test-rfc2231-charset-language-1 ((case test-rfc2231)) (lunit-assert (string= (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*=us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A") "title") "This is ***fun***"))) (luna-define-method test-rfc2231-charset-language-2 ((case test-rfc2231)) (lunit-assert (string= (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*=''This%20is%20%2A%2A%2Afun%2A%2A%2A") "title") "This is ***fun***"))) ;;; ;;; Combining Character Set, Language, and Parameter Continuations ;;; ;; Content-Type: application/x-stuff; ;; title*0*=us-ascii'en'This%20is%20even%20more%20; ;; title*1*=%2A%2A%2Afun%2A%2A%2A%20; ;; title*2="isn't it!" (luna-define-method test-rfc2231-charset-language-continuation-1 ((case test-rfc2231)) (lunit-assert (string= (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*0*=us-ascii'en'This%20is%20even%20more%20; title*1*=%2A%2A%2Afun%2A%2A%2A%20; title*2=\"isn't it!\"") "title") "This is even more ***fun*** isn't it!"))) ;; MIME states that parameters are not order sensitive. (luna-define-method test-rfc2231-charset-language-continuation-2 ((case test-rfc2231)) (lunit-assert (string= (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*2=\"isn't it!\"; title*1*=%2A%2A%2Afun%2A%2A%2A%20; title*0*=us-ascii'en'This%20is%20even%20more%20") "title") "This is even more ***fun*** isn't it!"))) ;; ABNF states that `ext-octet' is case-insensitive. (luna-define-method test-rfc2231-charset-language-continuation-3 ((case test-rfc2231)) (lunit-assert (let ((case-fold-search nil)) (string= (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*=us-ascii'en-us'This%20is%20%2a%2a%2afun%2a%2a%2a") "title") "This is ***fun***")))) ;; unencoded segments MUST NOT be decoded. (luna-define-method test-rfc2231-charset-language-continuation-4 ((case test-rfc2231)) (lunit-assert (string= (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*0*=us-ascii'en'This%20is%20even%20more%20; title*1*=%2A%2A%2Afun%2A%2A%2A%20; title*2=\"isn%27t%20it!\"") "title") "This is even more ***fun*** isn%27t%20it!"))) ;;; ;;; Language specification in Encoded Words ;;; (luna-define-method test-rfc2231-encoded-word-1 ((case test-rfc2231)) (lunit-assert (string= (eword-decode-string "=?US-ASCII?Q?Keith_Moore?=") "Keith Moore"))) (luna-define-method test-rfc2231-encoded-word-2 ((case test-rfc2231)) (lunit-assert (string= (eword-decode-string "=?US-ASCII*EN?Q?Keith_Moore?=") "Keith Moore"))) (luna-define-method test-rfc2231-encoded-word-3 ((case test-rfc2231)) (lunit-assert (eq (get-text-property 0 'mime-language (eword-decode-string "=?US-ASCII*EN?Q?Keith_Moore?=")) 'en))) ;;; ;;; Language specification in FLIM ;;; ;; both flim-1_13-rfc2231 and flim-1_14-rfc2231 choose to put language ;; info to the `mime-language' text-property of the parameter value. (luna-define-method test-rfc2231-mime-language-1 ((case test-rfc2231)) (lunit-assert (eq (get-text-property 0 'mime-language (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*=us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A") "title")) 'en-us))) (luna-define-method test-rfc2231-mime-language-2 ((case test-rfc2231)) (lunit-assert (eq (get-text-property 0 'mime-language (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*=US-ASCII'EN-US'This%20is%20%2A%2A%2Afun%2A%2A%2A") "title")) 'en-us))) (luna-define-method test-rfc2231-mime-language-3 ((case test-rfc2231)) (lunit-assert (null (get-text-property 0 'mime-language (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*=us-ascii''This%20is%20%2A%2A%2Afun%2A%2A%2A") "title"))))) (luna-define-method test-rfc2231-mime-language-4 ((case test-rfc2231)) (lunit-assert (null (get-text-property 0 'mime-language (mime-content-type-parameter (mime-parse-Content-Type "application/x-stuff; title*=''This%20is%20%2A%2A%2Afun%2A%2A%2A") "title"))))) wanderlust-flim-2cf5a78/tests/test-sasl.el000066400000000000000000000102521436773573300206750ustar00rootroot00000000000000(require 'lunit) (require 'sasl) (luna-define-class test-sasl (lunit-test-case)) (luna-define-method test-sasl-find-mechanism ((case test-sasl)) (let ((mechanisms sasl-mechanisms)) (while mechanisms (let* ((sasl-mechanisms (list (car mechanisms)))) (lunit-assert (sasl-find-mechanism (list (car mechanisms))))) (setq mechanisms (cdr mechanisms))))) (luna-define-method test-sasl-digest-md5-imap ((case test-sasl)) (let* ((sasl-mechanisms '("DIGEST-MD5")) (mechanism (sasl-find-mechanism '("DIGEST-MD5"))) (client (sasl-make-client mechanism "chris" "imap" "elwood.innosoft.com")) (sasl-read-passphrase #'(lambda (prompt) "secret")) step response) (sasl-client-set-property client 'realm "elwood.innosoft.com") (sasl-client-set-property client 'cnonce "OA6MHXh6VqTrRk") (setq step (sasl-next-step client nil)) (sasl-step-set-data step "realm=\"elwood.innosoft.com\",nonce=\"OA6MG9tEQGm2hh\",\ qop=\"auth\",algorithm=md5-sess,charset=utf-8") (setq step (sasl-next-step client step)) (sasl-step-data step) (setq response (sasl-digest-md5-parse-string (sasl-step-data step))) (lunit-assert (string= (plist-get response 'response) "d388dad90d4bbd760a152321f2143af7")))) (luna-define-method test-sasl-digest-md5-acap ((case test-sasl)) (let* ((sasl-mechanisms '("DIGEST-MD5")) (mechanism (sasl-find-mechanism '("DIGEST-MD5"))) (client (sasl-make-client mechanism "chris" "acap" "elwood.innosoft.com")) (sasl-read-passphrase #'(lambda (prompt) "secret")) step response) (sasl-client-set-property client 'realm "elwood.innosoft.com") (sasl-client-set-property client 'cnonce "OA9BSuZWMSpW8m") (setq step (sasl-next-step client nil)) (sasl-step-set-data step "realm=\"elwood.innosoft.com\",nonce=\"OA9BSXrbuRhWay\",qop=\"auth\",\ algorithm=md5-sess,charset=utf-8") (setq step (sasl-next-step client step)) (sasl-step-data step) (setq response (sasl-digest-md5-parse-string (sasl-step-data step))) (lunit-assert (string= (plist-get response 'response) "6084c6db3fede7352c551284490fd0fc")))) (luna-define-method test-sasl-scram-md5-imap ((case test-sasl)) (let* ((sasl-mechanisms '("SCRAM-MD5")) (mechanism (sasl-find-mechanism '("SCRAM-MD5"))) (client (sasl-make-client mechanism "chris" "imap" "eleanor.innosoft.com")) (sasl-read-passphrase #'(lambda (prompt) "secret stuff")) step response) (sasl-client-set-property client 'nonce "") (setq step (sasl-next-step client nil)) (sasl-step-set-data step "") (setq step (sasl-next-step client step)) (sasl-step-set-data step (base64-decode-string "dGVzdHNhbHQBAAAAaW1hcEBlbGVhbm9yLmlubm9zb2Z0LmNvbQBqaGNOWmxSdVBiemlGcCt2TFYrTkN3")) (setq step (sasl-next-step client step)) (lunit-assert (string= (sasl-step-data step) (base64-decode-string "AQAAAMg9jU8CeB4KOfk7sUhSQPs="))))) (luna-define-method test-sasl-ntlm-imap ((case test-sasl)) (let* ((sasl-mechanisms '("NTLM")) (mechanism (sasl-find-mechanism '("NTLM"))) (client (sasl-make-client mechanism "kawagish@nokiaseap" "imap" "xxx.yyy.com")) (sasl-read-passphrase #'(lambda (passphrase) "!\"#456secret")) step response) ;; init (setq step (sasl-next-step client nil)) ;; generate authentication request (sasl-step-set-data step "") (setq step (sasl-next-step client step)) (sasl-step-data step) ;; (base64-encode-string (sasl-step-data step) t) is sent to server ;; generate response to challenge (sasl-step-set-data step (string-as-unibyte (base64-decode-string "TlRMTVNTUAACAAAADAAMADAAAAAFggEApmEjGvh9M8YAAAAAAAAAAAAAAAA8AAAATgBPAEsARQBYAEMA"))) (setq step (sasl-next-step client step)) (sasl-step-data step) (setq response (base64-encode-string (sasl-step-data step) t)) (lunit-assert (string= response "TlRMTVNTUAADAAAAGAAYAEAAAAAYABgAWAAAABIAEgBwAAAAEAAQAIIAAAAQABAAkgAAAAAAAABiAAAABYIBAIwN9i7qK/9Y31dIDR6JQTaBbjcLJm8Sc6VogMe7fnHP96+eQ5Yf3ys2nIY4rx+iQG4AbwBrAGkAYQBzAGUAYQBwAGsAYQB3AGEAZwBpAHMAaABrAGEAdwBhAGcAaQBzAGgA")) ;;response ))