From 3c07ee018fb2fa3178e4eef483aee0326a2a52a6 Mon Sep 17 00:00:00 2001 From: akr Date: Thu, 18 Feb 1999 18:13:27 +0000 Subject: [PATCH] * Sync up to flim-1_12_5 from flim-1_12_1. * mime-def.el (mime-library-product): Bump up to FLAM-DOODLE 1.12.2. --- ChangeLog | 287 +++++++++++++++++- DOODLE-VERSION | 2 +- Makefile | 4 +- NEWS | 74 ++++- README.en | 26 +- README.ja | 94 +++--- VERSION | 23 +- eword-decode.el | 877 +++++++++++++++++++++++++------------------------------ eword-encode.el | 5 +- mel-b-ccl.el | 7 +- mel-q-ccl.el | 8 +- mime-def.el | 11 +- mime-en.sgml | 37 ++- mime-en.texi | 58 +++- mime-ja.sgml | 41 ++- mime-ja.texi | 61 +++- mime-parse.el | 80 ++++- mime.el | 90 ++++-- mmbuffer.el | 15 +- mmgeneric.el | 15 +- smtp.el | 14 +- std11.el | 301 +++++++++++-------- 22 files changed, 1371 insertions(+), 759 deletions(-) diff --git a/ChangeLog b/ChangeLog index e89fda4..7a6485a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,12 @@ 1999-02-18 Tanaka Akira + * Sync up to flim-1_12_5 from flim-1_12_1. + + * mime-def.el (mime-library-product): Bump up to FLAM-DOODLE + 1.12.2. + +1999-02-18 Tanaka Akira + * mel-b-ccl.el (mel-ccl-encode-base64-generic): Shift timing for linebreak. @@ -45,7 +52,7 @@ * Sync up to flim-1_12_1 from flim-1_11_3. * mime-def.el (mime-library-product): Bump up to FLAM-DOODLE - 1.12.0. + 1.12.1. 1999-01-04 Tanaka Akira @@ -1317,6 +1324,283 @@ * eword-decode.el: Copied from AKEMI branch of SEMI. +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. @@ -3178,3 +3462,4 @@ eword-encode.el: Copied from MEL, SEMI (mime-def.el eword-decode.el eword-encode.el) and APEL (std11-parse.el std11.el). +> diff --git a/DOODLE-VERSION b/DOODLE-VERSION index a9b2977..48ca6ba 100644 --- a/DOODLE-VERSION +++ b/DOODLE-VERSION @@ -27,7 +27,7 @@ Order is not significant. 21 $B??GCc(B $B$3$2$A$c(B 10R3.0/2.0 26 $B7*Hi(B $B$/$j$+$O(B 10R3.0/4.0 27 $BFP(B $B$H$S(B 10R4.0/7.0 diff --git a/Makefile b/Makefile index fa488ba..84d75f6 100644 --- a/Makefile +++ b/Makefile @@ -4,7 +4,7 @@ PACKAGE = flim API = 1.12 -RELEASE = 1 +RELEASE = 5 TAR = tar RM = /bin/rm -f @@ -27,7 +27,7 @@ FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog VERSION = $(API).$(RELEASE) ARC_DIR = /pub/GNU/elisp/flim/$(PACKAGE)-$(API) -SEMI_ARC_DIR = /pub/GNU/elisp/semi/semi-1.12-for-flim-$(API) +SEMI_ARC_DIR = /pub/GNU/elisp/semi/semi-1.13-for-flim-$(API) elc: ew-parse.el $(EMACS) $(FLAGS) -l FLIM-MK -f compile-flim $(PREFIX) $(LISPDIR) \ diff --git a/NEWS b/NEWS index 09922a3..79e5e60 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,5 @@ 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 @@ -35,6 +35,78 @@ 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 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 + (Saidaiji) ($(B@>Bg;{(B) ; $(B!{J?>k5\@W!"@>Bg;{(B +1.12.0 Amagatsuji $(BFt%vDT(B ; $(B!{?b?NE79DNM(B +1.12.1 Nishinoky-Dò-A $(B@>$N5~(B ; $(B!{Eb>7Ds;{!"Lt;U;{(B +1.12.2 Kuj-Dò-A $(B6e>r(B +1.12.3 Kintetsu-K-Dòriyama-A $(B6aE474;3(B ; $(B!{74;3>k@W!"(B + ; $(B%"%Z%k!"%]!>%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 ae6992d..a1be3bc 100644 --- a/eword-decode.el +++ b/eword-decode.el @@ -4,16 +4,16 @@ ;; Author: ENAMI Tsugutomo ;; MORIOKA Tomohiko -;; Tanaka Akira -;; Maintainer: Tanaka Akira +;; 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 FLAM (Faithful Library About MIME). +;; This file is part of FLIM (Faithful Library about Internet Message). ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as @@ -36,42 +36,12 @@ (require 'mel) (require 'mime-def) -(require 'ew-dec) -(require 'ew-line) - (eval-when-compile (require 'cl)) (defgroup eword-decode nil "Encoded-word decoding" :group 'mime) -;;; TEST - -(defvar rotate-memo nil) -(defmacro rotate-memo (var val) - `(when rotate-memo - (unless (boundp ',var) (setq ,var ())) - (setq ,var (cons ,val ,var)) - (let ((tmp (last ,var (- (length ,var) 100)))) - (when tmp (setcdr tmp nil))) - ,var)) - -;;; @ variables -;;; - -(defcustom eword-decode-sticked-encoded-word nil - "*If non-nil, decode encoded-words sticked on atoms, -other encoded-words, etc. -however this behaviour violates RFC2047." - :group 'eword-decode - :type 'boolean) - -(defcustom eword-decode-quoted-encoded-word nil - "*If non-nil, decode encoded-words in quoted-string -however this behaviour violates RFC2047." - :group 'eword-decode - :type 'boolean) - (defcustom eword-max-size-to-decode 1000 "*Max size to decode header field." :group 'eword-decode @@ -82,229 +52,29 @@ however this behaviour violates RFC2047." ;;; @ MIME encoded-word definition ;;; -(defconst eword-encoded-word-prefix-regexp - (concat (regexp-quote "=?") - "\\(" mime-charset-regexp "\\)" - (regexp-quote "?") - "\\(B\\|Q\\)" - (regexp-quote "?"))) -(defconst eword-encoded-word-suffix-regexp - (regexp-quote "?=")) - -(defconst eword-encoded-text-in-unstructured-regexp "[!->@-~]+") -(defconst eword-encoded-word-in-unstructured-regexp - (concat eword-encoded-word-prefix-regexp - "\\(" eword-encoded-text-in-unstructured-regexp "\\)" - eword-encoded-word-suffix-regexp)) -(defconst eword-after-encoded-word-in-unstructured-regexp "\\([ \t]\\|$\\)") - -(defconst eword-encoded-text-in-phrase-regexp "[-A-Za-z0-9!*+/=_]+") -(defconst eword-encoded-word-in-phrase-regexp - (concat eword-encoded-word-prefix-regexp - "\\(" eword-encoded-text-in-phrase-regexp "\\)" - eword-encoded-word-suffix-regexp)) -(defconst eword-after-encoded-word-in-phrase-regexp "\\([ \t]\\|$\\)") - -(defconst eword-encoded-text-in-comment-regexp "[]!-'*->@-[^-~]+") -(defconst eword-encoded-word-in-comment-regexp - (concat eword-encoded-word-prefix-regexp - "\\(" eword-encoded-text-in-comment-regexp "\\)" - eword-encoded-word-suffix-regexp)) -(defconst eword-after-encoded-word-in-comment-regexp "\\([ \t()\\\\]\\|$\\)") - -(defconst eword-encoded-text-in-quoted-string-regexp "[]!#->@-[^-~]+") -(defconst eword-encoded-word-in-quoted-string-regexp - (concat eword-encoded-word-prefix-regexp - "\\(" eword-encoded-text-in-quoted-string-regexp "\\)" - eword-encoded-word-suffix-regexp)) -(defconst eword-after-encoded-word-in-quoted-string-regexp "\\([ \t\"\\\\]\\|$\\)") - -; obsolete -(defconst eword-encoded-text-regexp eword-encoded-text-in-unstructured-regexp) -(defconst eword-encoded-word-regexp eword-encoded-word-in-unstructured-regexp) - - -;;; @ internal utilities -;;; - -(defun eword-decode-first-encoded-words (string - eword-regexp - after-regexp - &optional must-unfold) - "Decode MIME encoded-words in beginning of STRING. - -EWORD-REGEXP is the regexp that matches a encoded-word. -Usual value is -eword-encoded-word-in-unstructured-regexp, -eword-encoded-text-in-phrase-regexp, -eword-encoded-word-in-comment-regexp or -eword-encoded-word-in-quoted-string-regexp. - -AFTER-REGEXP is the regexp that matches a after encoded-word. -Usual value is -eword-after-encoded-word-in-unstructured-regexp, -eword-after-encoded-text-in-phrase-regexp, -eword-after-encoded-word-in-comment-regexp or -eword-after-encoded-word-in-quoted-string-regexp. - -If beginning of STRING matches EWORD-REGEXP with AFTER-REGEXP, -returns a cons cell of decoded string(sequence of characters) and -the rest(sequence of octets). - -If beginning of STRING does not matches EWORD-REGEXP and AFTER-REGEXP, -returns nil. - -If an encoded-word is broken or your emacs implementation can not -decode the charset included in it, it is returned in decoded part -as encoded-word form. - -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 eword-decode-sticked-encoded-word (setq after-regexp "")) - (let* ((between-ewords-regexp - (if eword-decode-sticked-encoded-word - "\\(\n?[ \t]\\)*" - "\\(\n?[ \t]\\)+")) - (between-ewords-eword-after-regexp - (concat "\\`\\(" between-ewords-regexp "\\)" - "\\(" eword-regexp "\\)" - after-regexp)) - (eword-after-regexp - (concat "\\`\\(" eword-regexp "\\)" after-regexp)) - (src string) ; sequence of octets. - (dst "")) ; sequence of characters. - (if (string-match eword-after-regexp src) - (let* (p - (q (match-end 1)) - (ew (substring src 0 q)) - (dw (eword-decode-encoded-word ew must-unfold))) - (setq dst (concat dst dw) - src (substring src q)) - (if (not (string= ew dw)) - (progn - (while - (and - (string-match between-ewords-eword-after-regexp src) - (progn - (setq p (match-end 1) - q (match-end 3) - ew (substring src p q) - dw (eword-decode-encoded-word ew must-unfold)) - (if (string= ew dw) - (progn - (setq dst (concat dst (substring src 0 q)) - src (substring src q)) - nil) - t))) - (setq dst (concat dst dw) - src (substring src q))))) - (cons dst src)) - nil))) - -(defun eword-decode-entire-string (string - eword-regexp - after-regexp - safe-regexp - escape ; ?\\ or nil. - delimiters ; list of chars. - chars-must-be-quote - must-unfold - code-conversion) - (if (and code-conversion - (not (mime-charset-to-coding-system code-conversion))) - (setq code-conversion default-mime-charset)) - (let ((equal-safe-regexp (concat "\\`=?" safe-regexp)) - (dst "") - (buf "") - (src string) - (ew-enable t)) - (while (< 0 (length src)) - (let ((ch (aref src 0)) - (decoded (and - ew-enable - (eword-decode-first-encoded-words src - eword-regexp after-regexp must-unfold)))) - (if (and (not (string= buf "")) - (or decoded (memq ch delimiters))) - (setq dst (concat dst - (std11-wrap-as-quoted-pairs - (decode-mime-charset-string buf code-conversion) - chars-must-be-quote)) - buf "")) - (cond - (decoded - (setq dst (concat dst - (std11-wrap-as-quoted-pairs - (car decoded) - chars-must-be-quote)) - src (cdr decoded))) - ((memq ch delimiters) - (setq dst (concat dst (list ch)) - src (substring src 1) - ew-enable t)) - ((eq ch escape) - (setq buf (concat buf (list (aref src 1))) - src (substring src 2) - ew-enable t)) - ((string-match "\\`[ \t\n]+" src) - (setq buf (concat buf (substring src 0 (match-end 0))) - src (substring src (match-end 0)) - ew-enable t)) - ((and (string-match equal-safe-regexp src) - (< 0 (match-end 0))) - (setq buf (concat buf (substring src 0 (match-end 0))) - src (substring src (match-end 0)) - ew-enable eword-decode-sticked-encoded-word)) - (t (error "something wrong"))))) - (if (not (string= buf "")) - (setq dst (concat dst - (std11-wrap-as-quoted-pairs - (decode-mime-charset-string buf code-conversion) - chars-must-be-quote)))) - dst)) +(eval-and-compile + (defconst eword-encoded-text-regexp "[!->@-~]+") + + (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 ;;; -(defun eword-decode-unstructured (string code-conversion &optional must-unfold) - (eword-decode-entire-string - string - eword-encoded-word-in-unstructured-regexp - eword-after-encoded-word-in-unstructured-regexp - "[^ \t\n=]*" - nil - nil - nil - must-unfold - code-conversion)) - -(defun eword-decode-comment (string code-conversion &optional must-unfold) - (eword-decode-entire-string - string - eword-encoded-word-in-comment-regexp - eword-after-encoded-word-in-comment-regexp - "[^ \t\n()\\\\=]*" - ?\\ - '(?\( ?\)) - '(?\( ?\) ?\\ ?\r ?\n) - must-unfold - code-conversion)) - -(defun eword-decode-quoted-string (string code-conversion &optional must-unfold) - (eword-decode-entire-string - string - eword-encoded-word-in-quoted-string-regexp - eword-after-encoded-word-in-quoted-string-regexp - "[^ \t\n\"\\\\=]*" - ?\\ - '(?\") - '(?\" ?\\ ?\r ?\n) - must-unfold - code-conversion)) - -(defun eword-decode-string (string &optional must-unfold code-conversion) +(defun eword-decode-string (string &optional must-unfold) "Decode MIME encoded-words in STRING. STRING is unfolded before decoding. @@ -314,28 +84,50 @@ 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 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." - (eword-decode-unstructured - (std11-unfold-string string) - code-conversion - must-unfold)) +such as a version of Net$cape)." + (setq string (std11-unfold-string string)) + (let ((dest "")(ew nil) + beg end) + (while (and (string-match eword-encoded-word-regexp string) + (setq beg (match-beginning 0) + end (match-end 0)) + ) + (if (> beg 0) + (if (not + (and (eq ew t) + (string-match "^[ \t]+$" (substring string 0 beg)) + )) + (setq dest (concat dest (substring string 0 beg))) + ) + ) + (setq dest + (concat dest + (eword-decode-encoded-word + (substring string beg end) must-unfold) + )) + (setq string (substring string end)) + (setq ew t) + ) + (concat dest string) + )) (defun eword-decode-structured-field-body (string - &optional - start-column max-column) - (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11)) - (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) - (ew-crlf-to-lf decoded))) + &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) + 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 @@ -343,72 +135,110 @@ 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* ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) - (ew-crlf-to-lf (ew-crlf-unfold decoded)))) + (let ((tokens (eword-lexical-analyze string start 'must-unfold)) + (result "")) + (while tokens + (let* ((token (car tokens)) + (type (car token))) + (setq tokens (cdr tokens)) + (setq result + (if (eq type 'spaces) + (concat result " ") + (concat result (eword-decode-token token)) + )))) + result)) (defun eword-decode-and-fold-structured-field-body (string start-column - &optional max-column) - (or max-column - (setq max-column fill-column)) - (let* ((field-name (make-string (1- start-column) ?X)) - (field-body (ew-lf-crlf-to-crlf string)) - (ew-decode-field-default-syntax '(ew-scan-unibyte-std11)) - (decoded (ew-decode-field field-name field-body))) - (unless (equal field-body decoded) - (setq decoded (ew-crlf-refold decoded start-column max-column))) - (ew-crlf-to-lf decoded))) + &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 start 'must-unfold)) + (result "") + token) + (while (and (setq token (car tokens)) + (setq tokens (cdr tokens))) + (let* ((type (car token))) + (if (eq type 'spaces) + (let* ((next-token (car tokens)) + (next-str (eword-decode-token next-token)) + (next-len (string-width next-str)) + (next-c (+ c next-len 1))) + (if (< next-c max-column) + (setq result (concat result " " next-str) + c next-c) + (setq result (concat result "\n " next-str) + c (1+ next-len))) + (setq tokens (cdr tokens)) + ) + (let* ((str (eword-decode-token token))) + (setq result (concat result str) + c (+ c (string-width str))) + )))) + (if token + (concat result (eword-decode-token token)) + result)))) (defun eword-decode-unstructured-field-body (string &optional start-column max-column) - (let ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) - (ew-crlf-to-lf decoded))) + (eword-decode-string + (decode-mime-charset-string string default-mime-charset))) (defun eword-decode-and-unfold-unstructured-field-body (string &optional start-column max-column) - (let ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) - (ew-crlf-to-lf (ew-crlf-unfold decoded)))) + (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) - (let ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string)))) - (ew-crlf-to-lf decoded))) + (eword-decode-string + (decode-mime-charset-string string default-mime-charset) + 'must-unfold)) ;;; @ for region ;;; -(defun eword-decode-region (start end &optional unfolding must-unfold - code-conversion) +(defun eword-decode-region (start end &optional unfolding must-unfold) "Decode MIME encoded-words in region between START and END. If UNFOLDING is not nil, it unfolds before decoding. If MUST-UNFOLD is non-nil, it unfolds and eliminates line-breaks even if there are in decoded encoded-words (generated by bad manner MUA -such as a version of Net$cape). - -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." +such as a version of Net$cape)." (interactive "*r") - (rotate-memo args-eword-decode-region - (list start end (buffer-substring start end) unfolding must-unfold code-conversion)) (save-excursion (save-restriction (narrow-to-region start end) (if unfolding (eword-decode-unfold) ) - (let ((str (eword-decode-unstructured - (buffer-substring (point-min) (point-max)) - code-conversion - must-unfold))) - (delete-region (point-min) (point-max)) - (insert str))))) + (goto-char (point-min)) + (while (re-search-forward (concat "\\(" eword-encoded-word-regexp "\\)" + "\\(\n?[ \t]\\)+" + "\\(" eword-encoded-word-regexp "\\)") + nil t) + (replace-match "\\1\\6") + (goto-char (point-min)) + ) + (while (re-search-forward eword-encoded-word-regexp nil t) + (insert (eword-decode-encoded-word + (prog1 + (buffer-substring (match-beginning 0) (match-end 0)) + (delete-region (match-beginning 0) (match-end 0)) + ) must-unfold)) + ) + ))) (defun eword-decode-unfold () (goto-char (point-min)) @@ -427,6 +257,7 @@ default-mime-charset." )) ))) + ;;; @ for message header ;;; @@ -437,6 +268,70 @@ default-mime-charset." (defvar mime-update-field-decoder-cache 'ew-mime-update-field-decoder-cache "*Field decoder cache update function.") +(defun ew-mime-update-field-decoder-cache (field mode) + (require 'ew-dec) + (let ((fun (cond + ((eq mode 'plain) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (let ((res (ew-crlf-to-lf + (ew-decode-field field-name field-body)))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res)))) + ((eq mode 'wide) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (let* ((res (ew-decode-field field-name field-body)) + (res (if (string= res field-body) + res + (ew-crlf-refold res + (length field-name) + (or max-column fill-column)))) + (res (ew-crlf-to-lf res))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res)))) + ((eq mode 'summary) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (let ((res (ew-crlf-to-lf + (ew-crlf-unfold + (ew-decode-field field-name field-body))))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res)))) + ((eq mode 'nov) + (lexical-let ((field-name (symbol-name field))) + (lambda (field-body &optional start-column max-column must-unfold) + (setq field-body (ew-lf-to-crlf field-body)) + (require 'ew-var) + (let ((ew-ignore-76bytes-limit t)) + (let ((res (ew-crlf-to-lf + (ew-crlf-unfold + (ew-decode-field field-name field-body))))) + (add-text-properties + 0 (length res) + (list 'original-field-name field-name + 'original-field-body field-body) + res) + res))))) + (t + nil)))) + (mime-update-field-decoder-cache field mode fun))) + ;;;###autoload (defun mime-set-field-decoder (field &rest specs) "Set decoder of FILED. @@ -586,72 +481,8 @@ Default value of MODE is `summary'." 'nov #'eword-decode-unfolded-unstructured-field-body) ;;;###autoload -(defun ew-mime-update-field-decoder-cache (field mode) - (let ((fun (cond - ((eq mode 'plain) - (lexical-let ((field-name (symbol-name field))) - (lambda (field-body &optional start-column max-column must-unfold) - (setq field-body (ew-lf-to-crlf field-body)) - (let ((res (ew-crlf-to-lf - (ew-decode-field field-name field-body)))) - (add-text-properties - 0 (length res) - (list 'original-field-name field-name - 'original-field-body field-body) - res) - res)))) - ((eq mode 'wide) - (lexical-let ((field-name (symbol-name field))) - (lambda (field-body &optional start-column max-column must-unfold) - (setq field-body (ew-lf-to-crlf field-body)) - (let* ((res (ew-decode-field field-name field-body)) - (res (if (string= res field-body) - res - (ew-crlf-refold res - (length field-name) - (or max-column fill-column)))) - (res (ew-crlf-to-lf res))) - (add-text-properties - 0 (length res) - (list 'original-field-name field-name - 'original-field-body field-body) - res) - res)))) - ((eq mode 'summary) - (lexical-let ((field-name (symbol-name field))) - (lambda (field-body &optional start-column max-column must-unfold) - (setq field-body (ew-lf-to-crlf field-body)) - (let ((res (ew-crlf-to-lf - (ew-crlf-unfold - (ew-decode-field field-name field-body))))) - (add-text-properties - 0 (length res) - (list 'original-field-name field-name - 'original-field-body field-body) - res) - res)))) - ((eq mode 'nov) - (lexical-let ((field-name (symbol-name field))) - (lambda (field-body &optional start-column max-column must-unfold) - (setq field-body (ew-lf-to-crlf field-body)) - (require 'ew-var) - (let ((ew-ignore-76bytes-limit t)) - (let ((res (ew-crlf-to-lf - (ew-crlf-unfold - (ew-decode-field field-name field-body))))) - (add-text-properties - 0 (length res) - (list 'original-field-name field-name - 'original-field-body field-body) - res) - res))))) - (t - nil)))) - (mime-update-field-decoder-cache field mode fun))) - -;;;###autoload (defun mime-decode-field-body (field-body field-name - &optional mode max-column) + &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'. @@ -703,8 +534,7 @@ default-mime-charset." default-mime-charset)))) (if default-charset (let ((mode-obj (mime-find-field-presentation-method 'wide)) - beg p end len field-decoder - field-name field-body) + 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) @@ -714,17 +544,17 @@ default-mime-charset." field-decoder (inline (mime-find-field-decoder-internal (intern (capitalize field-name)) - mode-obj))) + mode-obj))) (when field-decoder - (setq end (std11-field-end) - field-body (buffer-substring p end)) - (let ((default-mime-charset default-charset)) + (setq end (std11-field-end)) + (let ((body (buffer-substring p end)) + (default-mime-charset default-charset)) (delete-region p end) - (insert (funcall field-decoder field-body (1+ len))) + (insert (funcall field-decoder body (1+ len))) + (add-text-properties beg (min (1+ (point)) (point-max)) + (list 'original-field-name field-name + 'original-field-body field-body)) )) - (add-text-properties beg (min (1+ (point)) (point-max)) - (list 'original-field-name field-name - 'original-field-body field-body)) )) (eword-decode-region (point-min) (point-max) t) ))))) @@ -839,7 +669,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 @@ -848,8 +678,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. @@ -862,134 +693,222 @@ 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-without-encoded-word (string start &optional must-unfold) + (let ((p (std11-check-enclosure string ?\" ?\" nil start))) (if p - (cons (cons 'quoted-string - (if eword-decode-quoted-encoded-word - (eword-decode-quoted-string - (substring string 0 p) - default-mime-charset) - (std11-wrap-as-quoted-string - (decode-mime-charset-string - (std11-strip-quoted-pair (substring string 1 (1- p))) - default-mime-charset)))) - (substring string p))) - )) + (cons (cons 'quoted-string + (decode-mime-charset-string + (std11-strip-quoted-pair + (substring string (1+ start) (1- p))) + default-mime-charset)) + ;;(substring string p)) + p) + ))) + +(defun eword-analyze-quoted-string-with-encoded-word (string start &optional must-unfold) + (let ((p (std11-check-enclosure string ?\" ?\" nil start))) + (if p + (cons (cons 'quoted-string + (let ((str + (std11-strip-quoted-pair + (substring string (1+ start) (1- p))))) + (if (string-match eword-encoded-word-regexp str) + (eword-decode-encoded-word str) + (decode-mime-charset-string str default-mime-charset) + ))) + p) + ))) -(defun eword-analyze-domain-literal (string &optional must-unfold) - (std11-analyze-domain-literal string)) - -(defun eword-analyze-comment (string &optional must-unfold) - (let ((len (length string))) - (if (and (< 0 len) (eq (aref string 0) ?\()) - (let ((p 0)) - (while (and p (< p len) (eq (aref string p) ?\()) - (setq p (std11-check-enclosure string ?\( ?\) t p))) - (setq p (or p len)) - (cons (cons 'comment - (eword-decode-comment - (std11-unfold-string (substring string 0 p)) - default-mime-charset)) - (substring string p))) - nil))) - - -(defun eword-analyze-spaces (string &optional must-unfold) - (std11-analyze-spaces string)) - -(defun eword-analyze-special (string &optional must-unfold) - (std11-analyze-special string)) - -(defun eword-analyze-encoded-word (string &optional must-unfold) - (let ((decoded (eword-decode-first-encoded-words - string - eword-encoded-word-in-phrase-regexp - eword-after-encoded-word-in-phrase-regexp - must-unfold))) - (if decoded - (let ((s (car decoded))) - (while (or (string-match std11-atom-regexp s) - (string-match std11-spaces-regexp s)) - (setq s (substring s (match-end 0)))) - (if (= (length s) 0) - (cons (cons 'atom (car decoded)) (cdr decoded)) - (cons (cons 'quoted-string - (std11-wrap-as-quoted-string (car decoded))) - (cdr decoded))))))) - -(defun eword-analyze-atom (string &optional must-unfold) - (if (string-match std11-atom-regexp (string-as-unibyte string)) +(defvar eword-analyze-quoted-encoded-word nil) +(defun eword-analyze-quoted-string (string start &optional must-unfold) + (if eword-analyze-quoted-encoded-word + (eword-analyze-quoted-string-with-encoded-word string start must-unfold) + (eword-analyze-quoted-string-without-encoded-word string start must-unfold))) + +(defun eword-analyze-domain-literal (string start &optional must-unfold) + (std11-analyze-domain-literal string start)) + +(defun eword-analyze-comment (string from &optional must-unfold) + (let ((len (length string)) + (i (or from 0)) + dest last-str + chr ret) + (when (and (> len i) + (eq (aref string i) ?\()) + (setq i (1+ i) + from i) + (catch 'tag + (while (< i len) + (setq chr (aref string i)) + (cond ((eq chr ?\\) + (setq i (1+ i)) + (if (>= i len) + (throw 'tag nil) + ) + (setq last-str (concat last-str + (substring string from (1- i)) + (char-to-string (aref string i))) + i (1+ i) + from i) + ) + ((eq chr ?\)) + (setq ret (concat last-str + (substring string from i))) + (throw 'tag (cons + (cons 'comment + (nreverse + (if (string= ret "") + dest + (cons + (eword-decode-string + (decode-mime-charset-string + ret default-mime-charset) + must-unfold) + dest) + ))) + (1+ i))) + ) + ((eq chr ?\() + (if (setq ret (eword-analyze-comment string i must-unfold)) + (setq last-str + (concat last-str + (substring string from i)) + dest + (if (string= last-str "") + (cons (car ret) dest) + (list* (car ret) + (eword-decode-string + (decode-mime-charset-string + last-str default-mime-charset) + must-unfold) + dest) + ) + i (cdr ret) + from i + last-str "") + (throw 'tag nil) + )) + (t + (setq i (1+ i)) + )) + ))))) + +(defun eword-analyze-spaces (string start &optional must-unfold) + (std11-analyze-spaces string start)) + +(defun eword-analyze-special (string start &optional must-unfold) + (std11-analyze-special string start)) + +(defun eword-analyze-encoded-word (string start &optional must-unfold) + (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)) + (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)) + start end) + ) + (cons (cons 'atom dest) ;;string) + end) + ))) + +(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))) - (if (and eword-decode-sticked-encoded-word - (string-match eword-encoded-word-in-phrase-regexp - (substring string 0 end)) - (< 0 (match-beginning 0))) - (setq end (match-beginning 0))) (cons (cons 'atom (decode-mime-charset-string - (substring string 0 end) + (substring string start end) default-mime-charset)) - (substring string end) - )))) - -(defun eword-lexical-analyze-internal (string must-unfold) - (let ((last 'eword-analyze-spaces) - dest ret) - (while (not (string-equal string "")) + ;;(substring string end) + end) + ))) + +(defun eword-lexical-analyze-internal (string start must-unfold) + (let ((len (length string)) + dest ret) + (while (< start len) (setq ret - (let ((rest eword-lexical-analyzers) - func r) - (while (and (setq func (car rest)) - (or - (and - (not eword-decode-sticked-encoded-word) - (not (eq last 'eword-analyze-spaces)) - (eq func 'eword-analyze-encoded-word)) - (null (setq r (funcall func string must-unfold)))) - ) - (setq rest (cdr rest))) - (setq last func) - (or r `((error . ,string) . "")) - )) - (setq dest (cons (car ret) dest)) - (setq string (cdr ret)) + (let ((rest eword-lexical-analyzer) + func r) + (while (and (setq func (car rest)) + (null + (setq r (funcall func string start must-unfold))) + ) + (setq rest (cdr rest))) + (or r + (list (cons 'error (substring string start)) (1+ len))) + )) + (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* ((str (copy-sequence string)) - (key (cons str (cons default-mime-charset must-unfold))) - ret) - (set-text-properties 0 (length str) nil str) + (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 str 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) - (cdr token)) - -(defun eword-extract-address-components (string) + (let ((type (car token)) + (value (cdr token))) + (cond ((eq type 'quoted-string) + (std11-wrap-as-quoted-string value)) + ((eq type 'comment) + (let ((dest "")) + (while value + (setq dest (concat dest + (if (stringp (car value)) + (std11-wrap-as-quoted-pairs + (car value) '(?( ?))) + (eword-decode-token (car value)) + )) + value (cdr value)) + ) + (concat "(" dest ")") + )) + (t value)))) + +(defun eword-extract-address-components (string &optional start) "Extract full name and canonical address from STRING. Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). If no name can be extracted, FULL-NAME will be nil. It decodes non us-ascii characters in FULL-NAME encoded as encoded-words or invalid \"raw\" string. \"Raw\" non us-ascii characters are regarded as variable `default-mime-charset'." - (rotate-memo args-eword-extract-address-components (list string)) (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 80d2ee6..0cd8c8a 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 @@ -575,8 +575,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/mel-b-ccl.el b/mel-b-ccl.el index 610237b..7f48c41 100644 --- a/mel-b-ccl.el +++ b/mel-b-ccl.el @@ -409,8 +409,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) @@ -438,9 +437,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 8c29a6f..421b8b2 100644 --- a/mel-q-ccl.el +++ b/mel-q-ccl.el @@ -977,8 +977,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")) @@ -1009,8 +1009,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/mime-def.el b/mime-def.el index 18ec844..00f4d54 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 ["FLAM-DOODLE" (1 12 1) "$B%Y%s%,%i(B 7.5R4.0/7.0"] + (defconst mime-library-product ["FLAM-DOODLE" (1 12 2) "$BBel`(B 10R4.5/8.0"] "Product name, version number and code name of MIME-library package.") ) @@ -99,8 +99,11 @@ ;;; @ about MIME ;;; -(defconst mime-tspecials "][()<>@,\;:\\\"/?=") -(defconst mime-token-regexp (concat "[^" mime-tspecials "\000-\040]+")) +(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 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..e4dcda2 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> @@ -169,6 +169,10 @@ 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> @@ -187,6 +191,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> Entity $B$NB0@-(B <node> Entity Attributes @@ -313,12 +326,28 @@ MIME charset. <var>entity</var> $B$NFbMF$N(B byte $BNs$rJV$9!#(B </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> Entity $B$N%M%C%H%o!<%/I=8=(B +<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-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 17766bf..2a8c3b0 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 @@ -53,6 +53,12 @@ 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.") @@ -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,24 +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))) - ) - (t - (setq field (mime-decode-field-body - field-body field-name 'plain)) - )) + (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 'native) + )) (mime-entity-set-parsed-header-internal entity (put-alist field-name field header)) field))))))) @@ -335,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 a95c119..1f7cbbc 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)) diff --git a/smtp.el b/smtp.el index e5031a2..79ef969 100644 --- a/smtp.el +++ b/smtp.el @@ -60,11 +60,6 @@ don't define this value." :type '(choice (const nil) string) :group 'smtp) -(defcustom smtp-coding-system 'binary - "*Coding-system for SMTP output." - :type 'coding-system - :group 'smtp) - (defvar smtp-debug-info nil) (defvar smtp-read-point nil) @@ -80,9 +75,7 @@ don't define this value." (error "Cannot generate valid FQDN. Set `smtp-local-domain' correctly."))))) (defun smtp-via-smtp (sender recipients smtp-text-buffer) - (let ((coding-system-for-read smtp-coding-system) - (coding-system-for-write smtp-coding-system) - process response extensions) + (let (process response extensions) (save-excursion (set-buffer (get-buffer-create @@ -93,9 +86,8 @@ don't define this value." (unwind-protect (catch 'done - (setq process (open-network-stream "SMTP" - (current-buffer) - smtp-server smtp-service)) + (setq process (open-network-stream-as-binary + "SMTP" (current-buffer) smtp-server smtp-service)) (or process (throw 'done nil)) (set-process-filter process 'smtp-process-filter) diff --git a/std11.el b/std11.el index 112629c..a083236 100644 --- a/std11.el +++ b/std11.el @@ -1,6 +1,6 @@ ;;; 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 @@ -27,8 +27,10 @@ (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)) @@ -755,6 +796,7 @@ represents addr-spec of RFC 822. [std11.el]" ) dest))) +;;;###autoload (defun std11-full-name-string (address) "Return string of full-name part from parsed ADDRESS of RFC 822." (cond ((eq (car address) 'group) @@ -793,11 +835,13 @@ represents addr-spec of RFC 822. [std11.el]" ) )))) +;;;###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 @@ -839,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