pax_global_header00006660000000000000000000000064117470361240014517gustar00rootroot0000000000000052 comment=fee392e509542aa7cf623f611b8f2b2de7abf72c flim-fee392e/000077500000000000000000000000001174703612400131525ustar00rootroot00000000000000flim-fee392e/ChangeLog000066400000000000000000004446201174703612400147360ustar00rootroot000000000000002012-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. 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() on Emacs 23.1. (quoted-printable-ccl-decode-region) (quoted-printable-ccl-write-decoded-region): Use quoted-printable-ccl-decode-string on Emacs 23.1. * 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-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-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-Dò) released.-A 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-Dò) released.-A 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-Dò) released.-A 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-Dü-mae) released.-A 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-Dòmae) released.-A 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-Dò) released.-A 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-Düzaki) released.-A 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-Dòenmae) released.-A 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-Dòriyama) released.-A 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-Dò) released.-A 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-Dò) released.-A 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-Dò) was released.-A * 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-Dòsono) was released.-A 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-Dòdo) was released.-A * 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-Dò) was released.-A * 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-Dò) was released.-A 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 (-DÃ’kubo) was released.-A * 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-Dò) was released.-A 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-Dòmae) was released.-A 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-Düjò) was released.-A * 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-Dòji) was released.-A 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-Dòto) was released.-A * 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). flim-fee392e/FLIM-API.en000066400000000000000000000530541174703612400146430ustar00rootroot00000000000000 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] flim-fee392e/FLIM-CFG000066400000000000000000000034341174703612400142250ustar00rootroot00000000000000;;; -*-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)) (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 flim-fee392e/FLIM-ELS000066400000000000000000000023651174703612400142530ustar00rootroot00000000000000;;; -*-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-cram sasl-digest md4 ntlm sasl-ntlm sasl-scram smtp qmtp)) (setq flim-version-specific-modules nil) (setq hmac-modules '(hex-util hmac-def md5 sha1 hmac-md5 hmac-sha1)) (if (and (fboundp 'base64-encode-string) (subrp (symbol-function 'base64-encode-string))) nil (if (fboundp 'dynamic-link) (setq flim-modules (cons 'mel-b-dl flim-modules)))) (setq flim-modules (cons 'mel-b-el flim-modules)) (require 'pccl) (unless-broken ccl-usable (setq flim-modules (cons 'mel-b-ccl (cons 'mel-q-ccl flim-modules)))) (if (and (fboundp 'md5) (subrp (symbol-function 'md5))) nil (if (fboundp 'dynamic-link) (setq hmac-modules (cons 'md5-dl hmac-modules)) (setq hmac-modules (cons 'md5-el hmac-modules)))) (if (fboundp 'dynamic-link) (setq hmac-modules (cons 'sha1-dl hmac-modules)) (setq hmac-modules (cons 'sha1-el hmac-modules))) (setq flim-modules (nconc hmac-modules flim-modules)) ;;; FLIM-ELS ends here flim-fee392e/FLIM-MK000066400000000000000000000061561174703612400141410ustar00rootroot00000000000000;;; -*-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)) (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))) (defun config-flim-package () (let (package-dir) (and (setq package-dir (car command-line-args-left)) (or (string= "NONE" package-dir) (defvar PACKAGEDIR package-dir))) (setq command-line-args-left (cdr command-line-args-left)) (load-file "FLIM-CFG") (load-file "FLIM-ELS") (setq flim-modules (append flim-modules '(auto-autoloads custom-load))) (princ (format "PACKAGEDIR=%s\n" PACKAGEDIR)))) (defun compile-flim-package () (config-flim-package) (if (fboundp 'batch-update-directory-autoloads) ;; XEmacs 21.5.19 and newer. (progn (add-to-list 'command-line-args-left ".") (add-to-list 'command-line-args-left "flim") (batch-update-directory-autoloads)) (setq autoload-package-name "flim") (add-to-list 'command-line-args-left ".") (batch-update-directory)) (add-to-list 'command-line-args-left ".") (Custom-make-dependencies) (compile-elisp-modules flim-version-specific-modules ".") (compile-elisp-modules flim-modules ".")) (defun install-flim-package () (config-flim-package) (install-elisp-modules (append flim-version-specific-modules flim-modules) "./" (expand-file-name FLIM_PREFIX (expand-file-name "lisp" PACKAGEDIR))) (delete-file "./auto-autoloads.el") (delete-file "./custom-load.el")) ;;; FLIM-MK ends here flim-fee392e/Makefile000066400000000000000000000034141174703612400146140ustar00rootroot00000000000000# # 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 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) CVS_HOST = cvs.m17n.org elc: $(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) \ $(VERSION_SPECIFIC_LISPDIR) check: $(EMACS) $(FLAGS) -f check-flim $(PREFIX) $(LISPDIR) \ $(VERSION_SPECIFIC_LISPDIR) install: elc $(EMACS) $(FLAGS) -f install-flim $(PREFIX) $(LISPDIR) \ $(VERSION_SPECIFIC_LISPDIR) package: $(XEMACS) $(FLAGS) -f compile-flim-package $(PACKAGEDIR) install-package: package $(XEMACS) $(FLAGS) -f install-flim-package $(PACKAGEDIR) clean: -$(RM) $(GOMI) tar: cvs commit sh -c 'cvs tag -R $(PACKAGE)-`echo $(VERSION) | tr . _`; \ cd /tmp; \ cvs -d :pserver:anonymous@$(CVS_HOST):/cvs/root \ export -d $(PACKAGE)-$(VERSION) \ -r $(PACKAGE)-`echo $(VERSION) | tr . _` \ flim' cd /tmp; $(RM) $(PACKAGE)-$(VERSION)/ftp.in ; \ $(TAR) cvzf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION) cd /tmp; $(RM) -r $(PACKAGE)-$(VERSION) sed "s/VERSION/$(VERSION)/" < ftp.in | sed "s/API/$(API)/" \ | sed "s/PACKAGE/$(PACKAGE)/" > ftp 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 . flim-fee392e/NEWS000066400000000000000000000104741174703612400136570ustar00rootroot00000000000000FLIM 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: flim-fee392e/README.en000066400000000000000000000100561174703612400144350ustar00rootroot00000000000000[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 mailcap.el --- mailcap parser and utility 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) flim-fee392e/README.ja000066400000000000000000000116641174703612400144330ustar00rootroot00000000000000[FLIM $B$N(B README ($BF|K\8lHG(B)] FLIM $B$H$O!)(B =========== FLIM $B$O(B Internet message $B$K4X$9$kMM!9$JI=8=7A<0$dId9f2=$K4X$9$k4pAC(B $BE*$J5!G=$rDs6!$9$k$?$a$NHFMQItIJ$G$9!#(BFLIM $B$O0J2<$N%b%8%e!<%k$+$i9=(B $B@.$5$l$F$$$^$9(B: std11.el --- STD 11 (RFC 822) $B7A<0$K4p$E$/2r@O=hM}Ey(B mime.el --- MIME-entity $B$K4X$9$k=t5!G=$NDs6!(B mime-def.el --- MIME $B7A<0$K4X$9$kDj5A(B mime-parse.el --- MIME $B2r@O4o(B mel.el --- MIME $BId9f4o(B/$BI|9f4o(B mel-b-dl.el --- base64 (B-encoding) $BId9f4o(B/$BI|9f4o(B (dynamic loading $B5!G=IU$-(B Emacs 20 $BMQ(B) mel-b-ccl.el --- base64 (B-encoding) encoder/decoder (using CCL) mel-b-el.el --- base64 (B-encoding) $BId9f4o(B/$BI|9f4o(B ($BB>$N(B emacsen $BMQ(B) mel-q-ccl.el --- quoted-printable and Q-encoding encoder/decoder (using CCL) mel-q.el --- quoted-printable $B$H(B Q-encoding $BId9f4o(B/$BI|9f4o(B mel-u.el --- uuencode $B$N$?$a$NHs8x<0(B backend mel-g.el --- gzip64 $B$N$?$a$NHs8x<0(B backend eword-decode.el --- encoded-word $BI|9f4o(B eword-encode.el --- encoded-word $BId9f4o(B mailcap.el --- mailcap $B$N2r@O=hM}Ey(B $B0J2<$N4D6-$GF0:n$7$^$9!'(B Emacs 20.4 $B0J9_(B XEmacs 21.1 $B0J9_(B $BF3F~(B (Installation) =================== (0) $BF3F~(B (install) $B$9$kA0$K!"(BAPEL (10.7 $B0J9_(B) $B$rF3F~$7$F$/$@$5$$!#(BAPEL $B$O0J2<$N$H$3$m$Gl=j$X$NF3F~(B $BE83+$7$?>l=j$H$O0[$J$k>l=j$KF3F~$7$?$/$J$$$J$i!"(B % make $B$@$1$r$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"(B % make EMACS=xemacs `EMACS=...' $B$,>JN,$5$l$k$H!"(BEmacs=emacs $B$,;H$o$l$^$9!#(B (b) make install $BE83+$7$?>l=j$H$O0[$J$k>l=j$KF3F~$7$?$$$J$i!"(B % make install $B$r$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"(B % make install EMACS=xemacs `EMACS=...' $B$,>JN,$5$l$k$H!"(BEmacs=emacs $B$,;H$o$l$^$9!#(B Emacs Lisp $B%W%m%0%i%`$N$?$a$N%G%#%l%/%H%j!JN,$5$l$k$H!";XDj$5$l$?(B emacs $B%3%^%s%I$N%G%#%l%/%H%j!<(B $BLZ$N@\F,<-$,;HMQ$5$l$^$9(B ($B$*$=$i$/(B /usr/local $B$G$9(B)$B!#(B $BNc$($P!"(BPREFIX=/usr/local $B$H(B Emacs 20.7 $B$,;XDj$5$l$l$P!"0J2<$N%G%#%l(B $B%/%H%j!JN,$5$l$k$H!";XDj$5$l$?(B emacs $B$N%3%^%s%I$N(B site-lisp $B%G%#%l%/%H%j!<$,;H$o$l$^$9(B ($B$*$=$i$/(B /usr/local/share/emacs/site-lisp $B$+(B /usr/local/lib/xemacs/site-lisp) $B$G$9!#(B emu $B%b%8%e!<%k(B (APEL $B%Q%C%1!<%8$KF~$C$F$$$^$9(B) $B$,I8=`$G$J$$%G%#%l%/(B $B%H%j!<$KF3F~$5$l$F$$$k>l9g$O!"$=$l$i$N$"$k>l=j$r;XDj$9$kI,MW(B $B$,$"$j$^$9!#Nc$($P!'(B % make install VERSION_SPECIFIC_LISPDIR=~/elisp $B$I$N%U%!%$%k$,(B emu $B%b%8%e!<%k$+(B APEL $B%b%8%e!<%k$N0lIt$J$N$+!"$=$l$i(B $B$,$I$3$KF3F~$5$l$k$+$rCN$j$?$$$H$-$O!"$NA*Br2DG=$J@_Dj$r;XDj$9$k(B $B$3$H$,$G$-$^$9!#$=$N>\:Y$K4X$7$F$O(B FLIM-CFG $B%U%!%$%k$NCml9g$O!"(B % make install-package $B$r$r;XDj$9$k$3$H$,$G$-$^$9!#Nc!'(B % make install-package XEMACS=xemacs-21 `XEMACS=...' $B$,>JN,$5$l$k$H!"(BXEMACS=xemacs $B$,;HMQ$5$l$^$9!#(B $B%Q%C%1!<%8!&%G%#%l%/%H%j!<$r;XDj$9$k$3$H$,$G$-$^$9!#Nc!'(B % make install PACKAGEDIR=~/.xemacs `PACKAGEDIR=...' $B$,>JN,$5$l$k$H!"B8:_$9$k%Q%C%1!<%8!&%G%#%l%/%H%j!<(B $B$N:G=i$N$b$N$,;H$o$l$^$9!#(B $B!NCm0U!O(BXEmacs $B$N%Q%C%1!<%8!&%7%9%F%`$O(B XEmacs 21.0 $B$+$=$l0J9_$,I,MW(B $B$G$9!#(B $B%P%0Js9p(B ======== $B%P%0Js9p$d2~A1$NDs0F$r=q$$$?$H$-$O!"@'Hs(B Emacs-MIME $B%a!<%j%s%0%j%9%H(B $B$KAw$C$F$/$@$5$$(B: emacs-mime-ja@lists.chise.org $B!JF|K\8l!K(B emacs-mime-en@lists.chise.org $B!J1Q8l!K(B Emacs-MIME ML $B$rDL$7$F!"(BFLIM $B$N%P%0$rJs9p$7$?$j!"(BFLIM $B$N:G?7$N%j%j!<(B $B%9$r-Mh$N3HD%$N5DO@$r$7$?$j$9$k$3$H$,$G$-$^$9!#(B Emacs-MIME ML $B$K;22C$7$?$$J}$O!"0J2<$NJG$N5-=R$r8+$F9XFI JR, $(B5~ET;T8rDL6I(B-A 1.1.0 T-Dòji $(BEl;{(B-A 1.2.0 J-Dþjò $(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-Dòmae $(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 -DÒkubo $(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-Dòdo $(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-Dòsono $(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-Dòto 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-Dòriyama $(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-Dòenmae $(B%U%!%_%j!<8x1`A0(B-A 1.12.7 Y-Dþzaki $(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-Dòmae $(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/ ;; -DÒtò 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-Dþjò $(B==>r(B-A 1.6.0 Kuj-Dò $(B6e>r(B-A 1.6.1 Ky-Dòto $(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-Dòji $(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-Dòto $(B5~ET(B ; <=> $(B6aE4(B, $(B5~ET;T8rDL6I(B-A 1.12.1 T-Dòfukuji $(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 flim-fee392e/eword-decode.el000066400000000000000000000651111174703612400160410ustar00rootroot00000000000000;;; eword-decode.el --- RFC 2047 based encoded-word decoder for GNU Emacs ;; 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) (eval-when-compile (require 'cl)) ; list*, pop ;;; @ 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 (concat result (eword-decode-token token))) (setq tokens (cdr tokens))) 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 (if (eq type 'spaces) (concat result " ") (concat result (eword-decode-token token)) )))) 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 (concat result " " next-str) c next-c) (setq result (concat result "\n " next-str) c (1+ next-len))) (setq tokens (cdr tokens)) ) (let* ((str (eword-decode-token token))) (setq result (concat result str) c (+ c (string-width str))) )))) (if token (concat result (eword-decode-token token)) result)))) (defun eword-decode-unstructured-field-body (string &optional start-column max-column) (eword-decode-string (decode-mime-charset-string string default-mime-charset))) (defun eword-decode-and-unfold-unstructured-field-body (string &optional start-column max-column) (eword-decode-string (decode-mime-charset-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 (decode-mime-charset-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) ;;; @ 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 (caaar rest) (string-equal (downcase charset) (downcase (caaar rest))) (equal language (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 (caaar rest)) (condition-case err (decode-mime-charset-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 words) ? ))) " ")))) (when must-unfold (setq word (mapconcat (lambda (chr) (cond ((eq chr ?\n) "") ((eq chr ?\r) "") ((eq chr ?\t) " ") (t (char-to-string chr)))) (std11-unfold-string word) ""))) (when (setq language (cdaar rest)) (put-text-property 0 (length word) 'mime-language language word)) (setq words (concat word words) rest (cdr rest))) 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 (decode-mime-charset-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 (concat last-str (substring string from (1- i)) (char-to-string (aref string i))) i (1+ i) from i) ) ((eq chr ?\)) (setq ret (concat last-str (substring string from i))) (throw 'tag (cons (cons 'comment (nreverse (if (string= ret "") dest (cons (eword-decode-string (decode-mime-charset-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 (concat last-str (substring string from i)) dest (if (string= last-str "") (cons (car ret) dest) (list* (car ret) (eword-decode-string (decode-mime-charset-string last-str default-mime-charset) must-unfold) dest) ) i (cdr ret) from i last-str "") (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 (cons (cons 'atom (eword-decode-encoded-words (nreverse words) must-unfold)) 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 (decode-mime-charset-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 string (or start 0))) ret cell) (set-text-properties 0 (length key) nil key) (if (setq ret (assoc key eword-lexical-analyze-cache)) (cdr ret) (setq ret (eword-lexical-analyze-internal key 0 must-unfold)) (setq eword-lexical-analyze-cache (cons (cons key ret) eword-lexical-analyze-cache)) (if (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 (concat dest (if (stringp (car value)) (std11-wrap-as-quoted-pairs (car value) '(?( ?))) (eword-decode-token (car value)) )) value (cdr value)) ) (concat "(" 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 flim-fee392e/eword-encode.el000066400000000000000000000477261174703612400160670ustar00rootroot00000000000000;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs ;; 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-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 ;;; (defsubst eword-encode-char-type (character) (if (memq character '(? ?\t ?\n)) nil (char-charset character) )) (defun eword-encode-divide-into-charset-words (string) (let ((len (length string)) dest) (while (> len 0) (let* ((chr (aref string 0)) ;; (chr (sref string 0)) (charset (eword-encode-char-type chr)) (i 1) ;; (i (char-length chr)) ) (while (and (< i len) (setq chr (aref string i)) ;; (setq chr (sref string i)) (eq charset (eword-encode-char-type chr))) (setq i (1+ i)) ;; (setq i (char-next-index chr i)) ) (setq dest (cons (cons charset (substring string 0 i)) dest) string (substring string i) len (- len i)))) (nreverse dest))) ;;; @ word ;;; (defun eword-encode-charset-words-to-words (charset-words) (let (dest) (while charset-words (let* ((charset-word (car charset-words)) (charset (car charset-word)) ) (if charset (let ((charsets (list charset)) (str (cdr charset-word)) ) (catch 'tag (while (setq charset-words (cdr charset-words)) (setq charset-word (car charset-words) charset (car charset-word)) (if (null charset) (throw 'tag nil) ) (or (memq charset charsets) (setq charsets (cons charset charsets)) ) (setq str (concat str (cdr charset-word))) )) (setq dest (cons (cons charsets str) dest)) ) (setq dest (cons charset-word dest) charset-words (cdr charset-words) )))) (nreverse dest) )) ;;; @ rule ;;; (defmacro 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-charset-rule (charsets) (if charsets (let* ((charset (find-mime-charset-by-charsets charsets)) (encoding (cdr (or (assq charset mime-header-charset-encoding-alist) (cons charset mime-header-default-charset-encoding))))) (list charset encoding)))) ;; [tomo:2002-11-05] The following code is a quick-fix for emacsen ;; which is not depended on the Mule model. We should redesign ;; `eword-encode-split-string' to avoid to depend on the Mule model. (if (featurep 'utf-2000) ;; for CHISE Architecture (defun tm-eword::words-to-ruled-words (wl &optional mode) (let (mcs) (mapcar (function (lambda (word) (setq mcs (detect-mime-charset-string (cdr word))) (make-ew-rword (cdr word) mcs (cdr (or (assq mcs mime-header-charset-encoding-alist) (cons mcs mime-header-default-charset-encoding))) mode) )) wl))) ;; for legacy Mule (defun tm-eword::words-to-ruled-words (wl &optional mode) (mapcar (function (lambda (word) (let ((ret (ew-find-charset-rule (car word)))) (make-ew-rword (cdr word) (car ret)(nth 1 ret) mode) ))) wl)) ) (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::words-to-ruled-words (eword-encode-charset-words-to-words (eword-encode-divide-into-charset-words str)) mode))) ;;; @ length ;;; (defun tm-eword::encoded-word-length (rword) (let ((string (ew-rword-text rword)) (charset (ew-rword-charset rword)) (encoding (ew-rword-encoding rword)) ret) (setq ret (cond ((string-equal encoding "B") (setq string (encode-mime-charset-string string charset)) (base64-encoded-length string) ) ((string-equal encoding "Q") (setq string (encode-mime-charset-string string charset)) (Q-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) '(? ?\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)) '(? ?\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-charset-rule (find-charset-string str)))) (make-ew-rword str (car ret)(nth 1 ret) 'phrase) ) ))) ) ((eq type 'comment) (setq dest (append dest '(("(" nil nil special)) (tm-eword::words-to-ruled-words (eword-encode-charset-words-to-words (eword-encode-divide-into-charset-words (cdr token))) 'comment) '((")" nil nil special)) )) ) (t (setq dest (append dest (tm-eword::words-to-ruled-words (eword-encode-charset-words-to-words (eword-encode-divide-into-charset-words (cdr token)) ) 'phrase))) )) (setq phrase (cdr phrase)) ) (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 ;;; (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)))) ;;;###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) (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.") (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) ;;; @ end ;;; (provide 'eword-encode) ;;; eword-encode.el ends here flim-fee392e/ftp.in000066400000000000000000000006631174703612400143000ustar00rootroot00000000000000--<>-{ 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" --}-<> flim-fee392e/hex-util.el000066400000000000000000000050101174703612400152270ustar00rootroot00000000000000;;; hex-util.el --- Functions to encode/decode hexadecimal string. ;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keywords: data ;; 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: (eval-when-compile (defmacro hex-char-to-num (chr) (` (let ((chr (, chr))) (cond ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10)) ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10)) ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0)) (t (error "Invalid hexadecimal digit `%c'" chr)))))) (defmacro num-to-hex-char (num) (` (aref "0123456789abcdef" (, num))))) (defun decode-hex-string (string) "Decode hexadecimal STRING to octet string." (let* ((len (length string)) (dst (make-string (/ len 2) 0)) (idx 0)(pos 0)) (while (< pos len) ;;; logior and lsh are not byte-coded. ;;; (aset dst idx (logior (lsh (hex-char-to-num (aref string pos)) 4) ;;; (hex-char-to-num (aref string (1+ pos))))) (aset dst idx (+ (* (hex-char-to-num (aref string pos)) 16) (hex-char-to-num (aref string (1+ pos))))) (setq idx (1+ idx) pos (+ 2 pos))) dst)) (defun encode-hex-string (string) "Encode octet STRING to hexadecimal string." (let* ((len (length string)) (dst (make-string (* len 2) 0)) (idx 0)(pos 0)) (while (< pos len) ;;; logand and lsh are not byte-coded. ;;; (aset dst idx (num-to-hex-char (logand (lsh (aref string pos) -4) 15))) (aset dst idx (num-to-hex-char (/ (aref string pos) 16))) (setq idx (1+ idx)) ;;; (aset dst idx (num-to-hex-char (logand (aref string pos) 15))) (aset dst idx (num-to-hex-char (% (aref string pos) 16))) (setq idx (1+ idx) pos (1+ pos))) dst)) (provide 'hex-util) ;;; hex-util.el ends here flim-fee392e/hmac-def.el000066400000000000000000000060601174703612400151420ustar00rootroot00000000000000;;; hmac-def.el --- A macro for defining HMAC functions. ;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keywords: HMAC, RFC 2104 ;; 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 RFC 2104, ;; "HMAC: Keyed-Hashing for Message Authentication". ;;; Code: (defmacro define-hmac-function (name H B L &optional bit) "Define a function NAME(TEXT KEY) which computes HMAC with function H. HMAC function is H(KEY XOR opad, H(KEY XOR ipad, TEXT)): H is a cryptographic hash function, such as SHA1 and MD5, which takes a string and return a digest of it (in binary form). B is a byte-length of a block size of H. (B=64 for both SHA1 and MD5.) L is a byte-length of hash outputs. (L=16 for MD5, L=20 for SHA1.) If BIT is non-nil, truncate output to specified bits." (` (defun (, name) (text key) (, (concat "Compute " (upcase (symbol-name name)) " over TEXT with KEY.")) (let ((key-xor-ipad (make-string (, B) ?\x36)) (key-xor-opad (make-string (, B) ?\x5C)) (len (length key)) (pos 0)) (unwind-protect (progn ;; if `key' is longer than the block size, apply hash function ;; to `key' and use the result as a real `key'. (if (> len (, B)) (setq key ((, H) key) len (, L))) (while (< pos len) (aset key-xor-ipad pos (logxor (aref key pos) ?\x36)) (aset key-xor-opad pos (logxor (aref key pos) ?\x5C)) (setq pos (1+ pos))) (setq key-xor-ipad (unwind-protect (concat key-xor-ipad text) (fillarray key-xor-ipad 0)) key-xor-ipad (unwind-protect ((, H) key-xor-ipad) (fillarray key-xor-ipad 0)) key-xor-opad (unwind-protect (concat key-xor-opad key-xor-ipad) (fillarray key-xor-opad 0)) key-xor-opad (unwind-protect ((, H) key-xor-opad) (fillarray key-xor-opad 0))) ;; now `key-xor-opad' contains ;; H(KEY XOR opad, H(KEY XOR ipad, TEXT)). (, (if (and bit (< (/ bit 8) L)) (` (substring key-xor-opad 0 (, (/ bit 8)))) ;; return a copy of `key-xor-opad'. (` (concat key-xor-opad))))) ;; cleanup. (fillarray key-xor-ipad 0) (fillarray key-xor-opad 0)))))) (provide 'hmac-def) ;;; hmac-def.el ends here flim-fee392e/hmac-md5.el000066400000000000000000000061651174703612400150770ustar00rootroot00000000000000;;; hmac-md5.el --- Compute HMAC-MD5. ;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI ;; Keywords: HMAC, RFC 2104, HMAC-MD5, MD5, KEYED-MD5, CRAM-MD5 ;; 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-md5 "Hi There" (make-string 16 ?\x0b))) ;; => "9294727a3638bb1c13f48ef8158bfc9d" ;; ;; (encode-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe")) ;; => "750c783e6ab0b503eaa86e310a5db738" ;; ;; (encode-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa))) ;; => "56be34521d144c88dbb8c733f0e8b3f6" ;; ;; (encode-hex-string ;; (hmac-md5 ;; (make-string 50 ?\xcd) ;; (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819"))) ;; => "697eaf0aca3a3aea3a75164746ffaa79" ;; ;; (encode-hex-string ;; (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c))) ;; => "56461ef2342edc00f9bab995690efd4c" ;; ;; (encode-hex-string ;; (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c))) ;; => "56461ef2342edc00f9bab995" ;; ;; (encode-hex-string ;; (hmac-md5 ;; "Test Using Larger Than Block-Size Key - Hash Key First" ;; (make-string 80 ?\xaa))) ;; => "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd" ;; ;; (encode-hex-string ;; (hmac-md5 ;; "Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data" ;; (make-string 80 ?\xaa))) ;; => "6f630fad67cda0ee1fb1f562db3aa53e" ;;; Code: (eval-when-compile (require 'hmac-def)) (require 'hex-util) ; (decode-hex-string STRING) (require 'md5) ; expects (md5 STRING) ;; To share *.elc files between Emacs w/ and w/o DL patch, ;; this check must be done at load-time. (cond ((fboundp 'md5-binary) ;; do nothing. ) ((condition-case nil ;; `md5' of v21 takes 4th arg CODING (and 5th arg NOERROR). (md5 "" nil nil 'binary) ; => "d41d8cd98f00b204e9800998ecf8427e" (wrong-number-of-arguments nil)) (defun md5-binary (string) "Return the MD5 of STRING in binary form." (decode-hex-string (md5 string nil nil 'binary)))) (t (defun md5-binary (string) "Return the MD5 of STRING in binary form." (decode-hex-string (md5 string))))) (define-hmac-function hmac-md5 md5-binary 64 16) ; => (hmac-md5 TEXT KEY) (define-hmac-function hmac-md5-96 md5-binary 64 16 96) (provide 'hmac-md5) ;;; hmac-md5.el ends here flim-fee392e/hmac-sha1.el000066400000000000000000000055651174703612400152510ustar00rootroot00000000000000;;; hmac-sha1.el --- Compute HMAC-SHA1. ;; 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)) (require 'hex-util) ; (decode-hex-string STRING) (require 'sha1) ; expects (sha1 STRING) ;; To share *.elc files between Emacs w/ and w/o DL patch, ;; this check must be done at load-time. (cond ((fboundp 'sha1-binary) ;; do nothing. ) (t (defun sha1-binary (string) "Return the SHA1 of STRING in binary form." (decode-hex-string (sha1 string))))) (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 flim-fee392e/luna.el000066400000000000000000000327341174703612400144440ustar00rootroot00000000000000;;; luna.el --- tiny OOP system kernel ;; 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: (eval-when-compile (require 'cl)) ;;; @ 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)) (rest parents) parent name (i 2) b j) (while rest (setq parent (pop rest) 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)))) (setq rest slots) (while rest (setq name (symbol-name (pop rest))) (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) (or (stringp member-name) (setq member-name (symbol-name member-name))) (intern-soft 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) (or (stringp member-name) (setq member-name (symbol-name member-name))) (intern 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) ;;; (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 obarray) `(aset ,entity 1 ,obarray)) (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 luna-current-method-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. LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE." (let ((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)) (eval-when-compile (defvar luna-next-methods nil) (defvar luna-current-method-arguments nil)) (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 LUNA-CURRENT-METHOD-ARGUMENTS. (defun luna-apply-generic (entity message &rest luna-current-method-arguments) (let* ((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 flim-fee392e/lunit.el000066400000000000000000000247141174703612400146370ustar00rootroot00000000000000;;; lunit.el --- simple testing framework for luna ;; 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) (eval-when-compile (require 'cl)) ;;; @ 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: ") (save-excursion (set-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 flim-fee392e/mailcap.el000066400000000000000000000042551174703612400151100ustar00rootroot00000000000000;;; mailcap.el --- mailcap parser ;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Created: 1997-06-27 ;; 2000-11-24 Rewrote to use mime-conf.el. ;; Keywords: mailcap, setting, configuration, MIME, multimedia ;; Status: obsolete ;; 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-conf) (require 'poe) ; define-obsolete-function-alias (define-obsolete-function-alias 'mailcap-parse-buffer 'mime-parse-mailcap-buffer) (define-obsolete-function-alias 'mailcap-format-command 'mime-format-mailcap-command) (cond ((featurep 'xemacs) (define-obsolete-variable-alias 'mailcap-file 'mime-mailcap-file) (define-obsolete-function-alias 'mailcap-parse-file 'mime-parse-mailcap-file) ) (t (defvar mailcap-file mime-mailcap-file) (defun mailcap-parse-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. This function is obsolete. Please use mime-parse-mailcap-file instead." (if filename (mime-parse-mailcap-file filename order) (let ((mime-mailcap-file mailcap-file)) (mime-parse-mailcap-file nil order)))) (make-obsolete 'mailcap-parse-file 'mime-parse-mailcap-file) )) ;;; @ end ;;; (provide 'mailcap) ;;; mailcap.el ends here flim-fee392e/md4.el000066400000000000000000000205751174703612400141710ustar00rootroot00000000000000;;; md4.el --- MD4 Message Digest Algorithm. ;; Copyright (C) 2004 Free Software Foundation, Inc. ;; Copyright (C) 2001 Taro Kawagishi ;; Author: Taro Kawagishi ;; Keywords: MD4 ;; Version: 1.00 ;; Created: February 2001 ;; 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: ;;; ;;; MD4 hash calculation (defvar md4-buffer (make-vector 4 '(0 . 0)) "work buffer of four 32-bit integers") (defun md4 (in n) "Returns the MD4 hash string of 16 bytes long for a string IN of N bytes long. N is required to handle strings containing character 0." (let (m (b (cons 0 (* n 8))) (i 0) (buf (make-string 128 0)) c4) ;; initial values (aset md4-buffer 0 '(26437 . 8961)) ;0x67452301 (aset md4-buffer 1 '(61389 . 43913)) ;0xefcdab89 (aset md4-buffer 2 '(39098 . 56574)) ;0x98badcfe (aset md4-buffer 3 '(4146 . 21622)) ;0x10325476 ;; process the string in 64 bits chunks (while (> n 64) (setq m (md4-copy64 (substring in 0 64))) (md4-64 m) (setq in (substring in 64)) (setq n (- n 64))) ;; process the rest of the string (length is now n <= 64) (setq i 0) (while (< i n) (aset buf i (aref in i)) (setq i (1+ i))) (aset buf n 128) ;0x80 (if (<= n 55) (progn (setq c4 (md4-pack-int32 b)) (aset buf 56 (aref c4 0)) (aset buf 57 (aref c4 1)) (aset buf 58 (aref c4 2)) (aset buf 59 (aref c4 3)) (setq m (md4-copy64 buf)) (md4-64 m)) ;; else (setq c4 (md4-pack-int32 b)) (aset buf 120 (aref c4 0)) (aset buf 121 (aref c4 1)) (aset buf 122 (aref c4 2)) (aset buf 123 (aref c4 3)) (setq m (md4-copy64 buf)) (md4-64 m) (setq m (md4-copy64 (substring buf 64))) (md4-64 m))) (concat (md4-pack-int32 (aref md4-buffer 0)) (md4-pack-int32 (aref md4-buffer 1)) (md4-pack-int32 (aref md4-buffer 2)) (md4-pack-int32 (aref md4-buffer 3)))) (defsubst md4-F (x y z) (logior (logand x y) (logand (lognot x) z))) (defsubst md4-G (x y z) (logior (logand x y) (logand x z) (logand y z))) (defsubst md4-H (x y z) (logxor x y z)) (defmacro md4-make-step (name func) (` (defun (, name) (a b c d xk s ac) (let* ((h1 (+ (car a) ((, func) (car b) (car c) (car d)) (car xk) (car ac))) (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr xk) (cdr ac))) (h2 (logand 65535 (+ h1 (lsh l1 -16)))) (l2 (logand 65535 l1)) ;; cyclic shift of 32 bits integer (h3 (logand 65535 (if (> s 15) (+ (lsh h2 (- s 32)) (lsh l2 (- s 16))) (+ (lsh h2 s) (lsh l2 (- s 16)))))) (l3 (logand 65535 (if (> s 15) (+ (lsh l2 (- s 32)) (lsh h2 (- s 16))) (+ (lsh l2 s) (lsh h2 (- s 16))))))) (cons h3 l3))))) (md4-make-step md4-round1 md4-F) (md4-make-step md4-round2 md4-G) (md4-make-step md4-round3 md4-H) (defsubst md4-add (x y) "Return 32-bit sum of 32-bit integers X and Y." (let ((h (+ (car x) (car y))) (l (+ (cdr x) (cdr y)))) (cons (logand 65535 (+ h (lsh l -16))) (logand 65535 l)))) (defsubst md4-and (x y) (cons (logand (car x) (car y)) (logand (cdr x) (cdr y)))) (defun md4-64 (m) "Calculate md4 of 64 bytes chunk M which is represented as 16 pairs of 32 bits integers. The resulting md4 value is placed in md4-buffer." (let ((a (aref md4-buffer 0)) (b (aref md4-buffer 1)) (c (aref md4-buffer 2)) (d (aref md4-buffer 3))) (setq a (md4-round1 a b c d (aref m 0) 3 '(0 . 0)) d (md4-round1 d a b c (aref m 1) 7 '(0 . 0)) c (md4-round1 c d a b (aref m 2) 11 '(0 . 0)) b (md4-round1 b c d a (aref m 3) 19 '(0 . 0)) a (md4-round1 a b c d (aref m 4) 3 '(0 . 0)) d (md4-round1 d a b c (aref m 5) 7 '(0 . 0)) c (md4-round1 c d a b (aref m 6) 11 '(0 . 0)) b (md4-round1 b c d a (aref m 7) 19 '(0 . 0)) a (md4-round1 a b c d (aref m 8) 3 '(0 . 0)) d (md4-round1 d a b c (aref m 9) 7 '(0 . 0)) c (md4-round1 c d a b (aref m 10) 11 '(0 . 0)) b (md4-round1 b c d a (aref m 11) 19 '(0 . 0)) a (md4-round1 a b c d (aref m 12) 3 '(0 . 0)) d (md4-round1 d a b c (aref m 13) 7 '(0 . 0)) c (md4-round1 c d a b (aref m 14) 11 '(0 . 0)) b (md4-round1 b c d a (aref m 15) 19 '(0 . 0)) a (md4-round2 a b c d (aref m 0) 3 '(23170 . 31129)) ;0x5A827999 d (md4-round2 d a b c (aref m 4) 5 '(23170 . 31129)) c (md4-round2 c d a b (aref m 8) 9 '(23170 . 31129)) b (md4-round2 b c d a (aref m 12) 13 '(23170 . 31129)) a (md4-round2 a b c d (aref m 1) 3 '(23170 . 31129)) d (md4-round2 d a b c (aref m 5) 5 '(23170 . 31129)) c (md4-round2 c d a b (aref m 9) 9 '(23170 . 31129)) b (md4-round2 b c d a (aref m 13) 13 '(23170 . 31129)) a (md4-round2 a b c d (aref m 2) 3 '(23170 . 31129)) d (md4-round2 d a b c (aref m 6) 5 '(23170 . 31129)) c (md4-round2 c d a b (aref m 10) 9 '(23170 . 31129)) b (md4-round2 b c d a (aref m 14) 13 '(23170 . 31129)) a (md4-round2 a b c d (aref m 3) 3 '(23170 . 31129)) d (md4-round2 d a b c (aref m 7) 5 '(23170 . 31129)) c (md4-round2 c d a b (aref m 11) 9 '(23170 . 31129)) b (md4-round2 b c d a (aref m 15) 13 '(23170 . 31129)) a (md4-round3 a b c d (aref m 0) 3 '(28377 . 60321)) ;0x6ED9EBA1 d (md4-round3 d a b c (aref m 8) 9 '(28377 . 60321)) c (md4-round3 c d a b (aref m 4) 11 '(28377 . 60321)) b (md4-round3 b c d a (aref m 12) 15 '(28377 . 60321)) a (md4-round3 a b c d (aref m 2) 3 '(28377 . 60321)) d (md4-round3 d a b c (aref m 10) 9 '(28377 . 60321)) c (md4-round3 c d a b (aref m 6) 11 '(28377 . 60321)) b (md4-round3 b c d a (aref m 14) 15 '(28377 . 60321)) a (md4-round3 a b c d (aref m 1) 3 '(28377 . 60321)) d (md4-round3 d a b c (aref m 9) 9 '(28377 . 60321)) c (md4-round3 c d a b (aref m 5) 11 '(28377 . 60321)) b (md4-round3 b c d a (aref m 13) 15 '(28377 . 60321)) a (md4-round3 a b c d (aref m 3) 3 '(28377 . 60321)) d (md4-round3 d a b c (aref m 11) 9 '(28377 . 60321)) c (md4-round3 c d a b (aref m 7) 11 '(28377 . 60321)) b (md4-round3 b c d a (aref m 15) 15 '(28377 . 60321))) (aset md4-buffer 0 (md4-add a (aref md4-buffer 0))) (aset md4-buffer 1 (md4-add b (aref md4-buffer 1))) (aset md4-buffer 2 (md4-add c (aref md4-buffer 2))) (aset md4-buffer 3 (md4-add d (aref md4-buffer 3))) )) (defun md4-copy64 (seq) "Unpack a 64 bytes string into 16 pairs of 32 bits integers." (let ((int32s (make-vector 16 0)) (i 0) j) (while (< i 16) (setq j (* i 4)) (aset int32s i (cons (+ (aref seq (+ j 2)) (lsh (aref seq (+ j 3)) 8)) (+ (aref seq j) (lsh (aref seq (1+ j)) 8)))) (setq i (1+ i))) int32s)) ;;; ;;; sub functions (defun md4-pack-int16 (int16) "Pack 16 bits integer in 2 bytes string as little endian." (let ((str (make-string 2 0))) (aset str 0 (logand int16 255)) (aset str 1 (lsh int16 -8)) str)) (defun md4-pack-int32 (int32) "Pack 32 bits integer in a 4 bytes string as little endian. A 32 bits integer is represented as a pair of two 16 bits integers (cons high low)." (let ((str (make-string 4 0)) (h (car int32)) (l (cdr int32))) (aset str 0 (logand l 255)) (aset str 1 (lsh l -8)) (aset str 2 (logand h 255)) (aset str 3 (lsh h -8)) str)) (defun md4-unpack-int16 (str) (if (eq 2 (length str)) (+ (lsh (aref str 1) 8) (aref str 0)) (error "%s is not 2 bytes long" str))) (defun md4-unpack-int32 (str) (if (eq 4 (length str)) (cons (+ (lsh (aref str 3) 8) (aref str 2)) (+ (lsh (aref str 1) 8) (aref str 0))) (error "%s is not 4 bytes long" str))) (provide 'md4) ;;; md4.el ends here flim-fee392e/md5-dl.el000066400000000000000000000036451174703612400145660ustar00rootroot00000000000000;;; md5-dl.el --- MD5 Message Digest Algorithm using DL module. ;; 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: ;;; Code: (provide 'md5-dl) ; beware of circular dependency. (eval-when-compile (require 'md5)) ; md5-dl-module. ;;; This file is loaded (from "md5.el") only when md5-dl-module is exists. (defvar md5-dl-handle (dynamic-link md5-dl-module)) ;;; md5-dl-module provides `md5-string'. (dynamic-call "emacs_md5_init" md5-dl-handle) (defun md5-region (beg end) (md5-string (buffer-substring-no-properties beg end))) ;;; Note that v21 `md5' takes two more args: CODING and NOERROR. (defun md5 (object &optional beg end) "Return the MD5 (a secure message digest algorithm) of an object. OBJECT is either a string or a buffer. Optional arguments BEG and END denote buffer positions for computing the hash of a portion of OBJECT." (if (stringp object) (md5-string object) (save-excursion (set-buffer object) (md5-region (or beg (point-min)) (or end (point-max)))))) (provide 'md5-dl) ;;; md5-dl.el ends here flim-fee392e/md5-el.el000066400000000000000000000404151174703612400145630ustar00rootroot00000000000000;;; md5.el -- MD5 Message Digest Algorithm ;;; Gareth Rees ;; LCD Archive Entry: ;; md5|Gareth Rees|gdr11@cl.cam.ac.uk| ;; MD5 cryptographic message digest algorithm| ;; 13-Nov-95|1.0|~/misc/md5.el.Z| ;;; Details: ------------------------------------------------------------------ ;; This is a direct translation into Emacs LISP of the reference C ;; implementation of the MD5 Message-Digest Algorithm written by RSA ;; Data Security, Inc. ;; ;; The algorithm takes a message (that is, a string of bytes) and ;; computes a 16-byte checksum or "digest" for the message. This digest ;; is supposed to be cryptographically strong in the sense that if you ;; are given a 16-byte digest D, then there is no easier way to ;; construct a message whose digest is D than to exhaustively search the ;; space of messages. However, the robustness of the algorithm has not ;; been proven, and a similar algorithm (MD4) was shown to be unsound, ;; so treat with caution! ;; ;; The C algorithm uses 32-bit integers; because GNU Emacs ;; implementations provide 28-bit integers (with 24-bit integers on ;; versions prior to 19.29), the code represents a 32-bit integer as the ;; cons of two 16-bit integers. The most significant word is stored in ;; the car and the least significant in the cdr. The algorithm requires ;; at least 17 bits of integer representation in order to represent the ;; carry from a 16-bit addition. ;;; Usage: -------------------------------------------------------------------- ;; To compute the MD5 Message Digest for a message M (represented as a ;; string or as a vector of bytes), call ;; ;; (md5-encode M) ;; ;; which returns the message digest as a vector of 16 bytes. If you ;; need to supply the message in pieces M1, M2, ... Mn, then call ;; ;; (md5-init) ;; (md5-update M1) ;; (md5-update M2) ;; ... ;; (md5-update Mn) ;; (md5-final) ;;; Copyright and licence: ---------------------------------------------------- ;; Copyright (C) 1995, 1996, 1997 by Gareth Rees ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm ;; ;; md5.el 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. ;; ;; md5.el 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. ;; ;; The original copyright notice is given below, as required by the ;; licence for the original code. This code is distributed under *both* ;; RSA's original licence and the GNU General Public Licence. (There ;; should be no problems, as the former is more liberal than the ;; latter). ;;; Original copyright notice: ------------------------------------------------ ;; Copyright (C) 1990, RSA Data Security, Inc. All rights reserved. ;; ;; License to copy and use this software is granted provided that it is ;; identified as the "RSA Data Security, Inc. MD5 Message- Digest ;; Algorithm" in all material mentioning or referencing this software or ;; this function. ;; ;; License is also granted to make and use derivative works provided ;; that such works are identified as "derived from the RSA Data ;; Security, Inc. MD5 Message-Digest Algorithm" in all material ;; mentioning or referencing the derived work. ;; ;; RSA Data Security, Inc. makes no representations concerning either ;; the merchantability of this software or the suitability of this ;; software for any particular purpose. It is provided "as is" without ;; express or implied warranty of any kind. ;; ;; These notices must be retained in any copies of any part of this ;; documentation and/or software. ;;; Code: --------------------------------------------------------------------- (defvar md5-program "md5" "*Program that reads a message on its standard input and writes an MD5 digest on its output.") (defvar md5-maximum-internal-length 4096 "*The maximum size of a piece of data that should use the MD5 routines written in lisp. If a message exceeds this, it will be run through an external filter for processing. Also see the `md5-program' variable. This variable has no effect if you call the md5-init|update|final functions - only used by the `md5' function's simpler interface.") (defvar md5-bits (make-vector 4 0) "Number of bits handled, modulo 2^64. Represented as four 16-bit numbers, least significant first.") (defvar md5-buffer (make-vector 4 '(0 . 0)) "Scratch buffer (four 32-bit integers).") (defvar md5-input (make-vector 64 0) "Input buffer (64 bytes).") (defun md5-unhex (x) (if (> x ?9) (if (>= x ?a) (+ 10 (- x ?a)) (+ 10 (- x ?A))) (- x ?0))) (defun md5-encode (message) "Encodes MESSAGE using the MD5 message digest algorithm. MESSAGE must be a string or an array of bytes. Returns a vector of 16 bytes containing the message digest." (if (or (null md5-maximum-internal-length) (<= (length message) md5-maximum-internal-length)) (progn (md5-init) (md5-update message) (md5-final)) (save-excursion (set-buffer (get-buffer-create " *md5-work*")) (erase-buffer) (insert message) (call-process-region (point-min) (point-max) md5-program t (current-buffer)) ;; MD5 digest is 32 chars long ;; mddriver adds a newline to make neaten output for tty ;; viewing, make sure we leave it behind. (let ((data (buffer-substring (point-min) (+ (point-min) 32))) (vec (make-vector 16 0)) (ctr 0)) (while (< ctr 16) (aset vec ctr (+ (* 16 (md5-unhex (aref data (* ctr 2)))) (md5-unhex (aref data (1+ (* ctr 2)))))) (setq ctr (1+ ctr))))))) (defsubst md5-add (x y) "Return 32-bit sum of 32-bit integers X and Y." (let ((m (+ (car x) (car y))) (l (+ (cdr x) (cdr y)))) (cons (logand 65535 (+ m (lsh l -16))) (logand l 65535)))) ;; FF, GG, HH and II are basic MD5 functions, providing transformations ;; for rounds 1, 2, 3 and 4 respectively. Each function follows this ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x ;; by y bits to the left): ;; ;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b ;; ;; so we use the macro `md5-make-step' to construct each one. The ;; helper functions F, G, H and I operate on 16-bit numbers; the full ;; operation splits its inputs, operates on the halves separately and ;; then puts the results together. (defsubst md5-F (x y z) (logior (logand x y) (logand (lognot x) z))) (defsubst md5-G (x y z) (logior (logand x z) (logand y (lognot z)))) (defsubst md5-H (x y z) (logxor x y z)) (defsubst md5-I (x y z) (logxor y (logior x (logand 65535 (lognot z))))) (defmacro md5-make-step (name func) (` (defun (, name) (a b c d x s ac) (let* ((m1 (+ (car a) ((, func) (car b) (car c) (car d)) (car x) (car ac))) (l1 (+ (cdr a) ((, func) (cdr b) (cdr c) (cdr d)) (cdr x) (cdr ac))) (m2 (logand 65535 (+ m1 (lsh l1 -16)))) (l2 (logand 65535 l1)) (m3 (logand 65535 (if (> s 15) (+ (lsh m2 (- s 32)) (lsh l2 (- s 16))) (+ (lsh m2 s) (lsh l2 (- s 16)))))) (l3 (logand 65535 (if (> s 15) (+ (lsh l2 (- s 32)) (lsh m2 (- s 16))) (+ (lsh l2 s) (lsh m2 (- s 16))))))) (md5-add (cons m3 l3) b))))) (md5-make-step md5-FF md5-F) (md5-make-step md5-GG md5-G) (md5-make-step md5-HH md5-H) (md5-make-step md5-II md5-I) (defun md5-init () "Initialise the state of the message-digest routines." (aset md5-bits 0 0) (aset md5-bits 1 0) (aset md5-bits 2 0) (aset md5-bits 3 0) (aset md5-buffer 0 '(26437 . 8961)) (aset md5-buffer 1 '(61389 . 43913)) (aset md5-buffer 2 '(39098 . 56574)) (aset md5-buffer 3 '( 4146 . 21622))) (defun md5-update (string) "Update the current MD5 state with STRING (an array of bytes)." (let ((len (length string)) (i 0) (j 0)) (while (< i len) ;; Compute number of bytes modulo 64 (setq j (% (/ (aref md5-bits 0) 8) 64)) ;; Store this byte (truncating to 8 bits to be sure) (aset md5-input j (logand 255 (aref string i))) ;; Update number of bits by 8 (modulo 2^64) (let ((c 8) (k 0)) (while (and (> c 0) (< k 4)) (let ((b (aref md5-bits k))) (aset md5-bits k (logand 65535 (+ b c))) (setq c (if (> b (- 65535 c)) 1 0) k (1+ k))))) ;; Increment number of bytes processed (setq i (1+ i)) ;; When 64 bytes accumulated, pack them into sixteen 32-bit ;; integers in the array `in' and then tranform them. (if (= j 63) (let ((in (make-vector 16 (cons 0 0))) (k 0) (kk 0)) (while (< k 16) (aset in k (md5-pack md5-input kk)) (setq k (+ k 1) kk (+ kk 4))) (md5-transform in)))))) (defun md5-pack (array i) "Pack the four bytes at ARRAY reference I to I+3 into a 32-bit integer." (cons (+ (lsh (aref array (+ i 3)) 8) (aref array (+ i 2))) (+ (lsh (aref array (+ i 1)) 8) (aref array (+ i 0))))) (defun md5-byte (array n b) "Unpack byte B (0 to 3) from Nth member of ARRAY of 32-bit integers." (let ((e (aref array n))) (cond ((eq b 0) (logand 255 (cdr e))) ((eq b 1) (lsh (cdr e) -8)) ((eq b 2) (logand 255 (car e))) ((eq b 3) (lsh (car e) -8))))) (defun md5-final () (let ((in (make-vector 16 (cons 0 0))) (j 0) (digest (make-vector 16 0)) (padding)) ;; Save the number of bits in the message (aset in 14 (cons (aref md5-bits 1) (aref md5-bits 0))) (aset in 15 (cons (aref md5-bits 3) (aref md5-bits 2))) ;; Compute number of bytes modulo 64 (setq j (% (/ (aref md5-bits 0) 8) 64)) ;; Pad out computation to 56 bytes modulo 64 (setq padding (make-vector (if (< j 56) (- 56 j) (- 120 j)) 0)) (aset padding 0 128) (md5-update padding) ;; Append length in bits and transform (let ((k 0) (kk 0)) (while (< k 14) (aset in k (md5-pack md5-input kk)) (setq k (+ k 1) kk (+ kk 4)))) (md5-transform in) ;; Store the results in the digest (let ((k 0) (kk 0)) (while (< k 4) (aset digest (+ kk 0) (md5-byte md5-buffer k 0)) (aset digest (+ kk 1) (md5-byte md5-buffer k 1)) (aset digest (+ kk 2) (md5-byte md5-buffer k 2)) (aset digest (+ kk 3) (md5-byte md5-buffer k 3)) (setq k (+ k 1) kk (+ kk 4)))) ;; Return digest digest)) ;; It says in the RSA source, "Note that if the Mysterious Constants are ;; arranged backwards in little-endian order and decrypted with the DES ;; they produce OCCULT MESSAGES!" Security through obscurity? (defun md5-transform (in) "Basic MD5 step. Transform md5-buffer based on array IN." (let ((a (aref md5-buffer 0)) (b (aref md5-buffer 1)) (c (aref md5-buffer 2)) (d (aref md5-buffer 3))) (setq a (md5-FF a b c d (aref in 0) 7 '(55146 . 42104)) d (md5-FF d a b c (aref in 1) 12 '(59591 . 46934)) c (md5-FF c d a b (aref in 2) 17 '( 9248 . 28891)) b (md5-FF b c d a (aref in 3) 22 '(49597 . 52974)) a (md5-FF a b c d (aref in 4) 7 '(62844 . 4015)) d (md5-FF d a b c (aref in 5) 12 '(18311 . 50730)) c (md5-FF c d a b (aref in 6) 17 '(43056 . 17939)) b (md5-FF b c d a (aref in 7) 22 '(64838 . 38145)) a (md5-FF a b c d (aref in 8) 7 '(27008 . 39128)) d (md5-FF d a b c (aref in 9) 12 '(35652 . 63407)) c (md5-FF c d a b (aref in 10) 17 '(65535 . 23473)) b (md5-FF b c d a (aref in 11) 22 '(35164 . 55230)) a (md5-FF a b c d (aref in 12) 7 '(27536 . 4386)) d (md5-FF d a b c (aref in 13) 12 '(64920 . 29075)) c (md5-FF c d a b (aref in 14) 17 '(42617 . 17294)) b (md5-FF b c d a (aref in 15) 22 '(18868 . 2081)) a (md5-GG a b c d (aref in 1) 5 '(63006 . 9570)) d (md5-GG d a b c (aref in 6) 9 '(49216 . 45888)) c (md5-GG c d a b (aref in 11) 14 '( 9822 . 23121)) b (md5-GG b c d a (aref in 0) 20 '(59830 . 51114)) a (md5-GG a b c d (aref in 5) 5 '(54831 . 4189)) d (md5-GG d a b c (aref in 10) 9 '( 580 . 5203)) c (md5-GG c d a b (aref in 15) 14 '(55457 . 59009)) b (md5-GG b c d a (aref in 4) 20 '(59347 . 64456)) a (md5-GG a b c d (aref in 9) 5 '( 8673 . 52710)) d (md5-GG d a b c (aref in 14) 9 '(49975 . 2006)) c (md5-GG c d a b (aref in 3) 14 '(62677 . 3463)) b (md5-GG b c d a (aref in 8) 20 '(17754 . 5357)) a (md5-GG a b c d (aref in 13) 5 '(43491 . 59653)) d (md5-GG d a b c (aref in 2) 9 '(64751 . 41976)) c (md5-GG c d a b (aref in 7) 14 '(26479 . 729)) b (md5-GG b c d a (aref in 12) 20 '(36138 . 19594)) a (md5-HH a b c d (aref in 5) 4 '(65530 . 14658)) d (md5-HH d a b c (aref in 8) 11 '(34673 . 63105)) c (md5-HH c d a b (aref in 11) 16 '(28061 . 24866)) b (md5-HH b c d a (aref in 14) 23 '(64997 . 14348)) a (md5-HH a b c d (aref in 1) 4 '(42174 . 59972)) d (md5-HH d a b c (aref in 4) 11 '(19422 . 53161)) c (md5-HH c d a b (aref in 7) 16 '(63163 . 19296)) b (md5-HH b c d a (aref in 10) 23 '(48831 . 48240)) a (md5-HH a b c d (aref in 13) 4 '(10395 . 32454)) d (md5-HH d a b c (aref in 0) 11 '(60065 . 10234)) c (md5-HH c d a b (aref in 3) 16 '(54511 . 12421)) b (md5-HH b c d a (aref in 6) 23 '( 1160 . 7429)) a (md5-HH a b c d (aref in 9) 4 '(55764 . 53305)) d (md5-HH d a b c (aref in 12) 11 '(59099 . 39397)) c (md5-HH c d a b (aref in 15) 16 '( 8098 . 31992)) b (md5-HH b c d a (aref in 2) 23 '(50348 . 22117)) a (md5-II a b c d (aref in 0) 6 '(62505 . 8772)) d (md5-II d a b c (aref in 7) 10 '(17194 . 65431)) c (md5-II c d a b (aref in 14) 15 '(43924 . 9127)) b (md5-II b c d a (aref in 5) 21 '(64659 . 41017)) a (md5-II a b c d (aref in 12) 6 '(25947 . 22979)) d (md5-II d a b c (aref in 3) 10 '(36620 . 52370)) c (md5-II c d a b (aref in 10) 15 '(65519 . 62589)) b (md5-II b c d a (aref in 1) 21 '(34180 . 24017)) a (md5-II a b c d (aref in 8) 6 '(28584 . 32335)) d (md5-II d a b c (aref in 15) 10 '(65068 . 59104)) c (md5-II c d a b (aref in 6) 15 '(41729 . 17172)) b (md5-II b c d a (aref in 13) 21 '(19976 . 4513)) a (md5-II a b c d (aref in 4) 6 '(63315 . 32386)) d (md5-II d a b c (aref in 11) 10 '(48442 . 62005)) c (md5-II c d a b (aref in 2) 15 '(10967 . 53947)) b (md5-II b c d a (aref in 9) 21 '(60294 . 54161))) (aset md5-buffer 0 (md5-add (aref md5-buffer 0) a)) (aset md5-buffer 1 (md5-add (aref md5-buffer 1) b)) (aset md5-buffer 2 (md5-add (aref md5-buffer 2) c)) (aset md5-buffer 3 (md5-add (aref md5-buffer 3) d)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Here begins the merger with the XEmacs API and the md5.el from the URL ;;; package. Courtesy wmperry@cs.indiana.edu ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun md5 (object &optional start end) "Return the MD5 (a secure message digest algorithm) of an object. OBJECT is either a string or a buffer. Optional arguments START and END denote buffer positions for computing the hash of a portion of OBJECT." (let ((buffer nil)) (unwind-protect (save-excursion (setq buffer (generate-new-buffer " *md5-work*")) (set-buffer buffer) (cond ((bufferp object) (insert-buffer-substring object start end)) ((stringp object) (insert (if (or start end) (substring object start end) object))) (t nil)) (prog1 (if (or (null md5-maximum-internal-length) (<= (point-max) md5-maximum-internal-length)) (mapconcat (function (lambda (node) (format "%02x" node))) (md5-encode (buffer-string)) "") (call-process-region (point-min) (point-max) shell-file-name t buffer nil shell-command-switch md5-program) ;; MD5 digest is 32 chars long ;; mddriver adds a newline to make neaten output for tty ;; viewing, make sure we leave it behind. (buffer-substring (point-min) (+ (point-min) 32))) (kill-buffer buffer))) (and buffer (buffer-name buffer) (kill-buffer buffer) nil)))) (provide 'md5-el) flim-fee392e/md5.el000066400000000000000000000041501174703612400141610ustar00rootroot00000000000000;;; md5.el --- MD5 Message Digest Algorithm. ;; 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 (cond ((and (fboundp 'md5) (subrp (symbol-function 'md5))) nil) ((fboundp 'dynamic-link) ;; Should we take care of `dynamic-link-path'? (let ((path (expand-file-name "md5.so" exec-directory))) (if (file-exists-p path) path nil))) (t nil))) (cond ((and (fboundp 'md5) (subrp (symbol-function 'md5))) ;; do nothing. ) ((and (stringp md5-dl-module) (file-exists-p md5-dl-module)) (require 'md5-dl)) (t (require 'md5-el))) (provide 'md5) ;;; md5.el ends here flim-fee392e/mel-b-ccl.el000066400000000000000000000336501174703612400152360ustar00rootroot00000000000000;;; mel-b-ccl.el --- Base64 encoder/decoder using CCL. ;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: Tanaka Akira ;; Created: 1998/9/17 ;; Keywords: MIME, Base64 ;; 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-4-table '( 0 1 2 3)) (defconst mel-ccl-16-table '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)) (defconst mel-ccl-64-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)) (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-64-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 62 nil nil nil 63 52 53 54 55 56 57 58 59 60 61 nil nil nil t nil nil nil 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 nil nil nil nil nil nil 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 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-64-to-256-table (mapcar 'char-int "ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz\ 0123456789\ +/")) ) ;;; @ CCL programs ;;; (eval-when-compile (defun mel-ccl-decode-b-bit-ex (v) (logior (lsh (logand v (lsh 255 16)) -16) (logand v (lsh 255 8)) (lsh (logand v 255) 16))) ) (eval-when-compile (defconst mel-ccl-decode-b-0-table (vconcat (mapcar (lambda (v) (if (integerp v) (mel-ccl-decode-b-bit-ex (lsh v 18)) (lsh 1 24))) mel-ccl-256-to-64-table))) (defconst mel-ccl-decode-b-1-table (vconcat (mapcar (lambda (v) (if (integerp v) (mel-ccl-decode-b-bit-ex (lsh v 12)) (lsh 1 25))) mel-ccl-256-to-64-table))) (defconst mel-ccl-decode-b-2-table (vconcat (mapcar (lambda (v) (if (integerp v) (mel-ccl-decode-b-bit-ex (lsh v 6)) (lsh 1 26))) mel-ccl-256-to-64-table))) (defconst mel-ccl-decode-b-3-table (vconcat (mapcar (lambda (v) (if (integerp v) (mel-ccl-decode-b-bit-ex v) (lsh 1 27))) mel-ccl-256-to-64-table))) ) (check-broken-facility ccl-cascading-read) (if-broken ccl-cascading-read (define-ccl-program mel-ccl-decode-b `(1 (loop (loop (read-branch r1 ,@(mapcar (lambda (v) (cond ((or (eq v nil) (eq v t)) '(repeat)) (t `((r0 = ,(lsh v 2)) (break))))) mel-ccl-256-to-64-table))) (loop (read-branch r1 ,@(mapcar (lambda (v) (cond ((or (eq v nil) (eq v t)) '(repeat)) ((= (lsh v -4) 0) `((write r0) (r0 = ,(lsh (logand v 15) 4)) (break))) (t `((r0 |= ,(lsh v -4)) (write r0) (r0 = ,(lsh (logand v 15) 4)) (break))))) mel-ccl-256-to-64-table))) (loop (read-branch r1 ,@(mapcar (lambda (v) (cond ((eq v nil) '(repeat)) ((eq v t) '(end)) ((= (lsh v -2) 0) `((write r0) (r0 = ,(lsh (logand v 3) 6)) (break))) (t `((r0 |= ,(lsh v -2)) (write r0) (r0 = ,(lsh (logand v 3) 6)) (break))))) mel-ccl-256-to-64-table))) (loop (read-branch r1 ,@(mapcar (lambda (v) (cond ((eq v nil) '(repeat)) ((eq v t) '(end)) (t `((r0 |= ,v) (write r0) (break))))) mel-ccl-256-to-64-table))) (repeat)))) (define-ccl-program mel-ccl-decode-b `(1 (loop (read r0 r1 r2 r3) (r4 = r0 ,mel-ccl-decode-b-0-table) (r5 = r1 ,mel-ccl-decode-b-1-table) (r4 |= r5) (r5 = r2 ,mel-ccl-decode-b-2-table) (r4 |= r5) (r5 = r3 ,mel-ccl-decode-b-3-table) (r4 |= r5) (if (r4 & ,(lognot (1- (lsh 1 24)))) ((loop (if (r4 & ,(lsh 1 24)) ((r0 = r1) (r1 = r2) (r2 = r3) (read r3) (r4 >>= 1) (r4 &= ,(logior (lsh 7 24))) (r5 = r3 ,mel-ccl-decode-b-3-table) (r4 |= r5) (repeat)) (break))) (loop (if (r4 & ,(lsh 1 25)) ((r1 = r2) (r2 = r3) (read r3) (r4 >>= 1) (r4 &= ,(logior (lsh 7 24))) (r5 = r3 ,mel-ccl-decode-b-3-table) (r4 |= r5) (repeat)) (break))) (loop (if (r2 != ?=) (if (r4 & ,(lsh 1 26)) ((r2 = r3) (read r3) (r4 >>= 1) (r4 &= ,(logior (lsh 7 24))) (r5 = r3 ,mel-ccl-decode-b-3-table) (r4 |= r5) (repeat)) ((r6 = 0) (break))) ((r6 = 1) (break)))) (loop (if (r3 != ?=) (if (r4 & ,(lsh 1 27)) ((read r3) (r4 = r3 ,mel-ccl-decode-b-3-table) (repeat)) (break)) ((r6 |= 2) (break)))) (r4 = r0 ,mel-ccl-decode-b-0-table) (r5 = r1 ,mel-ccl-decode-b-1-table) (r4 |= r5) (branch r6 ;; BBBB ((r5 = r2 ,mel-ccl-decode-b-2-table) (r4 |= r5) (r5 = r3 ,mel-ccl-decode-b-3-table) (r4 |= r5) (r4 >8= 0) (write r7) (r4 >8= 0) (write r7) (write-repeat r4)) ;; error: BB=B ((write (r4 & 255)) (end)) ;; BBB= ((r5 = r2 ,mel-ccl-decode-b-2-table) (r4 |= r5) (r4 >8= 0) (write r7) (write (r4 & 255)) (end) ; Excessive (end) is workaround for XEmacs 21.0. ; Without this, "AAA=" is converted to "^@^@^@". (end)) ;; BB== ((write (r4 & 255)) (end)))) ((r4 >8= 0) (write r7) (r4 >8= 0) (write r7) (write-repeat r4)))))) ) (eval-when-compile ;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK ;; is not executed. (defun mel-ccl-encode-base64-generic (&optional quantums-per-line output-crlf terminate-with-newline) `(2 ((r3 = 0) (r2 = 0) (read r1) (loop (branch r1 ,@(mapcar (lambda (r1) `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table)) (r0 = ,(logand r1 3)))) mel-ccl-256-table)) (r2 = 1) (read-branch r1 ,@(mapcar (lambda (r1) `((write r0 ,(vconcat (mapcar (lambda (r0) (nth (logior (lsh r0 4) (lsh r1 -4)) mel-ccl-64-to-256-table)) mel-ccl-4-table))) (r0 = ,(logand r1 15)))) mel-ccl-256-table)) (r2 = 2) (read-branch r1 ,@(mapcar (lambda (r1) `((write r0 ,(vconcat (mapcar (lambda (r0) (nth (logior (lsh r0 2) (lsh r1 -6)) mel-ccl-64-to-256-table)) mel-ccl-16-table))))) mel-ccl-256-table)) (r1 &= 63) (write r1 ,(vconcat (mapcar (lambda (r1) (nth r1 mel-ccl-64-to-256-table)) mel-ccl-64-table))) (r3 += 1) (r2 = 0) (read r1) ,@(when quantums-per-line `((if (r3 == ,quantums-per-line) ((write ,(if output-crlf "\r\n" "\n")) (r3 = 0))))) (repeat))) (branch r2 ,(if terminate-with-newline `(if (r3 > 0) (write ,(if output-crlf "\r\n" "\n"))) `(r0 = 0)) ((write r0 ,(vconcat (mapcar (lambda (r0) (nth (lsh r0 4) mel-ccl-64-to-256-table)) mel-ccl-4-table))) (write ,(if terminate-with-newline (if output-crlf "==\r\n" "==\n") "=="))) ((write r0 ,(vconcat (mapcar (lambda (r0) (nth (lsh r0 2) mel-ccl-64-to-256-table)) mel-ccl-16-table))) (write ,(if terminate-with-newline (if output-crlf "=\r\n" "=\n") "=")))) )) ) (define-ccl-program mel-ccl-encode-b (mel-ccl-encode-base64-generic)) ;; 19 * 4 = 76 (define-ccl-program mel-ccl-encode-base64-crlf-crlf (mel-ccl-encode-base64-generic 19 t)) (define-ccl-program mel-ccl-encode-base64-crlf-lf (mel-ccl-encode-base64-generic 19 nil)) ;;; @ coding system ;;; (make-ccl-coding-system 'mel-ccl-b-rev ?B "MIME B-encoding (reversed)" 'mel-ccl-encode-b 'mel-ccl-decode-b) (make-ccl-coding-system 'mel-ccl-base64-crlf-rev ?B "MIME Base64-encoding (reversed)" 'mel-ccl-encode-base64-crlf-crlf 'mel-ccl-decode-b) (make-ccl-coding-system 'mel-ccl-base64-lf-rev ?B "MIME Base64-encoding (LF encoding) (reversed)" 'mel-ccl-encode-base64-crlf-lf 'mel-ccl-decode-b) ;;; @ B ;;; (check-broken-facility ccl-execute-eof-block-on-decoding-some) (unless-broken ccl-execute-eof-block-on-decoding-some (defun base64-ccl-encode-string (string &optional no-line-break) "Encode STRING with base64 encoding." (if no-line-break (decode-coding-string string 'mel-ccl-b-rev) (decode-coding-string string 'mel-ccl-base64-lf-rev))) (defalias-maybe 'base64-encode-string 'base64-ccl-encode-string) (defun base64-ccl-encode-region (start end &optional no-line-break) "Encode region from START to END with base64 encoding." (interactive "*r") (if no-line-break (decode-coding-region start end 'mel-ccl-b-rev) (decode-coding-region start end 'mel-ccl-base64-lf-rev))) (defalias-maybe 'base64-encode-region 'base64-ccl-encode-region) (defun base64-ccl-insert-encoded-file (filename) "Encode contents of file FILENAME to base64, and insert the result." (interactive "*fInsert encoded file: ") (insert (decode-coding-string (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents-as-binary filename) (buffer-string)) 'mel-ccl-base64-lf-rev))) (mel-define-method-function (mime-encode-string string (nil "base64")) 'base64-ccl-encode-string) (mel-define-method-function (mime-encode-region start end (nil "base64")) 'base64-ccl-encode-region) (mel-define-method-function (mime-insert-encoded-file filename (nil "base64")) 'base64-ccl-insert-encoded-file) (mel-define-method-function (encoded-text-encode-string string (nil "B")) 'base64-ccl-encode-string) ) (defun base64-ccl-decode-string (string) "Decode base64 encoded STRING" (encode-coding-string string 'mel-ccl-b-rev)) (defalias-maybe 'base64-decode-string 'base64-ccl-decode-string) (defun base64-ccl-decode-region (start end) "Decode base64 encoded the region from START to END." (interactive "*r") (encode-coding-region start end 'mel-ccl-b-rev)) (defalias-maybe 'base64-decode-region 'base64-ccl-decode-region) (defun base64-ccl-write-decoded-region (start end filename) "Decode the region from START to END and write out to FILENAME." (interactive "*r\nFWrite decoded region to file: ") (let ((coding-system-for-write 'mel-ccl-b-rev) jka-compr-compression-info-list jam-zcat-filename-list) (write-region start end filename))) (mel-define-method-function (mime-decode-string string (nil "base64")) 'base64-ccl-decode-string) (mel-define-method-function (mime-decode-region start end (nil "base64")) 'base64-ccl-decode-region) (mel-define-method-function (mime-write-decoded-region start end filename (nil "base64")) 'base64-ccl-write-decoded-region) (mel-define-method encoded-text-decode-string (string (nil "B")) (if (string-match (eval-when-compile (concat "\\`" B-encoded-text-regexp "\\'")) string) (base64-ccl-decode-string string) (error "Invalid encoded-text %s" string))) ;;; @ end ;;; (provide 'mel-b-ccl) ;;; mel-b-ccl.el ends here. flim-fee392e/mel-b-dl.el000066400000000000000000000073751174703612400151010ustar00rootroot00000000000000;;; mel-b-dl.el --- Base64 encoder/decoder using DL module. ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko ;; Keywords: MIME, Base64 ;; 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) (defvar base64-dl-handle (and (stringp base64-dl-module) (file-exists-p base64-dl-module) (dynamic-link base64-dl-module))) (dynamic-call "emacs_base64_init" base64-dl-handle) ;; base64-dl-module provides `encode-base64-string' and `decode-base64-string'. (defalias 'base64-encode-string 'encode-base64-string) (defalias 'base64-decode-string 'decode-base64-string) (defun base64-encode-region (start end) "Encode current region by base64. START and END are buffer positions." (interactive "*r") (insert (prog1 (base64-encode-string (buffer-substring start end)) (delete-region start end))) (or (bolp) (insert ?\n))) (defun base64-decode-region (start end) "Decode current region by base64. START and END are buffer positions." (interactive "*r") (insert (prog1 (base64-decode-string (buffer-substring start end)) (delete-region start end)))) (mel-define-method-function (mime-encode-string string (nil "base64")) 'base64-encode-string) (mel-define-method-function (mime-decode-string string (nil "base64")) 'base64-decode-string) (mel-define-method-function (mime-encode-region start end (nil "base64")) 'base64-encode-region) (mel-define-method-function (mime-decode-region start end (nil "base64")) 'base64-decode-region) (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))) ;;; @ base64 encoder/decoder for file ;;; (mel-define-method mime-insert-encoded-file (filename (nil "base64")) "Encode contents of file FILENAME to base64, and insert the result. It calls external base64 encoder specified by `base64-external-encoder'. So you must install the program (maybe mmencode included in metamail or XEmacs package)." (interactive "*fInsert encoded file: ") (insert (base64-encode-string (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents-as-binary filename) (buffer-string)))) (or (bolp) (insert ?\n))) ;; (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 "*r\nFWrite decoded region to file: ") ;; (let ((str (buffer-substring start end))) ;; (with-temp-buffer ;; (insert (base64-decode-string str)) ;; (write-region-as-binary (point-min)(point-max) filename)))) ;;; @ end ;;; (provide 'mel-b-dl) ;;; mel-b-dl.el ends here. flim-fee392e/mel-b-el.el000066400000000000000000000313461174703612400150750ustar00rootroot00000000000000;;; mel-b-el.el --- Base64 encoder/decoder. ;; Copyright (C) 1992,95,96,97,98,99,2001 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo ;; MORIOKA Tomohiko ;; Created: 1995/6/24 ;; Keywords: MIME, Base64 ;; 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) (eval-when-compile ;; XXX: the macro `as-binary-process' should be provided when compiling. (require 'pces)) ;;; @ variables ;;; (defgroup base64 nil "Base64 encoder/decoder" :group 'mime) (defcustom base64-external-encoder '("mmencode") "*list of base64 encoder program name and its arguments." :group 'base64 :type '(cons (file :tag "Command")(repeat :tag "Arguments" string))) (defcustom base64-external-decoder '("mmencode" "-u") "*list of base64 decoder program name and its arguments." :group 'base64 :type '(cons (file :tag "Command")(repeat :tag "Arguments" string))) (defcustom base64-external-decoder-option-to-specify-file '("-o") "*list of options of base64 decoder program to specify file. If the base64 decoder program does not have such option, set this as nil." :group 'base64 :type '(repeat :tag "Arguments" string)) (defcustom base64-internal-encoding-limit 1000 "*limit size to use internal base64 encoder. If size of input to encode is larger than this limit, external encoder is called." :group 'base64 :type '(choice (const :tag "Always use internal encoder" nil) (integer :tag "Size"))) (defcustom base64-internal-decoding-limit (if (and (featurep 'xemacs) (featurep 'mule)) 1000 7600) "*limit size to use internal base64 decoder. If size of input to decode is larger than this limit, external decoder is called." :group 'base64 :type '(choice (const :tag "Always use internal decoder" nil) (integer :tag "Size"))) ;;; @ utility function ;;; (defun pack-sequence (seq size) "Split sequence SEQ into SIZE elements packs, and return list of packs. \[mel-b-el; tl-seq function]" (let ((len (length seq)) (p 0) dest unit) (while (< p len) (setq unit (cons (elt seq p) unit)) (setq p (1+ p)) (when (zerop (mod p size)) (setq dest (cons (nreverse unit) dest)) (setq unit nil))) (if unit (nreverse (cons (nreverse unit) dest)) (nreverse dest)))) ;;; @ internal base64 encoder ;;; based on base64 decoder by Enami Tsugutomo (eval-and-compile (defconst base64-characters "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/") ) (defmacro base64-num-to-char (n) `(aref base64-characters ,n)) (defun base64-encode-1 (pack) (let ((buf (make-string 4 ?=))) (aset buf 0 (base64-num-to-char (ash (car pack) -2))) (if (nth 1 pack) (progn (aset buf 1 (base64-num-to-char (logior (ash (logand (car pack) 3) 4) (ash (nth 1 pack) -4)))) (if (nth 2 pack) (progn (aset buf 2 (base64-num-to-char (logior (ash (logand (nth 1 pack) 15) 2) (ash (nth 2 pack) -6)))) (aset buf 3 (base64-num-to-char (logand (nth 2 pack) 63)))) (aset buf 2 (base64-num-to-char (ash (logand (nth 1 pack) 15) 2))))) (aset buf 1 (base64-num-to-char (ash (logand (car pack) 3) 4)))) buf)) (defun-maybe 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." (let* ((len (length string)) (b 0)(e 57) (dest "")) (while (< e len) (setq dest (concat dest (mapconcat (function base64-encode-1) (pack-sequence (substring string b e) 3) "") (if (not no-line-break) "\n"))) (setq b e e (+ e 57))) (concat dest (mapconcat (function base64-encode-1) (pack-sequence (substring string b) 3) "")))) (defun base64-internal-encode-region (beg end &optional no-line-break) (save-excursion (save-restriction (narrow-to-region beg end) (insert (prog1 (base64-encode-string (buffer-substring beg end) no-line-break) (delete-region beg end)))))) ;;; @ internal base64 decoder ;;; (defconst base64-numbers (eval-when-compile (let ((len (length base64-characters)) (vec (make-vector 123 nil)) (i 0)) (while (< i len) (aset vec (aref base64-characters i) i) (setq i (1+ i))) vec))) (defmacro base64-char-to-num (c) `(aref base64-numbers ,c)) (defsubst base64-internal-decode (string buffer) (let* ((len (length string)) (i 0)(j 0) v1 v2 v3) (catch 'tag (while (< i len) (when (prog1 (setq v1 (base64-char-to-num (aref string i))) (setq i (1+ i))) (setq v2 (base64-char-to-num (aref string i)) i (1+ i) v3 (base64-char-to-num (aref string i)) i (1+ i)) (aset buffer j (logior (lsh v1 2)(lsh v2 -4))) (setq j (1+ j)) (if v3 (let ((v4 (base64-char-to-num (aref string i)))) (setq i (1+ i)) (aset buffer j (logior (lsh (logand v2 15) 4)(lsh v3 -2))) (setq j (1+ j)) (if v4 (aset buffer (prog1 j (setq j (1+ j))) (logior (lsh (logand v3 3) 6) v4)) (throw 'tag nil))) (throw 'tag nil))))) (substring buffer 0 j))) (defun base64-internal-decode-string (string) (base64-internal-decode string (make-string (length string) 0))) ;; (defsubst base64-decode-string! (string) ;; (setq string (string-as-unibyte string)) ;; (base64-internal-decode string string)) (defun base64-internal-decode-region (beg end) (save-excursion (let ((str (string-as-unibyte (buffer-substring beg end)))) (insert (prog1 (base64-internal-decode str str) (delete-region beg end)))))) ;; (defun base64-internal-decode-region2 (beg end) ;; (save-excursion ;; (let ((str (buffer-substring beg end))) ;; (delete-region beg end) ;; (goto-char beg) ;; (insert (base64-decode-string! str))))) ;; (defun base64-internal-decode-region3 (beg end) ;; (save-excursion ;; (let ((str (buffer-substring beg end))) ;; (delete-region beg end) ;; (goto-char beg) ;; (insert (base64-internal-decode-string str))))) ;;; @ external encoder/decoder ;;; (defun base64-external-encode-region (beg end &optional no-line-break) (save-excursion (save-restriction (narrow-to-region beg end) (as-binary-process (apply (function call-process-region) beg end (car base64-external-encoder) t t nil (cdr base64-external-encoder))) ;; for OS/2 ;; regularize line break code (goto-char (point-min)) (while (re-search-forward "\r$" nil t) (replace-match "")) (if no-line-break (progn (goto-char (point-min)) (while (search-forward "\n" nil t) (replace-match ""))))))) (defun base64-external-decode-region (beg end) (save-excursion (as-binary-process (apply (function call-process-region) beg end (car base64-external-decoder) t t nil (cdr base64-external-decoder))))) (defun base64-external-decode-string (string) (with-temp-buffer (insert string) (as-binary-process (apply (function call-process-region) (point-min)(point-max) (car base64-external-decoder) t t nil (cdr base64-external-decoder))) (buffer-string))) ;;; @ application interfaces ;;; (defun-maybe base64-encode-region (start end &optional no-line-break) "Base64-encode the region between START and END. Return the length of the encoded text. Optional third argument NO-LINE-BREAK means do not break long lines into shorter lines. This function calls internal base64 encoder if size of region is smaller than `base64-internal-encoding-limit', otherwise it calls external base64 encoder specified by `base64-external-encoder'. In this case, you must install the program (maybe mmencode included in metamail or XEmacs package)." (interactive "*r") (if (and base64-internal-encoding-limit (> (- end start) base64-internal-encoding-limit)) (base64-external-encode-region start end no-line-break) (base64-internal-encode-region start end no-line-break))) (defun-maybe base64-decode-region (start end) "Decode current region by base64. START and END are buffer positions. This function calls internal base64 decoder if size of region is smaller than `base64-internal-decoding-limit', otherwise it calls external base64 decoder specified by `base64-external-decoder'. In this case, you must install the program (maybe mmencode included in metamail or XEmacs package)." (interactive "*r") (if (and base64-internal-decoding-limit (> (- end start) base64-internal-decoding-limit)) (base64-external-decode-region start end) (base64-internal-decode-region start end))) (defun-maybe base64-decode-string (string) "Decode STRING which is encoded in base64, and return the result. This function calls internal base64 decoder if size of STRING is smaller than `base64-internal-decoding-limit', otherwise it calls external base64 decoder specified by `base64-external-decoder'. In this case, you must install the program (maybe mmencode included in metamail or XEmacs package)." (if (and base64-internal-decoding-limit (> (length string) base64-internal-decoding-limit)) (base64-external-decode-string string) (base64-internal-decode-string string))) (mel-define-method-function (mime-encode-string string (nil "base64")) 'base64-encode-string) (mel-define-method-function (mime-decode-string string (nil "base64")) 'base64-decode-string) (mel-define-method-function (mime-encode-region start end (nil "base64")) 'base64-encode-region) (mel-define-method-function (mime-decode-region start end (nil "base64")) 'base64-decode-region) (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))) (defun base64-insert-encoded-file (filename) "Encode contents of file FILENAME to base64, and insert the result. It calls external base64 encoder specified by `base64-external-encoder'. So you must install the program (maybe mmencode included in metamail or XEmacs package)." (interactive "*fInsert encoded file: ") (if (and base64-internal-encoding-limit (> (nth 7 (file-attributes filename)) base64-internal-encoding-limit)) (apply (function call-process) (car base64-external-encoder) filename t nil (cdr base64-external-encoder)) (insert (base64-encode-string (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents-as-binary filename) (buffer-string)))) (or (bolp) (insert ?\n)))) (mel-define-method-function (mime-insert-encoded-file filename (nil "base64")) 'base64-insert-encoded-file) (defun base64-write-decoded-region (start end filename) "Decode and write current region encoded by base64 into FILENAME. START and END are buffer positions." (interactive "*r\nFWrite decoded region to file: ") (if (and base64-internal-decoding-limit (> (- end start) base64-internal-decoding-limit)) (progn (as-binary-process (apply (function call-process-region) start end (car base64-external-decoder) (null base64-external-decoder-option-to-specify-file) (unless base64-external-decoder-option-to-specify-file (list (current-buffer) nil)) nil (delq nil (append (cdr base64-external-decoder) base64-external-decoder-option-to-specify-file (when base64-external-decoder-option-to-specify-file (list filename)))))) (unless base64-external-decoder-option-to-specify-file (write-region-as-binary (point-min) (point-max) filename))) (let ((str (buffer-substring start end))) (with-temp-buffer (insert (base64-internal-decode-string str)) (write-region-as-binary (point-min) (point-max) filename))))) (mel-define-method-function (mime-write-decoded-region start end filename (nil "base64")) 'base64-write-decoded-region) ;;; @ end ;;; (provide 'mel-b-el) ;;; mel-b-el.el ends here. flim-fee392e/mel-g.el000066400000000000000000000074631174703612400145070ustar00rootroot00000000000000;;; mel-g.el --- Gzip64 encoder/decoder. ;; 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 flim-fee392e/mel-q-ccl.el000066400000000000000000001041541174703612400152530ustar00rootroot00000000000000;;; mel-q-ccl.el --- Quoted-Printable encoder/decoder using CCL. ;; 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 (mapcar 'char-int "0123456789ABCDEF")) (defconst mel-ccl-high-table (vconcat (mapcar (lambda (v) (nth (lsh 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 'char-int "0123456789\ ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz\ !@#$%&'()*+,-./:;<>@[\\]^`{|}~")) (defconst mel-ccl-c-raw (mapcar 'char-int "0123456789\ ABCDEFGHIJKLMNOPQRSTUVWXYZ\ abcdefghijklmnopqrstuvwxyz\ !@#$%&'*+,-./:;<>@[]^`{|}~")) (defconst mel-ccl-p-raw (mapcar 'char-int "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 (char-int ?_)) `(write-repeat ? )) ((= r0 (char-int ?=)) `((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 (lsh 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) (current 'r0) (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 (char-int ?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 == ? ) ((,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 (char-int ?.)) `(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 (char-int ? )) `(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 (char-int ?=)) ;; r0='=' `((read r0) ;; '=' r0 (r1 = (r0 == ?\t)) (if ((r0 == ? ) | r1) ;; '=' r0:[\t ] ;; Skip transport-padding. ;; It should check CR LF after ;; transport-padding. (loop (read-if (r0 == ?\t) (repeat) (if (r0 == ? ) (repeat) (break))))) ;; '=' [\t ]* r0:[^\t ] (branch r0 ,@(mapcar (lambda (r0) (cond ((eq r0 (char-int ?\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 (char-int ?\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 (lsh 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 |= ,(lsh 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 & ,(lsh 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 (cond ((eval-when-compile (and (eq emacs-major-version 23) (eq emacs-minor-version 1))) (defun quoted-printable-ccl-encode-string (string) "Encode STRING with quoted-printable encoding." (ccl-execute-on-string 'mel-ccl-encode-quoted-printable-lf-lf (make-vector 9 0) string nil t)) (defun quoted-printable-ccl-encode-region (start end) "Encode the region from START to END with quoted-printable encoding." (interactive "*r") (save-excursion (goto-char start) (insert (prog1 (quoted-printable-ccl-encode-string (buffer-substring start end)) (delete-region start end))))) (defun quoted-printable-ccl-insert-encoded-file (filename) "Encode contents of the file named as FILENAME, and insert it." (interactive "*fInsert encoded file: ") (insert (ccl-execute-on-string 'mel-ccl-encode-quoted-printable-lf-lf (make-vector 9 0) (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents-as-binary filename) (buffer-string)) nil t)))) (t (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-as-binary 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) ) (cond ((eval-when-compile (and (eq emacs-major-version 23) (eq emacs-minor-version 1))) (defun quoted-printable-ccl-decode-string (string) "Decode quoted-printable encoded STRING." (ccl-execute-on-string 'mel-ccl-decode-quoted-printable-lf-lf (make-vector 9 0) string nil t)) (defun quoted-printable-ccl-decode-region (start end) "Decode the region from START to END with quoted-printable encoding." (interactive "*r") (save-excursion (goto-char start) (insert (prog1 (quoted-printable-ccl-decode-string (buffer-substring start end)) (delete-region start end))))) (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: ") (let ((string (quoted-printable-ccl-decode-string (buffer-substring start end))) (coding-system-for-write 'binary) jka-compr-compression-info-list jam-zcat-filename-list) (with-temp-file filename (insert string))))) (t (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: ") (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 ;;; (cond ((eval-when-compile (and (eq emacs-major-version 23) (eq emacs-minor-version 1))) (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'." (ccl-execute-on-string (cond ((eq mode 'text) 'mel-ccl-encode-uq) ((eq mode 'comment) 'mel-ccl-encode-cq) (t 'mel-ccl-encode-pq)) (make-vector 9 0) string nil t)) (defun q-encoding-ccl-decode-string (string) "Decode Q encoded STRING and return the result." (ccl-execute-on-string 'mel-ccl-decode-q (make-vector 9 0) string nil t))) (t (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)))) (unless (featurep 'xemacs) (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. flim-fee392e/mel-q.el000066400000000000000000000275711174703612400145230ustar00rootroot00000000000000;;; mel-q.el --- Quoted-Printable encoder/decoder. ;; 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 'path-util) (eval-when-compile ;; XXX: should provide char-list instead of string-to-char-list. ;; XXx: and also the macro `as-binary-process' should be provided ;; XXx: by the module "pces" which will be loaded by way of "poem". (require 'poem)) ;;; @ 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 (char-after (point)) 255)) (cond ((and (memq chr '(? ?\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))) ? )) (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 ""))))) (defvar quoted-printable-internal-encoding-limit (if (and (featurep 'xemacs)(featurep 'mule)) 0 (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)) )) (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 (char-after (point)) (eval-when-compile ;; XXX: should provide char-list instead. (string-to-char-list quoted-printable-hex-chars))) (memq (char-after (1+ (point))) (eval-when-compile ;; XXX: should provide char-list instead. (string-to-char-list quoted-printable-hex-chars)))) ;; encoded char. (insert (prog1 (quoted-printable-num-to-raw-byte-char (logior (ash (quoted-printable-hex-char-to-num (char-after (point))) 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 (function (lambda (chr) (cond ((eq chr ? ) "_") ((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 (function (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. flim-fee392e/mel-u.el000066400000000000000000000123441174703612400145170ustar00rootroot00000000000000;;; mel-u.el --- uuencode encoder/decoder. ;; 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. flim-fee392e/mel.el000066400000000000000000000261671174703612400142650ustar00rootroot00000000000000;;; mel.el --- A MIME encoding/decoding library. ;; 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) (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)) ;;; @ 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 'raw-text) 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." (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 (and (fboundp 'base64-encode-string) (subrp (symbol-function 'base64-encode-string)))) (when mel-b-builtin (mel-define-backend "base64") (mel-define-method-function (mime-encode-string string (nil "base64")) 'base64-encode-string) (mel-define-method-function (mime-decode-string string (nil "base64")) 'base64-decode-string) (mel-define-method-function (mime-encode-region start end (nil "base64")) 'base64-encode-region) (mel-define-method-function (mime-decode-region start end (nil "base64")) 'base64-decode-region) (mel-define-method mime-insert-encoded-file (filename (nil "base64")) "Encode contents of file FILENAME to base64, and insert the result. It calls external base64 encoder specified by `base64-external-encoder'. So you must install the program (maybe mmencode included in metamail or XEmacs package)." (interactive "*fInsert encoded file: ") (insert (base64-encode-string (with-temp-buffer (set-buffer-multibyte nil) (binary-insert-encoded-file filename) (buffer-string)))) (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 ((str (buffer-substring start end))) (with-temp-buffer (insert str) (base64-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-b-el '("base64" "B")) (mel-use-module 'mel-q '("quoted-printable" "Q")) (mel-use-module 'mel-g '("x-gzip64")) (mel-use-module 'mel-u '("x-uue" "x-uuencode")) (defvar mel-b-ccl-module (and (featurep 'mule) (progn (require 'path-util) (module-installed-p 'mel-b-ccl)))) (defvar mel-q-ccl-module (and (featurep 'mule) (progn (require 'path-util) (module-installed-p 'mel-q-ccl)))) (when mel-b-ccl-module (mel-use-module 'mel-b-ccl '("base64" "B"))) (when mel-q-ccl-module (mel-use-module 'mel-q-ccl '("quoted-printable" "Q"))) (when base64-dl-module (mel-use-module 'mel-b-dl '("base64" "B"))) ;;; @ 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) (completing-read "Encoding: " (mime-encoding-alist) nil t "base64"))) (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) (completing-read "Encoding: " (mime-encoding-alist 'mime-decode-region) nil t "base64"))) (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 ? )) (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: ") (completing-read "Encoding: " (mime-encoding-alist) nil t "base64"))) (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: ") (completing-read "Encoding: " (mime-encoding-alist 'mime-write-decoded-region) nil t "base64"))) (funcall (mel-find-function 'mime-write-decoded-region encoding) start end filename)) ;;; @ end ;;; (provide 'mel) ;;; mel.el ends here. flim-fee392e/mime-conf.el000066400000000000000000000153711174703612400153550ustar00rootroot00000000000000;;; mime-conf.el --- mailcap parser and MIME playback configuration ;; 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 (char-after (point)))) (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 (char-after (point)) ?/) (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 (char-after (point)))) (if (and chr (>= chr ? ) (/= chr ?\;) (/= chr ?\\) ) (prog1 chr (forward-char))))) (defsubst mime-mailcap-look-at-qchar () (when (eq (char-after (point)) ?\\) (prog2 (forward-char) (char-after (point)) (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 (null file) (error "'filename is not specified in situation.") (setq dest (concat dest (substring mtext p (1- i)) (shell-quote-argument 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)) (if (not (string-match "}" mtext i)) (error "parse error!!!") (let* ((me (match-end 0)) (attribute (substring mtext i (1- me))) (parameter (cdr (assoc attribute situation)))) (if (null 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 flim-fee392e/mime-def.el000066400000000000000000000266561174703612400151760ustar00rootroot00000000000000;;; mime-def.el --- definition module about MIME -*- coding: iso-8859-4; -*- ;; 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" (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 "\\|") "\\)")) (or (fboundp 'char-int) (defalias 'char-int 'identity)) ;;; @ 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 "\000-\040" "*'%" ; introduced in RFC 2231. "]")) (defconst mime-charset-regexp (concat "[^" mime-tspecial-char-list "\000-\040" "*'%" ; should not include "%"? "]+")) ;; More precisely, length of "[A-Za-z]+" is limited to at most 8. ;; (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.") ;;; @ 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 (if (and (fboundp 'base64-encode-string) (subrp (symbol-function 'base64-encode-string))) nil (if (fboundp 'dynamic-link) (let ((path (expand-file-name "base64.so" exec-directory))) (and (file-exists-p path) path) )))) ;;; @ end ;;; (provide 'mime-def) ;;; mime-def.el ends here flim-fee392e/mime-en.sgml000066400000000000000000001160451174703612400153740ustar00rootroot00000000000000 FLIM 1.14 Reference Manual about MIME Features <author>MORIOKA Tomohiko <mail>morioka@jaist.ac.jp</mail> <date>1999-01-27 <toc> </head> <body> <abstract> <p> This file documents MIME features of FLIM, a fundamental library to process Internet Messages for GNU Emacsen. </abstract> <h1> What is FLIM? <node> Introduction <p> FLIM is a library to provide basic features about message representation or encoding. <h1> How to use MIME features <node> How to use <p> Please eval following to use MIME features provided by FLIM: <lisp> (require 'mime) </lisp> <h1> Message and Entity <node> Entity <p> According to <dref>RFC 2045</dref>, `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 <concept>entity</concept> indicates all of header fields and body. <p> 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. <p> FLIM uses <concept>mime-entity</concept> structure to represent information of entity. In this document, it is called simply `mime-entity'. <h2> Functions to create mime-entity <node> Entity creation <p> <defun name="mime-open-entity"> <opts> type location <p> Open an entity and return it. <p> <var>type</var> is representation-type. <cf node="mm-backend"> <p> <var>location</var> is location of entity. Specification of it is depended on representation-type. </defun> <defun name="mime-parse-buffer"> <opts> buffer type <p> Parse <var>buffer</var> as message, and set the result to buffer local variable <code>mime-message-structure</code> of <var>buffer</var> as mime-entity. <p> If <var>buffer</var> is omitted, current buffer is used. <p> <var>type</var> is representation-type of created mime-entity. <cf node="mm-backend"> Default value is <var>buffer</var>. </defun> <h2> Features about message tree <node> Entity hierarchy <p> Structure of a MIME message is tree. <p> In the tree, root node is the entity indicates all of the message. In this document, it is called <concept>root-entity</concept> or <concept>message</concept>. In FLIM, it is indicated by buffer local variable <code>mime-message-structure</code>. <p> 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. <p> In addition, we can indicate an entity by absolute position of the message. <p> Each entity, which is a node of the tree, can be numbered by depth and left-to-right order of the depth. <verb> +-------+ | nil | +---+---+ +-------------------+-------------------+ +-+-+ +-+-+ +-+-+ | 0 | | 1 | | 2 | +-+-+ +-+-+ +-+-+ | +---------+---------+ | +--+--+ +--+--+ +--+--+ +--+--+ +--+--+ | 0.0 | | 1.0 | | 1.1 | | 1.2 | | 2.0 | +-----+ +-----+ +-----+ +-----+ +-----+ </verb> <p> 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 <concept>entity-number</concept>. An entity-number is represented by list of integer, like <code>(1 2 3)</code>. <p> mime-entity has also <concept>node-id</concept>. 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)</code>. <p> Each entity can be indicated by entity-number or node-id in <code>mime-message-structure</code>. <defvar name="mime-message-structure"> <p> Buffer local variable to store mime-entity structure of message. </defvar> <defun name="mime-entity-children"> <args> entity <p> Return list of entities included in the <var>entity</var>. </defun> <defun name="mime-entity-parent"> <args> entity <opts> message <p> Return parent entity of the <var>entity</var>. <p> If <var>message</var> is specified, it is regarded as root instead of <code>mime-message-structure</code>. </defun> <defun name="mime-root-entity-p"> <args> entity <p> Return non-<code>nil</code> if <var>entity</var> is root entity (message). </defun> <defun name="mime-entity-node-id"> <args> entity <p> Return node-id of <var>entity</var>. </defun> <defun name="mime-entity-number"> <args> entity <p> Return entity-number of <var>entity</var>. </defun> <h2> Find Entity <node> Entity Search <p> <defun name="mime-find-entity-from-number"> <args> entity-number <opts> message <p> Return entity from <var>entity-number</var> in <var>message</var>. <p> If <var>message</var> is not specified, <code>mime-message-structure</code> is used. </defun> <defun name="mime-find-entity-from-node-id"> <args> entity-node-id <opts> message <p> Return entity from <var>entity-node-id</var> in <var>message</var>. <p> If <var>message</var> is not specified, <code>mime-message-structure</code> is used. </defun> <defun name="mime-find-entity-from-content-id"> <args> cid <opts> message <p> Return entity from <var>cid</var> in <var>message</var>. <p> If <var>message</var> is not specified, <code>mime-message-structure</code> is used. </defun> <h2> Functions about attributes of mime-entity <node> Entity Attributes <p> <defun name="mime-entity-content-type"> <args> entity <p> Return content-type of <var>entity</var>. <cf node="mime-content-type"> </defun> <defun name="mime-entity-content-disposition"> <args> entity <p> Return content-disposition of <var>entity</var>. <cf node="mime-content-disposition"> </defun> <defun name="mime-entity-filename"> <args> entity <p> Return file name of <var>entity</var>. </defun> <defun name="mime-entity-encoding"> <args> entity <opts> default-encoding <p> Return content-transfer-encoding of <var>entity</var>. <cf node="Content-Transfer-Encoding"> <p> If the <var>entity</var> does not have Content-Transfer-Encoding field, this function returns <var>default-encoding</var>. If it is nil, <code>"7bit"</code> is used as default value. </defun> <defun name="mime-entity-cooked-p"> <args> entity <p> Return non-nil if contents of <var>entity</var> has been already code-converted. </defun> <h2> Information of entity header <node> Entity-header <p> <defun name="mime-fetch-field"> <args> field-name <opts> entity <p> Return field-body of <var>field-name</var> field in header of <var>entity</var>. <p> The results is network representation. <p> If <var>entity</var> is omitted, <code>mime-message-structure</code> is used as default value. <p> If <var>field-name</var> field is not found, this function returns <code>nil</code>. </defun> <defun name="mime-read-field"> <args> field-name <opts> entity <p> Parse <var>field-name</var> field in header of <var>entity</var>, and return the result. <p> 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. <p> Strings in the result will be converted to internal representation of Emacs. <p> If <var>entity</var> is omitted, <code>mime-message-structure</code> is used as default value. <p> If <var>field-name</var> field is not found, this function returns <code>nil</code>. </defun> <h2> Text presentation of entity <node> entity formatting <p> <defun name="mime-insert-header"> <args> entity <opts> invisible-fields visible-fields <p> Insert before point a decoded contents of header of <var>entity</var>. <p> <var>invisible-fields</var> is list of regexps to match field-name to hide. <var>visible-fields</var> is list of regexps to match field-name to hide. <p> If a field-name is matched with some elements of <var>invisible-fields</var> and matched with none of <var>visible-fields</var>, this function don't insert the field. <p> Each <dref>encoded-word</dref> in the header is decoded. ``Raw non us-ascii characters'' are also decoded as <code>default-mime-charset</code>. </defun> <defun name="mime-insert-text-content"> <args> entity <p> Insert before point a contents of <var>entity</var> as text entity. <p> Contents of the <var>entity</var> are decoded as <dref>MIME charset</dref>. If the <var>entity</var> does not have charset parameter of Content-Type field, <code>default-mime-charset</code> is used as default value. </defun> <defvar name="default-mime-charset"> <p> Symbol to indicate default value of <dref>MIME charset</dref>. <p> It is used when MIME charset is not specified. <p> It is originally variable of APEL. </defvar> <h2> Contents of Entity <node> Entity-content <p> <defun name="mime-entity-content"> <args> entity <p> Return content of <var>entity</var> as byte sequence. </defun> <defun name="mime-insert-entity-content"> <args> entity <p> Insert content of <var>entity</var> at point. </defun> <defun name="mime-write-entity-content"> <args> entity filename <p> Write content of <var>entity</var> into <var>filename</var>. </defun> <h2> Network representation of Entity <node> Entity-network-representation <p> <defun name="mime-insert-entity"> <args> entity <p> Insert header and body of <var>entity</var> at point. </defun> <defun name="mime-write-entity"> <args> entity filename <p> Write representation of <var>entity</var> into <var>filename</var>. </defun> <defun name="mime-write-entity-body"> <args> entity filename <p> Write body of <var>entity</var> into <var>filename</var>. </defun> <h2> Entity as buffer representation <node> Entity buffer <p> <defun name="mime-entity-buffer"> <args> entity <p> Return buffer, which contains <var>entity</var>. </defun> <defun name="mime-entity-point-min"> <args> entity <p> Return the start point of <var>entity</var> in the buffer which contains <var>entity</var>. </defun> <defun name="mime-entity-point-max"> <args> entity <p> Return the end point of <var>entity</var> in the buffer which contains <var>entity</var>. </defun> <defun name="mime-entity-header-start"> <args> entity <p> Return the start point of header of <var>entity</var> in the buffer which contains <var>entity</var>. </defun> <defun name="mime-entity-header-end"> <args> entity <p> Return the end point of header of <var>entity</var> in the buffer which contains <var>entity</var>. </defun> <defun name="mime-entity-body-start"> <args> entity <p> Return the start point of body of <var>entity</var> in the buffer which contains <var>entity</var>. </defun> <defun name="mime-entity-body-end"> <args> entity <p> Return the end point of body of <var>entity</var> in the buffer which contains <var>entity</var>. </defun> <h2> Entity representations and implementations <node> mm-backend <p> Entity is an abstraction. It is designed to use various data representations for their purposes. <p> Each entity has <concept>representation-type</concept>. It must be specified when an entity is created. <cf node="Entity Creation"> <p> 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 <concept>entity processing method</concept>. A module, consists of them corresponding with a representation-type, is called <concept>mm-backend</concept>. <p> Module name of each mm-backend consists of the prefix <code>mm</code> and its representation-type. The module is required automatically when its entity is created at first. <h3> Message-passing for entity <node> Request for entity <p> <defun name="mime-entity-send"> <args> entity message <rest> args <p> Send <var>message</var> to <var>entity</var> with <var>args</var>, and return the result. <p> <var>args</var> is arguments of the <var>message</var>. </defun> <h3> Definition of mm-backend <node> mm-backend module <p> <defmacro name="mm-define-backend"> <args> type <opts> parents <p> Define <var>type</var> as a mm-backend. <p> If <var>PARENTS</var> is specified, <var>type</var> inherits parents. Each parent must be representation-type. <p> Example: <p> <lisp> (mm-define-backend chao (generic)) </lisp> </defmacro> <defmacro name="mm-define-method"> <args> name args <rest> body <p> Define <var>name</var> as a method function of (nth 1 (car <var>args</var>)) backend. <p> <var>args</var> is like an argument list of lambda, but (car <var>args</var>) must be specialized parameter. (car (car <var>args</var>)) is name of variable and (nth 1 (car <var>args</var>)) is name of backend (representation-type). <p> Example: <p> <lisp> (mm-define-method entity-cooked-p ((entity chao)) nil) </lisp> </defmacro> <h1> Information of Content-Type field <node> Content-Type <p> <concept>Content-Type field</concept> is a field to indicate kind of contents or data format, such as <dref>media-type</dref> and MIME charset. It is defined in <dref>RFC 2045</dref>. <memo> <p> 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. </memo> <p> FLIM provides parser for Content-Type field and structure <concept>mime-content-type</concept> to store information of Content-Type field. <h2> Format of Content-Type field <node> Content-Type field <p> Format of Content-Type field is defined as follows: <quote> ``Content-Type'' ``:'' <concept>type</concept> ``/'' <concept>subtype</concept> *( ``;'' <concept>parameter</concept> ) </quote> <p> For example: <quote> <verb> Content-Type: image/jpeg </verb> </quote> <quote> <verb> Content-Type: text/plain; charset=iso-2022-jp </verb> </quote> <p> `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. <memo> <p> If an entity does not have Content-Type field, it is regarded as following: <quote> <verb> Content-Type: text/plain; charset=us-ascii </verb> </quote> <noindent> <cf node="us-ascii"> </memo> <h2> mime-content-type structure <node> mime-content-type <p> <define type="Structure" name="mime-content-type"> <p> Structure to store information of a Content-Type field. <p> Applications should use reference functions <code>mime-content-type-SLOT</code> to refer information of the structure. <p> Slots of the structure are following: <vl> <dt>primary-type<dd>primary type of media-type (symbol). </dd> <dt>subtype<dd>subtype of media-type (symbol). </dd> <dt>parameters<dd>parameters of Content-Type field (association-list). </dd> </vl> </define> <defun name="make-mime-content-type"> <args> type subtype <opts> parameters <p>Constructor of content-type. </defun> <defun name="mime-content-type-parameter"> <args> content-type parameter <p> Return value of <var>parameter</var> of <var>content-type</var>. </defun> <h2> Parser <node> Content-Type parser <p> <defun name="mime-parse-Content-Type"> <args> string <p> Parse <var>string</var> as a field-body of Content-Type field, and return the result as <dref>mime-content-type</dref> structure. </defun> <defun name="mime-read-Content-Type"> <p> Parse Content-Type field of the current buffer, and return the result as <dref>mime-content-type</dref> structure. <p> Return <code>nil</code> if Content-Type field is not found. </defun> <h2> Utility functions <node> Content-Type utility <p> <defun name="mime-type/subtype-string"> <args> type <opts> subtype <p> Return type/subtype string from <var>type</var> and <var>subtype</var>. </defun> <h1> Information of Content-Disposition field <node> Content-Disposition <p> <concept>Content-Disposition field</concept> is an optional field to specify presentation of an entity or attributes of an entity, such as file name. <rfc number="2183" type="Standards Track" author="S. Dorner, K. Moore and R. Troost" title="Communicating Presentation Information in Internet Messages: The Content-Disposition Header" date="August 1997"> <p> FLIM provides parser for Content-Disposition field and structure <concept>mime-content-disposition</concept> to store information of Content-Disposition field. <h2> mime-content-disposition structure <node> mime-content-disposition <p> <define type="Structure" name="mime-content-disposition"> <p> Structure to store information of a Content-Disposition field. <p> Applications should use reference functions <code>mime-content-disposition-SLOT</code> to refer information of the structure. <p> Slots of the structure are following: <vl> <dt>disposition-type<dd>disposition-type (symbol). </dd> <dt>parameters<dd>parameters of Content-Disposition field (association-list). </dd> </vl> </define> <defun name="mime-content-disposition-parameter"> <args> content-disposition parameter <p> Return value of <var>parameter</var> of <var>content-disposition</var>. </defun> <defun name="mime-content-disposition-filename"> <args> content-disposition <p> Return filename of <var>content-disposition</var>. </defun> <h2> Parser for Content-Disposition field <node> Content-Disposition parser <p> <defun name="mime-parse-Content-Disposition"> <args> string <p> Parse <var>string</var> as field-body of Content-Disposition field, and return the result as <dref>mime-content-disposition</dref> structure. </defun> <defun name="mime-read-Content-Disposition"> <p> Parse Content-Disposition field of the current buffer, and return the result as <dref>mime-content-disposition</dref> structure. <p> Return <code>nil</code> if Content-Disposition field is not found. </defun> <h1> Encoding Method <node> Content-Transfer-Encoding <p> <concept>Content-Transfer-Encoding field</concept> is a header field to indicate body encoding of a entity. <p> FLIM provides parser functions for Content-Transfer-Encoding field. They represent information of Content-Transfer-Encoding field as string. <p> In addition, FLIM provides encoder/decoder functions by Content-Transfer-Encoding. <h2> Parser <node> Content-Transfer-Encoding parser <p> <defun name="mime-parse-Content-Transfer-Encoding"> <args> string <p> Parse <var>string</var> as a field-body of Content-Transfer-Encoding field, and return the result. </defun> <defun name="mime-read-Content-Transfer-Encoding"> <opts>default-encoding <p> Parse Content-Transfer-Encoding field of the current buffer, and return the result. <p> Return <var>default-encoding</var> if Content-Transfer-Encoding field is not found. If it is not specified, <code>nil</code> is used as the default value. </defun> <h2> Encoder/decoder <node> encoder/decoder <p> <defun name="mime-encode-region"> <args> start end encoding <p> Encode region <var>start</var> to <var>end</var> of current buffer using <var>encoding</var>. </defun> <defun name="mime-decode-region"> <args> start end encoding <p> Decode region <var>start</var> to <var>end</var> of current buffer using <var>encoding</var>. </defun> <defun name="mime-decode-string"> <args> string encoding <p> Decode <var>string</var> which is encoded in <var>encoding</var>, and return the result. </defun> <defun name="mime-insert-encoded-file"> <args> filename encoding <p> Insert file <var>FILENAME</var> encoded by <var>ENCODING</var> format. </defun> <defun name="mime-write-decoded-region"> <args> start end filename encoding <p> Decode and write current region encoded by <var>encoding</var> into <var>filename</var>. <p> <var>start</var> and <var>end</var> are buffer positions. </defun> <h2> Other utilities <node> Encoding information <p> <defun name="mime-encoding-list"> <opts> SERVICE <p> Return list of Content-Transfer-Encoding. <p> If <var>service</var> is specified, it returns available list of Content-Transfer-Encoding for it. </defun> <defun name="mime-encoding-alist"> <opts> SERVICE <p> Return table of Content-Transfer-Encoding for completion. <p> If <var>service</var> is specified, it returns available list of Content-Transfer-Encoding for it. </defun> <h2> How to write encoder/decoder module <node> mel-backend <p> <defmacro name="mel-define-method"> <args> name args <rest> body <p> Define <var>name</var> as a method function of (nth 1 (car (last <var>args</var>))) backend. <p> <var>args</var> is like an argument list of lambda, but (car (last <var>args</var>)) must be specialized parameter. (car (car (last <var>args</var>))) is name of variable and (nth 1 (car (last <var>args</var>))) is name of backend (encoding). <p> Example: <p> <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) ))) </lisp> </defmacro> <defmacro name="mel-define-method-function"> <args> spec function <p> Set <var>spec</var>'s function definition to <var>function</var>. <p> First element of <var>spec</var> is service. <p> Rest of <var>args</var> is like an argument list of lambda, but (car (last <var>args</var>)) must be specialized parameter. (car (car (last <var>args</var>))) is name of variable and (nth 1 (car (last <var>args</var>))) is name of backend (encoding). <p> Example: <p> <lisp> (mel-define-method-function (mime-encode-string string (nil "base64")) 'encode-base64-string) </lisp> </defmacro> <h2> How to add encoding/decoding service <node> generic function for mel-backend <p> <defmacro name="mel-define-service"> <args> name <opts> args doc-string <p> Define <var>name</var> as a service for Content-Transfer-Encodings. <p> If <var>args</var> is specified, <var>name</var> is defined as a generic function for the service. <p> Example: <p> <lisp> (mel-define-service encoded-text-encode-string (string encoding) "Encode STRING as encoded-text using ENCODING. ENCODING must be string.") </lisp> </defmacro> <h1> Network representation of header <node> encoded-word <p> <concept>RFC 2047</concept> defines the <concept>encoded-word</concept> which is a format to represent non-<dref>ASCII</dref> characters in a header. <p> <rfc number="2047" type="Standards Track" author="K. Moore" title="MIME (Multipurpose Internet Mail Extensions) Part Three: Message Header Extensions for Non-ASCII Text" date="November 1996" obsolete="1521,1522,1590"> <p> The encoded-word is the only valid format to represent non-<dref>ASCII</dref> characters in a header, but there are also invalid styles. Such kinds of evil messages represent non-<dref>ASCII</dref> characters in headers without encoded-words (it is called "raw" non-<dref>ASCII</dref> characters). <p> FLIM provides encoding/decoding features of both encoded-word and invalid "raw" non-<dref>ASCII</dref> characters. <h2> Header encoding/decoding <node> Header encoder/decoder <p> <defun name="eword-decode-header"> <opts> code-conversion separator <p> Decode MIME encoded-words in header fields. <p> If <var>code-conversion</var> is <code>nil</code>, only encoded-words are decoded. If <var>code-conversion</var> is a <dref>MIME charset</dref>, non-ASCII bit patterns are decoded as the MIME charset. Otherwise non-ASCII bit patterns are decoded as the <code>default-mime-charset</code>. <cf node="entity formatting"> <p> If <var>separator</var> is not <code>nil</code>, it is used as header separator. </defun> <defun name="eword-encode-header"> <opts> code-conversion <p> Encode header fields to network representation, such as MIME encoded-word. <p> Each field is encoded as corresponding method specified by variable <code>mime-field-encoding-method-alist</code>. </defun> <defvar name="mime-field-encoding-method-alist"> <p> Association list to specify field encoding method. Each element looks like (FIELD . METHOD). <p> If METHOD is <code>mime</code>, the FIELD will be encoded into MIME format (encoded-word). <p> If METHOD is <code>nil</code>, the FIELD will not be encoded. <p> If METHOD is a MIME charset, the FIELD will be encoded as the charset when it must be convert into network-code. <p> Otherwise the FIELD will be encoded as variable <code>default-mime-charset</code> when it must be convert into network-code. </defvar> <h1> Various Customization <node> custom <p> <define type="group" name="mime"> <p> The group associated with functions related to MIME. <p> It belongs to <code>mail</code> and <code>news</code>. </define> <h1> Appendix <node> Appendix <h2> Glossary <node> Glossary <h3> 7bit <node> 7bit <p> <concept>7bit</concept> means any integer between 0 .. 127. <p> Any data represented by 7bit integers is called <concept>7bit data</concept>. <p> Textual string consisted of Control characters between 0 .. 31 and 127, and space represented by 32, and graphic characters between 33 .. 236 are called <concept>7bit (textual) string</concept>. <p> Conventional Internet <a node="MTA">MTA</a> can translate 7bit data, so it is no need to translate by <a node="Quoted-Printable">Quoted-Printable</a> or <a node="Base64">Base64</a> for 7bit data. <p> However if there are too long lines, it can not translate by 7bit MTA even if it is 7bit data. <dref>RFC 821</dref> and <dref>RFC 2045</dref> 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 <dref>binary</dref>. For example, Postscript file should be encoded by Quoted-Printable. <h3> 8bit <node> 8bit <p> <concept>8bit</concept> means any integer between 0 .. 255. <p> Any data represented by 8bit integers is called <concept>8bit data</concept>. <p> 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 <concept>8bit (textual) string</concept>. <p> For example, <dref>iso-8859-1</dref> or <dref>euc-kr</dref> are coded-character-set represented by 8bit textual string. <p> Traditional Internet <a node="MTA">MTA</a> can translate only <dref>7bit</dref> data, so if a 8bit data will be translated such MTA, it must be encoded by <dref>Quoted-Printable</dref> or <dref>Base64</dref>. <p> However 8bit MTA are increasing today. <p> However if there are too long lines, it can not translate by 8bit MTA even if it is 8bit data. <dref>RFC 2045</dref> 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 <dref>binary</dref>, so it must be encoded by Base64 or Quoted-Printable. <h3> ASCII <node> ASCII <p> <concept>ASCII</concept> 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 <a node="ISO 646">ISO 646</a>. <standard abbrev="ASCII" title-en="Coded Character Set -- 7-Bit American Standard Code for Information Interchange" number="ANSI X3.4" year="1986"> <h3> Base64 <node> Base64 <p> <concept>Base64</concept> is a transfer encoding method of <dref>MIME</dref> defined in <dref>RFC 2045</dref>. <p> The encoding process represents 24-bit groups of input bits as output strings of 4 encoded characters. Encoded characters represent integer 0 .. 63 or <concept>pad</concept>. Base64 data must be 4 * n bytes, so pad is used to adjust size. <p> 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. <h3> binary <node> binary <p> Any byte stream is called <concept>binary</concept>. <p> It does not require structure of lines. It differs from from <a node="8bit">8bit</a>. <p> In addition, if line structured data contain too long line (more than 998 bytes), it is regarded as binary. <h3> Coded character set, Character code <node> coded character set <p> 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. <h3> media-type <node> media-type <p> <concept>media-type</concept> specifies the nature of the data in the body of <dref>MIME</dref> <dref>entity</dref>. It consists of <concept>type</concept> and <concept>subtype</concept>. It is defined in <dref>RFC 2046</dref>. <p> Currently there are following standard primary-types: <ul> <li><concept>text</concept> </li> <li><concept>image</concept> </li> <li><concept>audio</concept> </li> <li><concept>video</concept> </li> <li><concept>application</concept> </li> <li><a node="multipart"><concept>multipart</concept></a> </li> <li><concept>message</concept> </ul> <p> And there are various subtypes, for example, application/octet-stream, audio/basic, image/jpeg, <dref>multipart/mixed</dref>, <dref>text/plain</dref>, video/mpeg... <p> You can refer registered media types at <a href="ftp://ftp.isi.edu/in-notes/iana/assignments/media-types">MEDIA TYPES</a>. <p> In addition, you can use private type or subtype using <concept>x-token</concept>, which as the prefix `x-'. However you can not use them in public. <p> <cf node="Content-Type field"> <h3> message <node> message <p> In this document, it means mail defined in <dref>RFC 822</dref> and news message defined in <dref>RFC 1036</dref>. <h3> MIME <node> MIME <p> MIME stands for <concept>Multipurpose Internet Mail Extensions</concept>, it is an extension for <dref>RFC 822</dref>. <p> According to RFC 2045: <p> 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 <ol> <li>textual message bodies in character sets other than US-ASCII, </li> <li>an extensible set of different formats for non-textual message bodies, </li> <li>multi-part message bodies, and </li> <li>textual header information in character sets other than US-ASCII. </ol> <p> It is defined in <dref>RFC 2045</dref>, <dref>RFC 2046</dref>, <a node="encoded-word">RFC 2047</a>, <dref>RFC 2048</dref> and <dref>RFC 2049</dref>. <h3> MIME charset <node> MIME charset <p> <a node="coded character set">Coded character set</a> used in <dref>Content-Type field</dref> or charset parameter of <a node="encoded-word">encoded-word</a>. <p> It is defined in <dref>RFC 2045</dref>. <p> <dref>iso-2022-jp</dref> or <dref>euc-kr</dref> are kinds of it. (In this document, MIME charsets are written by small letters to distinguish <dref>graphic character set</dref>. For example, ISO 8859-1 is a graphic character set, and iso-8859-1 is a MIME charset) <h3> MTA <node> MTA <p> <concept>Message Transfer Agent</concept>. It means mail transfer programs (ex. sendmail) and news servers. <p> <cf node="MUA"> <h3> MUA <node> MUA <p> <concept>Message User Agent</concept>. It means mail readers and news readers. <p> <cf node="MTA"> <h3> Quoted-Printable <node> Quoted-Printable <p> <concept>Quoted-Printable</concept> is a transfer encoding method of <dref>MIME</dref> defined in <dref>RFC 2045</dref>. <p> If the data being encoded are mostly US-ASCII text, the encoded form of the data remains largely recognizable by humans. <p> <cf node="Base64"> <h3> RFC 822 <node> RFC 822 <p> A RFC defines format of Internet mail message, mainly <concept>message header</concept>. <memo> <p> news message is based on RFC 822, so <concept>Internet message</concept> may be more suitable than <concept>Internet mail</concept> . </memo> <rfc number="822" type="STD 11" author="D. Crocker" title="Standard for the Format of ARPA Internet Text Messages" date="August 1982"> <h3> RFC 1036 <node> RFC 1036 <p> A RFC defines format of USENET message. It is a subset of <dref>RFC 822</dref>. It is not Internet standard, but a lot of netnews excepting Usenet uses it. <rfc name="USENET" number="1036" author="M. Horton and R. Adams" title="Standard for Interchange of USENET Messages" date="December 1987" obsolete="850"> <h3> RFC 2045 <node> RFC 2045 <p> <rfc number="2045" type="Standards Track" author="N. Freed and N. Borenstein" title="Multipurpose Internet Mail Extensions (MIME) Part One: Format of Internet Message Bodies" date="November 1996" obsolete="1521, 1522, 1590"> <h3> RFC 2046 <node> RFC 2046 <p> <rfc number="2046" type="Standards Track" author="N. Freed and N. Borenstein" title="Multipurpose Internet Mail Extensions (MIME) Part Two: Media Types" date="November 1996" obsolete="1521, 1522, 1590"> <h3> RFC 2048 <node> RFC 2048 <p> <rfc number="2048" type="Standards Track" author="N. Freed, J. Klensin and J. Postel" title="Multipurpose Internet Mail Extensions (MIME) Part Four: Registration Procedures" date="November 1996" obsolete="1521, 1522, 1590"> <h3> RFC 2049 <node> RFC 2049 <p> <rfc number="2049" type="Standards Track" author="N. Freed and N. Borenstein" title="Multipurpose Internet Mail Extensions (MIME) Part Five: Conformance Criteria and Examples" date="November 1996" obsolete="1521, 1522, 1590"> <h3> plain text <node> plain text <p> A textual data represented by only <dref>coded character set</dref>. It does not have information about font or typesetting. <cf node="text/plain"> <h3> us-ascii <node> us-ascii <p> A <a node="MIME charset">MIME charset</a> for primary Latin script mainly written by English or other languages. <p> It is a 7bit <dref>coded character set</dref> based on <dref>ISO 2022</dref>, it contains only <dref>ASCII</dref> and <dref>code extension</dref> is not allowed. <p> It is standard coded character set of Internet mail. If MIME charset is not specified, <concept>us-ascii</concept> is used as default. <p> In addition, <concept>ASCII</concept> of <dref>RFC 822</dref> should be interpreted as us-ascii. <h2> How to report bugs <node> Bug report <p> If you write bug-reports and/or suggestions for improvement, please send them to the EMACS-MIME Mailing List: <ul> <li> English <mail>emacs-mime-en@m17n.org</mail> <li> Japanese <mail>emacs-mime-ja@m17n.org</mail> </ul> <p> 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. <p> You should write <concept>good bug report</concept>. 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 file="emacs" node="Bugs"> <p> 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. <p> 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, send an empty e-mail to: <ul> <li> English <mail>emacs-mime-en-ctl@m17n.org</mail> <li> Japanese <mail>emacs-mime-ja-ctl@m17n.org</mail> </ul> <h2> CVS based development <node> CVS <p> Files in FLIM are managed under CVS. Therefore you can obtain the newest FLIM by the following method: <verb> (0) cvs login % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root login CVS password: [CR] # NULL string (1) checkout % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root \ checkout [-r TAG] flim </verb> <p> If you would like to join CVS based development, please send mail to <ul> <li> <mail>cvs@cvs.m17n.org</mail> </ul> <noindent> with your account name and your public key for ssh. cvsroot is :ext:cvs@@cvs.m17n.org:/cvs/root. <h2> History of FLIM <node> History <p> FLIM $B$N(B code $B$N:G8E$NItJ,$O(B $B1]JB(B $B;LCR(B $B;a$,=q$$$?(B <file>mime.el</file> $B$K5/8;$7$^$9!#$3$N>.$5$J(B program $B$O(B Nemacs $B$GF0:n$9$k(B iso-2022-jp $B$N(B B-encoding $B@lMQ$N(B encoded-word $B$NI|9f2=%W%m%0%i%`$G$7$?!#(B <p> $B$=$N8e!"<i2,(B $BCNI'(B $B$O(B <file>mime.el</file> $B$r85$K(B <file>tiny-mime.el</file> $B$H$$$&%W%m%0%i%`$r=q$-$^$9!#$3$l$O!"(BNemacs $B$H(B Mule $B$GF0:n$9$k(B encoded-word $B$NId9f2=!&I|9f2=%W%m%0%i%`$G$7$?!#(B <file>tiny-mime.el</file> $B$O(B B-encoding $B$@$1$G$J$/(B Q-encoding $B$b(B support $B$7!"$^$?!"(BMULE $B$G07$&$3$H$,$G$-$k$5$^$6$^$J(B <dref>MIME charset</dref> $B$rF1;~$K;H$&$3$H$,$G$-$^$7$?!#$3$N;~!"(BNemacs $B$H(B Mule $B$N(B $BAPJ}$r(B support $B$9$k$?$a$KMQ$$$i$l$?%F%/%K%C%/$O8e$K(B emu package $B$K$^$H(B $B$a$i$l$^$9!#(B <p> $B$3$N:"!"<i2,(B $BCNI'(B $B$O(B <file>tiny-mime.el</file> $B$r$5$^$6$^$J(B MUA $B$G;H$&(B $B$?$a$N@_Dj=8$bG[I[$7$F$$$^$7$?$,!"$=$l$i$O8e$K(B <file>tiny-mime.el</file> $B$H$H$b$K#1$D$N(B package $B$K$^$H$a$i$l!"(Btm $B$H$$(B $B$&L>A0$GG[I[$5$l$^$9!#(B <p> $B<i2,(B $BCNI'(B $B$O$d$,$F!"(BMIME message $B$r1\Mw$9$k$?$a$N%W%m%0%i%`$G$"$k(B <file>tm-body.el</file> $B$r=q$-$^$9!#$3$l$O!"$9$0$K(B <file>tm-view.el</file> $B$H$$$&L>A0$KJQ$o$j$^$7$?$,!"$d$,$F!"$3$l$,(B <file>tiny-mime.el</file> $B$KBe$o$C$F!"(Btm $B$NCf3K$H$J$j$^$9!#(B <p> <file>tm-view.el</file> $B$OEvA3!"(BContent-Transfer-Encoding $B$r07$&I,MW$,(B $B$"$j$^$9!#$3$NL\E*$N$?$a$K!"(BMEL $B$,@0Hw$5$l$O$8$a$^$7$?!#(BBase64 $B$K4X$7(B $B$F$O(B <file>tiny-mime.el</file> $B$N(B code $B$,0\$5$l!"$^$?!"?7$?$K(B Quoted-Printable $B$N(B code $B$,DI2C$5$l$^$7$?!#$3$l$i$,(B <file>mel-b.el</file> $B$H(B <file>mel-q.el</file> $B$K$J$j$^$7$?!#(B <p> $B$^$?!"8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B uuencode $BMQ$N(B <file>mel-u.el</file> $B$,(B $BDI2C$5$l!"$=$N8e$K!">.NS(B $B=$J?(B $B;a$K$h$C$F(B x-gzip64 $BMQ$N(B <file>mel-g.el</file> $B$,DI2C$5$l$^$7$?!#(B <p> tm $B$G$O8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B <file>tiny-mime.el</file> $B$N:F<BAu$,9T(B $B$o$l!"$3$N2aDx$G!"(BSTD 11 $B$N(B parser $B$,=q$+$l$^$7$?!#$3$l$O!"8=:_$N(B <file>std11.el</file> $B$KEv$?$j$^$9!#$^$?!"$3$N2aDx$G(B <file>tiny-mime.el</file> $B$OI|9f2=$r9T$&(B <file>tm-ew-d.el</file> $B$HId(B $B9f2=$r9T$&(B <file>tm-ew-e.el</file> $B$KJ,$1$i$l$^$7$?!#$3$NN><T$,8=:_$N(B <file>eword-decode.el</file> $B$H(B <file>eword-encode.el</file> $B$N@hAD$K(B $BEv$?$j$^$9!#(B <p> $B8e$K!"<i2,(B $BCNI'(B $B$i$K$h$C$F(B tm $B$NA4LL=q$-49$(:n6H$,9T$o$l!"$3$N2aDx$G!"(B tm $B$O(B APEL, MEL, SEMI, EMH, RMAIL-MIME, Gnus-MIME $B$J$I$KJ,$1$i$l$^$7$?!#(B $B$3$N$&$A$N(B MEL $B$,(B FLIM $B$ND>@\$N@hAD$KEv$?$j$^$9!#(B <p> $B8e$K!"(BAPEL $B$+$i(B <file>std11.el</file> $B$,0\$5$l!"$^$?!"(B <file>mailcap.el</file>, <file>eword-decode.el</file> $B$*$h$S(B <file>eword-encode.el</file> $B$,(B SEMI $B$+$i0\$5$l!"(Bpackage $B$NL>A0$,(B FLIM $B$H$J$j$^$9!#(B <p> $B$3$ND>A0$+$iEDCf(B $BE/(B $B;a$,$h$j(B RFC $B$KCi<B$J<BAu$r=q$-;O$a!"$3$l$O!"8=:_!"(B FLIM $B$N;^$G$"$k(B ``FLIM-FLAM'' $B$H$J$C$F$$$^$9!#(B <h1> Concept Index <node> Concept Index <cindex> <h1> Function Index <node> Function Index <findex> <h1> Variable Index <node> Variable Index <vindex> </body> �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/mime-en.texi���������������������������������������������������������������������������0000664�0000000�0000000�00000130226�11747036124�0015400�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������\input texinfo.tex @c Generated automatically from mime-en.sgml by sinfo 3.7. @setfilename mime-en.info @settitle{FLIM 1.14 Reference Manual about MIME Features} @titlepage @title FLIM 1.14 Reference Manual about MIME Features @author MORIOKA Tomohiko <morioka@@jaist.ac.jp> @subtitle 1999-01-27 @end titlepage @node Top, Introduction, (dir), (dir) @top FLIM 1.14 Reference Manual about MIME Features @ifinfo This file documents MIME features of FLIM, a fundamental library to process Internet Messages for GNU Emacsen. @end ifinfo @menu * Introduction:: What is FLIM? * 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? FLIM is a library to provide basic features about message representation or encoding. @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 * CVS:: CVS 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 821 (@ref{RFC 821}) 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 (@ref{iso-8859-1}) or euc-kr (@ref{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 (@ref{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} (@ref{multipart}) @item @strong{message} @end itemize And there are various subtypes, for example, application/octet-stream, audio/basic, image/jpeg, multipart/mixed (@ref{multipart/mixed}), text/plain (@ref{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 (@ref{iso-2022-jp}) or euc-kr (@ref{euc-kr}) are kinds of it. (In this document, MIME charsets are written by small letters to distinguish graphic character set (@ref{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. (cf. @ref{text/plain}) @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 (@ref{ISO 2022}), it contains only ASCII (@ref{ASCII}) and code extension (@ref{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, CVS, Glossary, Appendix @section How to report bugs @cindex good bug report If you write bug-reports and/or suggestions for improvement, please send them to the EMACS-MIME Mailing List: @itemize @bullet @item English <emacs-mime-en@@m17n.org> @item Japanese <emacs-mime-ja@@m17n.org> @end itemize 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{(emacs)Bugs}) @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. 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, send an empty e-mail to: @itemize @bullet @item English <emacs-mime-en-ctl@@m17n.org> @item Japanese <emacs-mime-ja-ctl@@m17n.org> @end itemize @node CVS, History, Bug report, Appendix @section CVS based development Files in FLIM are managed under CVS. Therefore you can obtain the newest FLIM by the following method. @example (0) cvs login % cvs -d :pserver:anonymous@@cvs.m17n.org:/cvs/root login CVS password: [CR] # NULL string (1) checkout % cvs -d :pserver:anonymous@@cvs.m17n.org:/cvs/root checkout checkout [-r TAG] flim @end example If you would like to join CVS based development, please send mail to @itemize @bullet @item <cvs@@cvs.m17n.org> @end itemize @noindent with your account name and your public key for ssh. cvsroot is :ext:cvs@@cvs.m17n.org:/cvs/root. @node History, , CVS, Appendix @section History of FLIM FLIM $B$N(B code $B$N:G8E$NItJ,$O(B $B1]JB(B $B;LCR(B $B;a$,=q$$$?(B @file{mime.el} $B$K5/8;$7(B $B$^$9!#$3$N>.$5$J(B program $B$O(B Nemacs $B$GF0:n$9$k(B iso-2022-jp $B$N(B B-encoding $B@lMQ$N(B encoded-word $B$NI|9f2=%W%m%0%i%`$G$7$?!#(B@refill $B$=$N8e!"<i2,(B $BCNI'(B $B$O(B @file{mime.el} $B$r85$K(B@file{tiny-mime.el} $B$H$$$&%W%m(B $B%0%i%`$r=q$-$^$9!#$3$l$O!"(BNemacs $B$H(B Mule $B$GF0:n$9$k(B encoded-word $B$NId9f(B $B2=!&I|9f2=%W%m%0%i%`$G$7$?!#(B@file{tiny-mime.el} $B$O(B B-encoding $B$@$1$G$J$/(B Q-encoding $B$b(Bsupport $B$7!"$^$?!"(BMULE $B$G07$&$3$H$,$G$-$k$5$^$6$^$J(B MIME charset (@ref{MIME charset}) $B$rF1;~$K;H$&$3$H$,$G$-$^$7$?!#$3$N;~!"(B Nemacs $B$H(B Mule $B$NAPJ}$r(B support $B$9$k$?$a$KMQ$$$i$l$?%F%/%K%C%/$O8e$K(B emu package $B$K$^$H$a$i$l$^$9!#(B@refill $B$3$N:"!"<i2,(B $BCNI'(B $B$O(B @file{tiny-mime.el} $B$r$5$^$6$^$J(B MUA $B$G;H$&$?$a$N@_(B $BDj=8$bG[I[$7$F$$$^$7$?$,!"$=$l$i$O8e$K(B@file{tiny-mime.el} $B$H$H$b$K#1$D$N(B package $B$K$^$H$a$i$l!"(Btm $B$H$$$&L>A0$GG[I[$5$l$^$9!#(B@refill $B<i2,(B $BCNI'(B $B$O$d$,$F!"(BMIME message $B$r1\Mw$9$k$?$a$N%W%m%0%i%`$G$"$k(B @file{tm-body.el} $B$r=q$-$^$9!#$3$l$O!"$9$0$K(B@file{tm-view.el} $B$H$$$&L>A0(B $B$KJQ$o$j$^$7$?$,!"$d$,$F!"$3$l$,(B@file{tiny-mime.el} $B$KBe$o$C$F!"(Btm $B$NCf(B $B3K$H$J$j$^$9!#(B@refill @file{tm-view.el} $B$OEvA3!"(BContent-Transfer-Encoding $B$r07$&I,MW$,$"$j$^$9!#(B $B$3$NL\E*$N$?$a$K!"(BMEL $B$,@0Hw$5$l$O$8$a$^$7$?!#(BBase64 $B$K4X$7$F$O(B @file{tiny-mime.el} $B$N(B code $B$,0\$5$l!"$^$?!"?7$?$K(BQuoted-Printable $B$N(B code $B$,DI2C$5$l$^$7$?!#$3$l$i$,(B@file{mel-b.el} $B$H(B @file{mel-q.el} $B$K$J$j(B $B$^$7$?!#(B@refill $B$^$?!"8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B uuencode $BMQ$N(B @file{mel-u.el} $B$,DI2C$5$l!"(B $B$=$N8e$K!">.NS(B $B=$J?(B $B;a$K$h$C$F(B x-gzip64 $BMQ$N(B@file{mel-g.el} $B$,DI2C$5$l$^(B $B$7$?!#(B@refill tm $B$G$O8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B @file{tiny-mime.el} $B$N:F<BAu$,9T$o$l!"$3(B $B$N2aDx$G!"(BSTD 11 $B$N(B parser $B$,=q$+$l$^$7$?!#$3$l$O!"8=:_$N(B @file{std11.el} $B$KEv$?$j$^$9!#$^$?!"$3$N2aDx$G(B @file{tiny-mime.el} $B$OI|(B $B9f2=$r9T$&(B @file{tm-ew-d.el} $B$HId9f2=$r9T$&(B @file{tm-ew-e.el} $B$KJ,$1$i$l(B $B$^$7$?!#$3$NN><T$,8=:_$N(B @file{eword-decode.el} $B$H(B @file{eword-encode.el} $B$N@hAD$KEv$?$j$^$9!#(B@refill $B8e$K!"<i2,(B $BCNI'(B $B$i$K$h$C$F(B tm $B$NA4LL=q$-49$(:n6H$,9T$o$l!"$3$N2aDx$G!"(Btm $B$O(B APEL, MEL, SEMI, EMH, RMAIL-MIME, Gnus-MIME $B$J$I$KJ,$1$i$l$^$7$?!#$3(B $B$N$&$A$N(B MEL $B$,(B FLIM $B$ND>@\$N@hAD$KEv$?$j$^$9!#(B@refill $B8e$K!"(BAPEL $B$+$i(B @file{std11.el} $B$,0\$5$l!"$^$?!"(B@file{mailcap.el}, @file{eword-decode.el} $B$*$h$S(B @file{eword-encode.el} $B$,(B SEMI $B$+$i0\$5$l!"(B package $B$NL>A0$,(B FLIM $B$H$J$j$^$9!#(B@refill $B$3$ND>A0$+$iEDCf(B $BE/(B $B;a$,$h$j(B RFC $B$KCi<B$J<BAu$r=q$-;O$a!"$3$l$O!"8=:_!"(B FLIM $B$N;^$G$"$k(B ``FLIM-FLAM'' $B$H$J$C$F$$$^$9!#(B @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 ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/mime-ja.sgml���������������������������������������������������������������������������0000664�0000000�0000000�00000130433�11747036124�0015361�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������<!doctype sinfo system> <head> <title>FLIM 1.14 MIME $B5!G=@bL@=q(B <author>$B<i2,(B $BCNI'(B <mail>morioka@jaist.ac.jp</mail> <date>1999-01-27 <toc> </head> <body> <abstract> <p> This file documents MIME features of FLIM, a fundamental library to process Internet Messages for GNU Emacsen. <p> GNU Emacsen $BMQ$N(B Internet Message $B=hM}$N$?$a$N4pAC(B library $B$G$"$k(B FLIM $B$N(B MIME $B5!G=$K4X$7$F@bL@$7$^$9!#(B </abstract> <h1> FLIM $B$C$F2?!)(B <node> Introduction <p> FLIM $B$O(B Internet Message $B$NI=8=$dId9f2=$K4X$9$k4pACE*$J5!G=$rDs6!$9$k(B $B$?$a$N(B library $B$G$9!#(B <h1> FLIM $B$N(B MIME $B5!G=$N;H$$J}(B <node> How to use <p> FLIM $B$NDs6!$9$k(B MIME $B5!G=$r;H$&$?$a$K$O(B <lisp> (require 'mime) </lisp> <noindent>$B$rI>2A$7$F$/$@$5$$!#(B <h1> Message $B$H(B Entity <node> Entity <p> <dref>RFC 2045</dref> $B$K$h$l$P!"!V(BEntity $B$H$$$&8l$O!"(Bmessage, $B$b$7$/$O!"(B multipart entity $B$N(B body $BCf$N#1$D$NItJ,$N!"(BMIME $B$GDj5A$5$l$?(B header field $B$HFbMF$r;X$9!W$H$J$C$F$$$^$9!#$3$3$G$O!"(BMIME $B$GDj5A$5$l$?(B header field $B0J30$NA4$F$N(B header $B$H(B body $B$r;X$98l$H$7$F(B <concept>entity</concept>$B$rMQ$$$k$3$H$K$7$^$9!#(B <p> RFC 2045 $B$NDj5A$O!"(BMIME message $B$,(B entity $B$r@a$H$9$kLZ9=B$$G$"$k$3$H$r(B $B<($7$F$$$^$9!#$D$^$j!"(BMIME $B$O(B message $B$rLZ9=B$$K3HD%$7$?Lu$G$9!#(B <p> FLIM $B$O(B entity $B$N>pJs$rI=8=$9$k$?$a$K(B<concept>mime-entity</concept> $B9=(B $BB$BN$rMQ$$$^$9!#0J2<$G$OC1$K(B mime-entity $B$H8F$V$3$H$K$7$^$9!#(B <h2> Entity $B$N@8@.(B <node> Entity creation <p> <defun name="mime-open-entity"> <opts> type location <p> Entity $B$r3+$$$F!"$=$l$rJV$7$^$9!#(B <p> <var>type</var> $B$O(B representation-type $B$G$9!#(B <cf node="mm-backend"> <p> <var>location</var> $B$O(B entity $B$N0LCV$G$9!#;XDjJ}K!$O(B representation-type $B$K0M$C$FJQ$o$j$^$9!#(B </defun> <defun name="mime-parse-buffer"> <opts> buffer type <p> <var>buffer</var> $B$r(B message $B$H$7$F9=J82r@O$7!"$=$N7k2L$N(B mime-entity $B$r(B <var>buffer</var> $B$N(B<code>mime-message-structure</code> $B$K3JG<$9$k!#(B <p> <var>buffer</var> $B$,>JN,$5$l$?>l9g!"8=:_$N(B buffer $B$r9=J82r@O$9$k!#(B <p> <var>type</var> $B$,;XDj$5$l$?>l9g!"$=$NCM$r@8@.$5$l$k(B mime-entity $B$NI=(B $B>]7?$H$7$FMQ$$$k!#>JN,$5$l$?>l9g$O(B <var>buffer</var> $B$H$J$k!#(B<cf node="mm-backend"> </defun> <h2> Entity $B3,AX(B <node> Entity hierarchy <p> MIME message $B$O(B entity $B$rC10L$H$9$kLZ9=B$$K$J$C$F$$$^$9!#(B <p> $B$3$NLZ$K$*$$$F:,$H$J$k@a$O(B message $BA4BN$rI=$9(B entity $B$G$9!#$3$3$G$O!"(B $B$3$l$r(B <concept>root-entity</concept> $B$b$7$/$O(B <concept>message</concept> $B$H8F$S$^$9!#(B <p> root-entity $B0J30$N(B entity $B$O?F$r;}$A$^$9!#$^$?!"(Bentity $B$O;R6!$r;}$D$+(B $B$bCN$l$^$;$s!#$3$N?F;R4X78$r9M$($k$3$H$G(B entity $B$NAjBP4X78$r07$&$3$H$,(B $B$G$-$^$9!#(B <p> $B0lJ}!"(Bentity $B$N(B message $B$K$*$1$k0LCV$r9M$($k$3$H$b$G$-$^$9!#(B <p> entity $B$O$3$NLZ$K$*$1$k@a$H$J$j$^$9$,!"$3$NLZ$K$O?<$5$HF1$8?<$5$NCf$N(B $B=gHV$K=>$C$FHV9f$,IU$1$k$3$H$,$G$-$^$9!#B($A!"(B <verb> $B(#(!(!(!($(B $B("(B nil $B("(B $B(&(!(((!(%(B $B(#(!(!(!(!(!(!(!(!(!(+(!(!(!(!(!(!(!(!(!($(B $B(#(*($(B $B(#(*($(B $B(#(*($(B $B("#0("(B $B("#1("(B $B("#2("(B $B(&(((%(B $B(&(((%(B $B(&(((%(B $B("(B $B(#(!(!(!(!(+(!(!(!(!($(B $B("(B $B(#(!(*(!($(#(!(*(!($(#(!(*(!($(#(!(*(!($(#(!(*(!($(B $B("(B $B#0(B.$B#0("("(B $B#1(B.$B#0("("(B $B#1(B.$B#1("("(B $B#1(B.$B#2("("(B $B#2(B.$B#0("(B $B(&(!(!(!(%(&(!(!(!(%(&(!(!(!(%(&(!(!(!(%(&(!(!(!(%(B </verb> <p> <noindent>$B$N$h$&$K?<$5(B n $B$N@a$K$OD9$5(B n $B$N@0?tNs$N@aHV9f$,?6$l$^$9!#$3$l(B $B$r(B <concept>entity-number</concept> $B$H8F$S$^$9!#(Bentity-number $B$O(B S $B<0$H(B $B$7$F$O(B <code>(1 2 3)</code> $B$N$h$&$J@0?t$N%j%9%H$H$7$FI=8=$5$l$^$9!#(B <p> mime-entity $B$G$O!"$3$l$HF1MM$N(B <concept>node-id</concept> $B$rMQ$$$^$9!#(B node-id $B$O$A$g$&$I(B entity-number $B$r5U$K$7$?%j%9%H$G!"(Bentity-number 1.2.3 $B$KBP1~$9$k(B node-id $B$O(B <code>(3 2 1)</code> $B$G$9!#(B <p> $BA0=R$N$h$&$K!"(BMIME message $B$O(B entity $B$rC10L$H$7$?LZ9=B$$K$J$C$F$$$k$N$G!"(B $B$3$N:,$G$"$k(B message $BA4BN$b(B mime-entity $B$GI=8=$9$k$3$H$,$G$-!"(Bbuffer local $BJQ?t(B <code>mime-message-structure</code> $B$K3JG<$9$k$3$H$K$7$^$9!#(B <p> <code>mime-message-structure</code> $B$r5/E@$K(B entity-number $B$d(B node-id $B$G<($5$l$k(B entity $B$r<h$j=P$9$3$H$,$G$-$^$9!#(B <defvar name="mime-message-structure"> <p> $B8=:_$N(B buffer $B$K$*$1$k(B message $BA4BN$N(B mime-entity $B9=B$BN$r3JG<$9$k(B buffer local $BJQ?t!#(B </defvar> <defun name="mime-entity-children"> <args> entity <p> <var>entity</var> $B$K4^$^$l$k(B entity $B$N(B list $B$rJV$9!#(B </defun> <defun name="mime-entity-parent"> <args> entity <opts> message <p> <var>entity</var> $B$N?F$N(B entity $B$rJV$9!#(B <p> <var>message</var> $B$,;XDj$5$l$?>l9g!"$3$l$r:,$H8+Jo$9!#(B </defun> <defun name="mime-root-entity-p"> <args> entity <p> <var>entity</var> $B$,:,!JB($A!"(Bmessage $BA4BN!K$G$"$k>l9g$K!"(B $BHs(B-<code>nil</code> $B$rJV$9!#(B </defun> <defun name="mime-entity-node-id"> <args> entity <p> <var>entity</var> $B$N(B node-id $B$rJV$9!#(B </defun> <defun name="mime-entity-number"> <args> entity <p> <var>entity</var> $B$N(B entity-number $B$rJV$9!#(B </defun> <h2> Entity $B$N8!:w(B <node> Entity Search <p> <defun name="mime-find-entity-from-number"> <args> entity-number <opts> message <p> <var>message</var> $B$+$i!"(B<var>enity-number</var> $B$N(B entity $B$rJV$7$^$9!#(B <p> <var>message</var> $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B <code>mime-message-structrue</code> $B$,;H$o$l$^$9!#(B </defun> <defun name="mime-find-entity-from-node-id"> <args> entity-node-id <opts> message <p> <var>message</var> $B$+$i!"(B<var>entity-node-id</var> $B$N(B entity $B$rJV$7$^(B $B$9!#(B <p> <var>message</var> $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B <code>mime-message-structure</code> $B$,;H$o$l$^$9!#(B </defun> <defun name="mime-find-entity-from-content-id"> <args> cid <opts> message <p> <var>message</var> $B$+$i!"(B<var>cid</var> $B$N(B entity $B$rJV$7$^$9!#(B <p> <var>message</var> $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B <code>mime-message-structure</code> $B$,;H$o$l$^$9!#(B </defun> <h2> Entity $B$NB0@-(B <node> Entity Attributes <p> <defun name="mime-entity-content-type"> <args> entity <p> <var>entity</var> $B$N(B content-type $B$rJV$9!#(B<cf node="mime-content-type"> </defun> <defun name="mime-entity-content-disposition"> <args> entity <p> <var>entity</var> $B$N(B content-disposition $B$rJV$9!#(B<cf node="mime-content-disposition"> </defun> <defun name="mime-entity-filename"> <args> entity <p> <var>entity</var> $B$N(B file $BL>$rJV$9!#(B </defun> <defun name="mime-entity-encoding"> <args> entity <opts> default-encoding <p> <var>entity</var> $B$N(B content-transfer-encoding $B$rJV$9!#(B<cf node="Content-Transfer-Encoding"> <p> $B$b$7!"(B<var>entity</var> $B$K(B Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l(B $B9g$O!"(B<var>default-encoding</var> $B$rJV$9!#$3$l$,;XDj$5$l$J$$>l9g$O!"(B <code>"7bit"</code> $B$rMQ$$$k!#(B </defun> <defun name="mime-entity-cooked-p"> <args> entity <p> <var>entity</var> $B$NFbMF$,4{$K%3!<%IJQ49$5$l$F$$$k>l9g$O(B nil $B$GL5$$CM(B $B$rJV$9!#(B </defun> <h2> Entity header $B$N>pJs(B <node> Entity-header <p> <defun name="mime-fetch-field"> <args> field-name <opts> entity <p> <var>entity</var> $B$N(B header $BCf$N(B <var>field-name</var> $BMs$N(B body $B$rJV$9!#(B <p> $B7k2L$NJ8;zNs$O(B network $BI=8=$N$^$^$G$"$k!#(B <p> <var>entity</var> $B$,>JN,$5$l$?>l9g$O!"(B <code>mime-message-structure</code> $B$NCM$rMQ$$$k!#(B <p> <var>field-name</var> $BMs$,B8:_$7$J$$>l9g$O(B <code>nil</code> $B$rJV$9!#(B </defun> <defun name="mime-read-field"> <args> field-name <opts> entity <p> <var>entity</var> $B$N(B header $BCf$N(B <var>field-name</var> $BMs$r9=J82r@O$7$?(B $B7k2L$rJV$9!#(B <p> $B7k2L$N7A<0$OMsKh$K0[$J$k!#Hs9=B$2=Ms$N>l9g$OJ8;zNs$rJV$7!"9=B$2=Ms$N>l9g(B $B$O$=$N7A<0$K=>$C$?(B list $B$rJV$9!#(B <p> $B7k2LCf$NJ8;zNs$O(B Emacs $B$NFbItI=8=$KJQ49$5$l$k!#(B <p> <var>entity</var> $B$,>JN,$5$l$?>l9g$O!"(B <code>mime-message-structure</code> $B$NCM$rMQ$$$k!#(B <p> <var>field-name</var> $BMs$,B8:_$7$J$$>l9g$O(B nil $B$rJV$9!#(B </defun> <h2> Entity $B$NJ8;zI=8=(B <node> entity formatting <p> <defun name="mime-insert-header"> <args> entity <opts> invisible-fields visible-fields <p> $B8=:_0LCV$K(B <var>entity</var> $B$NI|9f$7$?(B header $B$rA^F~$9$k!#(B <p> <var>invisible-fields</var> $B$H(B <var>visible-fields</var> $B$O@55,I=8=$N(B list $B$G!"$=$l$>$l!"I=<($7$?$/$J$$(B field $BL>$HI=<($7$?$$MsL>$rI=8=$7$?$b$N(B $B$G$"$k!#(B <p> <var>invisible-fields</var> $B$NMWAG$N$I$l$+$K(B match $B$7!"$+$D!"(B <var>visible-fields</var> $B$NMWAG$N$I$l$K$b(B match $B$7$J$$Ms$OI=<($5$l$J(B $B$$!#(B <p> <dref>encoded-word</dref> $B$OI|9f$5$l$k!#!X@8$NHs(B us-ascii $BJ8;z!Y$O(B <code>default-mime-charset</code> $B$H$7$F2r<a$5$l$k!#(B </defun> <defun name="mime-insert-text-content"> <args> entity <p> point $B$NA0$K(B <var>entity</var> $B$r(B text entity $B$H$7$FA^F~$7$^$9!#(B <p> <var>entity</var> $B$NFbMF$O(B <dref>MIME charset</dref> $B$H$7$FI|9f2=$5$l(B $B$^$9!#(B<var>entity</var> $B$N(B Content-Type field $B$K(B charset paramter $B$,L5(B $B$$$H!"(B<code>default-mime-charset</code> $B$,=i4|CM$H$7$F;H$o$l$^$9!#(B </defun> <defvar name="default-mime-charset"> <p> $BE,@Z$J(B <dref>MIME charset</dref> $B$,8+$D$+$i$J$+$C$?>l9g$KMQ$$$i$l$k(B MIME charset. <p> $BK\Mh$O(B APEL $B$NJQ?t$G$"$k!#(B </defvar> <h2> Entity $B$NFbMF(B <node> Entity-content <p> <defun name="mime-entity-content"> <args> entity <p> <var>entity</var> $B$NFbMF$N(B byte $BNs$rJV$9!#(B </defun> <defun name="mime-insert-entity-content"> <args> entity <p> point $B$N0LCV$K(B <var>entity</var> $B$NFbMF$rA^F~$7$^$9!#(B </defun> <defun name="mime-write-entity-content"> <args> entity filename <p> <var>entity</var> $B$NFbMF$r(B <var>filename</var> $B$K=q$-9~$_$^$9!#(B </defun> <h2> Entity $B$N%M%C%H%o!<%/I=8=(B <node> Entity-network-representation <p> <defun name="mime-insert-entity"> <args> entity <p> <var>entity</var> $B$N(B header $B$H(B body $B$r(B point $B$N$H$3$m$KA^F~$7$^$9!#(B </defun> <defun name="mime-write-entity"> <args> entity filename <p> <var>entity</var> $B$NI=8=$r(B <var>filename</var> $B$K=q$-9~$_$^$9!#(B </defun> <defun name="mime-write-entity-body"> <args> entity filename <p> <var>entity</var> $B$N(B body $B$r(B <var>filename</var> $B$K=q$-9~$_$^$9!#(B </defun> <h2> Entity $B$N(B buffer $B$K$h$kI=8=(B <node> Entity buffer <p> <defun name="mime-entity-buffer"> <args> entity <p> <var>entity</var> $B$,B8:_$9$k(B buffer $B$rJV$9!#(B </defun> <defun name="mime-entity-point-min"> <args> entity <p> <var>entity</var> $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(B<var>entity</var> $B$,@j$a$k(B $BNN0h$N@hF,0LCV$rJV$9!#(B </defun> <defun name="mime-entity-point-max"> <args> entity <p> <var>entity</var> $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(B<var>entity</var> $B$,@j$a$k(B $BNN0h$NKvHx0LCV$rJV$9!#(B </defun> <defun name="mime-entity-header-start"> <args> entity <p> <var>entity</var> $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(Bheader $B$,@j$a$kNN0h$N@hF,(B $B0LCV$rJV$9!#(B </defun> <defun name="mime-entity-header-end"> <args> entity <p> <var>entity</var> $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(Bheader $B$,@j$a$kNN0h$NKvHx(B $B0LCV$rJV$9!#(B </defun> <defun name="mime-entity-body-start"> <args> entity <p> <var>entity</var> $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(Bbody $B$,@j$a$kNN0h$N@hF,0L(B $BCV$rJV$9!#(B </defun> <defun name="mime-entity-body-end"> <args> entity <p> <var>entity</var> $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(Bbody $B$,@j$a$kNN0h$NKvHx0L(B $BCV$rJV$9!#(B </defun> <h2> Entity $B$NI=8=$H<B8=(B <node> mm-backend <p> Entity $B$OCj>]2=$5$l$?%G!<%?I=8=$G!"<B:]$N%G!<%?I=8=$H$7$F$OMQES$K1~$8$F(B $B$5$^$6$^$J$b$N$,MxMQ$G$-$k$h$&$K@_7W$5$l$F$$$^$9!#(B <p> $B$3$3$G!"(Bentity $B$,$I$&$$$&<oN`$NI=8=$r9T$C$F$$$k$+$r<($9$N$,(B <concept>representation-type</concept> $B$G!"(Bentity $B$r@8@.$9$k;~$K$O$3$l$r(B $B;XDj$7$^$9!#(B<cf node="Entity Creation"> <p> $BA0@a$^$G$K=R$Y$FMh$?(B entity $B$KBP$9$k=hM}$O!"(Bentity $B$KBP$7$F$=$N=hM}$r0M(B $BMj$9$k$3$H$K$h$C$F<B8=$5$l$F$$$^$9!#(BEntity $B$O<+J,$N(B representation-type $B$rCN$C$F$*$j!"$=$N(B representation-type $B$K1~$8$F<B:](B $B$N=hM}$r9T$&4X?t$r8F$S=P$7$^$9!#$3$N$h$&$J4X?t$r(B <concept>entity $B=hM}(B method</concept> $B$H8F$S$^$9!#$^$?!"(Brepresentation-type $BKh$K$3$N$h$&$J4X(B $B?t$r$^$H$a$?$b$N$r(B <concept>mm-backend</concept> $B$H8F$S$^$9!#(B <p> mm-backend $B$O(B representation-type $B$NL>A0$N@hF,$K(B <code>mm</code> $B$H$$$&(B $B@\F,<-$rIU$1$?4X?tL>$+$i$J$k(B module $B$G!"$=$N(B module $BL>$OF1MM$K(B representation-type $B$NL>A0$N@hF,$K(B <code>mm</code> $B$rIU$1$?$b$N$K$J$C$F(B $B$$$^$9!#$3$N(B module $B$O(B representation-type $B$N(B entity $B$,:G=i$K@8@.$5$l$k(B $B;~$K<+F0E*$K(B require $B$5$l$^$9!#(B <h3> Entity $B$X$NJX$j(B <node> Request for entity <p> <defun name="mime-entity-send"> <args> entity message <rest> args <p> <var>entity</var> $B$K(B <var>message</var> $B$rAw$k!#(B <p> <var>args</var> $B$O(B <var>message</var> $B$N0z?t$G$"$k!#(B </defun> <h3> mm-backend $B$N:n$jJ}(B <node> mm-backend module <p> <defmacro name="mm-define-backend"> <args> type <opts> parents <p> <var>type</var> $B$r(B mm-backend $B$H$7$FDj5A$7$^$9!#(B <p> <var>PARENTS</var> $B$,;XDj$5$l$F$$$k>l9g$O!"(B<var>type</var> $B$O(B prents $B$r7Q>5$7$^$9!#$=$l$>$l$N(B parent $B$O(B representation-type $B$G$"$kI,MW$,$"(B $B$j$^$9!#(B <p> $BNc(B: <p> <lisp> (mm-define-backend chao (generic)) </lisp> </defmacro> <defmacro name="mm-define-method"> <args> name args <rest> body <p> <var>name</var> $B$r(B (nth 1 (car <var>args</var>)) backend $B$N(B method $B4X(B $B?t$H$7$FDj5A$7$^$9!#(B <p> <var>args</var> $B$O(B lambda $B$N0z?t%j%9%H$N$h$&$J$b$N$G$9$,!"(B(car <var>args</var>) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car (car <var>args</var>)) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car <var>args</var>)) $B$O(B backend $B$NL>A0(B (representation-type) $B$G$9!#(B <p> $BNc(B: <p> <lisp> (mm-define-method entity-cooked-p ((entity chao)) nil) </lisp> </defmacro> <h1> Content-Type $BMs$N>pJs(B <node> Content-Type <p> <concept>Content-Type $BMs(B</concept> $B$O(B <dref>media-type</dref> $B$d(B MIME charset $B$H$$$C$?(B <dref>entity</dref> $B$NFbMF$N<oN`$dI=8=7A<0$J$I$r5-=R(B $B$9$k$?$a$N$b$N$G!"(B<dref>RFC 2045</dref> $B$GDj5A$5$l$F$$$^$9!#(B <memo> <p> $BNr;KE*$K$O(B RFC 1049 $B$G(B Content-Type $BMs$,Ds0F$5$l$F$$$k!#C"$7!"(BMIME $B$N(B media-type $B$N$h$&$J(B type $B$H(B subtype $B$N6hJL$O$J$/!"(BMIME charset $B$N$h$&(B $B$JJ8;zId9f$N<oN`$rI=8=$9$k$3$H$b$G$-$J$$!#(B </memo> <p> FLIM $B$O(B Content-Type $BMs$r9=J82r@O$9$k4X?t$H(B Content-Type $BMs$N2r@O7k2L$r(B $B3JG<$9$k9=B$BN(B <concept>mime-content-type</concept> $B$rDs6!$7$^$9!#(B <h2> Content-Type $BMs$N7A<0(B <node> Content-Type field <p> Content-Type $BMs$N7A<0$O0J2<$N$h$&$KDj5A$5$l$F$$$^$9!'(B <quote> ``Content-Type'' ``:'' <concept>type</concept> ``/'' <concept>subtype</concept> *( ``;'' <concept>parameter</concept> ) </quote> <p> $BNc$($P!"(B <quote> <verb> Content-Type: image/jpeg </verb> </quote> <noindent> $B$d(B <quote> <verb> Content-Type: text/plain; charset=iso-2022-jp </verb> </quote> <noindent> $B$J$I$N$h$&$KMQ$$$i$l$^$9!#(B <p> $B$3$3$G!"(B`type' $B$H(B `subtype' $B$O(B entity $B$N7A<0$r<($9$b$N$G!"N><T$rAm>N$7(B $B$F!"(B`media-type' $B$H8F$V$3$H$K$7$^$9!#>e5-$NNc$K$*$1$k(B `image/jpeg' $B$d(B `text/plain' $B$O(B media-type $B$N#1$D$G$9!#(B <memo> <p> Content-Type $BMs$N$J$$(B entity $B$O(B <quote> <verb> Content-Type: text/plain; charset=us-ascii </verb> </quote> <noindent> $B$H$7$F2r<a$5$l$k!#(B<cf node="us-ascii"> </memo> <h2> mime-content-type $B9=B$BN(B <node> mime-content-type <p> <define type="Structure" name="mime-content-type"> <p> Content-Type $BMs$N>pJs$r3JG<$9$k$?$a$N9=B$BN!#(B <p> $B$3$N9=B$BN$r;2>H$9$k$K$O(B <code>mime-content-type-$BMWAGL>(B</code> $B$H$$$&L>(B $BA0$N;2>H4X?t$rMQ$$$k!#(B <p> $B$3$N9=B$BN$NMWAG$O0J2<$NDL$j$G$"$k!'(B <vl> <dt>primary-type<dd>media-type $B$N<g7?(B (symbol). </dd> <dt>subtype<dd>media-type $B$NI{7?(B (symbol). </dd> <dt>parameters<dd>Content-Type $BMs$N(B parameter ($BO"A[(B list). </dd> </vl> </define> <defun name="make-mime-content-type"> <args> type subtype <opts> parameters <p>content-type $B$N@8@.;R!#(B </defun> <defun name="mime-content-type-parameter"> <args> content-type parameter <p> <var>content-type</var> $B$N(B <var>parameter</var> $B$NCM$rJV$9!#(B </defun> <h2> Content-Type $BMs$N2r@O4o(B <node> Content-Type parser <p> <defun name="mime-parse-Content-Type"> <args> string <p> <var>string</var> $B$r(B content-type $B$H$7$F2r@O$7$?7k2L$rJV$9!#(B </defun> <defun name="mime-read-Content-Type"> <p> $B8=:_$N(B buffer $B$N(B Content-Type $BMs$rFI$_<h$j!"2r@O$7$?7k2L$rJV$9!#(B <p> Content-Type $BMs$,B8:_$7$J$$>l9g$O(B nil $B$rJV$9!#(B </defun> <h2> Content-Type $B$K4X$9$kM-MQ$J4X?t(B <node> Content-Type utility <p> <defun name="mime-type/subtype-string"> <args> type <opts> subtype <p> <var>type</var> $B$H(B <var>subtype</var> $B$+$i(B type/subtype $B7A<0$NJ8;zNs$rJV(B $B$9!#(B </defun> <h1> Content-Disposition $BMs$N>pJs(B <node> Content-Disposition <p> <concept>Content-Disposition $BMs(B</concept> $B$O(B entity $B$NI=<($d(B file $BL>$J$I(B $B$NB0@-$K$J$I$K4X$9$k>pJs$r5-=R$9$k$?$a$N$b$N$G$9!#(B <rfc number="2183" type="Standards Track" author="S. Dorner, K. Moore and R. Troost" title="Communicating Presentation Information in Internet Messages: The Content-Disposition Header" date="August 1997"> <p> FLIM $B$O(B Content-Disposition $BMs$r9=J82r@O$9$k4X?t$H(B Content-Disposition $BMs$N2r@O7k2L$r3JG<$9$k9=B$BN(B <concept>mime-content-disposition</concept> $B$rDs6!$7$^$9!#(B <h2> mime-content-disposition $B9=B$BN(B <node> mime-content-disposition <p> <define type="Structure" name="mime-content-disposition"> <p> Content-Disposition $BMs$N2r@O7k2L$r<}$a$k$?$a$N9=B$BN!#(B <p> $B$3$N9=B$BN$r;2>H$9$k$K$O(B <code>mime-content-disposition-$BMWAGL>(B</code> $B$H(B $B$$$&L>A0$N;2>H4X?t$rMQ$$$k!#(B <p> $B$3$N9=B$BN$NMWAG$O0J2<$NDL$j$G$"$k!'(B <vl> <dt>disposition-type<dd>disposition-type (symbol). </dd> <dt>parameters<dd>Content-Disposition $BMs$N(B parameter ($BO"A[(B list). </dd> </vl> </define> <defun name="mime-content-disposition-parameter"> <args> content-disposition parameter <p> <var>content-disposition</var> $B$N(B <var>parameter</var> $B$NCM$rJV$9!#(B </defun> <defun name="mime-content-disposition-filename"> <args> content-disposition <p> <var>content-disposition</var> $B$N(B filename $B$NCM$rJV$9!#(B </defun> <h2> Content-Disposition $BMs$N2r@O4o(B <node> Content-Disposition parser <p> <defun name="mime-parse-Content-Disposition"> <args> string <p> <var>string</var> $B$r(B content-disposition $B$H$7$F2r@O$7$?7k2L$rJV$9!#(B </defun> <defun name="mime-read-Content-Disposition"> <p> $B8=:_$N(B buffer $B$N(B Content-Disposition $BMs$rFI$_<h$j!"2r@O$7$?7k2L$rJV$9!#(B <p> Content-Disposition $BMs$,B8:_$7$J$$>l9g$O(B nil $B$rJV$9!#(B </defun> <h1> $BId9f2=K!(B <node> Content-Transfer-Encoding <p> <concept>Content-Transfer-Encoding $BMs(B</concept> $B$O(B entity $B$NId9f2=K!$r5-(B $B=R$9$k$?$a$N$b$N$G$9!#(B <p> FLIM $B$G$O(B Content-Transfer-Encoding $BMs$r9=J82r@O$9$k4X?t$rDs6!$7$^$9!#$3(B $B$l$i$N4X?t$O(B Content-Transfer-Encoding $BMs$N>pJs$OJ8;zNs$GI=8=$7$^$9!#(B <p> $B$^$?!"(BContent-Transfer-Encoding $B$K4p$E$$$FId9f2=!&I|9f2=$r9T$&4X?t$bDs(B $B6!$5$l$^$9!#(B <h2> Content-Transfer-Encoding $BMs$N2r@O4o(B <node> Content-Transfer-Encoding parser <p> <defun name="mime-parse-Content-Transfer-Encoding"> <args> string <p> <var>string</var> $B$r(B content-transfer-encoding $B$H$7$F2r@O$7$?7k2L$rJV$9!#(B </defun> <defun name="mime-read-Content-Transfer-Encoding"> <opts>default-encoding <p> $B8=:_$N(B buffer $B$N(B Content-Transfer-Encoding $BMs$rFI$_<h$j!"2r@O$7$?7k2L$r(B $BJV$9!#(B <p> Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l9g$O(B <var>default-encoding</var> $B$rJV$9!#(B </defun> <h2> $BId9f2=!&I|9f2=(B <node> encoder/decoder <p> <defun name="mime-encode-region"> <args> start end encoding <p> $B8=:_$N(B buffer $B$N(B <var>start</var> $B$+$i(B <var>end</var> $B$^$G$N(B region $B$r(B <var>encoding</var> $B$r;H$C$FId9f2=$7$^$9!#(B </defun> <defun name="mime-decode-region"> <args> start end encoding <p> $B8=:_$N(B buffer $B$N(B <var>start</var> $B$+$i(B <var>end</var> $B$^$G$N(B region $B$r(B <var>encoding</var> $B$r;H$C$FI|9f2=$7$^$9!#(B </defun> <defun name="mime-decode-string"> <args> string encoding <p> <var>string</var> $B$r(B <var>encoding</var> $B$H$7$FI|9f$7$?7k2L$rJV$9!#(B </defun> <defun name="mime-insert-encoded-file"> <args> filename encoding <p> <var>ENCODING</var> format $B$GId9f2=$5$l$?(B file <var>FILENAME</var> $B$r(B $BA^F~$9$k!#(B </defun> <defun name="mime-write-decoded-region"> <args> start end filename encoding <p> <var>encoding</var> $B$GId9f2=$5$l$?8=:_$N(B region $B$rI|9f2=$7$F(B <var>filename</var>$B$K=q$-9~$_$^$9!#(B <p> <var>start<var> $B$H(B <var>end</var> $B$O(B buffer $B$N0LCV$G$9!#(B </defun> <h2> $BB>$N(B utility <node> Encoding information <p> <defun name="mime-encoding-list"> <opts> SERVICE <p> Content-Transfer-Encoding $B$N(B list $B$rJV$7$^$9!#(B <p> <var>service</var> $B$,;XDj$5$l$F$$$k$H!"$=$l$KBP$9$k(B Content-Transfer-Encoding $B$rJV$7$^$9!#(B </defun> <defun name="mime-encoding-alist"> <opts> SERVICE <p> $BJd40$N$?$a$N(B Content-Transfer-Encoding $B$NI=$rJV$7$^$9!#(B <p> <var>service</var> $B$,;XDj$5$l$F$$$k>l9g$O$=$l$KBP$9$k(B Content-Transfer-Encoding $B$N(B list $B$rJV$7$^$9!#(B </defun> <h2> $BId9f2=(B/$BI|9f2=(B module $B$N=q$-J}(B <node> mel-backend <p> <defmacro name="mel-define-method"> <args> name args <rest> body <p> <var>name</var> $B$r(B (nth 1 (car (last <var>args</var>))) backend $B$N(B method $B4X?t$H$7$FDj5A$7$^$9!#(B <p> <var>args</var> $B$O(B lambda $B$N0z?t(B list $B$H;w$F$$$^$9$,!"(B(car (last <var>args</var>)) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car (car (last <var>args</var>))) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car (last <var>args</var>))) $B$O(B backend $B$NL>A0(B (encoding) $B$G$9!#(B <p> $BNc(B: <p> <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) ))) </lisp> </defmacro> <defmacro name="mel-define-method-function"> <args> spec function <p> <var>spec</var> $B$N4X?tDj5A$r(B <var>function</var> $B$K@_Dj$7$^$9!#(B <p> <var>spec</var> $B$N:G=i$NMWAG$O(B service $B$G$9!#(B <p> <var>args</var> $B$N;D$j$O(B lambda $B$N0z?t(B list $B;w$F$$$^$9$,!"(B(car (last <var>args</var>)) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car (car (last <var>args</var>))) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car (last <var>args</var>))) $B$O(B backend $B$NL>A0(B (encoding) $B$G$9!#(B <p> $BNc(B: <p> <lisp> (mel-define-method-function (mime-encode-string string (nil "base64")) 'encode-base64-string) </lisp> </defmacro> <h2> $BId9f2=(B/$BI|9f2=(B service $B$rDI2C$9$kJ}K!(B <node> generic function for mel-backend <p> <defmacro name="mel-define-service"> <args> name <opts> args doc-string <p> <var>name</var> $B$r(B Content-Transfer-Encoding $B$N(B service $B$H$7$FDj5A$7$^(B $B$9!#(B <p> <var>args</var> $B$,;XDj$5$l$F$$$k$H!"(B<var>name</var> $B$O(B service $B$N(B generic function $B$H$7$FDj5A$5$l$^$9!#(B <p> $BNc(B: <p> <lisp> (mel-define-service encoded-text-encode-string (string encoding) "Encode STRING as encoded-text using ENCODING. ENCODING must be string.") </lisp> </defmacro> <h1> Header $B$N(B network $BI=8=(B <node> encoded-word <p> encoded-word $B$O(B header $B$GHs(B <dref>ASCII</dref> $BJ8;z$rI=8=$9$k$?$a$N7A(B $B<0$G!"(B<concept>RFC 2047</concept> $B$GDj5A$5$l$F$$$^$9!#(B <p> <rfc number="2047" type="Standards Track" author="K. Moore" title="MIME (Multipurpose Internet Mail Extensions) Part Three: Message Header Extensions for Non-ASCII Text" date="November 1996" obsolete="1521,1522,1590"> <p> $B$^$?!"9T57$N0-$$$3$H$@$H8@$($^$9$,!"(Bencoded-word $B$rMQ$$$:$KHs(B <dref>ASCII</dref> $BJ8;z$r(B header $B$KF~$l$?5-;v$bB8:_$7$^$9!#(B <p> FLIM $B$O$3$l$i$rId9f2=!&I|9f2=$9$k5!G=$rDs6!$7$^$9!#(B <h2> Header $B$NId9f2=!&I|9f2=(B <node> Header encoder/decoder <p> <defun name="eword-decode-header"> <opts> code-conversion separator <p> Header $BCf$N(B encoded-word $B$rI|9f$9$k!#(B <p> $B$b$7(B <var>code-conversion</var> $B$,(B <code>nil</code> $B$J$i!"(Bencoded-word $B$@$1$,I|9f$5$l$k!#$b$7!"(B<var>code-conversion</var> $B$,(B <dref>MIME charset</dref> $B$J$i!"Hs(B ASCII bit patterns $B$O$=$N(B MIME charset $B$H$7$F(B $BI|9f$5$l$k!#$3$l0J30$N>l9g!"Hs(B ASCII bit patterns $B$O(B <code>default-mime-charset</code>. $B$H$7$FI|9f$5$l$k!#(B<cf node="entity formatting"> <p> $B$b$7(B <var>separator</var> $B$,(B <code>nil</code> $B$G$J$1$l$P!"$=$NCM$,(B header separator $B$H$7$FMQ$$$i$l$k!#(B </defun> <defun name="eword-encode-header"> <opts> code-conversion <p> Header $B$r(B network $BI=8=$KId9f2=$9$k!#(B <p> $B3F(B field $B$O(B <code>mime-field-encoding-method-alist</code> $B$G;XDj$5$l(B $B$?J}<0$GId9f2=$5$l$k!#(B </defun> <defvar name="mime-field-encoding-method-alist"> <p> Field $B$rId9f2=$9$kJ}K!$r;XDj$9$kO"A[(B list$B!#3F(B element $B$O(B (FIELD . METHOD) $B$NMM$K$J$C$F$$$k!#(B <p> METHOD $B$,(B <code>mime</code> $B$G$"$l$P!"(BFIELD $B$O(B MIME format $B$KId9f2=$5(B $B$l$k(B (encoded-word)$B!#(B <p> METHOD $B$,(B <code>nil</code> $B$G$"$l$P!"(BFIELD $B$OId9f2=$5$l$J$$!#(B <p> METHOD $B$,(B MIME charset $B$G$"$l$P!"(BFIELD $B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J(B $B$1$l$P$J$i$J$$$H$-$K(B charset $B$KId9f2=$5$l$k!#(B <p> $B$=$&$G$J$1$l$P!"(BFIELD $B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J$1$l$P$J$i$J$$$H$-(B $B$K(B $BJQ?t(B <code>default-mime-charset</code> $B$GId9f2=$5$l$k(B </defvar> <h1> $B0lHL@_Dj(B <node> custom <p> <define type="group" name="mime"> <p> MIME $B4XO"5!G=$K4X$9$k(B group. <p> <code>mail</code> $B$H(B <code>news</code> $B$KB0$9$k!#(B </define> <h1> $BIUO?(B <node> Appendix <h2> $BMQ8l(B <node> Glossary <h3> 7bit <node> 7bit <p> $B$3$3$G$O(B 0 $B$+$i(B 127 $B$N@0?t$r;X$9!#(B <p> 0 $B$+$i(B 127 $B$N@0?t$NNs$GI=8=$G$-$k$h$&$J(B data $B$r(B ``7bit $B$N(B data'' $B$H8F(B $B$V!#(B <p> $B$^$?!"(B0 $B$+$i(B 31 $B$*$h$S(B 127 $B$GI=8=$5$l$k@)8fJ8;z$H(B 32 $B$GI=8=$5$l$k6uGr(B $B$H(B 33 $B$+$i(B 126 $B$GI=8=$5$l$k?^7AJ8;z$+$i$J$kJ8;zNs$N$3$H$r(B ``7bit $B$NJ8(B $B;zNs(B'' $B$H8F$V!J$3$l$O(B <dref>ISO 2022</dref> $B$N!V(B7 $BC10L7O!W$HF1MM!K!#(B <p> $BEAE}E*$J(B Internet $B$N(B <dref>MTA</dref> $B$O(B 7bit $B$N(B data $B$rE>Aw$G$-$k$N$G!"(B 7bit $B$N(B data $B$O(B <dref>Quoted-Printable</dref> $B$d(B <dref>Base64</dref> $B$H$$$C$?JQ49$r9T$o$J$/$F$b$=$N$^$^E>Aw$G$-$k!#(B <p> $B$7$+$7!"(B7bit $B$G$"$l$P$I$s$J(B data $B$G$bNI$$$H$O$$$($J$$!#$J$<$J$i!"#19T(B $B$ND9$5$,$"$^$j$KD9$$$H!"(BMTA $B$O$=$N(B message $B$rE>Aw$9$k$3$H$,$G$-$J$$$+(B $B$i$G$"$k!#$A$J$_$K!"(B<dref>RFC 821</dref> $B$O#19T$O2~9TJ8;z$r=|$$$F(B 998 byte $B0JFb$G$"$k$3$H$r5a$a$F$$$k!#$h$C$F!"$3$l0J>e$N9T$,4^$^$l$k2DG=@-(B $B$N$"$k(B data, $BNc$($P!"(BPostscript $B$N(B data $B$J$I$O(B Quoted-Printable $BEy$G(B encode$B$9$kI,MQ$,$"$k!#(B <h3> 8bit <node> 8bit <p> $B$3$3$G$O(B 0 $B$+$i(B 255 $B$N@0?t$r;X$9!#(B <p> 0 $B$+$i(B 255 $B$N@0?t$NNs$GI=8=$G$-$k$h$&$J(B data $B$r(B ``8bit $B$N(B data'' $B$H8F(B $B$V!#(B <p> $B$^$?!"(B0 $B$+$i(B 31, 127 $B$*$h$S(B 128 $B$+$i(B 159 $B$GI=8=$5$l$k@)8fJ8;z$H(B 32 $B$G(B $BI=8=$5$l$k6uGr$H(B 33 $B$+$i(B 126 $B$H(B 160 $B$+$i(B 255 $B$GI=8=$5$l$k?^7AJ8;z$+$i(B $B$J$kJ8;zNs$N$3$H$r(B ``8bit $B$NJ8;zNs(B'' $B$H8F$V!J$3$l$O(B <dref>ISO 2022</dref> $B$N!V(B8 $BC10L7O!W$HF1MM!K!#(B <p> <dref>iso-8859-1</dref> $B$d(B <dref>euc-kr</dref> $B$H$$$C$?Id9f2=J8;z=89g(B $B$O(B 8bit $B$NJ8;zNs$G$"$k!#(B <p> $BEAE}E*$J(B Internet $B$N(B <dref>MTA</dref> $B$O(B <dref>7bit</dref> $B$N(B data $B$7(B $B$+E>Aw$G$-$J$$$N$G!"$=$&$7$?(B MTA $B$r7PM3$9$k>l9g!"(B <dref>Quoted-Printable</dref> $B$d(B <dref>Base64</dref> $B$H$$$C$?JQ49$r9T(B $B$o$J$/$F$O$J$i$J$$!#(B <p> $B$7$+$7!":G6a$G$O(B 8bit $B$NJ8;zNs$r$=$N$^$^DL$9$3$H$,$G$-$k(B MTA $B$bEP>l$7(B $B$F$-$?$N$G!"$=$N$^$^Aw$k$3$H$,$G$-$k>l9g$bA}$($F$-$?!#(B <p> $B$7$+$7!"(B8bit $B$G$"$l$P$I$s$J(B data $B$G$bNI$$$H$O$$$($J$$!#$J$<$J$i!"#19T(B $B$ND9$5$,$"$^$j$KD9$$$H!"(BMTA $B$O$=$N(B message $B$rE>Aw$9$k$3$H$,$G$-$J$$$+(B $B$i$G$"$k!#$A$J$_$K!"(B<dref>RFC 821</dref> $B$O#19T$O2~9TJ8;z$r=|$$$F(B 998 byte $B0JFb$G$"$k$3$H$r5a$a$F$$$k!#$h$C$F!"$3$l0J>e$N9T$,4^$^$l$k2DG=@-(B $B$N$"$k(B data, $BNc$($P!"(BPostscript $B$N(B data $B$J$I$O(B Quoted-Printable $BEy$G(B encode$B$9$kI,MQ$,$"$k!#(B <p> $B$^$?!"$3$&$7$?M}M3$+$i!"#19T$,(B 999 byte $B0J>e$N9T$,B8:_$9$k2DG=@-$N$"$k(B data $B$O(B <a node="binary"><concept>binary</concept></a> $B$H8F$V$3$H$K$9(B $B$k!#(B <p> $B$A$J$_$K!"(B7bit $B$GI=8=$G$-$k(B data $B$O(B 8bit $B$G$bI=8=$G$-$k!#$h$C$F!"(B ``8bit'' $B$H8@$C$?>l9g!"#19T$,(B 998 byte $B0J2<$NG$0U$N(B data $B$r;X$9$3$H$,(B $B$"$k!#(B <h3> ASCII <node> ASCII <p> $B%"%a%j%+O"K.$G;H$o$l$kJ8;z$rId9f2=$7$?(B<dref>$BId9f2=J8;z=89g(B</dref>$B!#(B A-Z, a-z $B$N(B Latin $BJ8;z$H?t;z!"4v$D$+$N5-9f$+$i$J$k!#(BISO 646 $B$N0l$D$G!"(B $B8=:_$O9q:]4p=`HG(B (IRV) $B$K$J$C$F$$$k!#(B <standard abbrev="ASCII" title-en="Coded Character Set -- 7-Bit American Standard Code for Information Interchange" number="ANSI X3.4" year="1986"> <h3> Base64 <node> Base64 <p> <dref>RFC 2045</dref> $B$GDj5A$5$l$F$$$k(B <dref>MIME</dref> $B$K$*$1$k(B <a node="binary">binary data</a> $B$N(B network $B$G$NJQ49K!$N#1$D!#(B <p> $B!X(B64 $B?J?t!Y$H$$$&0UL#$G!"(B3 byte $B$N(B data $B$r(B 0 $B$+$i(B 63 $B$N?t$rI=$9(B <dref>ASCII</dref> 4 $BJ8;z$KJQ49$9$kJ}K!!#!J$b$7!"(B4 $BJ8;z$K$J$i$J$1$l$P(B <concept>pad</concept> $B$H8F$P$l$k5M$aJ*$r$7$FD9$5$rD4@0$9$k!K(B <p> $B$3$N(B 65 $B<oN`$NJ8;z$O(B ASCII $B$H(B EBCDIC $B$N6&DLItJ,$+$iA*$P$l$F$*$j!"(B Internet $B0J30$N(B network $B$r7PM3$9$k>l9g$G$b0BA4$KE>Aw$G$-$k$h$&$K@_7W$5(B $B$l$F$$$k!#(B <h3> binary <node> binary <p> $BG$0U$N(B byte $BNs$r(B <concept>binary</concept> $B$H8F$V!#(B <p> <dref>8bit</dref> $B$H0[$J$k$N$O(B data $B$K9T$N9=B$$r2>Dj$7$J$$$3$H$G$"$k!#(B <p> $B$^$?!"9T$N9=B$$,$"$C$F$b!"(B999 byte $B0J>e$+$i$J$k9T$,$"$k>l9g$b(B binary $B$H8F$V$3$H$K$9$k!#(B <p> $B$A$J$_$K!"(B<dref>7bit</dref> $B$d(B 8bit $B$GI=8=$G$-$k(B data $B$O(B binary $B$G$bI=(B $B8=$G$-$k!#$h$C$F!"(B<concept>binary data</concept> $B$H8@$C$?>l9g!"G$0U$N(B data $B$r;X$9$3$H$,$"$k!#(B <h3> Coded character set$B!JId9f2=J8;z=89g!K(B, Character code$B!JJ8;zId9f!K(B <node> Coded character set <p> $BJ8;z$H(B byte $BNs$H#1BP#1$KBP1~IU$1$k[#Kf$G$J$$5,B'$N=89g!#(B <h3> media-type <node> media-type <p> <dref>MIME</dref> $B$K$*$1$k(B <dref>entity</dref> $B$N<oN`!#(B <concept>primary-type</concept> $B$H(B <concept>subtype</concept> $B$+$i$J$k!#(B <dref>RFC 2046</dref> $B$GDj5A$5$l$F$$$k!#(B <p> primary-type $B$OI8=`$G$O(B <ul> <li><concept>text</concept> </li> <li><concept>image</concept> </li> <li><concept>audio</concept> </li> <li><concept>video</concept> </li> <li><concept>application</concept> </li> <li><a node="multipart"><concept>multipart</concept></a> </li> <li><concept>message</concept> </ul> <noindent> $B$,Dj5A$5$l!"$=$l$>$l$K$O(B application/octet-stream, audio/basic, image/jpeg, <dref>multipart/mixed</dref>, <dref>text/plain</dref>, video/mpeg $B$J$I$N$5$^$6$^$J(B subtype $B$,Dj5A$5$l$F$$$k!#(B <memo title="$BCm0U(B"> <p> $B$3$3$G$O!"(Btext/plain $B$J$I$N(B type/subtype $B$NAH$r$7$P$7$P(B <concept>primary-type/subtype</concept> $B$H=q$/!#(B </memo> <p> media-type $B$O!"(BRFC 2046 $B$GDj5A$5$l$F$$$k$b$N$K2C$($F!"EPO?$9$k$3$H$b$G(B $B$-$k!#8=:_!"EPO?$5$l$F$$$k$b$N$O(B <a href="ftp://ftp.isi.edu/in-notes/iana/assignments/media-types">MEDIA TYPES</a> $B$G;2>H$G$-$k!#(B <p> $B$^$?!"(Btype $B$b$7$/$O(B subtype $B$K!"A0$K(B `x-' $B$rIU$1$?(B <concept>x-token</concept> $B$rMQ$$$k$3$H$K$h$j!"EPO?$5$l$F$$$J$$$b$N$r(B $B;dE*$KMQ$$$k$3$H$b$G$-$k!#$7$+$7!"EvA3$N$3$H$J$,$i!"$3$&$7$?;dE*$J(B media-type $B$ONJ2r$rF@$?<T$N4V$G$7$+2r<a$G$-$J$$$N$GMxMQ$K$OCm0U$9$k$3(B $B$H!#(B <p> <cf node="Content-Type"> <h3> message <node> message <p> $B$3$3$G$O(B mail $B$H(B news $B5-;v$NAm>N$H$7$FMQ$$$k!#(B <h3> MIME <node> MIME <p> <concept>Multipurpose Internet Mail Extensions</concept> $B$NN,$G!"(B Internet $B$N(B mail $B$d(B news $B$G(B <a node="us-ascii">us-ascii plain text</a> $B0J30$NJ8;z$r;H$&$?$a$N(B <dref>RFC 822</dref> $B$KBP$9$k3HD%!#(B <p> RFC 2045 $B$OKAF,$G<!$N$h$&$K=R$Y$F$$$k!'(B <p> STD 11, RFC 822 $B$O!"(BUS-ASCII message header $B$K4X$7$FHs>o$K>\:Y$K5,Dj$7(B $B$?(B message $BI=8=(B protocol $B$rDj5A$7$F$$$k!#$7$+$7!"$=$l$OC1$K(B flat $B$J(B US-ASCII text $B$N$_$KN1$^$j!"(Bmessage $B$NFbMF$d(B message body $B$K4X$9$k5,Dj(B $B$O$J$5$l$F$$$J$$!#(BMultipurpose Internet Mail Extensions, $B$"$k$$$O(B MIME $B$HAm>N$5$l$k!"$3$N0lO"$NJ8=q$O!"0J2<$N;v$r2DG=$H$9$k$?$a$K(B message $B$N(B $B7A<0$r:FDj5A$7$?!'(B <ol> <li>$BJ8=q(B message body $B$K$*$1$k(B US-ASCII $B0J30$NJ8;z=89g(B </li> <li>$BHsJ8=q(B message body </li> <li>$BJ#?t$NItJ,$+$i$J$k(B message body </li> <li>US-ASCII $B0J30$NJ8;z=89g$+$i$J$kJ8=q(B header $B>pJs(B </ol> <p> <dref>RFC 2045</dref>, <dref>RFC 2046</dref>, <a node="encoded-word">RFC 2047</a>, <dref>RFC 2048</dref>, <dref>RFC 2049</dref> $B$GDj5A$5$l$F$$$k!#(B <h3> MIME charset <node> MIME charset <p> <dref>Content-Type</dref> $BMs$d(B <dref>encoded-word</dref> $B$N(B charset parameter $B$GMQ$$$i$l$kEPO?$5$l$?(B<a node="Coded character set">$BId9f2=J8(B $B;z=89g(B</a>$B!#(B <p> <dref>RFC 2045</dref> $B$GDj5A$5$l$F$$$k!#(B <p> iso-2022-jp $B$d(B euc-kr $B$O$=$N#1$D!#(B <h3> MTA <node> MTA <p> <concept>Message Transfer Agent</concept> $B$NN,$G!"(Bqmail $B$d(B sendmail $B$J(B $B$I$N(B mail $BG[Aw(B program $B$H(B inn $B$J$I$N(B news server $B$NAm>N!#(B <p> <cf node="MUA"> <h3> MUA <node> MUA <p> <concept>Message User Agent</concept> $B$NN,$G!"(Bmail reader $B$H(B news reader $B$NAm>N!#(B <p> <cf node="MTA"> <h3> Quoted-Printable <node> Quoted-Printable <p> <dref>RFC 2045</dref> $B$GDj5A$5$l$F$$$k(B <dref>MIME</dref> $B$K$*$1$k(B <dref>binary data</dref> $B$N(B network $B$G$NJQ49K!$N#1$D!#(B <p> `=' $B$d@)8fJ8;z$d(B 128 $B0J>e$NJ8;z$J$I$O(B `=AF' $B$N$h$&$K(B `=' $B$N8e$KB3$/(B 16 $B?J?t$GI=8=$9$k!#$3$N$?$a!"(B<dref>ASCII</dref> $BJ8;zCf?4$N(B data $B$G$O(B <dref>Base64</dref> $B$KHf$Y$k$H2DFI@-$,9b$/$J$k2DG=@-$,$"$k!#(B <p> $B$7$+$7$J$,$i!"(BEBCDIC $B$K$OB8:_$7$J$$J8;z$rMxMQ$9$k>l9g!"(BEBCDIC $B$rMxMQ$7(B $B$F$$$k(B network $B$G$O0BA4$KE>Aw$9$k$3$H$,$G$-$:!"(BBase64 $B$KHf$Y$F0BA4@-$O(B $BDc$$!#(B <h3> RFC 822 <node> RFC 822 <p> Internet mail $B$N<g$K(B <concept>message header</concept> $B$K4X$9$k7A<0$K(B $B4X$9$kI8=`$rDj$a$F$$$k(B RFC. <memo> <p> news message $B$b$3$l$K=`$8$F$$$k$N$G!"(B<concept>Internet mail</concept> $B$H=q$/$h$j$b!"(B<concept>Internet message</concept> $B$H=q$$$?J}$,NI$$$+$b(B $B$7$l$J$$!#(B </memo> <rfc number="822" type="STD 11" author="D. Crocker" title="Standard for the Format of ARPA Internet Text Messages" date="August 1982"> <h3> RFC 1036 <node> RFC 1036 <p> USENET $B$G$N(B message $B$N7A<0$rDj$a$?(B RFC. <dref>RFC 822</dref> $B$N(B subset $B$K$J$C$F$$$k!#(BInternet $B$NI8=`$G$O$J$$$,!"(BUSENET $B0J30$N(B netnews $B$G$b$3$l$K=`$8$F$$$k$b$N$,B?$$!#(B <rfc name="USENET" number="1036" author="M. Horton and R. Adams" title="Standard for Interchange of USENET Messages" date="December 1987" obsolete="850"> <h3> RFC 2045 <node> RFC 2045 <p> <rfc number="2045" type="Standards Track" author="N. Freed and N. Borenstein" title="Multipurpose Internet Mail Extensions (MIME) Part One: Format of Internet Message Bodies" date="November 1996" obsolete="1521, 1522, 1590"> <h3> RFC 2046 <node> RFC 2046 <p> <rfc number="2046" type="Standards Track" author="N. Freed and N. Borenstein" title="Multipurpose Internet Mail Extensions (MIME) Part Two: Media Types" date="November 1996" obsolete="1521, 1522, 1590"> <h3> RFC 2048 <node> RFC 2048 <p> <rfc number="2048" type="Standards Track" author="N. Freed, J. Klensin and J. Postel" title="Multipurpose Internet Mail Extensions (MIME) Part Four: Registration Procedures" date="November 1996" obsolete="1521, 1522, 1590"> <h3> RFC 2049 <node> RFC 2049 <p> <rfc number="2049" type="Standards Track" author="N. Freed and N. Borenstein" title="Multipurpose Internet Mail Extensions (MIME) Part Five: Conformance Criteria and Examples" date="November 1996" obsolete="1521, 1522, 1590"> <h3> plain text <node> plain text <p> $B=qBN$dAHHG$K4X$9$k>pJs$r;}$?$J$$(B<a node="Coded character set">$BJ8;zId9f(B </a>$B$N$_$GI=8=$5$l$k(B text $B>pJs!#(B<cf node="text/plain"> <h3> us-ascii <node> us-ascii <p> $B%"%a%j%+O"K.$J$I$G;H$o$l$k1Q8l$J$I$rI=8=$9$k$?$a$N(B <dref>MIME charset</dref> $B$N#1$D!#(B <p> <dref>ASCII</dref> $B$N$_$+$i$J$j(B ISO 2022 $B$K$h$kId9f3HD%$O5v$5$l$J$$!#(B <p> Internet message $B$K$*$1$kI8=`$N(B<a node="Coded character set">$BId9f2=J8(B $B;z=89g(B</a>$B$G$"$j!"L@<(E*$K(B MIME charset $B$,<($5$l$J$$>l9g$O86B'$H$7$F(B <concept>us-ascii</concept> $B$,;H$o$l$k!#(B <p> $B$^$?!"(B<dref>RFC 822</dref> $B$K$*$1$k(B <concept>ASCII</concept> $B$O(B us-ascii $B$G$"$k!#(B <h2> bug $BJs9p$N;EJ}(B <node> Bug report <p> FLIM $B$N%P%0$r8+$D$1$?$i!"0J2<$N(B address $B$K(B mail $B$rAw$C$F$/$@$5$$!'(B <ul> <li> $B1Q8l(B <mail>emacs-mime-en@m17n.org</mail> <li> $BF|K\8l(B <mail>emacs-mime-ja@m17n.org</mail> </ul> <p> $BC"$7!"$"$^$j$K$b8E$$HG$K4X$9$kJs9p$O4?7^$5$l$^$;$s!#8E$$HG$N(B bug $B$O!"(B $B?7$7$$HG$G$O<#$C$F$$$k$+$b$7$l$^$;$s!#$^$:!":G?7HG$G3NG'$7$F$_$^$7$g$&!#(B <p> $B$=$l$+$i!"E,@Z$JJs9p$r$7$^$7$g$&!#C1$K!V$&$^$/F0$+$J$$!W$H8@$o$l$F$b$I(B $B$&$$$&>u67$J$N$+$O$5$C$Q$jH=$j$^$;$s!#:GDc8B!"(BOS, emacs, APEL, FLIM, SEMI, $B;H$C$F$$$k(B MUA $B$N<oN`$*$h$SHG!"@_Dj$r=q$/I,MW$,$"$j$^$9!#$^$?!"(B error $B$,5/$C$F$$$k>l9g$O(B backtrace $B$rAw$k$3$H$b=EMW$G$9!#(B<cf file="emacs" node="Bugs"> <p> $B$^$?!"(Bbug $B$OBgDqJ#?t$N?M$,Ax6x$9$k$b$N$G$9!J$=$&$G$J$1$l$P!"(Bbug $B$G$O$J(B $B$$2DG=@-$,$"$j$^$9!K!#$@$+$i!":n<T$KD>@\(B mail $B$rAw$k$H:n<T$OF1$8(B mail $B$r2?DL$b=q$/1)L\$K$J$j$^$9!#$@$+$i!"I,$:(B bug $BJs9p$O>e5-$N(B address $B$KAw$C(B $B$F$/$@$5$$!#(B <p> EMACS-MIME ML $B$G$O(B FLIM $B$N%P%0>pJs$N8r49$d:G?7HG$NG[I[!"(BFLIM $B$N2~NI$K(B $B4X$9$k5DO@$r9T$J$C$F$$$^$9!#(BEMACS-MIME ML $B$K;22C$7$?$$J}$O(B <ul> <li> $B1Q8l(B <mail>emacs-mime-en-ctl@m17n.org</mail> <li> $BF|K\8l(B <mail>emacs-mime-ja-ctl@m17n.org</mail> </ul> <noindent> $B$K6u$N(B mail $B$rAw$C$F2<$5$$!#(B <h2> CVS $B$K$h$k3+H/(B <node> CVS <p> FLIM $B$N(B file $B$O(B CVS $B$r;H$C$F4IM}$5$l$F$$$^$9!#$3$N$?$a!"0J2<$NJ}K!$G:G(B $B?7$N(B FLIM $B$rF~<j$9$k$3$H$,$G$-$^$9!'(B <verb> (0) cvs login % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root login CVS password: [CR] # NULL string (1) checkout % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root \ checkout [-r TAG] flim </verb> <p> CVS $B$rMQ$$$?3+H/$K;22C$7$?$$J}$O(B <ul> <li> <mail>cvs@cvs.m17n.org</mail> </ul> <noindent> $B$^$G!"%"%+%&%s%HL>$H(B ssh $B$N8x3+80$rAw$C$F$/$@$5$$!#(Bssh $B7PM3$G$O!"(B cvsroot $B$O(B :ext:cvs@cvs.m17n.org:/cvs/root $B$H$J$j$^$9!#(B <h2> $BNr;K(B <node> History <p> FLIM $B$N(B code $B$N:G8E$NItJ,$O(B $B1]JB(B $B;LCR(B $B;a$,=q$$$?(B <file>mime.el</file> $B$K5/8;$7$^$9!#$3$N>.$5$J(B program $B$O(B Nemacs $B$GF0:n$9$k(B iso-2022-jp $B$N(B B-encoding $B@lMQ$N(B encoded-word $B$NI|9f2=%W%m%0%i%`$G$7$?!#(B <p> $B$=$N8e!"<i2,(B $BCNI'(B $B$O(B <file>mime.el</file> $B$r85$K(B <file>tiny-mime.el</file> $B$H$$$&%W%m%0%i%`$r=q$-$^$9!#$3$l$O!"(BNemacs $B$H(B Mule $B$GF0:n$9$k(B encoded-word $B$NId9f2=!&I|9f2=%W%m%0%i%`$G$7$?!#(B <file>tiny-mime.el</file> $B$O(B B-encoding $B$@$1$G$J$/(B Q-encoding $B$b(B support $B$7!"$^$?!"(BMULE $B$G07$&$3$H$,$G$-$k$5$^$6$^$J(B <dref>MIME charset</dref> $B$rF1;~$K;H$&$3$H$,$G$-$^$7$?!#$3$N;~!"(BNemacs $B$H(B Mule $B$N(B $BAPJ}$r(B support $B$9$k$?$a$KMQ$$$i$l$?%F%/%K%C%/$O8e$K(B emu package $B$K$^$H(B $B$a$i$l$^$9!#(B <p> $B$3$N:"!"<i2,(B $BCNI'(B $B$O(B <file>tiny-mime.el</file> $B$r$5$^$6$^$J(B MUA $B$G;H$&(B $B$?$a$N@_Dj=8$bG[I[$7$F$$$^$7$?$,!"$=$l$i$O8e$K(B <file>tiny-mime.el</file> $B$H$H$b$K#1$D$N(B package $B$K$^$H$a$i$l!"(Btm $B$H$$(B $B$&L>A0$GG[I[$5$l$^$9!#(B <p> $B<i2,(B $BCNI'(B $B$O$d$,$F!"(BMIME message $B$r1\Mw$9$k$?$a$N%W%m%0%i%`$G$"$k(B <file>tm-body.el</file> $B$r=q$-$^$9!#$3$l$O!"$9$0$K(B <file>tm-view.el</file> $B$H$$$&L>A0$KJQ$o$j$^$7$?$,!"$d$,$F!"$3$l$,(B <file>tiny-mime.el</file> $B$KBe$o$C$F!"(Btm $B$NCf3K$H$J$j$^$9!#(B <p> <file>tm-view.el</file> $B$OEvA3!"(BContent-Transfer-Encoding $B$r07$&I,MW$,(B $B$"$j$^$9!#$3$NL\E*$N$?$a$K!"(BMEL $B$,@0Hw$5$l$O$8$a$^$7$?!#(BBase64 $B$K4X$7(B $B$F$O(B <file>tiny-mime.el</file> $B$N(B code $B$,0\$5$l!"$^$?!"?7$?$K(B Quoted-Printable $B$N(B code $B$,DI2C$5$l$^$7$?!#$3$l$i$,(B <file>mel-b.el</file> $B$H(B <file>mel-q.el</file> $B$K$J$j$^$7$?!#(B <p> $B$^$?!"8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B uuencode $BMQ$N(B <file>mel-u.el</file> $B$,(B $BDI2C$5$l!"$=$N8e$K!">.NS(B $B=$J?(B $B;a$K$h$C$F(B x-gzip64 $BMQ$N(B <file>mel-g.el</file> $B$,DI2C$5$l$^$7$?!#(B <p> tm $B$G$O8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B <file>tiny-mime.el</file> $B$N:F<BAu$,9T(B $B$o$l!"$3$N2aDx$G!"(BSTD 11 $B$N(B parser $B$,=q$+$l$^$7$?!#$3$l$O!"8=:_$N(B <file>std11.el</file> $B$KEv$?$j$^$9!#$^$?!"$3$N2aDx$G(B <file>tiny-mime.el</file> $B$OI|9f2=$r9T$&(B <file>tm-ew-d.el</file> $B$HId(B $B9f2=$r9T$&(B <file>tm-ew-e.el</file> $B$KJ,$1$i$l$^$7$?!#$3$NN><T$,8=:_$N(B <file>eword-decode.el</file> $B$H(B <file>eword-encode.el</file> $B$N@hAD$K(B $BEv$?$j$^$9!#(B <p> $B8e$K!"<i2,(B $BCNI'(B $B$i$K$h$C$F(B tm $B$NA4LL=q$-49$(:n6H$,9T$o$l!"$3$N2aDx$G!"(B tm $B$O(B APEL, MEL, SEMI, EMH, RMAIL-MIME, Gnus-MIME $B$J$I$KJ,$1$i$l$^$7$?!#(B $B$3$N$&$A$N(B MEL $B$,(B FLIM $B$ND>@\$N@hAD$KEv$?$j$^$9!#(B <p> $B8e$K!"(BAPEL $B$+$i(B <file>std11.el</file> $B$,0\$5$l!"$^$?!"(B <file>mailcap.el</file>, <file>eword-decode.el</file> $B$*$h$S(B <file>eword-encode.el</file> $B$,(B SEMI $B$+$i0\$5$l!"(Bpackage $B$NL>A0$,(B FLIM $B$H$J$j$^$9!#(B <p> $B$3$ND>A0$+$iEDCf(B $BE/(B $B;a$,$h$j(B RFC $B$KCi<B$J<BAu$r=q$-;O$a!"$3$l$O!"8=:_!"(B FLIM $B$N;^$G$"$k(B ``FLIM-FLAM'' $B$H$J$C$F$$$^$9!#(B <h1> $B35G0:w0z(B <node> Concept Index <cindex> <h1> $B4X?t:w0z(B <node> Function Index <findex> <h1> $BJQ?t:w0z(B <node> Variable Index <vindex> </body> �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/mime-ja.texi���������������������������������������������������������������������������0000664�0000000�0000000�00000142550�11747036124�0015373�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������\input texinfo.tex @c Generated automatically from mime-ja.sgml by sinfo 3.7. @setfilename mime-ja.info @settitle{FLIM 1.14 MIME $B5!G=@bL@=q(B} @titlepage @title FLIM 1.14 MIME $B5!G=@bL@=q(B @author $B<i2,(B $BCNI'(B <morioka@@jaist.ac.jp> @subtitle 1999-01-27 @end titlepage @node Top, Introduction, (dir), (dir) @top FLIM 1.14 MIME $B5!G=@bL@=q(B @ifinfo This file documents MIME features of FLIM, a fundamental library to process Internet Messages for GNU Emacsen.@refill GNU Emacsen $BMQ$N(B Internet Message $B=hM}$N$?$a$N4pAC(B library $B$G$"$k(B FLIM $B$N(B MIME $B5!G=$K4X$7$F@bL@$7$^$9!#(B @end ifinfo @menu * Introduction:: FLIM $B$C$F2?!)(B * How to use:: FLIM $B$N(B MIME $B5!G=$N;H$$J}(B * Entity:: Message $B$H(B Entity * Content-Type:: Content-Type $BMs$N>pJs(B * Content-Disposition:: Content-Disposition $BMs$N>pJs(B * Content-Transfer-Encoding:: $BId9f2=K!(B * encoded-word:: Header $B$N(B network $BI=8=(B * custom:: $B0lHL@_Dj(B * Appendix:: $BIUO?(B * Concept Index:: $B35G0:w0z(B * Function Index:: $B4X?t:w0z(B * Variable Index:: $BJQ?t:w0z(B @end menu @node Introduction, How to use, Top, Top @chapter FLIM $B$C$F2?!)(B FLIM $B$O(B Internet Message $B$NI=8=$dId9f2=$K4X$9$k4pACE*$J5!G=$rDs6!$9$k(B $B$?$a$N(B library $B$G$9!#(B @node How to use, Entity, Introduction, Top @chapter FLIM $B$N(B MIME $B5!G=$N;H$$J}(B FLIM $B$NDs6!$9$k(B MIME $B5!G=$r;H$&$?$a$K$O(B @lisp (require 'mime) @end lisp @noindent $B$rI>2A$7$F$/$@$5$$!#(B @node Entity, Content-Type, How to use, Top @chapter Message $B$H(B Entity @cindex mime-entity @cindex entity RFC 2045 (@ref{RFC 2045}) $B$K$h$l$P!"!V(BEntity $B$H$$$&8l$O!"(Bmessage, $B$b$7$/(B $B$O!"(Bmultipart entity $B$N(B body $BCf$N#1$D$NItJ,$N!"(BMIME $B$GDj5A$5$l$?(B header field $B$HFbMF$r;X$9!W$H$J$C$F$$$^$9!#$3$3$G$O!"(BMIME $B$GDj5A$5$l$?(B header field $B0J30$NA4$F$N(B header $B$H(B body $B$r;X$98l$H$7$F(B @strong{entity}$B$rMQ$$$k(B $B$3$H$K$7$^$9!#(B@refill RFC 2045 $B$NDj5A$O!"(BMIME message $B$,(B entity $B$r@a$H$9$kLZ9=B$$G$"$k$3$H$r<((B $B$7$F$$$^$9!#$D$^$j!"(BMIME $B$O(B message $B$rLZ9=B$$K3HD%$7$?Lu$G$9!#(B@refill FLIM $B$O(B entity $B$N>pJs$rI=8=$9$k$?$a$K(B@strong{mime-entity} $B9=(B $BB$BN$rMQ$$$^$9!#0J2<$G$OC1$K(B mime-entity $B$H8F$V$3$H$K$7$^$9!#(B @menu * Entity creation:: Entity $B$N@8@.(B * Entity hierarchy:: Entity $B3,AX(B * Entity Search:: Entity $B$N8!:w(B * Entity Attributes:: Entity $B$NB0@-(B * Entity-header:: Entity header $B$N>pJs(B * entity formatting:: Entity $B$NJ8;zI=8=(B * Entity-content:: Entity $B$NFbMF(B * Entity-network-representation:: Entity $B$N%M%C%H%o!<%/I=8=(B * Entity buffer:: Entity $B$N(B buffer $B$K$h$kI=8=(B * mm-backend:: Entity $B$NI=8=$H<B8=(B @end menu @node Entity creation, Entity hierarchy, Entity, Entity @section Entity $B$N@8@.(B @defun mime-open-entity type location Entity $B$r3+$$$F!"$=$l$rJV$7$^$9!#(B@refill @var{type} $B$O(B representation-type $B$G$9!#(B(cf. @ref{mm-backend}) @refill @var{location} $B$O(B entity $B$N0LCV$G$9!#;XDjJ}K!$O(B representation-type $B$K0M$C$FJQ$o$j$^$9!#(B @end defun @defun mime-parse-buffer &optional buffer type @var{buffer} $B$r(B message $B$H$7$F9=J82r@O$7!"$=$N7k2L$N(B mime-entity $B$r(B @var{buffer} $B$N(B@code{mime-message-structure} $B$K3JG<$9$k!#(B@refill @var{buffer} $B$,>JN,$5$l$?>l9g!"8=:_$N(B buffer $B$r9=J82r@O$9$k!#(B@refill @var{type} $B$,;XDj$5$l$?>l9g!"$=$NCM$r@8@.$5$l$k(B mime-entity $B$NI=>]7?$H$7(B $B$FMQ$$$k!#>JN,$5$l$?>l9g$O(B @var{buffer} $B$H$J$k!#(B(cf. @ref{mm-backend}) @end defun @node Entity hierarchy, Entity Search, Entity creation, Entity @section Entity $B3,AX(B @cindex node-id @cindex entity-number @cindex message @cindex root-entity MIME message $B$O(B entity $B$rC10L$H$9$kLZ9=B$$K$J$C$F$$$^$9!#(B@refill $B$3$NLZ$K$*$$$F:,$H$J$k@a$O(B message $BA4BN$rI=$9(B entity $B$G$9!#$3$3$G$O!"$3(B $B$l$r(B @strong{root-entity} $B$b$7$/$O(B@strong{message} $B$H8F$S$^$9!#(B@refill root-entity $B0J30$N(B entity $B$O?F$r;}$A$^$9!#$^$?!"(Bentity $B$O;R6!$r;}$D$+$b(B $BCN$l$^$;$s!#$3$N?F;R4X78$r9M$($k$3$H$G(B entity $B$NAjBP4X78$r07$&$3$H$,$G$-(B $B$^$9!#(B@refill $B0lJ}!"(Bentity $B$N(B message $B$K$*$1$k0LCV$r9M$($k$3$H$b$G$-$^$9!#(B@refill entity $B$O$3$NLZ$K$*$1$k@a$H$J$j$^$9$,!"$3$NLZ$K$O?<$5$HF1$8?<$5$NCf$N(B $B=gHV$K=>$C$FHV9f$,IU$1$k$3$H$,$G$-$^$9!#B($A!"(B @example $B(#(!(!(!($(B $B("(B nil $B("(B $B(&(!(((!(%(B $B(#(!(!(!(!(!(!(!(!(!(+(!(!(!(!(!(!(!(!(!($(B $B(#(*($(B $B(#(*($(B $B(#(*($(B $B("#0("(B $B("#1("(B $B("#2("(B $B(&(((%(B $B(&(((%(B $B(&(((%(B $B("(B $B(#(!(!(!(!(+(!(!(!(!($(B $B("(B $B(#(!(*(!($(#(!(*(!($(#(!(*(!($(#(!(*(!($(#(!(*(!($(B $B("(B $B#0(B.$B#0("("(B $B#1(B.$B#0("("(B $B#1(B.$B#1("("(B $B#1(B.$B#2("("(B $B#2(B.$B#0("(B $B(&(!(!(!(%(&(!(!(!(%(&(!(!(!(%(&(!(!(!(%(&(!(!(!(%(B @end example @noindent $B$N$h$&$K?<$5(B n $B$N@a$K$OD9$5(B n $B$N@0?tNs$N@aHV9f$,?6$l$^$9!#$3$l(B $B$r(B @strong{entity-number} $B$H8F$S$^$9!#(Bentity-number $B$O(B S $B<0$H(B $B$7$F$O(B @code{(1 2 3)} $B$N$h$&$J@0?t$N%j%9%H$H$7$FI=8=$5$l$^$9!#(B mime-entity $B$G$O!"$3$l$HF1MM$N(B @strong{node-id} $B$rMQ$$$^$9!#(Bnode-id $B$O$A$g(B $B$&$I(B entity-number $B$r5U$K$7$?%j%9%H$G!"(Bentity-number 1.2.3 $B$KBP1~$9$k(B node-id $B$O(B @code{(3 2 1)} $B$G$9!#(B@refill $BA0=R$N$h$&$K!"(BMIME message $B$O(B entity $B$rC10L$H$7$?LZ9=B$$K$J$C$F$$$k$N$G!"(B $B$3$N:,$G$"$k(B message $BA4BN$b(B mime-entity $B$GI=8=$9$k$3$H$,$G$-!"(Bbuffer local $BJQ?t(B @code{mime-message-structure} $B$K3JG<$9$k$3$H$K$7$^$9!#(B@refill @code{mime-message-structure} $B$r5/E@$K(B entity-number $B$d(B node-id $B$G<($5$l$k(B entity $B$r<h$j=P$9$3$H$,$G$-$^$9!#(B @defvar mime-message-structure $B8=:_$N(B buffer $B$K$*$1$k(B message $BA4BN$N(B mime-entity $B9=B$BN$r3JG<$9$k(Bbuffer local $BJQ?t!#(B @end defvar @defun mime-entity-children entity @var{entity} $B$K4^$^$l$k(B entity $B$N(B list $B$rJV$9!#(B @end defun @defun mime-entity-parent entity &optional message @var{entity} $B$N?F$N(B entity $B$rJV$9!#(B@refill @var{message} $B$,;XDj$5$l$?>l9g!"$3$l$r:,$H8+Jo$9!#(B @end defun @defun mime-root-entity-p entity @var{entity} $B$,:,!JB($A!"(Bmessage $BA4BN!K$G$"$k>l9g$K!"Hs(B-@code{nil} $B$rJV(B $B$9!#(B @end defun @defun mime-entity-node-id entity @var{entity} $B$N(B node-id $B$rJV$9!#(B @end defun @defun mime-entity-number entity @var{entity} $B$N(B entity-number $B$rJV$9!#(B @end defun @node Entity Search, Entity Attributes, Entity hierarchy, Entity @section Entity $B$N8!:w(B @defun mime-find-entity-from-number entity-number &optional message @var{message} $B$+$i!"(B@var{enity-number} $B$N(B entity $B$rJV$7$^$9!#(B@refill @var{message} $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B @code{mime-message-structrue} $B$,;H$o$l$^$9!#(B @end defun @defun mime-find-entity-from-node-id entity-node-id &optional message @var{message} $B$+$i!"(B@var{entity-node-id} $B$N(B entity $B$rJV$7$^$9!#(B@refill @var{message} $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B @code{mime-message-structure} $B$,;H$o$l$^$9!#(B @end defun @defun mime-find-entity-from-content-id cid &optional message @var{message} $B$+$i!"(B@var{cid} $B$N(B entity $B$rJV$7$^$9!#(B@refill @var{message} $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B @code{mime-message-structure} $B$,;H$o$l$^$9!#(B @end defun @node Entity Attributes, Entity-header, Entity Search, Entity @section Entity $B$NB0@-(B @defun mime-entity-content-type entity @var{entity} $B$N(B content-type $B$rJV$9!#(B(cf. @ref{mime-content-type}) @end defun @defun mime-entity-content-disposition entity @var{entity} $B$N(B content-disposition $B$rJV$9!#(B (cf. @ref{mime-content-disposition}) @end defun @defun mime-entity-filename entity @var{entity} $B$N(B file $BL>$rJV$9!#(B @end defun @defun mime-entity-encoding entity &optional default-encoding @var{entity} $B$N(B content-transfer-encoding $B$rJV$9!#(B (cf. @ref{Content-Transfer-Encoding}) @refill $B$b$7!"(B@var{entity} $B$K(B Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l9g$O!"(B @var{default-encoding} $B$rJV$9!#$3$l$,;XDj$5$l$J$$>l9g$O!"(B@code{"7bit"} $B$rMQ$$$k!#(B @end defun @defun mime-entity-cooked-p entity @var{entity} $B$NFbMF$,4{$K%3!<%IJQ49$5$l$F$$$k>l9g$O(B nil $B$GL5$$CM(B $B$rJV$9!#(B @end defun @node Entity-header, entity formatting, Entity Attributes, Entity @section Entity header $B$N>pJs(B @defun mime-fetch-field field-name &optional entity @var{entity} $B$N(B header $BCf$N(B @var{field-name} $BMs$N(B body $B$rJV$9!#(B@refill $B7k2L$NJ8;zNs$O(B network $BI=8=$N$^$^$G$"$k!#(B@refill @var{entity} $B$,>JN,$5$l$?>l9g$O!"(B@code{mime-message-structure} $B$NCM$rMQ(B $B$$$k!#(B@refill @var{field-name} $BMs$,B8:_$7$J$$>l9g$O(B @code{nil} $B$rJV$9!#(B @end defun @defun mime-read-field field-name &optional entity @var{entity} $B$N(B header $BCf$N(B @var{field-name} $BMs$r9=J82r@O$7$?7k2L$rJV$9!#(B @refill $B7k2L$N7A<0$OMsKh$K0[$J$k!#Hs9=B$2=Ms$N>l9g$OJ8;zNs$rJV$7!"9=B$2=Ms$N>l9g(B $B$O$=$N7A<0$K=>$C$?(B list $B$rJV$9!#(B@refill $B7k2LCf$NJ8;zNs$O(B Emacs $B$NFbItI=8=$KJQ49$5$l$k!#(B@refill @var{entity} $B$,>JN,$5$l$?>l9g$O!"(B@code{mime-message-structure} $B$NCM$rMQ(B $B$$$k!#(B@refill @var{field-name} $BMs$,B8:_$7$J$$>l9g$O(B nil $B$rJV$9!#(B @end defun @node entity formatting, Entity-content, Entity-header, Entity @section Entity $B$NJ8;zI=8=(B @defun mime-insert-header entity &optional invisible-fields visible-fields $B8=:_0LCV$K(B @var{entity} $B$NI|9f$7$?(B header $B$rA^F~$9$k!#(B@refill @var{invisible-fields} $B$H(B @var{visible-fields} $B$O@55,I=8=$N(Blist $B$G!"$=$l(B $B$>$l!"I=<($7$?$/$J$$(B field $BL>$HI=<($7$?$$MsL>$rI=8=$7$?$b$N$G$"$k!#(B @refill @var{invisible-fields} $B$NMWAG$N$I$l$+$K(B match $B$7!"$+$D!"(B @var{visible-fields} $B$NMWAG$N$I$l$K$b(B match $B$7$J$$Ms$OI=<($5$l$J$$!#(B @refill encoded-word (@ref{encoded-word}) $B$OI|9f$5$l$k!#!X@8$NHs(B us-ascii $BJ8;z!Y(B $B$O(B @code{default-mime-charset} $B$H$7$F2r<a$5$l$k!#(B @end defun @defun mime-insert-text-content entity point $B$NA0$K(B @var{entity} $B$r(B text entity $B$H$7$FA^F~$7$^$9!#(B@refill @var{entity} $B$NFbMF$O(B @ref{MIME charset} $B$H$7$FI|9f2=$5$l(B $B$^$9!#(B@var{entity} $B$N(B Content-Type field $B$K(B charset paramter $B$,L5(B $B$$$H!"(B@code{default-mime-charset} $B$,=i4|CM$H$7$F;H$o$l$^$9!#(B @end defun @defvar default-mime-charset $BE,@Z$J(B MIME charset (@ref{MIME charset}) $B$,8+$D$+$i$J$+$C$?>l9g$KMQ$$$i(B $B$l$k(BMIME charset.@refill $BK\Mh$O(B APEL $B$NJQ?t$G$"$k!#(B @end defvar @node Entity-content, Entity-network-representation, entity formatting, Entity @section Entity $B$NFbMF(B @defun mime-entity-content entity @var{entity} $B$NFbMF$N(B byte $BNs$rJV$9!#(B @end defun @defun mime-insert-entity-content entity point $B$N0LCV$K(B @var{entity} $B$NFbMF$rA^F~$7$^$9!#(B @end defun @defun mime-write-entity-content entity filename @var{entity} $B$NFbMF$r(B @var{filename} $B$K=q$-9~$_$^$9!#(B @end defun @node Entity-network-representation, Entity buffer, Entity-content, Entity @section Entity $B$N%M%C%H%o!<%/I=8=(B @defun mime-insert-entity entity @var{entity} $B$N(B header $B$H(B body $B$r(B point $B$N$H$3$m$KA^F~$7$^$9!#(B @end defun @defun mime-write-entity entity filename @var{entity} $B$NI=8=$r(B @var{filename} $B$K=q$-9~$_$^$9!#(B @end defun @defun mime-write-entity-body entity filename @var{entity} $B$N(B body $B$r(B @var{filename} $B$K=q$-9~$_$^$9!#(B @end defun @node Entity buffer, mm-backend, Entity-network-representation, Entity @section Entity $B$N(B buffer $B$K$h$kI=8=(B @defun mime-entity-buffer entity @var{entity} $B$,B8:_$9$k(B buffer $B$rJV$9!#(B @end defun @defun mime-entity-point-min entity @var{entity} $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(B@var{entity} $B$,@j$a$kNN0h$N@hF,(B $B0LCV$rJV$9!#(B @end defun @defun mime-entity-point-max entity @var{entity} $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(B@var{entity} $B$,@j$a$kNN0h$NKvHx(B $B0LCV$rJV$9!#(B @end defun @defun mime-entity-header-start entity @var{entity} $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(Bheader $B$,@j$a$kNN0h$N@hF,0LCV$r(B $BJV$9!#(B @end defun @defun mime-entity-header-end entity @var{entity} $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(Bheader $B$,@j$a$kNN0h$NKvHx0LCV$r(B $BJV$9!#(B @end defun @defun mime-entity-body-start entity @var{entity} $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(Bbody $B$,@j$a$kNN0h$N@hF,0LCV$rJV(B $B$9!#(B @end defun @defun mime-entity-body-end entity @var{entity} $B$,B8:_$9$k(B buffer $B$K$*$1$k!"(Bbody $B$,@j$a$kNN0h$NKvHx0LCV$rJV(B $B$9!#(B @end defun @node mm-backend, , Entity buffer, Entity @section Entity $B$NI=8=$H<B8=(B @cindex mm-backend @cindex entity $B=hM}(B method @cindex representation-type Entity $B$OCj>]2=$5$l$?%G!<%?I=8=$G!"<B:]$N%G!<%?I=8=$H$7$F$OMQES$K1~$8$F(B $B$5$^$6$^$J$b$N$,MxMQ$G$-$k$h$&$K@_7W$5$l$F$$$^$9!#(B@refill $B$3$3$G!"(Bentity $B$,$I$&$$$&<oN`$NI=8=$r9T$C$F$$$k$+$r<($9$N$,(B @strong{representation-type} $B$G!"(Bentity $B$r@8@.$9$k;~$K$O$3$l$r;XDj$7$^$9!#(B (cf. @ref{Entity Creation}) @refill $BA0@a$^$G$K=R$Y$FMh$?(B entity $B$KBP$9$k=hM}$O!"(Bentity $B$KBP$7$F$=$N=hM}$r0M(B $BMj$9$k$3$H$K$h$C$F<B8=$5$l$F$$$^$9!#(BEntity $B$O<+J,$N(B representation-type $B$rCN$C$F$*$j!"$=$N(B representation-type $B$K1~$8$F<B:]$N=hM}$r9T$&4X?t$r8F(B $B$S=P$7$^$9!#$3$N$h$&$J4X?t$r(B @strong{entity $B=hM}(Bmethod} $B$H8F$S$^$9!#$^$?!"(B representation-type $BKh$K$3$N$h$&$J4X?t$r$^$H$a$?$b$N$r(B @strong{mm-backend} $B$H8F$S$^$9!#(B@refill mm-backend $B$O(B representation-type $B$NL>A0$N@hF,$K(B @code{mm} $B$H$$$&(B $B@\F,<-$rIU$1$?4X?tL>$+$i$J$k(B module $B$G!"$=$N(B module $BL>$OF1MM$K(B representation-type $B$NL>A0$N@hF,$K(B @code{mm} $B$rIU$1$?$b$N$K$J$C$F(B $B$$$^$9!#$3$N(B module $B$O(B representation-type $B$N(B entity $B$,:G=i$K@8@.$5$l$k(B $B;~$K<+F0E*$K(B require $B$5$l$^$9!#(B @menu * Request for entity:: Entity $B$X$NJX$j(B * mm-backend module:: mm-backend $B$N:n$jJ}(B @end menu @node Request for entity, mm-backend module, mm-backend, mm-backend @subsection Entity $B$X$NJX$j(B @defun mime-entity-send entity message &rest args @var{entity} $B$K(B @var{message} $B$rAw$k!#(B@refill @var{args} $B$O(B @var{message} $B$N0z?t$G$"$k!#(B @end defun @node mm-backend module, , Request for entity, mm-backend @subsection mm-backend $B$N:n$jJ}(B @defmac mm-define-backend type &optional parents @var{type} $B$r(B mm-backend $B$H$7$FDj5A$7$^$9!#(B@refill @var{PARENTS} $B$,;XDj$5$l$F$$$k>l9g$O!"(B@var{type} $B$O(B prents $B$r7Q>5$7$^$9!#$=$l$>$l$N(B parent $B$O(B representation-type $B$G$"$kI,MW$,$"(B $B$j$^$9!#(B $BNc(B:@refill @lisp (mm-define-backend chao (generic)) @end lisp @end defmac @defmac mm-define-method name args &rest body @var{name} $B$r(B (nth 1 (car @var{args})) backend $B$N(B method $B4X(B $B?t$H$7$FDj5A$7$^$9!#(B@refill @var{args} $B$O(B lambda $B$N0z?t%j%9%H$N$h$&$J$b$N$G$9$,!"(B(car @var{args}) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car (car @var{args})) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car @var{args})) $B$O(B backend $B$NL>A0(B (representation-type) $B$G$9!#(B@refill $BNc(B:@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 $BMs$N>pJs(B @cindex mime-content-type @cindex Content-Type $BMs(B @strong{Content-Type $BMs(B} $B$O(B media-type (@ref{media-type}) $B$d(B MIME charset $B$H$$$C$?(B entity (@ref{entity}) $B$NFbMF$N<oN`$dI=8=7A<0$J$I$r5-=R(B $B$9$k$?$a$N$b$N$G!"(BRFC 2045 (@ref{RFC 2045}) $B$GDj5A$5$l$F$$$^$9!#(B @noindent @strong{[Memo]} @quotation $BNr;KE*$K$O(B RFC 1049 $B$G(B Content-Type $BMs$,Ds0F$5$l$F$$$k!#C"$7!"(BMIME $B$N(B media-type $B$N$h$&$J(B type $B$H(B subtype $B$N6hJL$O$J$/!"(BMIME charset $B$N$h$&$J(B $BJ8;zId9f$N<oN`$rI=8=$9$k$3$H$b$G$-$J$$!#(B @end quotation FLIM $B$O(B Content-Type $BMs$r9=J82r@O$9$k4X?t$H(B Content-Type $BMs$N2r@O7k2L$r(B $B3JG<$9$k9=B$BN(B @strong{mime-content-type} $B$rDs6!$7$^$9!#(B @menu * Content-Type field:: Content-Type $BMs$N7A<0(B * mime-content-type:: mime-content-type $B9=B$BN(B * Content-Type parser:: Content-Type $BMs$N2r@O4o(B * Content-Type utility:: Content-Type $B$K4X$9$kM-MQ$J4X?t(B @end menu @node Content-Type field, mime-content-type, Content-Type, Content-Type @section Content-Type $BMs$N7A<0(B @cindex parameter @cindex subtype @cindex type Content-Type $BMs$N7A<0$O0J2<$N$h$&$KDj5A$5$l$F$$$^$9!'(B @quotation ``Content-Type'' ``:'' @strong{type} ``/'' @strong{subtype} *( ``;'' @strong{parameter} ) @end quotation $BNc$($P!"(B @quotation @example Content-Type: image/jpeg @end example @end quotation @noindent $B$d(B @quotation @example Content-Type: text/plain; charset=iso-2022-jp @end example @end quotation @noindent $B$J$I$N$h$&$KMQ$$$i$l$^$9!#(B $B$3$3$G!"(B`type' $B$H(B `subtype' $B$O(B entity $B$N7A<0$r<($9$b$N$G!"N><T$rAm>N$7(B $B$F!"(B`media-type' $B$H8F$V$3$H$K$7$^$9!#>e5-$NNc$K$*$1$k(B `image/jpeg' $B$d(B `text/plain' $B$O(B media-type $B$N#1$D$G$9!#(B @noindent @strong{[Memo]} @quotation Content-Type $BMs$N$J$$(B entity $B$O(B @quotation @example Content-Type: text/plain; charset=us-ascii @end example @end quotation @noindent $B$H$7$F2r<a$5$l$k!#(B(cf. @ref{us-ascii}) @end quotation @node mime-content-type, Content-Type parser, Content-Type field, Content-Type @section mime-content-type $B9=B$BN(B @deffn{Structure} mime-content-type Content-Type $BMs$N>pJs$r3JG<$9$k$?$a$N9=B$BN!#(B@refill $B$3$N9=B$BN$r;2>H$9$k$K$O(B @code{mime-content-type-$BMWAGL>(B} $B$H$$$&L>A0$N;2(B $B>H4X?t$rMQ$$$k!#(B@refill $B$3$N9=B$BN$NMWAG$O0J2<$NDL$j$G$"$k!'(B @table @var @item primary-type media-type $B$N<g7?(B (symbol). @item subtype media-type $B$NI{7?(B (symbol). @item parameters Content-Type $BMs$N(B parameter ($BO"A[(B list). @end table @end deffn @defun make-mime-content-type type subtype &optional parameters content-type $B$N@8@.;R!#(B @end defun @defun mime-content-type-parameter content-type parameter @var{content-type} $B$N(B @var{parameter} $B$NCM$rJV$9!#(B @end defun @node Content-Type parser, Content-Type utility, mime-content-type, Content-Type @section Content-Type $BMs$N2r@O4o(B @defun mime-parse-Content-Type string @var{string} $B$r(B content-type $B$H$7$F2r@O$7$?7k2L$rJV$9!#(B @end defun @defun mime-read-Content-Type $B8=:_$N(B buffer $B$N(B Content-Type $BMs$rFI$_<h$j!"2r@O$7$?7k2L$rJV$9!#(B@refill Content-Type $BMs$,B8:_$7$J$$>l9g$O(B nil $B$rJV$9!#(B @end defun @node Content-Type utility, , Content-Type parser, Content-Type @section Content-Type $B$K4X$9$kM-MQ$J4X?t(B @defun mime-type/subtype-string type &optional subtype @var{type} $B$H(B @var{subtype} $B$+$i(B type/subtype $B7A<0$NJ8;zNs$rJV$9!#(B @end defun @node Content-Disposition, Content-Transfer-Encoding, Content-Type, Top @chapter Content-Disposition $BMs$N>pJs(B @cindex mime-content-disposition @cindex RFC 2183 @cindex Standards Track @cindex Content-Disposition $BMs(B @strong{Content-Disposition $BMs(B} $B$O(B entity $B$NI=<($d(B file $BL>$J$I(B $B$NB0@-$K$J$I$K4X$9$k>pJs$r5-=R$9$k$?$a$N$b$N$G$9!#(B @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 $B$O(B Content-Disposition $BMs$r9=J82r@O$9$k4X?t$H(B Content-Disposition $BMs$N2r@O7k2L$r3JG<$9$k9=B$BN(B @strong{mime-content-disposition} $B$rDs6!$7$^$9!#(B @menu * mime-content-disposition:: mime-content-disposition $B9=B$BN(B * Content-Disposition parser:: Content-Disposition $BMs$N2r@O4o(B @end menu @node mime-content-disposition, Content-Disposition parser, Content-Disposition, Content-Disposition @section mime-content-disposition $B9=B$BN(B @deffn{Structure} mime-content-disposition Content-Disposition $BMs$N2r@O7k2L$r<}$a$k$?$a$N9=B$BN!#(B@refill $B$3$N9=B$BN$r;2>H$9$k$K$O(B @code{mime-content-disposition-$BMWAGL>(B} $B$H$$$&L>(B $BA0$N;2>H4X?t$rMQ$$$k!#(B@refill $B$3$N9=B$BN$NMWAG$O0J2<$NDL$j$G$"$k!'(B @table @var @item disposition-type disposition-type (symbol). @item parameters Content-Disposition $BMs$N(B parameter ($BO"A[(B list). @end table @end deffn @defun mime-content-disposition-parameter content-disposition parameter @var{content-disposition} $B$N(B @var{parameter} $B$NCM$rJV$9!#(B @end defun @defun mime-content-disposition-filename content-disposition @var{content-disposition} $B$N(B filename $B$NCM$rJV$9!#(B @end defun @node Content-Disposition parser, , mime-content-disposition, Content-Disposition @section Content-Disposition $BMs$N2r@O4o(B @defun mime-parse-Content-Disposition string @var{string} $B$r(B content-disposition $B$H$7$F2r@O$7$?7k2L$rJV$9!#(B @end defun @defun mime-read-Content-Disposition $B8=:_$N(B buffer $B$N(B Content-Disposition $BMs$rFI$_<h$j!"2r@O$7$?7k2L$rJV$9!#(B @refill Content-Disposition $BMs$,B8:_$7$J$$>l9g$O(B nil $B$rJV$9!#(B @end defun @node Content-Transfer-Encoding, encoded-word, Content-Disposition, Top @chapter $BId9f2=K!(B @cindex Content-Transfer-Encoding $BMs(B @strong{Content-Transfer-Encoding $BMs(B} $B$O(B entity $B$NId9f2=K!$r5-=R$9$k$?$a(B $B$N$b$N$G$9!#(B@refill FLIM $B$G$O(B Content-Transfer-Encoding $BMs$r9=J82r@O$9$k4X?t$rDs6!$7$^$9!#$3(B $B$l$i$N4X?t$O(B Content-Transfer-Encoding $BMs$N>pJs$OJ8;zNs$GI=8=$7$^$9!#(B @refill $B$^$?!"(BContent-Transfer-Encoding $B$K4p$E$$$FId9f2=!&I|9f2=$r9T$&4X?t$bDs(B $B6!$5$l$^$9!#(B @menu * Content-Transfer-Encoding parser:: Content-Transfer-Encoding $BMs$N2r@O4o(B * encoder/decoder:: $BId9f2=!&I|9f2=(B * 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 $BMs$N2r@O4o(B @defun mime-parse-Content-Transfer-Encoding string @var{string} $B$r(B content-transfer-encoding $B$H$7$F2r@O$7$?7k2L$rJV$9!#(B @end defun @defun mime-read-Content-Transfer-Encoding &optional default-encoding $B8=:_$N(B buffer $B$N(B Content-Transfer-Encoding $BMs$rFI$_<h$j!"2r@O$7$?7k2L$r(B $BJV$9!#(B@refill Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l9g$O(B@var{default-encoding} $B$r(B $BJV$9!#(B @end defun @node encoder/decoder, Encoding information, Content-Transfer-Encoding parser, Content-Transfer-Encoding @section $BId9f2=!&I|9f2=(B @defun mime-encode-region start end encoding $B8=:_$N(B buffer $B$N(B @var{start} $B$+$i(B @var{end} $B$^$G$N(B region $B$r(B @var{encoding} $B$r;H$C$FId9f2=$7$^$9!#(B @end defun @defun mime-decode-region start end encoding $B8=:_$N(B buffer $B$N(B @var{start} $B$+$i(B @var{end} $B$^$G$N(B region $B$r(B @var{encoding} $B$r;H$C$FI|9f2=$7$^$9!#(B @end defun @defun mime-decode-string string encoding @var{string} $B$r(B @var{encoding} $B$H$7$FI|9f$7$?7k2L$rJV$9!#(B @end defun @defun mime-insert-encoded-file filename encoding @var{ENCODING} format $B$GId9f2=$5$l$?(B file @var{FILENAME} $B$r(B $BA^F~$9$k!#(B @end defun @defun mime-write-decoded-region start end filename encoding @var{encoding} $B$GId9f2=$5$l$?8=:_$N(B region $B$rI|9f2=$7$F(B @var{filename}$B$K=q$-9~$_$^$9!#(B <var>start<var> $B$H(B @var{end} $B$O(B buffer $B$N0LCV$G$9!#(B @end defun @node Encoding information, mel-backend, encoder/decoder, Content-Transfer-Encoding @section Other utilities @defun mime-encoding-list &optional SERVICE Content-Transfer-Encoding $B$N(B list $B$rJV$7$^$9!#(B@refill @var{service} $B$,;XDj$5$l$F$$$k$H!"$=$l$KBP$9$k(B Content-Transfer-Encoding $B$rJV$7$^$9!#(B @end defun @defun mime-encoding-alist &optional SERVICE $BJd40$N$?$a$N(B Content-Transfer-Encoding $B$NI=$rJV$7$^$9!#(B@refill @var{service} $B$,;XDj$5$l$F$$$k>l9g$O$=$l$KBP$9$k(B Content-Transfer-Encoding $B$N(B list $B$rJV$7$^$9!#(B @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} $B$r(B (nth 1 (car (last @var{args}))) backend $B$N(B method $B4X?t$H$7$FDj5A$7$^$9!#(B @var{args} $B$O(B lambda $B$N0z?t(B list $B$H;w$F$$$^$9$,!"(B(car (last @var{args})) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car (car (last @var{args}))) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car (last @var{args}))) $B$O(B backend $B$NL>A0(B (encoding) $B$G$9!#(B@refill $BNc(B:@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} $B$N4X?tDj5A$r(B @var{function} $B$K@_Dj$7$^$9!#(B@refill @var{spec} $B$N:G=i$NMWAG$O(B service $B$G$9!#(B@refill @var{args} $B$N;D$j$O(B lambda $B$N0z?t(B list $B;w$F$$$^$9$,!"(B(car (last @var{args})) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car (car (last @var{args}))) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car (last @var{args}))) $B$O(B backend $B$NL>A0(B (encoding) $B$G$9!#(B@refill $BNc(B:@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 $BId9f2=(B/$BI|9f2=(B service $B$rDI2C$9$kJ}K!(B @defmac mel-define-service name &optional args doc-string @var{name} $B$r(B Content-Transfer-Encoding $B$N(B service $B$H$7$FDj5A$7$^(B $B$9!#(B@refill @var{args} $B$,;XDj$5$l$F$$$k$H!"(B@var{name} $B$O(B service $B$N(B generic function $B$H$7$FDj5A$5$l$^$9!#(B@refill $BNc(B:@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 $B$N(B network $BI=8=(B @cindex RFC 2047 @cindex Standards Track @cindex RFC 2047 encoded-word $B$O(B header $B$GHs(B ASCII (@ref{ASCII}) $BJ8;z$rI=8=$9$k$?$a$N7A<0(B $B$G!"(B@strong{RFC 2047} $B$GDj5A$5$l$F$$$^$9!#(B@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 $B$^$?!"9T57$N0-$$$3$H$@$H8@$($^$9$,!"(Bencoded-word $B$rMQ$$$:$KHs(B ASCII (@ref{ASCII}) $BJ8;z$r(B header $B$KF~$l$?5-;v$bB8:_$7$^$9!#(B@refill FLIM $B$O$3$l$i$rId9f2=!&I|9f2=$9$k5!G=$rDs6!$7$^$9!#(B @menu * Header encoder/decoder:: Header $B$NId9f2=!&I|9f2=(B @end menu @node Header encoder/decoder, , encoded-word, encoded-word @section Header $B$NId9f2=!&I|9f2=(B @defun eword-decode-header &optional code-conversion separator Header $BCf$N(B encoded-word $B$rI|9f$9$k!#(B@refill $B$b$7(B @var{code-conversion} $B$,(B @code{nil} $B$J$i!"(Bencoded-word $B$@$1$,I|9f$5(B $B$l$k!#$b$7!"(B@var{code-conversion} $B$,(B MIME charset (@ref{MIME charset}) $B$J$i!"Hs(B ASCII bit patterns $B$O$=$N(B MIME charset $B$H$7$FI|9f$5$l$k!#$3$l0J(B $B30$N>l9g!"Hs(B ASCII bit patterns $B$O(B@code{default-mime-charset}. $B$H$7$FI|(B $B9f$5$l$k!#(B(cf. @ref{entity formatting}) @refill $B$b$7(B @var{separator} $B$,(B @code{nil} $B$G$J$1$l$P!"$=$NCM$,(Bheader separator $B$H$7$FMQ$$$i$l$k!#(B @end defun @defun eword-encode-header &optional code-conversion Header $B$r(B network $BI=8=$KId9f2=$9$k!#(B@refill $B3F(B field $B$O(B @code{mime-field-encoding-method-alist} $B$G;XDj$5$l$?J}<0$G(B $BId9f2=$5$l$k!#(B @end defun @defvar mime-field-encoding-method-alist Field $B$rId9f2=$9$kJ}K!$r;XDj$9$kO"A[(B list$B!#3F(B element $B$O(B (FIELD . METHOD) $B$NMM$K$J$C$F$$$k!#(B@refill METHOD $B$,(B @code{mime} $B$G$"$l$P!"(BFIELD $B$O(B MIME format $B$KId9f2=$5(B $B$l$k(B (encoded-word)$B!#(B METHOD $B$,(B @code{nil} $B$G$"$l$P!"(BFIELD $B$OId9f2=$5$l$J$$!#(B METHOD $B$,(B MIME charset $B$G$"$l$P!"(BFIELD $B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J(B $B$1$l$P$J$i$J$$$H$-$K(B charset $B$KId9f2=$5$l$k!#(B@refill $B$=$&$G$J$1$l$P!"(BFIELD $B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J$1$l$P$J$i$J$$$H$-(B $B$K(B $BJQ?t(B @code{default-mime-charset} $B$GId9f2=$5$l$k(B @end defvar @node custom, Appendix, encoded-word, Top @chapter $B0lHL@_Dj(B @deffn{group} mime MIME $B4XO"5!G=$K4X$9$k(B group.@refill @code{mail} $B$H(B @code{news} $B$KB0$9$k!#(B @end deffn @node Appendix, Concept Index, custom, Top @chapter $BIUO?(B @menu * Glossary:: $BMQ8l(B * Bug report:: bug $BJs9p$N;EJ}(B * CVS:: CVS $B$K$h$k3+H/(B * History:: $BNr;K(B @end menu @node Glossary, Bug report, Appendix, Appendix @section $BMQ8l(B @menu * 7bit:: * 8bit:: * ASCII:: * Base64:: * binary:: * Coded character set:: Coded character set$B!JId9f2=J8;z=89g!K(B, Character code$B!JJ8;zId9f!K(B * 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 $B$3$3$G$O(B 0 $B$+$i(B 127 $B$N@0?t$r;X$9!#(B@refill 0 $B$+$i(B 127 $B$N@0?t$NNs$GI=8=$G$-$k$h$&$J(B data $B$r(B ``7bit $B$N(B data'' $B$H8F$V!#(B @refill $B$^$?!"(B0 $B$+$i(B 31 $B$*$h$S(B 127 $B$GI=8=$5$l$k@)8fJ8;z$H(B 32 $B$GI=8=$5$l$k6uGr$H(B 33 $B$+$i(B 126 $B$GI=8=$5$l$k?^7AJ8;z$+$i$J$kJ8;zNs$N$3$H$r(B ``7bit $B$NJ8;zNs(B'' $B$H8F$V!J$3$l$O(B ISO 2022 (@ref{ISO 2022}) $B$N!V(B7 $BC10L7O!W$HF1MM!K!#(B $BEAE}E*$J(B Internet $B$N(B MTA (@ref{MTA}) $B$O(B 7bit $B$N(B data $B$rE>Aw$G$-$k$N$G!"(B 7bit $B$N(B data $B$O(B Quoted-Printable (@ref{Quoted-Printable}) $B$d(B Base64 (@ref{Base64}) $B$H$$$C$?JQ49$r9T$o$J$/$F$b$=$N$^$^E>Aw$G$-$k!#(B@refill $B$7$+$7!"(B7bit $B$G$"$l$P$I$s$J(B data $B$G$bNI$$$H$O$$$($J$$!#$J$<$J$i!"#19T$N(B $BD9$5$,$"$^$j$KD9$$$H!"(BMTA $B$O$=$N(B message $B$rE>Aw$9$k$3$H$,$G$-$J$$$+$i$G(B $B$"$k!#$A$J$_$K!"(BRFC 821 (@ref{RFC 821}) $B$O#19T$O2~9TJ8;z$r=|$$$F(B 998 byte $B0JFb$G$"$k$3$H$r5a$a$F$$$k!#$h$C$F!"$3$l0J>e$N9T$,4^$^$l$k2DG=@-$N(B $B$"$k(B data, $BNc$($P!"(BPostscript $B$N(B data $B$J$I$O(B Quoted-Printable $BEy$G(B encode$B$9$kI,MQ$,$"$k!#(B @node 8bit, ASCII, 7bit, Glossary @subsection 8bit @cindex binary $B$3$3$G$O(B 0 $B$+$i(B 255 $B$N@0?t$r;X$9!#(B@refill 0 $B$+$i(B 255 $B$N@0?t$NNs$GI=8=$G$-$k$h$&$J(B data $B$r(B ``8bit $B$N(B data'' $B$H8F$V!#(B @refill $B$^$?!"(B0 $B$+$i(B 31, 127 $B$*$h$S(B 128 $B$+$i(B 159 $B$GI=8=$5$l$k@)8fJ8;z$H(B 32 $B$GI=(B $B8=$5$l$k6uGr$H(B 33 $B$+$i(B 126 $B$H(B 160 $B$+$i(B 255 $B$GI=8=$5$l$k?^7AJ8;z$+$i$J$k(B $BJ8;zNs$N$3$H$r(B ``8bit $B$NJ8;zNs(B'' $B$H8F$V!J$3$l$O(B ISO 2022 (@ref{ISO 2022}) $B$N!V(B8 $BC10L7O!W$HF1MM!K!#(B@refill iso-8859-1 (@ref{iso-8859-1}) $B$d(B euc-kr (@ref{euc-kr}) $B$H$$$C$?Id9f2=J8(B $B;z=89g$O(B 8bit $B$NJ8;zNs$G$"$k!#(B@refill $BEAE}E*$J(B Internet $B$N(B MTA (@ref{MTA}) $B$O(B 7bit (@ref{7bit}) $B$N(B data $B$7$+E>(B $BAw$G$-$J$$$N$G!"$=$&$7$?(B MTA $B$r7PM3$9$k>l9g!"(BQuoted-Printable (@ref{Quoted-Printable}) $B$d(B Base64 (@ref{Base64}) $B$H$$$C$?JQ49$r9T$o$J$/(B $B$F$O$J$i$J$$!#(B@refill $B$7$+$7!":G6a$G$O(B 8bit $B$NJ8;zNs$r$=$N$^$^DL$9$3$H$,$G$-$k(B MTA $B$bEP>l$7$F(B $B$-$?$N$G!"$=$N$^$^Aw$k$3$H$,$G$-$k>l9g$bA}$($F$-$?!#(B@refill $B$7$+$7!"(B8bit $B$G$"$l$P$I$s$J(B data $B$G$bNI$$$H$O$$$($J$$!#$J$<$J$i!"#19T$N(B $BD9$5$,$"$^$j$KD9$$$H!"(BMTA $B$O$=$N(B message $B$rE>Aw$9$k$3$H$,$G$-$J$$$+$i$G(B $B$"$k!#$A$J$_$K!"(BRFC 821 (@ref{RFC 821}) $B$O#19T$O2~9TJ8;z$r=|$$$F(B 998 byte $B0JFb$G$"$k$3$H$r5a$a$F$$$k!#$h$C$F!"$3$l0J>e$N9T$,4^$^$l$k2DG=@-$N(B $B$"$k(B data, $BNc$($P!"(BPostscript $B$N(B data $B$J$I$O(B Quoted-Printable $BEy$G(B encode$B$9$kI,MQ$,$"$k!#(B@refill $B$^$?!"$3$&$7$?M}M3$+$i!"#19T$,(B 999 byte $B0J>e$N9T$,B8:_$9$k2DG=@-$N$"$k(B data $B$O(B @strong{binary} (@ref{binary}) $B$H8F$V$3$H$K$9$k!#(B@refill $B$A$J$_$K!"(B7bit $B$GI=8=$G$-$k(B data $B$O(B 8bit $B$G$bI=8=$G$-$k!#$h$C$F!"(B ``8bit'' $B$H8@$C$?>l9g!"#19T$,(B 998 byte $B0J2<$NG$0U$N(B data $B$r;X$9$3$H$,(B $B$"$k!#(B @node ASCII, Base64, 8bit, Glossary @subsection ASCII @cindex ANSI X3.4:1986 @cindex ASCII $B%"%a%j%+O"K.$G;H$o$l$kJ8;z$rId9f2=$7$?Id9f2=J8;z=89g(B (@ref{$BId9f2=J8;z=8(B $B9g(B})$B!#(BA-Z, a-z $B$N(B Latin $BJ8;z$H?t;z!"4v$D$+$N5-9f$+$i$J$k!#(BISO 646 $B$N0l$D(B $B$G!"8=:_$O9q:]4p=`HG(B (IRV) $B$K$J$C$F$$$k!#(B @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}) $B$GDj5A$5$l$F$$$k(B MIME (@ref{MIME}) $B$K$*$1$k(B binary data (@ref{binary}) $B$N(B network $B$G$NJQ49K!$N#1$D!#(B@refill $B!X(B64 $B?J?t!Y$H$$$&0UL#$G!"(B3 byte $B$N(B data $B$r(B 0 $B$+$i(B 63 $B$N?t$rI=$9(B ASCII (@ref{ASCII}) 4 $BJ8;z$KJQ49$9$kJ}K!!#!J$b$7!"(B4 $BJ8;z$K$J$i$J$1$l$P(B @strong{pad} $B$H8F$P$l$k5M$aJ*$r$7$FD9$5$rD4@0$9$k!K(B@refill $B$3$N(B 65 $B<oN`$NJ8;z$O(B ASCII $B$H(B EBCDIC $B$N6&DLItJ,$+$iA*$P$l$F$*$j!"(B Internet $B0J30$N(B network $B$r7PM3$9$k>l9g$G$b0BA4$KE>Aw$G$-$k$h$&$K@_7W$5(B $B$l$F$$$k!#(B @node binary, Coded character set, Base64, Glossary @subsection binary @cindex binary data @cindex binary $BG$0U$N(B byte $BNs$r(B @strong{binary} $B$H8F$V!#(B@refill 8bit (@ref{8bit}) $B$H0[$J$k$N$O(B data $B$K9T$N9=B$$r2>Dj$7$J$$$3$H$G$"$k!#(B $B$^$?!"9T$N9=B$$,$"$C$F$b!"(B999 byte $B0J>e$+$i$J$k9T$,$"$k>l9g$b(B binary $B$H(B $B8F$V$3$H$K$9$k!#(B@refill $B$A$J$_$K!"(B7bit (@ref{7bit}) $B$d(B 8bit $B$GI=8=$G$-$k(B data $B$O(B binary $B$G$bI=8=(B $B$G$-$k!#$h$C$F!"(B@strong{binary data} $B$H8@$C$?>l9g!"G$0U$N(B data $B$r;X$9$3(B $B$H$,$"$k!#(B @node Coded character set, media-type, binary, Glossary @subsection Coded character set$B!JId9f2=J8;z=89g!K(B, Character code$B!JJ8;zId9f!K(B $BJ8;z$H(B byte $BNs$H#1BP#1$KBP1~IU$1$k[#Kf$G$J$$5,B'$N=89g!#(B @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}) $B$K$*$1$k(B entity (@ref{entity}) $B$N<oN`!#(B @strong{primary-type} $B$H(B @strong{subtype} $B$+$i$J$k!#(BRFC 2046 (@ref{RFC 2046}) $B$GDj5A$5$l$F$$$k!#(B@refill primary-type $B$OI8=`$G$O(B @itemize @bullet @item @strong{text} @item @strong{image} @item @strong{audio} @item @strong{video} @item @strong{application} @item @strong{multipart} (@ref{multipart}) @item @strong{message} @end itemize @noindent $B$,Dj5A$5$l!"$=$l$>$l$K$O(B application/octet-stream, audio/basic, image/jpeg, multipart/mixed (@ref{multipart/mixed}), text/plain (@ref{text/plain}), video/mpeg $B$J$I$N$5$^$6$^$J(B subtype $B$,Dj5A$5$l$F$$$k!#(B @noindent @strong{[$BCm0U(B]} @quotation $B$3$3$G$O!"(Btext/plain $B$J$I$N(B type/subtype $B$NAH$r$7$P$7$P(B @strong{primary-type/subtype} $B$H=q$/!#(B @end quotation media-type $B$O!"(BRFC 2046 $B$GDj5A$5$l$F$$$k$b$N$K2C$($F!"EPO?$9$k$3$H$b$G$-(B $B$k!#8=:_!"EPO?$5$l$F$$$k$b$N$O(B MEDIA TYPES (ftp://ftp.isi.edu/in-notes/iana/assignments/media-types) $B$G;2>H$G$-$k!#(B $B$^$?!"(Btype $B$b$7$/$O(B subtype $B$K!"A0$K(B `x-' $B$rIU$1$?(B @strong{x-token} $B$rMQ(B $B$$$k$3$H$K$h$j!"EPO?$5$l$F$$$J$$$b$N$r;dE*$KMQ$$$k$3$H$b$G$-$k!#$7$+$7!"(B $BEvA3$N$3$H$J$,$i!"$3$&$7$?;dE*$J(B media-type $B$ONJ2r$rF@$?<T$N4V$G$7$+2r<a(B $B$G$-$J$$$N$GMxMQ$K$OCm0U$9$k$3$H!#(B@refill (cf. @ref{Content-Type}) @node message, MIME, media-type, Glossary @subsection message $B$3$3$G$O(B mail $B$H(B news $B5-;v$NAm>N$H$7$FMQ$$$k!#(B @node MIME, MIME charset, message, Glossary @subsection MIME @cindex Multipurpose Internet Mail Extensions @strong{Multipurpose Internet Mail Extensions} $B$NN,$G!"(BInternet $B$N(B mail $B$d(B news $B$G(B us-ascii plain text (@ref{us-ascii}) $B0J30$NJ8;z$r;H$&$?$a$N(B RFC 822 (@ref{RFC 822}) $B$KBP$9$k3HD%!#(B@refill RFC 2045 $B$OKAF,$G<!$N$h$&$K=R$Y$F$$$k!'(B@refill STD 11, RFC 822 $B$O!"(BUS-ASCII message header $B$K4X$7$FHs>o$K>\:Y$K5,Dj$7(B $B$?(B message $BI=8=(B protocol $B$rDj5A$7$F$$$k!#$7$+$7!"$=$l$OC1$K(B flat $B$J(B US-ASCII text $B$N$_$KN1$^$j!"(Bmessage $B$NFbMF$d(B message body $B$K4X$9$k5,Dj(B $B$O$J$5$l$F$$$J$$!#(BMultipurpose Internet Mail Extensions, $B$"$k$$$O(B MIME $B$HAm>N$5$l$k!"$3$N0lO"$NJ8=q$O!"0J2<$N;v$r2DG=$H$9$k$?$a$K(B message $B$N(B $B7A<0$r:FDj5A$7$?!'(B @enumerate @item $BJ8=q(B message body $B$K$*$1$k(B US-ASCII $B0J30$NJ8;z=89g(B @item $BHsJ8=q(B message body @item $BJ#?t$NItJ,$+$i$J$k(B message body @item US-ASCII $B0J30$NJ8;z=89g$+$i$J$kJ8=q(B header $B>pJs(B @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}) $B$GDj5A$5$l$F$$$k!#(B @node MIME charset, MTA, MIME, Glossary @subsection MIME charset Content-Type (@ref{Content-Type}) $BMs$d(B encoded-word (@ref{encoded-word}) $B$N(B charset parameter $B$GMQ$$$i$l$kEPO?$5$l$?Id9f2=J8;z=89g(B(@ref{Coded character set})$B!#(B@refill RFC 2045 (@ref{RFC 2045}) $B$GDj5A$5$l$F$$$k!#(B@refill iso-2022-jp $B$d(B euc-kr $B$O$=$N#1$D!#(B @node MTA, MUA, MIME charset, Glossary @subsection MTA @cindex Message Transfer Agent @strong{Message Transfer Agent} $B$NN,$G!"(Bqmail $B$d(B sendmail $B$J$I$N(B mail $BG[(B $BAw(B program $B$H(B inn $B$J$I$N(B news server $B$NAm>N!#(B@refill (cf. @ref{MUA}) @node MUA, Quoted-Printable, MTA, Glossary @subsection MUA @cindex Message User Agent @strong{Message User Agent} $B$NN,$G!"(Bmail reader $B$H(B news reader $B$NAm>N!#(B @refill (cf. @ref{MTA}) @node Quoted-Printable, RFC 822, MUA, Glossary @subsection Quoted-Printable RFC 2045 (@ref{RFC 2045}) $B$GDj5A$5$l$F$$$k(B MIME (@ref{MIME}) $B$K$*$1$k(B binary data (@ref{binary data}) $B$N(B network $B$G$NJQ49K!$N#1$D!#(B@refill `=' $B$d@)8fJ8;z$d(B 128 $B0J>e$NJ8;z$J$I$O(B `=AF' $B$N$h$&$K(B `=' $B$N8e$KB3$/(B 16 $B?J?t$GI=8=$9$k!#$3$N$?$a!"(BASCII (@ref{ASCII}) $BJ8;zCf?4$N(B data $B$G$O(B Base64 (@ref{Base64}) $B$KHf$Y$k$H2DFI@-$,9b$/$J$k2DG=@-$,$"$k!#(B@refill $B$7$+$7$J$,$i!"(BEBCDIC $B$K$OB8:_$7$J$$J8;z$rMxMQ$9$k>l9g!"(BEBCDIC $B$rMxMQ$7(B $B$F$$$k(B network $B$G$O0BA4$KE>Aw$9$k$3$H$,$G$-$:!"(BBase64 $B$KHf$Y$F0BA4@-$O(B $BDc$$!#(B @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 $B$N<g$K(B @strong{message header} $B$K4X$9$k7A<0$K(B $B4X$9$kI8=`$rDj$a$F$$$k(B RFC. @noindent @strong{[Memo]} @quotation news message $B$b$3$l$K=`$8$F$$$k$N$G!"(B@strong{Internet mail} $B$H=q$/$h$j$b!"(B @strong{Internet message} $B$H=q$$$?J}$,NI$$$+$b$7$l$J$$!#(B @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 $B$G$N(B message $B$N7A<0$rDj$a$?(B RFC. RFC 822 (@ref{RFC 822}) $B$N(B subset $B$K$J$C$F$$$k!#(BInternet $B$NI8=`$G$O$J$$$,!"(BUSENET $B0J30$N(B netnews $B$G(B $B$b$3$l$K=`$8$F$$$k$b$N$,B?$$!#(B @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 $B=qBN$dAHHG$K4X$9$k>pJs$r;}$?$J$$J8;zId9f(B(@ref{Coded character set})$B$N$_(B $B$GI=8=$5$l$k(B text $B>pJs!#(B(cf. @ref{text/plain}) @node us-ascii, , plain text, Glossary @subsection us-ascii @cindex ASCII @cindex us-ascii $B%"%a%j%+O"K.$J$I$G;H$o$l$k1Q8l$J$I$rI=8=$9$k$?$a$N(B MIME charset (@ref{MIME charset}) $B$N#1$D!#(B@refill ASCII (@ref{ASCII}) $B$N$_$+$i$J$j(B ISO 2022 $B$K$h$kId9f3HD%$O5v$5$l$J$$!#(B Internet message $B$K$*$1$kI8=`$NId9f2=J8;z=89g(B(@ref{Coded character set}) $B$G$"$j!"L@<(E*$K(B MIME charset $B$,<($5$l$J$$>l9g$O86B'$H$7$F(B @strong{us-ascii} $B$,;H$o$l$k!#(B@refill $B$^$?!"(BRFC 822 (@ref{RFC 822}) $B$K$*$1$k(B @strong{ASCII} $B$O(B us-ascii $B$G$"$k!#(B @node Bug report, CVS, Glossary, Appendix @section bug $BJs9p$N;EJ}(B FLIM $B$N%P%0$r8+$D$1$?$i!"0J2<$N(B address $B$K(B mail $B$rAw$C$F$/$@$5$$!'(B @itemize @bullet @item $B1Q8l(B <emacs-mime-en@@m17n.org> @item $BF|K\8l(B <emacs-mime-ja@@m17n.org> @end itemize $BC"$7!"$"$^$j$K$b8E$$HG$K4X$9$kJs9p$O4?7^$5$l$^$;$s!#8E$$HG$N(B bug $B$O!"?7(B $B$7$$HG$G$O<#$C$F$$$k$+$b$7$l$^$;$s!#$^$:!":G?7HG$G3NG'$7$F$_$^$7$g$&!#(B @refill $B$=$l$+$i!"E,@Z$JJs9p$r$7$^$7$g$&!#C1$K!V$&$^$/F0$+$J$$!W$H8@$o$l$F$b$I$&(B $B$$$&>u67$J$N$+$O$5$C$Q$jH=$j$^$;$s!#:GDc8B!"(BOS, emacs, APEL, FLIM, SEMI, $B;H$C$F$$$k(B MUA $B$N<oN`$*$h$SHG!"@_Dj$r=q$/I,MW$,$"$j$^$9!#$^$?!"(Berror $B$,(B $B5/$C$F$$$k>l9g$O(B backtrace $B$rAw$k$3$H$b=EMW$G$9!#(B(cf. @ref{(emacs)Bugs}) $B$^$?!"(Bbug $B$OBgDqJ#?t$N?M$,Ax6x$9$k$b$N$G$9!J$=$&$G$J$1$l$P!"(Bbug $B$G$O$J(B $B$$2DG=@-$,$"$j$^$9!K!#$@$+$i!":n<T$KD>@\(B mail $B$rAw$k$H:n<T$OF1$8(B mail $B$r2?DL$b=q$/1)L\$K$J$j$^$9!#$@$+$i!"I,$:(B bug $BJs9p$O>e5-$N(B address $B$KAw$C(B $B$F$/$@$5$$!#(B EMACS-MIME ML $B$G$O(B FLIM $B$N%P%0>pJs$N8r49$d:G?7HG$NG[I[!"(BFLIM $B$N2~NI$K(B $B4X$9$k5DO@$r9T$J$C$F$$$^$9!#(BEMACS-MIME ML $B$K;22C$7$?$$J}$O(B @itemize @bullet @item $B1Q8l(B <emacs-mime-en-ctl@@m17n.org> @item $BF|K\8l(B <emacs-mime-ja-ctl@@m17n.org> @end itemize @noindent $B$K6u$N(B mail $B$rAw$C$F2<$5$$!#(B @node CVS, History, Bug report, Appendix @section CVS $B$K$h$k3+H/(B FLIM $B$N(B file $B$O(B CVS $B$r;H$C$F4IM}$5$l$F$$$^$9!#$3$N$?$a!"0J2<$NJ}K!$G:G(B $B?7$N(B FLIM $B$rF~<j$9$k$3$H$,$G$-$^$9!'(B @example (0) cvs login % cvs -d :pserver:anonymous@@cvs.m17n.org:/cvs/root login CVS password: [CR] # NULL string (1) checkout % cvs -d :pserver:anonymous@@cvs.m17n.org:/cvs/root checkout checkout [-r TAG] flim @end example CVS $B$rMQ$$$?3+H/$K;22C$7$?$$J}$O(B @itemize @bullet @item <cvs@@cvs.m17n.org> @end itemize @noindent $B$^$G!"%"%+%&%s%HL>$H(B ssh $B$N8x3+80$rAw$C$F$/$@$5$$!#(Bssh $B7PM3$G$O!"(B cvsroot $B$O(B :ext:cvs@@cvs.m17n.org:/cvs/root $B$H$J$j$^$9!#(B @node History, , CVS, Appendix @section $BNr;K(B FLIM $B$N(B code $B$N:G8E$NItJ,$O(B $B1]JB(B $B;LCR(B $B;a$,=q$$$?(B @file{mime.el} $B$K5/8;$7(B $B$^$9!#$3$N>.$5$J(B program $B$O(B Nemacs $B$GF0:n$9$k(B iso-2022-jp $B$N(B B-encoding $B@lMQ$N(B encoded-word $B$NI|9f2=%W%m%0%i%`$G$7$?!#(B@refill $B$=$N8e!"<i2,(B $BCNI'(B $B$O(B @file{mime.el} $B$r85$K(B@file{tiny-mime.el} $B$H$$$&%W%m(B $B%0%i%`$r=q$-$^$9!#$3$l$O!"(BNemacs $B$H(B Mule $B$GF0:n$9$k(B encoded-word $B$NId9f(B $B2=!&I|9f2=%W%m%0%i%`$G$7$?!#(B@file{tiny-mime.el} $B$O(B B-encoding $B$@$1$G$J$/(B Q-encoding $B$b(Bsupport $B$7!"$^$?!"(BMULE $B$G07$&$3$H$,$G$-$k$5$^$6$^$J(B MIME charset (@ref{MIME charset}) $B$rF1;~$K;H$&$3$H$,$G$-$^$7$?!#$3$N;~!"(B Nemacs $B$H(B Mule $B$NAPJ}$r(B support $B$9$k$?$a$KMQ$$$i$l$?%F%/%K%C%/$O8e$K(B emu package $B$K$^$H$a$i$l$^$9!#(B@refill $B$3$N:"!"<i2,(B $BCNI'(B $B$O(B @file{tiny-mime.el} $B$r$5$^$6$^$J(B MUA $B$G;H$&$?$a$N@_(B $BDj=8$bG[I[$7$F$$$^$7$?$,!"$=$l$i$O8e$K(B@file{tiny-mime.el} $B$H$H$b$K#1$D$N(B package $B$K$^$H$a$i$l!"(Btm $B$H$$$&L>A0$GG[I[$5$l$^$9!#(B@refill $B<i2,(B $BCNI'(B $B$O$d$,$F!"(BMIME message $B$r1\Mw$9$k$?$a$N%W%m%0%i%`$G$"$k(B @file{tm-body.el} $B$r=q$-$^$9!#$3$l$O!"$9$0$K(B@file{tm-view.el} $B$H$$$&L>A0(B $B$KJQ$o$j$^$7$?$,!"$d$,$F!"$3$l$,(B@file{tiny-mime.el} $B$KBe$o$C$F!"(Btm $B$NCf(B $B3K$H$J$j$^$9!#(B@refill @file{tm-view.el} $B$OEvA3!"(BContent-Transfer-Encoding $B$r07$&I,MW$,$"$j$^$9!#(B $B$3$NL\E*$N$?$a$K!"(BMEL $B$,@0Hw$5$l$O$8$a$^$7$?!#(BBase64 $B$K4X$7$F$O(B @file{tiny-mime.el} $B$N(B code $B$,0\$5$l!"$^$?!"?7$?$K(BQuoted-Printable $B$N(B code $B$,DI2C$5$l$^$7$?!#$3$l$i$,(B@file{mel-b.el} $B$H(B @file{mel-q.el} $B$K$J$j(B $B$^$7$?!#(B@refill $B$^$?!"8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B uuencode $BMQ$N(B @file{mel-u.el} $B$,DI2C$5$l!"(B $B$=$N8e$K!">.NS(B $B=$J?(B $B;a$K$h$C$F(B x-gzip64 $BMQ$N(B@file{mel-g.el} $B$,DI2C$5$l$^(B $B$7$?!#(B@refill tm $B$G$O8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B @file{tiny-mime.el} $B$N:F<BAu$,9T$o$l!"$3(B $B$N2aDx$G!"(BSTD 11 $B$N(B parser $B$,=q$+$l$^$7$?!#$3$l$O!"8=:_$N(B @file{std11.el} $B$KEv$?$j$^$9!#$^$?!"$3$N2aDx$G(B @file{tiny-mime.el} $B$OI|(B $B9f2=$r9T$&(B @file{tm-ew-d.el} $B$HId9f2=$r9T$&(B @file{tm-ew-e.el} $B$KJ,$1$i$l(B $B$^$7$?!#$3$NN><T$,8=:_$N(B @file{eword-decode.el} $B$H(B @file{eword-encode.el} $B$N@hAD$KEv$?$j$^$9!#(B@refill $B8e$K!"<i2,(B $BCNI'(B $B$i$K$h$C$F(B tm $B$NA4LL=q$-49$(:n6H$,9T$o$l!"$3$N2aDx$G!"(Btm $B$O(B APEL, MEL, SEMI, EMH, RMAIL-MIME, Gnus-MIME $B$J$I$KJ,$1$i$l$^$7$?!#$3(B $B$N$&$A$N(B MEL $B$,(B FLIM $B$ND>@\$N@hAD$KEv$?$j$^$9!#(B@refill $B8e$K!"(BAPEL $B$+$i(B @file{std11.el} $B$,0\$5$l!"$^$?!"(B@file{mailcap.el}, @file{eword-decode.el} $B$*$h$S(B @file{eword-encode.el} $B$,(B SEMI $B$+$i0\$5$l!"(B package $B$NL>A0$,(B FLIM $B$H$J$j$^$9!#(B@refill $B$3$ND>A0$+$iEDCf(B $BE/(B $B;a$,$h$j(B RFC $B$KCi<B$J<BAu$r=q$-;O$a!"$3$l$O!"8=:_!"(B FLIM $B$N;^$G$"$k(B ``FLIM-FLAM'' $B$H$J$C$F$$$^$9!#(B @node Concept Index, Function Index, Appendix, Top @chapter $B35G0:w0z(B @printindex cp @node Function Index, Variable Index, Concept Index, Top @chapter $B4X?t:w0z(B @printindex fn @node Variable Index, , Function Index, Top @chapter $BJQ?t:w0z(B @printindex vr @bye ��������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/mime-parse.el��������������������������������������������������������������������������0000664�0000000�0000000�00000042435�11747036124�0015543�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; mime-parse.el --- MIME message parser ;; Copyright (C) 1994,95,96,97,98,99,2001 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; 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 'mime-def) (require 'luna) (require 'std11) (autoload 'mime-entity-body-buffer "mime") (autoload 'mime-entity-body-start-point "mime") (autoload 'mime-entity-body-end-point "mime") ;;; @ lexical analyzer ;;; (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 (std11-lexical-analyze string mime-lexical-analyzer)) prev tail) ;; 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-int (buffer-substring (point)(- (point) 2)) 16) (delete-region (point)(- (point) 3))))) (setq text (buffer-string)) (when charset ;; I believe that `decode-mime-charset-string' of mcs-e20.el should ;; be independent of the value of `enable-multibyte-characters'. (erase-buffer) (set-buffer-multibyte t) (setq text (decode-mime-charset-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" (char-int (char-after))) (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-int (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) (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." (mime-parse-msg-id (cons '(specials . "<") (nconc (cdr (cdr (std11-lexical-analyze string))) '((specials . ">")))))) ;;; @ 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 (let ((str (std11-fetch-field "Content-Type"))) (if str (mime-parse-Content-Type str) )) 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 �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/mime.el��������������������������������������������������������������������������������0000664�0000000�0000000�00000033443�11747036124�0014432�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; mime.el --- MIME library module ;; Copyright (C) 1998,1999,2000,2001,2003 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <tomo@m17n.org> ;; 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 '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 (mime-content-disposition-filename (mime-entity-content-disposition entity)))) (if (and mime-header-accept-quoted-encoded-words ret) (eword-decode-string ret) ret)) (cdr (let ((param (mime-content-type-parameters (mime-entity-content-type entity)))) (or (assoc "name" param) (assoc "x-name" param)))))) (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 �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/mmbuffer.el����������������������������������������������������������������������������0000664�0000000�0000000�00000027337�11747036124�0015313�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; mmbuffer.el --- MIME entity module for binary buffer ;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <tomo@m17n.org> ;; 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)))) (save-excursion (set-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) (save-excursion (set-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)) (save-excursion (set-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) (save-excursion (set-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)) (save-excursion (set-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) (save-excursion (set-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) (save-excursion (set-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 �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/mmcooked.el����������������������������������������������������������������������������0000664�0000000�0000000�00000005705�11747036124�0015301�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; mmcooked.el --- MIME entity implementation for binary buffer ;; Copyright (C) 1998,1999 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; 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) (save-excursion (set-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) (save-excursion (set-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) (save-excursion (set-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 �����������������������������������������������������������flim-fee392e/mmexternal.el��������������������������������������������������������������������������0000664�0000000�0000000�00000013460�11747036124�0015654�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; mmexternal.el --- MIME entity module for external buffer ;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <tomo@m17n.org> ;; 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 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/mmgeneric.el���������������������������������������������������������������������������0000664�0000000�0000000�00000011763�11747036124�0015452�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; mmgeneric.el --- MIME generic entity module ;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <tomo@m17n.org> ;; 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 'luna) (eval-when-compile (require 'eword-decode) ; mime-find-field-presentation-method ) ;;; @ 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) (or (catch 'found (while visible-fields (let ((regexp (car visible-fields))) (if (string-match regexp field-name) (throw 'found t) )) (setq visible-fields (cdr visible-fields)) )) (catch 'found (while invisible-fields (let ((regexp (car invisible-fields))) (if (string-match regexp 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 ((the-buf (current-buffer)) (mode-obj (mime-find-field-presentation-method 'wide)) field-decoder f-b p f-e field-name len field field-body) (save-excursion (set-buffer buffer) (save-restriction (narrow-to-region start end) (goto-char start) (while (re-search-forward std11-field-head-regexp nil t) (setq f-b (match-beginning 0) p (match-end 0) field-name (buffer-substring f-b p) len (string-width field-name) f-e (std11-field-end)) (when (mime-visible-field-p field-name visible-fields invisible-fields) (setq field (intern (capitalize (buffer-substring f-b (1- p)))) field-body (buffer-substring p f-e) field-decoder (inline (mime-find-field-decoder-internal field mode-obj))) (with-current-buffer the-buf (insert field-name) (insert (if field-decoder (funcall field-decoder field-body len) ;; Don't decode field-body)) (insert "\n") ))))))) ;;; @ end ;;; (provide 'mmgeneric) ;;; mmgeneric.el ends here �������������flim-fee392e/ntlm.el��������������������������������������������������������������������������������0000664�0000000�0000000�00000045764�11747036124�0014466�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; ntlm.el --- NTLM (NT LanManager) authentication support ;; Copyright (C) 2001 Taro Kawagishi ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; Keywords: NTLM, SASL ;; Version: 1.00 ;; Created: February 2001 ;; 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 library is a direct translation of the Samba release 2.2.0 ;; implementation of Windows NT and LanManager compatible password ;; encryption. ;; ;; Interface functions: ;; ;; ntlm-build-auth-request ;; This will return a binary string, which should be used in the ;; base64 encoded form and it is the caller's responsibility to encode ;; the returned string with base64. ;; ;; ntlm-build-auth-response ;; It is the caller's responsibility to pass a base64 decoded string ;; (which will be a binary string) as the first argument and to ;; encode the returned string with base64. The second argument user ;; should be given in user@domain format. ;; ;; ntlm-get-password-hashes ;; ;; ;; NTLM authentication procedure example: ;; ;; 1. Open a network connection to the Exchange server at the IMAP port (143) ;; 2. Receive an opening message such as: ;; "* OK Microsoft Exchange IMAP4rev1 server version 5.5.2653.7 (XXXX) ready" ;; 3. Ask for IMAP server capability by sending "NNN capability" ;; 4. Receive a capability message such as: ;; "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM" ;; 5. Ask for NTLM authentication by sending a string ;; "NNN authenticate ntlm" ;; 6. Receive continuation acknowledgment "+" ;; 7. Send NTLM authentication request generated by 'ntlm-build-auth-request ;; 8. Receive NTLM challenge string following acknowledgment "+" ;; 9. Generate response to challenge by 'ntlm-build-auth-response ;; (here two hash function values of the user password are encrypted) ;; 10. Receive authentication completion message such as ;; "NNN OK AUTHENTICATE NTLM completed." ;;; Code: (require 'md4) ;;; ;;; NTLM authentication interface functions (defun ntlm-build-auth-request (user &optional domain) "Return the NTLM authentication request string for USER and DOMAIN. USER is a string representing a user name to be authenticated and DOMAIN is a NT domain. USER can include a NT domain part as in user@domain where the string after @ is used as the domain if DOMAIN is not given." (interactive) (let ((request-ident (concat "NTLMSSP" (make-string 1 0))) (request-msgType (concat (make-string 1 1) (make-string 3 0))) ;0x01 0x00 0x00 0x00 (request-flags (concat (make-string 1 7) (make-string 1 178) (make-string 2 0))) ;0x07 0xb2 0x00 0x00 lu ld off-d off-u) (when (string-match "@" user) (unless domain (setq domain (substring user (1+ (match-beginning 0))))) (setq user (substring user 0 (match-beginning 0)))) ;; set fields offsets within the request struct (setq lu (length user)) (setq ld (length domain)) (setq off-u 32) ;offset to the string 'user (setq off-d (+ 32 lu)) ;offset to the string 'domain ;; pack the request struct in a string (concat request-ident ;8 bytes request-msgType ;4 bytes request-flags ;4 bytes (md4-pack-int16 lu) ;user field, count field (md4-pack-int16 lu) ;user field, max count field (md4-pack-int32 (cons 0 off-u)) ;user field, offset field (md4-pack-int16 ld) ;domain field, count field (md4-pack-int16 ld) ;domain field, max count field (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field user ;bufer field domain ;bufer field ))) (eval-when-compile (defmacro ntlm-string-as-unibyte (string) (if (fboundp 'string-as-unibyte) `(string-as-unibyte ,string) string))) (defun ntlm-build-auth-response (challenge user password-hashes) "Return the response string to a challenge string CHALLENGE given by the NTLM based server for the user USER and the password hash list PASSWORD-HASHES. NTLM uses two hash values which are represented by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))" (let* ((rchallenge (ntlm-string-as-unibyte challenge)) ;; get fields within challenge struct ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes (flags (substring rchallenge 20 24)) ;flags, 4 bytes (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes uDomain-len uDomain-offs ;; response struct and its fields lmRespData ;lmRespData, 24 bytes ntRespData ;ntRespData, 24 bytes domain ;ascii domain string lu ld off-lm off-nt off-d off-u off-w off-s) ;; extract domain string from challenge string (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2))) (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8))) (setq domain (ntlm-unicode2ascii (substring challenge (cdr uDomain-offs) (+ (cdr uDomain-offs) uDomain-len)) (/ uDomain-len 2))) ;; overwrite domain in case user is given in <user>@<domain> format (when (string-match "@" user) (setq domain (substring user (1+ (match-beginning 0)))) (setq user (substring user 0 (match-beginning 0)))) ;; generate response data (setq lmRespData (ntlm-smb-owf-encrypt (car password-hashes) challengeData)) (setq ntRespData (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData)) ;; get offsets to fields to pack the response struct in a string (setq lu (length user)) (setq ld (length domain)) (setq off-lm 64) ;offset to string 'lmResponse (setq off-nt (+ 64 24)) ;offset to string 'ntResponse (setq off-d (+ 64 48)) ;offset to string 'uDomain (setq off-u (+ 64 48 (* 2 ld))) ;offset to string 'uUser (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey ;; pack the response struct in a string (concat "NTLMSSP\0" ;response ident field, 8 bytes (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes ;; lmResponse field, 8 bytes ;;AddBytes(response,lmResponse,lmRespData,24); (md4-pack-int16 24) ;len field (md4-pack-int16 24) ;maxlen field (md4-pack-int32 (cons 0 off-lm)) ;field offset ;; ntResponse field, 8 bytes ;;AddBytes(response,ntResponse,ntRespData,24); (md4-pack-int16 24) ;len field (md4-pack-int16 24) ;maxlen field (md4-pack-int32 (cons 0 off-nt)) ;field offset ;; uDomain field, 8 bytes ;;AddUnicodeString(response,uDomain,domain); ;;AddBytes(response, uDomain, udomain, 2*ld); (md4-pack-int16 (* 2 ld)) ;len field (md4-pack-int16 (* 2 ld)) ;maxlen field (md4-pack-int32 (cons 0 off-d)) ;field offset ;; uUser field, 8 bytes ;;AddUnicodeString(response,uUser,u); ;;AddBytes(response, uUser, uuser, 2*lu); (md4-pack-int16 (* 2 lu)) ;len field (md4-pack-int16 (* 2 lu)) ;maxlen field (md4-pack-int32 (cons 0 off-u)) ;field offset ;; uWks field, 8 bytes ;;AddUnicodeString(response,uWks,u); (md4-pack-int16 (* 2 lu)) ;len field (md4-pack-int16 (* 2 lu)) ;maxlen field (md4-pack-int32 (cons 0 off-w)) ;field offset ;; sessionKey field, 8 bytes ;;AddString(response,sessionKey,NULL); (md4-pack-int16 0) ;len field (md4-pack-int16 0) ;maxlen field (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset ;; flags field, 4 bytes flags ; ;; buffer field lmRespData ;lmResponse, 24 bytes ntRespData ;ntResponse, 24 bytes (ntlm-ascii2unicode domain ;unicode domain string, 2*ld bytes (length domain)) ; (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes (length user)) ; (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes (length user)) ; ))) (defun ntlm-get-password-hashes (password) "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD" (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))) (defun ntlm-ascii2unicode (str len) "Convert an ASCII string into a NT Unicode string, which is little-endian utf16." (let ((utf (make-string (* 2 len) 0)) (i 0) val) (while (and (< i len) (not (eq (setq val (aref str i)) ?\0))) (aset utf (* 2 i) val) (aset utf (1+ (* 2 i)) 0) (setq i (1+ i))) utf)) (defun ntlm-unicode2ascii (str len) "Extract 7 bits ASCII part of a little endian utf16 string STR of length LEN." (let ((buf (make-string len 0)) (i 0) (j 0)) (while (< i len) (aset buf i (logand (aref str j) 127)) ;(string-to-number "7f" 16) (setq i (1+ i) j (+ 2 j))) buf)) (defun ntlm-smb-passwd-hash (passwd) "Return the SMB password hash string of 16 bytes long for the given password string PASSWD. PASSWD is truncated to 14 bytes if longer." (let ((len (min (length passwd) 14))) (ntlm-smb-des-e-p16 (concat (substring (upcase passwd) 0 len) ;fill top 14 bytes with passwd (make-string (- 15 len) 0))))) (defun ntlm-smb-owf-encrypt (passwd c8) "Return the response string of 24 bytes long for the given password string PASSWD based on the DES encryption. PASSWD is of at most 14 bytes long and the challenge string C8 of 8 bytes long." (let ((len (min (length passwd) 16)) p22) (setq p22 (concat (substring passwd 0 len) ;fill top 16 bytes with passwd (make-string (- 22 len) 0))) (ntlm-smb-des-e-p24 p22 c8))) (defun ntlm-smb-des-e-p24 (p22 c8) "Return a 24 bytes hashed string for a 21 bytes string P22 and a 8 bytes string C8." (concat (ntlm-smb-hash c8 p22 t) ;hash first 8 bytes of p22 (ntlm-smb-hash c8 (substring p22 7) t) (ntlm-smb-hash c8 (substring p22 14) t))) (defconst ntlm-smb-sp8 [75 71 83 33 64 35 36 37]) (defun ntlm-smb-des-e-p16 (p15) "Return a 16 bytes hashed string for a 15 bytes string P15." (concat (ntlm-smb-hash ntlm-smb-sp8 p15 t) ;hash of first 8 bytes of p15 (ntlm-smb-hash ntlm-smb-sp8 ;hash of last 8 bytes of p15 (substring p15 7) t))) (defun ntlm-smb-hash (in key forw) "Return the hash string of length 8 for a string IN of length 8 and a string KEY of length 8. FORW is t or nil." (let ((out (make-string 8 0)) outb ;string of length 64 (inb (make-string 64 0)) (keyb (make-string 64 0)) (key2 (ntlm-smb-str-to-key key)) (i 0) aa) (while (< i 64) (unless (zerop (logand (aref in (/ i 8)) (lsh 1 (- 7 (% i 8))))) (aset inb i 1)) (unless (zerop (logand (aref key2 (/ i 8)) (lsh 1 (- 7 (% i 8))))) (aset keyb i 1)) (setq i (1+ i))) (setq outb (ntlm-smb-dohash inb keyb forw)) (setq i 0) (while (< i 64) (unless (eq (aref outb i) ?\0) (setq aa (aref out (/ i 8))) (aset out (/ i 8) (logior aa (lsh 1 (- 7 (% i 8)))))) (setq i (1+ i))) out)) (defun ntlm-smb-str-to-key (str) "Return a string of length 8 for the given string STR of length 7." (let ((key (make-string 8 0)) (i 7)) (aset key 0 (lsh (aref str 0) -1)) (aset key 1 (logior (lsh (logand (aref str 0) 1) 6) (lsh (aref str 1) -2))) (aset key 2 (logior (lsh (logand (aref str 1) 3) 5) (lsh (aref str 2) -3))) (aset key 3 (logior (lsh (logand (aref str 2) 7) 4) (lsh (aref str 3) -4))) (aset key 4 (logior (lsh (logand (aref str 3) 15) 3) (lsh (aref str 4) -5))) (aset key 5 (logior (lsh (logand (aref str 4) 31) 2) (lsh (aref str 5) -6))) (aset key 6 (logior (lsh (logand (aref str 5) 63) 1) (lsh (aref str 6) -7))) (aset key 7 (logand (aref str 6) 127)) (while (>= i 0) (aset key i (lsh (aref key i) 1)) (setq i (1- i))) key)) (defconst ntlm-smb-perm1 [57 49 41 33 25 17 9 1 58 50 42 34 26 18 10 2 59 51 43 35 27 19 11 3 60 52 44 36 63 55 47 39 31 23 15 7 62 54 46 38 30 22 14 6 61 53 45 37 29 21 13 5 28 20 12 4]) (defconst ntlm-smb-perm2 [14 17 11 24 1 5 3 28 15 6 21 10 23 19 12 4 26 8 16 7 27 20 13 2 41 52 31 37 47 55 30 40 51 45 33 48 44 49 39 56 34 53 46 42 50 36 29 32]) (defconst ntlm-smb-perm3 [58 50 42 34 26 18 10 2 60 52 44 36 28 20 12 4 62 54 46 38 30 22 14 6 64 56 48 40 32 24 16 8 57 49 41 33 25 17 9 1 59 51 43 35 27 19 11 3 61 53 45 37 29 21 13 5 63 55 47 39 31 23 15 7]) (defconst ntlm-smb-perm4 [32 1 2 3 4 5 4 5 6 7 8 9 8 9 10 11 12 13 12 13 14 15 16 17 16 17 18 19 20 21 20 21 22 23 24 25 24 25 26 27 28 29 28 29 30 31 32 1]) (defconst ntlm-smb-perm5 [16 7 20 21 29 12 28 17 1 15 23 26 5 18 31 10 2 8 24 14 32 27 3 9 19 13 30 6 22 11 4 25]) (defconst ntlm-smb-perm6 [40 8 48 16 56 24 64 32 39 7 47 15 55 23 63 31 38 6 46 14 54 22 62 30 37 5 45 13 53 21 61 29 36 4 44 12 52 20 60 28 35 3 43 11 51 19 59 27 34 2 42 10 50 18 58 26 33 1 41 9 49 17 57 25]) (defconst ntlm-smb-sc [1 1 2 2 2 2 2 2 1 2 2 2 2 2 2 1]) (defconst ntlm-smb-sbox [[[14 4 13 1 2 15 11 8 3 10 6 12 5 9 0 7] [ 0 15 7 4 14 2 13 1 10 6 12 11 9 5 3 8] [ 4 1 14 8 13 6 2 11 15 12 9 7 3 10 5 0] [15 12 8 2 4 9 1 7 5 11 3 14 10 0 6 13]] [[15 1 8 14 6 11 3 4 9 7 2 13 12 0 5 10] [ 3 13 4 7 15 2 8 14 12 0 1 10 6 9 11 5] [ 0 14 7 11 10 4 13 1 5 8 12 6 9 3 2 15] [13 8 10 1 3 15 4 2 11 6 7 12 0 5 14 9]] [[10 0 9 14 6 3 15 5 1 13 12 7 11 4 2 8] [13 7 0 9 3 4 6 10 2 8 5 14 12 11 15 1] [13 6 4 9 8 15 3 0 11 1 2 12 5 10 14 7] [ 1 10 13 0 6 9 8 7 4 15 14 3 11 5 2 12]] [[ 7 13 14 3 0 6 9 10 1 2 8 5 11 12 4 15] [13 8 11 5 6 15 0 3 4 7 2 12 1 10 14 9] [10 6 9 0 12 11 7 13 15 1 3 14 5 2 8 4] [ 3 15 0 6 10 1 13 8 9 4 5 11 12 7 2 14]] [[ 2 12 4 1 7 10 11 6 8 5 3 15 13 0 14 9] [14 11 2 12 4 7 13 1 5 0 15 10 3 9 8 6] [ 4 2 1 11 10 13 7 8 15 9 12 5 6 3 0 14] [11 8 12 7 1 14 2 13 6 15 0 9 10 4 5 3]] [[12 1 10 15 9 2 6 8 0 13 3 4 14 7 5 11] [10 15 4 2 7 12 9 5 6 1 13 14 0 11 3 8] [ 9 14 15 5 2 8 12 3 7 0 4 10 1 13 11 6] [ 4 3 2 12 9 5 15 10 11 14 1 7 6 0 8 13]] [[ 4 11 2 14 15 0 8 13 3 12 9 7 5 10 6 1] [13 0 11 7 4 9 1 10 14 3 5 12 2 15 8 6] [ 1 4 11 13 12 3 7 14 10 15 6 8 0 5 9 2] [ 6 11 13 8 1 4 10 7 9 5 0 15 14 2 3 12]] [[13 2 8 4 6 15 11 1 10 9 3 14 5 0 12 7] [ 1 15 13 8 10 3 7 4 12 5 6 11 0 14 9 2] [ 7 11 4 1 9 12 14 2 0 6 10 13 15 3 5 8] [ 2 1 14 7 4 10 8 13 15 12 9 0 3 5 6 11]]]) (defsubst ntlm-string-permute (in perm n) "Return a string of length N for a string IN and a permutation vector PERM of size N. The length of IN should be height of PERM." (let ((i 0) (out (make-string n 0))) (while (< i n) (aset out i (aref in (- (aref perm i) 1))) (setq i (1+ i))) out)) (defsubst ntlm-string-lshift (str count len) "Return a string by circularly shifting a string STR by COUNT to the left. length of STR is LEN." (let ((c (% count len))) (concat (substring str c len) (substring str 0 c)))) (defsubst ntlm-string-xor (in1 in2 n) "Return exclusive-or of sequences in1 and in2" (let ((w (make-string n 0)) (i 0)) (while (< i n) (aset w i (logxor (aref in1 i) (aref in2 i))) (setq i (1+ i))) w)) (defun ntlm-smb-dohash (in key forw) "Return the hash value for a string IN and a string KEY. Length of IN and KEY are 64. FORW non nill means forward, nil means backward." (let (pk1 ;string of length 56 c ;string of length 28 d ;string of length 28 cd ;string of length 56 (ki (make-vector 16 0)) ;vector of string of length 48 pd1 ;string of length 64 l ;string of length 32 r ;string of length 32 rl ;string of length 64 (i 0) (j 0) (k 0)) (setq pk1 (ntlm-string-permute key ntlm-smb-perm1 56)) (setq c (substring pk1 0 28)) (setq d (substring pk1 28 56)) (setq i 0) (while (< i 16) (setq c (ntlm-string-lshift c (aref ntlm-smb-sc i) 28)) (setq d (ntlm-string-lshift d (aref ntlm-smb-sc i) 28)) (setq cd (concat (substring c 0 28) (substring d 0 28))) (aset ki i (ntlm-string-permute cd ntlm-smb-perm2 48)) (setq i (1+ i))) (setq pd1 (ntlm-string-permute in ntlm-smb-perm3 64)) (setq l (substring pd1 0 32)) (setq r (substring pd1 32 64)) (setq i 0) (let (er ;string of length 48 erk ;string of length 48 (b (make-vector 8 0)) ;vector of strings of length 6 cb ;string of length 32 pcb ;string of length 32 r2 ;string of length 32 jj m n bj sbox-jmn) (while (< i 16) (setq er (ntlm-string-permute r ntlm-smb-perm4 48)) (setq erk (ntlm-string-xor er (aref ki (if forw i (- 15 i))) 48)) (setq j 0) (while (< j 8) (setq jj (* 6 j)) (aset b j (substring erk jj (+ jj 6))) (setq j (1+ j))) (setq j 0) (while (< j 8) (setq bj (aref b j)) (setq m (logior (lsh (aref bj 0) 1) (aref bj 5))) (setq n (logior (lsh (aref bj 1) 3) (lsh (aref bj 2) 2) (lsh (aref bj 3) 1) (aref bj 4))) (setq k 0) (setq sbox-jmn (aref (aref (aref ntlm-smb-sbox j) m) n)) (while (< k 4) (aset bj k (if (zerop (logand sbox-jmn (lsh 1 (- 3 k)))) 0 1)) (setq k (1+ k))) (setq j (1+ j))) (setq j 0) (setq cb nil) (while (< j 8) (setq cb (concat cb (substring (aref b j) 0 4))) (setq j (1+ j))) (setq pcb (ntlm-string-permute cb ntlm-smb-perm5 32)) (setq r2 (ntlm-string-xor l pcb 32)) (setq l r) (setq r r2) (setq i (1+ i)))) (setq rl (concat r l)) (ntlm-string-permute rl ntlm-smb-perm6 64))) (defun ntlm-md4hash (passwd) "Return the 16 bytes MD4 hash of a string PASSWD after converting it into a Unicode string. PASSWD is truncated to 128 bytes if longer." (let (len wpwd) ;; Password cannot be longer than 128 characters (setq len (length passwd)) (if (> len 128) (setq len 128)) ;; Password must be converted to NT unicode (setq wpwd (ntlm-ascii2unicode passwd len)) ;; Calculate length in bytes (setq len (* len 2)) (md4 wpwd len))) (provide 'ntlm) ;;; ntlm.el ends here ������������flim-fee392e/qmtp.el��������������������������������������������������������������������������������0000664�0000000�0000000�00000010065�11747036124�0014457�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; qmtp.el --- basic functions to send mail with QMTP server ;; Copyright (C) 2000 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; 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.") ;;;###autoload (defun qmtp-send-buffer (sender recipients buffer) (save-excursion (set-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 ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/sasl-cram.el���������������������������������������������������������������������������0000664�0000000�0000000�00000003156�11747036124�0015363�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; sasl-cram.el --- CRAM-MD5 module for the SASL client framework ;; Copyright (C) 2000 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Kenichi OKADA <okada@opaopa.org> ;; Keywords: SASL, CRAM-MD5 ;; 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: (require 'sasl) (require 'hmac-md5) (defconst sasl-cram-md5-steps '(ignore ;no initial response sasl-cram-md5-response)) (defun sasl-cram-md5-response (client step) (let ((passphrase (sasl-read-passphrase (format "CRAM-MD5 passphrase for %s: " (sasl-client-name client))))) (unwind-protect (concat (sasl-client-name client) " " (encode-hex-string (hmac-md5 (sasl-step-data step) passphrase))) (fillarray passphrase 0)))) (put 'sasl-cram 'sasl-mechanism (sasl-make-mechanism "CRAM-MD5" sasl-cram-md5-steps)) (provide 'sasl-cram) ;;; sasl-cram.el ends here ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/sasl-digest.el�������������������������������������������������������������������������0000664�0000000�0000000�00000011347�11747036124�0015721�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework ;; Copyright (C) 2000 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Kenichi OKADA <okada@opaopa.org> ;; Keywords: SASL, DIGEST-MD5 ;; 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. ;; This program is implemented from draft-leach-digest-sasl-05.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) ;;; Commentary: (require 'sasl) (require 'hmac-md5) (defvar sasl-digest-md5-nonce-count 1) (defvar sasl-digest-md5-unique-id-function sasl-unique-id-function) (defvar sasl-digest-md5-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?= "." table) (modify-syntax-entry ?, "." table) table) "A syntax table for parsing digest-challenge attributes.") (defconst sasl-digest-md5-steps '(ignore ;no initial response sasl-digest-md5-response ignore)) ;"" (defun sasl-digest-md5-parse-string (string) "Parse STRING and return a property list. The value is a cons cell of the form \(realm nonce qop-options stale maxbuf charset algorithm cipher-opts auth-param)." (with-temp-buffer (set-syntax-table sasl-digest-md5-syntax-table) (save-excursion (insert string) (goto-char (point-min)) (insert "(") (while (progn (forward-sexp) (not (eobp))) (delete-char 1) (insert " ")) (insert ")") (read (point-min-marker))))) (defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name) (concat serv-type "/" host (if (and serv-name (not (string= host serv-name))) (concat "/" serv-name)))) (defun sasl-digest-md5-cnonce () (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function)) (sasl-unique-id))) (defun sasl-digest-md5-response-value (username realm nonce cnonce nonce-count qop digest-uri authzid) (let ((passphrase (sasl-read-passphrase (format "DIGEST-MD5 passphrase for %s: " username)))) (unwind-protect (encode-hex-string (md5-binary (concat (encode-hex-string (md5-binary (concat (md5-binary (concat username ":" realm ":" passphrase)) ":" nonce ":" cnonce (if authzid (concat ":" authzid))))) ":" nonce ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":" (encode-hex-string (md5-binary (concat "AUTHENTICATE:" digest-uri (if (member qop '("auth-int" "auth-conf")) ":00000000000000000000000000000000"))))))) (fillarray passphrase 0)))) (defun sasl-digest-md5-response (client step) (let* ((plist (sasl-digest-md5-parse-string (sasl-step-data step))) (realm (or (sasl-client-property client 'realm) (plist-get plist 'realm))) ;need to check (nonce-count (or (sasl-client-property client 'nonce-count) sasl-digest-md5-nonce-count)) (qop (or (sasl-client-property client 'qop) "auth")) (digest-uri (sasl-digest-md5-digest-uri (sasl-client-service client)(sasl-client-server client))) (cnonce (or (sasl-client-property client 'cnonce) (sasl-digest-md5-cnonce)))) (sasl-client-set-property client 'nonce-count (1+ nonce-count)) (unless (string= qop "auth") (sasl-error (format "Unsupported \"qop-value\": %s" qop))) (concat "username=\"" (sasl-client-name client) "\"," "realm=\"" realm "\"," "nonce=\"" (plist-get plist 'nonce) "\"," "cnonce=\"" cnonce "\"," (format "nc=%08x," nonce-count) "digest-uri=\"" digest-uri "\"," "qop=" qop "," "response=" (sasl-digest-md5-response-value (sasl-client-name client) realm (plist-get plist 'nonce) cnonce nonce-count qop digest-uri (plist-get plist 'authzid))))) (put 'sasl-digest 'sasl-mechanism (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps)) (provide 'sasl-digest) ;;; sasl-digest.el ends here �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/sasl-ntlm.el���������������������������������������������������������������������������0000664�0000000�0000000�00000004514�11747036124�0015412�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; sasl-ntlm.el --- NTLM (NT Lan Manager) module for the SASL client framework ;; Copyright (C) 2000 Free Software Foundation, Inc. ;; Author: Taro Kawagishi <tarok@transpulse.org> ;; Keywords: SASL, NTLM ;; Version: 1.00 ;; Created: February 2001 ;; 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 is a SASL interface layer for NTLM authentication message ;; generation by ntlm.el ;;; Code: (require 'sasl) (require 'ntlm) (defconst sasl-ntlm-steps '(ignore ;nothing to do before making sasl-ntlm-request ;authentication request sasl-ntlm-response) ;response to challenge "A list of functions to be called in sequnece for the NTLM authentication steps. Ther are called by 'sasl-next-step.") (defun sasl-ntlm-request (client step) "SASL step function to generate a NTLM authentication request to the server. Called from 'sasl-next-step. CLIENT is a vector [mechanism user service server sasl-client-properties] STEP is a vector [<previous step function> <result of previous step function>]" (let ((user (sasl-client-name client))) (ntlm-build-auth-request user))) (defun sasl-ntlm-response (client step) "SASL step function to generate a NTLM response against the server challenge stored in the 2nd element of STEP. Called from 'sasl-next-step." (let* ((user (sasl-client-name client)) (passphrase (sasl-read-passphrase (format "NTLM passphrase for %s: " user))) (challenge (sasl-step-data step))) (ntlm-build-auth-response challenge user (ntlm-get-password-hashes passphrase)))) (put 'sasl-ntlm 'sasl-mechanism (sasl-make-mechanism "NTLM" sasl-ntlm-steps)) (provide 'sasl-ntlm) ;;; sasl-ntlm.el ends here ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/sasl-scram.el��������������������������������������������������������������������������0000664�0000000�0000000�00000021255�11747036124�0015546�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; sasl-scram.el --- Compute SCRAM-MD5. ;; Copyright (C) 1999 Shuhei KOBAYASHI ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; Kenichi OKADA <okada@opaopa.org> ;; 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 (lsh (logand buffer-size (lsh 255 16)) -16)) (aset csecinfo 2 (lsh (logand buffer-size (lsh 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 ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/sasl.el��������������������������������������������������������������������������������0000664�0000000�0000000�00000020546�11747036124�0014445�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; sasl.el --- SASL client framework ;; Copyright (C) 2000 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> ;; 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-mechanisms '("CRAM-MD5" "DIGEST-MD5" "PLAIN" "LOGIN" "ANONYMOUS" "NTLM" "SCRAM-MD5")) (defvar sasl-mechanism-alist '(("CRAM-MD5" sasl-cram) ("DIGEST-MD5" sasl-digest) ("PLAIN" sasl-plain) ("LOGIN" sasl-login) ("ANONYMOUS" sasl-anonymous) ("NTLM" sasl-ntlm) ("SCRAM-MD5" sasl-scram))) (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- (lsh 1 20))))) ;; (current-time) returns 16-bit ints, ;; and 2^16*25 just fits into 4 digits i base 36. (* 25 25))) (let ((tm (current-time))) (concat (sasl-unique-id-number-base36 (+ (car tm) (lsh (% sasl-unique-id-char 25) 16)) 4) (sasl-unique-id-number-base36 (+ (nth 1 tm) (lsh (/ 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)) (char-to-string (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 ����������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/sasl.texi������������������������������������������������������������������������������0000664�0000000�0000000�00000015420�11747036124�0015011�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������\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: ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/sha1-dl.el�����������������������������������������������������������������������������0000664�0000000�0000000�00000004065�11747036124�0014732�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; sha1-dl.el --- SHA1 Secure Hash Algorithm using DL module. ;; Copyright (C) 1999, 2001, 2004 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; 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: ;;; Code: (provide 'sha1-dl) ; beware of circular dependency. (eval-when-compile (require 'sha1)) ; sha1-dl-module. ;;; This file is loaded (from "sha1.el") only when sha1-dl-module exists. (defvar sha1-dl-handle (dynamic-link sha1-dl-module)) ;;; sha1-dl-module provides `sha1-string' and `sha1-binary'. (dynamic-call "emacs_sha1_init" sha1-dl-handle) (defun sha1-region (beg end &optional binary) (if binary (sha1-binary (buffer-substring-no-properties beg end)) (sha1-string (buffer-substring-no-properties beg end)))) (defun sha1 (object &optional beg end binary) "Return the SHA1 (Secure Hash Algorithm) of an object. OBJECT is either a string or a buffer. Optional arguments BEG and END denote buffer positions for computing the hash of a portion of OBJECT. If BINARY is non-nil, return a string in binary form." (if (stringp object) (if binary (sha1-binary object) (sha1-string object)) (save-excursion (set-buffer object) (sha1-region (or beg (point-min)) (or end (point-max)) binary)))) ;;; sha1-dl.el ends here ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/sha1-el.el�����������������������������������������������������������������������������0000664�0000000�0000000�00000035767�11747036124�0014750�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; sha1-el.el --- SHA1 Secure Hash Algorithm in Emacs-Lisp ;; Copyright (C) 1999, 2001, 2003, 2004 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; 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: ;; This program is implemented from the definition of SHA-1 in FIPS PUB ;; 180-1 (Federal Information Processing Standards Publication 180-1), ;; "Announcing the Standard for SECURE HASH STANDARD". ;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm> ;; (EXCEPTION; two optimizations taken from GnuPG/cipher/sha1.c) ;; ;; Test cases from FIPS PUB 180-1. ;; ;; (sha1 "abc") ;; => a9993e364706816aba3e25717850c26c9cd0d89d ;; ;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") ;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1 ;; ;; (sha1 (make-string 1000000 ?a)) ;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f ;; ;; BUGS: ;; * It is assumed that length of input string is less than 2^29 bytes. ;; * It is caller's responsibility to make string (or region) unibyte. ;; ;; TODO: ;; * Rewrite from scratch! ;; This version is much faster than Keiichi Suzuki's another sha1.el, ;; but it is too dirty. ;;; Code: (require 'hex-util) (autoload 'executable-find "executable") ;;; ;;; external SHA1 function. ;;; (defgroup sha1 nil "Elisp interface for SHA1 hash computation." :group 'extensions) (defcustom sha1-maximum-internal-length 500 "*Maximum length of message to use Lisp version of SHA1 function. If message is longer than this, `sha1-program' is used instead. If this variable is set to 0, use external program only. If this variable is set to nil, use internal function only." :type 'integer :group 'sha1) (defcustom sha1-program '("sha1sum") "*Name of program to compute SHA1. It must be a string \(program name\) or list of strings \(name and its args\)." :type '(repeat string) :group 'sha1) (defcustom sha1-use-external (condition-case () (executable-find (car sha1-program)) (error)) "*Use external SHA1 program. If this variable is set to nil, use internal function only." :type 'boolean :group 'sha1) (defun sha1-string-external (string &optional binary) (let (prog args digest default-enable-multibyte-characters) (if (consp sha1-program) (setq prog (car sha1-program) args (cdr sha1-program)) (setq prog sha1-program args nil)) (with-temp-buffer (insert string) (apply (function call-process-region) (point-min)(point-max) prog t t nil args) ;; SHA1 is 40 bytes long in hexadecimal form. (setq digest (buffer-substring (point-min)(+ (point-min) 40)))) (if binary (decode-hex-string digest) digest))) (defun sha1-region-external (beg end &optional binary) (sha1-string-external (buffer-substring-no-properties beg end) binary)) ;;; ;;; internal SHA1 function. ;;; (eval-when-compile ;; optional second arg of string-to-number is new in v20. (defconst sha1-K0-high 23170) ; (string-to-number "5A82" 16) (defconst sha1-K0-low 31129) ; (string-to-number "7999" 16) (defconst sha1-K1-high 28377) ; (string-to-number "6ED9" 16) (defconst sha1-K1-low 60321) ; (string-to-number "EBA1" 16) (defconst sha1-K2-high 36635) ; (string-to-number "8F1B" 16) (defconst sha1-K2-low 48348) ; (string-to-number "BCDC" 16) (defconst sha1-K3-high 51810) ; (string-to-number "CA62" 16) (defconst sha1-K3-low 49622) ; (string-to-number "C1D6" 16) ;;; original definition of sha1-F0. ;;; (defmacro sha1-F0 (B C D) ;;; (` (logior (logand (, B) (, C)) ;;; (logand (lognot (, B)) (, D))))) ;;; a little optimization from GnuPG/cipher/sha1.c. (defmacro sha1-F0 (B C D) (` (logxor (, D) (logand (, B) (logxor (, C) (, D)))))) (defmacro sha1-F1 (B C D) (` (logxor (, B) (, C) (, D)))) ;;; original definition of sha1-F2. ;;; (defmacro sha1-F2 (B C D) ;;; (` (logior (logand (, B) (, C)) ;;; (logand (, B) (, D)) ;;; (logand (, C) (, D))))) ;;; a little optimization from GnuPG/cipher/sha1.c. (defmacro sha1-F2 (B C D) (` (logior (logand (, B) (, C)) (logand (, D) (logior (, B) (, C)))))) (defmacro sha1-F3 (B C D) (` (logxor (, B) (, C) (, D)))) (defmacro sha1-S1 (W-high W-low) (` (let ((W-high (, W-high)) (W-low (, W-low))) (setq S1W-high (+ (% (* W-high 2) 65536) (/ W-low (, (/ 65536 2))))) (setq S1W-low (+ (/ W-high (, (/ 65536 2))) (% (* W-low 2) 65536)))))) (defmacro sha1-S5 (A-high A-low) (` (progn (setq S5A-high (+ (% (* (, A-high) 32) 65536) (/ (, A-low) (, (/ 65536 32))))) (setq S5A-low (+ (/ (, A-high) (, (/ 65536 32))) (% (* (, A-low) 32) 65536)))))) (defmacro sha1-S30 (B-high B-low) (` (progn (setq S30B-high (+ (/ (, B-high) 4) (* (% (, B-low) 4) (, (/ 65536 4))))) (setq S30B-low (+ (/ (, B-low) 4) (* (% (, B-high) 4) (, (/ 65536 4)))))))) (defmacro sha1-OP (round) (` (progn (sha1-S5 sha1-A-high sha1-A-low) (sha1-S30 sha1-B-high sha1-B-low) (setq sha1-A-low (+ ((, (intern (format "sha1-F%d" round))) sha1-B-low sha1-C-low sha1-D-low) sha1-E-low (, (symbol-value (intern (format "sha1-K%d-low" round)))) (aref block-low idx) (progn (setq sha1-E-low sha1-D-low) (setq sha1-D-low sha1-C-low) (setq sha1-C-low S30B-low) (setq sha1-B-low sha1-A-low) S5A-low))) (setq carry (/ sha1-A-low 65536)) (setq sha1-A-low (% sha1-A-low 65536)) (setq sha1-A-high (% (+ ((, (intern (format "sha1-F%d" round))) sha1-B-high sha1-C-high sha1-D-high) sha1-E-high (, (symbol-value (intern (format "sha1-K%d-high" round)))) (aref block-high idx) (progn (setq sha1-E-high sha1-D-high) (setq sha1-D-high sha1-C-high) (setq sha1-C-high S30B-high) (setq sha1-B-high sha1-A-high) S5A-high) carry) 65536))))) (defmacro sha1-add-to-H (H X) (` (progn (setq (, (intern (format "sha1-%s-low" H))) (+ (, (intern (format "sha1-%s-low" H))) (, (intern (format "sha1-%s-low" X))))) (setq carry (/ (, (intern (format "sha1-%s-low" H))) 65536)) (setq (, (intern (format "sha1-%s-low" H))) (% (, (intern (format "sha1-%s-low" H))) 65536)) (setq (, (intern (format "sha1-%s-high" H))) (% (+ (, (intern (format "sha1-%s-high" H))) (, (intern (format "sha1-%s-high" X))) carry) 65536))))) ) ;;; buffers (H0 H1 H2 H3 H4). (defvar sha1-H0-high) (defvar sha1-H0-low) (defvar sha1-H1-high) (defvar sha1-H1-low) (defvar sha1-H2-high) (defvar sha1-H2-low) (defvar sha1-H3-high) (defvar sha1-H3-low) (defvar sha1-H4-high) (defvar sha1-H4-low) (defun sha1-block (block-high block-low) (let (;; step (c) --- initialize buffers (A B C D E). (sha1-A-high sha1-H0-high) (sha1-A-low sha1-H0-low) (sha1-B-high sha1-H1-high) (sha1-B-low sha1-H1-low) (sha1-C-high sha1-H2-high) (sha1-C-low sha1-H2-low) (sha1-D-high sha1-H3-high) (sha1-D-low sha1-H3-low) (sha1-E-high sha1-H4-high) (sha1-E-low sha1-H4-low) (idx 16)) ;; step (b). (let (;; temporary variables used in sha1-S1 macro. S1W-high S1W-low) (while (< idx 80) (sha1-S1 (logxor (aref block-high (- idx 3)) (aref block-high (- idx 8)) (aref block-high (- idx 14)) (aref block-high (- idx 16))) (logxor (aref block-low (- idx 3)) (aref block-low (- idx 8)) (aref block-low (- idx 14)) (aref block-low (- idx 16)))) (aset block-high idx S1W-high) (aset block-low idx S1W-low) (setq idx (1+ idx)))) ;; step (d). (setq idx 0) (let (;; temporary variables used in sha1-OP macro. S5A-high S5A-low S30B-high S30B-low carry) (while (< idx 20) (sha1-OP 0) (setq idx (1+ idx))) (while (< idx 40) (sha1-OP 1) (setq idx (1+ idx))) (while (< idx 60) (sha1-OP 2) (setq idx (1+ idx))) (while (< idx 80) (sha1-OP 3) (setq idx (1+ idx)))) ;; step (e). (let (;; temporary variables used in sha1-add-to-H macro. carry) (sha1-add-to-H H0 A) (sha1-add-to-H H1 B) (sha1-add-to-H H2 C) (sha1-add-to-H H3 D) (sha1-add-to-H H4 E)))) (defun sha1-binary (string) "Return the SHA1 of STRING in binary form." (let (;; prepare buffers for a block. byte-length of block is 64. ;; input block is split into two vectors. ;; ;; input block: 00 01 02 03 04 05 06 07 08 09 0A 0B 0C 0D 0E 0F ... ;; block-high: +-0-+ +-1-+ +-2-+ +-3-+ ;; block-low: +-0-+ +-1-+ +-2-+ +-3-+ ;; ;; length of each vector is 80, and elements of each vector are ;; 16bit integers. elements 0x10-0x4F of each vector are ;; assigned later in `sha1-block'. (block-high (eval-when-compile (make-vector 80 nil))) (block-low (eval-when-compile (make-vector 80 nil)))) (unwind-protect (let* (;; byte-length of input string. (len (length string)) (lim (* (/ len 64) 64)) (rem (% len 4)) (idx 0)(pos 0)) ;; initialize buffers (H0 H1 H2 H3 H4). (setq sha1-H0-high 26437 ; (string-to-number "6745" 16) sha1-H0-low 8961 ; (string-to-number "2301" 16) sha1-H1-high 61389 ; (string-to-number "EFCD" 16) sha1-H1-low 43913 ; (string-to-number "AB89" 16) sha1-H2-high 39098 ; (string-to-number "98BA" 16) sha1-H2-low 56574 ; (string-to-number "DCFE" 16) sha1-H3-high 4146 ; (string-to-number "1032" 16) sha1-H3-low 21622 ; (string-to-number "5476" 16) sha1-H4-high 50130 ; (string-to-number "C3D2" 16) sha1-H4-low 57840) ; (string-to-number "E1F0" 16) ;; loop for each 64 bytes block. (while (< pos lim) ;; step (a). (setq idx 0) (while (< idx 16) (aset block-high idx (+ (* (aref string pos) 256) (aref string (1+ pos)))) (setq pos (+ pos 2)) (aset block-low idx (+ (* (aref string pos) 256) (aref string (1+ pos)))) (setq pos (+ pos 2)) (setq idx (1+ idx))) (sha1-block block-high block-low)) ;; last block. (if (prog1 (< (- len lim) 56) (setq lim (- len rem)) (setq idx 0) (while (< pos lim) (aset block-high idx (+ (* (aref string pos) 256) (aref string (1+ pos)))) (setq pos (+ pos 2)) (aset block-low idx (+ (* (aref string pos) 256) (aref string (1+ pos)))) (setq pos (+ pos 2)) (setq idx (1+ idx))) ;; this is the last (at most) 32bit word. (cond ((= rem 3) (aset block-high idx (+ (* (aref string pos) 256) (aref string (1+ pos)))) (setq pos (+ pos 2)) (aset block-low idx (+ (* (aref string pos) 256) 128))) ((= rem 2) (aset block-high idx (+ (* (aref string pos) 256) (aref string (1+ pos)))) (aset block-low idx 32768)) ((= rem 1) (aset block-high idx (+ (* (aref string pos) 256) 128)) (aset block-low idx 0)) (t ;; (= rem 0) (aset block-high idx 32768) (aset block-low idx 0))) (setq idx (1+ idx)) (while (< idx 16) (aset block-high idx 0) (aset block-low idx 0) (setq idx (1+ idx)))) ;; last block has enough room to write the length of string. (progn ;; write bit length of string to last 4 bytes of the block. (aset block-low 15 (* (% len 8192) 8)) (setq len (/ len 8192)) (aset block-high 15 (% len 65536)) ;; XXX: It is not practical to compute SHA1 of ;; such a huge message on emacs. ;; (setq len (/ len 65536)) ; for 64bit emacs. ;; (aset block-low 14 (% len 65536)) ;; (aset block-high 14 (/ len 65536)) (sha1-block block-high block-low)) ;; need one more block. (sha1-block block-high block-low) (fillarray block-high 0) (fillarray block-low 0) ;; write bit length of string to last 4 bytes of the block. (aset block-low 15 (* (% len 8192) 8)) (setq len (/ len 8192)) (aset block-high 15 (% len 65536)) ;; XXX: It is not practical to compute SHA1 of ;; such a huge message on emacs. ;; (setq len (/ len 65536)) ; for 64bit emacs. ;; (aset block-low 14 (% len 65536)) ;; (aset block-high 14 (/ len 65536)) (sha1-block block-high block-low)) ;; make output string (in binary form). (let ((result (make-string 20 0))) (aset result 0 (/ sha1-H0-high 256)) (aset result 1 (% sha1-H0-high 256)) (aset result 2 (/ sha1-H0-low 256)) (aset result 3 (% sha1-H0-low 256)) (aset result 4 (/ sha1-H1-high 256)) (aset result 5 (% sha1-H1-high 256)) (aset result 6 (/ sha1-H1-low 256)) (aset result 7 (% sha1-H1-low 256)) (aset result 8 (/ sha1-H2-high 256)) (aset result 9 (% sha1-H2-high 256)) (aset result 10 (/ sha1-H2-low 256)) (aset result 11 (% sha1-H2-low 256)) (aset result 12 (/ sha1-H3-high 256)) (aset result 13 (% sha1-H3-high 256)) (aset result 14 (/ sha1-H3-low 256)) (aset result 15 (% sha1-H3-low 256)) (aset result 16 (/ sha1-H4-high 256)) (aset result 17 (% sha1-H4-high 256)) (aset result 18 (/ sha1-H4-low 256)) (aset result 19 (% sha1-H4-low 256)) result)) ;; do not leave a copy of input string. (fillarray block-high nil) (fillarray block-low nil)))) (defun sha1-string-internal (string &optional binary) (if binary (sha1-binary string) (encode-hex-string (sha1-binary string)))) (defun sha1-region-internal (beg end &optional binary) (sha1-string-internal (buffer-substring-no-properties beg end) binary)) ;;; ;;; application interface. ;;; (defun sha1-region (beg end &optional binary) (if (and sha1-use-external sha1-maximum-internal-length (> (abs (- end beg)) sha1-maximum-internal-length)) (sha1-region-external beg end binary) (sha1-region-internal beg end binary))) (defun sha1-string (string &optional binary) (if (and sha1-use-external sha1-maximum-internal-length (> (length string) sha1-maximum-internal-length)) (sha1-string-external string binary) (sha1-string-internal string binary))) ;;;###autoload (defun sha1 (object &optional beg end binary) "Return the SHA1 (Secure Hash Algorithm) of an object. OBJECT is either a string or a buffer. Optional arguments BEG and END denote buffer positions for computing the hash of a portion of OBJECT. If BINARY is non-nil, return a string in binary form." (if (stringp object) (sha1-string object binary) (save-excursion (set-buffer object) (sha1-region (or beg (point-min)) (or end (point-max)) binary)))) (provide 'sha1-el) ;;; sha1-el.el ends here ���������flim-fee392e/sha1.el��������������������������������������������������������������������������������0000664�0000000�0000000�00000003472�11747036124�0014336�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; sha1.el --- SHA1 Secure Hash Algorithm. ;; Copyright (C) 1999, 2001 Free Software Foundation, Inc. ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; 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. ;; <URL:http://www.itl.nist.gov/div897/pubs/fip180-1.htm> ;; ;; (sha1 "abc") ;; => a9993e364706816aba3e25717850c26c9cd0d89d ;; ;; (sha1 "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq") ;; => 84983e441c3bd26ebaae4aa1f95129e5e54670f1 ;; ;; (sha1 (make-string 1000000 ?a)) ;; => 34aa973cd4c4daa4f61eeb2bdbad27316534016f ;;; Code: (defvar sha1-dl-module (cond ((and (fboundp 'sha1) (subrp (symbol-function 'sha1))) nil) ((fboundp 'dynamic-link) ;; Should we take care of `dynamic-link-path'? (let ((path (expand-file-name "sha1.so" exec-directory))) (if (file-exists-p path) path nil))) (t nil))) (cond ((and (stringp sha1-dl-module) (file-exists-p sha1-dl-module)) (require 'sha1-dl)) (t (require 'sha1-el))) (provide 'sha1) ;;; sha1.el ends here ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/smtp.el��������������������������������������������������������������������������������0000664�0000000�0000000�00000057317�11747036124�0014474�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; smtp.el --- basic functions to send mail with SMTP server ;; Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001 ,2002, 2004 ;; Free Software Foundation, Inc. ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp> ;; Simon Leinen <simon@switch.ch> (ESMTP support) ;; Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> ;; Daiki Ueno <ueno@unixuser.org> ;; 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 Message-ID." :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-starttls-ignore-error nil "If non-nil, do not use STARTTLS if STARTTLS is not available." :type 'boolean :group 'smtp-extensions) (defcustom smtp-starttls-program "starttls" "The program to run in a subprocess to open an TLSv1 connection." :group 'smtp-extensions) (defcustom smtp-starttls-extra-args nil "Extra arguments to `starttls-program'" :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." (save-excursion (set-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 ((system-name (system-name))) (cond (smtp-local-domain (concat system-name "." smtp-local-domain)) ((string-match "[^.]\\.[^.]" system-name) system-name) (t (error "Cannot generate valid FQDN")))))) (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")) (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 smtp-open-connection-function "SMTP" buffer server service)) connection) (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.") ;;;###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)) (starttls-program smtp-starttls-program) (starttls-extra-args smtp-starttls-extra-args) (smtp-open-connection-function (if smtp-use-starttls #'starttls-open-stream smtp-open-connection-function))) (save-excursion (set-buffer (get-buffer-create (format "*trace of SMTP session to %s*" server))) (erase-buffer) (buffer-disable-undo) (unless (smtp-find-connection (current-buffer)) (smtp-open-connection (current-buffer) server smtp-service)) (make-local-variable 'smtp-read-point) (setq smtp-read-point (point-min)) (funcall smtp-submit-package-function package))))) (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)) (smtp-open-connection-function (if smtp-use-starttls #'starttls-open-stream smtp-open-connection-function)) 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)) (save-excursion (set-buffer (get-buffer-create (format "*trace of SMTP session to %s*" server))) (erase-buffer) (buffer-disable-undo) (unless (smtp-find-connection (current-buffer)) (smtp-open-connection (current-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))) (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)) (sasl-step-set-data step (base64-decode-string (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))) 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)) (starttls-negotiate (smtp-connection-process-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)) (save-excursion (set-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) (save-excursion (set-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) (save-excursion (let ((process (smtp-connection-process-internal connection)) (encoder (smtp-connection-encoder-internal connection))) (set-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. (if (eq (string-to-char data) ?.) (setq data (concat "." data "\r\n")) (setq data (concat 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:<address>." (let ((simple-address-list "") this-line this-line-end addr-regexp (smtp-address-buffer (generate-new-buffer " *smtp-mail*"))) (unwind-protect (save-excursion ;; (set-buffer smtp-address-buffer) (setq case-fold-search t) (erase-buffer) (insert (save-excursion (set-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 ? t) ;; comma --> blank (subst-char-in-region (point-min) (point-max) ?, ? t) ;; tab --> blank (subst-char-in-region (point-min) (point-max) 9 ? 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 �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/smtpmail.el����������������������������������������������������������������������������0000664�0000000�0000000�00000024654�11747036124�0015335�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; smtpmail.el --- SMTP interface for mail-mode ;; Copyright (C) 1995, 1996, 1998, 1999, 2000 Free Software Foundation, Inc. ;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp> ;; Keywords: 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: ;; Send Mail to smtp host from smtpmail temp buffer. ;; Please add these lines in your .emacs(_emacs). ;; ;;(setq send-mail-function 'smtpmail-send-it) ;;(setq smtp-default-server "YOUR SMTP HOST") ;;(setq smtp-service "smtp") ;;(setq smtp-local-domain "YOUR DOMAIN NAME") ;;(setq smtp-debug-info t) ;;(autoload 'smtpmail-send-it "smtpmail") ;;(setq user-full-name "YOUR NAME HERE") ;; To queue mail, set smtpmail-queue-mail to t and use ;; smtpmail-send-queued-mail to send. ;;; Code: (require 'custom) (require 'smtp) (require 'sendmail) (require 'time-stamp) (require 'mel) ; binary-write-decoded-region, binary-find-file-noselect (eval-when-compile (require 'static)) (static-when (featurep 'xemacs) (define-obsolete-variable-alias 'smtpmail-default-smtp-server 'smtp-default-server) (define-obsolete-variable-alias 'smtpmail-smtp-server 'smtp-server) (define-obsolete-variable-alias 'smtpmail-smtp-service 'smtp-service) (define-obsolete-variable-alias 'smtpmail-local-domain 'smtp-local-domain) (define-obsolete-variable-alias 'smtpmail-debug-info 'smtp-debug-info) ) ;;; (defcustom smtpmail-queue-mail nil "Specify if mail is queued (if t) or sent immediately (if nil). If queued, it is stored in the directory `smtpmail-queue-dir' and sent with `smtpmail-send-queued-mail'." :type 'boolean :group 'smtp) (defcustom smtpmail-queue-dir "~/Mail/queued-mail/" "Directory where `smtpmail.el' stores queued mail." :type 'directory :group 'smtp) (defvar smtpmail-queue-index-file "index" "File name of queued mail index, This is relative to `smtpmail-queue-dir'.") (defvar smtpmail-queue-index (concat (file-name-as-directory smtpmail-queue-dir) smtpmail-queue-index-file)) (defvar smtpmail-recipient-address-list nil) ;;; ;;; ;;; ;;;###autoload (defun smtpmail-send-it () (require 'mail-utils) (let ((errbuf (if mail-interactive (generate-new-buffer " smtpmail errors") 0)) (tembuf (generate-new-buffer " smtpmail temp")) (case-fold-search nil) resend-to-addresses delimline (mailbuf (current-buffer))) (unwind-protect (save-excursion (set-buffer tembuf) (erase-buffer) (insert-buffer-substring mailbuf) (goto-char (point-max)) ;; require one newline at the end. (or (= (preceding-char) ?\n) (insert ?\n)) ;; Change header-delimiter to be what sendmail expects. (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) (replace-match "\n") (backward-char 1) (setq delimline (point-marker)) ;; (sendmail-synch-aliases) (if (and mail-aliases (fboundp 'expand-mail-aliases)) ; XEmacs (expand-mail-aliases (point-min) delimline)) (goto-char (point-min)) ;; ignore any blank lines in the header (while (and (re-search-forward "\n\n\n*" delimline t) (< (point) delimline)) (replace-match "\n")) (let ((case-fold-search t)) (goto-char (point-min)) (goto-char (point-min)) (while (re-search-forward "^Resent-to:" delimline t) (setq resend-to-addresses (save-restriction (narrow-to-region (point) (save-excursion (forward-line 1) (while (looking-at "^[ \t]") (forward-line 1)) (point))) (append (mail-parse-comma-list) resend-to-addresses)))) ;;; Apparently this causes a duplicate Sender. ;;; ;; If the From is different than current user, insert Sender. ;;; (goto-char (point-min)) ;;; (and (re-search-forward "^From:" delimline t) ;;; (progn ;;; (require 'mail-utils) ;;; (not (string-equal ;;; (mail-strip-quoted-names ;;; (save-restriction ;;; (narrow-to-region (point-min) delimline) ;;; (mail-fetch-field "From"))) ;;; (user-login-name)))) ;;; (progn ;;; (forward-line 1) ;;; (insert "Sender: " (user-login-name) "\n"))) ;; Don't send out a blank subject line (goto-char (point-min)) (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t) (replace-match "") ;; This one matches a Subject just before the header delimiter. (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t) (= (match-end 0) delimline)) (replace-match ""))) ;; Put the "From:" field in unless for some odd reason ;; they put one in themselves. (goto-char (point-min)) (if (not (re-search-forward "^From:" delimline t)) (let* ((login user-mail-address) (fullname (user-full-name))) (cond ((eq mail-from-style 'angles) (insert "From: " fullname) (let ((fullname-start (+ (point-min) 6)) (fullname-end (point-marker))) (goto-char fullname-start) ;; Look for a character that cannot appear unquoted ;; according to RFC 822. (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" fullname-end 1) (progn ;; Quote fullname, escaping specials. (goto-char fullname-start) (insert "\"") (while (re-search-forward "[\"\\]" fullname-end 1) (replace-match "\\\\\\&" t)) (insert "\"")))) (insert " <" login ">\n")) ((eq mail-from-style 'parens) (insert "From: " login " (") (let ((fullname-start (point))) (insert fullname) (let ((fullname-end (point-marker))) (goto-char fullname-start) ;; RFC 822 says \ and nonmatching parentheses ;; must be escaped in comments. ;; Escape every instance of ()\ ... (while (re-search-forward "[()\\]" fullname-end 1) (replace-match "\\\\\\&" t)) ;; ... then undo escaping of matching parentheses, ;; including matching nested parentheses. (goto-char fullname-start) (while (re-search-forward "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" fullname-end 1) (replace-match "\\1(\\3)" t) (goto-char fullname-start)))) (insert ")\n")) ((null mail-from-style) (insert "From: " login "\n"))))) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) (if (eval mail-mailer-swallows-blank-line) (newline)) ;; Find and handle any FCC fields. (goto-char (point-min)) (if (re-search-forward "^FCC:" delimline t) (mail-do-fcc delimline)) (if mail-interactive (save-excursion (set-buffer errbuf) (erase-buffer)))) ;; ;; ;; (setq smtpmail-recipient-address-list (or resend-to-addresses (smtp-deduce-address-list tembuf (point-min) delimline))) (smtpmail-do-bcc delimline) ; Send or queue (if (not smtpmail-queue-mail) (if smtpmail-recipient-address-list (smtp-send-buffer user-mail-address smtpmail-recipient-address-list tembuf) (error "Sending failed; no recipients")) (let* ((file-data (convert-standard-filename (concat (file-name-as-directory smtpmail-queue-dir) (time-stamp-yyyy-mm-dd) "_" (time-stamp-hh:mm:ss)))) (file-elisp (concat file-data ".el")) (buffer-data (create-file-buffer file-data)) (buffer-elisp (create-file-buffer file-elisp)) (buffer-scratch "*queue-mail*")) (save-excursion (set-buffer buffer-data) (erase-buffer) (insert-buffer tembuf) (or (file-directory-p smtpmail-queue-dir) (make-directory smtpmail-queue-dir t)) (binary-write-decoded-region (point-min) (point-max) file-data) (set-buffer buffer-elisp) (erase-buffer) (insert (concat "(setq smtpmail-recipient-address-list '" (prin1-to-string smtpmail-recipient-address-list) ")\n")) (write-file file-elisp) (set-buffer (generate-new-buffer buffer-scratch)) (insert (concat file-data "\n")) (append-to-file (point-min) (point-max) smtpmail-queue-index) ) (kill-buffer buffer-scratch) (kill-buffer buffer-data) (kill-buffer buffer-elisp)))) (kill-buffer tembuf) (if (bufferp errbuf) (kill-buffer errbuf))))) (defun smtpmail-send-queued-mail () "Send mail that was queued as a result of setting `smtpmail-queue-mail'." (interactive) ;;; Get index, get first mail, send it, get second mail, etc... (let ((buffer-index (find-file-noselect smtpmail-queue-index)) (file-msg "") (tembuf nil)) (save-excursion (set-buffer buffer-index) (beginning-of-buffer) (while (not (eobp)) (setq file-msg (buffer-substring (point) (save-excursion (end-of-line) (point)))) (load file-msg) (setq tembuf (binary-find-file-noselect file-msg)) (if smtpmail-recipient-address-list (smtp-send-buffer user-mail-address smtpmail-recipient-address-list tembuf) (error "Sending failed; no recipients")) (delete-file file-msg) (delete-file (concat file-msg ".el")) (kill-buffer tembuf) (kill-line 1)) (set-buffer buffer-index) (save-buffer smtpmail-queue-index) (kill-buffer buffer-index) ))) (defun smtpmail-do-bcc (header-end) "Delete BCC: and their continuation lines from the header area. There may be multiple BCC: lines, and each may have arbitrarily many continuation lines." (let ((case-fold-search t)) (save-excursion (goto-char (point-min)) ;; iterate over all BCC: lines (while (re-search-forward "^BCC:" header-end t) (delete-region (match-beginning 0) (progn (forward-line 1) (point))) ;; get rid of any continuation lines (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) (replace-match "")) ) ) ;; save-excursion ) ;; let ) ;;; (provide 'smtpmail) ;;; smtpmail.el ends here ������������������������������������������������������������������������������������flim-fee392e/std11.el�������������������������������������������������������������������������������0000664�0000000�0000000�00000062013�11747036124�0014432�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;;; std11.el --- STD 11 functions for GNU Emacs ;; Copyright (C) 1995,96,97,98,99,2000,01,02 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <tomo@m17n.org> ;; 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 'custom) ; std11-lexical-analyzer ;;; @ 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. If BOUNDARY is not nil, it is used as message header separator." (narrow-to-region (goto-char (point-min)) (if (re-search-forward (concat "^\\(" (regexp-quote (or boundary "")) "\\)?$") nil t) (match-beginning 0) (point-max) ))) ;;;###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 (while (setq field-name (car field-names)) (goto-char (point-min)) (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))) (if (string-match regexp field) (setq header (concat header field "\n")) )) 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 (concat header field "\n")) )) 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 ;;; ;;;###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 (concat dest (substring string p (match-beginning 0)) (substring string (match-beginning 1) (setq p (match-end 0))) )) ) (concat dest (substring string p)) )) ;;; @ quoted-string ;;; (defun std11-wrap-as-quoted-pairs (string specials) (let (dest (i 0) (b 0) (len (length string)) ) (while (< i len) (let ((chr (aref string i))) (if (memq chr specials) (setq dest (concat dest (substring string b i) "\\") b i) )) (setq i (1+ i)) ) (concat dest (substring string b)) )) (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) (let ((chr (aref string i))) (if (eq chr ?\\) (setq dest (concat dest (substring string b i)) b (1+ i) i (+ i 2)) (setq i (1+ i)) ))) (concat dest (substring string b)) )) (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 ;;; (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 '(? ?\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." (or analyzer (setq analyzer std11-lexical-analyzer)) (or start (setq start 0)) (let ((len (length string)) dest ret) (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) (let ((type (car token))) (or (eq type 'spaces)(eq type 'comment)) )) (defun std11-parse-token (lal) (let (token itl) (while (and lal (progn (setq token (car lal)) (std11-ignored-token-p token) )) (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 (progn (setq token (car lal)) (eq (car token) '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)) (progn (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) ;;; @ composer ;;; (defun std11-addr-to-string (seq) "Return string from lexical analyzed list SEQ represents addr-spec of RFC 822." (mapconcat (function (lambda (token) (let ((name (car token))) (cond ((eq name 'spaces) "") ((eq name 'comment) "") ((eq name 'quoted-string) (concat "\"" (cdr token) "\"")) ((eq name 'domain-literal) (concat "[" (cdr token) "]")) (t (cdr token))) ))) seq "") ) ;;;###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 (concat dest (if (stringp (car value)) (car value) (concat "(" (std11-comment-value-to-string (cdr (car value))) ")") )) value (cdr value)) ) 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 (function (lambda (token) (cdr token) )) (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 (function (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 (concat dest "\n " str) column (1+ len)) (setq dest str column (+ column len)) )) (setq dest (concat dest (cdr (car lal))) 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 (concat dest "\n " str) column len) (setq dest (concat dest " " str) column (+ column len)) )) (setq dest (concat dest (cdr (car lal))) lal (cdr lal)) ))) 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 ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/tests/���������������������������������������������������������������������������������0000775�0000000�0000000�00000000000�11747036124�0014314�5����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/tests/test-hmac-md5.el�����������������������������������������������������������������0000664�0000000�0000000�00000003642�11747036124�0017213�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������(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"))) ����������������������������������������������������������������������������������������������flim-fee392e/tests/test-hmac-sha1.el����������������������������������������������������������������0000664�0000000�0000000�00000003761�11747036124�0017364�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������(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"))) ���������������flim-fee392e/tests/test-rfc2231.el������������������������������������������������������������������0000664�0000000�0000000�00000015456�11747036124�0016710�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������(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"))))) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������flim-fee392e/tests/test-sasl.el���������������������������������������������������������������������0000664�0000000�0000000�00000010252�11747036124�0016555�0����������������������������������������������������������������������������������������������������ustar�00root����������������������������root����������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������(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 "<t4n4Pab9HB0Am/QLXB72eg@eleanor.innosoft.com>") (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 )) ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������