-;;; mel-ccl.el: CCL based encoder/decoder of Quoted-Printable
-;;; and Q-encoding
+;;; mel-q-ccl.el --- Quoted-Printable encoder/decoder using CCL.
-;; Copyright (C) 1998 Tanaka Akira
+;; Copyright (C) 1998,1999 Tanaka Akira
;; Author: Tanaka Akira <akr@jaist.ac.jp>
;; Created: 1998/9/17
;; General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with this program; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Code:
0 1 2 3 4 5 6 7 8 9 nil nil nil nil nil nil
nil 10 11 12 13 14 15 nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
- nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
+ nil 10 11 12 13 14 15 nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
(define-ccl-program mel-ccl-decode-q
`(1
((loop
- (read-branch
- r0
+ (read r0)
+ (branch
+ (r0 & 255)
,@(mapcar
(lambda (r0)
(cond
`(3
(loop
(loop
- (read-branch
+ (read r0)
+ (r0 &= 255)
+ (branch
r0
,@(mapcar
(lambda (r0)
(eval-when-compile
-(defun mel-ccl-try-to-read-crlf (input-crlf reg eof-reg cr-eof lf-eof crlf-eof succ fail-cr fail-lf fail-crlf)
+(defvar eof-block-branches)
+(defvar eof-block-reg)
+(defun mel-ccl-set-eof-block (branch)
+ (let ((p (assoc branch eof-block-branches)))
+ (unless p
+ (setq p (cons branch (length eof-block-branches))
+ eof-block-branches (cons p eof-block-branches)))
+ `(,eof-block-reg = ,(cdr p))))
+
+)
+
+(eval-when-compile
+
+(defun mel-ccl-try-to-read-crlf (input-crlf reg
+ succ
+ cr-eof cr-fail
+ lf-eof lf-fail
+ crlf-eof crlf-fail)
(if input-crlf
- `((,eof-reg = ,cr-eof) (read-if (,reg == ?\r)
- ((,eof-reg = ,lf-eof) (read-if (,reg == ?\n)
- ,succ
- ,fail-lf))
- ,fail-cr))
- `((,eof-reg = ,crlf-eof) (read-if (,reg == ?\n)
- ,succ
- ,fail-crlf))))
+ `(,(mel-ccl-set-eof-block cr-eof)
+ (read-if (,reg == ?\r)
+ (,(mel-ccl-set-eof-block lf-eof)
+ (read-if (,reg == ?\n)
+ ,succ
+ ,lf-fail))
+ ,cr-fail))
+ `(,(mel-ccl-set-eof-block crlf-eof)
+ (read-if (,reg == ?\n)
+ ,succ
+ ,crlf-fail))))
+
+)
+
+(eval-when-compile
;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
;; is not executed.
(defun mel-ccl-encode-quoted-printable-generic (input-crlf output-crlf)
- `(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 mel-ccl-qp-table r0)))
- (cond
- ((eq r0 (char-int ?F))
- `(if (r6 == 0)
- ((r4 = 15) (read-if (r0 == ?r)
- ((r4 = 16) (read-if (r0 == ?o)
- ((r4 = 17) (read-if (r0 == ?m)
- ((r4 = 18) (read-if (r0 == ? )
- ((r6 = 7)
- (r5 = 1)
- (write "=46rom ")
- (r4 = 19)
- (read r0)
- (repeat))
- ((r6 = 4)
- (write-repeat "From"))))
- ((r6 = 3)
- (write-repeat "Fro"))))
- ((r6 = 2)
- (write-repeat "Fr"))))
- ((r6 = 1)
- (write-repeat "F"))))
- ((r3 = 0) (break)) ; RAW
- ))
- ((eq r0 (char-int ?.))
- `(if (r6 == 0)
- ,(mel-ccl-try-to-read-crlf
- input-crlf
- 'r0 'r4 20 21 22
- `((write ,(if output-crlf "=2E\r\n" "=2E\n"))
- (r4 = 23)
- (read r0)
- (repeat))
- '((r6 = 1)
- (write-repeat "."))
- '((r6 = 4)
- (write-repeat ".=0D"))
- '((r6 = 1)
- (write-repeat ".")))
- ((r3 = 0) (break)) ; RAW
- ))
- ((eq tmp 'raw) '((r3 = 0) (break))) ; RAW
- ((eq tmp 'enc) '((r3 = 1) (break))) ; ENC
- ((eq tmp 'wsp) '((r3 = 2) (break))) ; WSP
- ((eq tmp 'cr) (if input-crlf
- '((r3 = 3) (break)) ; CR
- '((r3 = 1) (break)))) ; ENC
- ((eq tmp 'lf) (if input-crlf
- '((r3 = 1) (break)) ; ENC
- '((r3 = 3) (break)))) ; CRLF
- )))
- mel-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 ,mel-ccl-high-table)
- (r4 = 2)
- (write-read-repeat r0 ,mel-ccl-low-table))
- (if (r6 > 73)
- ((r6 = 3)
- (write ,(if output-crlf "=\r\n=" "=\n="))
- (write r0 ,mel-ccl-high-table)
- (r4 = 3)
- (write-read-repeat r0 ,mel-ccl-low-table))
- (break))))
- ;; r0:r3=WSP
- ((r5 = 1)
- (if (r6 < 75)
- ((r6 += 1)
- (r4 = 4)
- (write-read-repeat r0))
- ((r6 = 1)
- (write ,(if output-crlf "=\r\n" "=\n"))
- (r4 = 5)
- (write-read-repeat r0))))
- ;; r0:r3=CR/CRLF
- ,(if input-crlf
- ;; r0:r3=CR
- `((if ((r6 > 73) & r5)
- ((r6 = 0)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n" "=\n"))))
- (break))
- ;; r0:r3=CRLF
- `(if r5
- ;; WSP ; r0:r3=CRLF
- ((r5 = 0)
- (r6 = 0)
- (write ,(if output-crlf "=\r\n" "=\n"))
- ,@(if output-crlf '((write ?\r)) '())
- (r4 = 0)
- (write-read-repeat r0))
- ;; noWSP ; r0:r3=CRLF
- ((r5 = 0)
- (r6 = 0)
- ,@(if output-crlf '((write ?\r)) '())
- (r4 = 0)
- (write-read-repeat r0)))
- )))
- ;; r0:r3={RAW,ENC,CR}
- (loop
- ,(funcall
- (lambda (after-cr after-raw-enc)
- (if input-crlf
- `(if (r0 == ?\r)
- ,after-cr
- ,after-raw-enc)
- after-raw-enc))
- ;; 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 ,(if output-crlf "=\r\n\r\n" "=\n\n"))
- (r4 = 7)
- (read r0)
- (break))
- ;; r5=noWSP ; CR:r3=CR r0=LF
- ((r6 = 0)
- (r5 = 0)
- (write ,(if output-crlf "\r\n" "\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 ,(if output-crlf "=0D\r\n" "=0D\n"))
- (r4 = 10)
- (read r0)
- (break))
- ;; CR:r3=CR CR noLF
- ((r6 = 6)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=0D=0D" "=\n=0D=0D"))
- (break))))
- ;; CR:r3=CR r0=noLFnorCR
- ((r6 = 3)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
- (break)))
- ((r6 = 3)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=0D" "=\n=0D"))
- (break))))))
- (funcall
- (lambda (after-newline after-cr-nolf after-nonewline)
- (if input-crlf
- ;; 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 CR r1=LF
- ,after-newline
- ;; r0:r3=RAW CR r1=noLF
- ,after-cr-nolf))
- ;; r0:r3={RAW,ENC} r1:noCR
- ,after-nonewline))
- ;; r0:r3={RAW,ENC}
- `((r4 = 11)
- (read r1)
- ;; r0:r3={RAW,ENC} r1
- (if (r1 == ?\n)
- ;; r0:r3={RAW,ENC} r1=CRLF
- ,after-newline
- ;; r0:r3={RAW,ENC} r1:noCRLF
- ,after-nonewline))))
- ;; r0:r3={RAW,ENC} CR r1=LF
- ;; r0:r3={RAW,ENC} r1=CRLF
- `((r6 = 0)
- (r5 = 0)
- (branch
- r3
- ;; r0:r3=RAW CR r1=LF
- ;; r0:r3=RAW r1=CRLF
- ((write r0)
- (write ,(if output-crlf "\r\n" "\n"))
- (r4 = 13)
- (read r0)
- (break))
- ;; r0:r3=ENC CR r1=LF
- ;; r0:r3=ENC r1=CRLF
- ((write ?=)
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (write ,(if output-crlf "\r\n" "\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 ,(if output-crlf "=\r\n" "=\n"))
- (write r0)
- (write "=0D")
- (r0 = r1)
- (break))
- ;; r0:r3=ENC CR r1:noLF
- ((r6 = 6)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=" "=\n="))
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (write "=0D")
- (r0 = r1)
- (break))))
- ;; r0:r3={RAW,ENC} r1:noCR
- ;; r0:r3={RAW,ENC} r1:noCRLF
- `((branch
- r3
- ;; r0:r3=RAW r1:noCR
- ;; r0:r3=RAW r1:noCRLF
- ((r6 = 1)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n" "=\n"))
- (write r0)
- (r0 = r1)
- (break))
- ;; r0:r3=ENC r1:noCR
- ;; r0:r3=ENC r1:noCRLF
- ((r6 = 3)
- (r5 = 0)
- (write ,(if output-crlf "=\r\n=" "=\n="))
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (r0 = r1)
- (break)))))))
- (repeat)))
- ;; EOF
- ( ;(write "[EOF:") (write r4 ,mel-ccl-high-table) (write r4 ,mel-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 ,(if output-crlf "=\r\n" "=\n")) (end))
- ;; 5: SOFTBREAK r0:r3=WSP ;
- ((write ,(if output-crlf "=\r\n" "=\n")) (end))
- ;; 6: ; r0=\r:r3=CR
- (if (r6 <= 73)
- ((write "=0D") (end))
- ((write ,(if output-crlf "=\r\n=0D" "=\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 ,(if output-crlf "=\r\n=0D=0D" "=\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 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (end)))
- ;; 12: ; r0:r3={RAW,ENC} r1=CR
+ (let ((hard (if output-crlf "\r\n" "\n"))
+ (soft (if output-crlf "=\r\n" "=\n"))
+ (eof-block-branches nil)
+ (eof-block-reg 'r4)
+ (after-wsp 'r5)
+ (column 'r6)
+ (type 'r3)
+ (current 'r0)
+ (type-raw 0)
+ (type-enc 1)
+ (type-wsp 2)
+ (type-brk 3)
+ )
+ `(4
+ ((,column = 0)
+ (,after-wsp = 0)
+ ,(mel-ccl-set-eof-block '(end))
+ (read r0)
+ (loop ; invariant: column <= 75
+ (loop
+ (loop
+ (r0 &= 255)
+ (branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (let ((tmp (aref mel-ccl-qp-table r0)))
+ (cond
+ ((eq r0 (char-int ?F))
+ `(if (,column == 0)
+ (,(mel-ccl-set-eof-block '((write "F") (end)))
+ (read-if (r0 == ?r)
+ (,(mel-ccl-set-eof-block '((write "Fr") (end)))
+ (read-if (r0 == ?o)
+ (,(mel-ccl-set-eof-block '((write "Fro") (end)))
+ (read-if (r0 == ?m)
+ (,(mel-ccl-set-eof-block '((write "From") (end)))
+ (read-if (r0 == ? )
+ ((,column = 7)
+ (,after-wsp = 1)
+ ,(mel-ccl-set-eof-block '((write "From=20") (end)))
+ (read r0)
+ (write-repeat "=46rom "))
+ ((,column = 4)
+ (write-repeat "From"))))
+ ((,column = 3)
+ (write-repeat "Fro"))))
+ ((,column = 2)
+ (write-repeat "Fr"))))
+ ((,column = 1)
+ (write-repeat "F"))))
+ ((,type = ,type-raw) (break)) ; RAW
+ ))
+ ((eq r0 (char-int ?.))
+ `(if (,column == 0)
+ ,(mel-ccl-try-to-read-crlf
+ input-crlf 'r0
+ ;; "." CR LF (input-crlf: t)
+ ;; "." LF (input-crlf: nil)
+ `((write ,(concat "=2E" hard))
+ ,(mel-ccl-set-eof-block '(end))
+ (read r0)
+ (repeat))
+ ;; "." <EOF>
+ '((write ".") (end))
+ ;; "." noCR (input-crlf: t)
+ `((,column = 1)
+ (write-repeat "."))
+ ;; "." CR <EOF> (input-crlf: t)
+ '((write ".=0D") (end))
+ ;; "." CR noLF (input-crlf: t)
+ `((,column = 4)
+ (write-repeat ".=0D"))
+ ;; "." <EOF> (input-crlf: nil)
+ '((write ".") (end))
+ ;; "." noLF (input-crlf: nil)
+ `((,column = 1)
+ (write-repeat ".")))
+ ((,type = ,type-raw) (break)) ; RAW
+ ))
+ ((eq tmp 'raw) `((,type = ,type-raw) (break)))
+ ((eq tmp 'enc) `((,type = ,type-enc) (break)))
+ ((eq tmp 'wsp) `((,type = ,type-wsp) (break)))
+ ((eq tmp 'cr) `((,type = ,(if input-crlf type-brk type-enc))
+ (break)))
+ ((eq tmp 'lf) `((,type = ,(if input-crlf type-enc type-brk))
+ (break)))
+ )))
+ mel-ccl-256-table)))
+ ;; r0:type{raw,enc,wsp,brk}
+ (branch
+ ,type
+ ;; r0:type-raw
+ (if (,column < 75)
+ ((,column += 1)
+ (,after-wsp = 0)
+ ,(mel-ccl-set-eof-block '(end))
+ (write-read-repeat r0))
+ ((r1 = (r0 + 0))
+ (,after-wsp = 0)
+ ,@(mel-ccl-try-to-read-crlf
+ input-crlf 'r0
+ `((,column = 0)
+ (write r1)
+ ,(mel-ccl-set-eof-block `((write ,hard) (end)))
+ (read r0)
+ (write-repeat ,hard))
+ '((write r1) (end))
+ `((,column = 1)
+ (write ,soft) (write-repeat r1))
+ `((write ,soft) (write r1) (write "=0D") (end))
+ `((,column = 4)
+ (write ,soft) (write r1) (write-repeat "=0D"))
+ '((write r1) (end))
+ `((,column = 1)
+ (write ,soft) (write-repeat r1)))))
+ ;; r0:type-enc
+ ((,after-wsp = 0)
+ (if (,column < 73)
+ ((,column += 3)
+ (write "=")
+ (write r0 ,mel-ccl-high-table)
+ ,(mel-ccl-set-eof-block '(end))
+ (write-read-repeat r0 ,mel-ccl-low-table))
+ (if (,column < 74)
+ ((r1 = (r0 + 0))
+ (,after-wsp = 0)
+ ,@(mel-ccl-try-to-read-crlf
+ input-crlf 'r0
+ `((,column = 0)
+ (write "=")
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (write ,hard)
+ ,(mel-ccl-set-eof-block '(end))
+ (read r0)
+ (repeat))
+ `((write "=")
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (end))
+ `((,column = 3)
+ (write ,(concat soft "="))
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (repeat))
+ `((write ,(concat soft "="))
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (write "=0D")
+ (end))
+ `((,column = 6)
+ (write ,(concat soft "="))
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (write-repeat "=0D"))
+ `((write "=")
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (end))
+ `((,column = 3)
+ (write ,(concat soft "="))
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (repeat))))
+ ((,column = 3)
+ (write ,(concat soft "="))
+ (write r0 ,mel-ccl-high-table)
+ ,(mel-ccl-set-eof-block '(end))
+ (write-read-repeat r0 ,mel-ccl-low-table)))))
+ ;; r0:type-wsp
+ (if (,column < 73)
+ ((r1 = (r0 + 0))
+ ,@(mel-ccl-try-to-read-crlf
+ input-crlf 'r0
+ `((,column = 0)
+ (,after-wsp = 0)
+ (write "=")
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (write ,hard)
+ ,(mel-ccl-set-eof-block `(end))
+ (read r0)
+ (repeat))
+ `((write "=")
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (end))
+ `((,column += 1)
+ (,after-wsp = 1)
+ (write-repeat r1))
+ `((write r1)
+ (write "=0D")
+ (end))
+ `((,column += 4)
+ (,after-wsp = 0)
+ (write r1)
+ (write-repeat "=0D"))
+ `((write "=")
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (end))
+ `((,column += 1)
+ (,after-wsp = 1)
+ (write-repeat r1))))
+ (if (,column < 74)
+ ((r1 = (r0 + 0))
+ ,@(mel-ccl-try-to-read-crlf
+ input-crlf 'r0
+ `((,column = 0)
+ (,after-wsp = 0)
+ (write "=")
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (write ,hard)
+ ,(mel-ccl-set-eof-block `(end))
+ (read r0)
+ (repeat))
+ `((write "=")
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (end))
+ `((,column += 1)
+ (,after-wsp = 1)
+ (write-repeat r1))
+ `((write r1)
+ (write ,(concat soft "=0D"))
+ (end))
+ `((,column = 3)
+ (,after-wsp = 0)
+ (write r1)
+ (write-repeat ,(concat soft "=0D")))
+ `((write "=")
+ (write r1 ,mel-ccl-high-table)
+ (write r1 ,mel-ccl-low-table)
+ (end))
+ `((,column += 1)
+ (,after-wsp = 1)
+ (write-repeat r1))))
+ (if (,column < 75)
+ ((,column += 1)
+ (,after-wsp = 1)
+ ,(mel-ccl-set-eof-block `((write ,soft) (end)))
+ (write-read-repeat r0))
+ ((write ,soft)
+ (,column = 0)
+ (,after-wsp = 0)
+ (repeat)))))
+ ;; r0:type-brk
+ ,(if input-crlf
+ ;; r0{CR}:type-brk
+ `((if ((,column > 73) & ,after-wsp)
+ ((,column = 0)
+ (,after-wsp = 0)
+ (write ,soft)))
+ ,(mel-ccl-set-eof-block `((if (,column > 73) (write ,soft))
+ (write "=0D") (end)))
+ (read-if (r0 == ?\n)
+ (if ,after-wsp
+ ((,after-wsp = 0)
+ (,column = 0)
+ (write ,(concat soft hard))
+ ,(mel-ccl-set-eof-block '(end))
+ (read r0)
+ (repeat))
+ ((,after-wsp = 0)
+ (,column = 0)
+ (write ,hard)
+ ,(mel-ccl-set-eof-block '(end))
+ (read r0)
+ (repeat)))
+ (if (,column < 73)
+ ((,after-wsp = 0)
+ (,column += 3)
+ (write-repeat "=0D"))
+ (if (,column < 74)
+ (if (r0 == ?\r)
+ ((,after-wsp = 0)
+ ,(mel-ccl-set-eof-block
+ `((write ,(concat soft "=0D=0D")) (end)))
+ (read-if (r0 == ?\n)
+ ((,column = 0)
+ ,(mel-ccl-set-eof-block
+ `((write ,(concat "=0D" hard)) (end)))
+ (read r0)
+ (write-repeat ,(concat "=0D" hard)))
+ ((,column = 6)
+ (write-repeat ,(concat soft "=0D=0D")))))
+ ((,after-wsp = 0)
+ (,column = 3)
+ (write-repeat ,(concat soft "=0D"))))
+ ((,after-wsp = 0)
+ (,column = 3)
+ (write-repeat ,(concat soft "=0D")))))))
+ ;; r0{LF}:type-brk
+ `(if ,after-wsp
+ ;; WSP ; r0{LF}:type-brk
+ ((,after-wsp = 0)
+ (,column = 0)
+ (write ,(concat soft (if output-crlf "\r" "")))
+ ,(mel-ccl-set-eof-block `(end))
+ (write-read-repeat r0))
+ ;; noWSP ; r0{LF}:type-brk
+ ((,after-wsp = 0)
+ (,column = 0)
+ ,@(if output-crlf '((write ?\r)) '())
+ ,(mel-ccl-set-eof-block `(end))
+ (write-read-repeat r0)))
+ )))))
(branch
- r3
- ;; ; r0:r3=RAW r1=CR
- ((write ,(if output-crlf "=\r\n" "=\n"))
- (write r0)
- (write "=0D")
- (end))
- ;; ; r0:r3=ENC r1=CR
- ((write ,(if output-crlf "=\r\n=" "=\n="))
- (write r0 ,mel-ccl-high-table)
- (write r0 ,mel-ccl-low-table)
- (write "=0D")
- (end)))
- ;; 13: r0:r3=RAW CR LF ;
- ;; 13: r0:r3=RAW CRLF ;
- (end)
- ;; 14: r0:r3=ENC CR LF ;
- ;; 14: r0:r3=ENC CRLF ;
- (end)
- ;; 15: r6=0 ; "F"
- ((write "F") (end))
- ;; 16: r6=0 ; "Fr"
- ((write "Fr") (end))
- ;; 17: r6=0 ; "Fro"
- ((write "Fro") (end))
- ;; 18: r6=0 ; "From"
- ((write "From") (end))
- ;; 19: r6=0 "From " ;
- (end)
- ;; 20: r6=0 ; "."
- ((write ".") (end))
- ;; 21: r6=0 ; ".\r"
- ((write ".=0D") (end))
- ;; 22: r6=0 ; "."
- ((write ".") (end))
- ;; 23: r6=0 ".\r\n" ;
- (end)
- ))
- ))
+ ,eof-block-reg
+ ,@(reverse (mapcar 'car eof-block-branches))))))
(defun mel-ccl-decode-quoted-printable-generic (input-crlf output-crlf)
`(1
((read r0)
(loop
(branch
- r0
+ (r0 & 255)
,@(mapcar
(lambda (r0)
(let ((tmp (aref mel-ccl-qp-table r0)))
((setq tmp (nth r0 mel-ccl-256-to-16-table))
;; '=' [\t ]* r0:[0-9A-F]
;; upper nibble of hexadecimal digit found.
- `((r1 = r0)
+ `((r1 = (r0 + 0))
(r0 = ,tmp)))
(t
;; '=' [\t ]* r0:[^\r0-9A-F]
;; invalid input ->
;; output "=" with hex digit and rescan from r2.
(write ?=)
- (r0 = r2)
+ (r0 = (r2 + 0))
(write-repeat r1)))
(t
;; r0:[^\t\r -~]
;; invalid character found.
- ;; -> ignore.
- `((read r0)
- (repeat))))))
+ ;; -> output as is.
+ `((write-read-repeat r0))))))
mel-ccl-256-table))
;; r1[0]:[\t ]
(loop
(unless-broken ccl-execute-eof-block-on-decoding-some
- (defun quoted-printable-ccl-encode-string (string)
- "Encode STRING with quoted-printable encoding."
- (decode-coding-string
- string
- 'mel-ccl-quoted-printable-lf-lf-rev))
-
- (defun quoted-printable-ccl-encode-region (start end)
- "Encode the region from START to END with quoted-printable encoding."
- (interactive "r")
- (decode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
-
- (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)))
+ (cond
+ ((eval-when-compile
+ (and (eq emacs-major-version 23)
+ (eq emacs-minor-version 1)))
+ (defun quoted-printable-ccl-encode-string (string)
+ "Encode STRING with quoted-printable encoding."
+ (ccl-execute-on-string 'mel-ccl-encode-quoted-printable-lf-lf
+ (make-vector 9 0) string nil t))
+ (defun quoted-printable-ccl-encode-region (start end)
+ "Encode the region from START to END with quoted-printable encoding."
+ (interactive "*r")
+ (save-excursion
+ (goto-char start)
+ (insert (prog1 (quoted-printable-ccl-encode-string
+ (buffer-substring start end))
+ (delete-region start end)))))
+
+ (defun quoted-printable-ccl-insert-encoded-file (filename)
+ "Encode contents of the file named as FILENAME, and insert it."
+ (interactive "*fInsert encoded file: ")
+ (insert
+ (ccl-execute-on-string 'mel-ccl-encode-quoted-printable-lf-lf
+ (make-vector 9 0)
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-as-binary filename)
+ (buffer-string))
+ nil t))))
+ (t
+ (defun quoted-printable-ccl-encode-string (string)
+ "Encode STRING with quoted-printable encoding."
+ (decode-coding-string
+ string
+ 'mel-ccl-quoted-printable-lf-lf-rev))
+
+ (defun quoted-printable-ccl-encode-region (start end)
+ "Encode the region from START to END with quoted-printable encoding."
+ (interactive "*r")
+ (decode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
+
+ (defun quoted-printable-ccl-insert-encoded-file (filename)
+ "Encode contents of the file named as FILENAME, and insert it."
+ (interactive "*fInsert encoded file: ")
+ (insert
+ (decode-coding-string
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert-file-contents-as-binary filename)
+ (buffer-string))
+ 'mel-ccl-quoted-printable-lf-lf-rev)))))
(mel-define-method-function
(mime-encode-string string (nil "quoted-printable"))
'quoted-printable-ccl-insert-encoded-file)
)
-(defun quoted-printable-ccl-decode-string (string)
- "Decode quoted-printable encoded STRING."
- (encode-coding-string
- string
- 'mel-ccl-quoted-printable-lf-lf-rev))
-
-(defun quoted-printable-ccl-decode-region (start end)
- "Decode the region from START to END with quoted-printable
+ (cond
+ ((eval-when-compile
+ (and (eq emacs-major-version 23)
+ (eq emacs-minor-version 1)))
+ (defun quoted-printable-ccl-decode-string (string)
+ "Decode quoted-printable encoded STRING."
+ (ccl-execute-on-string 'mel-ccl-decode-quoted-printable-lf-lf
+ (make-vector 9 0) string nil t))
+
+ (defun quoted-printable-ccl-decode-region (start end)
+ "Decode the region from START to END with quoted-printable
+encoding."
+ (interactive "*r")
+ (save-excursion
+ (goto-char start)
+ (insert (prog1 (quoted-printable-ccl-decode-string
+ (buffer-substring start end))
+ (delete-region start end)))))
+
+ (defun quoted-printable-ccl-write-decoded-region (start end filename)
+ "Decode quoted-printable encoded current region and write out to FILENAME."
+ (interactive "*r\nFWrite decoded region to file: ")
+ (let ((string (quoted-printable-ccl-decode-string
+ (buffer-substring start end)))
+ (coding-system-for-write 'binary)
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (with-temp-file filename
+ (insert string)))))
+ (t
+ (defun quoted-printable-ccl-decode-string (string)
+ "Decode quoted-printable encoded STRING."
+ (encode-coding-string
+ string
+ 'mel-ccl-quoted-printable-lf-lf-rev))
+
+ (defun quoted-printable-ccl-decode-region (start end)
+ "Decode the region from START to END with quoted-printable
encoding."
- (interactive "r")
- (encode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
-
-(defun quoted-printable-ccl-write-decoded-region
- (start end filename)
- "Decode quoted-printable encoded current region and write out to FILENAME."
- (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)))
+ (interactive "*r")
+ (encode-coding-region start end 'mel-ccl-quoted-printable-lf-lf-rev))
+
+ (defun quoted-printable-ccl-write-decoded-region (start end filename)
+ "Decode quoted-printable encoded current region and write out to FILENAME."
+ (interactive "*r\nFWrite decoded region to file: ")
+ (let ((coding-system-for-write
+ (if (coding-system-p 'mel-ccl-quoted-printable-lf-lf-rev-unix)
+ 'mel-ccl-quoted-printable-lf-lf-rev-unix
+ 'mel-ccl-quoted-printable-lf-lf-rev))
+ jka-compr-compression-info-list jam-zcat-filename-list)
+ (write-region start end filename)))))
(mel-define-method-function
(mime-decode-string string (nil "quoted-printable"))
;;; @ Q
;;;
-(defun q-encoding-ccl-encode-string (string &optional mode)
- "Encode STRING to Q-encoding of encoded-word, and return the result.
+ (cond
+ ((eval-when-compile
+ (and (eq emacs-major-version 23)
+ (eq emacs-minor-version 1)))
+ (defun q-encoding-ccl-encode-string (string &optional mode)
+ "Encode STRING to Q-encoding of encoded-word, and return the result.
+MODE allows `text', `comment', `phrase' or nil. Default value is
+`phrase'."
+ (ccl-execute-on-string
+ (cond
+ ((eq mode 'text) 'mel-ccl-encode-uq)
+ ((eq mode 'comment) 'mel-ccl-encode-cq)
+ (t 'mel-ccl-encode-pq))
+ (make-vector 9 0) string nil t))
+
+ (defun q-encoding-ccl-decode-string (string)
+ "Decode Q encoded STRING and return the result."
+ (ccl-execute-on-string 'mel-ccl-decode-q
+ (make-vector 9 0) string nil t)))
+ (t
+ (defun q-encoding-ccl-encode-string (string &optional mode)
+ "Encode STRING to Q-encoding of encoded-word, and return the result.
MODE allows `text', `comment', `phrase' or nil. Default value is
`phrase'."
- (decode-coding-string
- string
- (cond
- ((eq mode 'text) 'mel-ccl-uq-rev)
- ((eq mode 'comment) 'mel-ccl-cq-rev)
- (t 'mel-ccl-pq-rev))))
-
-(defun q-encoding-ccl-decode-string (string)
- "Decode Q encoded STRING and return the result."
- (encode-coding-string
- string
- 'mel-ccl-uq-rev))
+ (decode-coding-string
+ string
+ (cond
+ ((eq mode 'text) 'mel-ccl-uq-rev)
+ ((eq mode 'comment) 'mel-ccl-cq-rev)
+ (t 'mel-ccl-pq-rev))))
+
+ (defun q-encoding-ccl-decode-string (string)
+ "Decode Q encoded STRING and return the result."
+ (encode-coding-string
+ string
+ 'mel-ccl-uq-rev))))
(unless (featurep 'xemacs)
(defun q-encoding-ccl-encoded-length (string &optional mode)
(let ((status [nil nil nil nil nil nil nil nil nil]))
- (fillarray status nil)
+ (fillarray status nil) ; XXX: Is this necessary?
(ccl-execute-on-string
(cond
((eq mode 'text) 'mel-ccl-count-uq)
'q-encoding-ccl-encode-string)
(mel-define-method encoded-text-decode-string (string (nil "Q"))
- (if (and (string-match Q-encoded-text-regexp string)
- (string= string (match-string 0 string)))
+ (if (string-match (eval-when-compile
+ (concat "\\`" Q-encoded-text-regexp "\\'"))
+ string)
(q-encoding-ccl-decode-string string)
(error "Invalid encoded-text %s" string)))
(provide 'mel-q-ccl)
-;;; mel-q-ccl.el ends here
+;;; mel-q-ccl.el ends here.
projects / elisp / flim.git / blobdiff