1998-08-21 Tanaka Akira <akr@jaist.ac.jp>
+ * TESTPAT: Change quoted-encoded-word to embedded-encoeded-word.
+
+ * closure.el (closure-make): Closure structure changed.
+ (closure-partial-call): New function.
+ (closure-call): Support new structure.
+
+ * ew-dec.el (ew-decode-field): Abolish argument `eword-filter'.
+ (ew-decode-none): Ditto.
+ (ew-decode-generic): Ditto.
+ (ew-decode-unstructured-ewords): Ditto.
+ (ew-decode-unstructured): Ditto.
+ (ew-decode-phrase-ewords): Ditto.
+ (ew-decode-phrase): Ditto.
+ (ew-decode-comment-ewords): Ditto.
+ (ew-decode-comment): Ditto.
+ (ew-analyze-field-to-decode): New function.
+ (ew-decode-analyzed-field): New function.
+ (ew-decode-field-no-cache): Use `ew-analyze-field-to-decode' and
+ `ew-decode-analyzed-field'.
+ (ew-decode-us-ascii): Now inlining function.
+ (ew-rotate): New macro.
+
+ * ew-quote.el (ew-encode-crlf): Support `ew-remove-bare-crlf' option.
+
+ * ew-unit.el (ew-eword-p): Now inlining function.
+ (ew-decode-eword): Abolish arguments `eword-filter1' and
+ `eword-filter2'.
+
+ * ew-var.el (ew-remove-bare-crlf): New variable.
+ (ew-dynamic-options): Add `ew-remove-bare-crlf'.
+
+ * eword-decode.el: Remove third argument for `ew-decode-field'.
+
+1998-08-21 Tanaka Akira <akr@jaist.ac.jp>
+
* ew-dec.el (ew-decode-us-ascii): New function.
(ew-decode-none): Use the function `ew-decode-us-ascii' instead of
the variable `ew-decode-us-ascii'.
(lambda (string)
(if (fboundp 'ew-decode-field)
(let ((ew-ignore-76bytes-limit t))
- (ew-cut-cr-lf (ew-decode-field "Subject" (ew-lf-to-crlf string))))
+ (ew-cut-cr-lf (ew-decode-field "Subject" (ew-lf-crlf-to-crlf string))))
(eword-decode-and-unfold-structured-field string))))
(setq gnus-structured-field-decoder
(lambda (string)
(if (fboundp 'ew-decode-field)
(let ((ew-ignore-76bytes-limit t))
- (ew-cut-cr-lf (ew-decode-field "From" (ew-lf-to-crlf string) 'ew-cut-cr-lf)))
+ (ew-cut-cr-lf (ew-decode-field "From" (ew-lf-crlf-to-crlf string))))
(eword-decode-unstructured-field-body (std11-unfold-string string) 'must-unfold))))
* Ignore warnings about args-eword-* when byte-compiling.
;;separate-sticked-comment ; violate the policy preserving absence of space
;;separate-sticked-special ; violate the policy preserving absence of space
;;zero-characters-encoded-word-hack ; violate common sense (very tricky)
-;;quoted-encoded-word ; violate character sequence semantics
+;;embedded-encoded-word ; violate character sequence semantics
;;separate-sticked-tokens-for-fold ; violate the policy preserving absence of space
;;encode-long-ascii-string-for-fold ; violate the policy preserving US-ASCII string
;;divide-atom-for-fold ; violate tne policy preserving absence of space
(require 'ew-line)
(defun decode-test (src dsts &rest opts)
- (let ((ew-decode-quoted-encoded-word nil)
+ (setq ew-decode-field-cache-buf nil)
+ (let ((ew-decode-sticked-encoded-word nil)
+ (ew-decode-quoted-encoded-word nil)
(ew-ignore-75bytes-limit (memq 'ignore-75bytes-limit opts))
(ew-ignore-76bytes-limit (memq 'ignore-76bytes-limit opts))
(ew-permit-sticked-comment (memq 'permit-sticked-comment opts))
(decode
"Subject: =?Shift_JIS?B?gqA=?="
-"Subject: \e$B$"\e(B"
-'quoted-encoded-word)
+"Subject: \e$B$"\e(B")
(decode
"Subject: =?EUC-JP?B?pKI=?="
-"Subject: \e$B$"\e(B"
-'quoted-encoded-word)
+"Subject: \e$B$"\e(B")
(decode
"Subject: = =?ISO-2022-JP?B?GyRCJCIbKEI=?="
(decode
"Subject:=?ISO-2022-JP?B?GyRCJCIbKEI=?="
-"Subject:=?ISO-2022-JP?B?GyRCJCIbKEI=?=")
-
-(decode
-"Subject:=?ISO-2022-JP?B?GyRCJCIbKEI=?="
-"Subject:\e$B$"\e(B"
-'permit-sticked-special)
+"Subject:\e$B$"\e(B")
;;; Section 4: Decoding invalid inputs.
=?ISO-2022-JP?B?GyRCJCgbKEI=?= <foo@bar>"
'separate-sticked-special)
-;;; Section 7: Using quoted-encoded-words.
+;;; Section 7: Using embedded-encoded-words.
;;
-;; quoted-encoded-word \e$BI=8=\e(B
+;; embedded-encoded-word \e$BI=8=\e(B
;;
;; RFC2047 \e$B$N%G%3!<%@$O@x:_E*$K\e(B(\e$B%G%3!<%I7k2L$G$J$/\e(B) encoded-word \e$B$=$N$b$N$r\e(B
;; \e$B=PNO$7$J$1$l$P$J$i$J$$$3$H$,$"$k!#\e(B
;;
;; =?US-ASCII?Q?=3D=3FUS-ASCII=3FQ=3Ftext=3F=3D?=
;;
-;; \e$B%G%3!<%@$,C1$J$kJ8;zNs$r=PNO$9$k>l9g!"C1=c$K$d$k$H\e(B encoded-word \e$B$=$N$b$N$H\e(B
+;; \e$B%G%3!<%@$,C1$J$kJ8;zNs$r=PNO$9$k>l9g!"C1=c$K$O\e(B encoded-word \e$B$=$N$b$N$H\e(B
;; encoded-word \e$B$N$h$&$K$_$($kJ8;zNs$r6hJL$G$-$J$$!#\e(B
;; \e$B$3$3$G$OJ8;zNsCf$G$=$l$i$r3N<B$K6hJL$7$FI=8=$9$kJ}K!$r<($9!#\e(B
;;
;; \e$B%^%C%A$9$kItJ,$O\e(B charset \e$B$N@hF,$K\e(B + \e$B$,$$$/$DIU$$$F$$$k$+$GFbMF$N\e(B
;;
\e$B2r<a$rJQ$($k!#
\e(B
;;
-;; \e$B6v?t$N>l9g\e(B(0, 2, 4, ...): charset \e$B$N@hF,$N\e(B + \e$B$N?t$rH>J,$K$7$?J8;zNs\e(B
-;; \e$B4q?t$N>l9g\e(B(1, 3, 5, ...): charset \e$B$N@hF,$N\e(B + \e$B$N?t$rH>J,\e(B(\e$B>.?tE@0J2<\e(B
-;; \e$B@Z<N$F\e(B)\e$B$K$7$F!"$=$l$r\e(B encoded-word \e$B$H;W$C$F%G%3!<%I$7$?J8;zNs!#\e(B
+;; 3\e$B$rK!$H$7$F\e(B0\e$B$HEy$7$$>l9g\e(B(0, 3, 6, ...): charset \e$B$N@hF,$N\e(B + \e$B$N?t$r\e(B
+;; 1/3 \e$B$K$7$?J8;zNs\e(B
+;; 3\e$B$rK!$H$7$F\e(B1\e$B$HEy$7$$>l9g\e(B(1, 4, 7, ...): charset \e$B$N@hF,$N\e(B + \e$B$N?t$r\e(B
+;; 1/3 (\e$B>.?tE@0J2<@Z<N$F\e(B)\e$B$K$7$F!"$=$l$r\e(B encoded-word \e$B$H;W$C$F%G\e(B
+;; \e$B%3!<%I$7$?J8;zNs!#\e(B
+;; 3\e$B$rK!$H$7$F\e(B2\e$B$HEy$7$$>l9g\e(B(2, 5, 8, ...): charset \e$B$N@hF,$N\e(B + \e$B$N?t$r\e(B
+;; 1/3 (\e$B>.?tE@0J2<@Z<N$F\e(B)\e$B$K$7$F!":G8e$N\e(B = \e$B$r<h$j=|$$$?J8;zNs\e(B
+;;
+;; =?c?e?t?=?c?e?t?=... \e$B$H$$$&$h$&$K!"%Q%?!<%s$N@hF,$N\e(B = \e$B$H\e(B \e$BKvHx$N\e(B =
+;; \e$B=E$J$k>l9g!"4q?tHVL\$N$b$N$KBP$7$F>e5-$N%k!<%k$rE,MQ$9$k!#\e(B
;;
-;; NOTE: + \e$B$r\e(B quoted-encoded-word \e$BI=8=$N\e(B quote \e$BJ8;z$H8F$V!#\e(B
+;; NOTE: + \e$B$r\e(B embedded-encoded-word \e$BI=8=$N\e(B quote \e$BJ8;z$H8F$V!#\e(B
;;
;; NOTE: \e$B8=;~E@\e(B(1998/07/19)\e$B$G\e(B IANA \e$B$K$O\e(B + \e$B$r4^$`\e(B charset \e$B$O\e(B
;; \e$BEPO?$5$l$F$$$J$$$N$G!"$=$l$i$N\e(B charset \e$B$r;H$C$?\e(B
;; =?US-ASCII?Q?abcdef?= \e$B$H$$$&\e(Bencoded-word : =?+US-ASCII?Q?abcdef?=
;;
;; =?US-ASCII?Q?abcdef?= \e$B$H$$$&J8;zNs\e(B : =?US-ASCII?Q?abcdef?=
-;; =?+US-ASCII?Q?abcdef?= \e$B$H$$$&J8;zNs\e(B : =?++US-ASCII?Q?abcdef?=
-;; =?++US-ASCII?Q?abcdef?= \e$B$H$$$&J8;zNs\e(B : =?++++US-ASCII?Q?abcdef?=
-;; =?+++US-ASCII?Q?abcdef?= \e$B$H$$$&J8;zNs\e(B : =?++++++US-ASCII?Q?abcdef?=
+;; =?+US-ASCII?Q?abcdef?= \e$B$H$$$&J8;zNs\e(B : =?+++US-ASCII?Q?abcdef?=
+;; =?++US-ASCII?Q?abcdef?= \e$B$H$$$&J8;zNs\e(B : =?++++++US-ASCII?Q?abcdef?=
+;; =?+++US-ASCII?Q?abcdef?= \e$B$H$$$&J8;zNs\e(B : =?+++++++++US-ASCII?Q?abcdef?=
;; =?US-ASCII+?Q?abcdef?= \e$B$H$$$&J8;zNs\e(B : =?US-ASCII+?Q?abcdef?=
;; =?U+S-ASCII?Q?abcdef?= \e$B$H$$$&J8;zNs\e(B : =?U+S-ASCII?Q?abcdef?=
;;
-;; NOTE: encoded-word \e$B$K8+$($kJ8;zNs$G\e(B + \e$B$,G\A}$5$l$k$N$O\e(B charset \e$B$N\e(B
+;; =?US-ASCII?Q?abcdef? \e$B$H$$$&J8;zNs\e(B : =?++US-ASCII?Q?abcdef?=
+;; =?+US-ASCII?Q?abcdef? \e$B$H$$$&J8;zNs\e(B : =?+++++US-ASCII?Q?abcdef?=
+;; =?++US-ASCII?Q?abcdef? \e$B$H$$$&J8;zNs\e(B : =?++++++++US-ASCII?Q?abcdef?=
+;; =?+++US-ASCII?Q?abcdef? \e$B$H$$$&J8;zNs\e(B : =?+++++++++++US-ASCII?Q?abcdef?=
+;;
+;; NOTE: encoded-word \e$B$K8+$($kJ8;zNs$G\e(B + \e$B$,\e(B 3\e$BG\A}$5$l$k$N$O\e(B charset \e$B$N\e(B
;; \e$B@hF,$@$1$G$"$j!"\e(Bencoding \e$B$d\e(B encoded-text \e$B$O$?$H$(\e(B + \e$B$,F~$C$F$$$F$b\e(B
;; \e$BJQ2=$7$J$$!#$^$?!"\e(Bcharset \e$BCf$G$b\e(B \e$B@hF,0J30$N\e(B + \e$B$OJQ2=$7$J$$!#\e(B
;;
+;; NOTE: charset \e$B$H\e(B encoding \e$B$K$O\e(B = \e$B$O4^$^$l$J$$$N$G\e(B 1\e$BJ8;z0J>e=E$J$k$3\e(B
+;; \e$B$H$O$J$$!#\e(B
+;;
;; rule 3:
\e$BJ8;zNsA4BN$NFbMF$O!"
\e(Brule 1
\e$B$H
\e(B rule 2
\e$B$G2r<a$7$?3FItJ,$N
\e(B
;; \e$BJ8;zNs$rC1=c$KO"7k$7$?J8;zNs$H$9$k!#\e(B
;;
;; NOTE: RFC2047 \e$B$G$O\e(B encoded-word \e$B$,6uGr$G6h@Z$i$l$J$1$l$P$J$i$J$$$H$+!"\e(B
;; encoded-word \e$B$O\e(B 75bytes \e$B0J2<$G$J$1$l$P$J$i$J$$$H$+!"\e(B
;; encoded-word \e$B$,4^$^$l$k9T$O\e(B 76bytes \e$B0J2<$G$J$1$l$P$J$i$J$$$J$I$H$$$&\e(B
-;; \e$B5,Ls$,$"$k$,!"\e(Bquoted-encoded-word \e$BI=8=$G$O$=$l$i$O:NMQ$7$J$$!#\e(B
+;; \e$B5,Ls$,$"$k$,!"\e(Bembedded-encoded-word \e$BI=8=$G$O$=$l$i$O:NMQ$7$J$$!#\e(B
;; \e$BC1=c$K\e(B encoded-word \e$BFbIt$NJ8K!$@$1$rMxMQ$9$k!#\e(B
;; (
\e$BK\<AE*$K$O0[$J$kJ8K!$r:NMQ$9$k$3$H$b2DG=$G$"$k$,!"
\e(BRFC2047
\e$B$K7I0U$r
\e(B
;; \e$BI=$7$F\e(B encoded-word \e$B$NJ8K!$r:NMQ$9$k!#\e(B)
;;
-;; NOTE: quoted-encoded-word \e$BI=8=$7$?J8;zNs$NO"7k$O0BA4$G$O$J$$!#\e(B
-;; =?+US-ASCII?Q?ab \e$B$H\e(B cd?= \e$B$H$$$&\e(B quoted-encoded-word \e$BI=8=$7$?J8;zNs$O\e(B
+;; NOTE: embedded-encoded-word \e$BI=8=$7$?J8;zNs$NO"7k$O0BA4$G$O$J$$!#\e(B
+;; =?+US-ASCII?Q?ab \e$B$H\e(B cd?= \e$B$H$$$&\e(B embedded-encoded-word \e$BI=8=$7$?J8;zNs$O\e(B
;; \e$B$=$l$>$l$=$NJ8;zNs$=$N$b$N$rI=8=$9$k$,!"$=$l$i$rO"7k$7$?J8;zNs\e(B
;; =?+US-ASCII?Q?abcd?= \e$B$O\e(B abcd \e$B$H$$$&J8;zNs$rI=8=$9$k$3$H$K$J$j!"\e(B
;; \e$B$=$l$>$l$NFbMF$NO"7k$H$O$J$i$J$$!#\e(B
;;
-;; \e$B$3$l$O$H$/$K\e(B Non ASCII \e$B3HD%\e(B RFC822 \e$B$NCf$K\e(B quoted-encoded-word \e$BI=8=$r\e(B
+;; \e$B$3$l$O$H$/$K\e(B Non ASCII \e$B3HD%\e(B RFC822 \e$B$NCf$K\e(B embedded-encoded-word \e$BI=8=$r\e(B
;; \e$BKd$a9~$`$H$-$K5$$rIU$1$J$1$l$P$J$i$J$$!#\e(B(\e$BKd$a9~$s$@7k2L$O@5$7$$\e(B
-;; quoted-encoded-word \e$BI=8=$H$O$J$i$J$$$+$bCN$l$J$$!#\e(B)
+;; embedded-encoded-word \e$BI=8=$H$O$J$i$J$$$+$bCN$l$J$$!#\e(B)
(decode
"Subject: =?Unknown-Charset?B?gqA=?="
"Subject: =?+Unknown-Charset?B?gqA=?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?US-ASCII?G?H4sIACqUszUAA8tIzcnJBwCGphA2BQAAAA==?="
"Subject: =?+US-ASCII?G?H4sIACqUszUAA8tIzcnJBwCGphA2BQAAAA==?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?US-ASCII?Unknown-Encoding?H4sIAGOUszUAAwtyczYyMDEHAEpvqpIHAAAA?="
"Subject: =?+US-ASCII?Unknown-Encoding?H4sIAGOUszUAAwtyczYyMDEHAEpvqpIHAAAA?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?ISO-2022-JP?G?H4sIAGiTszUAA5NWcVIBAhMtaQ0nAGLSaeEMAAAA?=\r
=?ISO-2022-JP?G?H4sIAH6TszUAA5NWcVIxV3FTyVbxldZwAgAuIikKDgAAAA==?="
"Subject: =?+ISO-2022-JP?G?H4sIAGiTszUAA5NWcVIBAhMtaQ0nAGLSaeEMAAAA?==?+ISO-2022-JP?G?H4sIAH6TszUAA5NWcVIxV3FTyVbxldZwAgAuIikKDgAAAA==?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?Unknown-Charset?B?gqA=?= =?Unknown-Charset?B?gqA=?="
"Subject: =?+Unknown-Charset?B?gqA=?==?+Unknown-Charset?B?gqA=?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?Unknown-Charset?B?gqA=?= =?Unknown-Charset?B?gqA=?="
"Subject: =?+Unknown-Charset?B?gqA=?==?+Unknown-Charset?B?gqA=?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?Unknown-Charset?B?gqA=?=\r
=?Unknown-Charset?B?gqA=?="
"Subject: =?+Unknown-Charset?B?gqA=?==?+Unknown-Charset?B?gqA=?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?Unknown-Charset?B?gqA=?=\r
=?Unknown-Charset?B?gqA=?="
"Subject: =?+Unknown-Charset?B?gqA=?==?+Unknown-Charset?B?gqA=?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: a=?Unknown-Charset?B?gqA=?="
"Subject: a=?Unknown-Charset?B?gqA=?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?Unknown-Charset?B?gqA=?=b"
"Subject: =?Unknown-Charset?B?gqA=?=b"
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: a=?Unknown-Charset?B?gqA=?=b"
"Subject: a=?Unknown-Charset?B?gqA=?=b"
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: a =?Unknown-Charset?B?gqA=?= b"
"Subject: a =?+Unknown-Charset?B?gqA=?= b"
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?ISO-2022-JP?B?DQoNCg==?="
"Subject: =?+US-ASCII?Q?=0D=0A=0D=0A?="
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?US-ASCII?Q?a=0D=0A_b?="
"Subject: a b"
-'quoted-encoded-word)
+'embedded-encoded-word)
(decode
"Subject: =?US-ASCII?Q?a=0D=0Ab?="
"Subject: a=?+US-ASCII?Q?=0D=0A?=b"
-'quoted-encoded-word)
+'embedded-encoded-word)
+
+;;; Section 8: CR and LF.
+
+(decode
+"From: akr@jaist.ac.jp (\r\\\n)"
+"From: akr@jaist.ac.jp (\r\\\n)")
+
+(decode
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A?= =?US-ASCII?Q?a?=)"
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A?= a)")
+
+(decode
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A_?=)"
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A_?=)")
+
+(decode
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A=09?=)"
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A=09?=)")
+
+(decode
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A?= )"
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A?= )")
+
+(decode
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A?= )"
+"From: akr@jaist.ac.jp (\r=?US-ASCII?Q?=0A?= )")
+
+(decode
+"From: akr@jaist.ac.jp (\\\r\\\n)"
+"From: akr@jaist.ac.jp (\\\r\\\n)")
+
+(decode
+"From: akr@jaist.ac.jp (\\\r=?US-ASCII?Q?=0A?= =?US-ASCII?Q?a?=)"
+"From: akr@jaist.ac.jp (=?+US-ASCII?Q?=0D=0A?=a)"
+'embedded-encoded-word)
+
+(decode
+"From: akr@jaist.ac.jp (\\\r=?US-ASCII?Q?=0Aa?=)"
+"From: akr@jaist.ac.jp (=?+US-ASCII?Q?=0D=0A?=a)"
+'embedded-encoded-word)
+
+(decode
+"From: akr@jaist.ac.jp (\\\r=?US-ASCII?Q?=0A_?=)"
+"From: akr@jaist.ac.jp (\\ )")
+
+(decode
+"From: akr@jaist.ac.jp (\\\r=?US-ASCII?Q?=0A=09?=)"
+"From: akr@jaist.ac.jp (\\ )")
+
+(decode
+"From: akr@jaist.ac.jp (\\\r=?US-ASCII?Q?=0A?= )"
+"From: akr@jaist.ac.jp (\\ )")
+
+(decode
+"From: akr@jaist.ac.jp (\\\r=?US-ASCII?Q?=0A?= )"
+"From: akr@jaist.ac.jp (\\ )")
+
+(decode
+"From: akr@jaist.ac.jp (\\\r=?US-ASCII?Q?=0A?=\r
+ =?US-ASCII?Q?=0D=0A?= =?US-ASCII?Q?a?=)"
+"From: akr@jaist.ac.jp (=?+US-ASCII?Q?=0D=0A=0D=0A?=a)"
+'embedded-encoded-word)
+
+(decode
+"From: akr@jaist.ac.jp (\\\r=?US-ASCII?Q?=0A?=\r
+ =?US-ASCII?Q?=0D?=\\\n =?US-ASCII?Q?a?=)"
+"From: akr@jaist.ac.jp (=?+US-ASCII?Q?=0D=0A?=\r\\
+ a)"
+'embedded-encoded-word)
;;;end-test
(provide 'closure)
+;; closure is one of following forms.
+;; FUNCTION
+;; (WRAPPER FUNCTION FV1 . FVS)
+;; (PARTIAL-ARGS CLOSURE)
+
(defmacro closure-make (fun &rest fvs)
- "Make closure from function FUN and free variable list FVS.
+ "Make a closure from a function FUN and free variables FVS.
CAUTION: Do not assign to free variables."
- (let* ((funv (make-symbol "funv"))
- (args (make-symbol "args")))
- `(list
- ,fun
- (lambda (,funv ,args ,@fvs)
- (apply ,funv ,args))
- ,@fvs)))
+ (if (null fvs)
+ fun
+ (let* ((funv (make-symbol "funv"))
+ (args (make-symbol "args")))
+ `(list
+ (lambda (,funv ,args ,@fvs)
+ (apply ,funv ,args))
+ ,fun
+ ,@fvs))))
+
+(defmacro closure-partial-call (clo &rest args)
+ "Call partially."
+ `(list (list ,@args) ,clo))
(defun closure-call (clo &rest args)
"Call closure."
- (if (functionp clo)
- (apply clo args)
- (apply (cadr clo) (car clo) args (cddr clo))))
+ (while
+ (and
+ (not (functionp clo))
+ (if (cddr clo)
+ (progn
+ (setq args (cons (cadr clo) (cons args (cddr clo)))
+ clo (car clo))
+ nil)
+ t))
+ (setq args (append (car clo) args)
+ clo (cadr clo)))
+ (apply clo args))
(defun closure-compose (c1 c2)
"Compose C1 and C2.
(setq plus3 (closure-compose plus1 plus2))
(closure-call plus3 4) ; => 7
+(closure-call (closure-partial-call (closure-partial-call '+ 1 2 3) 4 5 6) 7 8 9) ;=> 45
+
)
\ No newline at end of file
(defvar ew-decode-field-cache-buf '())
(defvar ew-decode-field-cache-num 300)
-(defun ew-decode-field (field-name field-body &optional eword-filter)
+(defun ew-decode-field (field-name field-body)
"Decode MIME RFC2047 encoded-words in a field.
FIELD-NAME is a name of the field such as \"To\", \"Subject\" etc. and
used to selecting syntax of body of the field and deciding first
If FIELD-BODY has multiple lines, each line is separated by CRLF as
pure network representation. Also if the result has multiple lines,
-each line is separated by CRLF.
-
-If EWORD-FILTER is non-nil, it should be closure. it is called for
-each successful decoded encoded-word with decoded string as a
-argument. The return value of EWORD-FILTER is used as decoding result
-instead of its argument."
- (let* ((key (ew-cons* field-name field-body eword-filter
+each line is separated by CRLF."
+ (let* ((key (ew-cons* field-name field-body
(ew-dynamic-options)))
(tmp (assoc key ew-decode-field-cache-buf)))
(if tmp
(setcar (car ew-decode-field-cache-buf) key)
(setcdr (car ew-decode-field-cache-buf)
(ew-decode-field-no-cache
- field-name field-body eword-filter))
+ field-name field-body))
(cdar ew-decode-field-cache-buf)))))
-(defun ew-decode-field-no-cache (field-name field-body &optional eword-filter)
- "No caching version of ew-decode-field."
+(defun ew-analyze-field-to-decode (field-name field-body)
+ "Analyze FIELD-BODY to decode."
(let ((tmp (assq (intern (downcase field-name)) ew-decode-field-syntax-alist))
- frag-anchor frag1 frag2 decode)
+ anchor)
(if tmp
(setq tmp (cdr tmp))
(setq tmp ew-decode-field-default-syntax))
- (setq frag-anchor (funcall (car tmp) (1+ (length field-name)) field-body))
- ;;(setq zzz frag-anchor)
- (when (and (eq (car tmp) 'ew-scan-unibyte-unstructured)
- ew-decode-sticked-encoded-word)
- (ew-separate-eword (get frag-anchor 'next-frag)
- frag-anchor
- '(ew:us-texts)))
- (when (cdr tmp)
- (ew-mark (cdr tmp) frag-anchor))
- (setq frag1 (get frag-anchor 'next-frag))
- (while (not (eq frag1 frag-anchor))
- (setq decode (get frag1 'decode))
- (setq frag2 (get frag1 'next-frag))
- (while (and (not (eq frag2 frag-anchor))
- (eq decode (get frag2 'decode)))
- (setq frag2 (get frag2 'next-frag)))
- (funcall decode frag-anchor frag1 frag2 eword-filter)
- (setq frag1 frag2))
- (setq frag1 (get frag-anchor 'prev-frag)
- tmp ())
- (while (not (eq frag1 frag-anchor))
- (setq tmp (cons (or (get frag1 'decoded) (symbol-name frag1)) tmp)
- frag1 (get frag1 'prev-frag)))
- (apply 'concat tmp)))
+ (setq anchor (funcall (car tmp) (1+ (length field-name)) field-body))
+ (put anchor 'field-name field-name)
+ (put anchor 'scanner (car tmp))
+ (put anchor 'marker (cdr tmp))
+ anchor))
+
+(defun ew-decode-analyzed-field (anchor)
+ "Decode analyzed field."
+ (or (get anchor 'decoded)
+ (let (tmp frag1 frag2 decode)
+ (when ew-decode-sticked-encoded-word
+ (ew-separate-eword
+ (get anchor 'next-frag)
+ anchor
+ (if (eq (get anchor 'scanner) 'ew-scan-unibyte-unstructured)
+ '(ew:us-texts)
+ '(ew:cm-texts))))
+ (when (get anchor 'marker)
+ (ew-mark (get anchor 'marker) anchor))
+ (setq frag1 (get anchor 'next-frag))
+ (while (not (eq frag1 anchor))
+ (setq decode (get frag1 'decode))
+ (setq frag2 (get frag1 'next-frag))
+ (while (and (not (eq frag2 anchor))
+ (eq decode (get frag2 'decode)))
+ (setq frag2 (get frag2 'next-frag)))
+ (funcall decode anchor frag1 frag2)
+ (setq frag1 frag2))
+ (setq frag1 (get anchor 'prev-frag)
+ tmp ())
+ (while (not (eq frag1 anchor))
+ (setq tmp (cons (or (get frag1 'decoded) (symbol-name frag1)) tmp)
+ frag1 (get frag1 'prev-frag)))
+ (put anchor 'decoded (apply 'concat tmp)))))
+
+(defun ew-decode-field-no-cache (field-name field-body)
+ "No caching version of ew-decode-field."
+ (ew-decode-analyzed-field
+ (ew-analyze-field-to-decode field-name field-body)))
(defun ew-mark (tag anchor)
(let ((tlist (cons (list (symbol-value tag)) (ew-pair-list anchor))))
(when (< 0 ew-parse-error-sit-for-seconds)
(sit-for ew-parse-error-sit-for-seconds))))))
-(defun ew-decode-us-ascii (str)
+(defsubst ew-decode-us-ascii (str)
(decode-mime-charset-string str ew-default-mime-charset 'LF))
-(defun ew-decode-none (anchor frag end eword-filter)
+(defun ew-decode-none (anchor frag end)
(while (not (eq frag end))
(put frag 'decoded (ew-decode-us-ascii (symbol-name frag)))
(setq frag (get frag 'next-frag))))
+(defsubst ew-proper-eword-p (frag)
+ (and
+ (or ew-ignore-75bytes-limit
+ (<= (length (symbol-name frag)) 75))
+ (or ew-ignore-76bytes-limit
+ (<= (get frag 'line-length) 76))
+ (cond
+ ((eq (get frag 'type) 'ew:cm-texts)
+ (ew-eword-p (symbol-name frag)))
+ ((eq (get frag 'type) 'ew:qs-texts)
+ (ew-eword-p (symbol-name frag)))
+ ((eq (get frag 'type) 'ew:atom)
+ (and
+ (or ew-permit-sticked-comment
+ (and
+ (not (ew-comment-frag-p (get frag 'prev-frag)))
+ (not (ew-comment-frag-p (get frag 'next-frag)))))
+ (or ew-permit-sticked-special
+ (and
+ (or (ew-comment-frag-p (get frag 'prev-frag))
+ (not (ew-special-frag-p (get frag 'prev-frag))))
+ (or (ew-comment-frag-p (get frag 'next-frag))
+ (not (ew-special-frag-p (get frag 'next-frag))))))
+ (ew-eword-p (symbol-name frag))))
+ ((eq (get frag 'type) 'ew:us-texts)
+ (and
+ (or ew-permit-sticked-special
+ (not (ew-special-frag-p (get frag 'prev-frag))))
+ (ew-eword-p (symbol-name frag))))
+ (t
+ nil))))
+
(defun ew-decode-generic (anchor start end
decode-ewords
decode-others
- eword gap all
- eword-filter)
- (let ((frag start) result buff type f)
+ eword gap all)
+ (let ((frag start) (start-others start) type f)
(while (not (eq frag end))
(setq type (get frag 'type))
(cond
((and (memq type eword)
(ew-proper-eword-p frag))
- (when buff
- (setq result (ew-rappend result
- (funcall decode-others
- (nreverse buff)))
- buff ()))
+ (when (not (eq start-others frag))
+ (funcall decode-others start-others frag))
(let ((first frag) (ewords (list frag)))
(while (progn
(setq f (get frag 'next-frag))
(setq f (get f 'next-frag)))
(and (not (eq f end))
(ew-proper-eword-p f)))
+ (setq frag (get frag 'next-frag))
+ (while (not (eq frag f))
+ (put frag 'decoded "")
+ (setq frag (get frag 'next-frag)))
(setq ewords (ew-rcons* ewords f)
frag f))
- (while (not (eq first frag))
- (put first 'decoded "")
- (setq first (get first 'next-frag)))
- (put frag 'decoded "")
- (setq result (ew-rappend result
- (funcall decode-ewords
- (nreverse ewords)
- eword-filter)))))
+ (funcall decode-ewords
+ (nreverse ewords)))
+ (setq start-others (get frag 'next-frag)))
((memq type all)
- (setq buff (cons frag buff))
- (put frag 'decoded ""))
+ nil)
(t
(error "unexpected token: %s (%s)" frag type)))
(setq frag (get frag 'next-frag)))
- (when buff
- (setq result (ew-rappend result (funcall decode-others (nreverse buff)))))
- (put start 'decoded
- (apply 'ew-quote-concat (nreverse result)))
- ))
-
-(defun ew-decode-generic-others (frags puncts quotes targets)
- (let (result buff frag type tmp)
- (while frags
- (setq frag (car frags)
- type (get frag 'type)
- frags (cdr frags))
+ (when (not (eq start-others end))
+ (funcall decode-others start-others end))))
+
+(defun ew-decode-generic-others (start end puncts quotes targets)
+ (let ((frag start) (start-nonpunct start) type buff tmp)
+ (while (not (eq frag end))
+ (setq type (get frag 'type))
(cond
((memq type puncts)
(when buff
- (setq buff (nreverse buff)
- tmp (ew-decode-us-ascii
- (mapconcat 'car buff "")))
- (if (ew-contain-non-ascii-p tmp)
- (setq result (ew-rcons* result tmp))
- (setq result (ew-rcons*
- result
- (ew-decode-us-ascii
- (mapconcat 'cdr buff "")))))
+ (setq buff (apply 'concat (nreverse buff))
+ tmp (ew-decode-us-ascii buff))
+ (if (equal buff tmp)
+ (while (not (eq start-nonpunct frag))
+ (put start-nonpunct 'decoded (symbol-name start-nonpunct))
+ (setq start-nonpunct (get start-nonpunct 'next-frag)))
+ (progn
+ (put start-nonpunct 'decoded tmp)
+ (setq start-nonpunct (get start-nonpunct 'next-frag))
+ (while (not (eq start-nonpunct frag))
+ (put start-nonpunct 'decoded "")
+ (setq start-nonpunct (get start-nonpunct 'next-frag)))))
(setq buff ()))
- (setq result (ew-rcons*
- result
- (symbol-name frag))))
+ (put frag 'decoded (symbol-name frag))
+ (setq start-nonpunct (get frag 'next-frag)))
((memq type quotes)
- (setq buff (ew-rcons*
- buff
- (cons (substring (symbol-name frag) 1)
- (symbol-name frag)))))
+ (setq buff (ew-rcons* buff
+ (substring (symbol-name frag) 1))))
((memq type targets)
- (setq buff (ew-rcons*
- buff
- (cons (symbol-name frag)
- (symbol-name frag)))))
- (t
- (error "something wrong: unexpected token: %s (%s)" frag type))))
+ (setq buff (ew-rcons* buff
+ (symbol-name frag))))
+ (t (error "something wrong: unexpected token: %s (%s)" frag type)))
+ (setq frag (get frag 'next-frag)))
(when buff
- (setq buff (nreverse buff)
- tmp (ew-decode-us-ascii
- (mapconcat 'car buff "")))
- (if (ew-contain-non-ascii-p tmp)
- (setq result (ew-rcons* result tmp))
- (setq result (ew-rcons*
- result
- (ew-decode-us-ascii
- (mapconcat 'cdr buff "")))))
- (setq buff ()))
- (nreverse result)))
-
-(defun ew-decode-unstructured-ewords (ewords eword-filter)
- (let (result)
- (while ewords
- (setq result (ew-rcons*
- result
- (list (ew-decode-eword (symbol-name (car ewords))
- eword-filter
- 'ew-encode-crlf)))
- ewords (cdr ewords)))
- (nreverse result)))
-
-(defun ew-decode-unstructured-others (frags)
- (let (result)
- (while frags
- (setq result (ew-rcons*
- result
- (symbol-name (car frags)))
- frags (cdr frags)))
- (list (ew-decode-us-ascii
- (apply 'concat (nreverse result))))))
-
-(defun ew-decode-unstructured (anchor start end eword-filter)
+ (setq buff (apply 'concat (nreverse buff))
+ tmp (ew-decode-us-ascii buff))
+ (if (equal buff tmp)
+ (while (not (eq start-nonpunct frag))
+ (put start-nonpunct 'decoded (symbol-name start-nonpunct))
+ (setq start-nonpunct (get start-nonpunct 'next-frag)))
+ (progn
+ (put start-nonpunct 'decoded tmp)
+ (setq start-nonpunct (get start-nonpunct 'next-frag))
+ (while (not (eq start-nonpunct frag))
+ (put start-nonpunct 'decoded "")
+ (setq start-nonpunct (get start-nonpunct 'next-frag))))))))
+
+(defun ew-decode-unstructured-ewords (ewords)
+ (while ewords
+ (put (car ewords)
+ 'decoded
+ (list (ew-decode-eword (symbol-name (car ewords)))))
+ (setq ewords (cdr ewords))))
+
+(defun ew-decode-unstructured-others (start end)
+ (let (strs)
+ (while (not (eq start end))
+ (put start 'decoded "")
+ (setq strs (ew-rcons* strs
+ (symbol-name start))
+ start (get start 'next-frag)))
+ (put (get end 'prev-frag)
+ 'decoded
+ (ew-decode-us-ascii
+ (apply 'concat (nreverse strs))))))
+
+(defun ew-decode-unstructured (anchor start end)
(ew-decode-generic
anchor start end
'ew-decode-unstructured-ewords
ew:us-fold)
'(ew:us-texts
ew:us-wsp
- ew:us-fold)
- eword-filter))
-
-(defun ew-decode-phrase-ewords (ewords eword-filter)
- (let ((qs (eq (get (car ewords) 'type) 'ew:qs-texts))
- require-quoting
- result)
- (while ewords
- (setq result (ew-rcons*
- result
- (list (ew-decode-eword (symbol-name (car ewords))
- eword-filter
- 'ew-encode-crlf)))
- require-quoting (or require-quoting
- (string-match "[][()<>@,;:\\\".\000-\037]"
- (caar result)))
- ewords (cdr ewords)))
- (if require-quoting
- (list
- (funcall (if qs 'ew-embed-in-quoted-string 'ew-embed-in-phrase)
- (apply 'ew-quote-concat
- (nreverse result))))
- (nreverse result))))
-
-(defun ew-decode-phrase-others (frags)
+ ew:us-fold))
+ (let ((frag end) tmp)
+ (while (not (eq frag start))
+ (setq frag (get frag 'prev-frag)
+ tmp (cons (get frag 'decoded) tmp))
+ (put frag 'decoded ""))
+ (put start 'decoded (ew-encode-crlf (apply 'ew-quote-concat tmp)))))
+
+(defun ew-decode-phrase-ewords (ewords)
+ (let* ((qs (eq (get (car ewords) 'type) 'ew:qs-texts))
+ (regexp (if qs "[\\\\\\\"]" "[][()<>@,;:\\\\\\\".\000-\037]"))
+ has-dangerous-char
+ tmp decoded)
+ (setq tmp ewords)
+ (while tmp
+ (put (car tmp)
+ 'decoded
+ (list (setq decoded (ew-decode-eword (symbol-name (car tmp))))))
+ (setq tmp (cdr tmp)
+ has-dangerous-char (or has-dangerous-char
+ (string-match regexp decoded))))
+ (when has-dangerous-char
+ (setq tmp ewords)
+ (while tmp
+ (setq decoded (get (car tmp) 'decoded))
+ (setcar decoded (ew-embed-in-quoted-string (car decoded)))
+ (setq tmp (cdr tmp)))
+ (when (not qs)
+ (setq decoded (get (car ewords) 'decoded))
+ (setcar decoded (concat "\"" (car decoded)))
+ (setq decoded (get (car (last ewords)) 'decoded))
+ (setcar decoded (concat (car decoded) "\""))))))
+
+(defun ew-decode-phrase-others (start end)
(ew-decode-generic-others
- frags
+ start end
'(ew:qs-begin
ew:qs-end)
'(ew:qs-qfold
ew:qs-wsp
ew:qs-fold)))
-(defun ew-decode-phrase (anchor start end eword-filter)
+(defmacro ew-rotate (var val len)
+ (let ((tmp (make-symbol "tmp")))
+ `(let ((,tmp (nthcdr ,(- len 2) ,var)))
+ (if (cdr ,tmp)
+ (progn
+ (setcdr (cdr ,tmp) ,var)
+ (setq ,var (cdr ,tmp))
+ (setcdr ,tmp nil))
+ (setq ,var (cons nil ,var)))
+ (setcar ,var ,val))))
+
+(defun ew-decode-phrase (anchor start end)
(ew-decode-generic
anchor start end
'ew-decode-phrase-ewords
'(ew:atom ew:qs-texts)
'(ew:atom))
'(ew:wsp
- ew:fold)
+ ew:fold
+ ew:qs-wsp
+ ew:qs-fold)
'(ew:atom
ew:wsp
ew:fold
ew:qs-wsp
ew:qs-fold
ew:qs-qfold
- ew:qs-qpair)
- eword-filter))
-
-(defun ew-decode-comment-ewords (ewords eword-filter)
- (let (require-quoting
- result)
- (while ewords
- (setq result (ew-rcons*
- result
- (list (ew-decode-eword (symbol-name (car ewords))
- eword-filter
- 'ew-encode-crlf)))
- require-quoting (or require-quoting
- (string-match "[()\\\\]" (caar result)))
- ewords (cdr ewords)))
- (if require-quoting
- (list
- (ew-embed-in-comment
- (apply 'ew-quote-concat
- (nreverse result))))
- (nreverse result))))
-
-(defun ew-decode-comment-others (frags)
+ ew:qs-qpair))
+ (let ((frag start) decoded str len idx char
+ chars frags
+ tmp)
+ (while (not (eq frag end))
+ (setq decoded (get frag 'decoded)
+ str (or (car-safe decoded) decoded)
+ len (length str)
+ idx 0)
+ (while (< idx len)
+ (setq char (sref str idx))
+ (ew-rotate chars char 3)
+ (ew-rotate frags frag 3)
+ (when (and (not (memq char '(?\t ?\ )))
+ (equal (cdr chars) '(?\n ?\r))
+ (eq (get (setq tmp (nth 2 frags)) 'type) 'ew:qs-qpair)
+ (eq (symbol-name tmp) (get tmp 'decoded)))
+ (put tmp 'decoded "\r"))
+ (setq idx (char-next-index char idx)))
+ (setq frag (get frag 'next-frag)))
+ (setq frag end
+ tmp ())
+ (while (not (eq frag start))
+ (setq frag (get frag 'prev-frag)
+ tmp (cons (get frag 'decoded) tmp))
+ (put frag 'decoded ""))
+ (put start 'decoded (ew-encode-crlf (apply 'ew-quote-concat tmp)))))
+
+(defun ew-decode-comment-ewords (ewords)
+ (let* ((regexp "[()\\\\]")
+ has-dangerous-char
+ tmp decoded)
+ (setq tmp ewords)
+ (while tmp
+ (put (car tmp)
+ 'decoded
+ (list (setq decoded (ew-decode-eword (symbol-name (car tmp))))))
+ (setq tmp (cdr tmp)
+ has-dangerous-char (or has-dangerous-char
+ (string-match regexp decoded))))
+ (when has-dangerous-char
+ (setq tmp ewords)
+ (while tmp
+ (setq decoded (get (car tmp) 'decoded))
+ (setcar decoded (ew-embed-in-comment (car decoded)))
+ (setq tmp (cdr tmp))))))
+
+(defun ew-decode-comment-others (start end)
(ew-decode-generic-others
- frags
+ start end
'()
'(ew:cm-qfold
ew:cm-qpair)
ew:cm-wsp
ew:cm-fold)))
-(defun ew-decode-comment (anchor start end eword-filter)
+(defun ew-decode-comment (anchor start end)
(ew-decode-generic
anchor start end
'ew-decode-comment-ewords
ew:cm-wsp
ew:cm-fold
ew:cm-qfold
- ew:cm-qpair)
- eword-filter))
+ ew:cm-qpair))
+ (let ((frag start) decoded str len idx char
+ chars frags tmp)
+ (while (not (eq frag end))
+ (setq decoded (get frag 'decoded)
+ str (or (car-safe decoded) decoded)
+ len (length str)
+ idx 0)
+ (while (< idx len)
+ (setq char (sref str idx))
+ (ew-rotate chars char 3)
+ (ew-rotate frags frag 3)
+ (when (and (not (memq char '(?\t ?\ )))
+ (equal (cdr chars) '(?\n ?\r))
+ (eq (get (setq tmp (nth 2 frags)) 'type) 'ew:cm-qpair)
+ (eq (symbol-name tmp) (get tmp 'decoded)))
+ (put tmp 'decoded "\r"))
+ (setq idx (char-next-index char idx)))
+ (setq frag (get frag 'next-frag)))
+ (setq frag end
+ tmp ())
+ (while (not (eq frag start))
+ (setq frag (get frag 'prev-frag)
+ tmp (cons (get frag 'decoded) tmp))
+ (put frag 'decoded ""))
+ (put start 'decoded (ew-encode-crlf (apply 'ew-quote-concat tmp)))))
;;;
;;;
-(defun ew-proper-eword-p (frag)
- (and
- (or ew-ignore-75bytes-limit
- (<= (length (symbol-name frag)) 75))
- (or ew-ignore-76bytes-limit
- (<= (get frag 'line-length) 76))
- (cond
- ((eq (get frag 'type) 'ew:cm-texts)
- (ew-eword-p (symbol-name frag)))
- ((eq (get frag 'type) 'ew:qs-texts)
- (ew-eword-p (symbol-name frag)))
- ((eq (get frag 'type) 'ew:atom)
- (and
- (or ew-permit-sticked-comment
- (and
- (not (ew-comment-frag-p (get frag 'prev-frag)))
- (not (ew-comment-frag-p (get frag 'next-frag)))))
- (or ew-permit-sticked-special
- (and
- (or (ew-comment-frag-p (get frag 'prev-frag))
- (not (ew-special-frag-p (get frag 'prev-frag))))
- (or (ew-comment-frag-p (get frag 'next-frag))
- (not (ew-special-frag-p (get frag 'next-frag))))))
- (ew-eword-p (symbol-name frag))))
- ((eq (get frag 'type) 'ew:us-texts)
- (and
- (or ew-permit-sticked-special
- (not (ew-special-frag-p (get frag 'prev-frag))))
- (ew-eword-p (symbol-name frag))))
- (t
- nil))))
-
(defun ew-contain-non-ascii-p (str)
(not (eq (charsets-to-mime-charset (find-charset-string str)) 'us-ascii)))
"?="))
(defun ew-encode-crlf (str)
- (let ((sstart 0)
- (mstart 0)
- (end (length str)) result ms me)
- (while (string-match "\\(\r\n\\)+" str mstart)
- (setq ms (match-beginning 0)
- me (match-end 0))
- (setq mstart me)
- (when (and (< me end)
- (member (aref str me) '(?\t ?\ )))
- (setq me (- me 2)))
- (when (< ms me)
+ (if ew-remove-bare-crlf
+ (ew-crlf-line-convert str nil nil (lambda (nl) ""))
+ (let ((sstart 0)
+ (mstart 0)
+ (end (length str)) result ms me)
+ (while (string-match "\\(\r\n\\)+" str mstart)
+ (setq ms (match-beginning 0)
+ me (match-end 0))
+ (setq mstart me)
+ (when (and (< me end)
+ (member (aref str me) '(?\t ?\ )))
+ (setq me (- me 2)))
+ (when (< ms me)
+ (setq result (ew-rcons* result
+ (substring str sstart ms)
+ "=?+US-ASCII?Q?")
+ sstart me)
+ (while (< ms me)
+ (setq result (ew-rcons* result "=0D=0A")
+ ms (+ ms 2)))
+ (setq result (ew-rcons* result "?="))))
+ (when (< sstart end)
(setq result (ew-rcons* result
- (substring str sstart ms)
- "=?+US-ASCII?Q?")
- sstart me)
- (while (< ms me)
- (setq result (ew-rcons* result "=0D=0A")
- ms (+ ms 2)))
- (setq result (ew-rcons* result "?="))))
- (when (< sstart end)
- (setq result (ew-rcons* result
- (substring str sstart))))
- (apply 'concat (nreverse result))))
-
+ (substring str sstart))))
+ (apply 'concat (nreverse result)))))
'(
(ew-quote-concat "aaa=?A?B?C?=ccc") ;"aaa=?A?B?C?=ccc"
(defun ew-b-check (encoding encoded-text) (string-match ew-b-regexp encoded-text))
(defun ew-q-check (encoding encoded-text) (string-match ew-q-regexp encoded-text))
-(defun ew-eword-p (str)
+(defsubst ew-eword-p (str)
(let ((len (length str)))
(and
(<= 3 len)
(eq (aref str (- len 2)) ??)
(eq (aref str (1- len)) ?=))))
-(defun ew-decode-eword (str &optional eword-filter1 eword-filter2)
+(defun ew-decode-eword (str)
(if (string-match ew-anchored-encoded-word-regexp str)
(let ((charset (match-string 1 str))
(encoding (match-string 2 str))
(setq cdec (ew-char-decoder charset)))
(if (or (null (setq bcheck (ew-byte-checker encoding)))
(funcall bcheck encoding encoded-text))
- (progn
- (setq tmp (closure-call cdec (funcall bdec encoded-text)))
- (when eword-filter1 (setq tmp (closure-call eword-filter1 tmp)))
- (setq tmp (ew-quote tmp))
- (when eword-filter2 (setq tmp (closure-call eword-filter2 tmp)))
- tmp)
+ (ew-quote (closure-call cdec (funcall bdec encoded-text)))
(ew-quote str))
(ew-quote-eword charset encoding encoded-text)))
(ew-quote str)))
(defvar ew-ignore-76bytes-limit nil)
(defvar ew-permit-sticked-comment nil)
(defvar ew-permit-sticked-special nil)
+
+(defvar ew-remove-bare-crlf nil)
(defvar ew-default-mime-charset 'x-ctext)
;;;
(if ew-ignore-75bytes-limit 4 0)
(if ew-ignore-76bytes-limit 8 0)
(if ew-permit-sticked-comment 16 0)
- (if ew-permit-sticked-special 32 0))))
+ (if ew-permit-sticked-special 32 0)
+ (if ew-remove-bare-crlf 64 0)
+ )))
(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
- (if must-unfold 'ew-cut-cr-lf))))
+ (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)))
decode the charset included in it, it is not decoded."
(rotate-memo args-eword-decode-and-unfold-structured-field (list string))
(let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
- (decoded (ew-decode-field ""
- (ew-lf-crlf-to-crlf string)
- 'ew-cut-cr-lf)))
- (ew-cut-cr-lf decoded)))
+ (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string))))
+ (ew-crlf-to-lf (ew-crlf-unfold decoded))))
(defun eword-decode-structured-field-body (string &optional must-unfold
start-column max-column)
(rotate-memo args-eword-decode-structured-field-body
(list string must-unfold start-column max-column))
(if start-column
- ;; fold with max-column (folding is not implemented.)
- (let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
- (decoded (ew-decode-field (make-string (1- start-column) ?X)
- (ew-lf-crlf-to-crlf string)
- (if must-unfold 'ew-cut-cr-lf))))
- (if must-unfold (ew-cut-cr-lf decoded) (ew-crlf-to-lf decoded)))
+ ;; fold with max-column
+ (eword-decode-and-fold-structured-field
+ string start-column max-column must-unfold)
;; Don't fold
(let* ((ew-decode-field-default-syntax '(ew-scan-unibyte-std11))
- (decoded (ew-decode-field ""
- (ew-lf-crlf-to-crlf string)
- (if must-unfold 'ew-cut-cr-lf))))
- (if must-unfold (ew-cut-cr-lf decoded) (ew-crlf-to-lf decoded)))))
+ (decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string))))
+ (ew-crlf-to-lf decoded))))
(defun eword-decode-unstructured-field-body (string &optional must-unfold)
"Decode non us-ascii characters in STRING as unstructured field body.
such as a version of Net$cape)."
(rotate-memo args-eword-decode-unstructured-field-body
(list string must-unfold))
- (let ((decoded (ew-decode-field ""
- (ew-lf-crlf-to-crlf string)
- (if must-unfold 'ew-cut-cr-lf))))
- (if must-unfold (ew-cut-cr-lf decoded) (ew-crlf-to-lf decoded))))
+ (let ((decoded (ew-decode-field "" (ew-lf-crlf-to-crlf string))))
+ (ew-crlf-to-lf (ew-crlf-unfold decoded))))
(defun eword-extract-address-components (string)
"Extract full name and canonical address from STRING.
projects / elisp / flim.git / commitdiff