From 3278469b1133b7cc84787965d314491b0c98fff8 Mon Sep 17 00:00:00 2001 From: akr Date: Thu, 27 Aug 1998 06:08:36 +0000 Subject: [PATCH] * DOODLE-TIPS: Add a notice about EVALARGS. * Makefile: evaluate environment variable EVALARGS if it is not empty. * ew-bq.el: - Use CCL emulating stuff of APEL. - Delete useless `eval-when-compile' in body of `define-ccl-program'. --- ChangeLog | 12 + DOODLE-TIPS | 19 +- Makefile | 13 +- ew-bq.el | 1158 ++++++++++++++++++++++++++++------------------------------- ew-var.el | 1 + 5 files changed, 592 insertions(+), 611 deletions(-) diff --git a/ChangeLog b/ChangeLog index b06c3c0..192df86 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +1998-08-27 Tanaka Akira + + * DOODLE-TIPS: Add a notice about EVALARGS. + + * Makefile: evaluate environment variable EVALARGS if it is not + empty. + + * ew-bq.el: + - Use CCL emulating stuff of APEL. + - Delete useless `eval-when-compile' in body of + `define-ccl-program'. + 1998-08-26 Tanaka Akira * ew-scan-n.el: New file. diff --git a/DOODLE-TIPS b/DOODLE-TIPS index 8df3ae0..f817d19 100644 --- a/DOODLE-TIPS +++ b/DOODLE-TIPS @@ -1,7 +1,8 @@ * You should byte-compile(make). Because DOODLE uses very complex macro. -Especialy ew-line.el, ew-scan-m.el, ew-scan-s.el and ew-scan-u.el that are require 'lex. +Especialy ew-line.el, ew-scan-m.el, ew-scan-s.el and ew-scan-u.el that +are require 'lex. (lex is scanner generator.) * Multiline field-bodies fetched from XOVER is already concatinated, @@ -15,17 +16,25 @@ field name information. (lambda (string) (if (fboundp 'ew-decode-field) (let ((ew-ignore-76bytes-limit t)) - (ew-cut-cr-lf (ew-decode-field "From" (ew-lf-crlf-to-crlf string)))) + (ew-cut-cr-lf + (ew-decode-field "From" (ew-lf-crlf-to-crlf string)))) (eword-decode-and-unfold-structured-field string)))) (setq gnus-unstructured-field-decoder (lambda (string) (if (fboundp 'ew-decode-field) (let ((ew-ignore-76bytes-limit t)) - (ew-cut-cr-lf (ew-decode-field "Subject" (ew-lf-crlf-to-crlf string)))) - (eword-decode-unstructured-field-body (std11-unfold-string string) 'must-unfold)))) + (ew-cut-cr-lf + (ew-decode-field "Subject" (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. -* If you have a problem with ew-ccl-b or other CCL based coding-system, set ew-bq-use-mel to t. +* If you have a problem with ew-ccl-b or other CCL based coding-system, +set ew-bq-use-mel to t. +* If you want to modify load-path or other variables when +byte-compiling without editing files, set EVALARGS environment variable. + + % EVALARGS='(setq load-path (cons "../apel" load-path))' make diff --git a/Makefile b/Makefile index 1aa6217..f170607 100644 --- a/Makefile +++ b/Makefile @@ -10,7 +10,8 @@ RM = /bin/rm -f CP = /bin/cp -p EMACS = emacs -FLAGS = -batch -q -no-site-file -l FLIM-MK +FLAGS = -batch -q -no-site-file -eval "$${EVALARGS:-nil}" +FLAGS_CURDIR = $(FLAGS) -eval '(setq load-path (cons "." load-path))' PREFIX = NONE LISPDIR = NONE @@ -20,10 +21,10 @@ FILES = README.?? Makefile FLIM-MK FLIM-CFG FLIM-ELS *.el ChangeLog elc: ew-parse.el - $(EMACS) $(FLAGS) -f compile-flim $(PREFIX) $(LISPDIR) + $(EMACS) $(FLAGS) -l FLIM-MK -f compile-flim $(PREFIX) $(LISPDIR) install: elc - $(EMACS) $(FLAGS) -f install-flim $(PREFIX) $(LISPDIR) + $(EMACS) $(FLAGS) -l FLIM-MK -f install-flim $(PREFIX) $(LISPDIR) clean: -$(RM) $(GOMI) @@ -53,10 +54,10 @@ ew-parse.el: ew-parse.scm lalr-el.scm -scm -f lalr-el.scm -f ew-parse.scm > ew-parse.out check: - $(EMACS) -q -batch -eval '(setq load-path (cons "." load-path))' -l ./TESTPAT -eval '(report)' + $(EMACS) $(FLAGS_CURDIR) -l ./TESTPAT -eval '(report)' -# BENCHMARK is not a part of FLAM-DOODLE because it is so large. +# The file BENCHMARK is not a part of FLAM-DOODLE because it is so large. benchmark: - $(EMACS) -q -batch -eval '(setq load-path (cons "." load-path))' -l ./BENCHMARK -eval '(report)' + $(EMACS) $(FLAGS_CURDIR) -l ./BENCHMARK -eval '(report)' diff --git a/ew-bq.el b/ew-bq.el index bf2f3dd..8796dbd 100644 --- a/ew-bq.el +++ b/ew-bq.el @@ -5,40 +5,6 @@ ;;; -(eval-and-compile -(defvar ew-ccl-use-symbol - (eval-when-compile - (define-ccl-program ew-ccl-identity-program - '(1 ((read r0) (loop (write-read-repeat r0))))) - (condition-case nil - (progn - (make-coding-system - 'ew-ccl-identity 4 ?I - "Identity coding system for byte-compile time checking" - '(ew-ccl-identity-program . ew-ccl-identity-program)) - t) - (error nil)))) -) - -(eval-and-compile -(defun ew-make-ccl-coding-system (coding-system mnemonic doc-string decoder encoder) - (make-coding-system - coding-system 4 mnemonic doc-string - (if ew-ccl-use-symbol - (cons decoder encoder) - (cons (symbol-value decoder) (symbol-value encoder))))) -) - -(defvar ew-ccl-untrusted-eof-block - (eval-when-compile - (define-ccl-program ew-ccl-eof-checker-program '(1 (read r0) (write "[EOF]"))) - (ew-make-ccl-coding-system - 'ew-ccl-eof-checker ?E "coding system for checking CCL_EOF_BLOCK when byte-compile time." - 'ew-ccl-eof-checker-program 'ew-ccl-eof-checker-program) - (not (equal (encode-coding-string "" 'ew-ccl-eof-checker) "[EOF]")))) - -;;; - (eval-when-compile (defconst ew-ccl-4-table @@ -173,101 +139,97 @@ ) (define-ccl-program ew-ccl-decode-q - (eval-when-compile - `(1 - ((loop - (read-branch - r0 - ,@(mapcar - (lambda (r0) - (cond - ((= r0 ?_) - `(write-repeat ? )) - ((= r0 ?=) - `((loop - (read-branch - r1 - ,@(mapcar - (lambda (v) - (if (integerp v) - `((r0 = ,v) (break)) - '(repeat))) - ew-ccl-256-to-16-table))) - (loop - (read-branch - r1 - ,@(mapcar - (lambda (v) - (if (integerp v) - `((write r0 ,(vconcat - (mapcar - (lambda (r0) - (logior (lsh r0 4) v)) - ew-ccl-16-table))) - (break)) - '(repeat))) - ew-ccl-256-to-16-table))) - (repeat))) - (t - `(write-repeat ,r0)))) - ew-ccl-256-table))))))) + `(1 + ((loop + (read-branch + r0 + ,@(mapcar + (lambda (r0) + (cond + ((= r0 ?_) + `(write-repeat ? )) + ((= r0 ?=) + `((loop + (read-branch + r1 + ,@(mapcar + (lambda (v) + (if (integerp v) + `((r0 = ,v) (break)) + '(repeat))) + ew-ccl-256-to-16-table))) + (loop + (read-branch + r1 + ,@(mapcar + (lambda (v) + (if (integerp v) + `((write r0 ,(vconcat + (mapcar + (lambda (r0) + (logior (lsh r0 4) v)) + ew-ccl-16-table))) + (break)) + '(repeat))) + ew-ccl-256-to-16-table))) + (repeat))) + (t + `(write-repeat ,r0)))) + ew-ccl-256-table)))))) (define-ccl-program ew-ccl-encode-uq - (eval-when-compile - `(3 - (loop - (loop - (read-branch - r0 - ,@(mapcar - (lambda (r0) - (cond - ((= r0 32) `(write-repeat ?_)) - ((member r0 ew-ccl-u-raw) `(write-repeat ,r0)) - (t '(break)))) - ew-ccl-256-table))) - (write ?=) - (write r0 ,ew-ccl-high-table) - (write r0 ,ew-ccl-low-table) - (repeat))))) + `(3 + (loop + (loop + (read-branch + r0 + ,@(mapcar + (lambda (r0) + (cond + ((= r0 32) `(write-repeat ?_)) + ((member r0 ew-ccl-u-raw) `(write-repeat ,r0)) + (t '(break)))) + ew-ccl-256-table))) + (write ?=) + (write r0 ,ew-ccl-high-table) + (write r0 ,ew-ccl-low-table) + (repeat)))) (define-ccl-program ew-ccl-encode-cq - (eval-when-compile - `(3 - (loop - (loop - (read-branch - r0 - ,@(mapcar - (lambda (r0) - (cond - ((= r0 32) `(write-repeat ?_)) - ((member r0 ew-ccl-c-raw) `(write-repeat ,r0)) - (t '(break)))) - ew-ccl-256-table))) - (write ?=) - (write r0 ,ew-ccl-high-table) - (write r0 ,ew-ccl-low-table) - (repeat))))) + `(3 + (loop + (loop + (read-branch + r0 + ,@(mapcar + (lambda (r0) + (cond + ((= r0 32) `(write-repeat ?_)) + ((member r0 ew-ccl-c-raw) `(write-repeat ,r0)) + (t '(break)))) + ew-ccl-256-table))) + (write ?=) + (write r0 ,ew-ccl-high-table) + (write r0 ,ew-ccl-low-table) + (repeat)))) (define-ccl-program ew-ccl-encode-pq - (eval-when-compile - `(3 - (loop - (loop - (read-branch - r0 - ,@(mapcar - (lambda (r0) - (cond - ((= r0 32) `(write-repeat ?_)) - ((member r0 ew-ccl-p-raw) `(write-repeat ,r0)) - (t '(break)))) - ew-ccl-256-table))) - (write ?=) - (write r0 ,ew-ccl-high-table) - (write r0 ,ew-ccl-low-table) - (repeat))))) + `(3 + (loop + (loop + (read-branch + r0 + ,@(mapcar + (lambda (r0) + (cond + ((= r0 32) `(write-repeat ?_)) + ((member r0 ew-ccl-p-raw) `(write-repeat ,r0)) + (t '(break)))) + ew-ccl-256-table))) + (write ?=) + (write r0 ,ew-ccl-high-table) + (write r0 ,ew-ccl-low-table) + (repeat)))) (eval-when-compile (defun ew-ccl-decode-b-bit-ex (v) @@ -400,511 +362,507 @@ ;; ew-ccl-encode-b works only 20.3 or later because CCL_EOF_BLOCK ;; is not executed on 20.2 (or former?). (define-ccl-program ew-ccl-encode-b - (eval-when-compile - `(2 - (loop - (r2 = 0) - (read-branch - r1 - ,@(mapcar - (lambda (r1) - `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table)) - (r0 = ,(logand r1 3)))) - ew-ccl-256-table)) - (r2 = 1) - (read-branch - r1 - ,@(mapcar - (lambda (r1) - `((write r0 ,(vconcat - (mapcar - (lambda (r0) - (nth (logior (lsh r0 4) - (lsh r1 -4)) - ew-ccl-64-to-256-table)) - ew-ccl-4-table))) - (r0 = ,(logand r1 15)))) - ew-ccl-256-table)) - (r2 = 2) - (read-branch - r1 - ,@(mapcar - (lambda (r1) - `((write r0 ,(vconcat - (mapcar - (lambda (r0) - (nth (logior (lsh r0 2) - (lsh r1 -6)) - ew-ccl-64-to-256-table)) - ew-ccl-16-table))))) - ew-ccl-256-table)) - (r1 &= 63) - (write r1 ,(vconcat - (mapcar - (lambda (r1) - (nth r1 ew-ccl-64-to-256-table)) - ew-ccl-64-table))) - (repeat)) - (branch - r2 - (end) - ((write r0 ,(vconcat - (mapcar - (lambda (r0) - (nth (lsh r0 4) ew-ccl-64-to-256-table)) - ew-ccl-4-table))) - (write "==")) - ((write r0 ,(vconcat - (mapcar - (lambda (r0) - (nth (lsh r0 2) ew-ccl-64-to-256-table)) - ew-ccl-16-table))) - (write ?=))) - ))) + `(2 + (loop + (r2 = 0) + (read-branch + r1 + ,@(mapcar + (lambda (r1) + `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table)) + (r0 = ,(logand r1 3)))) + ew-ccl-256-table)) + (r2 = 1) + (read-branch + r1 + ,@(mapcar + (lambda (r1) + `((write r0 ,(vconcat + (mapcar + (lambda (r0) + (nth (logior (lsh r0 4) + (lsh r1 -4)) + ew-ccl-64-to-256-table)) + ew-ccl-4-table))) + (r0 = ,(logand r1 15)))) + ew-ccl-256-table)) + (r2 = 2) + (read-branch + r1 + ,@(mapcar + (lambda (r1) + `((write r0 ,(vconcat + (mapcar + (lambda (r0) + (nth (logior (lsh r0 2) + (lsh r1 -6)) + ew-ccl-64-to-256-table)) + ew-ccl-16-table))))) + ew-ccl-256-table)) + (r1 &= 63) + (write r1 ,(vconcat + (mapcar + (lambda (r1) + (nth r1 ew-ccl-64-to-256-table)) + ew-ccl-64-table))) + (repeat)) + (branch + r2 + (end) + ((write r0 ,(vconcat + (mapcar + (lambda (r0) + (nth (lsh r0 4) ew-ccl-64-to-256-table)) + ew-ccl-4-table))) + (write "==")) + ((write r0 ,(vconcat + (mapcar + (lambda (r0) + (nth (lsh r0 2) ew-ccl-64-to-256-table)) + ew-ccl-16-table))) + (write ?=))) + )) ;;; ;; ew-ccl-encode-base64 does not works on 20.2 by same reason of ew-ccl-encode-b (define-ccl-program ew-ccl-encode-base64 - (eval-when-compile - `(2 - ((r3 = 0) - (loop - (r2 = 0) - (read-branch - r1 - ,@(mapcar - (lambda (r1) - `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table)) - (r0 = ,(logand r1 3)))) - ew-ccl-256-table)) - (r2 = 1) - (read-branch - r1 - ,@(mapcar - (lambda (r1) - `((write r0 ,(vconcat - (mapcar - (lambda (r0) - (nth (logior (lsh r0 4) - (lsh r1 -4)) - ew-ccl-64-to-256-table)) - ew-ccl-4-table))) - (r0 = ,(logand r1 15)))) - ew-ccl-256-table)) - (r2 = 2) - (read-branch - r1 - ,@(mapcar - (lambda (r1) - `((write r0 ,(vconcat - (mapcar - (lambda (r0) - (nth (logior (lsh r0 2) - (lsh r1 -6)) - ew-ccl-64-to-256-table)) - ew-ccl-16-table))))) - ew-ccl-256-table)) - (r1 &= 63) - (write r1 ,(vconcat - (mapcar - (lambda (r1) - (nth r1 ew-ccl-64-to-256-table)) - ew-ccl-64-table))) - (r3 += 1) - (if (r3 == 19) ; 4 * 19 = 76 --> line break. - ((write "\r\n") - (r3 = 0))) - (repeat))) - (branch - r2 - (if (r0 > 0) (write "\r\n")) - ((write r0 ,(vconcat - (mapcar - (lambda (r0) - (nth (lsh r0 4) ew-ccl-64-to-256-table)) - ew-ccl-4-table))) - (write "==\r\n")) - ((write r0 ,(vconcat - (mapcar - (lambda (r0) - (nth (lsh r0 2) ew-ccl-64-to-256-table)) - ew-ccl-16-table))) - (write "=\r\n"))) - ))) + `(2 + ((r3 = 0) + (loop + (r2 = 0) + (read-branch + r1 + ,@(mapcar + (lambda (r1) + `((write ,(nth (lsh r1 -2) ew-ccl-64-to-256-table)) + (r0 = ,(logand r1 3)))) + ew-ccl-256-table)) + (r2 = 1) + (read-branch + r1 + ,@(mapcar + (lambda (r1) + `((write r0 ,(vconcat + (mapcar + (lambda (r0) + (nth (logior (lsh r0 4) + (lsh r1 -4)) + ew-ccl-64-to-256-table)) + ew-ccl-4-table))) + (r0 = ,(logand r1 15)))) + ew-ccl-256-table)) + (r2 = 2) + (read-branch + r1 + ,@(mapcar + (lambda (r1) + `((write r0 ,(vconcat + (mapcar + (lambda (r0) + (nth (logior (lsh r0 2) + (lsh r1 -6)) + ew-ccl-64-to-256-table)) + ew-ccl-16-table))))) + ew-ccl-256-table)) + (r1 &= 63) + (write r1 ,(vconcat + (mapcar + (lambda (r1) + (nth r1 ew-ccl-64-to-256-table)) + ew-ccl-64-table))) + (r3 += 1) + (if (r3 == 19) ; 4 * 19 = 76 --> line break. + ((write "\r\n") + (r3 = 0))) + (repeat))) + (branch + r2 + (if (r0 > 0) (write "\r\n")) + ((write r0 ,(vconcat + (mapcar + (lambda (r0) + (nth (lsh r0 4) ew-ccl-64-to-256-table)) + ew-ccl-4-table))) + (write "==\r\n")) + ((write r0 ,(vconcat + (mapcar + (lambda (r0) + (nth (lsh r0 2) ew-ccl-64-to-256-table)) + ew-ccl-16-table))) + (write "=\r\n"))) + )) ;; ew-ccl-encode-quoted-printable does not works on 20.2 by same reason of ew-ccl-encode-b (define-ccl-program ew-ccl-encode-quoted-printable - (eval-when-compile - `(4 - ((r6 = 0) ; column - (r5 = 0) ; previous character is white space - (r4 = 0) - (read r0) - (loop ; r6 <= 75 - (loop - (loop - (branch - r0 - ,@(mapcar - (lambda (r0) - (let ((tmp (aref ew-ccl-qp-table r0))) - (cond - ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW - ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC - ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP - ((eq tmp 'cr) '((r3 = 3) (break))) ; CR - ))) - ew-ccl-256-table))) - (branch - r3 - ;; r0:r3=RAW - (if (r6 < 75) - ((r6 += 1) - (r5 = 0) - (r4 = 1) - (write-read-repeat r0)) - (break)) - ;; r0:r3=ENC - ((r5 = 0) - (if (r6 < 73) - ((r6 += 3) - (write "=") - (write r0 ,ew-ccl-high-table) - (r4 = 2) - (write-read-repeat r0 ,ew-ccl-low-table)) - (if (r6 > 73) - ((r6 = 3) - (write "=\r\n=") - (write r0 ,ew-ccl-high-table) - (r4 = 3) - (write-read-repeat r0 ,ew-ccl-low-table)) - (break)))) - ;; r0:r3=WSP - ((r5 = 1) - (if (r6 < 75) - ((r6 += 1) - (r4 = 4) - (write-read-repeat r0)) - ((r6 = 1) - (write "=\r\n") - (r4 = 5) - (write-read-repeat r0)))) - ;; r0:r3=CR - ((if ((r6 > 73) & r5) - ((r6 = 0) - (r5 = 0) - (write "=\r\n"))) - (break)))) - ;; r0:r3={RAW,ENC,CR} - (loop - (if (r0 == ?\r) - ;; r0=\r:r3=CR - ((r4 = 6) - (read r0) - ;; CR:r3=CR r0 - (if (r0 == ?\n) - ;; CR:r3=CR r0=LF - (if r5 - ;; r5=WSP ; CR:r3=CR r0=LF - ((r6 = 0) - (r5 = 0) - (write "=\r\n\r\n") - (r4 = 7) - (read r0) - (break)) - ;; r5=noWSP ; CR:r3=CR r0=LF - ((r6 = 0) - (r5 = 0) - (write "\r\n") - (r4 = 8) - (read r0) - (break))) - ;; CR:r3=CR r0=noLF - (if (r6 < 73) - ((r6 += 3) - (r5 = 0) - (write "=0D") - (break)) - (if (r6 == 73) - (if (r0 == ?\r) - ;; CR:r3=CR r0=CR - ((r4 = 9) - (read r0) - ;; CR:r3=CR CR r0 - (if (r0 == ?\n) - ;; CR:r3=CR CR LF - ((r6 = 0) - (r5 = 0) - (write "=0D\r\n") - (r4 = 10) - (read r0) - (break)) - ;; CR:r3=CR CR noLF - ((r6 = 6) - (r5 = 0) - (write "=\r\n=0D=0D") - (break)))) - ;; CR:r3=CR r0=noLFnorCR - ((r6 = 3) - (r5 = 0) - (write "=\r\n=0D") - (break))) - ((r6 = 3) - (r5 = 0) - (write "=\r\n=0D") - (break)))))) - ;; r0:r3={RAW,ENC} - ((r4 = 11) - (read r1) - ;; r0:r3={RAW,ENC} r1 - (if (r1 == ?\r) - ;; r0:r3={RAW,ENC} r1=CR - ((r4 = 12) - (read r1) - ;; r0:r3={RAW,ENC} CR r1 - (if (r1 == ?\n) - ;; r0:r3={RAW,ENC} CR r1=LF - ((r6 = 0) - (r5 = 0) - (branch - r3 - ;; r0:r3=RAW CR r1=LF - ((write r0) - (write "\r\n") - (r4 = 13) - (read r0) - (break)) - ;; r0:r3=ENC CR r1=LF - ((write ?=) - (write r0 ,ew-ccl-high-table) - (write r0 ,ew-ccl-low-table) - (write "\r\n") - (r4 = 14) - (read r0) - (break)))) - ;; r0:r3={RAW,ENC} CR r1=noLF - ((branch - r3 - ;; r0:r3=RAW CR r1:noLF - ((r6 = 4) - (r5 = 0) - (write "=\r\n") - (write r0) - (write "=0D") - (r0 = r1) - (break)) - ;; r0:r3=ENC CR r1:noLF - ((r6 = 6) - (r5 = 0) - (write "=\r\n=") - (write r0 ,ew-ccl-high-table) - (write r0 ,ew-ccl-low-table) - (write "=0D") - (r0 = r1) - (break)))) - )) - ;; r0:r3={RAW,ENC} r1:noCR - ((branch - r3 - ;; r0:r3=RAW r1:noCR - ((r6 = 1) - (r5 = 0) - (write "=\r\n") - (write r0) - (r0 = r1) - (break)) - ;; r0:r3=ENC r1:noCR - ((r6 = 3) - (r5 = 0) - (write "=\r\n=") - (write r0 ,ew-ccl-high-table) - (write r0 ,ew-ccl-low-table) - (r0 = r1) - (break)))))))) - (repeat))) - (;(write "[EOF:") (write r4 ,ew-ccl-high-table) (write r4 ,ew-ccl-low-table) (write "]") + `(4 + ((r6 = 0) ; column + (r5 = 0) ; previous character is white space + (r4 = 0) + (read r0) + (loop ; r6 <= 75 + (loop + (loop + (branch + r0 + ,@(mapcar + (lambda (r0) + (let ((tmp (aref ew-ccl-qp-table r0))) + (cond + ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW + ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC + ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP + ((eq tmp 'cr) '((r3 = 3) (break))) ; CR + ))) + ew-ccl-256-table))) (branch - r4 - ;; 0: (start) ; - (end) - ;; 1: RAW ; - (end) - ;; 2: r0:r3=ENC ; - (end) - ;; 3: SOFTBREAK r0:r3=ENC ; - (end) - ;; 4: r0:r3=WSP ; - ((write "=\r\n") (end)) - ;; 5: SOFTBREAK r0:r3=WSP ; - ((write "=\r\n") (end)) - ;; 6: ; r0=\r:r3=CR - (if (r6 <= 73) - ((write "=0D") (end)) - ((write "=\r\n=0D") (end))) - ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ; - (end) - ;; 8: r5=noWSP CR:r3=CR r0=LF ; - (end) - ;; 9: (r6=73) ; CR:r3=CR r0=CR - ((write "=\r\n=0D=0D") (end)) - ;; 10: (r6=73) CR:r3=CR CR LF ; - (end) - ;; 11: ; r0:r3={RAW,ENC} - (branch - r3 - ((write r0) (end)) - ((write "=") - (write r0 ,ew-ccl-high-table) - (write r0 ,ew-ccl-low-table) - (end))) - ;; 12: ; r0:r3={RAW,ENC} r1=CR - (branch - r3 - ((write "=\r\n") - (write r0) - (write "=0D") - (end)) - ((write "=\r\n=") - (write r0 ,ew-ccl-high-table) - (write r0 ,ew-ccl-low-table) - (write "=0D") - (end))) - ;; 13: r0:r3=RAW CR LF ; - (end) - ;; 14: r0:r3=ENC CR LF ; - (end) - )) - ))) + r3 + ;; r0:r3=RAW + (if (r6 < 75) + ((r6 += 1) + (r5 = 0) + (r4 = 1) + (write-read-repeat r0)) + (break)) + ;; r0:r3=ENC + ((r5 = 0) + (if (r6 < 73) + ((r6 += 3) + (write "=") + (write r0 ,ew-ccl-high-table) + (r4 = 2) + (write-read-repeat r0 ,ew-ccl-low-table)) + (if (r6 > 73) + ((r6 = 3) + (write "=\r\n=") + (write r0 ,ew-ccl-high-table) + (r4 = 3) + (write-read-repeat r0 ,ew-ccl-low-table)) + (break)))) + ;; r0:r3=WSP + ((r5 = 1) + (if (r6 < 75) + ((r6 += 1) + (r4 = 4) + (write-read-repeat r0)) + ((r6 = 1) + (write "=\r\n") + (r4 = 5) + (write-read-repeat r0)))) + ;; r0:r3=CR + ((if ((r6 > 73) & r5) + ((r6 = 0) + (r5 = 0) + (write "=\r\n"))) + (break)))) + ;; r0:r3={RAW,ENC,CR} + (loop + (if (r0 == ?\r) + ;; r0=\r:r3=CR + ((r4 = 6) + (read r0) + ;; CR:r3=CR r0 + (if (r0 == ?\n) + ;; CR:r3=CR r0=LF + (if r5 + ;; r5=WSP ; CR:r3=CR r0=LF + ((r6 = 0) + (r5 = 0) + (write "=\r\n\r\n") + (r4 = 7) + (read r0) + (break)) + ;; r5=noWSP ; CR:r3=CR r0=LF + ((r6 = 0) + (r5 = 0) + (write "\r\n") + (r4 = 8) + (read r0) + (break))) + ;; CR:r3=CR r0=noLF + (if (r6 < 73) + ((r6 += 3) + (r5 = 0) + (write "=0D") + (break)) + (if (r6 == 73) + (if (r0 == ?\r) + ;; CR:r3=CR r0=CR + ((r4 = 9) + (read r0) + ;; CR:r3=CR CR r0 + (if (r0 == ?\n) + ;; CR:r3=CR CR LF + ((r6 = 0) + (r5 = 0) + (write "=0D\r\n") + (r4 = 10) + (read r0) + (break)) + ;; CR:r3=CR CR noLF + ((r6 = 6) + (r5 = 0) + (write "=\r\n=0D=0D") + (break)))) + ;; CR:r3=CR r0=noLFnorCR + ((r6 = 3) + (r5 = 0) + (write "=\r\n=0D") + (break))) + ((r6 = 3) + (r5 = 0) + (write "=\r\n=0D") + (break)))))) + ;; r0:r3={RAW,ENC} + ((r4 = 11) + (read r1) + ;; r0:r3={RAW,ENC} r1 + (if (r1 == ?\r) + ;; r0:r3={RAW,ENC} r1=CR + ((r4 = 12) + (read r1) + ;; r0:r3={RAW,ENC} CR r1 + (if (r1 == ?\n) + ;; r0:r3={RAW,ENC} CR r1=LF + ((r6 = 0) + (r5 = 0) + (branch + r3 + ;; r0:r3=RAW CR r1=LF + ((write r0) + (write "\r\n") + (r4 = 13) + (read r0) + (break)) + ;; r0:r3=ENC CR r1=LF + ((write ?=) + (write r0 ,ew-ccl-high-table) + (write r0 ,ew-ccl-low-table) + (write "\r\n") + (r4 = 14) + (read r0) + (break)))) + ;; r0:r3={RAW,ENC} CR r1=noLF + ((branch + r3 + ;; r0:r3=RAW CR r1:noLF + ((r6 = 4) + (r5 = 0) + (write "=\r\n") + (write r0) + (write "=0D") + (r0 = r1) + (break)) + ;; r0:r3=ENC CR r1:noLF + ((r6 = 6) + (r5 = 0) + (write "=\r\n=") + (write r0 ,ew-ccl-high-table) + (write r0 ,ew-ccl-low-table) + (write "=0D") + (r0 = r1) + (break)))) + )) + ;; r0:r3={RAW,ENC} r1:noCR + ((branch + r3 + ;; r0:r3=RAW r1:noCR + ((r6 = 1) + (r5 = 0) + (write "=\r\n") + (write r0) + (r0 = r1) + (break)) + ;; r0:r3=ENC r1:noCR + ((r6 = 3) + (r5 = 0) + (write "=\r\n=") + (write r0 ,ew-ccl-high-table) + (write r0 ,ew-ccl-low-table) + (r0 = r1) + (break)))))))) + (repeat))) + (;(write "[EOF:") (write r4 ,ew-ccl-high-table) (write r4 ,ew-ccl-low-table) (write "]") + (branch + r4 + ;; 0: (start) ; + (end) + ;; 1: RAW ; + (end) + ;; 2: r0:r3=ENC ; + (end) + ;; 3: SOFTBREAK r0:r3=ENC ; + (end) + ;; 4: r0:r3=WSP ; + ((write "=\r\n") (end)) + ;; 5: SOFTBREAK r0:r3=WSP ; + ((write "=\r\n") (end)) + ;; 6: ; r0=\r:r3=CR + (if (r6 <= 73) + ((write "=0D") (end)) + ((write "=\r\n=0D") (end))) + ;; 7: r5=WSP SOFTBREAK CR:r3=CR r0=LF ; + (end) + ;; 8: r5=noWSP CR:r3=CR r0=LF ; + (end) + ;; 9: (r6=73) ; CR:r3=CR r0=CR + ((write "=\r\n=0D=0D") (end)) + ;; 10: (r6=73) CR:r3=CR CR LF ; + (end) + ;; 11: ; r0:r3={RAW,ENC} + (branch + r3 + ((write r0) (end)) + ((write "=") + (write r0 ,ew-ccl-high-table) + (write r0 ,ew-ccl-low-table) + (end))) + ;; 12: ; r0:r3={RAW,ENC} r1=CR + (branch + r3 + ((write "=\r\n") + (write r0) + (write "=0D") + (end)) + ((write "=\r\n=") + (write r0 ,ew-ccl-high-table) + (write r0 ,ew-ccl-low-table) + (write "=0D") + (end))) + ;; 13: r0:r3=RAW CR LF ; + (end) + ;; 14: r0:r3=ENC CR LF ; + (end) + )) + )) (define-ccl-program ew-ccl-decode-quoted-printable - (eval-when-compile - `(1 - ((read r0) - (loop - (branch - r0 - ,@(mapcar - (lambda (r0) - (let ((tmp (aref ew-ccl-qp-table r0))) - (cond - ((or (eq tmp 'raw) (eq tmp 'wsp)) `(write-read-repeat r0)) - ((eq r0 ?=) - ;; r0='=' - `((read r0) - ;; '=' r0 - (r1 = (r0 == ?\t)) - (if ((r0 == ? ) | r1) - ;; '=' r0:[\t ] - ;; Skip transport-padding. - ;; It should check CR LF after - ;; transport-padding. - (loop - (read-if (r0 == ?\t) - (repeat) - (if (r0 == ? ) - (repeat) - (break))))) - ;; '=' [\t ]* r0:[^\t ] - (branch - r0 - ,@(mapcar - (lambda (r0) - (cond - ((eq r0 ?\r) - ;; '=' [\t ]* r0='\r' - `((read r0) - ;; '=' [\t ]* '\r' r0 - (if (r0 == ?\n) - ;; '=' [\t ]* '\r' r0='\n' - ;; soft line break found. - ((read r0) - (repeat)) - ;; '=' [\t ]* '\r' r0:[^\n] - ;; invalid input -> - ;; output "=\r" and rescan from r0. - ((write "=\r") - (repeat))))) - ((setq tmp (nth r0 ew-ccl-256-to-16-table)) - ;; '=' [\t ]* r0:[0-9A-F] - `(r0 = ,tmp)) - (t - ;; '=' [\t ]* r0:[^\r0-9A-F] - ;; invalid input -> - ;; output "=" and rescan from r0. - `((write ?=) - (repeat))))) - ew-ccl-256-table)) - ;; '=' [\t ]* r0:[0-9A-F] - (read-branch - r1 - ,@(mapcar - (lambda (r1) - (if (setq tmp (nth r1 ew-ccl-256-to-16-table)) - ;; '=' [\t ]* [0-9A-F] r1:[0-9A-F] - `(write-read-repeat - r0 - ,(vconcat - (mapcar - (lambda (r0) - (logior (lsh r0 4) tmp)) - ew-ccl-16-table))) - ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F] - ;; invalid input - `(r2 = 0) ; nop - )) - ew-ccl-256-table)) - ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F] - ;; invalid input - (write ?=) - (write r0 ,(vconcat ew-ccl-16-to-256-table)) - (write r1) - (read r0) - (repeat))) - ((eq tmp 'cr) - ;; r0='\r' - `((read r0) - ;; '\r' r0 - (if (r0 == ?\n) - ;; '\r' r0='\n' - ;; hard line break found. - ((write ?\r) - (write-read-repeat r0)) - ;; '\r' r0:[^\n] - ;; invalid control character (bare CR) found. - ;; -> ignore it and rescan from r0. - (repeat)))) - (t - ;; r0:[^\t\r -~] - ;; invalid character found. - ;; -> ignore. - `((read r0) - (repeat)))))) - ew-ccl-256-table))))))) + `(1 + ((read r0) + (loop + (branch + r0 + ,@(mapcar + (lambda (r0) + (let ((tmp (aref ew-ccl-qp-table r0))) + (cond + ((or (eq tmp 'raw) (eq tmp 'wsp)) `(write-read-repeat r0)) + ((eq r0 ?=) + ;; r0='=' + `((read r0) + ;; '=' r0 + (r1 = (r0 == ?\t)) + (if ((r0 == ? ) | r1) + ;; '=' r0:[\t ] + ;; Skip transport-padding. + ;; It should check CR LF after + ;; transport-padding. + (loop + (read-if (r0 == ?\t) + (repeat) + (if (r0 == ? ) + (repeat) + (break))))) + ;; '=' [\t ]* r0:[^\t ] + (branch + r0 + ,@(mapcar + (lambda (r0) + (cond + ((eq r0 ?\r) + ;; '=' [\t ]* r0='\r' + `((read r0) + ;; '=' [\t ]* '\r' r0 + (if (r0 == ?\n) + ;; '=' [\t ]* '\r' r0='\n' + ;; soft line break found. + ((read r0) + (repeat)) + ;; '=' [\t ]* '\r' r0:[^\n] + ;; invalid input -> + ;; output "=\r" and rescan from r0. + ((write "=\r") + (repeat))))) + ((setq tmp (nth r0 ew-ccl-256-to-16-table)) + ;; '=' [\t ]* r0:[0-9A-F] + `(r0 = ,tmp)) + (t + ;; '=' [\t ]* r0:[^\r0-9A-F] + ;; invalid input -> + ;; output "=" and rescan from r0. + `((write ?=) + (repeat))))) + ew-ccl-256-table)) + ;; '=' [\t ]* r0:[0-9A-F] + (read-branch + r1 + ,@(mapcar + (lambda (r1) + (if (setq tmp (nth r1 ew-ccl-256-to-16-table)) + ;; '=' [\t ]* [0-9A-F] r1:[0-9A-F] + `(write-read-repeat + r0 + ,(vconcat + (mapcar + (lambda (r0) + (logior (lsh r0 4) tmp)) + ew-ccl-16-table))) + ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F] + ;; invalid input + `(r2 = 0) ; nop + )) + ew-ccl-256-table)) + ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F] + ;; invalid input + (write ?=) + (write r0 ,(vconcat ew-ccl-16-to-256-table)) + (write r1) + (read r0) + (repeat))) + ((eq tmp 'cr) + ;; r0='\r' + `((read r0) + ;; '\r' r0 + (if (r0 == ?\n) + ;; '\r' r0='\n' + ;; hard line break found. + ((write ?\r) + (write-read-repeat r0)) + ;; '\r' r0:[^\n] + ;; invalid control character (bare CR) found. + ;; -> ignore it and rescan from r0. + (repeat)))) + (t + ;; r0:[^\t\r -~] + ;; invalid character found. + ;; -> ignore. + `((read r0) + (repeat)))))) + ew-ccl-256-table)))))) ;;; -(ew-make-ccl-coding-system +(make-ccl-coding-system 'ew-ccl-uq ?Q "MIME Q-encoding in unstructured field" 'ew-ccl-decode-q 'ew-ccl-encode-uq) -(ew-make-ccl-coding-system +(make-ccl-coding-system 'ew-ccl-cq ?Q "MIME Q-encoding in comment" 'ew-ccl-decode-q 'ew-ccl-encode-cq) -(ew-make-ccl-coding-system +(make-ccl-coding-system 'ew-ccl-pq ?Q "MIME Q-encoding in phrase" 'ew-ccl-decode-q 'ew-ccl-encode-pq) -(ew-make-ccl-coding-system +(make-ccl-coding-system 'ew-ccl-b ?B "MIME B-encoding" 'ew-ccl-decode-b 'ew-ccl-encode-b) -(ew-make-ccl-coding-system +(make-ccl-coding-system 'ew-ccl-quoted-printable ?Q "MIME Quoted-Printable-encoding" 'ew-ccl-decode-quoted-printable 'ew-ccl-encode-quoted-printable) -(ew-make-ccl-coding-system +(make-ccl-coding-system 'ew-ccl-base64 ?B "MIME Base64-encoding" 'ew-ccl-decode-b 'ew-ccl-encode-base64) @@ -926,7 +884,7 @@ (defun ew-decode-q (str) (string-as-unibyte (decode-coding-string str 'ew-ccl-uq)))) -(if (or ew-bq-use-mel base64-dl-module ew-ccl-untrusted-eof-block) +(if (or ew-bq-use-mel base64-dl-module ccl-encoder-eof-block-is-broken) (defalias 'ew-encode-b 'base64-encode-string) (defun ew-encode-b (str) (encode-coding-string (string-as-unibyte str) 'ew-ccl-b))) diff --git a/ew-var.el b/ew-var.el index 8fa7549..7b53b7f 100644 --- a/ew-var.el +++ b/ew-var.el @@ -50,6 +50,7 @@ (path ew-scan-unibyte-none) (lines ew-scan-unibyte-none) (xref ew-scan-unibyte-none) + (followup-to ew-scan-unibyte-none) )) (defvar ew-decode-field-default-syntax '(ew-scan-unibyte-unstructured)) -- 1.7.10.4