+1999-05-11 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * FLIM: Version 1.12.6 (Family-K\e-Dòenmae)\e-A released.
+
+1999-04-27 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * mel-b-ccl.el (TopLevel): Suppress warning.
+ mel-q-ccl.el (TopLevel): Ditto.
+ mime.el (TopLevel): Ditto.
+
+1999-04-26 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * eword-decode.el (eword-encoded-word-regexp): Accept "b" and "q"
+ for "encoding".
+
+ * mime-def.el (std11-qtext-regexp): Don't use `string'.
+ (mime-tspecial-char-list): Eval at compile time.
+
+1999-04-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mime.el: Delete autoload setting for `eword-encode-field'.
+
+1999-04-22 MORIOKA Tomohiko <tomo@etl.go.jp>
+
+ * eword-encode.el: Require `poem' instead of `emu'.
+ Don't use `cl' for `caar'.
+
+1999-04-09 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * smtp.el (smtp-via-smtp): Funcall `smtp-server' if it is a
+ function.
+ (smtp-server): Make it can also be a function called from
+ `smtp-via-smtp' with arguments SENDER and RECIPIENTS.
+
+1999-04-05 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * FLIM-CFG: Make easier to install in VERSION_SPECIFIC_LISPDIR.
+
+1999-03-29 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * mime.el (mime-read-field): Correct argument of
+ `mime-decode-field-body'; 'native -> 'plain.
+
+1999-03-27 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * eword-encode.el (TopLevel): Require 'cl when compiling.
+ (eword-encode-rword-list): Suppress insertion of extra spaces.
+ (eword-encode-msg-id-to-rword-list): Treat surrounding angle
+ brackets atomically.
+ ([tm-ja:4244] by Kazuhiro Ohta <ohta@ele.cst.nihon-u.ac.jp>)
+
+1999-03-11 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-encode.el (eword-charset-encoding-alist): Add `tis-620'.
+
+1999-03-01 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mel.el (mime-decode-string): Return STRING if return value of
+ `(mel-find-function 'mime-decode-string encoding)' is nil.
+
+1999-02-10 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-def.el (mel-define-service): Change size of obarray to 7.
+
+1999-02-01 Yoshiki Hayashi <g740685@komaba.ecc.u-tokyo.ac.jp>
+
+ * mime-ja.sgml: Tranlate all untranslated parts.
+
+\f
+1999-01-27 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.12.5 (Hirahata) released.
+
+ * mime-ja.sgml, mime-en.sgml: Sync with FLIM API 1.12.
+
+1999-01-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * NEWS (New optional argument of `std11-field-end'): New
+ subsection.
+
+ * std11.el (std11-field-end): Add new optional argument `bound'.
+
+\f
+1999-01-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.12.4 (Tsutsui) released.
+
+1999-01-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * README.en: Sync with latest FLIM.
+
+ * README.ja: fixed.
+
+1999-01-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mmbuffer.el, mmgeneric.el (insert-entity-content): New method.
+
+ * mime.el (mime-insert-entity-content): New generic function.
+
+1999-01-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * NEWS (New function `mime-find-entity-from-content-id'): New
+ subsection.
+ (New function `mime-parse-msg-id'): New subsection.
+ (New function `mime-uri-parse-cid'): New subsection.
+
+1999-01-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime.el (mime-find-entity-from-content-id): New function.
+ (mime-field-parser-alist): Use `mime-parse-msg-id' instead of
+ `std11-parse-msg-id' to parse `Message-Id', `Recent-Message-Id'
+ and `Content-Id' field.
+
+ * mime-parse.el (mime-parse-msg-id): New function.
+ (mime-uri-parse-cid): New function.
+
+\f
+1999-01-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.12.3 (Kintetsu-K\e-Dòriyama)\e-A released.
+
+1999-01-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * NEWS (Function `std11-parse-in-reply-to'): New subsection.
+ (New function `std11-parse-msg-id-string'): Likewise.
+ (New function `std11-parse-msg-ids-string'): Likewise.
+ (New generic function `mime-insert-entity'): Likewise.
+
+1999-01-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime.el (mime-field-parser-alist): Change to set parser for
+ tokens instead of parser for string.
+ (mime-read-field): Use `eword-lexical-analyze' before parsing.
+
+ * eword-encode.el (eword-encode-in-reply-to): Use
+ `std11-parse-msg-ids-string' instead of `std11-parse-in-reply-to'
+ and `std11-lexical-analyze'.
+
+ * std11.el (std11-parse-msg-ids): Renamed from
+ `std11-parse-in-reply-to'; define `std11-parse-in-reply-to' as
+ obsolete alias.
+ (std11-parse-msg-id-string): New function.
+ (std11-parse-msg-ids-string): New function.
+
+1999-01-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime.el (mime-field-parser-alist): New variable.
+ (mime-read-field): Refer `mime-field-parser-alist'.
+
+1999-01-23 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mmbuffer.el, mmgeneric.el (insert-entity): New method.
+
+ * mime.el (mime-insert-entity): New generic function.
+
+1999-01-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * std11.el (TopLevel): Require `custom'.
+
+\f
+1999-01-21 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.12.2 (Kuj\e-Dò)\e-A released.
+
+1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-parse.el (mime-lexical-analyzer): New user option.
+ (mime-analyze-tspecial): New function.
+ (mime-analyze-token): New function.
+ (mime-parse-Content-Transfer-Encoding): Use
+ `std11-lexical-analyze' with `mime-lexical-analyzer'.
+
+ * mime-def.el (mime-tspecial-char-list): Renamed from
+ `mime-tspecials'; changed from string to list.
+ (mime-token-regexp): Use `eval-when-compile'.
+
+1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-decode.el (eword-lexical-analyzer): Modify DOC-string
+ about interface change.
+ (eword-analyze-comment): Renamed from `eword-parse-comment';
+ change second argument `from' to required argument; abolish alias
+ `eword-analyze-comment' of `eword-parse-comment'.
+
+1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * NEWS (User option `eword-lexical-analyzers' ->
+ `eword-lexical-analyzer'): New subsection.
+
+ * eword-decode.el (eword-lexical-analyzer): Renamed from user
+ option `eword-lexical-analyzers'.
+
+1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * NEWS (New user option `std11-lexical-analyzer'): New subsection.
+
+ * std11.el (std11-lexical-analyzer): Renamed from user option
+ `std11-lexical-analyzers'.
+
+1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * std11.el (std11-lexical-analyze): Change interface to add new
+ optional argument `analyzers'.
+
+1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * std11.el (std11-lexical-analyzers): New user option.
+ (std11-lexical-analyze): New implementation; refer
+ `std11-lexical-analyzers'.
+
+1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * NEWS (Change interface of lexical-analyzers): New subsection.
+
+1999-01-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-decode.el (eword-encoded-word-regexp): Must define when
+ this module is compiled.
+ (eword-decode-structured-field-body): Add new optional argument
+ `start'.
+ (eword-decode-and-unfold-structured-field-body): Likewise.
+ (eword-decode-and-fold-structured-field-body): Likewise.
+ (eword-analyze-quoted-string): Add new argument `start'; return
+ `(<parsed result> . <end position>)' instead of `(<parsed result>
+ . <rest string>)'.
+ (std11-analyze-domain-literal): Likewise.
+ (eword-analyze-domain-literal): Likewise.
+ (eword-analyze-comment): Changed to alias of
+ `eword-parse-comment'.
+ (eword-analyze-spaces): Add new argument `start'; return `(<parsed
+ result> . <end position>)' instead of `(<parsed result> . <rest
+ string>)'.
+ (std11-analyze-domain-literal): Likewise.
+ (eword-analyze-special): Likewise.
+ (eword-analyze-encoded-word): Likewise.
+ (eword-analyze-atom): Likewise.
+ (eword-lexical-analyze-internal): Add new argument `start'.
+ (eword-lexical-analyze): Change interface to add new optional
+ argument `start'.
+ (eword-extract-address-components): Add new optional argument
+ `start'.
+
+ * std11.el (std11-atom-regexp): Modify to match non-top atom.
+ (std11-analyze-spaces): Add new argument `start'; return `(<parsed
+ result> . <end position>)' instead of `(<parsed result> . <rest
+ string>)'.
+ (std11-analyze-special): Likewise.
+ (std11-analyze-atom): Likewise.
+ (std11-analyze-quoted-string): Likewise.
+ (std11-analyze-domain-literal): Likewise.
+ (std11-analyze-comment): Likewise.
+ (std11-lexical-analyze): Add new optional argument `start'.
+
+1999-01-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * std11.el (std11-fetch-field): Add autoload cookie.
+ (std11-narrow-to-header): Likewise.
+ (std11-field-body): Likewise.
+ (std11-unfold-string): Likewise.
+ (std11-lexical-analyze): Add DOC-string; add autoload cookie.
+
+ * std11.el (std11-space-char-list): Renamed from
+ `std11-space-chars'; changed from string to list.
+
+1999-01-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * std11.el (std11-fetch-field): Don't define as inline function.
+ (std11-field-body): Enclose `std11-narrow-to-header' and
+ `std11-fetch-field' by `inline'.
+
+1999-01-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * std11.el (std11-special-char-list): Evaluate when it is
+ compiled.
+ (std11-atom-regexp): Use `eval-when-compile'.
+
+1999-01-15 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * std11.el (std11-space-chars): Must evaluate when it is compiled.
+ (std11-analyze-spaces): Don't use `std11-spaces-regexp'; abolist
+ constant `std11-spaces-regexp'.
+
+ * mime-parse.el (mime-disposition-type-regexp): Must evaluate when
+ it is compiled.
+
+ * mime-parse.el: Don't require emu.
+
+ * mime-parse.el (mime-parse-Content-Disposition): Use
+ `eval-when-compile'.
+
+ * mime-parse.el (mime-parse-Content-Transfer-Encoding): New
+ implementation.
+
+1998-12-22 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * README.en (Installation): Modify for APEL 9.12.
+ * README.ja (Installation): Likewise.
+
+1998-12-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mel-b-ccl.el (base64-ccl-insert-encoded-file): Call
+ `insert-file-contents-as-coding-system' with CODING-SYSTEM as the
+ 1st arg.
+ * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file):
+ Likewise.
+
+ * mel-b-ccl.el (base64-ccl-write-decoded-region): Call
+ `write-region-as-coding-system' with CODING-SYSTEM as the 1st arg.
+ * mel-q-ccl.el (quoted-printable-ccl-write-decoded-region):
+ Likewise.
+
+1998-12-14 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mel-b-ccl.el (base64-ccl-insert-encoded-file): Use
+ `insert-file-contents-as-coding-system' (renamed from
+ `insert-file-contents-as-specified-coding-system').
+ * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file):
+ Likewise.
+
+ * mel-b-ccl.el (base64-ccl-write-decoded-region): Use
+ `write-region-as-coding-system' (renamed from
+ `write-region-as-specified-coding-system').
+ * mel-q-ccl.el (quoted-printable-ccl-write-decoded-region):
+ Likewise.
+
+1998-12-08 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * smtp.el (smtp-coding-system): Abolished.
+ (smtp-via-smtp): Use `open-network-stream-as-binary' instead of
+ `open-network-stream'.
+
+1998-12-04 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * mel-b-ccl.el (base64-ccl-insert-encoded-file): Use
+ `insert-file-contents-as-specified-coding-system' instead of
+ `insert-file-contents'.
+ * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file):
+ Likewise.
+
+ * mel-b-ccl.el (base64-ccl-write-decoded-region): Use
+ `write-region-as-specified-coding-system' instead of
+ `write-region'.
+ * mel-q-ccl.el (quoted-printable-ccl-write-decoded-region):
+ Likewise.
+
+\f
+1998-12-02 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.12.1 (Nishinoky\e-Dò)\e-A released.
+
+1998-11-30 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * smtpmail.el (smtpmail-send-it): Add autoload cookie; use
+ `smtpmail-do-bcc' instead of `smtp-do-bcc'; modify for interface
+ change of `smtp-via-smtp'.
+ (smtpmail-do-bcc): New function (moved and renamed from
+ `smtp-do-bcc' of smtp.el).
+
+1998-08-06 Katsumi Yamaoka <yamaoka@jpl.org>
+
+ * lisp/smtp.el: Do not insert empty line at the end of message.
+
+1998-06-18 Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+
+ * lisp/smtp.el (smtp-use-8bitmime): New variable.
+ (smtp-debug-info): Internal variable, now.
+ (smtp-make-fqdn): Renamed from `smtp-fqdn'.
+ (smtp-via-smtp): New implementation.
+ (smtp-send-command): Treat "PASS" as usual.
+ (smtp-do-bcc): Removed.
+
+1998-11-30 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * smtpmail.el: New module (copied from Semi-gnus 6.8).
+
+ * smtp.el: New module (copied from Semi-gnus 6.8).
+
+ * FLIM-ELS: Add smtp.el and smtpmail.el.
+
+1998-11-30 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-def.el: Abolish function `eliminate-top-spaces' because it
+ is not used in FLIM.
+
+1998-11-29 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-encode.el (eword-encode-mailbox-to-rword-list): Fix
+ problem in `eword-encode-addresses-to-rword-list'.
+
+1998-11-26 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * std11.el (std11-full-name-string): fixed.
+
+ * std11.el (std11-comment-value-to-string): fixed.
+
+1998-11-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * NEWS (Changes in FLIM 1.12): New section.
+
+1998-11-25 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * std11.el (std11-comment-value-to-string): New function.
+ (std11-full-name-string): Use `std11-comment-value-to-string'.
+
+ * eword-decode.el (eword-parse-comment): New function.
+ (eword-analyze-comment): New implementation; use
+ `eword-parse-comment'; change representation.
+ (eword-decode-token): Modify for representation change of comment.
+
+\f
+1998-11-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * FLIM: Version 1.12.0 (Amagatsuji) was released.
+
+1998-11-14 Tanaka Akira <akr@jaist.ac.jp>
+
+ * mel-b-ccl.el (ccl-cascading-read): Check consistency.
+
+1998-11-13 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-decode.el (eword-decode-structured-field-body): Abolish
+ non-used local variable.
+
+1998-11-12 Tanaka Akira <akr@jaist.ac.jp>
+
+ * mel-b-ccl.el (mel-ccl-decode-b): Check `ccl-cascading-read' to
+ select implementation.
+
+1998-11-12 Tanaka Akira <akr@jaist.ac.jp>
+
+ * mel-q-ccl.el (mel-ccl-encode-quoted-printable-generic): workaround
+ for mule-2.3@19.34.
+
+1998-11-12 Tanaka Akira <akr@jaist.ac.jp>
+
+ * mel.el (mel-b-builtin): New variable.
+
+1998-11-10 Tanaka Akira <akr@jaist.ac.jp>
+
+ * FLIM-ELS: require 'pccl.
+ (flim-modules): Check CCL availability by broken facility.
+
+1998-11-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-decode.el (eword-decode-structured-field-body): New
+ implementation; abolish optional argument `must-unfold'; delete
+ DOC-string.
+ (eword-decode-and-unfold-structured-field-body): Renamed from
+ `eword-decode-and-unfold-structured-field'; delete DOC-string.
+ (eword-decode-and-fold-structured-field-body): Renamed from
+ `eword-decode-and-fold-structured-field'; abolish optional
+ argument `must-unfold'; delete DOC-string.
+ (eword-decode-unstructured-field-body): Abolish optional argument
+ `must-unfold'; delete DOC-string.
+ (eword-decode-and-unfold-unstructured-field-body): Renamed from
+ `eword-decode-and-unfold-unstructured-field'; delete DOC-string.
+ (eword-decode-unfolded-unstructured-field-body): New function.
+
+1998-11-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mmgeneric.el (mime-insert-header-from-buffer): Use
+ `mime-find-field-presentation-method' and
+ `mime-find-field-decoder-internal'.
+
+ * eword-decode.el (mime-find-field-presentation-method): New
+ macro.
+ (mime-find-field-decoder-internal): New function.
+ (mime-find-field-decoder): New implementation (use
+ mime-find-field-decoder-internal).
+ (mime-decode-header-in-region): Use
+ `mime-find-field-presentation-method' and
+ `mime-find-field-decoder-internal'.
+
+1998-11-08 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mmgeneric.el (mime-insert-header-from-buffer): Rename
+ field-presentation-mode `folding' to `wide'.
+
+ * eword-decode.el: Rename field-presentation-modes from `native',
+ `folding', `unfolding', `unfolding-xover' to `plain', `wide',
+ `summary', `nov'.
+
+1998-11-07 Tanaka Akira <akr@jaist.ac.jp>
+
+ * eword-decode.el (mime-set-field-decoder): Add mode `unfolding-xover'.
+ (mime-find-field-decoder): Ditto.
+
+1998-11-04 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-encode.el (eword-encode-phrase-route-addr-to-rword-list):
+ Don't delete the front spaces.
+ (eword-encode-addresses-to-rword-list): Don't supplement space;
+ use `nconc' instead of `append'.
+ (eword-encode-msg-id-to-rword-list): Supplement the front space;
+ use `nconc' instead of `append'.
+
+1998-11-02 Tanaka Akira <akr@jaist.ac.jp>
+
+ * eword-decode.el (mime-field-decoder-cache): New variable.
+ (mime-find-field-decoder): Use `mime-field-decoder-cache'.
+ (mime-update-field-decoder-cache): New variable.
+ (mime-update-field-decoder-cache): New function.
+ (mime-decode-header-in-region): Use `mime-field-decoder-cache'.
+
+ * mmgeneric.el (mime-insert-header-from-buffer): Use
+ `mime-field-decoder-cache'.
+
+1998-11-02 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-decode.el (mime-decode-header-in-region): New function.
+ (mime-decode-header-in-buffer): Use function
+ `mime-decode-header-in-region'.
+
1998-10-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * mime-def.el: Avoid compile error when ediff is missing.
+ * mmgeneric.el (mime-insert-header-from-buffer): Refer
+ `mime-field-decoder-alist' instead of hard-coding.
+
+ * mime.el (mime-read-field): Use `mime-decode-field-body'.
+
+ * eword-decode.el (eword-decode-and-unfold-structured-field): Add
+ optional dummy argument `start-column' and `max-column'.
+ (eword-decode-structured-field-body): Change interface.
+ (eword-decode-unstructured-field-body): Change interface to add
+ optional dummy argument `start-column' and `max-column'.
+ (eword-decode-and-unfold-unstructured-field): Add optional dummy
+ argument `start-column' and `max-column'.
+ (mime-field-decoder-alist): New variable; abolish user option
+ `eword-decode-ignored-field-list' and
+ `eword-decode-structured-field-list'.
+ (mime-set-field-decoder): New function.
+ (mime-find-field-decoder): New function.
+ (mime-decode-field-body): New function; abolish function
+ `eword-decode-field-body'.
+ (mime-decode-header-in-buffer): Renamed from
+ `eword-decode-header'; refer `mime-field-decoder-alist' instead of
+ hard-coding; add obsolete alias `eword-decode-header'.
+
+1998-10-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-def.el: Avoid compile error when edebug is missing.
\f
1998-10-28 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* Move variable `mel-encoding-module-alist' from mel.el to
mime-def.el.
-
+
* mel.el (mel-find-function): Use function
`mel-find-function-from-obarray'.
Use `mel-define-backend' to define "7bit", "8bit" and "binary";
(mime-insert-encoded-file): Use `mel-define-method'; abolish
`base64-insert-encoded-file'.
(mime-write-decoded-region): Use `mel-define-method'; abolish
- `base64-write-decoded-region'.
+ `base64-write-decoded-region'.
- Move `base64-encoded-length' to mel.el.
* mel-dl.el (base64-encode-region): Define directly (abolish
* eword-decode.el (eword-decode-ignored-field-list): Add
`received'.
-
+
* mel.el (mime-temp-directory): Use TMPDIR, TMP, or TEMP
environment variables.
(add-to-list 'load-path (expand-file-name "apel" LISPDIR))
))
-(defvar VERSION_SPECIFIC_LISPDIR nil)
-
-(if VERSION_SPECIFIC_LISPDIR
+(if (boundp 'VERSION_SPECIFIC_LISPDIR)
(add-to-list 'load-path VERSION_SPECIFIC_LISPDIR))
(require 'install)
(defvar LISPDIR (install-detect-elisp-directory PREFIX))
;; (setq install-default-elisp-directory "~/lib/emacs/lisp")
+(defvar VERSION_SPECIFIC_LISPDIR
+ (install-detect-elisp-directory PREFIX nil 'version-specific))
+
+;; (setq FLIM_DIR (expand-file-name FLIM_PREFIX VERSION_SPECIFIC_LISPDIR))
(setq FLIM_DIR (expand-file-name FLIM_PREFIX LISPDIR))
(defvar PACKAGEDIR
mel mel-q mel-u mel-g
eword-decode eword-encode
mime mime-parse mmgeneric mmbuffer mmcooked
- mailcap))
+ mailcap
+ smtp smtpmail))
(unless (and (fboundp 'base64-encode-string)
(subrp (symbol-function 'base64-encode-string)))
(setq flim-modules (cons 'mel-b-el flim-modules))
)
-(if (and (featurep 'mule)
- (not (or (and (boundp 'MULE) MULE)
- (and (featurep 'xemacs) (< emacs-major-version 21))
- )))
- (setq flim-modules (cons 'mel-b-ccl (cons 'mel-q-ccl flim-modules)))
- )
+(require 'pccl)
+(unless-broken ccl-usable
+ (setq flim-modules (cons 'mel-b-ccl (cons 'mel-q-ccl flim-modules))))
;;; FLIM-ELS ends here
#
PACKAGE = flim
-VERSION = 1.11.3
+API = 1.12
+RELEASE = 6
TAR = tar
RM = /bin/rm -f
*.pg *.pgs *.tp *.tps *.toc *.aux *.log
FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog
+VERSION = $(API).$(RELEASE)
+ARC_DIR = /pub/mule/flim/$(PACKAGE)-$(API)
+SEMI_ARC_DIR = /pub/mule/semi/semi-1.13-for-flim-$(API)
elc:
$(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) \
tar:
cvs commit
- sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) \
- | sed s/\\\\./_/ | sed s/\\\\./_/`; \
+ sh -c 'cvs tag -RF $(PACKAGE)-`echo $(VERSION) | tr . _`; \
cd /tmp; \
cvs -d :pserver:anonymous@chamonix.jaist.ac.jp:/hare/cvs/root \
export -d $(PACKAGE)-$(VERSION) \
- -r $(PACKAGE)-`echo $(VERSION) | sed s/\\\\./_/ | sed s/\\\\./_/` \
+ -r $(PACKAGE)-`echo $(VERSION) | tr . _` \
flim'
cd /tmp; $(RM) $(PACKAGE)-$(VERSION)/ftp.in ; \
$(TAR) cvzf $(PACKAGE)-$(VERSION).tar.gz $(PACKAGE)-$(VERSION)
cd /tmp; $(RM) -r $(PACKAGE)-$(VERSION)
- sed "s/VERSION/$(VERSION)/" < ftp.in > ftp
+ sed "s/VERSION/$(VERSION)/" < ftp.in | sed "s/API/$(API)/" > ftp
release:
- -$(RM) /pub/GNU/elisp/flim/$(PACKAGE)-$(VERSION).tar.gz
- mv /tmp/$(PACKAGE)-$(VERSION).tar.gz /pub/GNU/elisp/flim/
- cd /pub/GNU/elisp/semi/ ; \
- ln -s ../flim/$(PACKAGE)-$(VERSION).tar.gz .
+ -$(RM) $(ARC_DIR)/$(PACKAGE)-$(VERSION).tar.gz
+ mv /tmp/$(PACKAGE)-$(VERSION).tar.gz $(ARC_DIR)
+ cd $(SEMI_ARC_DIR) ; \
+ ln -s ../../flim/flim-$(API)/$(PACKAGE)-$(VERSION).tar.gz .
FLIM NEWS --- history of major-changes.
-Copyright (C) 1998 Free Software Foundation, Inc.
+Copyright (C) 1998,1999 Free Software Foundation, Inc.
+* Changes in FLIM 1.12
+
+** Restructure of field decoding features
+
+Introduce backend mechanism of field-decoder and
+field-presentation-method to restructure field decoding features.
+
+Field-decoder is registered into variable `mime-field-decoder-alist'.
+Each decoding function uses decoding method found from variable
+`mime-field-decoder-alist'.
+
+New function `mime-set-field-decoder' is added to register field
+decoding method.
+
+New function `mime-find-field-presentation-method' is added to get
+`field-presentation-method' object corresponding with specified
+field-presentation-mode. Field-presentation-mode must be `plain',
+`wide', `summary' or `nov'.
+
+New function `mime-find-field-decoder' is added to find field decoding
+method corresponding with field-name and field-presentation-mode.
+
+New function `mime-decode-field-body' is added. It is general field
+decoder.
+
+
+** Function `mime-decode-header-in-buffer'
+
+Renamed from `eword-decode-header'. `eword-decode-header' is defined
+as obsolete alias.
+
+
+** New function `mime-decode-header-in-region'
+
+
+** Changes about lexical-analyzers
+
+*** New user option `std11-lexical-analyzer'
+
+Now function `std11-lexical-analyze' refers user option
+`std11-lexical-analyzer'.
+
+
+*** User option `eword-lexical-analyzers' -> `eword-lexical-analyzer'
+
+User option `eword-lexical-analyzers' was renamed to
+`eword-lexical-analyzer'.
+
+
+*** Change interface of lexical-analyzers
+
+Interface of function `eword-lexical-analyze' was changed from
+`(string &optional must-unfold)' to `(string &optional start
+must-unfold)'. Interface of lexical analyzer specified by user option
+`eword-lexical-analyzer' was changed likewise.
+
+Function `eword-extract-address-components' was added new optional
+argument `START' to specify start position of `STRING' to parse.
+
+Function `std11-lexical-analyze' was added new optional arguments
+`ANALYZER' to specify lexical-analyzer and `START' to specify start
+position of `STRING' to analyze.
+
+Interface of lexical analyzers for STD 11 was changed from `(string)'
+to `(string &optional start)'.
+
+
+** Function `std11-parse-in-reply-to' -> `std11-parse-msg-ids'
+
+Rename function `std11-parse-in-reply-to' to `std11-parse-msg-ids'.
+Function `std11-parse-in-reply-to' was defined as obsolete alias.
+
+
+** New function `std11-parse-msg-id-string'
+
+
+** New function `std11-parse-msg-ids-string'
+
+
+** New function `mime-find-entity-from-content-id'
+
+
+** New function `mime-parse-msg-id'
+
+
+** New function `mime-uri-parse-cid'
+
+
+** New generic function `mime-insert-entity'
+
+Add new generic function `mime-insert-entity' to insert header and
+body of ENTITY at point.
+
+Each mm-backend must have new method `insert-entity'.
+
+
+** New optional argument of `std11-field-end'
+
+Now `std11-field-end' can accept new optional argument BOUND. Thus
+current interface is:
+
+ std11-field-end (&optional BOUND)
+
+If the optional argument BOUND is specified, it bounds the search; it
+is a buffer position.
+
+\f
* Changes in FLIM 1.11
** New function `mime-insert-text-content'
[README for FLIM (English Version)]
+by MORIOKA Tomohiko
What's FLIM
===========
std11.el --- STD 11 (RFC 822) parser and utility
- mime.el --- MIME library
+ mime.el --- to provide various services about MIME-entities
mime-def.el --- Definitions about MIME format
mel.el --- MIME encoder/decoder
mel-b-dl.el --- base64 (B-encoding) encoder/decoder
(for Emacs 20 with dynamic loading support)
- mel-b.el --- base64 (B-encoding) encoder/decoder
+ mel-b-ccl.el --- base64 (B-encoding) encoder/decoder
+ (using CCL)
+ mel-b-en.el --- base64 (B-encoding) encoder/decoder
(for other emacsen)
+ mel-q-ccl.el --- quoted-printable and Q-encoding
+ encoder/decoder (using CCL)
mel-q.el --- quoted-printable and Q-encoding
encoder/decoder
- mel-ccl.el --- base64 (B-encoding), quoted-printable and
- Q-encoding encoder/decoder using CCL
- mel-u.el --- unofficial module for uuencode
- mel-g.el --- unofficial module for gzip64
+ mel-u.el --- unofficial backend for uuencode
+ mel-g.el --- unofficial backend for gzip64
eword-decode.el --- encoded-word decoder
eword-encode.el --- encoded-word encoder
Installation
============
-(0) before installing it, please install APEL (9.6 or later) package.
+(0) before installing it, please install APEL (9.12 or later) package.
APEL package is available at:
ftp://ftp.jaist.ac.jp/pub/GNU/elisp/apel/
If `EMACS=...' is omitted, EMACS=emacs is used.
You can specify the prefix of the directory tree for Emacs Lisp
- programs and shell scripts, for example:
+ programs, for example:
% make install PREFIX=~/
% make install VERSION_SPECIFIC_LISPDIR=~/elisp
+ Following make target is available to find what files are parts of
+ emu / APEL package, and where are directories to install them:
+
+ % make what-where LISPDIR=~/elisp VERSION_SPECIFIC_LISPDIR=~/elisp
+
You can specify other optional settings by editing the file
FLIM-CFG. Please read comments in it.
% make install-package
- You can specify the emacs command name, for example
+ You can specify the XEmacs command name, for example
% make install-package XEMACS=xemacs-21
FLIM \e$B$H$O!)\e(B
===========
- FLIM \e$B$O%a%C%;!<%8I=8=$HId9f2=$K4X$9$k4pACE*$J5!G=$rDs6!$9$k%i%$%V%i\e(B
- \e$B%j!<$G$9!#0J2<$N%b%8%e!<%k$+$i9=@.$5$l$F$$$^$9\e(B:
+ FLIM \e$B$O\e(B Internet message \e$B$K4X$9$kMM!9$JI=8=7A<0$dId9f2=$K4X$9$k4pAC\e(B
+ \e$BE*$J5!G=$rDs6!$9$k$?$a$NHFMQItIJ$G$9!#\e(BFLIM \e$B$O0J2<$N%b%8%e!<%k$+$i9=\e(B
+ \e$B@.$5$l$F$$$^$9\e(B:
- std11.el --- STD 11 (RFC 822) \e$B$N2r@O4o$H%f!<%F%#%j%F%#!<\e(B
+ std11.el --- STD 11 (RFC 822) \e$B7A<0$K4p$E$/2r@O=hM}Ey\e(B
- mime.el --- MIME \e$B%i%$%V%i%j!<\e(B
+ mime.el --- MIME-entity \e$B$K4X$9$k=t5!G=$NDs6!\e(B
- mime-def.el --- MIME \e$B$NMM<0$K4X$9$kDj5A\e(B
+ mime-def.el --- MIME \e$B7A<0$K4X$9$kDj5A\e(B
mime-parse.el --- MIME \e$B2r@O4o\e(B
mel.el --- MIME \e$BId9f4o\e(B/\e$BI|9f4o\e(B
mel-b-dl.el --- base64 (B-encoding) \e$BId9f4o\e(B/\e$BI|9f4o\e(B
- (Emacs 20 \e$B$NF0E*FI$_9~$_5!G=IU$-MQ\e(B)
- mel-b.el --- base64 (B-encoding) \e$BId9f4o\e(B/\e$BI|9f4o\e(B
- (\e$BB>$N\e(B emacs \e$B4D6-MQ\e(B)
+ (dynamic loading \e$B5!G=IU$-\e(B Emacs 20 \e$BMQ\e(B)
+ mel-b-ccl.el --- base64 (B-encoding) encoder/decoder (using CCL)
+ mel-b-el.el --- base64 (B-encoding) \e$BId9f4o\e(B/\e$BI|9f4o\e(B
+ (\e$BB>$N\e(B emacsen \e$BMQ\e(B)
+ mel-q-ccl.el --- quoted-printable and Q-encoding
+ encoder/decoder (using CCL)
mel-q.el --- quoted-printable \e$B$H\e(B Q-encoding
\e$BId9f4o\e(B/\e$BI|9f4o\e(B
- mel-ccl.el --- CCL \e$B$r;H$C$?\e(B base64 (B-encoding),
- quoted-printable \e$B$H\e(B Q-encoding \e$B$NId9f4o\e(B/\e$BI|9f4o\e(B
- mel-u.el --- uuencode \e$B$N$?$a$NHs8x<0%b%8%e!<%k\e(B
- mel-g.el --- gzip64 \e$B$N$?$a$NHs8x<0%b%8%e!<%k\e(B
+ mel-u.el --- uuencode \e$B$N$?$a$NHs8x<0\e(B backend
+ mel-g.el --- gzip64 \e$B$N$?$a$NHs8x<0\e(B backend
eword-decode.el --- encoded-word \e$BI|9f4o\e(B
eword-encode.el --- encoded-word \e$BId9f4o\e(B
- mailcap.el --- mailcap \e$B2r@O4o$H%f!<%F%#%j%F%#!<\e(B
+ mailcap.el --- mailcap \e$B$N2r@O=hM}Ey\e(B
-\e$B%$%s%9%H!<%k\e(B
-============
+\e$BF3F~\e(B (install)
+==============
-(0) \e$B%$%s%9%H!<%k$9$kA0$K!"\e(BAPEL \e$B%Q%C%1!<%8\e(B (9.6 \e$B0J9_\e(B)
- \e$B$r%$%s%9%H!<%k$7$F$/$@$5$$!#\e(BAPEL \e$B%Q%C%1!<%8$O0J2<$N$H$3$m$G<hF@$G\e(B
- \e$B$-$^$9\e(B:
+(0) \e$BF3F~\e(B (install) \e$B$9$kA0$K!"\e(BAPEL (9.12 \e$B0J9_\e(B) \e$B$rF3F~$7$F$/$@$5$$!#\e(BAPEL
+ \e$B$O0J2<$N$H$3$m$G<hF@$G$-$^$9\e(B:
ftp://ftp.jaist.ac.jp/pub/GNU/elisp/apel/
-(1-a) \e$BE83+$7$?>l=j$G<B9T\e(B
+(1-a) \e$BE83+$7$?>l=j$X$NF3F~\e(B
- \e$BB>$N%G%#%l%/%H%j!<$K%$%s%9%H!<%k$7$?$/$J$$$J$i!"0J2<$N$3$H$@$1$r$d$C\e(B
- \e$B$F$/$@$5$$\e(B:
+ \e$BE83+$7$?>l=j$H$O0[$J$k>l=j$KF3F~$7$?$/$J$$$J$i!"\e(B
% make
+ \e$B$@$1$r<B9T$7$F$/$@$5$$!#\e(B
+
emacs \e$B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"\e(B
% make EMACS=xemacs
(b) make install
- \e$BB>$N%G%#%l%/%H%j!<$K%$%s%9%H!<%k$7$?$$$J$i!"0J2<$N$3$H$r$7$F$/$@$5$$\e(B:
+ \e$BE83+$7$?>l=j$H$O0[$J$k>l=j$KF3F~$7$?$$$J$i!"\e(B
% make install
+ \e$B$r<B9T$7$F$/$@$5$$!#\e(B
+
emacs \e$B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"\e(B
% make install EMACS=xemacs
`EMACS=...' \e$B$,>JN,$5$l$k$H!"\e(BEmacs=emacs \e$B$,;H$o$l$^$9!#\e(B
- Emacs Lisp \e$B%W%m%0%i%`$H%7%'%k%9%/%j%W%H$N$?$a$N%G%#%l%/%H%j!<LZ$N@\\e(B
- \e$BF,<-\e(B (prefix) \e$B$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"\e(B
+ Emacs Lisp \e$B%W%m%0%i%`$N$?$a$N%G%#%l%/%H%j!<LZ$N@\F,<-\e(B (prefix) \e$B$r;X\e(B
+ \e$BDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"\e(B
% make install PREFIX=~/
\e$B$G$9!#\e(B
emu \e$B%b%8%e!<%k\e(B (APEL \e$B%Q%C%1!<%8$KF~$C$F$$$^$9\e(B) \e$B$,I8=`$G$J$$%G%#%l%/\e(B
- \e$B%H%j!<$K%$%s%9%H!<%k$5$l$F$$$k>l9g$O!"$=$l$i$N$"$k>l=j$r;XDj$9$kI,MW\e(B
- \e$B$,$"$j$^$9!#Nc$($P!"\e(B:
+ \e$B%H%j!<$KF3F~$5$l$F$$$k>l9g$O!"$=$l$i$N$"$k>l=j$r;XDj$9$kI,MW\e(B
+ \e$B$,$"$j$^$9!#Nc$($P!'\e(B
% make install VERSION_SPECIFIC_LISPDIR=~/elisp
- \e$B$I$N%U%!%$%k$,\e(B emu \e$B%b%8%e!<%k$+\e(B apel \e$B%b%8%e!<%k$N0lIt$J$N$+!"$=$l$i\e(B
- \e$B$,$I$3$K%$%s%9%H!<%k$5$l$k$+$rCN$j$?$$$H$-$O!"<!$N$h$&$J%3%^%s%I$rF~\e(B
+ \e$B$I$N%U%!%$%k$,\e(B emu \e$B%b%8%e!<%k$+\e(B APEL \e$B%b%8%e!<%k$N0lIt$J$N$+!"$=$l$i\e(B
+ \e$B$,$I$3$KF3F~$5$l$k$+$rCN$j$?$$$H$-$O!"<!$N$h$&$J%3%^%s%I$rF~\e(B
\e$BNO$9$k$3$H$,$G$-$^$9!#\e(B
% make what-where LISPDIR=~/elisp VERSION_SPECIFIC_LISPDIR=~/elisp
- \e$B%U%!%$%k\e(B FLIM-CFG \e$B$rJT=8$9$k$3$H$GB>$NA*Br<+M3$J@_Dj$r;XDj$9$k$3$H$,\e(B
- \e$B$G$-$^$9!#$=$NCf$N%3%a%s%H$rFI$s$G$/$@$5$$!#\e(B
+ \e$B$^$?!"\e(BFLIM-CFG \e$B%U%!%$%k$rJT=8$9$k$3$H$GB>$NA*Br2DG=$J@_Dj$r;XDj$9$k\e(B
+
\e$B$3$H$,$G$-$^$9!#$=$N>\:Y$K4X$7$F$O
\e(B FLIM-CFG
\e$B%U%!%$%k$NCm<a
\e(B (comment)
+ \e$B$rFI$s$G$/$@$5$$!#\e(B
-(1-c) XEmacs \e$B$N%Q%C%1!<%8$H$7$F%$%s%9%H!<%k$9$k\e(B
+(1-c) XEmacs \e$B$N%Q%C%1!<%8$H$7$FF3F~$9$k\e(B
- XEmacs \e$B$N%Q%C%1!<%8%G%#%l%/%H%j!<$K%$%s%9%H!<%k$9$k>l9g$O!"0J2<$N$3\e(B
- \e$B$H$r$7$F$/$@$5$$\e(B:
+ XEmacs \e$B$N%Q%C%1!<%8!&%G%#%l%/%H%j!<$KF3F~$9$k>l9g$O!"\e(B
% make install-package
- emacs \e$B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"\e(B
+ \e$B$r<B9T$7$F$/$@$5$$!#\e(B
+
+ XEmacs \e$B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc!'\e(B
% make install-package XEMACS=xemacs-21
`XEMACS=...' \e$B$,>JN,$5$l$k$H!"\e(BXEMACS=xemacs \e$B$,;HMQ$5$l$^$9!#\e(B
- \e$B%Q%C%1!<%8$N%G%#%l%/%H%j!<$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P\e(B:
+ \e$B%Q%C%1!<%8!&%G%#%l%/%H%j!<$r;XDj$9$k$3$H$,$G$-$^$9!#Nc!'\e(B
% make install PACKAGEDIR=~/.xemacs
- `PACKAGEDIR=...' \e$B$,>JN,$5$l$k$H!"B8:_$9$k%Q%C%1!<%8%G%#%l%/%H%j!<$N\e(B
- \e$B:G=i$N$b$N$,;H$o$l$^$9!#\e(B
+ `PACKAGEDIR=...' \e$B$,>JN,$5$l$k$H!"B8:_$9$k%Q%C%1!<%8!&%G%#%l%/%H%j!<\e(B
+ \e$B$N:G=i$N$b$N$,;H$o$l$^$9!#\e(B
+
+ \e$B!NCm0U!O\e(BXEmacs \e$B$N%Q%C%1!<%8!&%7%9%F%`$O\e(B XEmacs 21.0 \e$B$+$=$l0J9_$,I,MW\e(B
+ \e$B$G$9!#\e(B
- XEmacs \e$B$N%Q%C%1!<%8%7%9%F%`$O\e(B XEmacs 21.0 \e$B$+$=$l0J9_$rMW5a$9$k$3$H$K\e(B
- \e$BCm0U$7$F$/$@$5$$!#\e(B
load-path (Emacs \e$B$H\e(B MULE \e$BMQ\e(B)
=============================
- Emacs \e$B$+\e(B Mule \e$B$r;H$C$F$$$k$J$i!"\e(BFLIM \e$B$N%G%#%l%/%H%j!<$r\e(B
- load-path \e$B$KDI2C$7$F$/$@$5$$!#=i4|@_Dj$G%$%s%9%H!<%k$7$?$J$i!"<!$N$h\e(B
- \e$B$&$K\e(B subdirs.el \e$B$r=q$/$3$H$,$G$-$^$9!#Nc\e(B:
+ Emacs \e$B$+\e(B Mule \e$B$r;H$C$F$$$k$J$i!"\e(BFLIM \e$B$N%G%#%l%/%H%j!<$r\e(B load-path \e$B$K\e(B
+ \e$BDI2C$7$F$/$@$5$$!#=i4|@_Dj$N$^$^F3F~$7$?$J$i!"<!$N$h$&$K\e(B subdirs.el
+ \e$B$r=q$/$3$H$,$G$-$^$9!#Nc\e(B:
--------------------------------------------------------------------
(normal-top-level-add-to-load-path '("apel" "flim"))
XEmacs \e$B$r;H$C$F$$$k$J$i!"\e(Bload-path \e$B$r@_Dj$9$kI,MW$O$"$j$^$;$s!#\e(B
+
\e$B%P%0Js9p\e(B
-===========
+========
\e$B%P%0Js9p$d2~A1$NDs0F$r=q$$$?$H$-$O!"@'Hs\e(B tm \e$B%a!<%j%s%0%j%9%H$KAw$C$F\e(B
\e$B$/$@$5$$\e(B:
1.11.0 Yamadagawa \e$(B;3ED@n\e(B
1.11.1 Takanohara \e$(B9b$N86\e(B
1.11.2 Heij\e-Dò\e-A \e$(BJ?>k\e(B
-1.11.3 Saidaiji \e$(B@>Bg;{\e(B
+1.11.3 Saidaiji \e$(B@>Bg;{\e(B ; = \e$(B6aE4\e(B \e$(BF`NI@~\e(B
;;-------------------------------------------------------------------------
;; Kinki Nippon Railway \e$(B6a5&F|K\E4F;\e(B http://www.kintetsu.co.jp/
;; Ky\e-Dòto\e-A Line \e$(B3`86@~\e(B
;;-------------------------------------------------------------------------
(Saidaiji) (\e$(B@>Bg;{\e(B)
------ Amagatsuji \e$(BFt%vDT\e(B
------ Nishinoky\e-Dò\e-A \e$(B@>$N5~\e(B
------ Kuj\e-Dò\e-A \e$(B6e>r\e(B
------ Kintetsu-K\e-Dòriyama\e-A \e$(B6aE474;3\e(B
+1.12.0 Amagatsuji \e$(BFt%vDT\e(B
+1.12.1 Nishinoky\e-Dò\e-A \e$(B@>$N5~\e(B
+1.12.2 Kuj\e-Dò\e-A \e$(B6e>r\e(B
+1.12.3 Kintetsu-K\e-Dòriyama\e-A \e$(B6aE474;3\e(B
+1.12.4 Tsutsui \e$(BE{0f\e(B
+1.12.5 Hirahata \e$(BJ?C<\e(B ; = \e$(B6aE4\e(B \e$(BE7M}@~\e(B
+1.12.6 Family-K\e-Dòenmae\e-A \e$(B%U%!%_%j!<8x1`A0\e(B
+------ Y\e-Dþzaki\e-A \e$(B7k:j\e(B
+------ Iwami \e$(B@P8+\e(B
+------ Tawaramoto \e$(BED86K\\e(B ; <=> \e$(B6aE4\e(B \e$(B@>ED86K\\e(B
+------ Kasanui \e$(B3^K%\e(B
+------ Ninokuchi \e$(B?7%N8}\e(B
+------ Yagi \e$(BH,LZ\e(B ; = \e$(B6aE4\e(B \e$(BBg:e@~\e(B
+------ Yagi-Nishiguchi \e$(BH,LZ@>8}\e(B
+------ Unebigory\e-Dòmae\e-A \e$(B@&K58fNMA0\e(B
+------ Kashiharajingu-mae \e$(B3`86?@5\A0\e(B ; = \e$(B6aE4\e(B \e$(BFnBg:e@~!"5HLn@~\e(B
[Chao Version names]
1.11.3 Kitayama \e$(BKL;3\e(B
1.11.4 Matugasaki \e$(B>>%v:j\e(B
1.11.5 Kokusaikaikan \e$(B9q:]2q4[\e(B
+
+;;-------------------------------------------------------------------------
+;; West Japan Railway \e$(B@>F|K\N95RE4F;\e(B http://www.westjr.co.jp/
+;; Nara Line \e$(BF`NI@~\e(B
+;;-------------------------------------------------------------------------
+1.12.0 [JR] Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> \e$(B6aE4\e(B, \e$(B5~ET;T8rDL6I\e(B
+1.12.1 T\e-Dòfukuji\e-A \e$(BElJ!;{\e(B ; <=> \e$(B5~:e\e(B
+1.12.2 Inari \e$(B0p2Y\e(B
;; TANAKA Akira <akr@jaist.ac.jp>
;; Created: 1995/10/03
;; Original: 1992/07/20 ENAMI Tsugutomo's `mime.el'.
-;; Renamed: 1993/06/03 to tiny-mime.el
-;; Renamed: 1995/10/03 from tiny-mime.el (split off encoder)
-;; Renamed: 1997/02/22 from tm-ew-d.el
+;; Renamed: 1993/06/03 to tiny-mime.el by MORIOKA Tomohiko
+;; Renamed: 1995/10/03 to tm-ew-d.el (split off encoder)
+;; by MORIOKA Tomohiko
+;; Renamed: 1997/02/22 from tm-ew-d.el by MORIOKA Tomohiko
;; Keywords: encoded-word, MIME, multilingual, header, mail, news
-;; This file is part of SEMI (Spadework for Emacs MIME Interfaces).
+;; 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
(require 'mel)
(require 'mime-def)
+(eval-when-compile (require 'cl))
+
(defgroup eword-decode nil
"Encoded-word decoding"
:group 'mime)
(eval-and-compile
(defconst eword-encoded-text-regexp "[!->@-~]+")
+
+ (defconst eword-encoded-word-regexp
+ (eval-when-compile
+ (concat (regexp-quote "=?")
+ "\\("
+ mime-charset-regexp
+ "\\)"
+ (regexp-quote "?")
+ "\\([BbQq]\\)"
+ (regexp-quote "?")
+ "\\("
+ eword-encoded-text-regexp
+ "\\)"
+ (regexp-quote "?="))))
)
-(defconst eword-encoded-word-regexp
- (eval-when-compile
- (concat (regexp-quote "=?")
- "\\("
- mime-charset-regexp
- "\\)"
- (regexp-quote "?")
- "\\(B\\|Q\\)"
- (regexp-quote "?")
- "\\("
- eword-encoded-text-regexp
- "\\)"
- (regexp-quote "?="))))
;;; @ for string
(concat dest string)
))
-(defun eword-decode-and-fold-structured-field
- (string start-column &optional max-column must-unfold)
- "Decode and fold (fill) STRING as structured field body.
+(defun eword-decode-structured-field-body (string
+ &optional start-column max-column
+ start)
+ (let ((tokens (eword-lexical-analyze string start 'must-unfold))
+ (result "")
+ token)
+ (while tokens
+ (setq token (car tokens))
+ (setq result (concat result (eword-decode-token token)))
+ (setq tokens (cdr tokens)))
+ result))
+
+(defun eword-decode-and-unfold-structured-field-body (string
+ &optional
+ start-column
+ max-column
+ start)
+ "Decode and unfold STRING as structured field body.
It decodes non us-ascii characters in FULL-NAME encoded as
encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii
characters are regarded as variable `default-mime-charset'.
If an encoded-word is broken or your emacs implementation can not
-decode the charset included in it, it is not decoded.
-
-If MAX-COLUMN is omitted, `fill-column' is used.
+decode the charset included in it, it is not decoded."
+ (let ((tokens (eword-lexical-analyze string start 'must-unfold))
+ (result ""))
+ (while tokens
+ (let* ((token (car tokens))
+ (type (car token)))
+ (setq tokens (cdr tokens))
+ (setq result
+ (if (eq type 'spaces)
+ (concat result " ")
+ (concat result (eword-decode-token token))
+ ))))
+ result))
-If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
-if there are in decoded encoded-words (generated by bad manner MUA
-such as a version of Net$cape)."
+(defun eword-decode-and-fold-structured-field-body (string
+ start-column
+ &optional max-column
+ start)
(if (and eword-max-size-to-decode
(> (length string) eword-max-size-to-decode))
string
(or max-column
(setq max-column fill-column))
(let ((c start-column)
- (tokens (eword-lexical-analyze string must-unfold))
+ (tokens (eword-lexical-analyze string start 'must-unfold))
(result "")
token)
(while (and (setq token (car tokens))
(concat result (eword-decode-token token))
result))))
-(defun eword-decode-and-unfold-structured-field (string)
- "Decode and unfold STRING as structured field body.
-It decodes non us-ascii characters in FULL-NAME encoded as
-encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii
-characters are regarded as variable `default-mime-charset'.
-
-If an encoded-word is broken or your emacs implementation can not
-decode the charset included in it, it is not decoded."
- (let ((tokens (eword-lexical-analyze string 'must-unfold))
- (result ""))
- (while tokens
- (let* ((token (car tokens))
- (type (car token)))
- (setq tokens (cdr tokens))
- (setq result
- (if (eq type 'spaces)
- (concat result " ")
- (concat result (eword-decode-token token))
- ))))
- result))
-
-(defun eword-decode-structured-field-body (string &optional must-unfold
- start-column max-column)
- "Decode non us-ascii characters in STRING as structured field body.
-STRING is unfolded before decoding.
-
-It decodes non us-ascii characters in FULL-NAME encoded as
-encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii
-characters are regarded as variable `default-mime-charset'.
-
-If an encoded-word is broken or your emacs implementation can not
-decode the charset included in it, it is not decoded.
-
-If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
-if there are in decoded encoded-words (generated by bad manner MUA
-such as a version of Net$cape)."
- (if start-column
- ;; fold with max-column
- (eword-decode-and-fold-structured-field
- string start-column max-column must-unfold)
- ;; Don't fold
- (mapconcat (function eword-decode-token)
- (eword-lexical-analyze string must-unfold)
- "")
- ))
-
-(defun eword-decode-unstructured-field-body (string &optional must-unfold)
- "Decode non us-ascii characters in STRING as unstructured field body.
-STRING is unfolded before decoding.
-
-It decodes non us-ascii characters in FULL-NAME encoded as
-encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii
-characters are regarded as variable `default-mime-charset'.
-
-If an encoded-word is broken or your emacs implementation can not
-decode the charset included in it, it is not decoded.
-
-If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even
-if there are in decoded encoded-words (generated by bad manner MUA
-such as a version of Net$cape)."
+(defun eword-decode-unstructured-field-body (string &optional start-column
+ max-column)
(eword-decode-string
- (decode-mime-charset-string string default-mime-charset)
- must-unfold))
+ (decode-mime-charset-string string default-mime-charset)))
-(defun eword-decode-and-unfold-unstructured-field (string)
- "Decode and unfold STRING as unstructured field body.
-It decodes non us-ascii characters in FULL-NAME encoded as
-encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii
-characters are regarded as variable `default-mime-charset'.
-
-If an encoded-word is broken or your emacs implementation can not
-decode the charset included in it, it is not decoded."
+(defun eword-decode-and-unfold-unstructured-field-body (string
+ &optional start-column
+ max-column)
(eword-decode-string
(decode-mime-charset-string (std11-unfold-string string)
default-mime-charset)
'must-unfold))
+(defun eword-decode-unfolded-unstructured-field-body (string
+ &optional start-column
+ max-column)
+ (eword-decode-string
+ (decode-mime-charset-string string default-mime-charset)
+ 'must-unfold))
+
;;; @ for region
;;;
)
)))
+(defun eword-decode-unfold ()
+ (goto-char (point-min))
+ (let (field beg end)
+ (while (re-search-forward std11-field-head-regexp nil t)
+ (setq beg (match-beginning 0)
+ end (std11-field-end))
+ (setq field (buffer-substring beg end))
+ (if (string-match eword-encoded-word-regexp field)
+ (save-restriction
+ (narrow-to-region (goto-char beg) end)
+ (while (re-search-forward "\n\\([ \t]\\)" nil t)
+ (replace-match (match-string 1))
+ )
+ (goto-char (point-max))
+ ))
+ )))
+
;;; @ for message header
;;;
-(defcustom eword-decode-ignored-field-list
- '(Newsgroups Path Lines Nntp-Posting-Host Received Message-Id Date)
- "*List of field-names to be ignored when decoding.
-Each field name must be symbol."
- :group 'eword-decode
- :type '(repeat symbol))
-
-(defcustom eword-decode-structured-field-list
- '(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender
- To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc
- Mail-Followup-To
- Mime-Version Content-Type Content-Transfer-Encoding
- Content-Disposition User-Agent)
- "*List of field-names to decode as structured field.
-Each field name must be symbol."
- :group 'eword-decode
- :type '(repeat symbol))
+(defvar mime-field-decoder-alist nil)
+
+(defvar mime-field-decoder-cache nil)
+
+(defvar mime-update-field-decoder-cache 'mime-update-field-decoder-cache
+ "*Field decoder cache update function.")
+
+;;;###autoload
+(defun mime-set-field-decoder (field &rest specs)
+ "Set decoder of FILED.
+SPECS must be like `MODE1 DECODER1 MODE2 DECODER2 ...'.
+Each mode must be `nil', `plain', `wide', `summary' or `nov'.
+If mode is `nil', corresponding decoder is set up for every modes."
+ (when specs
+ (let ((mode (pop specs))
+ (function (pop specs)))
+ (if mode
+ (progn
+ (let ((cell (assq mode mime-field-decoder-alist)))
+ (if cell
+ (setcdr cell (put-alist field function (cdr cell)))
+ (setq mime-field-decoder-alist
+ (cons (cons mode (list (cons field function)))
+ mime-field-decoder-alist))
+ ))
+ (apply (function mime-set-field-decoder) field specs)
+ )
+ (mime-set-field-decoder field
+ 'plain function
+ 'wide function
+ 'summary function
+ 'nov function)
+ ))))
+
+;;;###autoload
+(defmacro mime-find-field-presentation-method (name)
+ "Return field-presentation-method from NAME.
+NAME must be `plain', `wide', `summary' or `nov'."
+ (cond ((eq name nil)
+ `(or (assq 'summary mime-field-decoder-cache)
+ '(summary))
+ )
+ ((and (consp name)
+ (car name)
+ (consp (cdr name))
+ (symbolp (car (cdr name)))
+ (null (cdr (cdr name))))
+ `(or (assq ,name mime-field-decoder-cache)
+ (cons ,name nil))
+ )
+ (t
+ `(or (assq (or ,name 'summary) mime-field-decoder-cache)
+ (cons (or ,name 'summary) nil))
+ )))
+
+(defun mime-find-field-decoder-internal (field &optional mode)
+ "Return function to decode field-body of FIELD in MODE.
+Optional argument MODE must be object of field-presentation-method."
+ (cdr (or (assq field (cdr mode))
+ (prog1
+ (funcall mime-update-field-decoder-cache
+ field (car mode))
+ (setcdr mode
+ (cdr (assq (car mode) mime-field-decoder-cache)))
+ ))))
+
+;;;###autoload
+(defun mime-find-field-decoder (field &optional mode)
+ "Return function to decode field-body of FIELD in MODE.
+Optional argument MODE must be object or name of
+field-presentation-method. Name of field-presentation-method must be
+`plain', `wide', `summary' or `nov'.
+Default value of MODE is `summary'."
+ (if (symbolp mode)
+ (let ((p (cdr (mime-find-field-presentation-method mode))))
+ (if (and p (setq p (assq field p)))
+ (cdr p)
+ (cdr (funcall mime-update-field-decoder-cache
+ field (or mode 'summary)))))
+ (inline (mime-find-field-decoder-internal field mode))
+ ))
-(defun eword-decode-field-body
- (field-body field-name &optional unfolded max-column)
- "Decode FIELD-BODY as FIELD-NAME, and return the result.
+;;;###autoload
+(defun mime-update-field-decoder-cache (field mode &optional function)
+ "Update field decoder cache `mime-field-decoder-cache'."
+ (cond ((eq function 'identity)
+ (setq function nil)
+ )
+ ((null function)
+ (let ((decoder-alist
+ (cdr (assq (or mode 'summary) mime-field-decoder-alist))))
+ (setq function (cdr (or (assq field decoder-alist)
+ (assq t decoder-alist)))))
+ ))
+ (let ((cell (assq mode mime-field-decoder-cache))
+ ret)
+ (if cell
+ (if (setq ret (assq field (cdr cell)))
+ (setcdr ret function)
+ (setcdr cell (cons (setq ret (cons field function)) (cdr cell))))
+ (setq mime-field-decoder-cache
+ (cons (cons mode (list (setq ret (cons field function))))
+ mime-field-decoder-cache)))
+ ret))
+
+;; ignored fields
+(mime-set-field-decoder 'Archive nil nil)
+(mime-set-field-decoder 'Content-Md5 nil nil)
+(mime-set-field-decoder 'Control nil nil)
+(mime-set-field-decoder 'Date nil nil)
+(mime-set-field-decoder 'Distribution nil nil)
+(mime-set-field-decoder 'Followup-Host nil nil)
+(mime-set-field-decoder 'Followup-To nil nil)
+(mime-set-field-decoder 'Lines nil nil)
+(mime-set-field-decoder 'Message-Id nil nil)
+(mime-set-field-decoder 'Newsgroups nil nil)
+(mime-set-field-decoder 'Nntp-Posting-Host nil nil)
+(mime-set-field-decoder 'Path nil nil)
+(mime-set-field-decoder 'Posted-And-Mailed nil nil)
+(mime-set-field-decoder 'Received nil nil)
+(mime-set-field-decoder 'Status nil nil)
+(mime-set-field-decoder 'X-Face nil nil)
+(mime-set-field-decoder 'X-Face-Version nil nil)
+(mime-set-field-decoder 'X-Info nil nil)
+(mime-set-field-decoder 'X-Pgp-Key-Info nil nil)
+(mime-set-field-decoder 'X-Pgp-Sig nil nil)
+(mime-set-field-decoder 'X-Pgp-Sig-Version nil nil)
+(mime-set-field-decoder 'Xref nil nil)
+
+;; structured fields
+(let ((fields
+ '(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender
+ To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc
+ Mail-Followup-To
+ Mime-Version Content-Type Content-Transfer-Encoding
+ Content-Disposition User-Agent))
+ field)
+ (while fields
+ (setq field (pop fields))
+ (mime-set-field-decoder
+ field
+ 'plain #'eword-decode-structured-field-body
+ 'wide #'eword-decode-and-fold-structured-field-body
+ 'summary #'eword-decode-and-unfold-structured-field-body
+ 'nov #'eword-decode-and-unfold-structured-field-body)
+ ))
-If UNFOLDED is non-nil, it is assumed that FIELD-BODY is
-already unfolded.
+;; unstructured fields (default)
+(mime-set-field-decoder
+ t
+ 'plain #'eword-decode-unstructured-field-body
+ 'wide #'eword-decode-unstructured-field-body
+ 'summary #'eword-decode-and-unfold-unstructured-field-body
+ 'nov #'eword-decode-unfolded-unstructured-field-body)
-If MAX-COLUMN is non-nil, the result is folded with MAX-COLUMN
-or `fill-column' if MAX-COLUMN is t.
-Otherwise, the result is unfolded.
+;;;###autoload
+(defun mime-decode-field-body (field-body field-name
+ &optional mode max-column)
+ "Decode FIELD-BODY as FIELD-NAME in MODE, and return the result.
+Optional argument MODE must be `plain', `wide', `summary' or `nov'.
+Default mode is `summary'.
-MIME encoded-word in FIELD-BODY is recognized according to
-`eword-decode-ignored-field-list',
-`eword-decode-structured-field-list' and FIELD-NAME.
+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'."
- (when (eq max-column t)
- (setq max-column fill-column))
- (let (field-name-symbol len)
+ (let (field-name-symbol len decoder)
(if (symbolp field-name)
(setq field-name-symbol field-name
len (1+ (string-width (symbol-name field-name))))
(setq field-name-symbol (intern (capitalize field-name))
len (1+ (string-width field-name))))
- (if (memq field-name-symbol eword-decode-ignored-field-list)
- ;; Don't decode
- (if max-column
- field-body
- (std11-unfold-string field-body))
- (if (memq field-name-symbol eword-decode-structured-field-list)
- ;; Decode as structured field
- (if max-column
- (eword-decode-and-fold-structured-field
- field-body len max-column t)
- (eword-decode-and-unfold-structured-field field-body))
- ;; Decode as unstructured field
- (if max-column
- (eword-decode-unstructured-field-body field-body len)
- (eword-decode-unstructured-field-body
- (std11-unfold-string field-body) len))))))
-
-(defun eword-decode-header (&optional code-conversion separator)
- "Decode MIME encoded-words in header fields.
+ (setq decoder (mime-find-field-decoder field-name-symbol mode))
+ (if decoder
+ (funcall decoder field-body len max-column)
+ ;; Don't decode
+ (if (eq mode 'summary)
+ (std11-unfold-string field-body)
+ field-body)
+ )))
+
+;;;###autoload
+(defun mime-decode-header-in-region (start end
+ &optional code-conversion)
+ "Decode MIME encoded-words in region between START and END.
If CODE-CONVERSION is nil, it decodes only encoded-words. If it is
mime-charset, it decodes non-ASCII bit patterns as the mime-charset.
Otherwise it decodes non-ASCII bit patterns as the
-default-mime-charset.
-If SEPARATOR is not nil, it is used as header separator."
- (interactive "*")
+default-mime-charset."
+ (interactive "*r")
(save-excursion
(save-restriction
- (std11-narrow-to-header separator)
+ (narrow-to-region start end)
(let ((default-charset
(if code-conversion
(if (mime-charset-to-coding-system code-conversion)
code-conversion
default-mime-charset))))
(if default-charset
- (let (beg p end field-name len)
+ (let ((mode-obj (mime-find-field-presentation-method 'wide))
+ beg p end field-name len field-decoder)
(goto-char (point-min))
(while (re-search-forward std11-field-head-regexp nil t)
(setq beg (match-beginning 0)
field-name (buffer-substring beg (1- p))
len (string-width field-name)
field-name (intern (capitalize field-name))
- end (std11-field-end))
- (cond ((memq field-name eword-decode-ignored-field-list)
- ;; Don't decode
- )
- ((memq field-name eword-decode-structured-field-list)
- ;; Decode as structured field
- (let ((body (buffer-substring p end))
- (default-mime-charset default-charset))
- (delete-region p end)
- (insert (eword-decode-and-fold-structured-field
- body (1+ len)))
- ))
- (t
- ;; Decode as unstructured field
- (save-restriction
- (narrow-to-region beg (1+ end))
- (decode-mime-charset-region p end default-charset)
- (goto-char p)
- (if (re-search-forward eword-encoded-word-regexp
- nil t)
- (eword-decode-region beg (point-max) 'unfold))
- )))))
+ field-decoder (inline
+ (mime-find-field-decoder-internal
+ field-name mode-obj)))
+ (when field-decoder
+ (setq end (std11-field-end))
+ (let ((body (buffer-substring p end))
+ (default-mime-charset default-charset))
+ (delete-region p end)
+ (insert (funcall field-decoder body (1+ len)))
+ ))
+ ))
(eword-decode-region (point-min) (point-max) t)
)))))
-(defun eword-decode-unfold ()
- (goto-char (point-min))
- (let (field beg end)
- (while (re-search-forward std11-field-head-regexp nil t)
- (setq beg (match-beginning 0)
- end (std11-field-end))
- (setq field (buffer-substring beg end))
- (if (string-match eword-encoded-word-regexp field)
- (save-restriction
- (narrow-to-region (goto-char beg) end)
- (while (re-search-forward "\n\\([ \t]\\)" nil t)
- (replace-match (match-string 1))
- )
- (goto-char (point-max))
- ))
- )))
+;;;###autoload
+(defun mime-decode-header-in-buffer (&optional code-conversion separator)
+ "Decode MIME encoded-words in header fields.
+If CODE-CONVERSION is nil, it decodes only encoded-words. If it is
+mime-charset, it decodes non-ASCII bit patterns as the mime-charset.
+Otherwise it decodes non-ASCII bit patterns as the
+default-mime-charset.
+If SEPARATOR is not nil, it is used as header separator."
+ (interactive "*")
+ (mime-decode-header-in-region
+ (point-min)
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^\\(" (regexp-quote (or separator "")) "\\)?$")
+ nil t)
+ (match-beginning 0)
+ (point-max)
+ ))
+ code-conversion))
+
+(define-obsolete-function-alias 'eword-decode-header
+ 'mime-decode-header-in-buffer)
;;; @ encoded-word decoder
"*Max position of eword-lexical-analyze-cache.
It is max size of eword-lexical-analyze-cache - 1.")
-(defcustom eword-lexical-analyzers
+(defcustom eword-lexical-analyzer
'(eword-analyze-quoted-string
eword-analyze-domain-literal
eword-analyze-comment
eword-analyze-encoded-word
eword-analyze-atom)
"*List of functions to return result of lexical analyze.
-Each function must have two arguments: STRING and MUST-UNFOLD.
+Each function must have three arguments: STRING, START and MUST-UNFOLD.
STRING is the target string to be analyzed.
+START is start position of STRING to analyze.
If MUST-UNFOLD is not nil, each function must unfold and eliminate
bare-CR and bare-LF from the result even if they are included in
content of the encoded-word.
:group 'eword-decode
:type '(repeat function))
-(defun eword-analyze-quoted-string (string &optional must-unfold)
- (let ((p (std11-check-enclosure string ?\" ?\")))
+(defun eword-analyze-quoted-string (string start &optional must-unfold)
+ (let ((p (std11-check-enclosure string ?\" ?\" nil start)))
(if p
(cons (cons 'quoted-string
(decode-mime-charset-string
- (std11-strip-quoted-pair (substring string 1 (1- p)))
+ (std11-strip-quoted-pair
+ (substring string (1+ start) (1- p)))
default-mime-charset))
- (substring string p))
+ ;;(substring string p))
+ p)
)))
-(defun eword-analyze-domain-literal (string &optional must-unfold)
- (std11-analyze-domain-literal string))
-
-(defun eword-analyze-comment (string &optional must-unfold)
- (let ((p (std11-check-enclosure string ?\( ?\) t)))
- (if p
- (cons (cons 'comment
- (eword-decode-string
- (decode-mime-charset-string
- (std11-strip-quoted-pair (substring string 1 (1- p)))
- default-mime-charset)
- must-unfold))
- (substring string p))
- )))
+(defun eword-analyze-domain-literal (string start &optional must-unfold)
+ (std11-analyze-domain-literal string start))
+
+(defun eword-analyze-comment (string from &optional must-unfold)
+ (let ((len (length string))
+ (i (or from 0))
+ dest last-str
+ chr ret)
+ (when (and (> len i)
+ (eq (aref string i) ?\())
+ (setq i (1+ i)
+ from i)
+ (catch 'tag
+ (while (< i len)
+ (setq chr (aref string i))
+ (cond ((eq chr ?\\)
+ (setq i (1+ i))
+ (if (>= i len)
+ (throw 'tag nil)
+ )
+ (setq last-str (concat last-str
+ (substring string from (1- i))
+ (char-to-string (aref string i)))
+ i (1+ i)
+ from i)
+ )
+ ((eq chr ?\))
+ (setq ret (concat last-str
+ (substring string from i)))
+ (throw 'tag (cons
+ (cons 'comment
+ (nreverse
+ (if (string= ret "")
+ dest
+ (cons
+ (eword-decode-string
+ (decode-mime-charset-string
+ ret default-mime-charset)
+ must-unfold)
+ dest)
+ )))
+ (1+ i)))
+ )
+ ((eq chr ?\()
+ (if (setq ret (eword-analyze-comment string i must-unfold))
+ (setq last-str
+ (concat last-str
+ (substring string from i))
+ dest
+ (if (string= last-str "")
+ (cons (car ret) dest)
+ (list* (car ret)
+ (eword-decode-string
+ (decode-mime-charset-string
+ last-str default-mime-charset)
+ must-unfold)
+ dest)
+ )
+ i (cdr ret)
+ from i
+ last-str "")
+ (throw 'tag nil)
+ ))
+ (t
+ (setq i (1+ i))
+ ))
+ )))))
-(defun eword-analyze-spaces (string &optional must-unfold)
- (std11-analyze-spaces string))
+(defun eword-analyze-spaces (string start &optional must-unfold)
+ (std11-analyze-spaces string start))
-(defun eword-analyze-special (string &optional must-unfold)
- (std11-analyze-special string))
+(defun eword-analyze-special (string start &optional must-unfold)
+ (std11-analyze-special string start))
-(defun eword-analyze-encoded-word (string &optional must-unfold)
- (if (eq (string-match eword-encoded-word-regexp string) 0)
+(defun eword-analyze-encoded-word (string start &optional must-unfold)
+ (if (and (string-match eword-encoded-word-regexp string start)
+ (= (match-beginning 0) start))
(let ((end (match-end 0))
(dest (eword-decode-encoded-word (match-string 0 string)
must-unfold))
)
- (setq string (substring string end))
- (while (eq (string-match `,(concat "[ \t\n]*\\("
- eword-encoded-word-regexp
- "\\)")
- string)
- 0)
+ ;;(setq string (substring string end))
+ (setq start end)
+ (while (and (string-match (eval-when-compile
+ (concat "[ \t\n]*\\("
+ eword-encoded-word-regexp
+ "\\)"))
+ string start)
+ (= (match-beginning 0) start))
(setq end (match-end 0))
(setq dest
(concat dest
(eword-decode-encoded-word (match-string 1 string)
must-unfold))
- string (substring string end))
+ ;;string (substring string end))
+ start end)
)
- (cons (cons 'atom dest) string)
+ (cons (cons 'atom dest) ;;string)
+ end)
)))
-(defun eword-analyze-atom (string &optional must-unfold)
- (if (string-match std11-atom-regexp string)
+(defun eword-analyze-atom (string start &optional must-unfold)
+ (if (and (string-match std11-atom-regexp string start)
+ (= (match-beginning 0) start))
(let ((end (match-end 0)))
(cons (cons 'atom (decode-mime-charset-string
- (substring string 0 end)
+ (substring string start end)
default-mime-charset))
- (substring string end)
- ))))
+ ;;(substring string end)
+ end)
+ )))
-(defun eword-lexical-analyze-internal (string must-unfold)
- (let (dest ret)
- (while (not (string-equal string ""))
+(defun eword-lexical-analyze-internal (string start must-unfold)
+ (let ((len (length string))
+ dest ret)
+ (while (< start len)
(setq ret
- (let ((rest eword-lexical-analyzers)
+ (let ((rest eword-lexical-analyzer)
func r)
(while (and (setq func (car rest))
- (null (setq r (funcall func string must-unfold)))
+ (null
+ (setq r (funcall func string start must-unfold)))
)
(setq rest (cdr rest)))
- (or r `((error . ,string) . ""))
+ (or r
+ (list (cons 'error (substring string start)) (1+ len)))
))
- (setq dest (cons (car ret) dest))
- (setq string (cdr ret))
+ (setq dest (cons (car ret) dest)
+ start (cdr ret))
)
(nreverse dest)
))
-(defun eword-lexical-analyze (string &optional must-unfold)
+(defun eword-lexical-analyze (string &optional start must-unfold)
"Return lexical analyzed list corresponding STRING.
It is like std11-lexical-analyze, but it decodes non us-ascii
characters encoded as encoded-words or invalid \"raw\" format.
\"Raw\" non us-ascii characters are regarded as variable
`default-mime-charset'."
- (let ((key (copy-sequence string))
- ret)
+ (let ((key (substring string (or start 0)))
+ ret cell)
(set-text-properties 0 (length key) nil key)
(if (setq ret (assoc key eword-lexical-analyze-cache))
(cdr ret)
- (setq ret (eword-lexical-analyze-internal key must-unfold))
+ (setq ret (eword-lexical-analyze-internal key 0 must-unfold))
(setq eword-lexical-analyze-cache
(cons (cons key ret)
- (last eword-lexical-analyze-cache
- eword-lexical-analyze-cache-max)))
+ eword-lexical-analyze-cache))
+ (if (cdr (setq cell (nthcdr eword-lexical-analyze-cache-max
+ eword-lexical-analyze-cache)))
+ (setcdr cell nil))
ret)))
(defun eword-decode-token (token)
(cond ((eq type 'quoted-string)
(std11-wrap-as-quoted-string value))
((eq type 'comment)
- (concat "(" (std11-wrap-as-quoted-pairs value '(?( ?))) ")"))
+ (let ((dest ""))
+ (while value
+ (setq dest (concat dest
+ (if (stringp (car value))
+ (std11-wrap-as-quoted-pairs
+ (car value) '(?( ?)))
+ (eword-decode-token (car value))
+ ))
+ value (cdr value))
+ )
+ (concat "(" dest ")")
+ ))
(t value))))
-(defun eword-extract-address-components (string)
+(defun eword-extract-address-components (string &optional start)
"Extract full name and canonical address from STRING.
Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
If no name can be extracted, FULL-NAME will be nil.
characters are regarded as variable `default-mime-charset'."
(let* ((structure (car (std11-parse-address
(eword-lexical-analyze
- (std11-unfold-string string) 'must-unfold))))
+ (std11-unfold-string string) start
+ 'must-unfold))))
(phrase (std11-full-name-string structure))
(address (std11-address-string structure))
)
;;; eword-encode.el --- RFC 2047 based encoded-word encoder for GNU Emacs
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: encoded-word, MIME, multilingual, header, mail, news
;;; Code:
-(require 'emu)
+(require 'poem)
(require 'mel)
(require 'std11)
(require 'mime-def)
(cn-gb . "B")
(cn-gb-2312 . "B")
(euc-kr . "B")
+ (tis-620 . "B")
(iso-2022-jp-2 . "B")
(iso-2022-int-1 . "B")
(utf-8 . "B")
))
(defun eword-encode-rword-list (column rwl)
- (let (ret dest ps special str ew-f pew-f)
+ (let (ret dest ps special str ew-f pew-f bew)
(while rwl
(setq ew-f (nth 2 (car rwl)))
(if (and pew-f ew-f)
(setq rwl (cons '(" ") rwl)
+ bew t
pew-f nil)
- (setq pew-f ew-f)
+ (setq pew-f ew-f
+ bew nil)
)
(setq ret (tm-eword::encode-string-1 column rwl))
(setq str (car ret))
(if (eq (elt str 0) ?\n)
- (if (eq special ?\()
- (progn
- (setq dest (concat dest "\n ("))
- (setq ret (tm-eword::encode-string-1 2 rwl))
- (setq str (car ret))
- ))
+ (cond
+ ((eq special ?\()
+ (setq dest (concat dest "\n ("))
+ (setq ret (tm-eword::encode-string-1 2 rwl))
+ (setq str (car ret)))
+ ((eq bew t)
+ (setq dest (concat dest "\n "))
+ (setq ret (tm-eword::encode-string-1 1 (cdr rwl)))
+ (setq str (car ret))))
(cond ((eq special ? )
(if (string= str "(")
(setq ps t)
(let ((phrase (nth 1 phrase-route-addr))
(route (nth 2 phrase-route-addr))
dest)
- (if (eq (car (car phrase)) 'spaces)
- (setq phrase (cdr phrase))
- )
+ ;; (if (eq (car (car phrase)) 'spaces)
+ ;; (setq phrase (cdr phrase))
+ ;; )
(setq dest (eword-encode-phrase-to-rword-list phrase))
(if dest
(setq dest (append dest '((" " nil nil))))
'((" " nil nil)
("(" nil nil))
(eword-encode-split-string comment 'comment)
- '((")" nil nil))
+ (list '(")" nil nil))
)))
dest))
(if dest
(while (setq addresses (cdr addresses))
(setq dest
- (append dest
- '(("," nil nil))
- '((" " nil nil))
- (eword-encode-mailbox-to-rword-list (car addresses))
- ))
+ (nconc dest
+ (list '("," nil nil))
+ ;; (list '(" " nil nil))
+ (eword-encode-mailbox-to-rword-list (car addresses))
+ ))
))
dest))
(defsubst eword-encode-msg-id-to-rword-list (msg-id)
- (cons '("<" nil nil)
- (append (eword-encode-addr-seq-to-rword-list (cdr msg-id))
- '((">" nil nil)))))
+ (list
+ (list
+ (concat "<"
+ (caar (eword-encode-addr-seq-to-rword-list (cdr msg-id)))
+ ">")
+ nil nil)))
(defsubst eword-encode-in-reply-to-to-rword-list (in-reply-to)
(let (dest)
(car (eword-encode-rword-list
(or column 13)
(eword-encode-in-reply-to-to-rword-list
- (std11-parse-in-reply-to
- (std11-lexical-analyze string))))))
+ (std11-parse-msg-ids-string string)))))
(defun eword-encode-structured-field-body (string &optional column)
"Encode header field STRING as structured field, and return the result.
It is available from
- ftp://ftp.jaist.ac.jp/pub/GNU/elisp/flim/
+ ftp://ftp.etl.go.jp/pub/mule/flim/flim-API
--[[message/external-body;
access-type=anon-ftp;
- site="ftp.jaist.ac.jp";
- directory="/pub/GNU/elisp/flim";
+ site="ftp.etl.go.jp";
+ directory="/pub/mule/flim/flim-API";
name="flim-VERSION.tar.gz";
mode=image]]
Content-Type: application/octet-stream;
(logand v (lsh 255 8))
(lsh (logand v 255) 16)))
+)
+
+(eval-when-compile
+
(defconst mel-ccl-decode-b-0-table
(vconcat
(mapcar
)
-(define-ccl-program mel-ccl-decode-b
- `(1
- (loop
- (read r0 r1 r2 r3)
- (r4 = r0 ,mel-ccl-decode-b-0-table)
- (r5 = r1 ,mel-ccl-decode-b-1-table)
- (r4 |= r5)
- (r5 = r2 ,mel-ccl-decode-b-2-table)
- (r4 |= r5)
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (if (r4 & ,(lognot (1- (lsh 1 24))))
- ((loop
- (if (r4 & ,(lsh 1 24))
- ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
- (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (repeat))
- (break)))
- (loop
- (if (r4 & ,(lsh 1 25))
- ((r1 = r2) (r2 = r3) (read r3)
- (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (repeat))
- (break)))
- (loop
- (if (r2 != ?=)
- (if (r4 & ,(lsh 1 26))
- ((r2 = r3) (read r3)
- (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (repeat))
- ((r6 = 0)
- (break)))
- ((r6 = 1)
- (break))))
- (loop
- (if (r3 != ?=)
- (if (r4 & ,(lsh 1 27))
- ((read r3)
- (r4 = r3 ,mel-ccl-decode-b-3-table)
- (repeat))
- (break))
- ((r6 |= 2)
- (break))))
- (r4 = r0 ,mel-ccl-decode-b-0-table)
- (r5 = r1 ,mel-ccl-decode-b-1-table)
- (r4 |= r5)
- (branch
- r6
- ;; BBBB
- ((r5 = r2 ,mel-ccl-decode-b-2-table)
+(check-broken-facility ccl-cascading-read)
+
+(if-broken ccl-cascading-read
+ (define-ccl-program mel-ccl-decode-b
+ `(1
+ (loop
+ (loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (v)
+ (cond
+ ((or (eq v nil) (eq v t)) '(repeat))
+ (t `((r0 = ,(lsh v 2)) (break)))))
+ mel-ccl-256-to-64-table)))
+ (loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (v)
+ (cond
+ ((or (eq v nil) (eq v t)) '(repeat))
+ ((= (lsh v -4) 0) `((write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))
+ (t `((r0 |= ,(lsh v -4)) (write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))))
+ mel-ccl-256-to-64-table)))
+ (loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (v)
+ (cond
+ ((eq v nil) '(repeat))
+ ((eq v t) '(end))
+ ((= (lsh v -2) 0) `((write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))
+ (t `((r0 |= ,(lsh v -2)) (write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))))
+ mel-ccl-256-to-64-table)))
+ (loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (v)
+ (cond
+ ((eq v nil) '(repeat))
+ ((eq v t) '(end))
+ (t `((r0 |= ,v) (write r0) (break)))))
+ mel-ccl-256-to-64-table)))
+ (repeat))))
+ (define-ccl-program mel-ccl-decode-b
+ `(1
+ (loop
+ (read r0 r1 r2 r3)
+ (r4 = r0 ,mel-ccl-decode-b-0-table)
+ (r5 = r1 ,mel-ccl-decode-b-1-table)
+ (r4 |= r5)
+ (r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (if (r4 & ,(lognot (1- (lsh 1 24))))
+ ((loop
+ (if (r4 & ,(lsh 1 24))
+ ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ (break)))
+ (loop
+ (if (r4 & ,(lsh 1 25))
+ ((r1 = r2) (r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ (break)))
+ (loop
+ (if (r2 != ?=)
+ (if (r4 & ,(lsh 1 26))
+ ((r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ ((r6 = 0)
+ (break)))
+ ((r6 = 1)
+ (break))))
+ (loop
+ (if (r3 != ?=)
+ (if (r4 & ,(lsh 1 27))
+ ((read r3)
+ (r4 = r3 ,mel-ccl-decode-b-3-table)
+ (repeat))
+ (break))
+ ((r6 |= 2)
+ (break))))
+ (r4 = r0 ,mel-ccl-decode-b-0-table)
+ (r5 = r1 ,mel-ccl-decode-b-1-table)
(r4 |= r5)
- (r5 = r3 ,mel-ccl-decode-b-3-table)
- (r4 |= r5)
- (r4 >8= 0)
- (write r7)
- (r4 >8= 0)
- (write r7)
- (write-repeat r4))
- ;; error: BB=B
- ((write (r4 & 255))
- (end))
- ;; BBB=
- ((r5 = r2 ,mel-ccl-decode-b-2-table)
- (r4 |= r5)
- (r4 >8= 0)
- (write r7)
- (write (r4 & 255))
- (end) ; Excessive (end) is workaround for XEmacs 21.0.
+ (branch
+ r6
+ ;; BBBB
+ ((r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4))
+ ;; error: BB=B
+ ((write (r4 & 255))
+ (end))
+ ;; BBB=
+ ((r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r4 >8= 0)
+ (write r7)
+ (write (r4 & 255))
+ (end) ; Excessive (end) is workaround for XEmacs 21.0.
; Without this, "AAA=" is converted to "^@^@^@".
- (end))
- ;; BB==
- ((write (r4 & 255))
- (end))))
- ((r4 >8= 0)
- (write r7)
- (r4 >8= 0)
- (write r7)
- (write-repeat r4))))))
+ (end))
+ ;; BB==
+ ((write (r4 & 255))
+ (end))))
+ ((r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4))))))
+ )
(eval-when-compile
;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
;; is not executed.
-(defun mel-ccl-encode-base64-generic (&optional quantums-per-line output-crlf terminate-with-newline)
+(defun mel-ccl-encode-base64-generic
+ (&optional quantums-per-line output-crlf terminate-with-newline)
`(2
((r3 = 0)
(loop
(defun base64-ccl-insert-encoded-file (filename)
"Encode contents of file FILENAME to base64, and insert the result."
(interactive (list (read-file-name "Insert encoded file: ")))
- (let ((coding-system-for-read 'mel-ccl-base64-lf-rev))
- (insert-file-contents filename)))
+ (insert-file-contents-as-coding-system 'mel-ccl-base64-lf-rev filename))
(mel-define-method-function (mime-encode-string string (nil "base64"))
'base64-ccl-encode-string)
(interactive
(list (region-beginning) (region-end)
(read-file-name "Write decoded region to file: ")))
- (let ((coding-system-for-write 'mel-ccl-b-rev)
- jka-compr-compression-info-list)
- (write-region start end filename)))
+ (write-region-as-coding-system 'mel-ccl-b-rev start end filename))
(mel-define-method-function (mime-decode-string string (nil "base64"))
'base64-ccl-decode-string)
,succ
,fail-crlf))))
+)
+
+(eval-when-compile
+
;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
;; is not executed.
(defun mel-ccl-encode-quoted-printable-generic (input-crlf output-crlf)
(write ,(if output-crlf "=\r\n" "=\n"))
(write r0)
(write "=0D")
- (r0 = r1)
+ (r0 = (r1 + 0)) ; "+ 0" is workaround for mule 2.3@19.34.
(break))
;; r0:r3=ENC CR r1:noLF
((r6 = 6)
(write r0 ,mel-ccl-high-table)
(write r0 ,mel-ccl-low-table)
(write "=0D")
- (r0 = r1)
+ (r0 = (r1 + 0))
(break))))
;; r0:r3={RAW,ENC} r1:noCR
;; r0:r3={RAW,ENC} r1:noCRLF
(r5 = 0)
(write ,(if output-crlf "=\r\n" "=\n"))
(write r0)
- (r0 = r1)
+ (r0 = (r1 + 0))
(break))
;; r0:r3=ENC r1:noCR
;; r0:r3=ENC r1:noCRLF
(write ,(if output-crlf "=\r\n=" "=\n="))
(write r0 ,mel-ccl-high-table)
(write r0 ,mel-ccl-low-table)
- (r0 = r1)
+ (r0 = (r1 + 0))
(break)))))))
(repeat)))
;; EOF
((setq tmp (nth r0 mel-ccl-256-to-16-table))
;; '=' [\t ]* r0:[0-9A-F]
;; upper nibble of hexadecimal digit found.
- `((r1 = r0)
+ `((r1 = (r0 + 0))
(r0 = ,tmp)))
(t
;; '=' [\t ]* r0:[^\r0-9A-F]
;; invalid input ->
;; output "=" with hex digit and rescan from r2.
(write ?=)
- (r0 = r2)
+ (r0 = (r2 + 0))
(write-repeat r1)))
(t
;; r0:[^\t\r -~]
(defun quoted-printable-ccl-insert-encoded-file (filename)
"Encode contents of the file named as FILENAME, and insert it."
(interactive (list (read-file-name "Insert encoded file: ")))
- (let ((coding-system-for-read 'mel-ccl-quoted-printable-lf-lf-rev))
- (insert-file-contents filename)))
+ (insert-file-contents-as-coding-system
+ 'mel-ccl-quoted-printable-lf-lf-rev filename))
(mel-define-method-function
(mime-encode-string string (nil "quoted-printable"))
(interactive
(list (region-beginning) (region-end)
(read-file-name "Write decoded region to file: ")))
- (let ((coding-system-for-write 'mel-ccl-quoted-printable-lf-lf-rev))
- (write-region start end filename)))
+ (write-region-as-coding-system 'mel-ccl-quoted-printable-lf-lf-rev
+ start end filename))
(mel-define-method-function
(mime-decode-string string (nil "quoted-printable"))
(mel-define-backend "binary" ("8bit"))
-(when (and (fboundp 'base64-encode-string)
- (subrp (symbol-function 'base64-encode-string)))
+(defvar mel-b-builtin
+ (and (fboundp 'base64-encode-string)
+ (subrp (symbol-function 'base64-encode-string))))
+
+(when mel-b-builtin
(mel-define-backend "base64")
(mel-define-method-function (mime-encode-string string (nil "base64"))
'base64-encode-string)
ENCODING must be string. If ENCODING is found in
`mime-string-decoding-method-alist' as its key, this function decodes
the STRING by its value."
- (funcall (mel-find-function 'mime-decode-string encoding)
- string))
+ (let ((f (mel-find-function 'mime-decode-string encoding)))
+ (if f
+ (funcall f string)
+ string)))
(mel-define-service encoded-text-encode-string (string encoding)
;;; mime-def.el --- definition module about MIME
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: definition, MIME, multimedia, mail, news
(require 'mcharset)
(eval-and-compile
- (defconst mime-library-product ["FLIM" (1 11 3) "Saidaiji"]
+ (defconst mime-library-product ["FLIM" (1 12 6) "Family-K\e.D\8eòenmae"]
"Product name, version number and code name of MIME-library package.")
)
;;; @ required functions
;;;
-(defsubst eliminate-top-spaces (string)
- "Eliminate top sequence of space or tab in STRING."
- (if (string-match "^[ \t]+" string)
- (substring string (match-end 0))
- string))
-
(defsubst regexp-* (regexp)
(concat regexp "*"))
(defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
(defconst std11-qtext-regexp
(eval-when-compile
- (concat "[^" (apply #'string std11-non-qtext-char-list) "]"))))
+ (concat "[^" std11-non-qtext-char-list "]"))))
(defconst std11-quoted-string-regexp
(eval-when-compile
(concat "\""
;;; @ about MIME
;;;
-(defconst mime-tspecials "][()<>@,\;:\\\"/?=")
-(defconst mime-token-regexp (concat "[^" mime-tspecials "\000-\040]+"))
+(eval-and-compile
+ (defconst mime-tspecial-char-list
+ '(?\] ?\[ ?\( ?\) ?< ?> ?@ ?, ?\; ?: ?\\ ?\" ?/ ?? ?=)))
+(defconst mime-token-regexp
+ (eval-when-compile
+ (concat "[^" mime-tspecial-char-list "\000-\040]+")))
(defconst mime-charset-regexp mime-token-regexp)
(defconst mime-media-type/subtype-regexp
service."
`(progn
(add-to-list 'mel-service-list ',name)
- (defvar ,(intern (format "%s-obarray" name)) (make-vector 1 nil))
+ (defvar ,(intern (format "%s-obarray" name)) (make-vector 7 0))
,@(if args
`((defun ,name ,args
,@rest
<!doctype sinfo system>
<head>
-<title>FLIM 1.10 Manual about MIME Features
+<title>FLIM 1.12 Reference Manual about MIME Features
<author>MORIOKA Tomohiko <mail>morioka@jaist.ac.jp</mail>
-<date>1998/07/01
+<date>1999-01-27
<toc>
</head>
<abstract>
<p>
-This file documents MIME features of FLIM, a Internet message
-parsing/encoding library for GNU Emacs.
+This file documents MIME features of FLIM, a fundamental library to
+process Internet Messages for GNU Emacsen.
</abstract>
Return entity-number of <var>entity</var>.
</defun>
+
+<h2> Find Entity
+<node> Entity Search
+<p>
<defun name="mime-find-entity-from-number">
<args> entity-number <opts> message
<p>
<code>mime-message-structure</code> is used.
</defun>
+<defun name="mime-find-entity-from-content-id">
+ <args> cid <opts> message
+<p>
+Return entity from <var>cid</var> in <var>message</var>.
+<p>
+If <var>message</var> is not specified,
+<code>mime-message-structure</code> is used.
+</defun>
+
<h2> Functions about attributes of mime-entity
<node> Entity Attributes
Return content of <var>entity</var> as byte sequence.
</defun>
+<defun name="mime-insert-entity-content">
+ <args> entity
+<p>
+Insert content of <var>entity</var> at point.
+</defun>
+
<defun name="mime-write-entity-content">
<args> entity filename
<p>
Write content of <var>entity</var> into <var>filename</var>.
</defun>
+
+<h2> Network representation of Entity
+<node> Entity-network-representation
+<p>
+<defun name="mime-insert-entity">
+ <args> entity
+<p>
+Insert header and body of <var>entity</var> at point.
+</defun>
+
<defun name="mime-write-entity">
<args> entity filename
<p>
\input texinfo.tex
@c Generated automatically from mime-en.sgml by sinfo 3.7.
@setfilename mime-en.info
-@settitle{FLIM 1.10 Manual about MIME Features}
+@settitle{FLIM 1.12 Reference Manual about MIME Features}
@titlepage
-@title FLIM 1.10 Manual about MIME Features
+@title FLIM 1.12 Reference Manual about MIME Features
@author MORIOKA Tomohiko <morioka@@jaist.ac.jp>
-@subtitle 1998/07/01
+@subtitle 1999-01-27
@end titlepage
@node Top, Introduction, (dir), (dir)
-@top FLIM 1.10 Manual about MIME Features
+@top FLIM 1.12 Reference Manual about MIME Features
@ifinfo
-This file documents MIME features of FLIM, a Internet message
-parsing/encoding library for GNU Emacs.
+This file documents MIME features of FLIM, a fundamental library to
+process Internet Messages for GNU Emacsen.
@end ifinfo
@menu
@menu
* Entity creation:: Functions to create mime-entity
* Entity hierarchy:: Features about message tree
+* Entity Search:: Find Entity
* Entity Attributes:: Functions about attributes of mime-entity
* Entity-header:: Information of entity header
* entity formatting:: Text presentation of entity
* Entity-content:: Contents of Entity
+* Entity-network-representation:: Network representation of Entity
* Entity buffer:: Entity as buffer representation
* mm-backend:: Entity representations and implementations
@end menu
If @var{buffer} is omitted, current buffer is used.@refill
@var{type} is representation-type of created
-mime-entity. (cf. @ref{mm-backend})
- Default value is @var{buffer}.
+mime-entity. (cf. @ref{mm-backend}) Default value is @var{buffer}.
@end defun
-@node Entity hierarchy, Entity Attributes, Entity creation, Entity
+@node Entity hierarchy, Entity Search, Entity creation, Entity
@section Features about message tree
@cindex node-id
@cindex entity-number
@end defun
+
+@node Entity Search, Entity Attributes, Entity hierarchy, Entity
+@section Find Entity
+
@defun mime-find-entity-from-number entity-number &optional message
Return entity from @var{entity-number} in @var{message}.@refill
@end defun
+@defun mime-find-entity-from-content-id cid &optional message
+
+Return entity from @var{cid} in @var{message}.@refill
+
+If @var{message} is not specified, @code{mime-message-structure} is
+used.
+@end defun
+
+
-@node Entity Attributes, Entity-header, Entity hierarchy, Entity
+@node Entity Attributes, Entity-header, Entity Search, Entity
@section Functions about attributes of mime-entity
@defun mime-entity-content-type entity
-@node Entity-content, Entity buffer, entity formatting, Entity
+@node Entity-content, Entity-network-representation, entity formatting, Entity
@section Contents of Entity
@defun mime-entity-content entity
@end defun
+@defun mime-insert-entity-content entity
+
+Insert content of @var{entity} at point.
+@end defun
+
+
@defun mime-write-entity-content entity filename
Write content of @var{entity} into @var{filename}.
@end defun
+
+@node Entity-network-representation, Entity buffer, Entity-content, Entity
+@section Network representation of Entity
+
+@defun mime-insert-entity entity
+
+Insert header and body of @var{entity} at point.
+@end defun
+
+
@defun mime-write-entity entity filename
Write representation of @var{entity} into @var{filename}.
-@node Entity buffer, mm-backend, Entity-content, Entity
+@node Entity buffer, mm-backend, Entity-network-representation, Entity
@section Entity as buffer representation
@defun mime-entity-buffer entity
@node History, , CVS, Appendix
@section History of FLIM
-FLIM \e$B$N\e(B code \e$B$N:G8E$NItJ,$O\e(B \e$B1]JB\e(B \e$B;LCR\e(B \e$B;a$,=q$$$?\e(B @file{mime.el}\e$B$K5/8;$7\e(B
+FLIM \e$B$N\e(B code \e$B$N:G8E$NItJ,$O\e(B \e$B1]JB\e(B \e$B;LCR\e(B \e$B;a$,=q$$$?\e(B @file{mime.el} \e$B$K5/8;$7\e(B
\e$B$^$9!#$3$N>.$5$J\e(B program \e$B$O\e(B Nemacs \e$B$GF0:n$9$k\e(B iso-2022-jp \e$B$N\e(B B-encoding
\e$B@lMQ$N\e(B encoded-word \e$B$NI|9f2=%W%m%0%i%`$G$7$?!#\e(B@refill
\e$B8e$K!"\e(BAPEL \e$B$+$i\e(B @file{std11.el} \e$B$,0\$5$l!"$^$?!"\e(B@file{mailcap.el},
@file{eword-decode.el} \e$B$*$h$S\e(B @file{eword-encode.el} \e$B$,\e(B SEMI \e$B$+$i0\$5$l!"\e(B
-package \e$B$NL>A0$,\e(B FLIM\e$B$H$J$j$^$9!#\e(B@refill
+package \e$B$NL>A0$,\e(B FLIM \e$B$H$J$j$^$9!#\e(B@refill
\e$B$3$ND>A0$+$iEDCf\e(B \e$BE/\e(B \e$B;a$,$h$j\e(B RFC \e$B$KCi<B$J<BAu$r=q$-;O$a!"$3$l$O!"8=:_!"\e(B
FLIM \e$B$N;^$G$"$k\e(B ``FLIM-FLAM'' \e$B$H$J$C$F$$$^$9!#\e(B
<!doctype sinfo system>
<head>
-<title>FLIM 1.10 MIME \e$B5!G=@bL@=q\e(B
+<title>FLIM 1.12 MIME \e$B5!G=@bL@=q\e(B
<author>\e$B<i2,\e(B \e$BCNI'\e(B <mail>morioka@jaist.ac.jp</mail>
-<date>1998/07/01
+<date>1999-01-27
<toc>
</head>
<abstract>
<p>
-This file documents MIME features of FLIM, a Internet message
-parsing/encoding library for GNU Emacs.
+This file documents MIME features of FLIM, a fundamental library to
+process Internet Messages for GNU Emacsen.
<p>
-GNU Emacs \e$BMQ$N\e(B Internet Message \e$B$N2r@O$dId9f2=$K4X$9$k\e(B library \e$B$G$"$k\e(B
-FLIM \e$B$N\e(B MIME \e$B5!G=$K4X$7$F@bL@$7$^$9!#\e(B
+GNU Emacsen \e$BMQ$N\e(B Internet Message \e$B=hM}$N$?$a$N4pAC\e(B library \e$B$G$"$k\e(B FLIM
+\e$B$N\e(B MIME \e$B5!G=$K4X$7$F@bL@$7$^$9!#\e(B
</abstract>
<defun name="mime-open-entity">
<opts> type location
<p>
-Open an entity and return it.
+Entity \e$B$r3+$$$F!"$=$l$rJV$7$^$9!#\e(B
<p>
-<var>type</var> is representation-type. <cf node="mm-backend">
+<var>type</var> \e$B$O\e(B representation-type \e$B$G$9!#\e(B <cf node="mm-backend">
<p>
-<var>location</var> is location of entity. Specification of it is
-depended on representation-type.
+<var>location</var> \e$B$O\e(B entity \e$B$N0LCV$G$9!#;XDjJ}K!$O\e(B
+representation-type \e$B$K0M$C$FJQ$o$j$^$9!#\e(B
</defun>
<defun name="mime-parse-buffer">
<var>entity</var> \e$B$N\e(B entity-number \e$B$rJV$9!#\e(B
</defun>
+
+<h2> Entity \e$B$N8!:w\e(B
+<node> Entity Search
+<p>
<defun name="mime-find-entity-from-number">
<args> entity-number <opts> message
<p>
-Return entity from <var>entity-number</var> in <var>message</var>.
+<var>message</var> \e$B$+$i!"\e(B<var>enity-number</var> \e$B$N\e(B entity \e$B$rJV$7$^$9!#\e(B
<p>
-If <var>message</var> is not specified,
-<code>mime-message-structure</code> is used.
+<var>message</var> \e$B$,;XDj$5$l$F$$$J$$>l9g$O!"\e(B
+<code>mime-message-structrue</code> \e$B$,;H$o$l$^$9!#\e(B
</defun>
<defun name="mime-find-entity-from-node-id">
<args> entity-node-id <opts> message
<p>
-Return entity from <var>entity-node-id</var> in <var>message</var>.
+<var>message</var> \e$B$+$i!"\e(B<var>entity-node-id</var> \e$B$N\e(B entity \e$B$rJV$7$^\e(B
+\e$B$9!#\e(B
<p>
-If <var>message</var> is not specified,
-<code>mime-message-structure</code> is used.
+<var>message</var> \e$B$,;XDj$5$l$F$$$J$$>l9g$O!"\e(B
+<code>mime-message-structure</code> \e$B$,;H$o$l$^$9!#\e(B
+</defun>
+
+<defun name="mime-find-entity-from-content-id">
+ <args> cid <opts> message
+<p>
+<var>message</var> \e$B$+$i!"\e(B<var>cid</var> \e$B$N\e(B entity \e$B$rJV$7$^$9!#\e(B
+<p>
+<var>message</var> \e$B$,;XDj$5$l$F$$$J$$>l9g$O!"\e(B
+<code>mime-message-structure</code> \e$B$,;H$o$l$^$9!#\e(B
</defun>
<defun name="mime-entity-cooked-p">
<args> entity
<p>
-Return non-nil if contents of <var>entity</var> has been already
-code-converted.
+<var>entity</var> \e$B$NFbMF$,4{$K%3!<%IJQ49$5$l$F$$$k>l9g$O\e(B nil \e$B$GL5$$CM\e(B
+\e$B$rJV$9!#\e(B
</defun>
<defun name="mime-insert-text-content">
<args> entity
<p>
-Insert before point a contents of <var>entity</var> as text entity.
+point \e$B$NA0$K\e(B <var>entity</var> \e$B$r\e(B text entity \e$B$H$7$FA^F~$7$^$9!#\e(B
<p>
-Contents of the <var>entity</var> are decoded as <dref>MIME
-charset</dref>. If the <var>entity</var> does not have charset
-parameter of Content-Type field, <code>default-mime-charset</code> is
-used as default value.
+<var>entity</var> \e$B$NFbMF$O\e(B <dref>MIMe charset</dref> \e$B$H$7$FI|9f2=$5$l\e(B
+\e$B$^$9!#\e(B<var>entity</var> \e$B$N\e(B Content-Type field \e$B$K\e(B charset paramter \e$B$,L5\e(B
+\e$B$$$H!"\e(B<code>default-mime-charset</code> \e$B$,=i4|CM$H$7$F;H$o$l$^$9!#\e(B
</defun>
<defvar name="default-mime-charset">
<var>entity</var> \e$B$NFbMF$N\e(B byte \e$BNs$rJV$9!#\e(B
</defun>
+<defun name="mime-insert-entity-content">
+ <args> entity
+<p>
+pointo \e$B$N0LCV$K\e(B <var>entity</var> \e$B$NFbMF$rA^F~$7$^$9!#\e(B
+</defun>
+
<defun name="mime-write-entity-content">
<args> entity filename
<p>
-Write content of <var>entity</var> into <var>filename</var>.
+<var>entity</var> \e$B$NFbMF$r\e(B <var>filename</var> \e$B$K=q$-9~$_$^$9!#\e(B
+</defun>
+
+
+<h2> Entity \e$B$N%M%C%H%o!<%/I=8=\e(B
+<node> Entity-network-representation
+<p>
+<defun name="mime-insert-entity">
+ <args> entity
+<p>
+<var>entity</var> \e$B$N\e(B header \e$B$H\e(B body \e$B$r\e(B point \e$B$N$H$3$m$KA^F~$7$^$9!#\e(B
</defun>
<defun name="mime-write-entity">
<args> entity filename
<p>
-Write representation of <var>entity</var> into <var>filename</var>.
+<var>entity</var> \e$B$NI=8=$r\e(B <var>filename</var> \e$B$K=q$-9~$_$^$9!#\e(B
</defun>
<defun name="mime-write-entity-body">
<args> entity filename
<p>
-Write body of <var>entity</var> into <var>filename</var>.
+<var>entity</var> \e$B$N\e(B body \e$B$r\e(B <var>filename</var> \e$B$K=q$-9~$_$^$9!#\e(B
</defun>
<args> type
<opts> parents
<p>
-Define <var>type</var> as a mm-backend.
+<var>type</var> \e$B$r\e(B mm-backend \e$B$H$7$FDj5A$7$^$9!#\e(B
<p>
-If <var>PARENTS</var> is specified, <var>type</var> inherits parents.
-Each parent must be representation-type.
+<var>PARENTS</var> \e$B$,;XDj$5$l$F$$$k>l9g$O!"\e(B<var>type</var> \e$B$O\e(B prents
+\e$B$r7Q>5$7$^$9!#$=$l$>$l$N\e(B parent \e$B$O\e(B representation-type \e$B$G$"$kI,MW$,$"\e(B
+\e$B$j$^$9!#\e(B
<p>
-Example:
+\e$BNc\e(B:
<p>
<lisp>
(mm-define-backend chao (generic))
<defmacro name="mm-define-method">
<args> name args <rest> body
<p>
-Define <var>name</var> as a method function of (nth 1 (car
-<var>args</var>)) backend.
+<var>name</var> \e$B$r\e(B (nth 1 (car <var>args</var>)) backend \e$B$N\e(B method \e$B4X\e(B
+\e$B?t$H$7$FDj5A$7$^$9!#\e(B
<p>
-<var>args</var> is like an argument list of lambda, but (car
-<var>args</var>) must be specialized parameter. (car (car
-<var>args</var>)) is name of variable and (nth 1 (car
-<var>args</var>)) is name of backend (representation-type).
+<var>args</var> \e$B$O\e(B lambda \e$B$N0z?t%j%9%H$N$h$&$J$b$N$G$9$,!"\e(B(car
+<var>args</var>) \e$B$O;XDj$5$l$?\e(B parameter \e$B$G$"$kI,MW$,$"$j$^$9!#\e(B(car
+(car <var>args</var>)) \e$B$OJQ?t$NL>A0$G!"\e(B(nth 1 (car <var>args</var>))
+\e$B$O\e(B backend \e$B$NL>A0\e(B (representation-type) \e$B$G$9!#\e(B
<p>
-Example:
+\e$BNc\e(B:
<p>
<lisp>
(mm-define-method entity-cooked-p ((entity chao)) nil)
<defun name="mime-encode-region">
<args> start end encoding
<p>
-Encode region <var>start</var> to <var>end</var> of current buffer
-using <var>encoding</var>.
+\e$B8=:_$N\e(B buffer \e$B$N\e(B <var>start</var> \e$B$+$i\e(B <var>end</var> \e$B$^$G$N\e(B region \e$B$r\e(B
+<var>encoding</var> \e$B$r;H$C$FId9f2=$7$^$9!#\e(B
</defun>
<defun name="mime-decode-region">
<args> start end encoding
<p>
-Decode region <var>start</var> to <var>end</var> of current buffer
-using <var>encoding</var>.
+\e$B8=:_$N\e(B buffer \e$B$N\e(B <var>start</var> \e$B$+$i\e(B <var>end</var> \e$B$^$G$N\e(B region \e$B$r\e(B
+<var>encoding</var> \e$B$r;H$C$FI|9f2=$7$^$9!#\e(B
</defun>
<defun name="mime-insert-encoded-file">
<args> filename encoding
<p>
-Insert file <var>FILENAME</var> encoded by <var>ENCODING</var> format.
+<var>ENCODING</var> format \e$B$GId9f2=$5$l$?\e(B file <var>FILENAME</var> \e$B$r\e(B
+\e$BA^F~$9$k!#\e(B
</defun>
<defun name="mime-write-decoded-region">
<args> start end filename encoding
<p>
-Decode and write current region encoded by <var>encoding</var> into
-<var>filename</var>.
+<var>encoding</var> \e$B$GId9f2=$5$l$?8=:_$N\e(B region \e$B$rI|9f2=$7$F\e(B
+<var>filename</var>\e$B$K=q$-9~$_$^$9!#\e(B
<p>
-<var>start</var> and <var>end</var> are buffer positions.
+<var>start<var> \e$B$H\e(B <var>end</var> \e$B$O\e(B buffer \e$B$N0LCV$G$9!#\e(B
</defun>
-<h2> Other utilities
+<h2> \e$BB>$N\e(B utility
<node> Encoding information
<p>
<defun name="mime-encoding-list">
<opts> SERVICE
<p>
-Return list of Content-Transfer-Encoding.
+Content-Transfer-Encoding \e$B$N\e(B list \e$B$rJV$7$^$9!#\e(B
<p>
-If <var>service</var> is specified, it returns available list of
-Content-Transfer-Encoding for it.
+<var>service</var> \e$B$,;XDj$5$l$F$$$k$H!"$=$l$KBP$9$k\e(B
+Content-Transfer-Encoding \e$B$rJV$7$^$9!#\e(B
</defun>
<defun name="mime-encoding-alist">
<opts> SERVICE
<p>
-Return table of Content-Transfer-Encoding for completion.
+\e$BJd40$N$?$a$N\e(B Content-Transfer-Encoding \e$B$NI=$rJV$7$^$9!#\e(B
<p>
-If <var>service</var> is specified, it returns available list of
-Content-Transfer-Encoding for it.
+<var>service</var> \e$B$,;XDj$5$l$F$$$k>l9g$O$=$l$KBP$9$k\e(B
+Content-Transfer-Encoding \e$B$N\e(B list \e$B$rJV$7$^$9!#\e(B
</defun>
-<h2> How to write encoder/decoder module
+<h2> \e$BId9f2=\e(B/\e$BI|9f2=\e(B module \e$B$N=q$-J}\e(B
<node> mel-backend
<p>
<defmacro name="mel-define-method">
<args> name args <rest> body
<p>
-Define <var>name</var> as a method function of (nth 1 (car (last
-<var>args</var>))) backend.
+<var>name</var> \e$B$r\e(B (nth 1 (car (last <var>args</var>))) backend \e$B$N\e(B
+method \e$B4X?t$H$7$FDj5A$7$^$9!#\e(B
<p>
-<var>args</var> is like an argument list of lambda, but (car (last
-<var>args</var>)) must be specialized parameter. (car (car (last
-<var>args</var>))) is name of variable and (nth 1 (car (last
-<var>args</var>))) is name of backend (encoding).
+<var>args</var> \e$B$O\e(B lambda \e$B$N0z?t\e(B list \e$B$H;w$F$$$^$9$,!"\e(B(car (last
+<var>args</var>)) \e$B$O;XDj$5$l$?\e(B parameter \e$B$G$"$kI,MW$,$"$j$^$9!#\e(B(car
+(car (last <var>args</var>))) \e$B$OJQ?t$NL>A0$G!"\e(B(nth 1 (car (last
+<var>args</var>))) \e$B$O\e(B backend \e$B$NL>A0\e(B (encoding) \e$B$G$9!#\e(B
<p>
-Example:
+\e$BNc\e(B:
<p>
<lisp>
(mel-define-method mime-write-decoded-region (start end filename
<defmacro name="mel-define-method-function">
<args> spec function
<p>
-Set <var>spec</var>'s function definition to <var>function</var>.
+<var>spec</var> \e$B$N4X?tDj5A$r\e(B <var>function</var> \e$B$K@_Dj$7$^$9!#\e(B
<p>
-First element of <var>spec</var> is service.
+<var>spec</var> \e$B$N:G=i$NMWAG$O\e(B service \e$B$G$9!#\e(B
<p>
-Rest of <var>args</var> is like an argument list of lambda, but (car
-(last <var>args</var>)) must be specialized parameter. (car (car
-(last <var>args</var>))) is name of variable and (nth 1 (car (last
-<var>args</var>))) is name of backend (encoding).
+<var>args</var> \e$B$N;D$j$O\e(B lambda \e$B$N0z?t\e(B list \e$B;w$F$$$^$9$,!"\e(B(car (last
+<var>args</var>)) \e$B$O;XDj$5$l$?\e(B parameter \e$B$G$"$kI,MW$,$"$j$^$9!#\e(B(car
+(car (last <var>args</var>))) \e$B$OJQ?t$NL>A0$G!"\e(B(nth 1 (car (last
+<var>args</var>))) \e$B$O\e(B backend \e$B$NL>A0\e(B (encoding) \e$B$G$9!#\e(B
<p>
-Example:
+\e$BNc\e(B:
<p>
<lisp>
(mel-define-method-function (mime-encode-string string (nil "base64"))
</defmacro>
-<h2> How to add encoding/decoding service
+<h2> \e$BId9f2=\e(B/\e$BI|9f2=\e(B service \e$B$rDI2C$9$kJ}K!\e(B
<node> generic function for mel-backend
<p>
<defmacro name="mel-define-service">
<args> name
<opts> args doc-string
<p>
-Define <var>name</var> as a service for Content-Transfer-Encodings.
+<var>name</var> \e$B$r\e(B Content-Transfer-Encoding \e$B$N\e(B service \e$B$H$7$FDj5A$7$^\e(B
+\e$B$9!#\e(B
<p>
-If <var>args</var> is specified, <var>name</var> is defined as a
-generic function for the service.
+<var>args</var> \e$B$,;XDj$5$l$F$$$k$H!"\e(B<var>name</var> \e$B$O\e(B service \e$B$N\e(B
+generic function \e$B$H$7$FDj5A$5$l$^$9!#\e(B
<p>
-Example:
+\e$BNc\e(B:
<p>
<lisp>
(mel-define-service encoded-text-encode-string (string encoding)
<defvar name="eword-field-encoding-method-alist">
<p>
-Association list to specify field encoding method. Each element looks
-like (FIELD . METHOD).
+Field \e$B$rId9f2=$9$kJ}K!$r;XDj$9$kO"A[\e(B list\e$B!#3F\e(B element \e$B$O\e(B (FIELD
+. METHOD) \e$B$NMM$K$J$C$F$$$k!#\e(B
<p>
-If METHOD is <code>mime</code>, the FIELD will be encoded into MIME
-format (encoded-word).
+METHOD \e$B$,\e(B <code>mime</code> \e$B$G$"$l$P!"\e(BFIELD \e$B$O\e(B MIME format \e$B$KId9f2=$5\e(B
+\e$B$l$k\e(B (encoded-word)\e$B!#\e(B
<p>
-If METHOD is <code>nil</code>, the FIELD will not be encoded.
+METHOD \e$B$,\e(B <code>nil</code> \e$B$G$"$l$P!"\e(BFIELD \e$B$OId9f2=$5$l$J$$!#\e(B
<p>
-If METHOD is a MIME charset, the FIELD will be encoded as the charset
-when it must be convert into network-code.
+METHOD \e$B$,\e(B MIME charset \e$B$G$"$l$P!"\e(BFIELD \e$B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J\e(B
+\e$B$1$l$P$J$i$J$$$H$-$K\e(B charset \e$B$KId9f2=$5$l$k!#\e(B
<p>
-Otherwise the FIELD will be encoded as variable
-<code>default-mime-charset</code> when it must be convert into
-network-code.
+\e$B$=$&$G$J$1$l$P!"\e(BFIELD \e$B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J$1$l$P$J$i$J$$$H$-\e(B
+\e$B$K\e(B \e$BJQ?t\e(B <code>default-mime-charset</code> \e$B$GId9f2=$5$l$k\e(B
</defvar>
\input texinfo.tex
@c Generated automatically from mime-ja.sgml by sinfo 3.7.
@setfilename mime-ja.info
-@settitle{FLIM 1.10 MIME \e$B5!G=@bL@=q\e(B}
+@settitle{FLIM 1.12 MIME \e$B5!G=@bL@=q\e(B}
@titlepage
-@title FLIM 1.10 MIME \e$B5!G=@bL@=q\e(B
+@title FLIM 1.12 MIME \e$B5!G=@bL@=q\e(B
@author \e$B<i2,\e(B \e$BCNI'\e(B <morioka@@jaist.ac.jp>
-@subtitle 1998/07/01
+@subtitle 1999-01-27
@end titlepage
@node Top, Introduction, (dir), (dir)
-@top FLIM 1.10 MIME \e$B5!G=@bL@=q\e(B
+@top FLIM 1.12 MIME \e$B5!G=@bL@=q\e(B
@ifinfo
-This file documents MIME features of FLIM, a Internet message
-parsing/encoding library for GNU Emacs.@refill
+This file documents MIME features of FLIM, a fundamental library to
+process Internet Messages for GNU Emacsen.@refill
-GNU Emacs \e$BMQ$N\e(B Internet Message \e$B$N2r@O$dId9f2=$K4X$9$k\e(B library \e$B$G$"$k\e(B
-FLIM \e$B$N\e(B MIME \e$B5!G=$K4X$7$F@bL@$7$^$9!#\e(B
+GNU Emacsen \e$BMQ$N\e(B Internet Message \e$B=hM}$N$?$a$N4pAC\e(B library \e$B$G$"$k\e(B FLIM
+\e$B$N\e(B MIME \e$B5!G=$K4X$7$F@bL@$7$^$9!#\e(B
@end ifinfo
@menu
@menu
* Entity creation:: Entity \e$B$N@8@.\e(B
* Entity hierarchy:: Entity \e$B3,AX\e(B
+* Entity Search:: Entity \e$B$N8!:w\e(B
* Entity Attributes:: Entity \e$B$NB0@-\e(B
* Entity-header:: Entity header \e$B$N>pJs\e(B
* entity formatting:: Entity \e$B$NJ8;zI=8=\e(B
* Entity-content:: Entity \e$B$NFbMF\e(B
+* Entity-network-representation:: Entity \e$B$N%M%C%H%o!<%/I=8=\e(B
* Entity buffer:: Entity \e$B$N\e(B buffer \e$B$K$h$kI=8=\e(B
* mm-backend:: Entity \e$B$NI=8=$H<B8=\e(B
@end menu
-@node Entity hierarchy, Entity Attributes, Entity creation, Entity
+@node Entity hierarchy, Entity Search, Entity creation, Entity
@section Entity \e$B3,AX\e(B
@cindex node-id
@cindex entity-number
@end defun
+
+@node Entity Search, Entity Attributes, Entity hierarchy, Entity
+@section Entity \e$B$N8!:w\e(B
+
@defun mime-find-entity-from-number entity-number &optional message
Return entity from @var{entity-number} in @var{message}.@refill
@end defun
+@defun mime-find-entity-from-content-id cid &optional message
+
+Return entity from @var{cid} in @var{message}.@refill
+
+If @var{message} is not specified, @code{mime-message-structure} is
+used.
+@end defun
+
+
-@node Entity Attributes, Entity-header, Entity hierarchy, Entity
+@node Entity Attributes, Entity-header, Entity Search, Entity
@section Entity \e$B$NB0@-\e(B
@defun mime-entity-content-type entity
-@node Entity-content, Entity buffer, entity formatting, Entity
+@node Entity-content, Entity-network-representation, entity formatting, Entity
@section Entity \e$B$NFbMF\e(B
@defun mime-entity-content entity
@end defun
+@defun mime-insert-entity-content entity
+
+Insert content of @var{entity} at point.
+@end defun
+
+
@defun mime-write-entity-content entity filename
Write content of @var{entity} into @var{filename}.
@end defun
+
+@node Entity-network-representation, Entity buffer, Entity-content, Entity
+@section Entity \e$B$N%M%C%H%o!<%/I=8=\e(B
+
+@defun mime-insert-entity entity
+
+Insert header and body of @var{entity} at point.
+@end defun
+
+
@defun mime-write-entity entity filename
Write representation of @var{entity} into @var{filename}.
-@node Entity buffer, mm-backend, Entity-content, Entity
+@node Entity buffer, mm-backend, Entity-network-representation, Entity
@section Entity \e$B$N\e(B buffer \e$B$K$h$kI=8=\e(B
@defun mime-entity-buffer entity
ASCII (@ref{ASCII}) \e$B$N$_$+$i$J$j\e(B ISO 2022 \e$B$K$h$kId9f3HD%$O5v$5$l$J$$!#\e(B
-Internet message \e$B$K$*$1$kI8=`$NId9f2=J8;z=89g\e(B(@ref{Coded character set})
+Internet message \e$B$K$*$1$kI8=`$NId9f2=J8;z=89g\e(B(@ref{Coded character set})
\e$B$G$"$j!"L@<(E*$K\e(B MIME charset \e$B$,<($5$l$J$$>l9g$O86B'$H$7$F\e(B
@strong{us-ascii} \e$B$,;H$o$l$k!#\e(B@refill
@node History, , CVS, Appendix
@section \e$BNr;K\e(B
-FLIM \e$B$N\e(B code \e$B$N:G8E$NItJ,$O\e(B \e$B1]JB\e(B \e$B;LCR\e(B \e$B;a$,=q$$$?\e(B @file{mime.el}\e$B$K5/8;$7\e(B
+FLIM \e$B$N\e(B code \e$B$N:G8E$NItJ,$O\e(B \e$B1]JB\e(B \e$B;LCR\e(B \e$B;a$,=q$$$?\e(B @file{mime.el} \e$B$K5/8;$7\e(B
\e$B$^$9!#$3$N>.$5$J\e(B program \e$B$O\e(B Nemacs \e$B$GF0:n$9$k\e(B iso-2022-jp \e$B$N\e(B B-encoding
\e$B@lMQ$N\e(B encoded-word \e$B$NI|9f2=%W%m%0%i%`$G$7$?!#\e(B@refill
\e$B8e$K!"\e(BAPEL \e$B$+$i\e(B @file{std11.el} \e$B$,0\$5$l!"$^$?!"\e(B@file{mailcap.el},
@file{eword-decode.el} \e$B$*$h$S\e(B @file{eword-encode.el} \e$B$,\e(B SEMI \e$B$+$i0\$5$l!"\e(B
-package \e$B$NL>A0$,\e(B FLIM\e$B$H$J$j$^$9!#\e(B@refill
+package \e$B$NL>A0$,\e(B FLIM \e$B$H$J$j$^$9!#\e(B@refill
\e$B$3$ND>A0$+$iEDCf\e(B \e$BE/\e(B \e$B;a$,$h$j\e(B RFC \e$B$KCi<B$J<BAu$r=q$-;O$a!"$3$l$O!"8=:_!"\e(B
FLIM \e$B$N;^$G$"$k\e(B ``FLIM-FLAM'' \e$B$H$J$C$F$$$^$9!#\e(B
;;; mime-parse.el --- MIME message parser
-;; Copyright (C) 1994,1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1994,1995,1996,1997,1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: parse, MIME, multimedia, mail, news
;;; Code:
-(require 'emu)
(require 'std11)
(require 'mime-def)
(eval-when-compile (require 'cl))
+;;; @ lexical analyzer
+;;;
+
+(defcustom mime-lexical-analyzer
+ '(std11-analyze-quoted-string
+ std11-analyze-domain-literal
+ std11-analyze-comment
+ std11-analyze-spaces
+ mime-analyze-tspecial
+ mime-analyze-token)
+ "*List of functions to return result of lexical analyze.
+Each function must have two arguments: STRING and START.
+STRING is the target string to be analyzed.
+START is start position of STRING to analyze.
+
+Previous function is preferred to next function. If a function
+returns nil, next function is used. Otherwise the return value will
+be the result."
+ :group 'mime
+ :type '(repeat function))
+
+(defun mime-analyze-tspecial (string start)
+ (if (and (> (length string) start)
+ (memq (aref string start) mime-tspecial-char-list))
+ (cons (cons 'tpecials (substring string start (1+ start)))
+ (1+ start))
+ ))
+
+(defun mime-analyze-token (string start)
+ (if (and (string-match mime-token-regexp string start)
+ (= (match-beginning 0) start))
+ (let ((end (match-end 0)))
+ (cons (cons 'mime-token (substring string start end))
+ ;;(substring string end)
+ end)
+ )))
+
+
;;; @ field parser
;;;
;;; @ Content-Disposition
;;;
-(defconst mime-disposition-type-regexp mime-token-regexp)
+(eval-and-compile
+ (defconst mime-disposition-type-regexp mime-token-regexp)
+ )
;;;###autoload
(defun mime-parse-Content-Disposition (string)
"Parse STRING as field-body of Content-Disposition field."
(setq string (std11-unfold-string string))
- (if (string-match `,(concat "^" mime-disposition-type-regexp) string)
+ (if (string-match (eval-when-compile
+ (concat "^" mime-disposition-type-regexp)) string)
(let* ((e (match-end 0))
(type (downcase (substring string 0 e)))
ret dest)
;;;###autoload
(defun mime-parse-Content-Transfer-Encoding (string)
"Parse STRING as field-body of Content-Transfer-Encoding field."
- (if (string-match "[ \t\n\r]+$" string)
- (setq string (match-string 0 string))
- )
- (downcase string))
+ (let ((tokens (std11-lexical-analyze string mime-lexical-analyzer))
+ token)
+ (while (and tokens
+ (setq token (car tokens))
+ (std11-ignored-token-p token))
+ (setq tokens (cdr tokens)))
+ (if token
+ (if (eq (car token) 'mime-token)
+ (downcase (cdr token))
+ ))))
;;;###autoload
(defun mime-read-Content-Transfer-Encoding (&optional default-encoding)
default-encoding)))
+;;; @ Content-Id / Message-Id
+;;;
+
+;;;###autoload
+(defun mime-parse-msg-id (tokens)
+ "Parse TOKENS as msg-id of Content-Id or Message-Id field."
+ (car (std11-parse-msg-id tokens)))
+
+;;;###autoload
+(defun mime-uri-parse-cid (string)
+ "Parse STRING as cid URI."
+ (inline
+ (mime-parse-msg-id (cons '(specials . "<")
+ (nconc
+ (cdr (cdr (std11-lexical-analyze string)))
+ '((specials . ">")))))))
+
+
;;; @ message parser
;;;
;;; mime.el --- MIME library module
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: MIME, multimedia, mail, news
(require 'mime-def)
(require 'eword-decode)
-(autoload 'eword-encode-field "eword-encode"
- "Encode header field STRING, and return the result.")
+(eval-and-compile
+
(autoload 'eword-encode-header "eword-encode"
"Encode header fields to network representation, such as MIME encoded-word.")
-
(autoload 'mime-parse-Content-Type "mime-parse"
"Parse STRING as field-body of Content-Type field.")
(autoload 'mime-read-Content-Type "mime-parse"
"Read field-body of Content-Transfer-Encoding field from
current-buffer, and return it.")
+(autoload 'mime-parse-msg-id "mime-parse"
+ "Parse TOKENS as msg-id of Content-Id or Message-Id field.")
+
+(autoload 'mime-uri-parse-cid "mime-parse"
+ "Parse STRING as cid URI.")
+
(autoload 'mime-parse-buffer "mime-parse"
"Parse BUFFER as a MIME message.")
+)
;;; @ Entity Representation and Implementation
;;;
If MESSAGE is not specified, `mime-message-structure' is used."
(mime-find-entity-from-number (reverse entity-node-id) message))
+(defun mime-find-entity-from-content-id (cid &optional message)
+ "Return entity from CID in MESSAGE.
+If MESSAGE is not specified, `mime-message-structure' is used."
+ (or message
+ (setq message mime-message-structure))
+ (if (equal cid (mime-read-field 'Content-Id message))
+ message
+ (let ((children (mime-entity-children message))
+ ret)
+ (while (and children
+ (null (setq ret (mime-find-entity-from-content-id
+ cid (car children)))))
+ (setq children (cdr children)))
+ ret)))
+
(defun mime-entity-parent (entity &optional message)
"Return mother entity of ENTITY.
If MESSAGE is specified, it is regarded as root entity."
default-encoding "7bit"))
)))
+(defvar mime-field-parser-alist
+ '((Return-Path . std11-parse-route-addr)
+
+ (Reply-To . std11-parse-addresses)
+
+ (Sender . std11-parse-mailbox)
+ (From . std11-parse-addresses)
+
+ (Resent-Reply-To . std11-parse-addresses)
+
+ (Resent-Sender . std11-parse-mailbox)
+ (Resent-From . std11-parse-addresses)
+
+ (To . std11-parse-addresses)
+ (Resent-To . std11-parse-addresses)
+ (Cc . std11-parse-addresses)
+ (Resent-Cc . std11-parse-addresses)
+ (Bcc . std11-parse-addresses)
+ (Resent-Bcc . std11-parse-addresses)
+
+ (Message-Id . mime-parse-msg-id)
+ (Recent-Message-Id . mime-parse-msg-id)
+
+ (In-Reply-To . std11-parse-msg-ids)
+ (References . std11-parse-msg-ids)
+
+ (Content-Id . mime-parse-msg-id)
+ ))
+
(defun mime-read-field (field-name &optional entity)
(or (symbolp field-name)
(setq field-name (capitalize (capitalize field-name))))
(let* ((header (mime-entity-parsed-header-internal entity))
(field (cdr (assq field-name header))))
(or field
- (let ((field-body (mime-fetch-field field-name entity)))
+ (let ((field-body (mime-fetch-field field-name entity))
+ parser)
(when field-body
- (cond ((memq field-name '(From Resent-From
- To Resent-To
- Cc Resent-Cc
- Bcc Resent-Bcc
- Reply-To Resent-Reply-To))
- (setq field (std11-parse-addresses
- (eword-lexical-analyze field-body)))
- )
- ((memq field-name '(Sender Resent-Sender))
- (setq field (std11-parse-address
- (eword-lexical-analyze field-body)))
- )
- ((memq field-name eword-decode-ignored-field-list)
- (setq field field-body))
- ((memq field-name eword-decode-structured-field-list)
- (setq field (eword-decode-structured-field-body
- field-body)))
- (t
- (setq field (eword-decode-unstructured-field-body
- field-body))
- ))
+ (setq parser
+ (cdr (assq field-name mime-field-parser-alist)))
+ (setq field
+ (if parser
+ (funcall parser
+ (eword-lexical-analyze field-body))
+ (mime-decode-field-body
+ field-body field-name 'plain)
+ ))
(mime-entity-set-parsed-header-internal
entity (put-alist field-name field header))
field)))))))
(mm-define-generic entity-content (entity)
"Return content of ENTITY as byte sequence (string).")
-(mm-define-generic insert-text-content (entity)
- "Insert decoded text body of ENTITY.")
+(mm-define-generic insert-entity-content (entity)
+ "Insert content of ENTITY at point.")
(mm-define-generic write-entity-content (entity filename)
"Write content of ENTITY into FILENAME.")
+(mm-define-generic insert-text-content (entity)
+ "Insert decoded text body of ENTITY.")
+
+(mm-define-generic insert-entity (entity)
+ "Insert header and body of ENTITY at point.")
+
(mm-define-generic write-entity (entity filename)
"Write header and body of ENTITY into FILENAME.")
;;; mmbuffer.el --- MIME entity module for binary buffer
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: MIME, multimedia, mail, news
(mime-entity-body-end-internal entity))
(mime-entity-encoding entity))))
+(mm-define-method insert-entity-content ((entity buffer))
+ (insert (with-current-buffer (mime-entity-buffer-internal entity)
+ (mime-decode-string
+ (buffer-substring (mime-entity-body-start-internal entity)
+ (mime-entity-body-end-internal entity))
+ (mime-entity-encoding entity)))))
+
(mm-define-method write-entity-content ((entity buffer) filename)
(save-excursion
(set-buffer (mime-entity-buffer-internal entity))
(or (mime-entity-encoding entity) "7bit"))
))
+(mm-define-method insert-entity ((entity buffer))
+ (insert-buffer-substring (mime-entity-buffer-internal entity)
+ (mime-entity-header-start-internal entity)
+ (mime-entity-body-end-internal entity))
+ )
+
(mm-define-method write-entity ((entity buffer) filename)
(save-excursion
(set-buffer (mime-entity-buffer-internal entity))
;;; mmgeneric.el --- MIME entity module for generic buffer
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: MIME, multimedia, mail, news
(mime-entity-body-end-internal entity))
(mime-entity-encoding entity))))
+(mm-define-method insert-entity-content ((entity generic))
+ (insert (with-current-buffer (mime-entity-buffer entity)
+ (mime-decode-string
+ (buffer-substring (mime-entity-body-start-internal entity)
+ (mime-entity-body-end-internal entity))
+ (mime-entity-encoding entity)))))
+
(mm-define-method write-entity-content ((entity generic) filename)
(save-excursion
(set-buffer (mime-entity-buffer entity))
(or (mime-entity-encoding entity) "7bit"))
))
+(mm-define-method insert-entity ((entity generic))
+ (insert-buffer-substring (mime-entity-buffer entity)
+ (mime-entity-header-start-internal entity)
+ (mime-entity-body-end-internal entity))
+ )
+
(mm-define-method write-entity ((entity generic) filename)
(save-excursion
(set-buffer (mime-entity-buffer entity))
&optional invisible-fields
visible-fields)
(let ((the-buf (current-buffer))
+ (mode-obj (mime-find-field-presentation-method 'wide))
+ field-decoder
f-b p f-e field-name len field field-body)
(save-excursion
(set-buffer buffer)
visible-fields invisible-fields)
(setq field (intern
(capitalize (buffer-substring f-b (1- p))))
- field-body (buffer-substring p f-e))
+ field-body (buffer-substring p f-e)
+ field-decoder (inline (mime-find-field-decoder-internal
+ field mode-obj)))
(with-current-buffer the-buf
(insert field-name)
- (insert
- (if (memq field eword-decode-ignored-field-list)
- ;; Don't decode
- field-body
- (if (memq field eword-decode-structured-field-list)
- ;; Decode as structured field
- (eword-decode-and-fold-structured-field field-body len)
- ;; Decode as unstructured field
- (eword-decode-unstructured-field-body field-body len)
- )))
+ (insert (if field-decoder
+ (funcall field-decoder field-body len)
+ ;; Don't decode
+ field-body))
(insert "\n")
)))))))
--- /dev/null
+;;; smtp.el --- basic functions to send mail with SMTP server
+
+;; Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc.
+
+;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
+;; Simon Leinen <simon@switch.ch> (ESMTP support)
+;; Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp>
+;; Keywords: SMTP, mail
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with 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 'mail-utils) ; pick up mail-strip-quoted-names
+
+(defgroup smtp nil
+ "SMTP protocol for sending mail."
+ :group 'mail)
+
+(defcustom smtp-default-server nil
+ "*Specify default SMTP server."
+ :type '(choice (const nil) string)
+ :group 'smtp)
+
+(defcustom smtp-server (or (getenv "SMTPSERVER") smtp-default-server)
+ "*The name of the host running SMTP server. It can also be a function
+called from `smtp-via-smtp' with arguments SENDER and RECIPIENTS."
+ :type '(choice (string :tag "Name")
+ (function :tag "Function"))
+ :group 'smtp)
+
+(defcustom smtp-service "smtp"
+ "*SMTP service port number. \"smtp\" or 25."
+ :type '(choice (integer :tag "25" 25)
+ (string :tag "smtp" "smtp"))
+ :group 'smtp)
+
+(defcustom smtp-use-8bitmime t
+ "*If non-nil, use ESMTP 8BITMIME if available."
+ :type 'boolean
+ :group 'smtp)
+
+(defcustom smtp-local-domain nil
+ "*Local domain name without a host name.
+If the function (system-name) returns the full internet address,
+don't define this value."
+ :type '(choice (const nil) string)
+ :group 'smtp)
+
+(defvar smtp-debug-info nil)
+(defvar smtp-read-point nil)
+
+(defun smtp-make-fqdn ()
+ "Return user's fully qualified domain name."
+ (let ((system-name (system-name)))
+ (cond
+ (smtp-local-domain
+ (concat system-name "." smtp-local-domain))
+ ((string-match "[^.]\\.[^.]" system-name)
+ system-name)
+ (t
+ (error "Cannot generate valid FQDN. Set `smtp-local-domain' correctly.")))))
+
+(defun smtp-via-smtp (sender recipients smtp-text-buffer)
+ (let ((server (if (functionp smtp-server)
+ (funcall smtp-server sender recipients)
+ smtp-server))
+ process response extensions)
+ (save-excursion
+ (set-buffer
+ (get-buffer-create
+ (format "*trace of SMTP session to %s*" server)))
+ (erase-buffer)
+ (make-local-variable 'smtp-read-point)
+ (setq smtp-read-point (point-min))
+
+ (unwind-protect
+ (catch 'done
+ (setq process (open-network-stream-as-binary
+ "SMTP" (current-buffer) server smtp-service))
+ (or process (throw 'done nil))
+
+ (set-process-filter process 'smtp-process-filter)
+
+ ;; Greeting
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (throw 'done (car (cdr response))))
+
+ ;; EHLO
+ (smtp-send-command process
+ (format "EHLO %s" (smtp-make-fqdn)))
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (progn
+ ;; HELO
+ (smtp-send-command process
+ (format "HELO %s" (smtp-make-fqdn)))
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (throw 'done (car (cdr response)))))
+ (let ((extension-lines (cdr (cdr response))))
+ (while extension-lines
+ (push (intern (downcase (substring (car extension-lines) 4)))
+ extensions)
+ (setq extension-lines (cdr extension-lines)))))
+
+ ;; ONEX --- One message transaction only (sendmail extension?)
+ (if (or (memq 'onex extensions)
+ (memq 'xone extensions))
+ (progn
+ (smtp-send-command process "ONEX")
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (throw 'done (car (cdr response))))))
+
+ ;; VERB --- Verbose (sendmail extension?)
+ (if (and smtp-debug-info
+ (or (memq 'verb extensions)
+ (memq 'xvrb extensions)))
+ (progn
+ (smtp-send-command process "VERB")
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (throw 'done (car (cdr response))))))
+
+ ;; XUSR --- Initial (user) submission (sendmail extension?)
+ (if (memq 'xusr extensions)
+ (progn
+ (smtp-send-command process "XUSR")
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (throw 'done (car (cdr response))))))
+
+ ;; MAIL FROM:<sender>
+ (smtp-send-command
+ process
+ (format "MAIL FROM:<%s>%s%s"
+ sender
+ ;; SIZE --- Message Size Declaration (RFC1870)
+ (if (memq 'size extensions)
+ (format " SIZE=%d"
+ (save-excursion
+ (set-buffer smtp-text-buffer)
+ (+ (- (point-max) (point-min))
+ ;; Add one byte for each change-of-line
+ ;; because or CR-LF representation:
+ (count-lines (point-min) (point-max))
+ ;; For some reason, an empty line is
+ ;; added to the message. Maybe this
+ ;; is a bug, but it can't hurt to add
+ ;; those two bytes anyway:
+ 2)))
+ "")
+ ;; 8BITMIME --- 8bit-MIMEtransport (RFC1652)
+ (if (and (memq '8bitmime extensions)
+ smtp-use-8bitmime)
+ " BODY=8BITMIME"
+ "")))
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (throw 'done (car (cdr response))))
+
+ ;; RCPT TO:<recipient>
+ (while recipients
+ (smtp-send-command process
+ (format "RCPT TO:<%s>" (car recipients)))
+ (setq recipients (cdr recipients))
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (throw 'done (car (cdr response)))))
+
+ ;; DATA
+ (smtp-send-command process "DATA")
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (throw 'done (car (cdr response))))
+
+ ;; Mail contents
+ (smtp-send-data process smtp-text-buffer)
+
+ ;; DATA end "."
+ (smtp-send-command process ".")
+ (setq response (smtp-read-response process))
+ (if (or (null (car response))
+ (not (integerp (car response)))
+ (>= (car response) 400))
+ (throw 'done (car (cdr response))))
+
+ t)
+
+ (if (and process
+ (eq (process-status process) 'open))
+ (progn
+ ;; QUIT
+ (smtp-send-command process "QUIT")
+ (smtp-read-response process)
+ (delete-process process)))))))
+
+(defun smtp-process-filter (process output)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+ (insert output)))
+
+(defun smtp-read-response (process)
+ (let ((case-fold-search nil)
+ (response-strings nil)
+ (response-continue t)
+ (return-value '(nil ()))
+ match-end)
+
+ (while response-continue
+ (goto-char smtp-read-point)
+ (while (not (search-forward "\r\n" nil t))
+ (accept-process-output process)
+ (goto-char smtp-read-point))
+
+ (setq match-end (point))
+ (setq response-strings
+ (cons (buffer-substring smtp-read-point (- match-end 2))
+ response-strings))
+
+ (goto-char smtp-read-point)
+ (if (looking-at "[0-9]+ ")
+ (let ((begin (match-beginning 0))
+ (end (match-end 0)))
+ (if smtp-debug-info
+ (message "%s" (car response-strings)))
+
+ (setq smtp-read-point match-end)
+
+ ;; ignore lines that start with "0"
+ (if (looking-at "0[0-9]+ ")
+ nil
+ (setq response-continue nil)
+ (setq return-value
+ (cons (string-to-int
+ (buffer-substring begin end))
+ (nreverse response-strings)))))
+
+ (if (looking-at "[0-9]+-")
+ (progn (if smtp-debug-info
+ (message "%s" (car response-strings)))
+ (setq smtp-read-point match-end)
+ (setq response-continue t))
+ (progn
+ (setq smtp-read-point match-end)
+ (setq response-continue nil)
+ (setq return-value
+ (cons nil (nreverse response-strings)))))))
+ (setq smtp-read-point match-end)
+ return-value))
+
+(defun smtp-send-command (process command)
+ (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-1 (process data)
+ (goto-char (point-max))
+ (if smtp-debug-info
+ (insert data "\r\n"))
+ (setq smtp-read-point (point))
+ ;; 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"))
+
+(defun smtp-send-data (process buffer)
+ (let ((data-continue t)
+ (sending-data nil)
+ this-line
+ this-line-end)
+
+ (save-excursion
+ (set-buffer buffer)
+ (goto-char (point-min)))
+
+ (while data-continue
+ (save-excursion
+ (set-buffer buffer)
+ (beginning-of-line)
+ (setq this-line (point))
+ (end-of-line)
+ (setq this-line-end (point))
+ (setq sending-data nil)
+ (setq sending-data (buffer-substring this-line this-line-end))
+ (if (or (/= (forward-line 1) 0) (eobp))
+ (setq data-continue nil)))
+
+ (smtp-send-data-1 process sending-data))))
+
+(defun smtp-deduce-address-list (smtp-text-buffer header-start header-end)
+ "Get address list suitable for smtp RCPT TO:<address>."
+ (let ((case-fold-search t)
+ (simple-address-list "")
+ this-line
+ this-line-end
+ addr-regexp
+ (smtp-address-buffer (generate-new-buffer " *smtp-mail*")))
+ (unwind-protect
+ (save-excursion
+ ;;
+ (set-buffer smtp-address-buffer)
+ (erase-buffer)
+ (insert (save-excursion
+ (set-buffer smtp-text-buffer)
+ (buffer-substring-no-properties header-start header-end)))
+ (goto-char (point-min))
+ ;; RESENT-* fields should stop processing of regular fields.
+ (save-excursion
+ (if (re-search-forward "^RESENT-TO:" header-end t)
+ (setq addr-regexp
+ "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)")
+ (setq addr-regexp "^\\(TO:\\|CC:\\|BCC:\\)")))
+
+ (while (re-search-forward addr-regexp header-end t)
+ (replace-match "")
+ (setq this-line (match-beginning 0))
+ (forward-line 1)
+ ;; get any continuation lines.
+ (while (and (looking-at "^[ \t]+") (< (point) header-end))
+ (forward-line 1))
+ (setq this-line-end (point-marker))
+ (setq simple-address-list
+ (concat simple-address-list " "
+ (mail-strip-quoted-names
+ (buffer-substring this-line this-line-end)))))
+ (erase-buffer)
+ (insert-string " ")
+ (insert-string simple-address-list)
+ (insert-string "\n")
+ ;; newline --> blank
+ (subst-char-in-region (point-min) (point-max) 10 ? t)
+ ;; comma --> blank
+ (subst-char-in-region (point-min) (point-max) ?, ? t)
+ ;; tab --> blank
+ (subst-char-in-region (point-min) (point-max) 9 ? t)
+
+ (goto-char (point-min))
+ ;; tidyness in case hook is not robust when it looks at this
+ (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
+
+ (goto-char (point-min))
+ (let (recipient-address-list)
+ (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
+ (backward-char 1)
+ (setq recipient-address-list
+ (cons (buffer-substring (match-beginning 1) (match-end 1))
+ recipient-address-list)))
+ recipient-address-list))
+ (kill-buffer smtp-address-buffer))))
+
+(provide 'smtp)
+
+;;; smtp.el ends here
--- /dev/null
+;;; smtpmail.el --- SMTP interface for mail-mode
+
+;; Copyright (C) 1995, 1996, 1998 Free Software Foundation, Inc.
+
+;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
+;; Keywords: mail
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Send Mail to smtp host from smtpmail temp buffer.
+
+;; Please add these lines in your .emacs(_emacs).
+;;
+;;(setq send-mail-function 'smtpmail-send-it)
+;;(setq smtp-default-server "YOUR SMTP HOST")
+;;(setq smtp-service "smtp")
+;;(setq smtp-local-domain "YOUR DOMAIN NAME")
+;;(setq smtp-debug-info t)
+;;(autoload 'smtpmail-send-it "smtpmail")
+;;(setq user-full-name "YOUR NAME HERE")
+
+;; To queue mail, set smtpmail-queue-mail to t and use
+;; smtpmail-send-queued-mail to send.
+
+
+;;; Code:
+
+(require 'smtp)
+(require 'sendmail)
+(require 'time-stamp)
+
+;;;
+
+(defcustom smtpmail-queue-mail nil
+ "*Specify if mail is queued (if t) or sent immediately (if nil).
+If queued, it is stored in the directory `smtpmail-queue-dir'
+and sent with `smtpmail-send-queued-mail'."
+ :type 'boolean
+ :group 'smtp)
+
+(defcustom smtpmail-queue-dir "~/Mail/queued-mail/"
+ "*Directory where `smtpmail.el' stores queued mail."
+ :type 'directory
+ :group 'smtp)
+
+(defvar smtpmail-queue-index-file "index"
+ "File name of queued mail index,
+This is relative to `smtpmail-queue-dir'.")
+
+(defvar smtpmail-queue-index (concat smtpmail-queue-dir
+ smtpmail-queue-index-file))
+
+(defvar smtpmail-recipient-address-list nil)
+
+
+;;;
+;;;
+;;;
+
+;;;###autoload
+(defun smtpmail-send-it ()
+ (require 'mail-utils)
+ (let ((errbuf (if mail-interactive
+ (generate-new-buffer " smtpmail errors")
+ 0))
+ (tembuf (generate-new-buffer " smtpmail temp"))
+ (case-fold-search nil)
+ resend-to-addresses
+ delimline
+ (mailbuf (current-buffer)))
+ (unwind-protect
+ (save-excursion
+ (set-buffer tembuf)
+ (erase-buffer)
+ (insert-buffer-substring mailbuf)
+ (goto-char (point-max))
+ ;; require one newline at the end.
+ (or (= (preceding-char) ?\n)
+ (insert ?\n))
+ ;; Change header-delimiter to be what sendmail expects.
+ (goto-char (point-min))
+ (re-search-forward
+ (concat "^" (regexp-quote mail-header-separator) "\n"))
+ (replace-match "\n")
+ (backward-char 1)
+ (setq delimline (point-marker))
+;; (sendmail-synch-aliases)
+ (if mail-aliases
+ (expand-mail-aliases (point-min) delimline))
+ (goto-char (point-min))
+ ;; ignore any blank lines in the header
+ (while (and (re-search-forward "\n\n\n*" delimline t)
+ (< (point) delimline))
+ (replace-match "\n"))
+ (let ((case-fold-search t))
+ (goto-char (point-min))
+ (goto-char (point-min))
+ (while (re-search-forward "^Resent-to:" delimline t)
+ (setq resend-to-addresses
+ (save-restriction
+ (narrow-to-region (point)
+ (save-excursion
+ (end-of-line)
+ (point)))
+ (append (mail-parse-comma-list)
+ resend-to-addresses))))
+;;; Apparently this causes a duplicate Sender.
+;;; ;; If the From is different than current user, insert Sender.
+;;; (goto-char (point-min))
+;;; (and (re-search-forward "^From:" delimline t)
+;;; (progn
+;;; (require 'mail-utils)
+;;; (not (string-equal
+;;; (mail-strip-quoted-names
+;;; (save-restriction
+;;; (narrow-to-region (point-min) delimline)
+;;; (mail-fetch-field "From")))
+;;; (user-login-name))))
+;;; (progn
+;;; (forward-line 1)
+;;; (insert "Sender: " (user-login-name) "\n")))
+ ;; Don't send out a blank subject line
+ (goto-char (point-min))
+ (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
+ (replace-match ""))
+ ;; Put the "From:" field in unless for some odd reason
+ ;; they put one in themselves.
+ (goto-char (point-min))
+ (if (not (re-search-forward "^From:" delimline t))
+ (let* ((login user-mail-address)
+ (fullname (user-full-name)))
+ (cond ((eq mail-from-style 'angles)
+ (insert "From: " fullname)
+ (let ((fullname-start (+ (point-min) 6))
+ (fullname-end (point-marker)))
+ (goto-char fullname-start)
+ ;; Look for a character that cannot appear unquoted
+ ;; according to RFC 822.
+ (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
+ fullname-end 1)
+ (progn
+ ;; Quote fullname, escaping specials.
+ (goto-char fullname-start)
+ (insert "\"")
+ (while (re-search-forward "[\"\\]"
+ fullname-end 1)
+ (replace-match "\\\\\\&" t))
+ (insert "\""))))
+ (insert " <" login ">\n"))
+ ((eq mail-from-style 'parens)
+ (insert "From: " login " (")
+ (let ((fullname-start (point)))
+ (insert fullname)
+ (let ((fullname-end (point-marker)))
+ (goto-char fullname-start)
+ ;; RFC 822 says \ and nonmatching parentheses
+ ;; must be escaped in comments.
+ ;; Escape every instance of ()\ ...
+ (while (re-search-forward "[()\\]" fullname-end 1)
+ (replace-match "\\\\\\&" t))
+ ;; ... then undo escaping of matching parentheses,
+ ;; including matching nested parentheses.
+ (goto-char fullname-start)
+ (while (re-search-forward
+ "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
+ fullname-end 1)
+ (replace-match "\\1(\\3)" t)
+ (goto-char fullname-start))))
+ (insert ")\n"))
+ ((null mail-from-style)
+ (insert "From: " login "\n")))))
+ ;; Insert an extra newline if we need it to work around
+ ;; Sun's bug that swallows newlines.
+ (goto-char (1+ delimline))
+ (if (eval mail-mailer-swallows-blank-line)
+ (newline))
+ ;; Find and handle any FCC fields.
+ (goto-char (point-min))
+ (if (re-search-forward "^FCC:" delimline t)
+ (mail-do-fcc delimline))
+ (if mail-interactive
+ (save-excursion
+ (set-buffer errbuf)
+ (erase-buffer))))
+ ;;
+ ;;
+ ;;
+ (setq smtpmail-recipient-address-list
+ (or resend-to-addresses
+ (smtp-deduce-address-list tembuf (point-min) delimline)))
+
+ (smtpmail-do-bcc delimline)
+ ; Send or queue
+ (if (not smtpmail-queue-mail)
+ (if smtpmail-recipient-address-list
+ (if (not (smtp-via-smtp user-mail-address
+ smtpmail-recipient-address-list
+ tembuf))
+ (error "Sending failed; SMTP protocol error"))
+ (error "Sending failed; no recipients"))
+ (let* ((file-data (concat
+ smtpmail-queue-dir
+ (time-stamp-strftime
+ "%02y%02m%02d-%02H%02M%02S")))
+ (file-elisp (concat file-data ".el"))
+ (buffer-data (create-file-buffer file-data))
+ (buffer-elisp (create-file-buffer file-elisp))
+ (buffer-scratch "*queue-mail*"))
+ (save-excursion
+ (set-buffer buffer-data)
+ (erase-buffer)
+ (insert-buffer tembuf)
+ (write-file file-data)
+ (set-buffer buffer-elisp)
+ (erase-buffer)
+ (insert (concat
+ "(setq smtpmail-recipient-address-list '"
+ (prin1-to-string smtpmail-recipient-address-list)
+ ")\n"))
+ (write-file file-elisp)
+ (set-buffer (generate-new-buffer buffer-scratch))
+ (insert (concat file-data "\n"))
+ (append-to-file (point-min)
+ (point-max)
+ smtpmail-queue-index)
+ )
+ (kill-buffer buffer-scratch)
+ (kill-buffer buffer-data)
+ (kill-buffer buffer-elisp))))
+ (kill-buffer tembuf)
+ (if (bufferp errbuf)
+ (kill-buffer errbuf)))))
+
+(defun smtpmail-send-queued-mail ()
+ "Send mail that was queued as a result of setting `smtpmail-queue-mail'."
+ (interactive)
+ ;;; Get index, get first mail, send it, get second mail, etc...
+ (let ((buffer-index (find-file-noselect smtpmail-queue-index))
+ (file-msg "")
+ (tembuf nil))
+ (save-excursion
+ (set-buffer buffer-index)
+ (beginning-of-buffer)
+ (while (not (eobp))
+ (setq file-msg (buffer-substring (point) (save-excursion
+ (end-of-line)
+ (point))))
+ (load file-msg)
+ (setq tembuf (find-file-noselect file-msg))
+ (if smtpmail-recipient-address-list
+ (if (not (smtp-via-smtp user-mail-address
+ smtpmail-recipient-address-list tembuf))
+ (error "Sending failed; SMTP protocol error"))
+ (error "Sending failed; no recipients"))
+ (delete-file file-msg)
+ (delete-file (concat file-msg ".el"))
+ (kill-buffer tembuf)
+ (kill-line 1))
+ (set-buffer buffer-index)
+ (save-buffer smtpmail-queue-index)
+ (kill-buffer buffer-index)
+ )))
+
+
+(defun smtpmail-do-bcc (header-end)
+ "Delete BCC: and their continuation lines from the header area.
+There may be multiple BCC: lines, and each may have arbitrarily
+many continuation lines."
+ (let ((case-fold-search t))
+ (save-excursion
+ (goto-char (point-min))
+ ;; iterate over all BCC: lines
+ (while (re-search-forward "^BCC:" header-end t)
+ (delete-region (match-beginning 0) (progn (forward-line 1) (point)))
+ ;; get rid of any continuation lines
+ (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
+ (replace-match ""))
+ )
+ ) ;; save-excursion
+ ) ;; let
+ )
+
+
+;;;
+
+(provide 'smtpmail)
+
+;;; smtpmail.el ends here
;;; std11.el --- STD 11 functions for GNU Emacs
-;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: mail, news, RFC 822, STD 11
-;; This file is part of MU (Message Utilities).
+;; 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
;;; Code:
-(autoload 'buffer-substring-no-properties "emu")
-(autoload 'member "emu")
+(or (fboundp 'buffer-substring-no-properties)
+ (require 'poe))
+(require 'custom)
-;;; @ field
+
+;;; @ fetch
;;;
(defconst std11-field-name-regexp "[!-9;-~]+")
(defconst std11-next-field-head-regexp
(concat "\n" std11-field-name-regexp ":"))
-(defun std11-field-end ()
- "Move to end of field and return this point. [std11.el]"
- (if (re-search-forward std11-next-field-head-regexp nil t)
+(defun std11-field-end (&optional bound)
+ "Move to end of field and return this point.
+The optional argument BOUNDs the search; it is a buffer position."
+ (if (re-search-forward std11-next-field-head-regexp bound t)
(goto-char (match-beginning 0))
- (if (re-search-forward "^$" nil t)
+ (if (re-search-forward "^$" bound t)
(goto-char (1- (match-beginning 0)))
(end-of-line)
))
(point)
)
-(defsubst std11-fetch-field (name)
+;;;###autoload
+(defun std11-fetch-field (name)
"Return the value of the header field NAME.
The buffer is expected to be narrowed to just the headers of the message."
(save-excursion
(buffer-substring-no-properties (match-end 0) (std11-field-end))
))))
+;;;###autoload
+(defun std11-narrow-to-header (&optional boundary)
+ "Narrow to the message header.
+If BOUNDARY is not nil, it is used as message header separator."
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (re-search-forward
+ (concat "^\\(" (regexp-quote (or boundary "")) "\\)?$")
+ nil t)
+ (match-beginning 0)
+ (point-max)
+ )))
+
+;;;###autoload
(defun std11-field-body (name &optional boundary)
"Return the value of the header field NAME.
If BOUNDARY is not nil, it is used as message header separator."
(save-excursion
(save-restriction
- (std11-narrow-to-header boundary)
- (std11-fetch-field name)
+ (inline (std11-narrow-to-header boundary)
+ (std11-fetch-field name))
)))
(defun std11-find-field-body (field-names &optional boundary)
"Return the first found field-body specified by FIELD-NAMES
of the message header in current buffer. If BOUNDARY is not nil, it is
-used as message header separator. [std11.el]"
+used as message header separator."
(save-excursion
(save-restriction
(std11-narrow-to-header boundary)
(defun std11-field-bodies (field-names &optional default-value boundary)
"Return list of each field-bodies of FIELD-NAMES of the message header
in current buffer. If BOUNDARY is not nil, it is used as message
-header separator. [std11.el]"
+header separator."
(save-excursion
(save-restriction
(std11-narrow-to-header boundary)
)
dest))))
-
-;;; @ unfolding
-;;;
-
-(defun std11-unfold-string (string)
- "Unfold STRING as message header field."
- (let ((dest "")
- (p 0))
- (while (string-match "\n\\([ \t]\\)" string p)
- (setq dest (concat dest
- (substring string p (match-beginning 0))
- (substring string
- (match-beginning 1)
- (setq p (match-end 0)))
- ))
- )
- (concat dest (substring string p))
- ))
-
-
-;;; @ header
-;;;
-
-(defun std11-narrow-to-header (&optional boundary)
- "Narrow to the message header.
-If BOUNDARY is not nil, it is used as message header separator.
-\[std11.el]"
- (narrow-to-region
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^\\(" (regexp-quote (or boundary "")) "\\)?$")
- nil t)
- (match-beginning 0)
- (point-max)
- )))
-
(defun std11-header-string (regexp &optional boundary)
"Return string of message header fields matched by REGEXP.
-If BOUNDARY is not nil, it is used as message header separator.
-\[std11.el]"
+If BOUNDARY is not nil, it is used as message header separator."
(let ((case-fold-search t))
(save-excursion
(save-restriction
(defun std11-header-string-except (regexp &optional boundary)
"Return string of message header fields not matched by REGEXP.
-If BOUNDARY is not nil, it is used as message header separator.
-\[std11.el]"
+If BOUNDARY is not nil, it is used as message header separator."
(let ((case-fold-search t))
(save-excursion
(save-restriction
(defun std11-collect-field-names (&optional boundary)
"Return list of all field-names of the message header in current buffer.
-If BOUNDARY is not nil, it is used as message header separator.
-\[std11.el]"
+If BOUNDARY is not nil, it is used as message header separator."
(save-excursion
(save-restriction
(std11-narrow-to-header boundary)
dest))))
+;;; @ unfolding
+;;;
+
+;;;###autoload
+(defun std11-unfold-string (string)
+ "Unfold STRING as message header field."
+ (let ((dest "")
+ (p 0))
+ (while (string-match "\n\\([ \t]\\)" string p)
+ (setq dest (concat dest
+ (substring string p (match-beginning 0))
+ (substring string
+ (match-beginning 1)
+ (setq p (match-end 0)))
+ ))
+ )
+ (concat dest (substring string p))
+ ))
+
+
;;; @ quoted-string
;;;
(defconst std11-non-qtext-char-list '(?\" ?\\ ?\r ?\n))
(defun std11-wrap-as-quoted-string (string)
- "Wrap STRING as RFC 822 quoted-string. [std11.el]"
+ "Wrap STRING as RFC 822 quoted-string."
(concat "\""
(std11-wrap-as-quoted-pairs string std11-non-qtext-char-list)
"\""))
(defun std11-strip-quoted-pair (string)
- "Strip quoted-pairs in STRING. [std11.el]"
+ "Strip quoted-pairs in STRING."
(let (dest
(b 0)
(i 0)
))
(defun std11-strip-quoted-string (string)
- "Strip quoted-string STRING. [std11.el]"
+ "Strip quoted-string STRING."
(let ((len (length string)))
(or (and (>= len 2)
(let ((max (1- len)))
;;; @ lexical analyze
;;;
-(defconst std11-space-chars " \t\n")
-(defconst std11-spaces-regexp (` (, (concat "[" std11-space-chars "]+"))))
-(defconst std11-special-char-list '(?\] ?\[
- ?\( ?\) ?< ?> ?@
- ?, ?\; ?: ?\\ ?\"
- ?.))
+(defcustom std11-lexical-analyzer
+ '(std11-analyze-quoted-string
+ std11-analyze-domain-literal
+ std11-analyze-comment
+ std11-analyze-spaces
+ std11-analyze-special
+ std11-analyze-atom)
+ "*List of functions to return result of lexical analyze.
+Each function must have two arguments: STRING and START.
+STRING is the target string to be analyzed.
+START is start position of STRING to analyze.
+
+Previous function is preferred to next function. If a function
+returns nil, next function is used. Otherwise the return value will
+be the result."
+ :group 'news
+ :group 'mail
+ :type '(repeat function))
+
+(eval-and-compile
+ (defconst std11-space-char-list '(? ?\t ?\n))
+ (defconst std11-special-char-list '(?\] ?\[
+ ?\( ?\) ?< ?> ?@
+ ?, ?\; ?: ?\\ ?\"
+ ?.))
+ )
+;; (defconst std11-spaces-regexp
+;; (eval-when-compile (concat "[" std11-space-char-list "]+")))
(defconst std11-atom-regexp
- (` (, (concat "^[^" std11-special-char-list std11-space-chars "]+"))))
-
-(defun std11-analyze-spaces (string)
- (if (and (string-match std11-spaces-regexp string)
- (= (match-beginning 0) 0))
+ (eval-when-compile
+ (concat "[^" std11-special-char-list std11-space-char-list "]+")))
+
+(defun std11-analyze-spaces (string start)
+ (if (and (string-match (eval-when-compile
+ (concat "[" std11-space-char-list "]+"))
+ string start)
+ (= (match-beginning 0) start))
(let ((end (match-end 0)))
- (cons (cons 'spaces (substring string 0 end))
- (substring string end)
- ))))
-
-(defun std11-analyze-special (str)
- (if (and (> (length str) 0)
- (memq (aref str 0) std11-special-char-list))
- (cons (cons 'specials (substring str 0 1))
- (substring str 1)
- )))
-
-(defun std11-analyze-atom (str)
- (if (string-match std11-atom-regexp str)
+ (cons (cons 'spaces (substring string start end))
+ ;;(substring string end)
+ end)
+ )))
+
+(defun std11-analyze-special (string start)
+ (if (and (> (length string) start)
+ (memq (aref string start) std11-special-char-list))
+ (cons (cons 'specials (substring string start (1+ start)))
+ ;;(substring string 1)
+ (1+ start))
+ ))
+
+(defun std11-analyze-atom (string start)
+ (if (and (string-match std11-atom-regexp string start)
+ (= (match-beginning 0) start))
(let ((end (match-end 0)))
- (cons (cons 'atom (substring str 0 end))
- (substring str end)
- ))))
+ (cons (cons 'atom (substring string start end))
+ ;;(substring string end)
+ end)
+ )))
-(defun std11-check-enclosure (str open close &optional recursive from)
- (let ((len (length str))
+(defun std11-check-enclosure (string open close &optional recursive from)
+ (let ((len (length string))
(i (or from 0))
)
(if (and (> len i)
- (eq (aref str i) open))
+ (eq (aref string i) open))
(let (p chr)
(setq i (1+ i))
(catch 'tag
(while (< i len)
- (setq chr (aref str i))
+ (setq chr (aref string i))
(cond ((eq chr ?\\)
(setq i (1+ i))
(if (>= i len)
((eq chr open)
(if (and recursive
(setq p (std11-check-enclosure
- str open close recursive i))
+ string open close recursive i))
)
(setq i p)
(throw 'tag nil)
))
))))))
-(defun std11-analyze-quoted-string (str)
- (let ((p (std11-check-enclosure str ?\" ?\")))
+(defun std11-analyze-quoted-string (string start)
+ (let ((p (std11-check-enclosure string ?\" ?\" nil start)))
(if p
- (cons (cons 'quoted-string (substring str 1 (1- p)))
- (substring str p))
+ (cons (cons 'quoted-string (substring string (1+ start) (1- p)))
+ ;;(substring string p))
+ p)
)))
-(defun std11-analyze-domain-literal (str)
- (let ((p (std11-check-enclosure str ?\[ ?\])))
+(defun std11-analyze-domain-literal (string start)
+ (let ((p (std11-check-enclosure string ?\[ ?\] nil start)))
(if p
- (cons (cons 'domain-literal (substring str 1 (1- p)))
- (substring str p))
+ (cons (cons 'domain-literal (substring string (1+ start) (1- p)))
+ ;;(substring string p))
+ p)
)))
-(defun std11-analyze-comment (str)
- (let ((p (std11-check-enclosure str ?\( ?\) t)))
+(defun std11-analyze-comment (string start)
+ (let ((p (std11-check-enclosure string ?\( ?\) t start)))
(if p
- (cons (cons 'comment (substring str 1 (1- p)))
- (substring str p))
+ (cons (cons 'comment (substring string (1+ start) (1- p)))
+ ;;(substring string p))
+ p)
)))
-(defun std11-lexical-analyze (str)
- (let (dest ret)
- (while (not (string-equal str ""))
+;;;###autoload
+(defun std11-lexical-analyze (string &optional analyzer start)
+ "Analyze STRING as lexical tokens of STD 11."
+ (or analyzer
+ (setq analyzer std11-lexical-analyzer))
+ (or start
+ (setq start 0))
+ (let ((len (length string))
+ dest ret)
+ (while (< start len)
(setq ret
- (or (std11-analyze-quoted-string str)
- (std11-analyze-domain-literal str)
- (std11-analyze-comment str)
- (std11-analyze-spaces str)
- (std11-analyze-special str)
- (std11-analyze-atom str)
- '((error) . "")
- ))
- (setq dest (cons (car ret) dest))
- (setq str (cdr ret))
+ (let ((rest analyzer)
+ func r)
+ (while (and (setq func (car rest))
+ (null (setq r (funcall func string start))))
+ (setq rest (cdr rest)))
+ (or r
+ (list (cons 'error (substring string start)) (1+ len)))
+ ))
+ (setq dest (cons (car ret) dest)
+ start (cdr ret))
)
(nreverse dest)
))
(cdr ret))
)))
-(defun std11-parse-in-reply-to (tokens)
- "Parse lexical TOKENS as In-Reply-To field, and return the result."
+(defun std11-parse-msg-ids (tokens)
+ "Parse lexical TOKENS as `*(phrase / msg-id)', and return the result."
(let ((ret (or (std11-parse-msg-id tokens)
(std11-parse-phrase tokens))))
(if ret
(nreverse dest)
))))
+(defalias 'std11-parse-in-reply-to 'std11-parse-msg-ids)
+(make-obsolete 'std11-parse-in-reply-to 'std11-parse-msg-ids)
+
;;; @ composer
;;;
(defun std11-addr-to-string (seq)
"Return string from lexical analyzed list SEQ
-represents addr-spec of RFC 822. [std11.el]"
+represents addr-spec of RFC 822."
(mapconcat (function
(lambda (token)
(let ((name (car token)))
seq "")
)
+;;;###autoload
(defun std11-address-string (address)
- "Return string of address part from parsed ADDRESS of RFC 822.
-\[std11.el]"
+ "Return string of address part from parsed ADDRESS of RFC 822."
(cond ((eq (car address) 'group)
(mapconcat (function std11-address-string)
(car (cdr address))
)
)))))
+(defun std11-comment-value-to-string (value)
+ (if (stringp value)
+ (std11-strip-quoted-pair value)
+ (let ((dest ""))
+ (while value
+ (setq dest
+ (concat dest
+ (if (stringp (car value))
+ (car value)
+ (concat "("
+ (std11-comment-value-to-string
+ (cdr (car value)))
+ ")")
+ ))
+ value (cdr value))
+ )
+ dest)))
+
+;;;###autoload
(defun std11-full-name-string (address)
- "Return string of full-name part from parsed ADDRESS of RFC 822.
-\[std11.el]"
+ "Return string of full-name part from parsed ADDRESS of RFC 822."
(cond ((eq (car address) 'group)
(mapconcat (function
(lambda (token)
(std11-strip-quoted-pair (cdr token))
)
((eq type 'comment)
- (concat
- "("
- (std11-strip-quoted-pair (cdr token))
- ")")
+ (concat "("
+ (std11-comment-value-to-string
+ (cdr token))
+ ")")
)
(t
(cdr token)
(nth 1 addr) ""))
)
(cond ((> (length phrase) 0) phrase)
- (comment (std11-strip-quoted-pair comment))
+ (comment (std11-comment-value-to-string comment))
)
))))
+;;;###autoload
(defun std11-msg-id-string (msg-id)
"Return string from parsed MSG-ID of RFC 822."
(concat "<" (std11-addr-to-string (cdr msg-id)) ">")
)
+;;;###autoload
(defun std11-fill-msg-id-list-string (string &optional column)
"Fill list of msg-id in STRING, and return the result."
(or column
;;; @ parser with lexical analyzer
;;;
+;;;###autoload
(defun std11-parse-address-string (string)
- "Parse STRING as mail address. [std11.el]"
+ "Parse STRING as mail address."
(std11-parse-address (std11-lexical-analyze string))
)
+;;;###autoload
(defun std11-parse-addresses-string (string)
- "Parse STRING as mail address list. [std11.el]"
+ "Parse STRING as mail address list."
(std11-parse-addresses (std11-lexical-analyze string))
)
+;;;###autoload
+(defun std11-parse-msg-id-string (string)
+ "Parse STRING as msg-id."
+ (std11-parse-msg-id (std11-lexical-analyze string))
+ )
+
+;;;###autoload
+(defun std11-parse-msg-ids-string (string)
+ "Parse STRING as `*(phrase / msg-id)'."
+ (std11-parse-msg-ids (std11-lexical-analyze string))
+ )
+
+;;;###autoload
(defun std11-extract-address-components (string)
"Extract full name and canonical address from STRING.
Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
-If no name can be extracted, FULL-NAME will be nil. [std11.el]"
+If no name can be extracted, FULL-NAME will be nil."
(let* ((structure (car (std11-parse-address-string
(std11-unfold-string string))))
(phrase (std11-full-name-string structure))
projects / elisp / flim.git / commitdiff