1998-08-28 Tanaka Akira <akr@jaist.ac.jp>
+ * ew-dec.el (ew-decode-field-test): Change column.
+
+ * eword-encode.el (ew-decode-field-test): Sync up to 1.9 from
+ 1.3.
+ (eword-encode-field): Add `In-Reply-To' to structured field.
+
+ * mel-b.el:
+ - Move `base64-internal-encoding-limit',
+ `base64-internal-decoding-limit', `base64-encode-region',
+ `base64-decode-region', `base64-encode-string' and
+ `base64-decode-string'
+ to mel.el.
+ (base64-internal-encode-string): Renamed from
+ `base64-encode-string'.
+ (base64-external-write-decoded-region): Renamed from
+ `base64-write-decoded-region'.
+ (base64-internal-encoded-length): Renamed from
+ `base64-encoded-length'
+
+ * mel-dl.el:
+ - Move `base64-encode-string' and `base64-decode-string' to
+ mel.el.
+ (base64-dl-encode-string): New alias for `encode-base64-string'.
+ (base64-dl-decode-string): New alias for `decode-base64-string'.
+ (base64-dl-encode-region): Renamed from `base64-encode-region'.
+ (base64-dl-decode-region): Renamed from `base64-decode-region'.
+ (base64-external-encoder): Abolished.
+ (base64-external-decoder): Abolished.
+ (base64-external-decoder-option-to-specify-file): Abolished.
+ (base64-insert-encoded-file): Abolished.
+ (base64-write-decoded-region): Abolished.
+ (base64-base64-encoded-length): Abolished.
+
+ * mel-g.el:
+ - Move `gzip64-encode-region' and `gzip64-decode-region' to
+ mel.el.
+ (gzip64-external--insert-encoded-file): Renamed from
+ `gzip64-insert-encoded-file'.
+ (gzip64-external-write-decoded-region): Renamed from
+ `gzip64-write-decoded-region'.
+
+ *mel-q.el:
+ - Move `quoted-printable-internal-encoding-limit',
+ `quoted-printable-encode-region',
+ `quoted-printable-internal-decoding-limit' and
+ `quoted-printable-decode-region' to mel.el
+ (quoted-printable-encode-string): Abolished.
+ (quoted-printable-internal-encode-string): New function.
+ (quoted-printable-external-encode-string): New function.
+ (quoted-printable-external-insert-encoded-file): Renamed from
+ `quoted-printable-insert-encoded-file'.
+ (quoted-printable-decode-string): Abolished.
+ (quoted-printable-internal-decode-string): New function.
+ (quoted-printable-external-decode-string): New function.
+ (quoted-printable-external-write-decoded-region): Renamed from
+ `quoted-printable-write-decoded-region'.
+ (q-encoding-internal-encode-string): Renamed from
+ `q-encoding-encode-string'.
+ (q-encoding-internal-decode-string): Renamed from
+ `q-encoding-decode-string'.
+ (q-encoding-internal-encoded-length): Renamed from
+ `q-encoding-encoded-length'.
+
+ * mel-u.el:
+ - Move `uuencode-encode-region', `uuencode-decode-region' to
+ mel.el.
+ (uuencode-external-insert-encoded-file): Renamed from
+ `uuencode-insert-encoded-file'.
+ (uuencode-external-write-decoded-region): Renamed from
+ `uuencode-write-decoded-region'.
+
+ * mel.el: Autoloading Restructured.
+ (base64-internal-encoding-limit): Moved from mel-b.el.
+ (base64-internal-decoding-limit): Moved from mel-b.el.
+ (quoted-printable-internal-encoding-limit): Moved from mel-q.el.
+ (quoted-printable-internal-decoding-limit): Moved from mel-q.el.
+
+1998-08-28 Tanaka Akira <akr@jaist.ac.jp>
+
* ew-dec.el (ew-decode-field-test): Print sequence of fragments
if prefix argument exists.
;;; Code:
(setq flim-modules '(mime-def
- mel mel-dl mel-b mel-q mel-u mel-g
+ mel mel-dl mel-ccl mel-b mel-q mel-u mel-g
closure
natset
digraph
(when current-prefix-arg
(mapcar
(lambda (frag)
- (insert (format "%-16s %S\n"
- (get frag 'type)
+ (insert (format "%-15s %S\n"
+ (substring (symbol-name (get frag 'type)) 3)
(symbol-name frag)))
nil)
(ew-frag-list (ew-analyze-field-to-decode field-name field-body)))
;;; @ rule
;;;
-(defmacro tm-eword::make-rword (text charset encoding type)
+(defmacro make-ew-rword (text charset encoding type)
(` (list (, text)(, charset)(, encoding)(, type))))
-(defmacro tm-eword::rword-text (rword)
+(defmacro ew-rword-text (rword)
(` (car (, rword))))
-(defmacro tm-eword::rword-charset (rword)
+(defmacro ew-rword-charset (rword)
(` (car (cdr (, rword)))))
-(defmacro tm-eword::rword-encoding (rword)
+(defmacro ew-rword-encoding (rword)
(` (car (cdr (cdr (, rword))))))
-(defmacro tm-eword::rword-type (rword)
+(defmacro ew-rword-type (rword)
(` (car (cdr (cdr (cdr (, rword)))))))
(defun tm-eword::find-charset-rule (charsets)
(mapcar (function
(lambda (word)
(let ((ret (tm-eword::find-charset-rule (car word))))
- (tm-eword::make-rword (cdr word) (car ret)(nth 1 ret) mode)
+ (make-ew-rword (cdr word) (car ret)(nth 1 ret) mode)
)))
wl))
(setq b (car seq))
(setq seq (cdr seq))
(setq c (car seq))
- (setq cc (tm-eword::rword-charset c))
- (if (null (tm-eword::rword-charset b))
+ (setq cc (ew-rword-charset c))
+ (if (null (ew-rword-charset b))
(progn
(setq a (car prev))
- (setq ac (tm-eword::rword-charset a))
- (if (and (tm-eword::rword-encoding a)
- (tm-eword::rword-encoding c))
+ (setq ac (ew-rword-charset a))
+ (if (and (ew-rword-encoding a)
+ (ew-rword-encoding c))
(cond ((eq ac cc)
(setq prev (cons
(cons (concat (car a)(car b)(car c))
;;;
(defun tm-eword::encoded-word-length (rword)
- (let ((string (tm-eword::rword-text rword))
- (charset (tm-eword::rword-charset rword))
- (encoding (tm-eword::rword-encoding rword))
+ (let ((string (ew-rword-text rword))
+ (charset (ew-rword-charset rword))
+ (encoding (ew-rword-encoding rword))
ret)
(setq ret
(cond ((string-equal encoding "B")
((string-equal encoding "Q")
(setq string (encode-mime-charset-string string charset))
(q-encoding-encoded-length string
- (tm-eword::rword-type rword))
+ (ew-rword-type rword))
)))
(if ret
(cons (+ 7 (length (symbol-name charset)) ret) string)
)
(setq string
(eword-encode-text
- (tm-eword::rword-charset rword)
- (tm-eword::rword-encoding rword)
+ (ew-rword-charset rword)
+ (ew-rword-encoding rword)
(cdr ret)
- (tm-eword::rword-type rword)
+ (ew-rword-type rword)
))
(setq len (+ (length string) column))
(setq rwl (cdr rwl))
(cdr rwl)))
(setq string
(eword-encode-text
- (tm-eword::rword-charset rword)
- (tm-eword::rword-encoding rword)
+ (ew-rword-charset rword)
+ (ew-rword-encoding rword)
str
- (tm-eword::rword-type rword)))
+ (ew-rword-type rword)))
(setq len (+ (length string) column))
)
)))
(list dest column)
))
-(defun tm-eword::encode-string (column str &optional mode)
- (tm-eword::encode-rwl column (tm-eword::split-string str mode))
- )
-
;;; @ converter
;;;
(list
(let ((ret (tm-eword::find-charset-rule
(find-non-ascii-charset-string str))))
- (tm-eword::make-rword
+ (make-ew-rword
str (car ret)(nth 1 ret) 'phrase)
)
)))
))
dest))
-(defun tm-eword::encode-address-list (column str)
- (tm-eword::encode-rwl
- column
- (tm-eword::addresses-to-rwl (std11-parse-addresses-string str))
- ))
+(defun eword-encode-address-list (string &optional column)
+ (car (tm-eword::encode-rwl
+ (or column 0)
+ (tm-eword::addresses-to-rwl (std11-parse-addresses-string string))
+ )))
+
+(defun eword-encode-structured-field-body (string &optional column)
+ (car (tm-eword::encode-rwl
+ (or column 0)
+ (eword-addr-seq-to-rwl (std11-lexical-analyze string))
+ )))
;;; @ application interfaces
;;;
+(defun eword-encode-string (str &optional column mode)
+ (car (tm-eword::encode-rwl (or column 0) (tm-eword::split-string str mode))))
+
(defun eword-encode-field (string)
"Encode header field STRING, and return the result.
A lexical token includes non-ASCII character is encoded as MIME
(let ((field-name (substring string 0 (1- (match-end 0))))
(field-body (eliminate-top-spaces
(substring string (match-end 0))))
- )
+ field-name-symbol)
(if (setq ret
- (cond ((string-equal field-body "") "")
- ((memq (intern (downcase field-name))
- '(reply-to
- from sender
- resent-reply-to resent-from
- resent-sender to resent-to
- cc resent-cc
- bcc resent-bcc dcc
- mime-version)
- )
- (car (tm-eword::encode-address-list
- (+ (length field-name) 2) field-body))
+ (cond ((string= field-body "") "")
+ ((memq (setq field-name-symbol
+ (intern (capitalize field-name)))
+ '(Reply-To
+ From Sender
+ Resent-Reply-To Resent-From
+ Resent-Sender To Resent-To
+ Cc Resent-Cc
+ Bcc Resent-Bcc Dcc))
+ (eword-encode-address-list
+ field-body (+ (length field-name) 2))
+ )
+ ((memq field-name-symbol
+ '(Mime-Version User-Agent
+ In-Reply-To))
+ (eword-encode-structured-field-body
+ field-body (+ (length field-name) 2))
)
(t
- (car (tm-eword::encode-string
- (1+ (length field-name))
- field-body 'text))
+ (eword-encode-string field-body
+ (1+ (length field-name))
+ 'text)
))
)
(concat field-name ": " ret)
)))
- (car (tm-eword::encode-string 0 string))
+ (eword-encode-string string 0)
)))
(defun eword-in-subject-p ()
))
)))
-(defun eword-encode-string (str &optional column mode)
- (car (tm-eword::encode-rwl (or column 0) (tm-eword::split-string str mode)))
- )
-
;;; @ end
;;;
(defvar base64-external-decoder-option-to-specify-file '("-o")
"*list of options of base64 decoder program to specify file.")
-(defvar base64-internal-encoding-limit 1000
- "*limit size to use internal base64 encoder.
-If size of input to encode is larger than this limit,
-external encoder is called.")
-
-(defvar base64-internal-decoding-limit 1000
- "*limit size to use internal base64 decoder.
-If size of input to decode is larger than this limit,
-external decoder is called.")
-
;;; @ internal base64 decoder/encoder
;;; based on base64 decoder by Enami Tsugutomo
;;; @@ base64 encoder/decoder for string
;;;
-(defun base64-encode-string (string)
+(defun base64-internal-encode-string (string)
"Encode STRING to base64, and return the result."
(let ((len (length string))
(b 0)(e 57)
(narrow-to-region beg end)
(let ((str (buffer-substring beg end)))
(delete-region beg end)
- (insert (base64-encode-string str))
+ (insert (base64-internal-encode-string str))
)
(or (bolp)
(insert "\n")
(buffer-string)))
-(defun base64-encode-region (start end)
- "Encode current region by base64.
-START and END are buffer positions.
-This function calls internal base64 encoder if size of region is
-smaller than `base64-internal-encoding-limit', otherwise it calls
-external base64 encoder specified by `base64-external-encoder'. In
-this case, you must install the program (maybe mmencode included in
-metamail or XEmacs package)."
- (interactive "r")
- (if (and base64-internal-encoding-limit
- (> (- end start) base64-internal-encoding-limit))
- (base64-external-encode-region start end)
- (base64-internal-encode-region start end)
- ))
-
-(defun base64-decode-region (start end)
- "Decode current region by base64.
-START and END are buffer positions.
-This function calls internal base64 decoder if size of region is
-smaller than `base64-internal-decoding-limit', otherwise it calls
-external base64 decoder specified by `base64-external-decoder'. In
-this case, you must install the program (maybe mmencode included in
-metamail or XEmacs package)."
- (interactive "r")
- (if (and base64-internal-decoding-limit
- (> (- end start) base64-internal-decoding-limit))
- (base64-external-decode-region start end)
- (base64-internal-decode-region start end)
- ))
-
-(defun base64-decode-string (string)
- "Decode STRING which is encoded in base64, and return the result.
-This function calls internal base64 decoder if size of STRING is
-smaller than `base64-internal-decoding-limit', otherwise it calls
-external base64 decoder specified by `base64-external-decoder'. In
-this case, you must install the program (maybe mmencode included in
-metamail or XEmacs package)."
- (interactive "r")
- (if (and base64-internal-decoding-limit
- (> (length string) base64-internal-decoding-limit))
- (base64-external-decode-string string)
- (base64-internal-decode-string string)
- ))
-
-
;;; @ base64 encoder/decoder for file
;;;
-(defun base64-insert-encoded-file (filename)
+(defun base64-external-insert-encoded-file (filename)
"Encode contents of file FILENAME to base64, and insert the result.
It calls external base64 encoder specified by
`base64-external-encoder'. So you must install the program (maybe
filename t nil (cdr base64-external-encoder))
)
-(defun base64-write-decoded-region (start end filename)
+(defun base64-external-write-decoded-region (start end filename)
"Decode and write current region encoded by base64 into FILENAME.
START and END are buffer positions."
(interactive
;;; @ etc
;;;
-(defun base64-encoded-length (string)
+(defun base64-internal-encoded-length (string)
(let ((len (length string)))
(* (+ (/ len 3)
(if (= (mod len 3) 0) 0 1)
--- /dev/null
+(require 'ccl)
+(require 'emu)
+
+
+;;; @ constants
+;;;
+
+(eval-when-compile
+
+(defconst mel-ccl-4-table
+ '( 0 1 2 3))
+
+(defconst mel-ccl-16-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15))
+
+(defconst mel-ccl-64-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63))
+
+(defconst mel-ccl-256-table
+ '( 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
+ 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
+ 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
+ 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79
+ 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
+ 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
+ 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127
+ 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
+ 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159
+ 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
+ 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191
+ 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
+ 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223
+ 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
+ 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255))
+
+(defconst mel-ccl-256-to-16-table
+ '(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
+ 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 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 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 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))
+
+(defconst mel-ccl-16-to-256-table
+ '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?A ?B ?C ?D ?E ?F))
+
+(defconst mel-ccl-high-table
+ (vconcat
+ (mapcar
+ (lambda (v) (nth (lsh v -4) mel-ccl-16-to-256-table))
+ mel-ccl-256-table)))
+
+(defconst mel-ccl-low-table
+ (vconcat
+ (mapcar
+ (lambda (v) (nth (logand v 15) mel-ccl-16-to-256-table))
+ mel-ccl-256-table)))
+
+(defconst mel-ccl-u-raw
+ (append
+ "0123456789"
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "abcdefghijklmnopqrstuvwxyz"
+ "!@#$%&'()*+,-./:;<>@[\\]^`{|}~"
+ ()))
+
+(defconst mel-ccl-c-raw
+ (append
+ "0123456789"
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "abcdefghijklmnopqrstuvwxyz"
+ "!@#$%&'*+,-./:;<>@[]^`{|}~"
+ ()))
+
+(defconst mel-ccl-p-raw
+ (append
+ "0123456789"
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ "abcdefghijklmnopqrstuvwxyz"
+ "!*+-/"
+ ()))
+
+(defconst mel-ccl-256-to-64-table
+ '(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 62 nil nil nil 63
+ 52 53 54 55 56 57 58 59 60 61 nil nil nil t nil nil
+ nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
+ 15 16 17 18 19 20 21 22 23 24 25 nil nil nil nil nil
+ nil 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
+ 41 42 43 44 45 46 47 48 49 50 51 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 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 nil nil nil
+ nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil))
+
+(defconst mel-ccl-64-to-256-table
+ '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P
+ ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d ?e ?f
+ ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v
+ ?w ?x ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?+ ?/))
+
+(defconst mel-ccl-qp-table
+ [enc enc enc enc enc enc enc enc enc wsp enc enc enc cr enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ wsp raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw enc raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw
+ raw raw raw raw raw raw raw raw raw raw raw raw raw raw raw enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc
+ enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc enc])
+
+)
+
+
+;;; @ CCL programs
+;;;
+
+(define-ccl-program mel-ccl-decode-q
+ `(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)))
+ mel-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))
+ mel-ccl-16-table)))
+ (break))
+ '(repeat)))
+ mel-ccl-256-to-16-table)))
+ (repeat)))
+ (t
+ `(write-repeat ,r0))))
+ mel-ccl-256-table))))))
+
+(define-ccl-program mel-ccl-encode-uq
+ `(3
+ (loop
+ (loop
+ (read-branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((= r0 32) `(write-repeat ?_))
+ ((member r0 mel-ccl-u-raw) `(write-repeat ,r0))
+ (t '(break))))
+ mel-ccl-256-table)))
+ (write ?=)
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (repeat))))
+
+(define-ccl-program mel-ccl-encode-cq
+ `(3
+ (loop
+ (loop
+ (read-branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((= r0 32) `(write-repeat ?_))
+ ((member r0 mel-ccl-c-raw) `(write-repeat ,r0))
+ (t '(break))))
+ mel-ccl-256-table)))
+ (write ?=)
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (repeat))))
+
+(define-ccl-program mel-ccl-encode-pq
+ `(3
+ (loop
+ (loop
+ (read-branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((= r0 32) `(write-repeat ?_))
+ ((member r0 mel-ccl-p-raw) `(write-repeat ,r0))
+ (t '(break))))
+ mel-ccl-256-table)))
+ (write ?=)
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (repeat))))
+
+(eval-when-compile
+(defun mel-ccl-decode-b-bit-ex (v)
+ (logior
+ (lsh (logand v (lsh 255 16)) -16)
+ (logand v (lsh 255 8))
+ (lsh (logand v 255) 16)))
+
+(defconst mel-ccl-decode-b-0-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex (lsh v 18))
+ (lsh 1 24)))
+ mel-ccl-256-to-64-table)))
+
+(defconst mel-ccl-decode-b-1-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex (lsh v 12))
+ (lsh 1 25)))
+ mel-ccl-256-to-64-table)))
+
+(defconst mel-ccl-decode-b-2-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex (lsh v 6))
+ (lsh 1 26)))
+ mel-ccl-256-to-64-table)))
+
+(defconst mel-ccl-decode-b-3-table
+ (vconcat
+ (mapcar
+ (lambda (v)
+ (if (integerp v)
+ (mel-ccl-decode-b-bit-ex v)
+ (lsh 1 27)))
+ mel-ccl-256-to-64-table)))
+
+)
+
+(define-ccl-program mel-ccl-decode-b
+ `(1
+ (loop
+ (read r0 r1 r2 r3)
+ (r4 = r0 ,mel-ccl-decode-b-0-table)
+ (r5 = r1 ,mel-ccl-decode-b-1-table)
+ (r4 |= r5)
+ (r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (if (r4 & ,(lognot (1- (lsh 1 24))))
+ ((loop
+ (if (r4 & ,(lsh 1 24))
+ ((r0 = r1) (r1 = r2) (r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ (break)))
+ (loop
+ (if (r4 & ,(lsh 1 25))
+ ((r1 = r2) (r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ (break)))
+ (loop
+ (if (r2 != ?=)
+ (if (r4 & ,(lsh 1 26))
+ ((r2 = r3) (read r3)
+ (r4 >>= 1) (r4 &= ,(logior (lsh 7 24)))
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (repeat))
+ ((r6 = 0)
+ (break)))
+ ((r6 = 1)
+ (break))))
+ (loop
+ (if (r3 != ?=)
+ (if (r4 & ,(lsh 1 27))
+ ((read r3)
+ (r4 = r3 ,mel-ccl-decode-b-3-table)
+ (repeat))
+ (break))
+ ((r6 |= 2)
+ (break))))
+ (r4 = r0 ,mel-ccl-decode-b-0-table)
+ (r5 = r1 ,mel-ccl-decode-b-1-table)
+ (r4 |= r5)
+ (branch
+ r6
+ ;; BBBB
+ ((r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r5 = r3 ,mel-ccl-decode-b-3-table)
+ (r4 |= r5)
+ (r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4))
+ ;; error: BB=B
+ ((write r4)
+ (end))
+ ;; BBB=
+ ((r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r4 >8= 0)
+ (write r7)
+ (write r4)
+ (end))
+ ;; BB==
+ ((write r4)
+ (end))))
+ ((r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4))))))
+
+;; mel-ccl-encode-b works only 20.3 or later because CCL_EOF_BLOCK
+;; is not executed on 20.2 (or former?).
+(define-ccl-program mel-ccl-encode-b
+ `(2
+ (loop
+ (r2 = 0)
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table))
+ (r0 = ,(logand r1 3))))
+ mel-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))
+ mel-ccl-64-to-256-table))
+ mel-ccl-4-table)))
+ (r0 = ,(logand r1 15))))
+ mel-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))
+ mel-ccl-64-to-256-table))
+ mel-ccl-16-table)))))
+ mel-ccl-256-table))
+ (r1 &= 63)
+ (write r1 ,(vconcat
+ (mapcar
+ (lambda (r1)
+ (nth r1 mel-ccl-64-to-256-table))
+ mel-ccl-64-table)))
+ (repeat))
+ (branch
+ r2
+ (end)
+ ((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (lsh r0 4) mel-ccl-64-to-256-table))
+ mel-ccl-4-table)))
+ (write "=="))
+ ((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (lsh r0 2) mel-ccl-64-to-256-table))
+ mel-ccl-16-table)))
+ (write ?=)))
+ ))
+
+;; mel-ccl-encode-base64 does not works on 20.2 by same reason of mel-ccl-encode-b
+(define-ccl-program mel-ccl-encode-base64
+ `(2
+ ((r3 = 0)
+ (loop
+ (r2 = 0)
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ `((write ,(nth (lsh r1 -2) mel-ccl-64-to-256-table))
+ (r0 = ,(logand r1 3))))
+ mel-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))
+ mel-ccl-64-to-256-table))
+ mel-ccl-4-table)))
+ (r0 = ,(logand r1 15))))
+ mel-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))
+ mel-ccl-64-to-256-table))
+ mel-ccl-16-table)))))
+ mel-ccl-256-table))
+ (r1 &= 63)
+ (write r1 ,(vconcat
+ (mapcar
+ (lambda (r1)
+ (nth r1 mel-ccl-64-to-256-table))
+ mel-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) mel-ccl-64-to-256-table))
+ mel-ccl-4-table)))
+ (write "==\r\n"))
+ ((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (lsh r0 2) mel-ccl-64-to-256-table))
+ mel-ccl-16-table)))
+ (write "=\r\n")))
+ ))
+
+;; mel-ccl-encode-quoted-printable does not works on 20.2 by same reason of mel-ccl-encode-b
+(define-ccl-program mel-ccl-encode-quoted-printable
+ `(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 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
+ )))
+ 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 "=\r\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 "=\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 ,mel-ccl-high-table)
+ (write r0 ,mel-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 ,mel-ccl-high-table)
+ (write r0 ,mel-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 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (r0 = r1)
+ (break))))))))
+ (repeat)))
+ (;(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 "=\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 ,mel-ccl-high-table)
+ (write r0 ,mel-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 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (write "=0D")
+ (end)))
+ ;; 13: r0:r3=RAW CR LF ;
+ (end)
+ ;; 14: r0:r3=ENC CR LF ;
+ (end)
+ ))
+ ))
+
+(define-ccl-program mel-ccl-decode-quoted-printable
+ `(1
+ ((read r0)
+ (loop
+ (branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (let ((tmp (aref mel-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 mel-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)))))
+ mel-ccl-256-table))
+ ;; '=' [\t ]* r0:[0-9A-F]
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ (if (setq tmp (nth r1 mel-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))
+ mel-ccl-16-table)))
+ ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
+ ;; invalid input
+ `(r2 = 0) ; nop
+ ))
+ mel-ccl-256-table))
+ ;; '=' [\t ]* [0-9A-F] r1:[^0-9A-F]
+ ;; invalid input
+ (write ?=)
+ (write r0 ,(vconcat mel-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))))))
+ mel-ccl-256-table))))))
+
+
+;;; @ coding system
+;;;
+
+(make-ccl-coding-system
+ 'mel-ccl-uq ?Q "MIME Q-encoding in unstructured field"
+ 'mel-ccl-decode-q 'mel-ccl-encode-uq)
+
+(make-ccl-coding-system
+ 'mel-ccl-cq ?Q "MIME Q-encoding in comment"
+ 'mel-ccl-decode-q 'mel-ccl-encode-cq)
+
+(make-ccl-coding-system
+ 'mel-ccl-pq ?Q "MIME Q-encoding in phrase"
+ 'mel-ccl-decode-q 'mel-ccl-encode-pq)
+
+(make-ccl-coding-system
+ 'mel-ccl-b ?B "MIME B-encoding"
+ 'mel-ccl-decode-b 'mel-ccl-encode-b)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable ?Q "MIME Quoted-Printable-encoding"
+ 'mel-ccl-decode-quoted-printable 'mel-ccl-encode-quoted-printable)
+
+(make-ccl-coding-system
+ 'mel-ccl-base64 ?B "MIME Base64-encoding"
+ 'mel-ccl-decode-b 'mel-ccl-encode-base64)
+
+(make-ccl-coding-system
+ 'mel-ccl-b-rev ?B "MIME B-encoding (reversed)"
+ 'mel-ccl-encode-b 'mel-ccl-decode-b)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-rev ?Q "MIME Quoted-Printable-encoding (reversed)"
+ 'mel-ccl-encode-quoted-printable 'mel-ccl-decode-quoted-printable)
+
+(make-ccl-coding-system
+ 'mel-ccl-base64-rev ?B "MIME Base64-encoding (reversed)"
+ 'mel-ccl-encode-base64 'mel-ccl-decode-b)
+
+
+;;; @ B
+;;;
+
+(unless (and (boundp 'ccl-encoder-eof-block-is-broken)
+ ccl-encoder-eof-block-is-broken)
+
+(defun base64-ccl-encode-string (string)
+ "Encode STRING with base64 encoding."
+ (encode-coding-string string 'mel-ccl-b))
+
+(defun base64-ccl-encode-region (start end)
+ "Encode region from START to END with base64 encoding."
+ (interactive "r")
+ (encode-coding-region start end 'mel-ccl-b))
+
+(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-b))
+ (insert-file-contents filename)))
+
+)
+
+(defun base64-ccl-decode-string (string)
+ "Decode base64 encoded STRING"
+ (string-as-unibyte (decode-coding-string string 'mel-ccl-b)))
+
+(defun base64-ccl-decode-region (start end)
+ "Decode base64 encoded the region from START to END."
+ (interactive "r")
+ (decode-coding-region start end 'mel-ccl-b))
+
+(defun base64-ccl-write-decoded-region (start end filename)
+ "Decode the region from START to END 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-b-rev))
+ (write-region start end filename)))
+
+
+;;; @ quoted-printable
+;;;
+
+(unless (and (boundp 'ccl-encoder-eof-block-is-broken)
+ ccl-encoder-eof-block-is-broken)
+
+(defun quoted-printable-ccl-encode-string (string)
+ "Encode STRING with quoted-printable encoding."
+ (decode-coding-string
+ (encode-coding-string
+ (encode-coding-string
+ string
+ 'raw-text-dos)
+ 'mel-ccl-quoted-printable)
+ 'raw-text-dos))
+
+(defun quoted-printable-ccl-encode-region (start end)
+ "Encode the region from START to END with quoted-printable
+encoding."
+ (interactive "r")
+ (setq end (+ start (encode-coding-region start end 'raw-text-dos)))
+ (setq end (+ start (encode-coding-region start end 'mel-ccl-quoted-printable)))
+ (decode-coding-region start end 'raw-text-dos))
+
+(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 ((start (point)) end
+ (coding-system-for-read 'mel-ccl-quoted-printable-rev))
+ (setq end (+ start (cadr (insert-file-contents filename))))
+ (decode-coding-region start end 'raw-text-dos)))
+
+)
+
+(defun quoted-printable-ccl-decode-string (string)
+ "Decode quoted-printable encoded STRING."
+ (decode-coding-string
+ (decode-coding-string
+ (encode-coding-string
+ string
+ 'raw-text-dos)
+ 'mel-ccl-quoted-printable)
+ 'raw-text-dos))
+
+(defun quoted-printable-ccl-decode-region (start end)
+ "Decode the region from START to END with quoted-printable
+encoding."
+ (interactive "r")
+ (setq end (+ start (encode-coding-region start end 'raw-text-dos)))
+ (setq end (+ start (decode-coding-region start end 'mel-ccl-quoted-printable)))
+ (decode-coding-region start end 'raw-text-dos))
+
+(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 ((buf (current-buffer)) tmp)
+ (with-temp-buffer
+ (setq tmp (current-buffer))
+ (save-excursion
+ (set-buffer buf)
+ (copy-to-buffer tmp start end))
+ (encode-coding-region (point-min) (point-max) 'raw-text-dos)
+ (decode-coding-region (point-min) (point-max) 'mel-ccl-quoted-printable)
+ (decode-coding-region (point-min) (point-max) 'raw-text-dos)
+ (write-region-as-binary (point-min) (point-max) filename))))
+
+
+;;; @ Q
+;;;
+
+(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'."
+ (encode-coding-string
+ string
+ (cond
+ ((eq mode 'text) 'mel-ccl-uq)
+ ((eq mode 'comment) 'mel-ccl-cq)
+ (t 'mel-ccl-pq))))
+
+(defun q-encoding-ccl-decode-string (string)
+ "Decode Q encoded STRING and return the result."
+ (string-as-unibyte
+ (decode-coding-string
+ string
+ 'mel-ccl-uq)))
+
+
+;;; @ end
+;;;
+
+(provide 'mel-ccl)
+
(dynamic-call "emacs_base64_init" base64-dl-handle)
-(defalias 'base64-encode-string 'encode-base64-string)
-(defalias 'base64-decode-string 'decode-base64-string)
+(defalias 'base64-dl-encode-string 'encode-base64-string)
+(defalias 'base64-dl-decode-string 'decode-base64-string)
-(defun base64-encode-region (start end)
+(defun base64-dl-encode-region (start end)
"Encode current region by base64.
START and END are buffer positions."
(interactive "r")
)
)))
-(defun base64-decode-region (start end)
+(defun base64-dl-decode-region (start end)
"Decode current region by base64.
START and END are buffer positions."
(interactive "r")
)))
-;;; @ base64 encoder/decoder for file
-;;;
-
-(defvar base64-external-encoder '("mmencode")
- "*list of base64 encoder program name and its arguments.")
-
-(defvar base64-external-decoder '("mmencode" "-u")
- "*list of base64 decoder program name and its arguments.")
-
-(defvar base64-external-decoder-option-to-specify-file '("-o")
- "*list of options of base64 decoder program to specify file.")
-
-(defun base64-insert-encoded-file (filename)
- "Encode contents of file FILENAME to base64, and insert the result.
-It calls external base64 encoder specified by
-`base64-external-encoder'. So you must install the program (maybe
-mmencode included in metamail or XEmacs package)."
- (interactive (list (read-file-name "Insert encoded file: ")))
- (apply (function call-process) (car base64-external-encoder)
- filename t nil (cdr base64-external-encoder))
- )
-
-(defun base64-write-decoded-region (start end filename)
- "Decode and write current region encoded by base64 into FILENAME.
-START and END are buffer positions."
- (interactive
- (list (region-beginning) (region-end)
- (read-file-name "Write decoded region to file: ")))
- (as-binary-process
- (apply (function call-process-region)
- start end (car base64-external-decoder)
- nil nil nil
- (append (cdr base64-external-decoder)
- base64-external-decoder-option-to-specify-file
- (list filename))
- )))
-
-
-;;; @ etc
-;;;
-
-(defun base64-encoded-length (string)
- (let ((len (length string)))
- (* (+ (/ len 3)
- (if (= (mod len 3) 0) 0 1)
- ) 4)
- ))
-
-
;;; @ end
;;;
)
))
-(defalias 'gzip64-encode-region 'gzip64-external-encode-region)
-(defalias 'gzip64-decode-region 'gzip64-external-decode-region)
-
;;; @ encoder/decoder for file
;;;
-(defun gzip64-insert-encoded-file (filename)
+(defun gzip64-external-insert-encoded-file (filename)
(interactive (list (read-file-name "Insert encoded file: ")))
(apply (function call-process) (car gzip64-external-encoder)
filename t nil
(cdr gzip64-external-encoder))
)
-(defun gzip64-write-decoded-region (start end filename)
+(defun gzip64-external-write-decoded-region (start end filename)
"Decode and write current region encoded by gzip64 into FILENAME.
START and END are buffer positions."
(interactive
)
)))
-
-(defvar quoted-printable-internal-encoding-limit
- (if (and (featurep 'xemacs)(featurep 'mule))
- 0
- (require 'path-util)
- (if (exec-installed-p "mmencode")
- 1000
- (message "Don't found external encoder for Quoted-Printable!")
- nil))
- "*limit size to use internal quoted-printable encoder.
-If size of input to encode is larger than this limit,
-external encoder is called.")
-
-(defun quoted-printable-encode-region (start end)
- "Encode current region by quoted-printable.
-START and END are buffer positions.
-This function calls internal quoted-printable encoder if size of
-region is smaller than `quoted-printable-internal-encoding-limit',
-otherwise it calls external quoted-printable encoder specified by
-`quoted-printable-external-encoder'. In this case, you must install
-the program (maybe mmencode included in metamail or XEmacs package)."
- (interactive "r")
- (if (and quoted-printable-internal-encoding-limit
- (> (- end start) quoted-printable-internal-encoding-limit))
- (quoted-printable-external-encode-region start end)
- (quoted-printable-internal-encode-region start end)
+(defun quoted-printable-internal-encode-string (string)
+ "Encode STRING to quoted-printable, and return the result."
+ (with-temp-buffer
+ (insert string)
+ (quoted-printable-internal-encode-region (point-min)(point-max))
+ (buffer-string)
))
-
-(defun quoted-printable-encode-string (string)
+(defun quoted-printable-external-encode-string (string)
"Encode STRING to quoted-printable, and return the result."
(with-temp-buffer
(insert string)
- (quoted-printable-encode-region (point-min)(point-max))
+ (quoted-printable-external-encode-region (point-min)(point-max))
(buffer-string)
))
-
-(defun quoted-printable-insert-encoded-file (filename)
+(defun quoted-printable-external-insert-encoded-file (filename)
"Encode contents of file FILENAME to quoted-printable, and insert the result.
It calls external quoted-printable encoder specified by
`quoted-printable-external-encoder'. So you must install the program
t t nil (cdr quoted-printable-external-decoder))
)))
-
-(defvar quoted-printable-internal-decoding-limit nil
- "*limit size to use internal quoted-printable decoder.
-If size of input to decode is larger than this limit,
-external decoder is called.")
-
-(defun quoted-printable-decode-region (start end)
- "Decode current region by quoted-printable.
-START and END are buffer positions.
-This function calls internal quoted-printable decoder if size of
-region is smaller than `quoted-printable-internal-decoding-limit',
-otherwise it calls external quoted-printable decoder specified by
-`quoted-printable-external-decoder'. In this case, you must install
-the program (maybe mmencode included in metamail or XEmacs package)."
- (interactive "r")
- (if (and quoted-printable-internal-decoding-limit
- (> (- end start) quoted-printable-internal-decoding-limit))
- (quoted-printable-external-decode-region start end)
- (quoted-printable-internal-decode-region start end)
- ))
-
-(defun quoted-printable-decode-string (string)
+(defun quoted-printable-internal-decode-string (string)
"Decode STRING which is encoded in quoted-printable, and return the result."
(with-temp-buffer
(insert string)
- (quoted-printable-decode-region (point-min)(point-max))
+ (quoted-printable-internal-decode-region (point-min)(point-max))
(buffer-string)))
+(defun quoted-printable-external-decode-string (string)
+ "Decode STRING which is encoded in quoted-printable, and return the result."
+ (with-temp-buffer
+ (insert string)
+ (quoted-printable-external-decode-region (point-min)(point-max))
+ (buffer-string)))
(defvar quoted-printable-external-decoder-option-to-specify-file '("-o")
"*list of options of quoted-printable decoder program to specify file.")
-(defun quoted-printable-write-decoded-region (start end filename)
+(defun quoted-printable-external-write-decoded-region (start end filename)
"Decode and write current region encoded by quoted-printable into FILENAME.
START and END are buffer positions."
(interactive
?: ?\; ?< ?> ?@ ?\[ ?\] ?^ ?` ?{ ?| ?} ?~)
))
-(defun q-encoding-encode-string (string &optional mode)
+(defun q-encoding-internal-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'."
string "")
))
-(defun q-encoding-decode-string (string)
+(defun q-encoding-internal-decode-string (string)
"Decode STRING which is encoded in Q-encoding and return the result."
(let (q h l)
(mapconcat (function
(string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
))))
-(defun q-encoding-encoded-length (string &optional mode)
+(defun q-encoding-internal-encoded-length (string &optional mode)
(let ((l 0)(i 0)(len (length string)) chr)
(while (< i len)
(setq chr (elt string i))
))
)))
-(defalias 'uuencode-encode-region 'uuencode-external-encode-region)
-(defalias 'uuencode-decode-region 'uuencode-external-decode-region)
-
;;; @ uuencode encoder/decoder for file
;;;
-(defun uuencode-insert-encoded-file (filename)
+(defun uuencode-external-insert-encoded-file (filename)
"Insert file encoded by unofficial uuencode format.
This function uses external uuencode encoder which is specified by
variable `uuencode-external-encoder'."
(file-name-nondirectory filename))
)
-(defun uuencode-write-decoded-region (start end filename)
+(defun uuencode-external-write-decoded-region (start end filename)
"Decode and write current region encoded by uuencode into FILENAME.
START and END are buffer positions."
(interactive
;;; @ variable
;;;
+(defvar base64-internal-encoding-limit 1000
+ "*limit size to use internal base64 encoder.
+If size of input to encode is larger than this limit,
+external encoder is called.")
+
+(defvar base64-internal-decoding-limit 1000
+ "*limit size to use internal base64 decoder.
+ size of input to decode is larger than this limit,
+external decoder is called.")
+
+(defvar quoted-printable-internal-encoding-limit
+ (if (and (featurep 'xemacs)(featurep 'mule))
+ 0
+ (require 'path-util)
+ (if (exec-installed-p "mmencode")
+ 1000
+ (message "Don't found external encoder for Quoted-Printable!")
+ nil))
+ "*limit size to use internal quoted-printable encoder.
+If size of input to encode is larger than this limit,
+external encoder is called.")
+
+(defvar quoted-printable-internal-decoding-limit nil
+ "*limit size to use internal quoted-printable decoder.
+If size of input to decode is larger than this limit,
+external decoder is called.")
+
+
+;;; @ autoload
+;;;
+
+;; mel-dl
(defvar base64-dl-module
(and (fboundp 'dynamic-link)
(let ((path (expand-file-name "base64.so" exec-directory)))
(and (file-exists-p path)
path))))
+(when base64-dl-module
+ (autoload 'base64-dl-encode-string "mel-dl"
+ "Encode STRING to base64, and return the result.")
+ (autoload 'base64-dl-decode-string "mel-dl"
+ "Decode STRING which is encoded in base64, and return the result.")
+ (autoload 'base64-dl-encode-region "mel-dl"
+ "Encode current region by base64." t)
+ (autoload 'base64-dl-decode-region "mel-dl"
+ "Decode current region by base64." t))
+
+;; mel-b
+(autoload 'base64-internal-encode-string "mel-b"
+ "Encode STRING to base64, and return the result.")
+(autoload 'base64-internal-decode-string "mel-b"
+ "Decode STRING which is encoded in base64, and return the result.")
+(autoload 'base64-internal-encode-region "mel-b"
+ "Encode current region by base64." t)
+(autoload 'base64-internal-decode-region "mel-b"
+ "Decode current region by base64." t)
+
+(autoload 'base64-external-encode-string "mel-b"
+ "Encode STRING to base64, and return the result.")
+(autoload 'base64-external-decode-string "mel-b"
+ "Decode STRING which is encoded in base64, and return the result.")
+(autoload 'base64-external-encode-region "mel-b"
+ "Encode current region by base64." t)
+(autoload 'base64-external-decode-region "mel-b"
+ "Decode current region by base64." t)
+
+(autoload 'base64-external-insert-encoded-file "mel-b"
+ "Encode contents of file to base64, and insert the result." t)
+(autoload 'base64-external-write-decoded-region "mel-b"
+ "Decode and write current region encoded by base64 into FILENAME." t)
-;;; @ autoload
-;;;
+;; for encoded-word
+(autoload 'base64-internal-encoded-length "mel-b")
-(cond (base64-dl-module
- (autoload 'base64-encode-string "mel-dl"
- "Encode STRING to base64, and return the result.")
- (autoload 'base64-decode-string "mel-dl"
- "Decode STRING which is encoded in base64, and return the result.")
- (autoload 'base64-encode-region "mel-dl"
- "Encode current region by base64." t)
- (autoload 'base64-decode-region "mel-dl"
- "Decode current region by base64." t)
- (autoload 'base64-insert-encoded-file "mel-dl"
- "Encode contents of file to base64, and insert the result." t)
- (autoload 'base64-write-decoded-region "mel-dl"
- "Decode and write current region encoded by base64 into FILENAME." t)
- ;; for encoded-word
- (autoload 'base64-encoded-length "mel-dl")
- )
- (t
- (autoload 'base64-encode-string "mel-b"
- "Encode STRING to base64, and return the result.")
- (autoload 'base64-decode-string "mel-b"
- "Decode STRING which is encoded in base64, and return the result.")
- (autoload 'base64-encode-region "mel-b"
- "Encode current region by base64." t)
- (autoload 'base64-decode-region "mel-b"
- "Decode current region by base64." t)
- (autoload 'base64-insert-encoded-file "mel-b"
- "Encode contents of file to base64, and insert the result." t)
- (autoload 'base64-write-decoded-region "mel-b"
- "Decode and write current region encoded by base64 into FILENAME." t)
- ;; for encoded-word
- (autoload 'base64-encoded-length "mel-b")
- ))
-
-(autoload 'quoted-printable-encode-string "mel-q"
+;; mel-q
+(autoload 'quoted-printable-internal-encode-string "mel-q"
"Encode STRING to quoted-printable, and return the result.")
-(autoload 'quoted-printable-decode-string "mel-q"
+(autoload 'quoted-printable-internal-decode-string "mel-q"
"Decode STRING which is encoded in quoted-printable, and return the result.")
-(autoload 'quoted-printable-encode-region "mel-q"
+(autoload 'quoted-printable-internal-encode-region "mel-q"
"Encode current region by Quoted-Printable." t)
-(autoload 'quoted-printable-decode-region "mel-q"
+(autoload 'quoted-printable-internal-decode-region "mel-q"
"Decode current region by Quoted-Printable." t)
-(autoload 'quoted-printable-insert-encoded-file "mel-q"
+
+(autoload 'quoted-printable-external-encode-string "mel-q"
+ "Encode STRING to quoted-printable, and return the result.")
+(autoload 'quoted-printable-external-decode-string "mel-q"
+ "Decode STRING which is encoded in quoted-printable, and return the result.")
+(autoload 'quoted-printable-external-encode-region "mel-q"
+ "Encode current region by Quoted-Printable." t)
+(autoload 'quoted-printable-external-decode-region "mel-q"
+ "Decode current region by Quoted-Printable." t)
+
+(autoload 'quoted-printable-external-insert-encoded-file "mel-q"
"Encode contents of file to quoted-printable, and insert the result." t)
-(autoload 'quoted-printable-write-decoded-region "mel-q"
+(autoload 'quoted-printable-external-write-decoded-region "mel-q"
"Decode and write current region encoded by quoted-printable into FILENAME."
t)
+
;; for encoded-word
-(autoload 'q-encoding-encode-string "mel-q"
+(autoload 'q-encoding-internal-encode-string "mel-q"
"Encode STRING to Q-encoding of encoded-word, and return the result.")
-(autoload 'q-encoding-decode-string "mel-q"
+(autoload 'q-encoding-internal-decode-string "mel-q"
"Decode STRING which is encoded in Q-encoding and return the result.")
-(autoload 'q-encoding-encoded-length "mel-q")
+(autoload 'q-encoding-internal-encoded-length "mel-q")
-(autoload 'uuencode-encode-region "mel-u"
+;; mel-u
+(autoload 'uuencode-external-encode-region "mel-u"
"Encode current region by unofficial uuencode format." t)
-(autoload 'uuencode-decode-region "mel-u"
+(autoload 'uuencode-external-decode-region "mel-u"
"Decode current region by unofficial uuencode format." t)
-(autoload 'uuencode-insert-encoded-file "mel-u"
+(autoload 'uuencode-external-insert-encoded-file "mel-u"
"Insert file encoded by unofficial uuencode format." t)
-(autoload 'uuencode-write-decoded-region "mel-u"
+(autoload 'uuencode-external-write-decoded-region "mel-u"
"Decode and write current region encoded by uuencode into FILENAME." t)
-(autoload 'gzip64-encode-region "mel-g"
+;; mel-g
+(autoload 'gzip64-external-encode-region "mel-g"
"Encode current region by unofficial x-gzip64 format." t)
-(autoload 'gzip64-decode-region "mel-g"
+(autoload 'gzip64-external-decode-region "mel-g"
"Decode current region by unofficial x-gzip64 format." t)
-(autoload 'gzip64-insert-encoded-file "mel-g"
+(autoload 'gzip64-external-insert-encoded-file "mel-g"
"Insert file encoded by unofficial gzip64 format." t)
-(autoload 'gzip64-write-decoded-region "mel-g"
+(autoload 'gzip64-external-write-decoded-region "mel-g"
"Decode and write current region encoded by gzip64 into FILENAME." t)
+;; mel-ccl
+(when (fboundp 'make-ccl-coding-system)
+ (unless (and (boundp 'ccl-encoder-eof-block-is-broken)
+ ccl-encoder-eof-block-is-broken)
+ (autoload 'base64-ccl-encode-string "mel-ccl"
+ "Encode STRING with base64 encoding.")
+ (autoload 'base64-ccl-encode-region "mel-ccl"
+ "Encode region from START to END with base64 encoding." t)
+ (autoload 'base64-ccl-insert-encoded-file "mel-ccl"
+ "Encode contents of file FILENAME to base64, and insert the result." t))
+
+ (autoload 'base64-ccl-decode-string "mel-ccl"
+ "Decode base64 encoded STRING")
+ (autoload 'base64-ccl-decode-region "mel-ccl"
+ "Decode base64 encoded STRING" t)
+ (autoload 'base64-ccl-write-decoded-region "mel-ccl"
+ "Decode the region from START to END and write out to FILENAME." t)
+
+ (unless (and (boundp 'ccl-encoder-eof-block-is-broken)
+ ccl-encoder-eof-block-is-broken)
+ (autoload 'quoted-printable-ccl-encode-string "mel-ccl"
+ "Encode STRING with quoted-printable encoding.")
+ (autoload 'quoted-printable-ccl-encode-region "mel-ccl"
+ "Encode the region from START to END with quoted-printable
+ encoding." t)
+ (autoload 'quoted-printable-ccl-insert-encoded-file "mel-ccl"
+ "Encode contents of the file named as FILENAME, and insert it." t))
+
+ (autoload 'quoted-printable-ccl-decode-string "mel-ccl"
+ "Decode quoted-printable encoded STRING.")
+ (autoload 'quoted-printable-ccl-decode-region "mel-ccl"
+ "Decode the region from START to END with quoted-printable
+ encoding.")
+ (autoload 'quoted-printable-ccl-write-decoded-region "mel-ccl"
+ "Decode quoted-printable encoded current region and write out to FILENAME." t)
+
+ (autoload 'q-encoding-ccl-encode-string "mel-ccl"
+ "Encode STRING to Q-encoding of encoded-word, and return the result.
+ MODE allows `text', `comment', `phrase' or nil. Default value is
+ `phrase'.")
+ (autoload 'q-encoding-ccl-decode-string "mel-ccl"
+ "Decode Q encoded STRING and return the result.")
+)
+
+;;; @ entrance functions.
+;;;
+
+(cond
+ ((fboundp 'base64-dl-encode-string)
+ (defalias 'base64-encode-string 'base64-dl-encode-string))
+ ((fboundp 'base64-ccl-encode-string)
+ (defalias 'base64-encode-string 'base64-ccl-encode-string))
+ (t
+ (defalias 'base64-encode-string 'base64-internal-encode-string)))
+
+(cond
+ ((fboundp 'base64-dl-decode-string)
+ (defalias 'base64-decode-string 'base64-dl-decode-string))
+ ((fboundp 'base64-ccl-decode-string)
+ (defalias 'base64-decode-string 'base64-ccl-decode-string))
+ (t
+ (defun base64-decode-string (string)
+ "Decode STRING which is encoded in base64, and return the result.
+This function calls internal base64 decoder if size of STRING is
+smaller than `base64-internal-decoding-limit', otherwise it calls
+external base64 decoder specified by `base64-external-decoder'. In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
+ (interactive "r")
+ (if (and base64-internal-decoding-limit
+ (> (length string) base64-internal-decoding-limit))
+ (base64-external-decode-string string)
+ (base64-internal-decode-string string)))))
+
+(cond
+ ((fboundp 'base64-dl-encode-region)
+ (defalias 'base64-encode-region 'base64-dl-encode-region)) ; no fold
+ ((fboundp 'base64-ccl-encode-region)
+ (defalias 'base64-encode-region 'base64-ccl-encode-region)) ; no fold
+ (t
+ (defun base64-encode-region (start end)
+ "Encode current region by base64.
+START and END are buffer positions.
+This function calls internal base64 encoder if size of region is
+smaller than `base64-internal-encoding-limit', otherwise it calls
+external base64 encoder specified by `base64-external-encoder'. In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
+ (interactive "r")
+ (if (and base64-internal-encoding-limit
+ (> (- end start) base64-internal-encoding-limit))
+ (base64-external-encode-region start end)
+ (base64-internal-encode-region start end))))) ; LF fold
+
+(cond
+ ((fboundp 'base64-dl-decode-region)
+ (defalias 'base64-decode-region 'base64-dl-decode-region))
+ ((fboundp 'base64-ccl-decode-region)
+ (defalias 'base64-decode-region 'base64-ccl-decode-region))
+ (t
+ (defun base64-decode-region (start end)
+ "Decode current region by base64.
+START and END are buffer positions.
+This function calls internal base64 decoder if size of region is
+smaller than `base64-internal-decoding-limit', otherwise it calls
+external base64 decoder specified by `base64-external-decoder'. In
+this case, you must install the program (maybe mmencode included in
+metamail or XEmacs package)."
+ (interactive "r")
+ (if (and base64-internal-decoding-limit
+ (> (- end start) base64-internal-decoding-limit))
+ (base64-external-decode-region start end)
+ (base64-internal-decode-region start end)))))
+
+(cond
+ ((fboundp 'base64-ccl-insert-encoded-file)
+ (defalias 'base64-insert-encoded-file 'base64-ccl-insert-encoded-file))
+ (t
+ (defalias 'base64-insert-encoded-file 'base64-external-insert-encoded-file)))
+
+(cond
+ ((fboundp 'base64-ccl-write-decoded-region)
+ (defalias 'base64-write-decoded-region 'base64-ccl-write-decoded-region))
+ (t
+ (defalias 'base64-write-decoded-region 'base64-external-write-decoded-region)))
+
+(cond
+ (t
+ (defalias 'base64-encoded-length 'base64-internal-encoded-length)))
+
+(cond
+ ((fboundp 'quoted-printable-ccl-encode-string)
+ (defalias 'quoted-printable-encode-string 'quoted-printable-ccl-encode-string))
+ (t
+ (defun quoted-printable-encode-string (string)
+ "Encode STRING to quoted-printable, and return the result."
+ (if (and quoted-printable-internal-encoding-limit
+ (> (length string) quoted-printable-internal-encoding-limit))
+ (quoted-printable-external-encode-string string)
+ (quoted-printable-internal-encode-string string)))))
+
+(cond
+ ((fboundp 'quoted-printable-ccl-decode-string)
+ (defalias 'quoted-printable-decode-string 'quoted-printable-ccl-decode-string))
+ (t
+ (defun quoted-printable-decode-string (string)
+ "Decode STRING which is encoded in quoted-printable, and return the result."
+ (if (and quoted-printable-internal-decoding-limit
+ (> (length string) quoted-printable-internal-decoding-limit))
+ (quoted-printable-external-decode-string string)
+ (quoted-printable-internal-decode-string string)))))
+
+(cond
+ ((fboundp 'quoted-printable-ccl-encode-region)
+ (defalias 'quoted-printable-encode-region 'quoted-printable-ccl-encode-region))
+ (t
+ (defun quoted-printable-encode-region (start end)
+ "Encode current region by quoted-printable.
+START and END are buffer positions.
+This function calls internal quoted-printable encoder if size of
+region is smaller than `quoted-printable-internal-encoding-limit',
+otherwise it calls external quoted-printable encoder specified by
+`quoted-printable-external-encoder'. In this case, you must install
+the program (maybe mmencode included in metamail or XEmacs package)."
+ (interactive "r")
+ (if (and quoted-printable-internal-encoding-limit
+ (> (- end start) quoted-printable-internal-encoding-limit))
+ (quoted-printable-external-encode-region start end)
+ (quoted-printable-internal-encode-region start end)
+ ))))
+
+(cond
+ ((fboundp 'quoted-printable-ccl-decode-region)
+ (defalias 'quoted-printable-decode-region 'quoted-printable-ccl-decode-region))
+ (t
+ (defun quoted-printable-decode-region (start end)
+ "Decode current region by quoted-printable.
+START and END are buffer positions.
+This function calls internal quoted-printable decoder if size of
+region is smaller than `quoted-printable-internal-decoding-limit',
+otherwise it calls external quoted-printable decoder specified by
+`quoted-printable-external-decoder'. In this case, you must install
+the program (maybe mmencode included in metamail or XEmacs package)."
+ (interactive "r")
+ (if (and quoted-printable-internal-decoding-limit
+ (> (- end start) quoted-printable-internal-decoding-limit))
+ (quoted-printable-external-decode-region start end)
+ (quoted-printable-internal-decode-region start end)
+ ))))
+
+(cond
+ ((fboundp 'quoted-printable-ccl-insert-encoded-file)
+ (defalias 'quoted-printable-insert-encoded-file 'quoted-printable-ccl-insert-encoded-file))
+ (t
+ (defalias 'quoted-printable-insert-encoded-file 'quoted-printable-external-insert-encoded-file)))
+
+(cond
+ ((fboundp 'quoted-printable-ccl-write-decoded-region)
+ (defalias 'quoted-printable-write-decoded-region 'quoted-printable-ccl-write-decoded-region))
+ (t
+ (defalias 'quoted-printable-write-decoded-region 'quoted-printable-external-write-decoded-region)))
+
+(cond
+ ((fboundp 'q-encoding-ccl-encode-string)
+ (defalias 'q-encoding-encode-string 'q-encoding-ccl-encode-string))
+ (t
+ (defalias 'q-encoding-encode-string 'q-encoding-internal-encode-string)))
+
+(cond
+ ((fboundp 'q-encoding-ccl-decode-string)
+ (defalias 'q-encoding-decode-string 'q-encoding-ccl-decode-string))
+ (t
+ (defalias 'q-encoding-decode-string 'q-encoding-internal-decode-string)))
+
+(cond
+ (t
+ (defalias 'q-encoding-encoded-length 'q-encoding-internal-encoded-length)))
+
+(cond
+ (t
+ (defalias 'uuencode-encode-region 'uuencode-external-encode-region)))
+
+(cond
+ (t
+ (defalias 'uuencode-decode-region 'uuencode-external-decode-region)))
+
+(cond
+ (t
+ (defalias 'uuencode-insert-encoded-file 'uuencode-external-insert-encoded-file)))
+
+(cond
+ (t
+ (defalias 'uuencode-write-decoded-region 'uuencode-external-write-decoded-region)))
+
+(cond
+ (t
+ (defalias 'gzip64-encode-region 'gzip64-external-encode-region)))
+
+(cond
+ (t
+ (defalias 'gzip64-decode-region 'gzip64-external-decode-region)))
+
+(cond
+ (t
+ (defalias 'gzip64-insert-encoded-file 'gzip64-external-insert-encoded-file)))
+
+(cond
+ (t
+ (defalias 'gzip64-write-decoded-region 'gzip64-external-write-decoded-region)))
;;; @ region
;;;
projects / elisp / flim.git / commitdiff