From 770d60c548483b13c481d3973285fbfebe2e0731 Mon Sep 17 00:00:00 2001 From: okada Date: Fri, 22 Dec 2000 08:06:57 +0000 Subject: [PATCH] Sync up with flim-1_14. --- ChangeLog | 688 ++++++++++++++++++++++++++++++++++------- FLIM-API.en | 923 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ FLIM-CFG | 3 +- FLIM-ELS | 26 +- FLIM-MK | 46 +-- Makefile | 6 +- README.en | 20 +- README.ja | 22 +- VERSION | 2 +- eword-decode.el | 36 +-- eword-encode.el | 125 +++----- luna.el | 246 +++++++++------ mailcap.el | 1 + mel-b-ccl.el | 12 +- mel-g.el | 42 +-- mel-q-ccl.el | 10 +- mel-q.el | 4 +- mel-u.el | 51 +-- mel.el | 34 +- mime-def.el | 63 +++- mime-parse.el | 1 + mime.el | 23 +- mmbuffer.el | 31 +- mmdbuffer.el | 187 ----------- mmexternal.el | 9 +- mmgeneric.el | 4 + qmtp.el | 16 +- raw-io.el | 116 +++++++ sha1.el | 3 +- smtp.el | 236 +++++++------- smtpmail.el | 8 +- std11.el | 11 +- 32 files changed, 2221 insertions(+), 784 deletions(-) create mode 100644 FLIM-API.en delete mode 100644 mmdbuffer.el create mode 100644 raw-io.el diff --git a/ChangeLog b/ChangeLog index 86e79cf..63e1958 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,378 @@ +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 @@ -6,152 +381,241 @@ 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. + * 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'. -2000-11-26 Kenichi OKADA + * FLIM-ELS (flim-modules): Add `mime-conf' instead of `mailcap'. + (flim-version-specific-modules): New variable; specify `mailcap'. - * SLIM: Version 1.14.4 released. - * mime-def.el (mime-library-product): Up. - * SLIM-VERSION: Added. + * FLIM-CFG (FLIM_VERSION_SPECIFIC_DIR): New variable. -2000-11-22 Kenichi OKADA + * mailcap.el: Completely rewrote to use mime-conf.el. - * smtp.el (smtp-primitive-starttls): Call `smtp-primitive-helo' - after `starttls-negotiate'. + * mime-conf.el: New file. -2000-11-20 Kenichi OKADA +2000-11-16 Kenichi OKADA * sasl-digest.el (sasl-digest-md5-response): Fix typo. -2000-11-20 Kenichi OKADA +2000-11-12 Daiki Ueno - * FLIM-ELS (flim-modules): Add `sasl-cram', `sasl-digest' , `qmtp'. - Remove `digest-md5'. - * sasl.el: sync up with flim-1_14. - * smtp.el: sync up with flim-1_14. - * qmtp.el: New file. - * sasl-cram.el: New file. - * sasl-digest.el: New file. - * digest-md5.el: Delete. + * 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-10-20 Kenichi OKADA +2000-11-10 Daiki Ueno - * SLIM: Version 1.14.3 released. + * 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-09-21 Kenichi OKADA +2000-11-07 Kenichi OKADA - * smtp.el (smtp-via-smtp): Cause an error if `smtp-notify-success' - is not available. + * sasl.el (sasl-login-response-1): Fix. + (sasl-login-response-2): Fix. -2000-09-18 KUSANO Takayuki +2000-11-07 Daiki Ueno - * smtp.el (smtp-via-smtp): Check `service extensions' for DSN. + * smtp.el (smtp-sasl-properties): New user option. + (smtp-sasl-user-realm): Abolish. -2000-09-21 Kenichi OKADA +2000-11-05 Daiki Ueno - * mime-def.el (mime-library-product): Up. - * SLIM-VERSION: Up. + * qmtp.el (qmtp-send-package): Don't check "K" reply per recipient. + (qmtp-via-smtp): Mark as obsolete. + (qmtp-send-buffer): New function. - -2000-09-16 Kenichi OKADA + * sasl.texi: New file. - * SLIM: Version 1.14.2 released. +2000-11-05 Daiki Ueno -2000-08-28 Yuuichi Teranishi + * sasl.el (sasl-step-data): New function. + (sasl-step-set-data): New function. - * 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'. +2000-11-04 Daiki Ueno - * std11.el (std11-address-string): Fix for group list. + * 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-08-23 Kenichi OKADA +2000-11-04 Daiki Ueno - * smtp.el (smtp-fqdn): New variable. - (smtp-make-fqdn): Use `smtp-fqdn' if non-nil. + * 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-08-23 Kenichi OKADA +2000-11-02 Daiki Ueno - * mime-def.el (mime-library-product): Up. - * SLIM-VERSION: Up. + * 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. - -2000-08-12 Kenichi OKADA + * smtp.el (smtp-sasl-user-name): Rename from + `smtp-sasl-principal-user'. + (smtp-sasl-user-realm): Rename from `smtp-sasl-principal-realm'. - * SLIM: Version 1.14.1 released. - SLIM-TIPS: Update. +2000-11-02 Daiki Ueno -2000-08-12 Kenichi OKADA + * 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. - * starttls.el (starttls-open-stream): Put `starttls-extra-args' on - the last arg. + * smtp.el (smtp-error): Define. + (smtp-via-smtp): Use it. -2000-08-11 Kenichi OKADA +2000-11-02 Daiki Ueno - * starttls.el (starttls-open-ssl-stream): New function. - (starttls-open-stream): Move `starttls-extra-args'. + * smtp.el (smtp-via-smtp): Mark as obsolete. + (smtp-send-buffer): Rename from `smtp-via-smtp'. -2000-07-12 Kenichi OKADA +2000-11-02 Daiki Ueno - * mime-def.el (mime-library-product): Up. + * sasl.el (sasl-make-authenticator): Allocate a freshly generated + symbol for each continuation. - -2000-07-12 Kenichi OKADA +2000-11-02 Daiki Ueno - * SLIM: Version 1.14.0 released. - (Sync with FLIM-Chao 1.14.1). + * 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. -2000-07-12 Kenichi OKADA + * sasl.el (sasl-mechanism-alist): Rename from `sasl-mechanisms'. + (sasl-mechanisms): New variable. + (sasl-find-authenticator): Check `sasl-mechanisms' rather than + `sasl-mechanism-alist'. - * md5-dl.el (TopLevel): Define-maybe - `md5-string', `dynamic-link' and `dynamic-call'. - * sha1-dl.el (TopLevel): Define-maybe `dynamic-link' and `dynamic-call'. - * md5-el.el (TopLevel): Provide `md5-el' instead of `md5'. - * md5.el (TopLevel): Require `md5-el' and `md5-dl'. + * smtp.el (smtp-submit-package): Use `smtp-primitive-ehlo'. + (smtp-primitive-auth): Check authenticator. -2000-07-10 MORIOKA Tomohiko +2000-11-02 Daiki Ueno - * mmexternal.el (initialize-instance): Deleted. - (mmexternal-require-file-name): New function. - (mmexternal-require-buffer): Use `mmexternal-require-file-name'. + * FLIM-ELS (hmac-modules): New variable. + (flim-modules): Move HMAC modules to `hmac-modules' + - Add `sasl-digest'. -2000-06-30 MORIOKA Tomohiko + * smtp.el (smtp-sasl-principal-realm): New user option. - * mime.el (mime-entity-read-field): Fix a bug when FIELD-NAME is a - string. + * 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. -2000-06-27 Kenichi OKADA + * sasl-digest.el: New file. - * smtp.el (smtp-via-smtp): additional HELO for sendmail warning. +2000-11-01 Daiki Ueno -2000-06-25 Kenichi OKADA + * 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. - * SLIM-VERION: Add code name. + * sasl.el: New implementation. -2000-06-24 Kenichi OKADA + * sasl-cram.el: New file. - * mime-def.el (mime-library-product): Fix. + * FLIM-ELS (flim-modules): Add `md5', `md5-el', `md5-dl', + `hex-util', `hmac-def', `hmac-md5', `sasl' and `sasl-cram'. -2000-06-24 Kenichi OKADA +2000-11-01 Daiki Ueno - * mime-def.el (mime-library-product): Up. + * 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ò)-A released. + +2000-07-10 MORIOKA Tomohiko + + * mmexternal.el (initialize-instance): Deleted. + (mmexternal-require-file-name): New function. + (mmexternal-require-buffer): Use `mmexternal-require-file-name'. + +2000-06-30 MORIOKA Tomohiko + + * mime.el (mime-entity-read-field): Fix a bug when FIELD-NAME is a + string. 2000-06-23 MORIOKA Tomohiko @@ -1216,7 +1680,7 @@ 1999-05-31 MORIOKA Tomohiko - * FLIM: Version 1.12.7 (Y-D~zaki) released. + * FLIM: Version 1.12.7 (Y-Dþzaki)-A released. 1999-05-31 MORIOKA Tomohiko @@ -1391,7 +1855,7 @@ 1999-05-11 MORIOKA Tomohiko - * FLIM: Version 1.12.6 (Family-K-Drenmae) released. + * FLIM: Version 1.12.6 (Family-K-Dòenmae)-A released. 1999-04-27 Shuhei KOBAYASHI @@ -1508,7 +1972,7 @@ 1999-01-23 MORIOKA Tomohiko - * FLIM: Version 1.12.3 (Kintetsu-K-Drriyama) released. + * FLIM: Version 1.12.3 (Kintetsu-K-Dòriyama)-A released. 1999-01-23 MORIOKA Tomohiko @@ -1551,7 +2015,7 @@ 1999-01-21 MORIOKA Tomohiko - * FLIM: Version 1.12.2 (Kuj-Dr) released. + * FLIM: Version 1.12.2 (Kuj-Dò)-A released. 1999-01-16 MORIOKA Tomohiko @@ -1737,7 +2201,7 @@ 1998-12-02 MORIOKA Tomohiko - * FLIM: Version 1.12.1 (Nishinoky-Dr) released. + * FLIM: Version 1.12.1 (Nishinoky-Dò)-A released. 1998-11-30 MORIOKA Tomohiko @@ -1955,7 +2419,7 @@ 1998-10-26 MORIOKA Tomohiko - * FLIM: Version 1.11.2 (Heij-Dr) was released. + * FLIM: Version 1.11.2 (Heij-Dò)-A was released. * NEWS (Abolish variable `mime-temp-directory'): New subsection. @@ -2235,7 +2699,7 @@ 1998-10-12 MORIOKA Tomohiko - * FLIM: Version 1.10.4 (Shin-H-Drsono) was released. + * FLIM: Version 1.10.4 (Shin-H-Dòsono)-A was released. 1998-10-12 Katsumi Yamaoka @@ -2420,7 +2884,7 @@ 1998-09-29 MORIOKA Tomohiko - * FLIM: Version 1.10.0 (K-Drdo) was released. + * FLIM: Version 1.10.0 (K-Dòdo)-A was released. * README.en (What's FLIM): Add mel-ccl.el. @@ -2707,7 +3171,7 @@ 1998-08-31 MORIOKA Tomohiko - * FLIM: Version 1.9.1 (Tonosh-Dr) was released. + * FLIM: Version 1.9.1 (Tonosh-Dò)-A was released. * mime-en.sgml (mm-backend): Translate a little. @@ -2850,7 +3314,7 @@ 1998-07-07 MORIOKA Tomohiko - * FLIM-Chao: Version 1.8.0 (Shij-Dr) was released. + * FLIM-Chao: Version 1.8.0 (Shij-Dò)-A was released. 1998-07-07 MORIOKA Tomohiko @@ -2962,7 +3426,7 @@ 1998-07-01 MORIOKA Tomohiko - * FLIM: Version 1.8.0 (-DRkubo) was released. + * FLIM: Version 1.8.0 (-DÒkubo)-A was released. * README.en: Delete `How to use'. @@ -3087,7 +3551,7 @@ 1998-06-28 MORIOKA Tomohiko - * FLIM-Chao: Version 1.7.0 (Goj-Dr) was released. + * FLIM-Chao: Version 1.7.0 (Goj-Dò)-A was released. 1998-06-26 MORIOKA Tomohiko @@ -3346,7 +3810,7 @@ 1998-06-19 MORIOKA Tomohiko - * FLIM: Version 1.4.1 (Momoyama-Gory-Drmae) was released. + * FLIM: Version 1.4.1 (Momoyama-Gory-Dòmae)-A was released. 1998-06-18 MORIOKA Tomohiko @@ -3466,7 +3930,7 @@ 1998-05-06 MORIOKA Tomohiko - * FLIM: Version 1.2.0 (J-D~jr) was released. + * FLIM: Version 1.2.0 (J-Dþjò)-A was released. * README.en (What's FLIM): Delete description about std11-parse.el; add description about mailcap.el. @@ -3517,7 +3981,7 @@ 1998-05-05 MORIOKA Tomohiko - * FLIM: Version 1.1.0 (T-Drji) was released. + * FLIM: Version 1.1.0 (T-Dòji)-A was released. 1998-05-04 MORIOKA Tomohiko @@ -3553,7 +4017,7 @@ 1998-04-17 MORIOKA Tomohiko - * FLIM: Version 1.0.1 (Ky-Drto) was released. + * FLIM: Version 1.0.1 (Ky-Dòto)-A was released. * mime-def.el (mime-spadework-module-version-string): New constant. diff --git a/FLIM-API.en b/FLIM-API.en new file mode 100644 index 0000000..623ca7b --- /dev/null +++ b/FLIM-API.en @@ -0,0 +1,923 @@ + FLIM (Faithful Library about Internet Message) API + Version 1.14 + Draft Release 1 + +* 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 &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. + + [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] [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] + + +** Decoder + +[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-decode-region (start end encoding) + Decode region START to END of current buffer using ENCODING. + + ENCODING must be string. + + [Suggest] + + +[Function] 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] + + +** Encoder + +[Function] mime-encode-string (string encoding) + Encode STRING using ENCODING. + + ENCODING must be string. + + [Optional] + + +[Function] mime-encode-region (start end encoding) + Encode region START to END of current buffer using ENCODING. + + ENCODING must be string. + + [Suggest] + + +[Function] mime-insert-encoded-file (filename encoding) + Insert file FILENAME encoded by ENCODING format. + + [Required] + + +** 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 parsing + +** How to use + +(require 'mime) + + +** Level 2 features + +[Variable] mime-field-parser-alist + Alist to specify field parser. + + +[Function] mime-parse-Content-Type (string) + Parse STRING as field-body of Content-Type field. + +Return value is + (PRIMARY-TYPE SUBTYPE (NAME1 . VALUE1)(NAME2 . VALUE2) ...) +or nil. PRIMARY-TYPE and SUBTYPE are symbol and NAME_n and VALUE_n +are string. + + +[Function] mime-read-Content-Type () + Read field-body of Content-Type field from current-buffer, +and return parsed it. Format of return value is as same as +`mime-parse-Content-Type'. + + +[Function] mime-parse-Content-Disposition (string) + Parse STRING as field-body of Content-Disposition field. + + +[Function] mime-read-Content-Disposition () + Read field-body of Content-Disposition field from current-buffer, +and return parsed it. + + +[Function] mime-parse-Content-Transfer-Encoding (string) + Parse STRING as field-body of Content-Transfer-Encoding field. + + +[Function] mime-read-Content-Transfer-Encoding (&optional default-encoding) + Read field-body of Content-Transfer-Encoding field from +current-buffer, and return it. + +If is is not found, return DEFAULT-ENCODING. + + +[Function] mime-parse-msg-id (tokens) + Parse TOKENS as msg-id of Content-Id or Message-Id field. + + +[Function] mime-uri-parse-cid (string) + Parse STRING as cid URI. + + +* STD 11 parsing + +** How to use + +(require 'std11) + + +** Level 1 features + +[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. + + +[Function] std11-narrow-to-header (&optional boundary) + Narrow to the message header. + +If BOUNDARY is not nil, it is used as message header separator. + + +[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. + + +[Function] std11-unfold-string (string) + Unfold STRING as message header field. + + +** Level 2 features + +[Function] std11-lexical-analyze (string &optional analyzer start) + Analyze STRING as lexical tokens of STD 11. + + +[Function] std11-address-string (address) + Return string of address part from parsed ADDRESS of RFC 822. + + +[Function] std11-full-name-string (address) + Return string of full-name part from parsed ADDRESS of RFC 822. + + +[Function] std11-msg-id-string (msg-id) + Return string from parsed MSG-ID of RFC 822. + + +[Function] std11-fill-msg-id-list-string (string &optional column) + Fill list of msg-id in STRING, and return the result. + + +[Function] std11-parse-address-string (string) + Parse STRING as mail address. + + +[Function] std11-parse-addresses-string (string) + Parse STRING as mail address list. + + +[Function] std11-parse-msg-id-string (string) + Parse STRING as msg-id. + + +[Function] std11-parse-msg-ids-string (string) + Parse STRING as `*(phrase / msg-id)'. + + +[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. + + +* 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] diff --git a/FLIM-CFG b/FLIM-CFG index 965c7b8..8a314fd 100644 --- a/FLIM-CFG +++ b/FLIM-CFG @@ -13,8 +13,7 @@ (progn (add-to-list 'default-load-path LISPDIR) (add-to-list 'load-path LISPDIR) - (add-to-list 'load-path (expand-file-name "apel" LISPDIR)) - )) + (add-to-list 'load-path (expand-file-name "apel" LISPDIR)))) (if (boundp 'VERSION_SPECIFIC_LISPDIR) (add-to-list 'load-path VERSION_SPECIFIC_LISPDIR)) diff --git a/FLIM-ELS b/FLIM-ELS index 6eeb3c9..cb181e1 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -5,26 +5,23 @@ ;;; Code: (setq flim-modules '(std11 - luna mime-def + luna lunit mime-def mel mel-q mel-u mel-g eword-decode eword-encode mime mime-parse mmgeneric mmbuffer mmcooked mmdbuffer mmexternal mime-conf + unique-id scram-md5 sasl sasl-cram sasl-digest - scram-md5 unique-id - smtp qmtp smtpmail)) + smtp qmtp smtpmail + raw-io)) (setq flim-version-specific-modules '(mailcap)) (setq hmac-modules '(hex-util - hmac-def - md5 md5-el md5-dl - sha1 sha1-el sha1-dl + hmac-def md5 sha1 hmac-md5 hmac-sha1)) -(setq flim-modules (nconc hmac-modules flim-modules)) - (if (and (fboundp 'base64-encode-string) (subrp (symbol-function 'base64-encode-string))) nil @@ -36,4 +33,17 @@ (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 diff --git a/FLIM-MK b/FLIM-MK index 5038f50..701ff61 100644 --- a/FLIM-MK +++ b/FLIM-MK @@ -8,54 +8,62 @@ (let (prefix lisp-dir version-specific-lisp-dir) (and (setq prefix (car command-line-args-left)) (or (string-equal "NONE" prefix) - (defvar PREFIX 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) - )) + (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))) - )) + 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)) - )) +LISPDIR=%s\n" PREFIX LISPDIR)))) (defun compile-flim () (config-flim) (compile-elisp-modules flim-version-specific-modules ".") - (compile-elisp-modules flim-modules ".") - ) + (compile-elisp-modules flim-modules ".")) (defun install-flim () (config-flim) (install-elisp-modules flim-version-specific-modules "./" FLIM_VERSION_SPECIFIC_DIR) - (install-elisp-modules flim-modules "./" FLIM_DIR) - ) + (install-elisp-modules flim-modules "./" FLIM_DIR)) + +(defun check-flim () + (config-flim) + (require 'lunit) + (let ((files (directory-files "tests" t)) + (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) - )) + (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)) - )) + (princ (format "PACKAGEDIR=%s\n" PACKAGEDIR)))) (defun compile-flim-package () (config-flim-package) @@ -68,8 +76,7 @@ LISPDIR=%s\n" PREFIX LISPDIR)) (Custom-make-dependencies) (compile-elisp-modules flim-version-specific-modules ".") - (compile-elisp-modules flim-modules ".") - ) + (compile-elisp-modules flim-modules ".")) (defun install-flim-package () (config-flim-package) @@ -80,7 +87,6 @@ LISPDIR=%s\n" PREFIX LISPDIR)) (expand-file-name "lisp" PACKAGEDIR))) (delete-file "./auto-autoloads.el") - (delete-file "./custom-load.el") - ) + (delete-file "./custom-load.el")) ;;; FLIM-MK ends here diff --git a/Makefile b/Makefile index c90ab4e..0a1df22 100644 --- a/Makefile +++ b/Makefile @@ -33,6 +33,10 @@ 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) @@ -50,7 +54,7 @@ clean: tar: cvs commit - sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) | tr . _`; \ + sh -c 'cvs tag -R $(PACKAGE)-`echo $(VERSION) | tr . _`; \ cd /tmp; \ cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root \ export -d $(PACKAGE)-$(VERSION) \ diff --git a/README.en b/README.en index 8ded084..da9875d 100644 --- a/README.en +++ b/README.en @@ -35,6 +35,11 @@ What's FLIM mailcap.el --- mailcap parser and utility + This library should work on: + + Emacs 20.4 and up + XEmacs 21.1 and up + Installation ============ @@ -127,21 +132,6 @@ Installation Notice that XEmacs package system requires XEmacs 21.0 or later. -load-path (for Emacs or MULE) -============================= - - If you are using Emacs or Mule, please add directory of FLIM to - load-path. If you install by default setting, you can write - subdirs.el for example: - - -------------------------------------------------------------------- - (normal-top-level-add-to-load-path '("apel" "flim")) - -------------------------------------------------------------------- - - If you are using XEmacs, there are no need of setting about - load-path. - - Bug reports =========== diff --git a/README.ja b/README.ja index 5327de3..b9592ba 100644 --- a/README.ja +++ b/README.ja @@ -33,6 +33,11 @@ FLIM $B$H$O!)(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 (install) ============== @@ -78,10 +83,11 @@ FLIM $B$H$O!)(B `PREFIX=...' $B$,>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 19.34 $B$,;XDj$5$l$l$P!"0J2<$N%G%#%l(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! $(B6aE4(B $(B@>ED86K\(B 1.13.2 Kasanui $(B3^K%(B 1.14.0 Ninokuchi $(B?7%N8}(B ------- Yagi $(BH,LZ(B ; = $(B6aE4(B $(BBg:e@~(B +1.14.1 Yagi $(BH,LZ(B ; = $(B6aE4(B $(BBg:e@~(B ------ Yagi-Nishiguchi $(BH,LZ@>8}(B ------ Unebigory-Dòmae-A $(B@&K58fNMA0(B ------ Kashiharajingu-mae $(B3`86?@5\A0(B ; = $(B6aE4(B $(BFnBg:e@~!"5HLn@~(B diff --git a/eword-decode.el b/eword-decode.el index dd46d32..0fc7d33 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -1,10 +1,10 @@ ;;; eword-decode.el --- RFC 2047 based encoded-word decoder for GNU Emacs -;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc. ;; Author: ENAMI Tsugutomo -;; MORIOKA Tomohiko -;; TANAKA Akira +;; 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 @@ -38,15 +38,11 @@ (eval-when-compile (require 'cl)) ; list*, pop -(defgroup eword-decode nil - "Encoded-word decoding" - :group 'mime) -(defcustom eword-max-size-to-decode 1000 - "*Max size to decode header field." - :group 'eword-decode - :type '(choice (integer :tag "Limit (bytes)") - (const :tag "Don't limit" nil))) +;;; @ Variables +;;; + +;; User options are defined in mime-def.el. ;;; @ MIME encoded-word definition @@ -152,8 +148,8 @@ decode the charset included in it, it is not decoded." start-column &optional max-column start) - (if (and eword-max-size-to-decode - (> (length string) eword-max-size-to-decode)) + (if (and mime-field-decoding-max-size + (> (length string) mime-field-decoding-max-size)) string (or max-column (setq max-column fill-column)) @@ -270,7 +266,7 @@ such as a version of Net$cape)." ;;;###autoload (defun mime-set-field-decoder (field &rest specs) - "Set decoder of FILED. + "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." @@ -505,8 +501,8 @@ If SEPARATOR is not nil, it is used as header separator." )) code-conversion)) -(define-obsolete-function-alias 'eword-decode-header - 'mime-decode-header-in-buffer) +(defalias 'eword-decode-header 'mime-decode-header-in-buffer) +(make-obsolete 'eword-decode-header 'mime-decode-header-in-buffer) ;;; @ encoded-word decoder @@ -594,7 +590,7 @@ as a version of Net$cape)." "*Max position of eword-lexical-analyze-cache. It is max size of eword-lexical-analyze-cache - 1.") -(defcustom eword-lexical-analyzer +(defvar mime-header-lexical-analyzer '(eword-analyze-quoted-string eword-analyze-domain-literal eword-analyze-comment @@ -614,9 +610,7 @@ 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." - :group 'eword-decode - :type '(repeat function)) +be the result.") (defun eword-analyze-quoted-string (string start &optional must-unfold) (let ((p (std11-check-enclosure string ?\" ?\" nil start))) @@ -747,7 +741,7 @@ be the result." dest ret) (while (< start len) (setq ret - (let ((rest eword-lexical-analyzer) + (let ((rest mime-header-lexical-analyzer) func r) (while (and (setq func (car rest)) (null diff --git a/eword-encode.el b/eword-encode.el index f7111c1..f075db3 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -1,8 +1,8 @@ ;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs -;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: encoded-word, MIME, multilingual, header, mail, news ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -33,39 +33,9 @@ ;;; @ variables ;;; -(defgroup eword-encode nil - "Encoded-word encoding" - :group 'mime) - -(defcustom eword-field-encoding-method-alist - '(("X-Nsubject" . iso-2022-jp-2) - ("Newsgroups" . nil) - ("Message-ID" . nil) - (t . mime) - ) - "*Alist to specify field encoding method. -Its key is field-name, value is encoding method. - -If method is `mime', this field will be encoded into MIME format. - -If method is a MIME-charset, this field will be encoded as the charset -when it must be convert into network-code. - -If method is `default-mime-charset', this field will be encoded as -variable `default-mime-charset' when it must be convert into -network-code. - -If method is nil, this field will not be encoded." - :group 'eword-encode - :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))))) - -(defvar eword-charset-encoding-alist +;; 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") @@ -89,6 +59,8 @@ If method is nil, this field will not be encoded." (utf-8 . "B") )) +(defvar mime-header-default-charset-encoding "Q") + ;;; @ encoded-text encoder ;;; @@ -99,7 +71,7 @@ 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))) + (let ((text (encoded-text-encode-string string encoding mode))) (if text (concat "=?" (upcase (symbol-name charset)) "?" encoding "?" text "?=") @@ -119,21 +91,23 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (let ((len (length string)) dest) (while (> len 0) - (let* ((chr (sref string 0)) + (let* ((chr (aref string 0)) + ;; (chr (sref string 0)) (charset (eword-encode-char-type chr)) - (i (char-length chr))) + (i 1) + ;; (i (char-length chr)) + ) (while (and (< i len) - (setq chr (sref string i)) - (eq charset (eword-encode-char-type chr)) - ) - (setq i (char-next-index chr i)) + (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) - )) + len (- len i)))) + (nreverse dest))) ;;; @ word @@ -187,10 +161,10 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (defun ew-find-charset-rule (charsets) (if charsets (let* ((charset (find-mime-charset-by-charsets charsets)) - (encoding (cdr (or (assq charset eword-charset-encoding-alist) - '(nil . "Q"))))) - (list charset encoding) - ))) + (encoding + (cdr (or (assq charset mime-header-charset-encoding-alist) + (cons charset mime-header-default-charset-encoding))))) + (list charset encoding)))) (defun tm-eword::words-to-ruled-words (wl &optional mode) (mapcar (function @@ -312,7 +286,8 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (str "") nstr) (while (and (< p len) (progn - (setq np (char-next-index (sref string p) p)) + (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)) @@ -401,7 +376,7 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (append dest (list (let ((ret (ew-find-charset-rule - (find-non-ascii-charset-string str)))) + (find-charset-string str)))) (make-ew-rword str (car ret)(nth 1 ret) 'phrase) ) @@ -464,7 +439,8 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (if (or (eq pname 'spaces) (eq pname 'comment)) (nconc dest (list (list (cdr token) nil nil))) - (nconc (butlast dest) + (nconc (nreverse (cdr (reverse dest))) + ;; (butlast dest) (list (list (concat (car (car (last dest))) (cdr token)) @@ -575,10 +551,8 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is ;;; @ application interfaces ;;; -(defcustom eword-encode-default-start-column 10 - "Default start column if it is omitted." - :group 'eword-encode - :type 'integer) +(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. @@ -621,7 +595,8 @@ Optional argument COLUMN is start-position of the field." (or column eword-encode-default-start-column) (eword-encode-split-string string 'text)))) -(defun eword-encode-field-body (field-body field-name) +;;;###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." @@ -640,27 +615,25 @@ encoded-word. ASCII token is not encoded." Resent-Sender To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc)) - (eword-encode-address-list field-body start) - ) + (eword-encode-address-list field-body start)) ((eq field-name 'In-Reply-To) - (eword-encode-in-reply-to field-body start) - ) + (eword-encode-in-reply-to field-body start)) ((memq field-name '(Mime-Version User-Agent)) - (eword-encode-structured-field-body field-body start) - ) + (eword-encode-structured-field-body field-body start)) (t - (eword-encode-unstructured-field-body field-body start) - )) - ))) + (eword-encode-unstructured-field-body field-body start)))))) +(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 eword-field-encoding-method-alist)) + (let ((alist mime-field-encoding-method-alist)) (catch 'found (while alist (let* ((pair (car alist)) @@ -670,13 +643,14 @@ encoded-word. ASCII token is not encoded." (throw 'found (cdr pair)) )) (setq alist (cdr alist))) - (cdr (assq t eword-field-encoding-method-alist)) + (cdr (assq t mime-field-encoding-method-alist)) ))) -(defun eword-encode-header (&optional code-conversion) +;;;###autoload +(defun mime-encode-header-in-buffer (&optional code-conversion) "Encode header fields to network representation, such as MIME encoded-word. -It refer variable `eword-field-encoding-method-alist'." +It refer variable `mime-field-encoding-method-alist'." (interactive "*") (save-excursion (save-restriction @@ -688,7 +662,7 @@ It refer variable `eword-field-encoding-method-alist'." (setq bbeg (match-end 0) field-name (buffer-substring (match-beginning 0) (1- bbeg)) end (std11-field-end)) - (and (find-non-ascii-charset-region bbeg end) + (and (delq 'ascii (find-charset-region bbeg end)) (let ((method (eword-find-field-encoding-method (downcase field-name)))) (cond ((eq method 'mime) @@ -696,9 +670,8 @@ It refer variable `eword-field-encoding-method-alist'." (buffer-substring-no-properties bbeg end) )) (delete-region bbeg end) - (insert (eword-encode-field-body field-body - field-name)) - )) + (insert (mime-encode-field-body field-body + field-name)))) (code-conversion (let ((cs (or (mime-charset-to-coding-system @@ -709,6 +682,8 @@ It refer variable `eword-field-encoding-method-alist'." )) )) ))) +(defalias 'eword-encode-header 'mime-encode-header-in-buffer) +(make-obsolete 'eword-encode-header 'mime-encode-header-in-buffer) ;;; @ end diff --git a/luna.el b/luna.el index 48da490..b307ad9 100644 --- a/luna.el +++ b/luna.el @@ -26,51 +26,47 @@ (eval-when-compile (require 'cl)) -(eval-when-compile (require 'static)) - -(static-condition-case nil - :symbol-for-testing-whether-colon-keyword-is-available-or-not - (void-variable - (defconst :before ':before) - (defconst :after ':after) - (defconst :around ':around))) - ;;; @ class ;;; (defmacro luna-find-class (name) - "Return the luna-class of the given 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 (type &optional parents slots) - "Define TYPE as a luna-class. -If PARENTS is specified, TYPE inherits PARENTS. -Each parent must be name of luna-class (symbol). -If SLOTS is specified, TYPE will be defined to have them." - `(luna-define-class-function ',type ',(append parents '(standard-object)) +(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)) -(defun luna-define-class-function (type &optional parents slots) - (static-condition-case nil - :symbol-for-testing-whether-colon-keyword-is-available-or-not - (void-variable - (let (key) - (dolist (slot slots) - (setq key (intern (format ":%s" slot))) - (set key key))))) + +;; 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 @@ -84,19 +80,19 @@ If SLOTS is specified, TYPE will be defined to have them." (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 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 type (vector 'class oa parents 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) @@ -111,40 +107,61 @@ If SLOTS is specified, TYPE will be defined to have them." member-name))))) ret))) + +;; 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 function of a class. + "Define NAME as a method of a luna class. Usage of this macro follows: - (luna-define-method NAME [METHOD-QUALIFIER] ARGLIST [DOCSTRING] BODY...) + (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. -NAME is the name of method. +If it is :around, call the method only. The parents' methods can be +executed by calling the function `luna-call-next-method' in BODY. -Optional argument METHOD-QUALIFIER must be :before, :after or :around. -If it is :before / :after, the method is called before / after a -method of parent class is finished. ARGLIST is like an argument list -of lambda, but (car ARGLIST) must be specialized parameter. (car (car -ARGLIST)) is name of variable and \(nth 1 (car ARGLIST)) is name of -class. +Otherwize, call the method only, and the parents' methods are never +executed. In this case, METHOD-QUALIFIER is treated as ARGLIST. -Optional argument DOCSTRING is the documentation of method. +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. -BODY is the body of method." +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) - ) + method-qualifier nil)) (setq specializer (car args) class (nth 1 specializer) self (car specializer)) @@ -153,10 +170,12 @@ BODY is the body of method." (cdr args)) ,@definition)) (sym (luna-class-find-or-make-member - (luna-find-class ',class) ',name))) + (luna-find-class ',class) ',name)) + (cache (get ',name 'luna-method-cache))) + (if cache + (unintern ',class cache)) (fset sym func) - (put sym 'luna-method-qualifier ,method-qualifier) - ))) + (put sym 'luna-method-qualifier ,method-qualifier)))) (put 'luna-define-method 'lisp-indent-function 'defun) @@ -165,10 +184,13 @@ BODY is the body of method." ((arg symbolp) [&rest arg] [&optional ["&optional" arg &rest arg]] - &optional ["&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) @@ -179,25 +201,23 @@ BODY is the body of method." 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)) - ) + (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))) - ) + (list (symbol-function sym)))) ((eq (get sym 'luna-method-qualifier) :around) - (cons sym (luna-class-find-parents-functions class service)) - ) + (cons sym (luna-class-find-parents-functions class service))) (t - (list (symbol-function sym)) - )) - (luna-class-find-parents-functions class service) - ))) + (list (symbol-function sym)))) + (luna-class-find-parents-functions class service)))) ;;; @ instance (entity) @@ -234,6 +254,8 @@ BODY is the body of method." (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 @@ -252,11 +274,12 @@ LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE." (eval-when-compile (defvar luna-next-methods nil) - (defvar luna-current-method-arguments nil) - ) + (defvar luna-current-method-arguments nil)) (defun luna-call-next-method () - "Call the next method in a method with :around qualifier." + "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 @@ -271,44 +294,72 @@ LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE." t)))) luna-previous-return-value)) -(defun luna-make-entity (type &rest init-args) - "Make instance of luna-class TYPE and return it. -If INIT-ARGS is specified, it is used as initial values of the slots. -It must be plist and each slot name must have prefix `:'." - (let* ((c (get type 'luna-class)) +(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 type) + (luna-set-class-name v class) (luna-set-obarray v (make-vector 7 0)) - (apply #'luna-send v 'initialize-instance v init-args) - )) + (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 dest (cons arg dest)))) (setq arglist (cdr arglist))) (nreverse dest))) + (defmacro luna-define-generic (name args &optional doc) - "Define generic-function NAME. -ARGS is argument of and DOC is DOC-string." + "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 - `(defun ,(intern (symbol-name name)) ,args - ,doc - (luna-send ,(car args) ',name - ,@(luna-arglist-to-arguments args)) - ) - `(defun ,(intern (symbol-name name)) ,args - (luna-send ,(car args) ',name - ,@(luna-arglist-to-arguments args)) - ))) + `(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) @@ -317,7 +368,17 @@ ARGS is argument of and DOC is DOC-string." ;;; (defun luna-define-internal-accessors (class-name) - "Define internal accessors for an entity of 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 @@ -329,8 +390,7 @@ ARGS is argument of and DOC is DOC-string." (setq parent-class (luna-find-class (car parents))) (if (luna-class-slot-index parent-class slot) (throw 'derived nil)) - (setq parents (cdr parents)) - ) + (setq parents (cdr parents))) (eval `(progn (defmacro ,(intern (format "%s-%s-internal" @@ -338,27 +398,26 @@ ARGS is argument of and DOC is DOC-string." (entity) (list 'aref entity ,(luna-class-slot-index entity-class - (intern (symbol-name slot))) - )) + (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)) - )) - ))) + 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) @@ -366,8 +425,7 @@ ARGS is argument of and DOC is DOC-string." (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) - )) + (aset entity (get s 'luna-slot-index) i))) entity)) diff --git a/mailcap.el b/mailcap.el index b31dd21..9bee280 100644 --- a/mailcap.el +++ b/mailcap.el @@ -28,6 +28,7 @@ ;;; Code: (require 'mime-conf) +(require 'poe) ; define-obsolete-function-alias (define-obsolete-function-alias 'mailcap-parse-buffer 'mime-parse-mailcap-buffer) diff --git a/mel-b-ccl.el b/mel-b-ccl.el index fa12483..7e31dfa 100644 --- a/mel-b-ccl.el +++ b/mel-b-ccl.el @@ -1,8 +1,8 @@ ;;; mel-b-ccl.el --- Base64 encoder/decoder using CCL. -;; Copyright (C) 1998,1999 Tanaka Akira +;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. -;; Author: Tanaka Akira +;; Author: Tanaka Akira ;; Created: 1998/9/17 ;; Keywords: MIME, Base64 @@ -419,7 +419,9 @@ abcdefghijklmnopqrstuvwxyz\ (defun base64-ccl-insert-encoded-file (filename) "Encode contents of file FILENAME to base64, and insert the result." (interactive "*fInsert encoded file: ") - (insert-file-contents-as-coding-system 'mel-ccl-base64-lf-rev filename)) + (let ((coding-system-for-read 'mel-ccl-base64-lf-rev) + format-alist) + (insert-file-contents filename))) (mel-define-method-function (mime-encode-string string (nil "base64")) 'base64-ccl-encode-string) @@ -447,7 +449,9 @@ abcdefghijklmnopqrstuvwxyz\ (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: ") - (write-region-as-coding-system 'mel-ccl-b-rev start end filename)) + (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) diff --git a/mel-g.el b/mel-g.el index 16a37fd..9f79197 100644 --- a/mel-g.el +++ b/mel-g.el @@ -59,25 +59,26 @@ (defun gzip64-external-encode-region (beg end) (interactive "*r") (save-excursion - (as-binary-process - (apply (function call-process-region) - beg end (car gzip64-external-encoder) - t t nil - (cdr gzip64-external-encoder))) + (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 "")))) + ;;(goto-char (point-min)) + ;;(while (re-search-forward "\r$" nil t) + ;; (replace-match "")) + )) (defun gzip64-external-decode-region (beg end) (interactive "*r") (save-excursion - (as-binary-process - (apply (function call-process-region) - beg end (car gzip64-external-decoder) - t t nil - (cdr gzip64-external-decoder))))) + (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) @@ -116,13 +117,14 @@ "Decode and write current region encoded by gzip64 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 gzip64-external-decoder) - nil nil nil - (let ((args (cdr gzip64-external-decoder))) - (append (butlast args) - (list (concat (car (last args)) ">" filename))))))) + (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 diff --git a/mel-q-ccl.el b/mel-q-ccl.el index c71fab6..cb54a56 100644 --- a/mel-q-ccl.el +++ b/mel-q-ccl.el @@ -898,8 +898,9 @@ abcdefghijklmnopqrstuvwxyz\ (defun quoted-printable-ccl-insert-encoded-file (filename) "Encode contents of the file named as FILENAME, and insert it." (interactive "*fInsert encoded file: ") - (insert-file-contents-as-coding-system - 'mel-ccl-quoted-printable-lf-lf-rev filename)) + (let ((coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev) + format-alist) + (insert-file-contents filename))) (mel-define-method-function (mime-encode-string string (nil "quoted-printable")) @@ -927,8 +928,9 @@ encoding." (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: ") - (write-region-as-coding-system 'mel-ccl-quoted-printable-lf-lf-rev - start end filename)) + (let ((coding-system-for-write '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")) diff --git a/mel-q.el b/mel-q.el index 44b83c9..a5830d2 100644 --- a/mel-q.el +++ b/mel-q.el @@ -27,7 +27,9 @@ (require 'mime-def) (require 'path-util) - +(eval-when-compile + ;; XXX: should provide char-list instead of string-to-char-list. + (require 'poem)) ;;; @ Quoted-Printable encoder ;;; diff --git a/mel-u.el b/mel-u.el index 49d5733..ead3efb 100644 --- a/mel-u.el +++ b/mel-u.el @@ -51,11 +51,12 @@ This function uses external uuencode encoder which is specified by variable `uuencode-external-encoder'." (interactive "*r") (save-excursion - (as-binary-process - (apply (function call-process-region) - start end (car uuencode-external-encoder) - t t nil - (cdr uuencode-external-encoder))) + (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)) @@ -78,19 +79,20 @@ variable `uuencode-external-decoder'." (match-end 0))))))) (default-directory temporary-file-directory)) (if filename - (as-binary-process - (apply (function call-process-region) - start end (car uuencode-external-decoder) - t nil nil - (cdr uuencode-external-decoder)) - (as-binary-input-file (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))))))) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (apply (function call-process-region) + start end (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) @@ -142,12 +144,13 @@ START and END are buffer positions." (match-end 0))))))) (default-directory temporary-file-directory)) (if file - (as-binary-process - (apply (function call-process-region) - start end (car uuencode-external-decoder) - nil nil nil - (cdr uuencode-external-decoder)) - (rename-file file filename 'overwrites)))))) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (apply (function call-process-region) + start end (car uuencode-external-decoder) + nil nil nil + (cdr uuencode-external-decoder)) + (rename-file file filename 'overwrites)))))) ;;; @ end diff --git a/mel.el b/mel.el index 98d08c7..8c84ac5 100644 --- a/mel.el +++ b/mel.el @@ -26,9 +26,8 @@ ;;; Code: (require 'mime-def) -(require 'poem) +(require 'raw-io) (require 'alist) -(require 'path-util) (defcustom mime-encoding-list '("7bit" "8bit" "binary" "base64" "quoted-printable") @@ -87,10 +86,10 @@ Content-Transfer-Encoding for it." (mel-define-method mime-encode-region (start end (nil "7bit"))) (mel-define-method mime-decode-region (start end (nil "7bit"))) (mel-define-method-function (mime-insert-encoded-file filename (nil "7bit")) - 'insert-file-contents-as-binary) + 'binary-insert-file-contents) (mel-define-method-function (mime-write-decoded-region start end filename (nil "7bit")) - 'write-region-as-binary) + 'binary-write-region) (mel-define-backend "8bit" ("7bit")) @@ -119,12 +118,12 @@ mmencode included in metamail or XEmacs package)." (insert (base64-encode-string (with-temp-buffer (set-buffer-multibyte nil) - (insert-file-contents-as-binary filename) + (binary-insert-file-contents filename) (buffer-string)))) (or (bolp) (insert ?\n))) - (mel-define-method-function (encoded-text-encode-string string (nil "B")) - 'base64-encode-string) + ;; (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 "\\'")) @@ -199,17 +198,22 @@ ENCODING must be string. If ENCODING is found in the STRING by its value." (let ((f (mel-find-function 'mime-decode-string encoding))) (if f - (condition-case nil - (funcall f string) - (error - (message "Wrong Content-Transfer-Encoding: %s" - encoding) - string)) + (funcall f string) string))) -(mel-define-service encoded-text-encode-string (string encoding) - "Encode STRING as encoded-text using ENCODING. ENCODING must be 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.") diff --git a/mime-def.el b/mime-def.el index 3b73400..4efc076 100644 --- a/mime-def.el +++ b/mime-def.el @@ -24,9 +24,7 @@ ;;; Code: -(require 'poe) -(require 'poem) -(require 'pcustom) +(require 'custom) (require 'mcharset) (require 'alist) @@ -36,7 +34,7 @@ ) (eval-and-compile - (defconst mime-library-product ["SLIM" (1 14 4) "$BA0ED0&(B"] + (defconst mime-library-product ["SLIM" (1 14 4) "$(BA0ED0&(B"] "Product name, version number and code name of MIME-library package.")) (defmacro mime-product-name (product) @@ -59,8 +57,6 @@ ;;; @ variables ;;; -(require 'custom) - (defgroup mime '((default-mime-charset custom-variable)) "Emacs MIME Interfaces" :group 'news @@ -72,6 +68,54 @@ :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))) + +;;; @@@ 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 ;;; @@ -81,6 +125,9 @@ (defsubst regexp-or (&rest args) (concat "\\(" (mapconcat (function identity) args "\\|") "\\)")) +(or (fboundp 'char-int) + (defalias 'char-int 'identity)) + ;;; @ about STD 11 ;;; @@ -167,11 +214,11 @@ (cdr (car content-type))) (defsubst mime-content-type-subtype (content-type) - "Return primary-type of CONTENT-TYPE." + "Return subtype of CONTENT-TYPE." (cdr (cadr content-type))) (defsubst mime-content-type-parameters (content-type) - "Return primary-type of CONTENT-TYPE." + "Return parameters of CONTENT-TYPE." (cddr content-type)) (defsubst mime-content-type-parameter (content-type parameter) diff --git a/mime-parse.el b/mime-parse.el index 4aeb30c..2323fba 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -25,6 +25,7 @@ ;;; Code: (require 'mime-def) +(require 'luna) (require 'std11) (autoload 'mime-entity-body-buffer "mime") diff --git a/mime.el b/mime.el index 328d599..2160569 100644 --- a/mime.el +++ b/mime.el @@ -33,7 +33,7 @@ (eval-and-compile -(autoload 'eword-encode-header "eword-encode" +(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" @@ -65,6 +65,10 @@ current-buffer, and return it.") ) +(autoload 'mime-encode-field-body "eword-encode" + "Encode FIELD-BODY as FIELD-NAME, and return the result.") + + ;;; @ Entity Representation and Implementation ;;; @@ -87,10 +91,12 @@ representation-type." ;;; (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) @@ -263,6 +269,7 @@ If MESSAGE is specified, it is regarded as root entity." ;; (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 @@ -271,6 +278,7 @@ If MESSAGE is specified, it is regarded as root entity." )))) (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 @@ -279,6 +287,10 @@ If MESSAGE is specified, it is regarded as root entity." )))) (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 @@ -390,19 +402,28 @@ If MESSAGE is specified, it is regarded as root entity." (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)) diff --git a/mmbuffer.el b/mmbuffer.el index 97fc783..b99d80b 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -96,11 +96,10 @@ (luna-define-method mime-write-entity ((entity mime-buffer-entity) filename) (save-excursion (set-buffer (mime-buffer-entity-buffer-internal entity)) - (write-region-as-raw-text-CRLF - (mime-buffer-entity-header-start-internal entity) - (mime-buffer-entity-body-end-internal entity) - filename) - )) + (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 @@ -126,10 +125,9 @@ filename) (save-excursion (set-buffer (mime-buffer-entity-buffer-internal entity)) - (write-region-as-binary (mime-buffer-entity-body-start-internal entity) - (mime-buffer-entity-body-end-internal entity) - filename) - )) + (binary-write-region (mime-buffer-entity-body-start-internal entity) + (mime-buffer-entity-body-end-internal entity) + filename))) ;;; @ entity content @@ -262,11 +260,12 @@ ;;; @ children ;;; -(defun mmbuffer-parse-multipart (entity) +(defun mmbuffer-parse-multipart (entity &optional representation-type) (with-current-buffer (mime-buffer-entity-buffer-internal entity) - (let* ((representation-type - (mime-entity-representation-type-internal entity)) - (content-type (mime-entity-content-type-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"))) @@ -320,7 +319,8 @@ nil) )))) -(defun mmbuffer-parse-encapsulated (entity &optional external) +(defun mmbuffer-parse-encapsulated (entity &optional external + representation-type) (mime-entity-set-children-internal entity (with-current-buffer (mime-buffer-entity-buffer-internal entity) @@ -332,7 +332,8 @@ (progn (require 'mmexternal) 'mime-external-entity) - (mime-entity-representation-type-internal entity)) + (or representation-type + (mime-entity-representation-type-internal entity))) nil entity (cons 0 (mime-entity-node-id-internal entity)))))))) diff --git a/mmdbuffer.el b/mmdbuffer.el deleted file mode 100644 index 5a1ae20..0000000 --- a/mmdbuffer.el +++ /dev/null @@ -1,187 +0,0 @@ -;;; mmdual.el --- MIME entity module for dual buffers - -;; Copyright (C) 1998,1999,2000 Free Software Foundation, Inc. - -;; Author: MORIOKA Tomohiko -;; Keywords: MIME, multimedia, mail, news - -;; This file is part of FLIM (Faithful Library about Internet Message). - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the GNU General Public License as -;; published by the Free Software Foundation; either version 2, or (at -;; your option) any later version. - -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Code: - -(require 'mime) - -(eval-and-compile - (luna-define-class mime-dual-entity (mime-entity) - (header-buffer - body-buffer)) - - (luna-define-internal-accessors 'mime-dual-entity) - ) - -(luna-define-method initialize-instance :after ((entity mime-dual-entity) - &rest init-args) - (let ((buf (mime-dual-entity-header-buffer-internal entity))) - (if buf - (with-current-buffer buf - (or (mime-entity-content-type-internal entity) - (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-dual-entity)) - (buffer-name (mime-dual-entity-header-buffer-internal entity)) - ) - - -(luna-define-method mime-insert-header ((entity mime-dual-entity) - &optional invisible-fields - visible-fields) - (let* ((buf (mime-dual-entity-header-buffer-internal entity)) - header-start header-end) - (with-current-buffer buf - (setq header-start (point-min) - header-end (point-max))) - (mime-insert-header-from-buffer buf header-start header-end - invisible-fields visible-fields) - )) - -(luna-define-method mime-entity-content ((entity mime-dual-entity)) - (mime-decode-string - (with-current-buffer (mime-dual-entity-body-buffer-internal entity) - (buffer-string)) - (mime-entity-encoding entity))) - -(luna-define-method mime-entity-fetch-field :around - ((entity mime-dual-entity) field-name) - (or (luna-call-next-method) - (with-current-buffer (mime-dual-entity-header-buffer-internal entity) - (let ((ret (std11-fetch-field field-name))) - (when ret - (or (symbolp field-name) - (setq field-name - (intern (capitalize (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-entity-content ((entity mime-dual-entity)) - (insert - (mime-decode-string - (with-current-buffer (mime-dual-entity-body-buffer-internal entity) - (buffer-substring (point-min)(point-max))) - (mime-entity-encoding entity)))) - -(luna-define-method mime-write-entity-content ((entity mime-dual-entity) - filename) - (with-current-buffer (mime-dual-entity-body-buffer-internal entity) - (mime-write-decoded-region (point-min) - (point-max) - filename - (or (mime-entity-encoding entity) "7bit")))) - -(luna-define-method mime-insert-entity ((entity mime-dual-entity)) - (let (buf) - (setq buf (mime-dual-entity-header-buffer-internal entity)) - (when buf - (insert-buffer (mime-dual-entity-header-buffer-internal entity)) - (setq buf (mime-dual-entity-body-buffer-internal entity)) - (when buf - (insert "\n") - (insert-buffer buf))))) - -(luna-define-method mime-write-entity ((entity mime-dual-entity) filename) - (let (buf) - (setq buf (mime-dual-entity-header-buffer-internal entity)) - (if (null buf) - (error "No header buffer.") - (with-current-buffer buf - (write-region-as-raw-text-CRLF - (point-min)(point-max) filename)) - (setq buf (mime-dual-entity-body-buffer-internal entity)) - (when buf - (with-temp-buffer - (insert "\n") - (write-region-as-raw-text-CRLF - (point-min)(point-max) - filename 'append)) - (with-current-buffer buf - (write-region-as-raw-text-CRLF - (point-min)(point-max) - filename 'append)))))) - -(luna-define-method mime-write-entity-body ((entity mime-dual-entity) filename) - (with-current-buffer (mime-dual-entity-body-buffer-internal entity) - (write-region-as-binary (point-min)(point-max) - filename))) - - -;;; @ buffer -;;; - -(luna-define-method mime-entity-header-buffer ((entity mime-dual-entity)) - (mime-dual-entity-header-buffer-internal entity)) - -(luna-define-method mime-entity-body-buffer ((entity mime-dual-entity)) - (mime-dual-entity-body-buffer-internal entity)) - -(luna-define-method mime-entity-buffer ((entity mime-dual-entity)) - (message "mime-dual-entity does not have mime-entity-buffer.") - nil) - -(luna-define-method mime-entity-body-start-point ((entity mime-dual-entity)) - (with-current-buffer (mime-entity-body-buffer entity) - (point-min))) - -(luna-define-method mime-entity-body-end-point ((entity mime-dual-entity)) - (with-current-buffer (mime-entity-body-buffer entity) - (point-max))) - -(luna-define-method mime-entity-point-min ((entity mime-dual-entity)) - (message "mime-dual-entity does not have mime-entity-point-min.") - nil) - -(luna-define-method mime-entity-point-max ((entity mime-dual-entity)) - (message "mime-dual-entity does not have mime-entity-point-max.") - nil) - -(luna-define-method mime-goto-header-start-point ((entity mime-dual-entity)) - (set-buffer (mime-dual-entity-header-buffer-internal entity)) - (goto-char (point-min))) - -(luna-define-method mime-goto-body-start-point ((entity mime-dual-entity)) - (set-buffer (mime-dual-entity-body-buffer-internal entity)) - (goto-char (point-min))) - -(luna-define-method mime-goto-body-end-point ((entity mime-dual-entity)) - (set-buffer (mime-dual-entity-body-buffer-internal entity)) - (goto-char (point-max))) - - -;;; @ end -;;; - -(provide 'mmdual) - -;;; mmdual.el ends here diff --git a/mmexternal.el b/mmexternal.el index 04e5649..dde1406 100644 --- a/mmexternal.el +++ b/mmexternal.el @@ -24,8 +24,8 @@ ;;; Code: +(require 'mmgeneric) (require 'mime) -(require 'pces) (eval-and-compile (luna-define-class mime-external-entity (mime-entity) @@ -78,7 +78,7 @@ (concat " *Body of " (mime-entity-name entity) "*")) - (insert-file-contents-as-binary + (binary-insert-file-contents (mime-external-entity-body-file-internal entity)) (current-buffer)))) (error (message "Can't get external-body."))))) @@ -95,7 +95,8 @@ (luna-define-method mime-write-entity ((entity mime-external-entity) filename) (with-temp-buffer (mime-insert-entity entity) - (write-region-as-raw-text-CRLF (point-min) (point-max) filename))) + (let ((coding-system-for-write 'raw-text-dos)) + (write-region (point-min) (point-max) filename)))) ;;; @ entity header @@ -119,7 +120,7 @@ filename) (mmexternal-require-buffer entity) (with-current-buffer (mime-external-entity-body-buffer-internal entity) - (write-region-as-binary (point-min) (point-max) filename))) + (binary-write-region (point-min) (point-max) filename))) ;;; @ entity content diff --git a/mmgeneric.el b/mmgeneric.el index 5bd9686..532dfd9 100644 --- a/mmgeneric.el +++ b/mmgeneric.el @@ -26,6 +26,10 @@ (require 'luna) +(eval-when-compile + (require 'eword-decode) ; mime-find-field-presentation-method + ) + ;;; @ MIME entity ;;; diff --git a/qmtp.el b/qmtp.el index 459cd7f..1010857 100644 --- a/qmtp.el +++ b/qmtp.el @@ -29,12 +29,11 @@ ;; To send mail using QMTP instead of SMTP, do -;; (fset 'smtp-via-smtp 'qmtp-via-qmtp) +;; (fset 'smtp-send-buffer 'qmtp-send-buffer) ;;; Code: -(require 'poem) -(require 'pcustom) +(require 'custom) (defgroup qmtp nil "QMTP protocol for sending mail." @@ -61,7 +60,9 @@ called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.") :type 'integer :group 'qmtp) -(defvar qmtp-open-connection-function (function open-network-stream)) +(autoload 'binary-open-network-stream "raw-io") +;;;###autoload +(defvar qmtp-open-connection-function (function binary-open-network-stream)) (defvar qmtp-error-response-alist '((?Z "Temporary failure") @@ -126,10 +127,9 @@ called from `qmtp-via-qmtp' with arguments SENDER and RECIPIENTS.") (let (process) (unwind-protect (progn - (as-binary-process - (setq process - (funcall qmtp-open-connection-function - "QMTP" (current-buffer) qmtp-server qmtp-service))) + (setq process + (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))) diff --git a/raw-io.el b/raw-io.el new file mode 100644 index 0000000..5652c94 --- /dev/null +++ b/raw-io.el @@ -0,0 +1,116 @@ +;;; raw-io.el --- input/output without code-conversion + +;; Copyright (C) 1997,1998,1999,2000 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Keywords: definition, MIME, multimedia, mail, news + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(eval-when-compile (require 'static)) + +(static-if (and (featurep 'xemacs) + (not (featurep 'utf-2000))) + (defun binary-insert-file-contents (filename + &optional visit beg end replace) + "Like `insert-file-contents', but only reads in the file literally. +A buffer may be modified in several ways after reading into the buffer, +to Emacs features such as format decoding, character code +conversion, find-file-hooks, automatic uncompression, etc. + +This function ensures that none of these modifications will take place." + (let ((format-alist nil) + (after-insert-file-functions nil) + (coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (jka-compr-compression-info-list nil) + (jam-zcat-filename-list nil) + (find-buffer-file-type-function + (if (fboundp 'find-buffer-file-type) + (symbol-function 'find-buffer-file-type) + nil))) + (unwind-protect + (progn + (fset 'find-buffer-file-type (lambda (filename) t)) + (insert-file-contents filename visit beg end replace)) + (if find-buffer-file-type-function + (fset 'find-buffer-file-type find-buffer-file-type-function) + (fmakunbound 'find-buffer-file-type))))) + (defalias 'binary-insert-file-contents 'insert-file-contents-literally)) + +(defun binary-write-region (start end filename + &optional append visit lockname) + "Like `write-region', q.v., but don't encode." + (let ((coding-system-for-write 'binary) + jka-compr-compression-info-list jam-zcat-filename-list) + (write-region start end filename append visit lockname))) + +(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-open-network-stream (name buffer host service &rest options) + "Like `open-network-stream', q.v., but don't code and format conversion." + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (apply #'open-network-stream name buffer host service options))) + +(defun binary-start-process (name buffer program &rest program-args) + "Like `start-process', q.v., but don't code conversion." + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (apply #'start-process name buffer program program-args))) + +(defun binary-start-process-shell-command (name buffer &rest args) + "Like `start-process-shell-command', q.v., but don't code conversion." + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (apply #'start-process-shell-command name buffer args))) + + +(defun raw-text-insert-file-contents (filename + &optional visit beg end replace) + "Like `insert-file-contents', q.v., but don't code and format conversion. +Like `insert-file-contents-literary', but it allows find-file-hooks, +automatic uncompression, etc. +Like `binary-insert-file-contents', but it converts line-break +code." + (let ((coding-system-for-read 'raw-text) + format-alist) + ;; Returns list of absolute file name and length of data inserted. + (insert-file-contents filename visit beg end replace))) + + +(defun raw-message-write-region (start end filename + &optional append visit lockname) + "Like `write-region', q.v., but write as network representation." + (let ((coding-system-for-write 'raw-text-dos) + format-alist) + (write-region start end filename append visit lockname))) + + +;;; @ end +;;; + +(provide 'raw-io) + +;;; raw-io.el ends here diff --git a/sha1.el b/sha1.el index a7265b6..24a3af5 100644 --- a/sha1.el +++ b/sha1.el @@ -43,7 +43,8 @@ (require 'hex-util) (eval-when-compile - (defun-maybe sha1-string (a))) + (or (fboundp 'sha1-string) + (defun sha1-string (a)))) (defvar sha1-dl-module (if (and (fboundp 'sha1-string) diff --git a/smtp.el b/smtp.el index 990a923..220a177 100644 --- a/smtp.el +++ b/smtp.el @@ -31,10 +31,10 @@ ;;; Code: -(require 'pces) -(require 'pcustom) +(require 'custom) (require 'mail-utils) ; mail-strip-quoted-names (require 'sasl) +(require 'luna) (defgroup smtp nil "SMTP protocol for sending mail." @@ -111,8 +111,10 @@ don't define this value." :group 'smtp-extensions) (defvar sasl-mechanisms) - -(defvar smtp-open-connection-function #'open-network-stream) + +(autoload 'binary-open-network-stream "raw-io") +;;;###autoload +(defvar smtp-open-connection-function #'binary-open-network-stream) (defvar smtp-read-point nil) @@ -120,36 +122,32 @@ don't define this value." (defvar smtp-submit-package-function #'smtp-submit-package) -;;; @ SMTP package structure +;;; @ 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). -(defmacro smtp-package-sender (package) - "Return the sender of PACKAGE, a string." - `(aref ,package 0)) - -(defmacro smtp-package-recipients (package) - "Return the recipients of PACKAGE, a list of strings." - `(aref ,package 1)) +(eval-and-compile + (luna-define-class smtp-package () + (sender + recipients + buffer)) -(defmacro smtp-package-buffer (package) - "Return the data of PACKAGE, a buffer." - `(aref ,package 2)) + (luna-define-internal-accessors 'smtp-package)) -(defmacro smtp-make-package (sender recipients buffer) +(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." - `(vector ,sender ,recipients ,buffer)) + (luna-make-entity 'smtp-package :sender sender :recipients recipients :buffer buffer)) -(defun smtp-package-buffer-size (package) +(defun smtp-package-buffer-internal-size (package) "Return the size of PACKAGE, an integer." (save-excursion - (set-buffer (smtp-package-buffer package)) + (set-buffer (smtp-package-buffer-internal package)) (let ((size (+ (buffer-size) ;; Add one byte for each change-of-line @@ -165,49 +163,42 @@ BUFFER may be a buffer or a buffer name which contains mail message." (setq size (1+ size))) size))) -;;; @ SMTP connection structure +;;; @ 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. -(defmacro smtp-connection-process (connection) - "Return the subprocess-object of CONNECTION." - `(aref ,connection 0)) - -(defmacro smtp-connection-server (connection) - "Return the server of CONNECTION, a string." - `(aref ,connection 1)) - -(defmacro smtp-connection-service (connection) - "Return the service of CONNECTION, a string or an integer." - `(aref ,connection 2)) - -(defmacro smtp-connection-extensions (connection) - "Return the SMTP extensions of CONNECTION, a list of strings." - `(aref ,connection 3)) +(eval-and-compile + (luna-define-class smtp-connection () + (process + server + service + extensions + encoder + decoder)) -(defmacro smtp-connection-set-extensions (connection extensions) - "Set the SMTP extensions of CONNECTION. -EXTENSIONS is a list of cons cells of the form \(EXTENSION . PARAMETERS). -Where EXTENSION is a symbol and PARAMETERS is a list of strings." - `(aset ,connection 3 ,extensions)) + (luna-define-internal-accessors 'smtp-connection)) -(defmacro smtp-make-connection (process server service) +(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." - `(vector ,process ,server ,service nil)) + (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.") -(defun smtp-connection-opened (connection) - "Say whether the CONNECTION to server has been opened." - (let ((process (smtp-connection-process connection))) +(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))) -(defun smtp-close-connection (connection) - "Close the CONNECTION to server." - (let ((process (smtp-connection-process connection))) +(luna-define-method smtp-close-connection ((connection smtp-connection)) + (let ((process (smtp-connection-process-internal connection))) (delete-process process))) (defun smtp-make-fqdn () @@ -245,9 +236,8 @@ 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 - (as-binary-process - (funcall smtp-open-connection-function - "SMTP" buffer server service))) + (funcall smtp-open-connection-function + "SMTP" buffer server service)) connection) (when process (setq connection (smtp-make-connection process server service)) @@ -259,6 +249,7 @@ of the host to connect to. SERVICE is name of the service desired." ;;;###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) @@ -269,6 +260,10 @@ of the host to connect to. SERVICE is name of the service desired." ;;;###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." (let ((server (if (functionp smtp-server) (funcall smtp-server sender recipients) @@ -318,22 +313,19 @@ of the host to connect to. SERVICE is name of the service desired." (let* ((connection (smtp-find-connection (current-buffer))) (response - (smtp-read-response - (smtp-connection-process connection)))) + (smtp-read-response connection))) (if (/= (car response) 220) (smtp-response-error response)))) (defun smtp-primitive-ehlo (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) response) - (smtp-send-command process (format "EHLO %s" (smtp-make-fqdn))) - (setq response (smtp-read-response process)) + (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 + (smtp-connection-set-extensions-internal connection (mapcar (lambda (extension) (let ((extensions @@ -347,21 +339,17 @@ of the host to connect to. SERVICE is name of the service desired." (defun smtp-primitive-helo (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) response) - (smtp-send-command process (format "HELO %s" (smtp-make-fqdn))) - (setq response (smtp-read-response process)) + (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))) - (process - (smtp-connection-process connection)) (mechanisms - (cdr (assq 'auth (smtp-connection-extensions connection)))) + (cdr (assq 'auth (smtp-connection-extensions-internal connection)))) (sasl-mechanisms (or smtp-sasl-mechanisms sasl-mechanisms)) (mechanism @@ -373,20 +361,20 @@ of the host to connect to. SERVICE is name of the service desired." (unless mechanism (error "No authentication mechanism available")) (setq client (sasl-make-client mechanism smtp-sasl-user-name "smtp" - (smtp-connection-server connection))) + (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 - process + 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 process)) + (setq response (smtp-read-response connection)) (when (= (car response) 235) ;; The authentication process is finished. (setq step (sasl-next-step client step)) @@ -398,99 +386,95 @@ of the host to connect to. SERVICE is name of the service desired." (sasl-step-set-data step (base64-decode-string (nth 1 response))) (setq step (sasl-next-step client step)) (smtp-send-command - process (if (sasl-step-data step) - (base64-encode-string (sasl-step-data step) t) - "")))))) + connection + (if (sasl-step-data step) + (base64-encode-string (sasl-step-data step) t) + "")))) +;;; (smtp-connection-set-encoder-internal +;;; connection (sasl-client-encoder client)) +;;; (smtp-connection-set-decoder-internal +;;; connection (sasl-client-decoder client)) + )) (defun smtp-primitive-starttls (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) response) ;; STARTTLS --- begin a TLS negotiation (RFC 2595) - (smtp-send-command process "STARTTLS") - (setq response (smtp-read-response process)) + (smtp-send-command connection "STARTTLS") + (setq response (smtp-read-response connection)) (if (/= (car response) 220) (smtp-response-error response)) - (starttls-negotiate process) + (starttls-negotiate (smtp-connection-process-internal connection)) ;; for sendmail warning XXX (smtp-primitive-helo package))) (defun smtp-primitive-mailfrom (package) (let* ((connection (smtp-find-connection (current-buffer))) - (process - (smtp-connection-process connection)) (extensions - (smtp-connection-extensions + (smtp-connection-extensions-internal connection)) (sender - (smtp-package-sender package)) + (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-size package)))) + (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 - process + connection (if extension (format "MAIL FROM:<%s> %s" sender extension) (format "MAIL FROM:<%s>" sender))) - (setq response (smtp-read-response process)) + (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))) - (process - (smtp-connection-process connection)) (recipients - (smtp-package-recipients package)) + (smtp-package-recipients-internal package)) response) (while recipients (smtp-send-command - process (format "RCPT TO:<%s>" (pop recipients))) - (setq response (smtp-read-response process)) + 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))) - (process - (smtp-connection-process connection)) response) - (smtp-send-command process "DATA") - (setq response (smtp-read-response process)) + (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 package)) + (set-buffer (smtp-package-buffer-internal package)) (goto-char (point-min)) (while (not (eobp)) (smtp-send-data - process (buffer-substring (point) (progn (end-of-line)(point)))) + connection (buffer-substring (point) (progn (end-of-line)(point)))) (beginning-of-line 2))) - (smtp-send-command process ".") - (setq response (smtp-read-response process)) + (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))) - (process - (smtp-connection-process connection)) response) - (smtp-send-command process "QUIT") - (setq response (smtp-read-response process)) + (smtp-send-command connection "QUIT") + (setq response (smtp-read-response connection)) (if (/= (car response) 221) (smtp-response-error response)))) @@ -511,14 +495,20 @@ of the host to connect to. SERVICE is name of the service desired." (defun smtp-response-error (response) (signal 'smtp-response-error response)) -(defun smtp-read-response (process) - (let ((response-continue t) +(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 (search-forward "\r\n" nil t)) - (accept-process-output process) + (accept-process-output (smtp-connection-process-internal connection)) (goto-char smtp-read-point)) + (if decoder + (let ((string (buffer-substring smtp-read-point (- (point) 2)))) + (delete-region smtp-read-point (point)) + (insert (funcall decoder string) "\r\n"))) (setq response (nconc response (list (buffer-substring @@ -532,21 +522,33 @@ of the host to connect to. SERVICE is name of the service desired." response-continue nil))) response)) -(defun smtp-send-command (process command) +(defun smtp-send-command (connection command) (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert command "\r\n") - (setq smtp-read-point (point)) - (process-send-string process command) - (process-send-string process "\r\n"))) - -(defun smtp-send-data (process data) - ;; Escape "." at start of a line. - (if (eq (string-to-char data) ?.) - (process-send-string process ".")) - (process-send-string process data) - (process-send-string process "\r\n")) + (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:
." diff --git a/smtpmail.el b/smtpmail.el index 8582394..6475e44 100644 --- a/smtpmail.el +++ b/smtpmail.el @@ -42,11 +42,11 @@ ;;; Code: -(require 'poe) -(require 'pcustom) +(require 'custom) (require 'smtp) (require 'sendmail) (require 'time-stamp) +(require 'raw-io) (eval-when-compile (require 'static)) @@ -245,7 +245,7 @@ This is relative to `smtpmail-queue-dir'.") (insert-buffer tembuf) (or (file-directory-p smtpmail-queue-dir) (make-directory smtpmail-queue-dir t)) - (write-region-as-binary (point-min) (point-max) file-data) + (binary-write-region (point-min) (point-max) file-data) (set-buffer buffer-elisp) (erase-buffer) (insert (concat @@ -281,7 +281,7 @@ This is relative to `smtpmail-queue-dir'.") (end-of-line) (point)))) (load file-msg) - (setq tembuf (find-file-noselect-as-binary 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) diff --git a/std11.el b/std11.el index dc7bde5..051d45a 100644 --- a/std11.el +++ b/std11.el @@ -1,8 +1,8 @@ ;;; std11.el --- STD 11 functions for GNU Emacs -;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc. -;; Author: MORIOKA Tomohiko +;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, RFC 822, STD 11 ;; This file is part of FLIM (Faithful Library about Internet Message). @@ -24,9 +24,7 @@ ;;; Code: -(require 'poe) -(require 'poem) ; find-non-ascii-charset-string -(require 'pcustom) ; std11-lexical-analyzer +(require 'custom) ; std11-lexical-analyzer ;;; @ fetch @@ -435,8 +433,7 @@ be the result." (setq token (car lal)) (or (std11-ignored-token-p token) (if (and (setq token-value (cdr token)) - (find-non-ascii-charset-string token-value) - ) + (delq 'ascii (find-charset-string token-value))) (setq token nil) ))) (setq lal (cdr lal)) -- 1.7.10.4