From 41fe6bdf8523a73c43e73612b5df85caa5622081 Mon Sep 17 00:00:00 2001 From: morioka Date: Wed, 12 May 1999 11:29:04 +0000 Subject: [PATCH] Merge flim-1_12_6. --- ChangeLog | 546 +++++++++++++++++++++++++++++++++++++++++++- FLIM-CFG | 8 +- FLIM-ELS | 12 +- Makefile | 21 +- NEWS | 109 ++++++++- README.en | 26 ++- README.ja | 94 ++++---- VERSION | 30 ++- eword-decode.el | 682 +++++++++++++++++++++++++++++++++++-------------------- eword-encode.el | 56 +++-- ftp.in | 6 +- mel-b-ccl.el | 226 +++++++++++------- mel-q-ccl.el | 24 +- mel.el | 13 +- mime-def.el | 22 +- mime-en.sgml | 37 ++- mime-en.texi | 58 +++-- mime-ja.sgml | 195 +++++++++------- mime-ja.texi | 61 +++-- mime-parse.el | 80 ++++++- mime.el | 101 +++++--- mmbuffer.el | 15 +- mmgeneric.el | 35 ++- smtp.el | 393 ++++++++++++++++++++++++++++++++ smtpmail.el | 305 +++++++++++++++++++++++++ std11.el | 338 ++++++++++++++++----------- 26 files changed, 2730 insertions(+), 763 deletions(-) create mode 100644 smtp.el create mode 100644 smtpmail.el diff --git a/ChangeLog b/ChangeLog index ed4066d..f8250b5 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,6 +1,544 @@ +1999-05-11 MORIOKA Tomohiko + + * FLIM: Version 1.12.6 (Family-K-Dòenmae)-A released. + +1999-04-27 Shuhei KOBAYASHI + + * mel-b-ccl.el (TopLevel): Suppress warning. + mel-q-ccl.el (TopLevel): Ditto. + mime.el (TopLevel): Ditto. + +1999-04-26 Shuhei KOBAYASHI + + * eword-decode.el (eword-encoded-word-regexp): Accept "b" and "q" + for "encoding". + + * mime-def.el (std11-qtext-regexp): Don't use `string'. + (mime-tspecial-char-list): Eval at compile time. + +1999-04-22 Katsumi Yamaoka + + * mime.el: Delete autoload setting for `eword-encode-field'. + +1999-04-22 MORIOKA Tomohiko + + * eword-encode.el: Require `poem' instead of `emu'. + Don't use `cl' for `caar'. + +1999-04-09 Katsumi Yamaoka + + * smtp.el (smtp-via-smtp): Funcall `smtp-server' if it is a + function. + (smtp-server): Make it can also be a function called from + `smtp-via-smtp' with arguments SENDER and RECIPIENTS. + +1999-04-05 Shuhei KOBAYASHI + + * FLIM-CFG: Make easier to install in VERSION_SPECIFIC_LISPDIR. + +1999-03-29 Shuhei KOBAYASHI + + * mime.el (mime-read-field): Correct argument of + `mime-decode-field-body'; 'native -> 'plain. + +1999-03-27 Shuhei KOBAYASHI + + * eword-encode.el (TopLevel): Require 'cl when compiling. + (eword-encode-rword-list): Suppress insertion of extra spaces. + (eword-encode-msg-id-to-rword-list): Treat surrounding angle + brackets atomically. + ([tm-ja:4244] by Kazuhiro Ohta ) + +1999-03-11 MORIOKA Tomohiko + + * eword-encode.el (eword-charset-encoding-alist): Add `tis-620'. + +1999-03-01 MORIOKA Tomohiko + + * mel.el (mime-decode-string): Return STRING if return value of + `(mel-find-function 'mime-decode-string encoding)' is nil. + +1999-02-10 MORIOKA Tomohiko + + * mime-def.el (mel-define-service): Change size of obarray to 7. + +1999-02-01 Yoshiki Hayashi + + * mime-ja.sgml: Tranlate all untranslated parts. + + +1999-01-27 MORIOKA Tomohiko + + * FLIM: Version 1.12.5 (Hirahata) released. + + * mime-ja.sgml, mime-en.sgml: Sync with FLIM API 1.12. + +1999-01-26 MORIOKA Tomohiko + + * NEWS (New optional argument of `std11-field-end'): New + subsection. + + * std11.el (std11-field-end): Add new optional argument `bound'. + + +1999-01-24 MORIOKA Tomohiko + + * FLIM: Version 1.12.4 (Tsutsui) released. + +1999-01-24 MORIOKA Tomohiko + + * README.en: Sync with latest FLIM. + + * README.ja: fixed. + +1999-01-24 MORIOKA Tomohiko + + * mmbuffer.el, mmgeneric.el (insert-entity-content): New method. + + * mime.el (mime-insert-entity-content): New generic function. + +1999-01-24 MORIOKA Tomohiko + + * NEWS (New function `mime-find-entity-from-content-id'): New + subsection. + (New function `mime-parse-msg-id'): New subsection. + (New function `mime-uri-parse-cid'): New subsection. + +1999-01-24 MORIOKA Tomohiko + + * mime.el (mime-find-entity-from-content-id): New function. + (mime-field-parser-alist): Use `mime-parse-msg-id' instead of + `std11-parse-msg-id' to parse `Message-Id', `Recent-Message-Id' + and `Content-Id' field. + + * mime-parse.el (mime-parse-msg-id): New function. + (mime-uri-parse-cid): New function. + + +1999-01-23 MORIOKA Tomohiko + + * FLIM: Version 1.12.3 (Kintetsu-K-Dòriyama)-A released. + +1999-01-23 MORIOKA Tomohiko + + * NEWS (Function `std11-parse-in-reply-to'): New subsection. + (New function `std11-parse-msg-id-string'): Likewise. + (New function `std11-parse-msg-ids-string'): Likewise. + (New generic function `mime-insert-entity'): Likewise. + +1999-01-23 MORIOKA Tomohiko + + * mime.el (mime-field-parser-alist): Change to set parser for + tokens instead of parser for string. + (mime-read-field): Use `eword-lexical-analyze' before parsing. + + * eword-encode.el (eword-encode-in-reply-to): Use + `std11-parse-msg-ids-string' instead of `std11-parse-in-reply-to' + and `std11-lexical-analyze'. + + * std11.el (std11-parse-msg-ids): Renamed from + `std11-parse-in-reply-to'; define `std11-parse-in-reply-to' as + obsolete alias. + (std11-parse-msg-id-string): New function. + (std11-parse-msg-ids-string): New function. + +1999-01-23 MORIOKA Tomohiko + + * mime.el (mime-field-parser-alist): New variable. + (mime-read-field): Refer `mime-field-parser-alist'. + +1999-01-23 MORIOKA Tomohiko + + * mmbuffer.el, mmgeneric.el (insert-entity): New method. + + * mime.el (mime-insert-entity): New generic function. + +1999-01-22 Katsumi Yamaoka + + * std11.el (TopLevel): Require `custom'. + + +1999-01-21 MORIOKA Tomohiko + + * FLIM: Version 1.12.2 (Kuj-Dò)-A released. + +1999-01-16 MORIOKA Tomohiko + + * mime-parse.el (mime-lexical-analyzer): New user option. + (mime-analyze-tspecial): New function. + (mime-analyze-token): New function. + (mime-parse-Content-Transfer-Encoding): Use + `std11-lexical-analyze' with `mime-lexical-analyzer'. + + * mime-def.el (mime-tspecial-char-list): Renamed from + `mime-tspecials'; changed from string to list. + (mime-token-regexp): Use `eval-when-compile'. + +1999-01-16 MORIOKA Tomohiko + + * eword-decode.el (eword-lexical-analyzer): Modify DOC-string + about interface change. + (eword-analyze-comment): Renamed from `eword-parse-comment'; + change second argument `from' to required argument; abolish alias + `eword-analyze-comment' of `eword-parse-comment'. + +1999-01-16 MORIOKA Tomohiko + + * NEWS (User option `eword-lexical-analyzers' -> + `eword-lexical-analyzer'): New subsection. + + * eword-decode.el (eword-lexical-analyzer): Renamed from user + option `eword-lexical-analyzers'. + +1999-01-16 MORIOKA Tomohiko + + * NEWS (New user option `std11-lexical-analyzer'): New subsection. + + * std11.el (std11-lexical-analyzer): Renamed from user option + `std11-lexical-analyzers'. + +1999-01-16 MORIOKA Tomohiko + + * std11.el (std11-lexical-analyze): Change interface to add new + optional argument `analyzers'. + +1999-01-16 MORIOKA Tomohiko + + * std11.el (std11-lexical-analyzers): New user option. + (std11-lexical-analyze): New implementation; refer + `std11-lexical-analyzers'. + +1999-01-16 MORIOKA Tomohiko + + * NEWS (Change interface of lexical-analyzers): New subsection. + +1999-01-16 MORIOKA Tomohiko + + * eword-decode.el (eword-encoded-word-regexp): Must define when + this module is compiled. + (eword-decode-structured-field-body): Add new optional argument + `start'. + (eword-decode-and-unfold-structured-field-body): Likewise. + (eword-decode-and-fold-structured-field-body): Likewise. + (eword-analyze-quoted-string): Add new argument `start'; return + `( . )' instead of `( + . )'. + (std11-analyze-domain-literal): Likewise. + (eword-analyze-domain-literal): Likewise. + (eword-analyze-comment): Changed to alias of + `eword-parse-comment'. + (eword-analyze-spaces): Add new argument `start'; return `( . )' instead of `( . )'. + (std11-analyze-domain-literal): Likewise. + (eword-analyze-special): Likewise. + (eword-analyze-encoded-word): Likewise. + (eword-analyze-atom): Likewise. + (eword-lexical-analyze-internal): Add new argument `start'. + (eword-lexical-analyze): Change interface to add new optional + argument `start'. + (eword-extract-address-components): Add new optional argument + `start'. + + * std11.el (std11-atom-regexp): Modify to match non-top atom. + (std11-analyze-spaces): Add new argument `start'; return `( . )' instead of `( . )'. + (std11-analyze-special): Likewise. + (std11-analyze-atom): Likewise. + (std11-analyze-quoted-string): Likewise. + (std11-analyze-domain-literal): Likewise. + (std11-analyze-comment): Likewise. + (std11-lexical-analyze): Add new optional argument `start'. + +1999-01-15 MORIOKA Tomohiko + + * std11.el (std11-fetch-field): Add autoload cookie. + (std11-narrow-to-header): Likewise. + (std11-field-body): Likewise. + (std11-unfold-string): Likewise. + (std11-lexical-analyze): Add DOC-string; add autoload cookie. + + * std11.el (std11-space-char-list): Renamed from + `std11-space-chars'; changed from string to list. + +1999-01-15 MORIOKA Tomohiko + + * std11.el (std11-fetch-field): Don't define as inline function. + (std11-field-body): Enclose `std11-narrow-to-header' and + `std11-fetch-field' by `inline'. + +1999-01-15 MORIOKA Tomohiko + + * std11.el (std11-special-char-list): Evaluate when it is + compiled. + (std11-atom-regexp): Use `eval-when-compile'. + +1999-01-15 MORIOKA Tomohiko + + * std11.el (std11-space-chars): Must evaluate when it is compiled. + (std11-analyze-spaces): Don't use `std11-spaces-regexp'; abolist + constant `std11-spaces-regexp'. + + * mime-parse.el (mime-disposition-type-regexp): Must evaluate when + it is compiled. + + * mime-parse.el: Don't require emu. + + * mime-parse.el (mime-parse-Content-Disposition): Use + `eval-when-compile'. + + * mime-parse.el (mime-parse-Content-Transfer-Encoding): New + implementation. + +1998-12-22 Katsumi Yamaoka + + * README.en (Installation): Modify for APEL 9.12. + * README.ja (Installation): Likewise. + +1998-12-14 Katsumi Yamaoka + + * mel-b-ccl.el (base64-ccl-insert-encoded-file): Call + `insert-file-contents-as-coding-system' with CODING-SYSTEM as the + 1st arg. + * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): + Likewise. + + * mel-b-ccl.el (base64-ccl-write-decoded-region): Call + `write-region-as-coding-system' with CODING-SYSTEM as the 1st arg. + * mel-q-ccl.el (quoted-printable-ccl-write-decoded-region): + Likewise. + +1998-12-14 Katsumi Yamaoka + + * mel-b-ccl.el (base64-ccl-insert-encoded-file): Use + `insert-file-contents-as-coding-system' (renamed from + `insert-file-contents-as-specified-coding-system'). + * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): + Likewise. + + * mel-b-ccl.el (base64-ccl-write-decoded-region): Use + `write-region-as-coding-system' (renamed from + `write-region-as-specified-coding-system'). + * mel-q-ccl.el (quoted-printable-ccl-write-decoded-region): + Likewise. + +1998-12-08 Katsumi Yamaoka + + * smtp.el (smtp-coding-system): Abolished. + (smtp-via-smtp): Use `open-network-stream-as-binary' instead of + `open-network-stream'. + +1998-12-04 Katsumi Yamaoka + + * mel-b-ccl.el (base64-ccl-insert-encoded-file): Use + `insert-file-contents-as-specified-coding-system' instead of + `insert-file-contents'. + * mel-q-ccl.el (quoted-printable-ccl-insert-encoded-file): + Likewise. + + * mel-b-ccl.el (base64-ccl-write-decoded-region): Use + `write-region-as-specified-coding-system' instead of + `write-region'. + * mel-q-ccl.el (quoted-printable-ccl-write-decoded-region): + Likewise. + + +1998-12-02 MORIOKA Tomohiko + + * FLIM: Version 1.12.1 (Nishinoky-Dò)-A released. + +1998-11-30 MORIOKA Tomohiko + + * smtpmail.el (smtpmail-send-it): Add autoload cookie; use + `smtpmail-do-bcc' instead of `smtp-do-bcc'; modify for interface + change of `smtp-via-smtp'. + (smtpmail-do-bcc): New function (moved and renamed from + `smtp-do-bcc' of smtp.el). + +1998-08-06 Katsumi Yamaoka + + * lisp/smtp.el: Do not insert empty line at the end of message. + +1998-06-18 Shuhei KOBAYASHI + + * lisp/smtp.el (smtp-use-8bitmime): New variable. + (smtp-debug-info): Internal variable, now. + (smtp-make-fqdn): Renamed from `smtp-fqdn'. + (smtp-via-smtp): New implementation. + (smtp-send-command): Treat "PASS" as usual. + (smtp-do-bcc): Removed. + +1998-11-30 MORIOKA Tomohiko + + * smtpmail.el: New module (copied from Semi-gnus 6.8). + + * smtp.el: New module (copied from Semi-gnus 6.8). + + * FLIM-ELS: Add smtp.el and smtpmail.el. + +1998-11-30 MORIOKA Tomohiko + + * mime-def.el: Abolish function `eliminate-top-spaces' because it + is not used in FLIM. + +1998-11-29 MORIOKA Tomohiko + + * eword-encode.el (eword-encode-mailbox-to-rword-list): Fix + problem in `eword-encode-addresses-to-rword-list'. + +1998-11-26 MORIOKA Tomohiko + + * std11.el (std11-full-name-string): fixed. + + * std11.el (std11-comment-value-to-string): fixed. + +1998-11-25 MORIOKA Tomohiko + + * NEWS (Changes in FLIM 1.12): New section. + +1998-11-25 MORIOKA Tomohiko + + * std11.el (std11-comment-value-to-string): New function. + (std11-full-name-string): Use `std11-comment-value-to-string'. + + * eword-decode.el (eword-parse-comment): New function. + (eword-analyze-comment): New implementation; use + `eword-parse-comment'; change representation. + (eword-decode-token): Modify for representation change of comment. + + +1998-11-16 MORIOKA Tomohiko + + * FLIM: Version 1.12.0 (Amagatsuji) was released. + +1998-11-14 Tanaka Akira + + * mel-b-ccl.el (ccl-cascading-read): Check consistency. + +1998-11-13 MORIOKA Tomohiko + + * eword-decode.el (eword-decode-structured-field-body): Abolish + non-used local variable. + +1998-11-12 Tanaka Akira + + * mel-b-ccl.el (mel-ccl-decode-b): Check `ccl-cascading-read' to + select implementation. + +1998-11-12 Tanaka Akira + + * mel-q-ccl.el (mel-ccl-encode-quoted-printable-generic): workaround + for mule-2.3@19.34. + +1998-11-12 Tanaka Akira + + * mel.el (mel-b-builtin): New variable. + +1998-11-10 Tanaka Akira + + * FLIM-ELS: require 'pccl. + (flim-modules): Check CCL availability by broken facility. + +1998-11-08 MORIOKA Tomohiko + + * eword-decode.el (eword-decode-structured-field-body): New + implementation; abolish optional argument `must-unfold'; delete + DOC-string. + (eword-decode-and-unfold-structured-field-body): Renamed from + `eword-decode-and-unfold-structured-field'; delete DOC-string. + (eword-decode-and-fold-structured-field-body): Renamed from + `eword-decode-and-fold-structured-field'; abolish optional + argument `must-unfold'; delete DOC-string. + (eword-decode-unstructured-field-body): Abolish optional argument + `must-unfold'; delete DOC-string. + (eword-decode-and-unfold-unstructured-field-body): Renamed from + `eword-decode-and-unfold-unstructured-field'; delete DOC-string. + (eword-decode-unfolded-unstructured-field-body): New function. + +1998-11-08 MORIOKA Tomohiko + + * mmgeneric.el (mime-insert-header-from-buffer): Use + `mime-find-field-presentation-method' and + `mime-find-field-decoder-internal'. + + * eword-decode.el (mime-find-field-presentation-method): New + macro. + (mime-find-field-decoder-internal): New function. + (mime-find-field-decoder): New implementation (use + mime-find-field-decoder-internal). + (mime-decode-header-in-region): Use + `mime-find-field-presentation-method' and + `mime-find-field-decoder-internal'. + +1998-11-08 MORIOKA Tomohiko + + * mmgeneric.el (mime-insert-header-from-buffer): Rename + field-presentation-mode `folding' to `wide'. + + * eword-decode.el: Rename field-presentation-modes from `native', + `folding', `unfolding', `unfolding-xover' to `plain', `wide', + `summary', `nov'. + +1998-11-07 Tanaka Akira + + * eword-decode.el (mime-set-field-decoder): Add mode `unfolding-xover'. + (mime-find-field-decoder): Ditto. + +1998-11-04 MORIOKA Tomohiko + + * eword-encode.el (eword-encode-phrase-route-addr-to-rword-list): + Don't delete the front spaces. + (eword-encode-addresses-to-rword-list): Don't supplement space; + use `nconc' instead of `append'. + (eword-encode-msg-id-to-rword-list): Supplement the front space; + use `nconc' instead of `append'. + +1998-11-02 Tanaka Akira + + * eword-decode.el (mime-field-decoder-cache): New variable. + (mime-find-field-decoder): Use `mime-field-decoder-cache'. + (mime-update-field-decoder-cache): New variable. + (mime-update-field-decoder-cache): New function. + (mime-decode-header-in-region): Use `mime-field-decoder-cache'. + + * mmgeneric.el (mime-insert-header-from-buffer): Use + `mime-field-decoder-cache'. + +1998-11-02 MORIOKA Tomohiko + + * eword-decode.el (mime-decode-header-in-region): New function. + (mime-decode-header-in-buffer): Use function + `mime-decode-header-in-region'. + 1998-10-28 MORIOKA Tomohiko - * 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 + + * mime-def.el: Avoid compile error when edebug is missing. 1998-10-28 MORIOKA Tomohiko @@ -412,7 +950,7 @@ * 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"; @@ -581,7 +1119,7 @@ (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 @@ -1617,7 +2155,7 @@ * eword-decode.el (eword-decode-ignored-field-list): Add `received'. - + * mel.el (mime-temp-directory): Use TMPDIR, TMP, or TEMP environment variables. diff --git a/FLIM-CFG b/FLIM-CFG index 57565ab..e4fbd65 100644 --- a/FLIM-CFG +++ b/FLIM-CFG @@ -16,9 +16,7 @@ (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) @@ -54,6 +52,10 @@ (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 diff --git a/FLIM-ELS b/FLIM-ELS index c778f88..d389fa4 100644 --- a/FLIM-ELS +++ b/FLIM-ELS @@ -9,7 +9,8 @@ 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))) @@ -19,11 +20,8 @@ (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 diff --git a/Makefile b/Makefile index d1565ef..67cc56d 100644 --- a/Makefile +++ b/Makefile @@ -3,7 +3,8 @@ # PACKAGE = flim -VERSION = 1.11.3 +API = 1.12 +RELEASE = 6 TAR = tar RM = /bin/rm -f @@ -23,6 +24,9 @@ GOMI = *.elc \ *.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) \ @@ -45,20 +49,19 @@ clean: 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 . diff --git a/NEWS b/NEWS index 7662287..79e5e60 100644 --- a/NEWS +++ b/NEWS @@ -1,6 +1,113 @@ 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. + + * Changes in FLIM 1.11 ** New function `mime-insert-text-content' diff --git a/README.en b/README.en index 4213653..358e4e3 100644 --- a/README.en +++ b/README.en @@ -1,4 +1,5 @@ [README for FLIM (English Version)] +by MORIOKA Tomohiko What's FLIM =========== @@ -9,7 +10,7 @@ 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 @@ -18,14 +19,16 @@ What's FLIM 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 @@ -36,7 +39,7 @@ What's FLIM 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/ @@ -67,7 +70,7 @@ Installation 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=~/ @@ -93,6 +96,11 @@ Installation % 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. @@ -103,7 +111,7 @@ Installation % 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 diff --git a/README.ja b/README.ja index a3233bb..01740dc 100644 --- a/README.ja +++ b/README.ja @@ -3,51 +3,53 @@ FLIM $B$H$O!)(B =========== - FLIM $B$O%a%C%;!<%8I=8=$HId9f2=$K4X$9$k4pACE*$J5!G=$rDs6!$9$k%i%$%V%i(B - $B%j!<$G$9!#0J2<$N%b%8%e!<%k$+$i9=@.$5$l$F$$$^$9(B: + FLIM $B$O(B Internet message $B$K4X$9$kMM!9$JI=8=7A<0$dId9f2=$K4X$9$k4pAC(B + $BE*$J5!G=$rDs6!$9$k$?$a$NHFMQItIJ$G$9!#(BFLIM $B$O0J2<$N%b%8%e!<%k$+$i9=(B + $B@.$5$l$F$$$^$9(B: - std11.el --- STD 11 (RFC 822) $B$N2r@O4o$H%f!<%F%#%j%F%#!<(B + std11.el --- STD 11 (RFC 822) $B7A<0$K4p$E$/2r@O=hM}Ey(B - mime.el --- MIME $B%i%$%V%i%j!<(B + mime.el --- MIME-entity $B$K4X$9$k=t5!G=$NDs6!(B - mime-def.el --- MIME $B$NMM<0$K4X$9$kDj5A(B + mime-def.el --- MIME $B7A<0$K4X$9$kDj5A(B mime-parse.el --- MIME $B2r@O4o(B mel.el --- MIME $BId9f4o(B/$BI|9f4o(B mel-b-dl.el --- base64 (B-encoding) $BId9f4o(B/$BI|9f4o(B - (Emacs 20 $B$NF0E*FI$_9~$_5!G=IU$-MQ(B) - mel-b.el --- base64 (B-encoding) $BId9f4o(B/$BI|9f4o(B - ($BB>$N(B emacs $B4D6-MQ(B) + (dynamic loading $B5!G=IU$-(B Emacs 20 $BMQ(B) + mel-b-ccl.el --- base64 (B-encoding) encoder/decoder (using CCL) + mel-b-el.el --- base64 (B-encoding) $BId9f4o(B/$BI|9f4o(B + ($BB>$N(B emacsen $BMQ(B) + mel-q-ccl.el --- quoted-printable and Q-encoding + encoder/decoder (using CCL) mel-q.el --- quoted-printable $B$H(B Q-encoding $BId9f4o(B/$BI|9f4o(B - mel-ccl.el --- CCL $B$r;H$C$?(B base64 (B-encoding), - quoted-printable $B$H(B Q-encoding $B$NId9f4o(B/$BI|9f4o(B - mel-u.el --- uuencode $B$N$?$a$NHs8x<0%b%8%e!<%k(B - mel-g.el --- gzip64 $B$N$?$a$NHs8x<0%b%8%e!<%k(B + mel-u.el --- uuencode $B$N$?$a$NHs8x<0(B backend + mel-g.el --- gzip64 $B$N$?$a$NHs8x<0(B backend eword-decode.el --- encoded-word $BI|9f4o(B eword-encode.el --- encoded-word $BId9f4o(B - mailcap.el --- mailcap $B2r@O4o$H%f!<%F%#%j%F%#!<(B + mailcap.el --- mailcap $B$N2r@O=hM}Ey(B -$B%$%s%9%H!<%k(B -============ +$BF3F~(B (install) +============== -(0) $B%$%s%9%H!<%k$9$kA0$K!"(BAPEL $B%Q%C%1!<%8(B (9.6 $B0J9_(B) - $B$r%$%s%9%H!<%k$7$F$/$@$5$$!#(BAPEL $B%Q%C%1!<%8$O0J2<$N$H$3$m$Gl=j$Gl=j$X$NF3F~(B - $BB>$N%G%#%l%/%H%j!<$K%$%s%9%H!<%k$7$?$/$J$$$J$i!"0J2<$N$3$H$@$1$r$d$C(B - $B$F$/$@$5$$(B: + $BE83+$7$?>l=j$H$O0[$J$k>l=j$KF3F~$7$?$/$J$$$J$i!"(B % make + $B$@$1$r$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"(B % make EMACS=xemacs @@ -56,18 +58,20 @@ FLIM $B$H$O!)(B (b) make install - $BB>$N%G%#%l%/%H%j!<$K%$%s%9%H!<%k$7$?$$$J$i!"0J2<$N$3$H$r$7$F$/$@$5$$(B: + $BE83+$7$?>l=j$H$O0[$J$k>l=j$KF3F~$7$?$$$J$i!"(B % make install + $B$r$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"(B % make install EMACS=xemacs `EMACS=...' $B$,>JN,$5$l$k$H!"(BEmacs=emacs $B$,;H$o$l$^$9!#(B - Emacs Lisp $B%W%m%0%i%`$H%7%'%k%9%/%j%W%H$N$?$a$N%G%#%l%/%H%j!l9g$O!"$=$l$i$N$"$k>l=j$r;XDj$9$kI,MW(B - $B$,$"$j$^$9!#Nc$($P!"(B: + $B%H%j!<$KF3F~$5$l$F$$$k>l9g$O!"$=$l$i$N$"$k>l=j$r;XDj$9$kI,MW(B + $B$,$"$j$^$9!#Nc$($P!'(B % make install VERSION_SPECIFIC_LISPDIR=~/elisp - $B$I$N%U%!%$%k$,(B emu $B%b%8%e!<%k$+(B apel $B%b%8%e!<%k$N0lIt$J$N$+!"$=$l$i(B - $B$,$I$3$K%$%s%9%H!<%k$5$l$k$+$rCN$j$?$$$H$-$O!"$NA*Br<+M3$J@_Dj$r;XDj$9$k$3$H$,(B - $B$G$-$^$9!#$=$NCf$N%3%a%s%H$rFI$s$G$/$@$5$$!#(B + $B$^$?!"(BFLIM-CFG $B%U%!%$%k$rJT=8$9$k$3$H$GB>$NA*Br2DG=$J@_Dj$r;XDj$9$k(B + $B$3$H$,$G$-$^$9!#$=$N>\:Y$K4X$7$F$O(B FLIM-CFG $B%U%!%$%k$NCml9g$O!"0J2<$N$3(B - $B$H$r$7$F$/$@$5$$(B: + XEmacs $B$N%Q%C%1!<%8!&%G%#%l%/%H%j!<$KF3F~$9$k>l9g$O!"(B % make install-package - emacs $B$N%3%^%s%IL>$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P!"(B + $B$r$r;XDj$9$k$3$H$,$G$-$^$9!#Nc!'(B % make install-package XEMACS=xemacs-21 `XEMACS=...' $B$,>JN,$5$l$k$H!"(BXEMACS=xemacs $B$,;HMQ$5$l$^$9!#(B - $B%Q%C%1!<%8$N%G%#%l%/%H%j!<$r;XDj$9$k$3$H$,$G$-$^$9!#Nc$($P(B: + $B%Q%C%1!<%8!&%G%#%l%/%H%j!<$r;XDj$9$k$3$H$,$G$-$^$9!#Nc!'(B % make install PACKAGEDIR=~/.xemacs - `PACKAGEDIR=...' $B$,>JN,$5$l$k$H!"B8:_$9$k%Q%C%1!<%8%G%#%l%/%H%j!<$N(B - $B:G=i$N$b$N$,;H$o$l$^$9!#(B + `PACKAGEDIR=...' $B$,>JN,$5$l$k$H!"B8:_$9$k%Q%C%1!<%8!&%G%#%l%/%H%j!<(B + $B$N:G=i$N$b$N$,;H$o$l$^$9!#(B + + $B!NCm0U!O(BXEmacs $B$N%Q%C%1!<%8!&%7%9%F%`$O(B XEmacs 21.0 $B$+$=$l0J9_$,I,MW(B + $B$G$9!#(B - XEmacs $B$N%Q%C%1!<%8%7%9%F%`$O(B XEmacs 21.0 $B$+$=$l0J9_$rMW5a$9$k$3$H$K(B - $BCm0U$7$F$/$@$5$$!#(B load-path (Emacs $B$H(B MULE $BMQ(B) ============================= - Emacs $B$+(B Mule $B$r;H$C$F$$$k$J$i!"(BFLIM $B$N%G%#%l%/%H%j!<$r(B - load-path $B$KDI2C$7$F$/$@$5$$!#=i4|@_Dj$G%$%s%9%H!<%k$7$?$J$i!"k(B -1.11.3 Saidaiji $(B@>Bg;{(B +1.11.3 Saidaiji $(B@>Bg;{(B ; = $(B6aE4(B $(BF`NI@~(B ;;------------------------------------------------------------------------- ;; Kinki Nippon Railway $(B6a5&F|K\E4F;(B http://www.kintetsu.co.jp/ ;; Ky-Dòto-A Line $(B3`86@~(B ;;------------------------------------------------------------------------- (Saidaiji) ($(B@>Bg;{(B) ------ Amagatsuji $(BFt%vDT(B ------ Nishinoky-Dò-A $(B@>$N5~(B ------ Kuj-Dò-A $(B6e>r(B ------ Kintetsu-K-Dòriyama-A $(B6aE474;3(B +1.12.0 Amagatsuji $(BFt%vDT(B +1.12.1 Nishinoky-Dò-A $(B@>$N5~(B +1.12.2 Kuj-Dò-A $(B6e>r(B +1.12.3 Kintetsu-K-Dòriyama-A $(B6aE474;3(B +1.12.4 Tsutsui $(BE{0f(B +1.12.5 Hirahata $(BJ?C<(B ; = $(B6aE4(B $(BE7M}@~(B +1.12.6 Family-K-Dòenmae-A $(B%U%!%_%j!<8x1`A0(B +------ Y-Dþzaki-A $(B7k:j(B +------ Iwami $(B@P8+(B +------ Tawaramoto $(BED86K\(B ; <=> $(B6aE4(B $(B@>ED86K\(B +------ Kasanui $(B3^K%(B +------ Ninokuchi $(B?7%N8}(B +------ Yagi $(BH,LZ(B ; = $(B6aE4(B $(BBg:e@~(B +------ Yagi-Nishiguchi $(BH,LZ@>8}(B +------ Unebigory-Dòmae-A $(B@&K58fNMA0(B +------ Kashiharajingu-mae $(B3`86?@5\A0(B ; = $(B6aE4(B $(BFnBg:e@~!"5HLn@~(B [Chao Version names] @@ -66,3 +78,11 @@ 1.11.3 Kitayama $(BKL;3(B 1.11.4 Matugasaki $(B>>%v:j(B 1.11.5 Kokusaikaikan $(B9q:]2q4[(B + +;;------------------------------------------------------------------------- +;; West Japan Railway $(B@>F|K\N95RE4F;(B http://www.westjr.co.jp/ +;; Nara Line $(BF`NI@~(B +;;------------------------------------------------------------------------- +1.12.0 [JR] Ky-Dòto-A $(B5~ET(B ; <=> $(B6aE4(B, $(B5~ET;T8rDL6I(B +1.12.1 T-Dòfukuji-A $(BElJ!;{(B ; <=> $(B5~:e(B +1.12.2 Inari $(B0p2Y(B diff --git a/eword-decode.el b/eword-decode.el index d85bce3..528a927 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -7,12 +7,13 @@ ;; TANAKA Akira ;; 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 @@ -35,6 +36,8 @@ (require 'mel) (require 'mime-def) +(eval-when-compile (require 'cl)) + (defgroup eword-decode nil "Encoded-word decoding" :group 'mime) @@ -51,20 +54,21 @@ (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 @@ -107,28 +111,54 @@ such as a version of Net$cape)." (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)) @@ -154,83 +184,26 @@ such as a version of Net$cape)." (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 ;;; @@ -267,88 +240,229 @@ such as a version of Net$cape)." ) ))) +(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) @@ -356,47 +470,43 @@ If SEPARATOR is not nil, it is used as header separator." 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 @@ -484,7 +594,7 @@ as a version of Net$cape)." "*Max position of eword-lexical-analyze-cache. It is max size of eword-lexical-analyze-cache - 1.") -(defcustom eword-lexical-analyzers +(defcustom eword-lexical-analyzer '(eword-analyze-quoted-string eword-analyze-domain-literal eword-analyze-comment @@ -493,8 +603,9 @@ It is max size of eword-lexical-analyze-cache - 1.") 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. @@ -507,102 +618,169 @@ be the result." :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) @@ -611,10 +789,21 @@ characters encoded as encoded-words or invalid \"raw\" format. (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. @@ -623,7 +812,8 @@ encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii characters are regarded as variable `default-mime-charset'." (let* ((structure (car (std11-parse-address (eword-lexical-analyze - (std11-unfold-string string) 'must-unfold)))) + (std11-unfold-string string) start + 'must-unfold)))) (phrase (std11-full-name-string structure)) (address (std11-address-string structure)) ) diff --git a/eword-encode.el b/eword-encode.el index c87d5fa..1bca5cf 100644 --- a/eword-encode.el +++ b/eword-encode.el @@ -1,6 +1,6 @@ ;;; 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 ;; Keywords: encoded-word, MIME, multilingual, header, mail, news @@ -24,7 +24,7 @@ ;;; Code: -(require 'emu) +(require 'poem) (require 'mel) (require 'std11) (require 'mime-def) @@ -83,6 +83,7 @@ If method is nil, this field will not be encoded." (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") @@ -331,23 +332,28 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is )) (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) @@ -473,9 +479,9 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (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)))) @@ -506,7 +512,7 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is '((" " nil nil) ("(" nil nil)) (eword-encode-split-string comment 'comment) - '((")" nil nil)) + (list '(")" nil nil)) ))) dest)) @@ -515,18 +521,21 @@ MODE is allows `text', `comment', `phrase' or nil. Default value is (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) @@ -574,8 +583,7 @@ Optional argument COLUMN is start-position of the field." (car (eword-encode-rword-list (or column 13) (eword-encode-in-reply-to-to-rword-list - (std11-parse-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. diff --git a/ftp.in b/ftp.in index 80b8381..0949088 100644 --- a/ftp.in +++ b/ftp.in @@ -2,12 +2,12 @@ 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; diff --git a/mel-b-ccl.el b/mel-b-ccl.el index b01650c..02fd3e3 100644 --- a/mel-b-ccl.el +++ b/mel-b-ccl.el @@ -105,6 +105,10 @@ abcdefghijklmnopqrstuvwxyz\ (logand v (lsh 255 8)) (lsh (logand v 255) 16))) +) + +(eval-when-compile + (defconst mel-ccl-decode-b-0-table (vconcat (mapcar @@ -143,96 +147,145 @@ abcdefghijklmnopqrstuvwxyz\ ) -(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 @@ -357,8 +410,7 @@ abcdefghijklmnopqrstuvwxyz\ (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) @@ -386,9 +438,7 @@ abcdefghijklmnopqrstuvwxyz\ (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) diff --git a/mel-q-ccl.el b/mel-q-ccl.el index 17b58be..dc84735 100644 --- a/mel-q-ccl.el +++ b/mel-q-ccl.el @@ -248,6 +248,10 @@ abcdefghijklmnopqrstuvwxyz\ ,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) @@ -496,7 +500,7 @@ abcdefghijklmnopqrstuvwxyz\ (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) @@ -505,7 +509,7 @@ abcdefghijklmnopqrstuvwxyz\ (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 @@ -517,7 +521,7 @@ abcdefghijklmnopqrstuvwxyz\ (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 @@ -526,7 +530,7 @@ abcdefghijklmnopqrstuvwxyz\ (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 @@ -712,7 +716,7 @@ abcdefghijklmnopqrstuvwxyz\ ((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] @@ -744,7 +748,7 @@ abcdefghijklmnopqrstuvwxyz\ ;; invalid input -> ;; output "=" with hex digit and rescan from r2. (write ?=) - (r0 = r2) + (r0 = (r2 + 0)) (write-repeat r1))) (t ;; r0:[^\t\r -~] @@ -918,8 +922,8 @@ abcdefghijklmnopqrstuvwxyz\ (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")) @@ -950,8 +954,8 @@ encoding." (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")) diff --git a/mel.el b/mel.el index ccfc072..b1902b4 100644 --- a/mel.el +++ b/mel.el @@ -96,8 +96,11 @@ Content-Transfer-Encoding for it." (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) @@ -201,8 +204,10 @@ ENCODING must be 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) diff --git a/mime-def.el b/mime-def.el index e479011..68cc8ea 100644 --- a/mime-def.el +++ b/mime-def.el @@ -1,6 +1,6 @@ ;;; 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 ;; Keywords: definition, MIME, multimedia, mail, news @@ -27,7 +27,7 @@ (require 'mcharset) (eval-and-compile - (defconst mime-library-product ["FLIM" (1 11 3) "Saidaiji"] + (defconst mime-library-product ["FLIM" (1 12 6) "Family-K.DŽòenmae"] "Product name, version number and code name of MIME-library package.") ) @@ -72,12 +72,6 @@ ;;; @ 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 "*")) @@ -93,7 +87,7 @@ (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 "\"" @@ -105,8 +99,12 @@ ;;; @ 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 @@ -446,7 +444,7 @@ If ARGS is specified, NAME is defined as a generic function for the service." `(progn (add-to-list 'mel-service-list ',name) - (defvar ,(intern (format "%s-obarray" name)) (make-vector 1 nil)) + (defvar ,(intern (format "%s-obarray" name)) (make-vector 7 0)) ,@(if args `((defun ,name ,args ,@rest diff --git a/mime-en.sgml b/mime-en.sgml index de14cb9..dd428f8 100644 --- a/mime-en.sgml +++ b/mime-en.sgml @@ -1,8 +1,8 @@ -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> @@ -11,8 +11,8 @@ <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> @@ -165,6 +165,10 @@ Return node-id of <var>entity</var>. 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> @@ -183,6 +187,15 @@ If <var>message</var> is not specified, <code>mime-message-structure</code> is used. </defun> +<defun name="mime-find-entity-from-content-id"> + <args> cid <opts> message +<p> +Return entity from <var>cid</var> in <var>message</var>. +<p> +If <var>message</var> is not specified, +<code>mime-message-structure</code> is used. +</defun> + <h2> Functions about attributes of mime-entity <node> Entity Attributes @@ -316,12 +329,28 @@ It is originally variable of APEL. 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> diff --git a/mime-en.texi b/mime-en.texi index 6da91cd..aa65897 100644 --- a/mime-en.texi +++ b/mime-en.texi @@ -1,19 +1,19 @@ \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 @@ -72,10 +72,12 @@ information of entity. In this document, it is called simply @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 @@ -103,13 +105,12 @@ mime-entity.@refill If @var{buffer} is omitted, current buffer is used.@refill @var{type} is representation-type of created -mime-entity. (cf. @ref{mm-backend}) - Default value is @var{buffer}. +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 @@ -198,6 +199,10 @@ Return entity-number of @var{entity}. @end defun + +@node Entity Search, Entity Attributes, Entity hierarchy, Entity +@section Find Entity + @defun mime-find-entity-from-number entity-number &optional message Return entity from @var{entity-number} in @var{message}.@refill @@ -216,8 +221,17 @@ used. @end defun +@defun mime-find-entity-from-content-id cid &optional message + +Return entity from @var{cid} in @var{message}.@refill + +If @var{message} is not specified, @code{mime-message-structure} is +used. +@end defun + + -@node Entity Attributes, Entity-header, Entity hierarchy, Entity +@node Entity Attributes, Entity-header, Entity Search, Entity @section Functions about attributes of mime-entity @defun mime-entity-content-type entity @@ -339,7 +353,7 @@ It is originally variable of APEL. -@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 @@ -348,12 +362,28 @@ Return content of @var{entity} as byte sequence. @end defun +@defun mime-insert-entity-content entity + +Insert content of @var{entity} at point. +@end defun + + @defun mime-write-entity-content entity filename Write content of @var{entity} into @var{filename}. @end defun + +@node Entity-network-representation, Entity buffer, Entity-content, Entity +@section Network representation of Entity + +@defun mime-insert-entity entity + +Insert header and body of @var{entity} at point. +@end defun + + @defun mime-write-entity entity filename Write representation of @var{entity} into @var{filename}. @@ -367,7 +397,7 @@ Write body 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 @@ -1537,7 +1567,7 @@ CVS $B$rMQ$$$?3+H/$K;22C$7$?$$J}$O(B @node History, , CVS, Appendix @section History of FLIM -FLIM $B$N(B code $B$N:G8E$NItJ,$O(B $B1]JB(B $B;LCR(B $B;a$,=q$$$?(B @file{mime.el}$B$K5/8;$7(B +FLIM $B$N(B code $B$N:G8E$NItJ,$O(B $B1]JB(B $B;LCR(B $B;a$,=q$$$?(B @file{mime.el} $B$K5/8;$7(B $B$^$9!#$3$N>.$5$J(B program $B$O(B Nemacs $B$GF0:n$9$k(B iso-2022-jp $B$N(B B-encoding $B@lMQ$N(B encoded-word $B$NI|9f2=%W%m%0%i%`$G$7$?!#(B@refill @@ -1581,7 +1611,7 @@ tm $B$G$O8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B @file{tiny-mime.el} $B$N:F<BA $B8e$K!"(BAPEL $B$+$i(B @file{std11.el} $B$,0\$5$l!"$^$?!"(B@file{mailcap.el}, @file{eword-decode.el} $B$*$h$S(B @file{eword-encode.el} $B$,(B SEMI $B$+$i0\$5$l!"(B -package $B$NL>A0$,(B FLIM$B$H$J$j$^$9!#(B@refill +package $B$NL>A0$,(B FLIM $B$H$J$j$^$9!#(B@refill $B$3$ND>A0$+$iEDCf(B $BE/(B $B;a$,$h$j(B RFC $B$KCi<B$J<BAu$r=q$-;O$a!"$3$l$O!"8=:_!"(B FLIM $B$N;^$G$"$k(B ``FLIM-FLAM'' $B$H$J$C$F$$$^$9!#(B diff --git a/mime-ja.sgml b/mime-ja.sgml index fe6794b..e358ca0 100644 --- a/mime-ja.sgml +++ b/mime-ja.sgml @@ -1,8 +1,8 @@ <!doctype sinfo system> <head> -<title>FLIM 1.10 MIME $B5!G=@bL@=q(B +<title>FLIM 1.12 MIME $B5!G=@bL@=q(B <author>$B<i2,(B $BCNI'(B <mail>morioka@jaist.ac.jp</mail> -<date>1998/07/01 +<date>1999-01-27 <toc> </head> @@ -11,11 +11,11 @@ <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 $BMQ$N(B Internet Message $B$N2r@O$dId9f2=$K4X$9$k(B library $B$G$"$k(B -FLIM $B$N(B MIME $B5!G=$K4X$7$F@bL@$7$^$9!#(B +GNU Emacsen $BMQ$N(B Internet Message $B=hM}$N$?$a$N4pAC(B library $B$G$"$k(B FLIM +$B$N(B MIME $B5!G=$K4X$7$F@bL@$7$^$9!#(B </abstract> @@ -60,12 +60,12 @@ FLIM $B$O(B entity $B$N>pJs$rI=8=$9$k$?$a$K(B<concept>mime-entity</concept> <defun name="mime-open-entity"> <opts> type location <p> -Open an entity and return it. +Entity $B$r3+$$$F!"$=$l$rJV$7$^$9!#(B <p> -<var>type</var> is representation-type. <cf node="mm-backend"> +<var>type</var> $B$O(B representation-type $B$G$9!#(B <cf node="mm-backend"> <p> -<var>location</var> is location of entity. Specification of it is -depended on representation-type. +<var>location</var> $B$O(B entity $B$N0LCV$G$9!#;XDjJ}K!$O(B +representation-type $B$K0M$C$FJQ$o$j$^$9!#(B </defun> <defun name="mime-parse-buffer"> @@ -169,22 +169,36 @@ buffer local $BJQ?t!#(B <var>entity</var> $B$N(B entity-number $B$rJV$9!#(B </defun> + +<h2> Entity $B$N8!:w(B +<node> Entity Search +<p> <defun name="mime-find-entity-from-number"> <args> entity-number <opts> message <p> -Return entity from <var>entity-number</var> in <var>message</var>. +<var>message</var> $B$+$i!"(B<var>enity-number</var> $B$N(B entity $B$rJV$7$^$9!#(B <p> -If <var>message</var> is not specified, -<code>mime-message-structure</code> is used. +<var>message</var> $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B +<code>mime-message-structrue</code> $B$,;H$o$l$^$9!#(B </defun> <defun name="mime-find-entity-from-node-id"> <args> entity-node-id <opts> message <p> -Return entity from <var>entity-node-id</var> in <var>message</var>. +<var>message</var> $B$+$i!"(B<var>entity-node-id</var> $B$N(B entity $B$rJV$7$^(B +$B$9!#(B <p> -If <var>message</var> is not specified, -<code>mime-message-structure</code> is used. +<var>message</var> $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B +<code>mime-message-structure</code> $B$,;H$o$l$^$9!#(B +</defun> + +<defun name="mime-find-entity-from-content-id"> + <args> cid <opts> message +<p> +<var>message</var> $B$+$i!"(B<var>cid</var> $B$N(B entity $B$rJV$7$^$9!#(B +<p> +<var>message</var> $B$,;XDj$5$l$F$$$J$$>l9g$O!"(B +<code>mime-message-structure</code> $B$,;H$o$l$^$9!#(B </defun> @@ -225,8 +239,8 @@ node="Content-Transfer-Encoding"> <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> $B$NFbMF$,4{$K%3!<%IJQ49$5$l$F$$$k>l9g$O(B nil $B$GL5$$CM(B +$B$rJV$9!#(B </defun> @@ -287,12 +301,11 @@ list $B$G!"$=$l$>$l!"I=<($7$?$/$J$$(B field $BL>$HI=<($7$?$$MsL>$rI=8=$7$?$b$ <defun name="mime-insert-text-content"> <args> entity <p> -Insert before point a contents of <var>entity</var> as text entity. +point $B$NA0$K(B <var>entity</var> $B$r(B text entity $B$H$7$FA^F~$7$^$9!#(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> $B$NFbMF$O(B <dref>MIMe charset</dref> $B$H$7$FI|9f2=$5$l(B +$B$^$9!#(B<var>entity</var> $B$N(B Content-Type field $B$K(B charset paramter $B$,L5(B +$B$$$H!"(B<code>default-mime-charset</code> $B$,=i4|CM$H$7$F;H$o$l$^$9!#(B </defun> <defvar name="default-mime-charset"> @@ -313,22 +326,38 @@ MIME charset. <var>entity</var> $B$NFbMF$N(B byte $BNs$rJV$9!#(B </defun> +<defun name="mime-insert-entity-content"> + <args> entity +<p> +pointo $B$N0LCV$K(B <var>entity</var> $B$NFbMF$rA^F~$7$^$9!#(B +</defun> + <defun name="mime-write-entity-content"> <args> entity filename <p> -Write content of <var>entity</var> into <var>filename</var>. +<var>entity</var> $B$NFbMF$r(B <var>filename</var> $B$K=q$-9~$_$^$9!#(B +</defun> + + +<h2> Entity $B$N%M%C%H%o!<%/I=8=(B +<node> Entity-network-representation +<p> +<defun name="mime-insert-entity"> + <args> entity +<p> +<var>entity</var> $B$N(B header $B$H(B body $B$r(B point $B$N$H$3$m$KA^F~$7$^$9!#(B </defun> <defun name="mime-write-entity"> <args> entity filename <p> -Write representation of <var>entity</var> into <var>filename</var>. +<var>entity</var> $B$NI=8=$r(B <var>filename</var> $B$K=q$-9~$_$^$9!#(B </defun> <defun name="mime-write-entity-body"> <args> entity filename <p> -Write body of <var>entity</var> into <var>filename</var>. +<var>entity</var> $B$N(B body $B$r(B <var>filename</var> $B$K=q$-9~$_$^$9!#(B </defun> @@ -427,12 +456,13 @@ representation-type $B$NL>A0$N@hF,$K(B <code>mm</code> $B$rIU$1$?$b$N$K$J$C$F <args> type <opts> parents <p> -Define <var>type</var> as a mm-backend. +<var>type</var> $B$r(B mm-backend $B$H$7$FDj5A$7$^$9!#(B <p> -If <var>PARENTS</var> is specified, <var>type</var> inherits parents. -Each parent must be representation-type. +<var>PARENTS</var> $B$,;XDj$5$l$F$$$k>l9g$O!"(B<var>type</var> $B$O(B prents +$B$r7Q>5$7$^$9!#$=$l$>$l$N(B parent $B$O(B representation-type $B$G$"$kI,MW$,$"(B +$B$j$^$9!#(B <p> -Example: +$BNc(B: <p> <lisp> (mm-define-backend chao (generic)) @@ -442,15 +472,15 @@ Example: <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> $B$r(B (nth 1 (car <var>args</var>)) backend $B$N(B method $B4X(B +$B?t$H$7$FDj5A$7$^$9!#(B <p> -<var>args</var> 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> $B$O(B lambda $B$N0z?t%j%9%H$N$h$&$J$b$N$G$9$,!"(B(car +<var>args</var>) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car +(car <var>args</var>)) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car <var>args</var>)) +$B$O(B backend $B$NL>A0(B (representation-type) $B$G$9!#(B <p> -Example: +$BNc(B: <p> <lisp> (mm-define-method entity-cooked-p ((entity chao)) nil) @@ -695,15 +725,15 @@ Content-Transfer-Encoding $BMs$,B8:_$7$J$$>l9g$O(B <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>. +$B8=:_$N(B buffer $B$N(B <var>start</var> $B$+$i(B <var>end</var> $B$^$G$N(B region $B$r(B +<var>encoding</var> $B$r;H$C$FId9f2=$7$^$9!#(B </defun> <defun name="mime-decode-region"> <args> start end encoding <p> -Decode region <var>start</var> to <var>end</var> of current buffer -using <var>encoding</var>. +$B8=:_$N(B buffer $B$N(B <var>start</var> $B$+$i(B <var>end</var> $B$^$G$N(B region $B$r(B +<var>encoding</var> $B$r;H$C$FI|9f2=$7$^$9!#(B </defun> @@ -717,56 +747,57 @@ using <var>encoding</var>. <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 $B$GId9f2=$5$l$?(B file <var>FILENAME</var> $B$r(B +$BA^F~$9$k!#(B </defun> <defun name="mime-write-decoded-region"> <args> start end filename encoding <p> -Decode and write current region encoded by <var>encoding</var> into -<var>filename</var>. +<var>encoding</var> $B$GId9f2=$5$l$?8=:_$N(B region $B$rI|9f2=$7$F(B +<var>filename</var>$B$K=q$-9~$_$^$9!#(B <p> -<var>start</var> and <var>end</var> are buffer positions. +<var>start<var> $B$H(B <var>end</var> $B$O(B buffer $B$N0LCV$G$9!#(B </defun> -<h2> Other utilities +<h2> $BB>$N(B utility <node> Encoding information <p> <defun name="mime-encoding-list"> <opts> SERVICE <p> -Return list of Content-Transfer-Encoding. +Content-Transfer-Encoding $B$N(B list $B$rJV$7$^$9!#(B <p> -If <var>service</var> is specified, it returns available list of -Content-Transfer-Encoding for it. +<var>service</var> $B$,;XDj$5$l$F$$$k$H!"$=$l$KBP$9$k(B +Content-Transfer-Encoding $B$rJV$7$^$9!#(B </defun> <defun name="mime-encoding-alist"> <opts> SERVICE <p> -Return table of Content-Transfer-Encoding for completion. +$BJd40$N$?$a$N(B Content-Transfer-Encoding $B$NI=$rJV$7$^$9!#(B <p> -If <var>service</var> is specified, it returns available list of -Content-Transfer-Encoding for it. +<var>service</var> $B$,;XDj$5$l$F$$$k>l9g$O$=$l$KBP$9$k(B +Content-Transfer-Encoding $B$N(B list $B$rJV$7$^$9!#(B </defun> -<h2> How to write encoder/decoder module +<h2> $BId9f2=(B/$BI|9f2=(B module $B$N=q$-J}(B <node> mel-backend <p> <defmacro name="mel-define-method"> <args> name args <rest> body <p> -Define <var>name</var> as a method function of (nth 1 (car (last -<var>args</var>))) backend. +<var>name</var> $B$r(B (nth 1 (car (last <var>args</var>))) backend $B$N(B +method $B4X?t$H$7$FDj5A$7$^$9!#(B <p> -<var>args</var> 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> $B$O(B lambda $B$N0z?t(B list $B$H;w$F$$$^$9$,!"(B(car (last +<var>args</var>)) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car +(car (last <var>args</var>))) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car (last +<var>args</var>))) $B$O(B backend $B$NL>A0(B (encoding) $B$G$9!#(B <p> -Example: +$BNc(B: <p> <lisp> (mel-define-method mime-write-decoded-region (start end filename @@ -787,16 +818,16 @@ START and END are buffer positions." <defmacro name="mel-define-method-function"> <args> spec function <p> -Set <var>spec</var>'s function definition to <var>function</var>. +<var>spec</var> $B$N4X?tDj5A$r(B <var>function</var> $B$K@_Dj$7$^$9!#(B <p> -First element of <var>spec</var> is service. +<var>spec</var> $B$N:G=i$NMWAG$O(B service $B$G$9!#(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> $B$N;D$j$O(B lambda $B$N0z?t(B list $B;w$F$$$^$9$,!"(B(car (last +<var>args</var>)) $B$O;XDj$5$l$?(B parameter $B$G$"$kI,MW$,$"$j$^$9!#(B(car +(car (last <var>args</var>))) $B$OJQ?t$NL>A0$G!"(B(nth 1 (car (last +<var>args</var>))) $B$O(B backend $B$NL>A0(B (encoding) $B$G$9!#(B <p> -Example: +$BNc(B: <p> <lisp> (mel-define-method-function (mime-encode-string string (nil "base64")) @@ -805,19 +836,20 @@ Example: </defmacro> -<h2> How to add encoding/decoding service +<h2> $BId9f2=(B/$BI|9f2=(B service $B$rDI2C$9$kJ}K!(B <node> generic function for mel-backend <p> <defmacro name="mel-define-service"> <args> name <opts> args doc-string <p> -Define <var>name</var> as a service for Content-Transfer-Encodings. +<var>name</var> $B$r(B Content-Transfer-Encoding $B$N(B service $B$H$7$FDj5A$7$^(B +$B$9!#(B <p> -If <var>args</var> is specified, <var>name</var> is defined as a -generic function for the service. +<var>args</var> $B$,;XDj$5$l$F$$$k$H!"(B<var>name</var> $B$O(B service $B$N(B +generic function $B$H$7$FDj5A$5$l$^$9!#(B <p> -Example: +$BNc(B: <p> <lisp> (mel-define-service encoded-text-encode-string (string encoding) @@ -874,20 +906,19 @@ Header $B$r(B network $BI=8=$KId9f2=$9$k!#(B <defvar name="eword-field-encoding-method-alist"> <p> -Association list to specify field encoding method. Each element looks -like (FIELD . METHOD). +Field $B$rId9f2=$9$kJ}K!$r;XDj$9$kO"A[(B list$B!#3F(B element $B$O(B (FIELD +. METHOD) $B$NMM$K$J$C$F$$$k!#(B <p> -If METHOD is <code>mime</code>, the FIELD will be encoded into MIME -format (encoded-word). +METHOD $B$,(B <code>mime</code> $B$G$"$l$P!"(BFIELD $B$O(B MIME format $B$KId9f2=$5(B +$B$l$k(B (encoded-word)$B!#(B <p> -If METHOD is <code>nil</code>, the FIELD will not be encoded. +METHOD $B$,(B <code>nil</code> $B$G$"$l$P!"(BFIELD $B$OId9f2=$5$l$J$$!#(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 $B$,(B MIME charset $B$G$"$l$P!"(BFIELD $B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J(B +$B$1$l$P$J$i$J$$$H$-$K(B charset $B$KId9f2=$5$l$k!#(B <p> -Otherwise the FIELD will be encoded as variable -<code>default-mime-charset</code> when it must be convert into -network-code. +$B$=$&$G$J$1$l$P!"(BFIELD $B$O%M%C%H%o!<%/%3!<%I$KJQ49$7$J$1$l$P$J$i$J$$$H$-(B +$B$K(B $BJQ?t(B <code>default-mime-charset</code> $B$GId9f2=$5$l$k(B </defvar> diff --git a/mime-ja.texi b/mime-ja.texi index 171e5ad..7cd0e10 100644 --- a/mime-ja.texi +++ b/mime-ja.texi @@ -1,22 +1,22 @@ \input texinfo.tex @c Generated automatically from mime-ja.sgml by sinfo 3.7. @setfilename mime-ja.info -@settitle{FLIM 1.10 MIME $B5!G=@bL@=q(B} +@settitle{FLIM 1.12 MIME $B5!G=@bL@=q(B} @titlepage -@title FLIM 1.10 MIME $B5!G=@bL@=q(B +@title FLIM 1.12 MIME $B5!G=@bL@=q(B @author $B<i2,(B $BCNI'(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 $B5!G=@bL@=q(B +@top FLIM 1.12 MIME $B5!G=@bL@=q(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 $BMQ$N(B Internet Message $B$N2r@O$dId9f2=$K4X$9$k(B library $B$G$"$k(B -FLIM $B$N(B MIME $B5!G=$K4X$7$F@bL@$7$^$9!#(B +GNU Emacsen $BMQ$N(B Internet Message $B=hM}$N$?$a$N4pAC(B library $B$G$"$k(B FLIM +$B$N(B MIME $B5!G=$K4X$7$F@bL@$7$^$9!#(B @end ifinfo @menu @@ -75,10 +75,12 @@ FLIM $B$O(B entity $B$N>pJs$rI=8=$9$k$?$a$K(B@strong{mime-entity} $B9=(B @menu * Entity creation:: Entity $B$N@8@.(B * Entity hierarchy:: Entity $B3,AX(B +* Entity Search:: Entity $B$N8!:w(B * Entity Attributes:: Entity $B$NB0@-(B * Entity-header:: Entity header $B$N>pJs(B * entity formatting:: Entity $B$NJ8;zI=8=(B * Entity-content:: Entity $B$NFbMF(B +* Entity-network-representation:: Entity $B$N%M%C%H%o!<%/I=8=(B * Entity buffer:: Entity $B$N(B buffer $B$K$h$kI=8=(B * mm-backend:: Entity $B$NI=8=$H<B8=(B @end menu @@ -110,7 +112,7 @@ on representation-type. -@node Entity hierarchy, Entity Attributes, Entity creation, Entity +@node Entity hierarchy, Entity Search, Entity creation, Entity @section Entity $B3,AX(B @cindex node-id @cindex entity-number @@ -201,6 +203,10 @@ local $BJQ?t!#(B @end defun + +@node Entity Search, Entity Attributes, Entity hierarchy, Entity +@section Entity $B$N8!:w(B + @defun mime-find-entity-from-number entity-number &optional message Return entity from @var{entity-number} in @var{message}.@refill @@ -219,8 +225,17 @@ used. @end defun +@defun mime-find-entity-from-content-id cid &optional message + +Return entity from @var{cid} in @var{message}.@refill + +If @var{message} is not specified, @code{mime-message-structure} is +used. +@end defun + + -@node Entity Attributes, Entity-header, Entity hierarchy, Entity +@node Entity Attributes, Entity-header, Entity Search, Entity @section Entity $B$NB0@-(B @defun mime-entity-content-type entity @@ -335,7 +350,7 @@ value. -@node Entity-content, Entity buffer, entity formatting, Entity +@node Entity-content, Entity-network-representation, entity formatting, Entity @section Entity $B$NFbMF(B @defun mime-entity-content entity @@ -344,12 +359,28 @@ value. @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 $B$N%M%C%H%o!<%/I=8=(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}. @@ -363,7 +394,7 @@ Write body 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 $B$N(B buffer $B$K$h$kI=8=(B @defun mime-entity-buffer entity @@ -1450,7 +1481,7 @@ Standards Track (obsolete RFC 1521, 1522, 1590). ASCII (@ref{ASCII}) $B$N$_$+$i$J$j(B ISO 2022 $B$K$h$kId9f3HD%$O5v$5$l$J$$!#(B -Internet message $B$K$*$1$kI8=`$NId9f2=J8;z=89g(B(@ref{Coded character set}) +Internet message $B$K$*$1$kI8=`$NId9f2=J8;z=89g(B(@ref{Coded character set}) $B$G$"$j!"L@<(E*$K(B MIME charset $B$,<($5$l$J$$>l9g$O86B'$H$7$F(B @strong{us-ascii} $B$,;H$o$l$k!#(B@refill @@ -1534,7 +1565,7 @@ CVS $B$rMQ$$$?3+H/$K;22C$7$?$$J}$O(B @node History, , CVS, Appendix @section $BNr;K(B -FLIM $B$N(B code $B$N:G8E$NItJ,$O(B $B1]JB(B $B;LCR(B $B;a$,=q$$$?(B @file{mime.el}$B$K5/8;$7(B +FLIM $B$N(B code $B$N:G8E$NItJ,$O(B $B1]JB(B $B;LCR(B $B;a$,=q$$$?(B @file{mime.el} $B$K5/8;$7(B $B$^$9!#$3$N>.$5$J(B program $B$O(B Nemacs $B$GF0:n$9$k(B iso-2022-jp $B$N(B B-encoding $B@lMQ$N(B encoded-word $B$NI|9f2=%W%m%0%i%`$G$7$?!#(B@refill @@ -1578,7 +1609,7 @@ tm $B$G$O8e$K!"<i2,(B $BCNI'(B $B$K$h$C$F(B @file{tiny-mime.el} $B$N:F<BA $B8e$K!"(BAPEL $B$+$i(B @file{std11.el} $B$,0\$5$l!"$^$?!"(B@file{mailcap.el}, @file{eword-decode.el} $B$*$h$S(B @file{eword-encode.el} $B$,(B SEMI $B$+$i0\$5$l!"(B -package $B$NL>A0$,(B FLIM$B$H$J$j$^$9!#(B@refill +package $B$NL>A0$,(B FLIM $B$H$J$j$^$9!#(B@refill $B$3$ND>A0$+$iEDCf(B $BE/(B $B;a$,$h$j(B RFC $B$KCi<B$J<BAu$r=q$-;O$a!"$3$l$O!"8=:_!"(B FLIM $B$N;^$G$"$k(B ``FLIM-FLAM'' $B$H$J$C$F$$$^$9!#(B diff --git a/mime-parse.el b/mime-parse.el index 8951509..003b800 100644 --- a/mime-parse.el +++ b/mime-parse.el @@ -1,6 +1,6 @@ ;;; 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 @@ -24,13 +24,50 @@ ;;; 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 ;;; @@ -96,13 +133,16 @@ and return parsed it. Format of return value is as same as ;;; @ 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) @@ -131,10 +171,16 @@ and return parsed it." ;;;###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) @@ -147,6 +193,24 @@ If is is not found, return 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 ;;; diff --git a/mime.el b/mime.el index 293b3e7..ce23631 100644 --- a/mime.el +++ b/mime.el @@ -1,6 +1,6 @@ ;;; 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 @@ -29,12 +29,11 @@ (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" @@ -53,9 +52,16 @@ and return parsed it.") "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 ;;; @@ -139,6 +145,21 @@ If MESSAGE is not specified, `mime-message-structure' is used." 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." @@ -244,6 +265,35 @@ 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)))) @@ -262,29 +312,18 @@ If MESSAGE is specified, it is regarded as root entity." (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))))))) @@ -340,12 +379,18 @@ If MESSAGE is specified, it is regarded as root entity." (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.") diff --git a/mmbuffer.el b/mmbuffer.el index 93b2ff3..38432fb 100644 --- a/mmbuffer.el +++ b/mmbuffer.el @@ -1,6 +1,6 @@ ;;; 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 @@ -86,6 +86,13 @@ (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)) @@ -95,6 +102,12 @@ (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)) diff --git a/mmgeneric.el b/mmgeneric.el index 6d67b99..df11185 100644 --- a/mmgeneric.el +++ b/mmgeneric.el @@ -1,6 +1,6 @@ ;;; 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 @@ -100,6 +100,13 @@ (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)) @@ -109,6 +116,12 @@ (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)) @@ -148,6 +161,8 @@ &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) @@ -164,19 +179,15 @@ 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") ))))))) diff --git a/smtp.el b/smtp.el new file mode 100644 index 0000000..c2c9937 --- /dev/null +++ b/smtp.el @@ -0,0 +1,393 @@ +;;; 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 diff --git a/smtpmail.el b/smtpmail.el new file mode 100644 index 0000000..807b4a7 --- /dev/null +++ b/smtpmail.el @@ -0,0 +1,305 @@ +;;; 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 diff --git a/std11.el b/std11.el index 616d3ad..a083236 100644 --- a/std11.el +++ b/std11.el @@ -1,11 +1,11 @@ ;;; 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 @@ -24,11 +24,13 @@ ;;; 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;-~]+") @@ -37,18 +39,20 @@ (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 @@ -58,19 +62,33 @@ The buffer is expected to be narrowed to just the headers of the message." (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) @@ -90,7 +108,7 @@ used as message header separator. [std11.el]" (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) @@ -111,46 +129,9 @@ header separator. [std11.el]" ) 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 @@ -168,8 +149,7 @@ If BOUNDARY is not nil, it is used as message header separator. (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 @@ -187,8 +167,7 @@ If BOUNDARY is not nil, it is used as message header separator. (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) @@ -204,6 +183,26 @@ If BOUNDARY is not nil, it is used as message header separator. 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 ;;; @@ -227,13 +226,13 @@ If BOUNDARY is not nil, it is used as message header separator. (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) @@ -251,7 +250,7 @@ If BOUNDARY is not nil, it is used as message header separator. )) (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))) @@ -265,48 +264,77 @@ If BOUNDARY is not nil, it is used as message header separator. ;;; @ 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) @@ -320,7 +348,7 @@ If BOUNDARY is not nil, it is used as message header separator. ((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) @@ -330,41 +358,51 @@ If BOUNDARY is not nil, it is used as message header separator. )) )))))) -(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) )) @@ -685,8 +723,8 @@ If BOUNDARY is not nil, it is used as message header separator. (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 @@ -700,13 +738,16 @@ If BOUNDARY is not nil, it is used as message header separator. (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))) @@ -720,9 +761,9 @@ represents addr-spec of RFC 822. [std11.el]" 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)) @@ -737,9 +778,27 @@ represents addr-spec of RFC 822. [std11.el]" ) ))))) +(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) @@ -761,10 +820,10 @@ represents addr-spec of RFC 822. [std11.el]" (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) @@ -772,15 +831,17 @@ represents addr-spec of RFC 822. [std11.el]" (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 @@ -822,20 +883,35 @@ represents addr-spec of RFC 822. [std11.el]" ;;; @ 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)) -- 1.7.10.4