+1998-09-24 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-decode.el (eword-decode-structured-field-list): Add
+ Mail-Followup-To field.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-encode.el (eword-charset-encoding-alist): Add utf-8.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mel.el (mime-content-transfer-encoding-list): New user option.
+ (mime-encode-region): Use `mime-content-transfer-encoding-list'
+ for completion.
+ (mime-decode-region): Likewise.
+ (mime-insert-encoded-file): Likewise.
+ (mime-write-decoded-region): Likewise.
+
+ * mel.el (mime-write-decoded-region): fix typo.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mime-def.el (mel-define-method-function): Don't override.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mel.el, mel-ccl.el, FLIM-ELS: Add mel-ccl.el.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mel-dl.el, README.en, FLIM-ELS: Rename mel-dl.el to mel-b-dl.el.
+
+ * mel.el: - Rename mel-dl.el to mel-b-dl.el.
+ - Move `mel-define-service' to mime-def.el.
+
+ * mime-def.el (mel-define-service): New macro (moved from mel.el);
+ fixed problem in Emacs.
+ (mel-define-method): Use `mel-define-service'.
+ (mel-define-method-function): Use `mel-define-service'.
+
+1998-09-20 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * mel.el (mime-encode-region): Don't regard nil encoding as
+ "7bit".
+
+1998-09-19 MORIOKA Tomohiko <morioka@jaist.ac.jp>
+
+ * eword-encode.el (eword-encode-text): Use
+ `encoded-text-encode-string'.
+ (tm-eword::encoded-word-length): `q-encoding-encoded-length' was
+ renamed to `Q-encoded-text-length'.
+
+ * eword-decode.el: Move `base64-token-regexp',
+ `base64-token-padding-regexp', `eword-B-encoded-text-regexp' and
+ `eword-Q-encoded-text-regexp' to mime-def.el.
+ (eword-decode-encoded-text): Use `encoded-text-decode-string'.
+
+ * mel-q.el: Define method functions of mel.
+ (mime-insert-encoded-file): Use `mel-define-method'; abolish
+ `quoted-printable-insert-encoded-file'.
+ (mime-write-decoded-region): Use `mel-define-method'; abolish
+ `quoted-printable-write-decoded-region'.
+ - Move `q-encoding-printable-char-p' and
+ `q-encoding-encoded-length' to mel.el.
+
+ * mel-b.el: Define method functions of mel.
+ (mime-insert-encoded-file): Use `mel-define-method'; abolish
+ `base64-insert-encoded-file'.
+ (mime-write-decoded-region): Use `mel-define-method'; abolish
+ `base64-write-decoded-region'.
+ - Move `base64-encoded-length' to mel.el.
+
+ * mel-dl.el (base64-encode-region): Define directly (abolish
+ `base64-dl-encode-region').
+ (base64-decode-region): Define directly (abolish
+ `base64-dl-decode-region'). Define method functions of mel.
+ (mime-insert-encoded-file): Use `mel-define-method'; abolish
+ `base64-insert-encoded-file'; don't use external encoder.
+ (mime-write-decoded-region): Use `mel-define-method'; abolish
+ `base64-write-decoded-region'; don't use external decoder.
+ - Move `base64-encoded-length' to mel.el.
+
+ * mime.el: Move `mm-arglist-to-arguments' to mime-def.el.
+
+ * mime-def.el (base64-token-regexp): New constant (moved from
+ eword-decode.el).
+ (base64-token-padding-regexp): Likewise.
+ (B-encoded-text-regexp): New constant (moved from eword-decode.el,
+ and renamed from `eword-B-encoded-text-regexp').
+ (Q-encoded-text-regexp): New constant (moved from eword-decode.el,
+ and renamed from `eword-Q-encoded-text-regexp'.
+ (mm-arglist-to-arguments): New function (moved from mime.el).
+ (mel-define-method): New macro.
+ (mel-define-method-function): New macro.
+ (mel-define-function): New macro.
+
+ * mel.el (mel-encoding-module-alist): New variable.
+ (mel-use-module): New function.
+ (mel-find-function): New function.
+ (mel-define-service): New macro.
+ (mime-encode-region): Use `mel-find-function'; abolish variable
+ `mime-encoding-method-alist'.
+ (mime-decode-region): Use `mel-find-function'; abolish variable
+ `mime-decoding-method-alist'.
+ (mime-decode-string): Use `mel-find-function'; abolish variable
+ `mime-string-decoding-method-alist'.
+ (encoded-text-encode-string): New function.
+ (encoded-text-decode-string): New function.
+ (base64-encoded-length): New function (moved from mel-b.el and
+ mel-dl.el).
+ (Q-encoding-printable-char-p): New function (moved from mel-q.el,
+ and renamed from `q-encoding-printable-char-p').
+ (Q-encoded-text-length): New function (moved from mel-q.el, and
+ renamed from `q-encoding-encoded-length').
+ (mime-insert-encoded-file): Use `mel-find-function'; abolish
+ variable `mime-file-encoding-method-alist'.
+ (mime-write-decoded-region): Use `mel-find-function'; abolish
+ variable `mime-file-decoding-method-alist'.
+
1998-09-16 MORIOKA Tomohiko <morioka@jaist.ac.jp>
* mel-b.el (base64-internal-encoding-limit): modify :type.
mailcap))
(if (fboundp 'dynamic-link)
- (setq flim-modules (cons 'mel-dl flim-modules))
+ (setq flim-modules (cons 'mel-b-dl flim-modules))
+ )
+
+(if (featurep 'mule)
+ (setq flim-modules (cons 'mel-ccl flim-modules))
)
;;; FLIM-ELS ends here
;;-------------------------------------------------------------------------
;; Kinki Nippon Railway \e$(B6a5&F|K\E4F;\e(B http://www.kintetsu.co.jp/
-;; Ky\e-Dòto Line \e$(B5~ET@~\e(B\e-A
+;; Ky\e-Dòto\e-A Line \e$(B5~ET@~\e(B
;;-------------------------------------------------------------------------
-1.0.1 Ky\e-Dòto \e$(B5~ET\e(B ; <=> JR, \e$(B5~ET;T8rDL6I\e(B\e-A
-1.1.0 T\e-Dòji \e$(BEl;{\e(B\e-A
-1.2.0 J\e-Dþjò \e$(B==>r\e(B\e-A
+1.0.1 Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> JR, \e$(B5~ET;T8rDL6I\e(B
+1.1.0 T\e-Dòji\e-A \e$(BEl;{\e(B
+1.2.0 J\e-Dþjò\e-A \e$(B==>r\e(B
1.2.1 Kamitobaguchi \e$(B>eD;1)8}\e(B
1.2.2 Takeda \e$(BC]ED\e(B ; = \e$(B5~ET;T8rDL6I\e(B \e$(B1(4]@~\e(B
1.3.0 Fushimi \e$(BIz8+\e(B
1.4.0 Kintetsu-Tambabashi \e$(B6aE4C0GH66\e(B ; <=> \e$(B5~:e\e(B \e$(BC0GH66\e(B
-1.4.1 Momoyama-Gory\e-Dòmae \e$(BEm;38fNMA0\e(B\e-A
+1.4.1 Momoyama-Gory\e-Dòmae\e-A \e$(BEm;38fNMA0\e(B
1.5.0 Mukaijima \e$(B8~Eg\e(B
1.6.0 Ogura \e$(B>.AR\e(B
1.7.0 Iseda \e$(B0K@*ED\e(B
-1.8.0 \e-DÒkubo \e$(BBg5WJ]\e(B\e-A
+1.8.0 \e-DÒkubo\e-A \e$(BBg5WJ]\e(B
1.8.1 Kutsukawa \e$(B5WDE@n\e(B
1.9.0 Terada \e$(B;{ED\e(B
-1.9.1 Tonosh\e-Dò \e$(BIYLnAq\e(B\e-A
+1.9.1 Tonosh\e-Dò\e-A \e$(BIYLnAq\e(B
1.9.2 Shin-Tanabe \e$(B?7EDJU\e(B
------ K\e-Dòdo \e$(B6=8M\e(B\e-A
+----- K\e-Dòdo\e-A \e$(B6=8M\e(B
----- Miyamaki \e$(B;0;3LZ\e(B
----- Kintetsu-Miyazu \e$(B6aE45\DE\e(B
----- Komada \e$(B9}ED\e(B
------ Shin-H\e-Dòsono \e$(B?7=K1`\e(B\e-A
+----- Shin-H\e-Dòsono\e-A \e$(B?7=K1`\e(B
----- Kizugawadai \e$(BLZDE@nBf\e(B
----- Yamadagawa \e$(B;3ED@n\e(B
----- Takanohara \e$(B9b$N86\e(B
------ Heij\e-Dò \e$(BJ?>k\e(B\e-A
+----- Heij\e-Dò\e-A \e$(BJ?>k\e(B
----- Saidaiji \e$(B@>Bg;{\e(B
;;-------------------------------------------------------------------------
;; Kinki Nippon Railway \e$(B6a5&F|K\E4F;\e(B http://www.kintetsu.co.jp/
-;; Ky\e-Dòto Line \e$(B3`86@~\e(B\e-A
+;; Ky\e-Dòto\e-A Line \e$(B3`86@~\e(B
;;-------------------------------------------------------------------------
(Saidaiji) (\e$(B@>Bg;{\e(B)
----- Amagatsuji \e$(BFt%vDT\e(B
------ Nishinoky\e-Dò \e$(B@>$N5~\e(B\e-A
------ Kuj\e-Dò \e$(B6e>r\e(B\e-A
------ Kintetsu-K\e-Dòriyama \e$(B6aE474;3\e(B\e-A
+----- Nishinoky\e-Dò\e-A \e$(B@>$N5~\e(B
+----- Kuj\e-Dò\e-A \e$(B6e>r\e(B
+----- Kintetsu-K\e-Dòriyama\e-A \e$(B6aE474;3\e(B
[Chao Version names]
;;-------------------------------------------------------------------------
1.2.0 Takeda \e$(BC]ED\e(B ; = \e$(B6aE4\e(B \e$(B5~ET@~\e(B
1.3.0 Kuinabashi \e$(B$/$$$J66\e(B
-1.4.0 J\e-Dþjò \e$(B==>r\e(B\e-A
-1.6.0 Kuj\e-Dò \e$(B6e>r\e(B\e-A
-1.6.1 Ky\e-Dòto \e$(B5~ET\e(B ; <=> JR, \e$(B6aE4\e(B\e-A
-1.7.0 Goj\e-Dò \e$(B8^>r\e(B\e-A
-1.8.0 Shij\e-Dò \e$(B;M>r\e(B\e-A
+1.4.0 J\e-Dþjò\e-A \e$(B==>r\e(B
+1.6.0 Kuj\e-Dò\e-A \e$(B6e>r\e(B
+1.6.1 Ky\e-Dòto\e-A \e$(B5~ET\e(B ; <=> JR, \e$(B6aE4\e(B
+1.7.0 Goj\e-Dò\e-A \e$(B8^>r\e(B
+1.8.0 Shij\e-Dò\e-A \e$(B;M>r\e(B ; <=> \e$(B:e5^\e(B \e$(B5~ET@~\e(B
+1.9.0 Karasuma Oike \e$(B1(4]8fCS\e(B ; = \e$(B5~ET;T8rDL6I\e(B \e$(BEl@>@~\e(B
mime.el --- MIME library
- mime-def.el --- Definitions about MIME format
-
- mime-parse.el --- MIME parser
-
- mel.el --- MIME encoder/decoder
- mel-dl.el --- base64 (b-encoding) encoder/decoder
- (for Emacs 20 with dynamic loading support)
- mel-b.el --- base64 (b-encoding) encoder/decoder
- (for other emacsen)
- mel-q.el --- quoted-printable and q-encoding encoder/decoder
- mel-u.el --- unofficial module for uuencode
- mel-g.el --- unofficial module for gzip64
-
- eword-decode.el --- encoded-word decoder
- eword-encode.el --- encoded-word encoder
+ mime-def.el --- Definitions about MIME format
+
+ mime-parse.el --- MIME parser
+
+ mel.el --- MIME encoder/decoder
+ mel-b-dl.el --- base64 (B-encoding) encoder/decoder
+ (for Emacs 20 with dynamic loading support)
+ mel-b.el --- base64 (B-encoding) encoder/decoder
+ (for other emacsen)
+ mel-q.el --- quoted-printable and Q-encoding
+ encoder/decoder
+ mel-u.el --- unofficial module for uuencode
+ mel-g.el --- unofficial module for gzip64
+
+ eword-decode.el --- encoded-word decoder
+ eword-encode.el --- encoded-word encoder
mailcap.el --- mailcap parser and utility
(regexp-quote "?=")))
-;;; @@ Base64
-;;;
-
-(defconst base64-token-regexp "[A-Za-z0-9+/]")
-(defconst base64-token-padding-regexp "[A-Za-z0-9+/=]")
-
-(defconst eword-B-encoded-text-regexp
- (concat "\\(\\("
- base64-token-regexp
- base64-token-regexp
- base64-token-regexp
- base64-token-regexp
- "\\)*"
- base64-token-regexp
- base64-token-regexp
- base64-token-padding-regexp
- base64-token-padding-regexp
- "\\)"))
-
-;; (defconst eword-B-encoding-and-encoded-text-regexp
-;; (concat "\\(B\\)\\?" eword-B-encoded-text-regexp))
-
-
-;;; @@ Quoted-Printable
-;;;
-
-(defconst eword-Q-encoded-text-regexp
- (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+"))
-;; (defconst eword-Q-encoding-and-encoded-text-regexp
-;; (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp))
-
-
;;; @ for string
;;;
(defcustom eword-decode-structured-field-list
'(Reply-To Resent-Reply-To From Resent-From Sender Resent-Sender
To Resent-To Cc Resent-Cc Bcc Resent-Bcc Dcc
+ Mail-Followup-To
Mime-Version Content-Type Content-Transfer-Encoding
Content-Disposition User-Agent)
"*List of field-names to decode as structured field.
as a version of Net$cape)."
(let ((cs (mime-charset-to-coding-system charset)))
(if cs
- (let ((dest
- (cond
- ((string-equal "B" encoding)
- (if (and (string-match eword-B-encoded-text-regexp string)
- (string-equal string (match-string 0 string)))
- (base64-decode-string string)
- (error "Invalid encoded-text %s" string)))
- ((string-equal "Q" encoding)
- (if (and (string-match eword-Q-encoded-text-regexp string)
- (string-equal string (match-string 0 string)))
- (q-encoding-decode-string string)
- (error "Invalid encoded-text %s" string)))
- (t
- (error "Invalid encoding %s" encoding)
- )))
- )
+ (let ((dest (encoded-text-decode-string string encoding)))
(when dest
(setq dest (decode-mime-charset-string dest charset))
(if must-unfold
(euc-kr . "B")
(iso-2022-jp-2 . "B")
(iso-2022-int-1 . "B")
+ (utf-8 . "B")
))
ENCODING allows \"B\" or \"Q\".
MODE is allows `text', `comment', `phrase' or nil. Default value is
`phrase'."
- (let ((text
- (cond ((string= encoding "B")
- (base64-encode-string string))
- ((string= encoding "Q")
- (q-encoding-encode-string string mode))
- )
- ))
+ (let ((text (encoded-text-encode-string string encoding)))
(if text
(concat "=?" (upcase (symbol-name charset)) "?"
encoding "?" text "?=")
)
((string-equal encoding "Q")
(setq string (encode-mime-charset-string string charset))
- (q-encoding-encoded-length string
- (ew-rword-type rword))
+ (Q-encoded-text-length string (ew-rword-type rword))
)))
(if ret
(cons (+ 7 (length (symbol-name charset)) ret) string)
--- /dev/null
+;;; mel-b-dl.el: Base64 encoder/decoder using DL module
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; Keywords: MIME, Base64
+
+;; This file is part of MEL (MIME Encoding Library).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; 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.
+
+;;; Code:
+
+(require 'emu)
+(require 'mime-def)
+
+(eval-and-compile
+ (defvar base64-dl-module
+ (expand-file-name "base64.so" exec-directory))
+
+ (defvar base64-dl-handle
+ (and (file-exists-p base64-dl-module)
+ (dynamic-link base64-dl-module)))
+
+ (dynamic-call "emacs_base64_init" base64-dl-handle)
+ )
+
+(defun base64-encode-region (start end)
+ "Encode current region by base64.
+START and END are buffer positions."
+ (interactive "r")
+ (let ((str (buffer-substring start end)))
+ (delete-region start end)
+ (insert (encode-base64-string str))
+ )
+ (or (bolp)
+ (insert "\n"))
+ )
+
+(defun base64-decode-region (start end)
+ "Decode current region by base64.
+START and END are buffer positions."
+ (interactive "r")
+ (let ((str (buffer-substring start end)))
+ (delete-region start end)
+ (condition-case err
+ (insert (decode-base64-string str))
+ (error (message (nth 1 err)))
+ )))
+
+(defalias 'base64-encode-string 'encode-base64-string)
+(defalias 'base64-decode-string 'decode-base64-string)
+
+
+(mel-define-method-function (mime-encode-string string (nil "base64"))
+ 'encode-base64-string)
+(mel-define-method-function (mime-decode-string string (nil "base64"))
+ 'decode-base64-string)
+(mel-define-method-function (mime-encode-region start end (nil "base64"))
+ 'base64-encode-region)
+(mel-define-method-function (mime-decode-region start end (nil "base64"))
+ 'base64-decode-region)
+
+(mel-define-method-function (encoded-text-encode-string string (nil "B"))
+ 'encode-base64-string)
+
+(mel-define-method encoded-text-decode-string (string (nil "B"))
+ (if (and (string-match B-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (decode-base64-string string)
+ (error "Invalid encoded-text %s" string)))
+
+
+;;; @ base64 encoder/decoder for file
+;;;
+
+(mel-define-method mime-insert-encoded-file (filename (nil "base64"))
+ "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: ")))
+ (insert (encode-base64-string
+ (with-temp-buffer
+ (insert-file-contents-as-binary filename)
+ (buffer-string))))
+ (or (bolp)
+ (insert "\n"))
+ )
+
+(mel-define-method mime-write-decoded-region (start end filename
+ (nil "base64"))
+ "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: ")))
+ (let ((str (buffer-substring start end)))
+ (with-temp-buffer
+ (insert (decode-base64-string str))
+ (write-region-as-binary (point-min) (point-max) filename)
+ )))
+
+
+;;; @ end
+;;;
+
+(provide 'mel-b-dl)
+
+;;; mel-b-dl.el ends here.
(base64-internal-decode-string string)))
-(defun base64-insert-encoded-file (filename)
+(mel-define-method-function (mime-encode-string string (nil "base64"))
+ 'base64-encode-string)
+(mel-define-method-function (mime-decode-string string (nil "base64"))
+ 'base64-decode-string)
+(mel-define-method-function (mime-encode-region start end (nil "base64"))
+ 'base64-encode-region)
+(mel-define-method-function (mime-decode-region start end (nil "base64"))
+ 'base64-decode-region)
+
+(mel-define-method-function (encoded-text-encode-string string (nil "B"))
+ 'base64-encode-string)
+
+(mel-define-method encoded-text-decode-string (string (nil "B"))
+ (if (and (string-match B-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (base64-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
+(mel-define-method mime-insert-encoded-file (filename (nil "base64"))
"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
(insert "\n"))
))
-(defun base64-write-decoded-region (start end filename)
+(mel-define-method mime-write-decoded-region (start end filename
+ (nil "base64"))
"Decode and write current region encoded by base64 into FILENAME.
START and END are buffer positions."
(interactive
;;; @ etc
;;;
-(defun base64-encoded-length (string)
- (let ((len (length string)))
- (* (+ (/ len 3)
- (if (= (mod len 3) 0) 0 1)
- ) 4)
- ))
-
(defun pack-sequence (seq size)
"Split sequence SEQ into SIZE elements packs,
and return list of packs. [mel-b; tl-seq function]"
--- /dev/null
+;;; mel-ccl.el: CCL based encoder/decoder of Base64, Quoted-Printable
+;;; and Q-encoding
+
+;; Copyright (C) 1998 Tanaka Akira
+
+;; Author: Tanaka Akira <akr@jaist.ac.jp>
+;; Created: 1998/9/17
+;; Keywords: MIME, Base64, Quoted-Printable, Q-encoding
+
+;; This file is part of FLIM (Faithful Library about Internet Message).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; 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.
+
+;;; Code:
+
+(require 'ccl)
+(require 'emu)
+(require 'pccl)
+(require 'mime-def)
+
+
+;;; @ 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-28-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))
+
+(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
+ (mapcar 'char-int "0123456789ABCDEF"))
+
+(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
+ (mapcar
+ 'char-int
+ "0123456789\
+ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+!@#$%&'()*+,-./:;<>@[\\]^`{|}~"))
+
+(defconst mel-ccl-c-raw
+ (mapcar
+ 'char-int
+ "0123456789\
+ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+!@#$%&'*+,-./:;<>@[]^`{|}~"))
+
+(defconst mel-ccl-p-raw
+ (mapcar
+ 'char-int
+ "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
+ (mapcar
+ 'char-int
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZ\
+abcdefghijklmnopqrstuvwxyz\
+0123456789\
++/"))
+
+(defconst mel-ccl-qp-table
+ [enc enc enc enc enc enc enc enc enc wsp lf 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
+;;;
+
+;;; Q
+
+(define-ccl-program mel-ccl-decode-q
+ `(1
+ ((loop
+ (read-branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((= r0 (char-int ?_))
+ `(write-repeat ? ))
+ ((= r0 (char-int ?=))
+ `((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))))))
+
+(eval-when-compile
+
+(defun mel-ccl-encode-q-generic (raw)
+ `(3
+ (loop
+ (loop
+ (read-branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (cond
+ ((= r0 32) `(write-repeat ?_))
+ ((member r0 raw) `(write-repeat ,r0))
+ (t '(break))))
+ mel-ccl-256-table)))
+ (write ?=)
+ (write r0 ,mel-ccl-high-table)
+ (write r0 ,mel-ccl-low-table)
+ (repeat))))
+
+;; On xemacs, generated program counts iso-8859-1 8bit character as 6bytes.
+(defun mel-ccl-count-q-length (raw)
+ `(0
+ ((r0 = 0)
+ (loop
+ (read-branch
+ r1
+ ,@(mapcar
+ (lambda (r1)
+ (if (or (= r1 32) (member r1 raw))
+ '((r0 += 1) (repeat))
+ '((r0 += 3) (repeat))))
+ mel-ccl-256-table))))))
+
+)
+
+(define-ccl-program mel-ccl-encode-uq
+ (mel-ccl-encode-q-generic mel-ccl-u-raw))
+(define-ccl-program mel-ccl-encode-cq
+ (mel-ccl-encode-q-generic mel-ccl-c-raw))
+(define-ccl-program mel-ccl-encode-pq
+ (mel-ccl-encode-q-generic mel-ccl-p-raw))
+
+(define-ccl-program mel-ccl-count-uq
+ (mel-ccl-count-q-length mel-ccl-u-raw))
+(define-ccl-program mel-ccl-count-cq
+ (mel-ccl-count-q-length mel-ccl-c-raw))
+(define-ccl-program mel-ccl-count-pq
+ (mel-ccl-count-q-length mel-ccl-p-raw))
+
+;;; B/Base64
+
+(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 & 255))
+ (end))
+ ;; BBB=
+ ((r5 = r2 ,mel-ccl-decode-b-2-table)
+ (r4 |= r5)
+ (r4 >8= 0)
+ (write r7)
+ (write (r4 & 255))
+ (end) ; Excessive (end) is workaround for XEmacs 21.0.
+ ; Without this, "AAA=" is converted to "^@^@^@".
+ (end))
+ ;; BB==
+ ((write (r4 & 255))
+ (end))))
+ ((r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4))))))
+
+(eval-when-compile
+
+;; Generated CCL program works not properly on 20.2 because CCL_EOF_BLOCK
+;; is not executed.
+(defun mel-ccl-encode-base64-generic (&optional quantums-per-line output-crlf terminate-with-newline)
+ `(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)
+ ,@(when quantums-per-line
+ `((if (r3 == ,quantums-per-line)
+ ((write ,(if output-crlf "\r\n" "\n"))
+ (r3 = 0)))))
+ (repeat)))
+ (branch
+ r2
+ ,(if terminate-with-newline
+ `(if (r3 > 0) (write ,(if output-crlf "\r\n" "\n")))
+ `(r0 = 0))
+ ((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (lsh r0 4) mel-ccl-64-to-256-table))
+ mel-ccl-4-table)))
+ (write ,(if terminate-with-newline
+ (if output-crlf "==\r\n" "==\n")
+ "==")))
+ ((write r0 ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (nth (lsh r0 2) mel-ccl-64-to-256-table))
+ mel-ccl-16-table)))
+ (write ,(if terminate-with-newline
+ (if output-crlf "=\r\n" "=\n")
+ "="))))
+ ))
+)
+
+(define-ccl-program mel-ccl-encode-b
+ (mel-ccl-encode-base64-generic))
+
+;; 19 * 4 = 76
+(define-ccl-program mel-ccl-encode-base64-crlf-crlf
+ (mel-ccl-encode-base64-generic 19 t))
+
+(define-ccl-program mel-ccl-encode-base64-crlf-lf
+ (mel-ccl-encode-base64-generic 19 nil))
+
+;; Quoted-Printable
+
+(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)
+ (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))))
+
+;; 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
+ (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)
+ ))
+ ))
+
+(defun mel-ccl-decode-quoted-printable-generic (input-crlf output-crlf)
+ `(1
+ ((read r0)
+ (loop
+ (branch
+ r0
+ ,@(mapcar
+ (lambda (r0)
+ (let ((tmp (aref mel-ccl-qp-table r0)))
+ (cond
+ ((eq tmp 'raw) `(write-read-repeat r0))
+ ((eq tmp 'wsp) (if (eq r0 (char-int ? ))
+ `(r1 = 1)
+ `(r1 = 0)))
+ ((eq tmp 'cr)
+ (if input-crlf
+ ;; r0='\r'
+ `((read r0)
+ ;; '\r' r0
+ (if (r0 == ?\n)
+ ;; '\r' r0='\n'
+ ;; hard line break found.
+ ,(if output-crlf
+ '((write ?\r)
+ (write-read-repeat r0))
+ '(write-read-repeat r0))
+ ;; '\r' r0:[^\n]
+ ;; invalid control character (bare CR) found.
+ ;; -> ignore it and rescan from r0.
+ (repeat)))
+ ;; r0='\r'
+ ;; invalid character (bare CR) found.
+ ;; -> ignore.
+ `((read r0)
+ (repeat))))
+ ((eq tmp 'lf)
+ (if input-crlf
+ ;; r0='\n'
+ ;; invalid character (bare LF) found.
+ ;; -> ignore.
+ `((read r0)
+ (repeat))
+ ;; r0='\r\n'
+ ;; hard line break found.
+ (if output-crlf
+ '((write ?\r)
+ (write-read-repeat r0))
+ '(write-read-repeat r0))))
+ ((eq r0 (char-int ?=))
+ ;; 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 (char-int ?\r))
+ (if input-crlf
+ ;; '=' [\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 "=" and rescan from r0.
+ ((write "=")
+ (repeat))))
+ ;; '=' [\t ]* r0='\r'
+ ;; invalid input (bare CR found) ->
+ ;; output "=" and rescan from next.
+ `((write ?=)
+ (read r0)
+ (repeat))))
+ ((eq r0 (char-int ?\n))
+ (if input-crlf
+ ;; '=' [\t ]* r0='\n'
+ ;; invalid input (bare LF found) ->
+ ;; output "=" and rescan from next.
+ `((write ?=)
+ (read r0)
+ (repeat))
+ ;; '=' [\t ]* r0='\r\n'
+ ;; soft line break found.
+ `((read r0)
+ (repeat))))
+ ((setq tmp (nth r0 mel-ccl-256-to-16-table))
+ ;; '=' [\t ]* r0:[0-9A-F]
+ ;; upper nibble of hexadecimal digit found.
+ `((r1 = r0)
+ (r0 = ,tmp)))
+ (t
+ ;; '=' [\t ]* r0:[^\r0-9A-F]
+ ;; invalid input ->
+ ;; output "=" and rescan from r0.
+ `((write ?=)
+ (repeat)))))
+ mel-ccl-256-table))
+ ;; '=' [\t ]* r1:r0:[0-9A-F]
+ (read-branch
+ r2
+ ,@(mapcar
+ (lambda (r2)
+ (if (setq tmp (nth r2 mel-ccl-256-to-16-table))
+ ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[0-9A-F]
+ `(write-read-repeat
+ r0
+ ,(vconcat
+ (mapcar
+ (lambda (r0)
+ (logior (lsh r0 4) tmp))
+ mel-ccl-16-table)))
+ ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
+ ;; invalid input
+ `(r3 = 0) ; nop
+ ))
+ mel-ccl-256-table))
+ ;; '=' [\t ]* r1:r0:[0-9A-F] r2:[^0-9A-F]
+ ;; invalid input ->
+ ;; output "=" with hex digit and rescan from r2.
+ (write ?=)
+ (r0 = r2)
+ (write-repeat r1)))
+ (t
+ ;; r0:[^\t\r -~]
+ ;; invalid character found.
+ ;; -> ignore.
+ `((read r0)
+ (repeat))))))
+ mel-ccl-256-table))
+ ;; r1[0]:[\t ]
+ (loop
+ ,@(apply
+ 'append
+ (mapcar
+ (lambda (regnum)
+ (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
+ (apply
+ 'append
+ (mapcar
+ (lambda (bit)
+ (if (= bit 0)
+ (if (= regnum 0)
+ nil
+ `((read r0)
+ (if (r0 == ?\t)
+ (,reg = 0)
+ (if (r0 == ?\ )
+ (,reg = 1)
+ ((r6 = ,(+ (* regnum 28) bit))
+ (break))))))
+ `((read r0)
+ (if (r0 == ?\ )
+ (,reg |= ,(lsh 1 bit))
+ (if (r0 != ?\t)
+ ((r6 = ,(+ (* regnum 28) bit))
+ (break)))))))
+ mel-ccl-28-table))))
+ '(0 1 2 3 4)))
+ ;; white space buffer exhaust.
+ ;; error: line length limit (76bytes) violation.
+ ;; -> ignore these white spaces.
+ (repeat))
+ ,(if input-crlf
+ `(if (r0 == ?\r)
+ ((read r0)
+ (if (r0 == ?\n)
+ ;; trailing white spaces found.
+ ;; -> ignore these white spacs.
+ ((write ,(if output-crlf "\r\n" "\n"))
+ (read r0)
+ (repeat))
+ ;; [\t ]* \r r0:[^\n]
+ ;; error: bare CR found.
+ ;; -> output white spaces and ignore bare CR.
+ ))
+ ;; [\t ]* r0:[^\r]
+ ;; middle white spaces found.
+ )
+ `(if (r0 == ?\n)
+ ;; trailing white spaces found.
+ ;; -> ignore these white spacs.
+ ((write ,(if output-crlf "\r\n" "\n"))
+ (read r0)
+ (repeat))
+ ;; [\t ]* r0:[^\n]
+ ;; middle white spaces found.
+ ))
+ ,@(apply
+ 'append
+ (mapcar
+ (lambda (regnum)
+ (let ((reg (aref [r1 r2 r3 r4 r5] regnum)))
+ (apply
+ 'append
+ (mapcar
+ (lambda (bit)
+ `((if (,reg & ,(lsh 1 bit))
+ (write ?\ )
+ (write ?\t))
+ (if (r6 == ,(+ (* regnum 28) bit 1))
+ (repeat))))
+ mel-ccl-28-table))))
+ '(0 1 2 3 4)))
+ (repeat)
+ ))))
+
+)
+
+(define-ccl-program mel-ccl-encode-quoted-printable-crlf-crlf
+ (mel-ccl-encode-quoted-printable-generic t t))
+
+(define-ccl-program mel-ccl-encode-quoted-printable-crlf-lf
+ (mel-ccl-encode-quoted-printable-generic t nil))
+
+(define-ccl-program mel-ccl-encode-quoted-printable-lf-crlf
+ (mel-ccl-encode-quoted-printable-generic nil t))
+
+(define-ccl-program mel-ccl-encode-quoted-printable-lf-lf
+ (mel-ccl-encode-quoted-printable-generic nil nil))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-crlf-crlf
+ (mel-ccl-decode-quoted-printable-generic t t))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-crlf-lf
+ (mel-ccl-decode-quoted-printable-generic t nil))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-lf-crlf
+ (mel-ccl-decode-quoted-printable-generic nil t))
+
+(define-ccl-program mel-ccl-decode-quoted-printable-lf-lf
+ (mel-ccl-decode-quoted-printable-generic nil nil))
+
+
+;;; @ coding system
+;;;
+
+(make-ccl-coding-system
+ 'mel-ccl-uq-rev ?Q "MIME Q-encoding in unstructured field (reversed)"
+ 'mel-ccl-encode-uq 'mel-ccl-decode-q)
+
+(make-ccl-coding-system
+ 'mel-ccl-cq-rev ?Q "MIME Q-encoding in comment (reversed)"
+ 'mel-ccl-encode-cq 'mel-ccl-decode-q)
+
+(make-ccl-coding-system
+ 'mel-ccl-pq-rev ?Q "MIME Q-encoding in phrase (reversed)"
+ 'mel-ccl-encode-pq 'mel-ccl-decode-q)
+
+(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-crlf-crlf-rev
+ ?Q "MIME Quoted-Printable-encoding (reversed)"
+ 'mel-ccl-encode-quoted-printable-crlf-crlf
+ 'mel-ccl-decode-quoted-printable-crlf-crlf)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-lf-crlf-rev
+ ?Q "MIME Quoted-Printable-encoding (LF encoding) (reversed)"
+ 'mel-ccl-encode-quoted-printable-crlf-lf
+ 'mel-ccl-decode-quoted-printable-lf-crlf)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-crlf-lf-rev
+ ?Q "MIME Quoted-Printable-encoding (LF internal) (reversed)"
+ 'mel-ccl-encode-quoted-printable-lf-crlf
+ 'mel-ccl-decode-quoted-printable-crlf-lf)
+
+(make-ccl-coding-system
+ 'mel-ccl-quoted-printable-lf-lf-rev
+ ?Q "MIME Quoted-Printable-encoding (LF encoding) (LF internal) (reversed)"
+ 'mel-ccl-encode-quoted-printable-lf-lf
+ 'mel-ccl-decode-quoted-printable-lf-lf)
+
+(make-ccl-coding-system
+ 'mel-ccl-base64-crlf-rev
+ ?B "MIME Base64-encoding (reversed)"
+ 'mel-ccl-encode-base64-crlf-crlf
+ 'mel-ccl-decode-b)
+
+(make-ccl-coding-system
+ 'mel-ccl-base64-lf-rev
+ ?B "MIME Base64-encoding (LF encoding) (reversed)"
+ 'mel-ccl-encode-base64-crlf-lf
+ '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."
+ (decode-coding-string string 'mel-ccl-base64-lf-rev))
+
+ (defun base64-ccl-encode-region (start end)
+ "Encode region from START to END with base64 encoding."
+ (interactive "r")
+ (decode-coding-region start end 'mel-ccl-base64-lf-rev))
+
+ (defun base64-ccl-insert-encoded-file (filename)
+ "Encode contents of file FILENAME to base64, and insert the result."
+ (interactive (list (read-file-name "Insert encoded file: ")))
+ (let ((coding-system-for-read 'mel-ccl-base64-lf-rev))
+ (insert-file-contents filename)))
+
+ (mel-define-method-function (mime-encode-string string (nil "base64"))
+ 'base64-ccl-encode-string)
+ (mel-define-method-function (mime-encode-region start end (nil "base64"))
+ 'base64-ccl-encode-region)
+ (mel-define-method-function
+ (mime-insert-encoded-file filename (nil "base64"))
+ 'base64-ccl-insert-encoded-file)
+
+ (mel-define-method-function (encoded-text-encode-string string (nil "B"))
+ 'base64-ccl-encode-string)
+ )
+
+(defun base64-ccl-decode-string (string)
+ "Decode base64 encoded STRING"
+ (encode-coding-string string 'mel-ccl-b-rev))
+
+(defun base64-ccl-decode-region (start end)
+ "Decode base64 encoded the region from START to END."
+ (interactive "r")
+ (encode-coding-region start end 'mel-ccl-b-rev))
+
+(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)))
+
+(mel-define-method-function (mime-decode-string string (nil "base64"))
+ 'base64-ccl-decode-string)
+(mel-define-method-function (mime-decode-region start end (nil "base64"))
+ 'base64-ccl-decode-region)
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "base64"))
+ 'base64-ccl-write-decoded-region)
+
+(mel-define-method encoded-text-decode-string (string (nil "B"))
+ (if (and (string-match B-encoded-text-regexp string)
+ (string= string (match-string 0 string)))
+ (base64-ccl-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
+
+;;; @ 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
+ 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)))
+
+ (mel-define-method-function
+ (mime-encode-string string (nil "quoted-printable"))
+ 'quoted-printable-ccl-encode-string)
+ (mel-define-method-function
+ (mime-encode-region start end (nil "quoted-printable"))
+ 'quoted-printable-ccl-encode-region)
+ (mel-define-method-function
+ (mime-insert-encoded-file filename (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
+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)))
+
+(mel-define-method-function
+ (mime-decode-string string (nil "quoted-printable"))
+ 'quoted-printable-ccl-decode-string)
+(mel-define-method-function
+ (mime-decode-region start end (nil "quoted-printable"))
+ 'quoted-printable-ccl-decode-region)
+(mel-define-method-function
+ (mime-write-decoded-region start end filename (nil "quoted-printable"))
+ 'quoted-printable-ccl-write-decoded-region)
+
+
+;;; @ 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'."
+ (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)
+ (ccl-execute-on-string
+ (cond
+ ((eq mode 'text) 'mel-ccl-count-uq)
+ ((eq mode 'comment) 'mel-ccl-count-cq)
+ (t 'mel-ccl-count-pq))
+ status
+ string)
+ (aref status 0)))
+ )
+
+(mel-define-method-function (encoded-text-encode-string string (nil "Q"))
+ '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)))
+ (q-encoding-ccl-decode-string string)
+ (error "Invalid encoded-text %s" string)))
+
+
+;;; @ end
+;;;
+
+(provide 'mel-ccl)
+
+;;; mel-ccl.el ends here
+++ /dev/null
-;;; mel-dl.el: Base64 encoder/decoder using DL module
-
-;; Copyright (C) 1998 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Keywords: MIME, Base64
-
-;; This file is part of MEL (MIME Encoding Library).
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; 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.
-
-;;; Code:
-
-(require 'emu)
-
-(defvar base64-dl-module
- (expand-file-name "base64.so" exec-directory))
-
-(defvar base64-dl-handle
- (and (file-exists-p base64-dl-module)
- (dynamic-link base64-dl-module)))
-
-(dynamic-call "emacs_base64_init" base64-dl-handle)
-
-(defalias 'base64-dl-encode-string 'encode-base64-string)
-(defalias 'base64-dl-decode-string 'decode-base64-string)
-
-(defun base64-dl-encode-region (start end)
- "Encode current region by base64.
-START and END are buffer positions."
- (interactive "r")
- (let ((str (buffer-substring start end)))
- (delete-region start end)
- (insert (encode-base64-string str))
- )
- (or (bolp)
- (insert "\n"))
- )
-
-(defun base64-dl-decode-region (start end)
- "Decode current region by base64.
-START and END are buffer positions."
- (interactive "r")
- (let ((str (buffer-substring start end)))
- (delete-region start end)
- (condition-case err
- (insert (decode-base64-string str))
- (error (message (nth 1 err)))
- )))
-
-(defalias 'base64-encode-string 'encode-base64-string)
-(defalias 'base64-decode-string 'decode-base64-string)
-(defalias 'base64-encode-region 'base64-dl-encode-region)
-(defalias 'base64-decode-region 'base64-dl-decode-region)
-
-
-;;; @ 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
-;;;
-
-(provide 'mel-dl)
-
-;;; mel-dl.el ends here.
))
-(defun quoted-printable-insert-encoded-file (filename)
+(mel-define-method-function
+ (mime-encode-string string (nil "quoted-printable"))
+ 'quoted-printable-encode-string)
+
+(mel-define-method-function
+ (mime-encode-region start end (nil "quoted-printable"))
+ 'quoted-printable-encode-region)
+
+(mel-define-method mime-insert-encoded-file (filename
+ (nil "quoted-printable"))
"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
(buffer-string)))
+(mel-define-method-function
+ (mime-decode-string string (nil "quoted-printable"))
+ 'quoted-printable-decode-string)
+
+(mel-define-method-function
+ (mime-decode-region start end (nil "quoted-printable"))
+ 'quoted-printable-decode-region)
+
+
(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)
+(mel-define-method mime-write-decoded-region (start end filename
+ (nil "quoted-printable"))
"Decode and write current region encoded by quoted-printable into FILENAME.
START and END are buffer positions."
(interactive
)))
string "")))
+(mel-define-method-function (encoded-text-encode-string string (nil "Q"))
+ 'q-encoding-encode-string)
-;;; @@ etc
-;;;
-
-(defun q-encoding-printable-char-p (chr mode)
- (and (not (memq chr '(?= ?? ?_)))
- (<= ?\ chr)(<= chr ?~)
- (cond ((eq mode 'text) t)
- ((eq mode 'comment)
- (not (memq chr '(?\( ?\) ?\\)))
- )
- (t
- (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
- ))))
-
-(defun q-encoding-encoded-length (string &optional mode)
- (let ((l 0)(i 0)(len (length string)) chr)
- (while (< i len)
- (setq chr (elt string i))
- (if (q-encoding-printable-char-p chr mode)
- (setq l (+ l 1))
- (setq l (+ l 3))
- )
- (setq i (+ i 1)) )
- l))
+(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)))
+ (q-encoding-decode-string string)
+ (error "Invalid encoded-text %s" string)))
;;; @ end
;;; Code:
(require 'emu)
+(require 'mime-def)
+
+(defcustom mime-content-transfer-encoding-list
+ '("7bit" "8bit" "binary" "base64" "quoted-printable")
+ "List of Content-Transfer-Encoding. Each encoding must be string."
+ :group 'mime
+ :type '(repeat string))
+
+(defvar mel-encoding-module-alist nil)
+
+(defsubst mel-use-module (name encodings)
+ (let (encoding)
+ (while (setq encoding (car encodings))
+ (set-alist 'mel-encoding-module-alist
+ encoding
+ (cons name (cdr (assoc encoding mel-encoding-module-alist))))
+ (setq encodings (cdr encodings))
+ )))
-
-;;; @ variable
+(defsubst mel-find-function (service encoding)
+ (let* ((oba (symbol-value (intern (format "%s-obarray" service))))
+ (f (intern-soft encoding oba)))
+ (or f
+ (let ((rest (cdr (assoc encoding mel-encoding-module-alist))))
+ (while (and rest
+ (progn
+ (require (car rest))
+ (null (setq f (intern-soft encoding oba)))
+ ))
+ (setq rest (cdr rest))
+ )
+ f))))
+
+
+;;; @ setting for modules
;;;
(defvar base64-dl-module
path))))
-;;; @ autoload
-;;;
-
-(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"
- "Encode STRING to quoted-printable, and return the result.")
-(autoload 'quoted-printable-decode-string "mel-q"
- "Decode STRING which is encoded in quoted-printable, and return the result.")
-(autoload 'quoted-printable-encode-region "mel-q"
- "Encode current region by Quoted-Printable." t)
-(autoload 'quoted-printable-decode-region "mel-q"
- "Decode current region by Quoted-Printable." t)
-(autoload 'quoted-printable-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"
- "Decode and write current region encoded by quoted-printable into FILENAME."
- t)
-;; for encoded-word
-(autoload 'q-encoding-encode-string "mel-q"
- "Encode STRING to Q-encoding of encoded-word, and return the result.")
-(autoload 'q-encoding-decode-string "mel-q"
- "Decode STRING which is encoded in Q-encoding and return the result.")
-(autoload 'q-encoding-encoded-length "mel-q")
-
-(autoload 'uuencode-encode-region "mel-u"
- "Encode current region by unofficial uuencode format." t)
-(autoload 'uuencode-decode-region "mel-u"
- "Decode current region by unofficial uuencode format." t)
-(autoload 'uuencode-insert-encoded-file "mel-u"
- "Insert file encoded by unofficial uuencode format." t)
-(autoload 'uuencode-write-decoded-region "mel-u"
- "Decode and write current region encoded by uuencode into FILENAME." t)
-
-(autoload 'gzip64-encode-region "mel-g"
- "Encode current region by unofficial x-gzip64 format." t)
-(autoload 'gzip64-decode-region "mel-g"
- "Decode current region by unofficial x-gzip64 format." t)
-(autoload 'gzip64-insert-encoded-file "mel-g"
- "Insert file encoded by unofficial gzip64 format." t)
-(autoload 'gzip64-write-decoded-region "mel-g"
- "Decode and write current region encoded by gzip64 into FILENAME." t)
+(mel-use-module 'mel-b '("base64" "B"))
+(mel-use-module 'mel-q '("quoted-printable" "Q"))
+(mel-use-module 'mel-g '("x-gzip64"))
+(mel-use-module 'mel-u '("x-uue" "x-uuencode"))
+
+(if (featurep 'mule)
+ (mel-use-module 'mel-ccl '("base64" "quoted-printable" "B" "Q"))
+ )
+
+(if base64-dl-module
+ (mel-use-module 'mel-b-dl '("base64" "B"))
+ )
+
+(mel-define-method-function (mime-encode-string string (nil "7bit"))
+ 'identity)
+(mel-define-method-function (mime-decode-string string (nil "7bit"))
+ 'identity)
+(mel-define-method mime-encode-region (start end (nil "7bit")))
+(mel-define-method mime-decode-region (start end (nil "7bit")))
+(mel-define-method-function (mime-insert-encoded-file filename (nil "7bit"))
+ 'insert-file-contents-as-binary)
+(mel-define-method-function (mime-write-decoded-region
+ start end filename (nil "7bit"))
+ 'write-region-as-binary)
+
+(mel-define-method-function (mime-encode-string string (nil "8bit"))
+ 'identity)
+(mel-define-method-function (mime-decode-string string (nil "8bit"))
+ 'identity)
+(mel-define-method mime-encode-region (start end (nil "8bit")))
+(mel-define-method mime-decode-region (start end (nil "8bit")))
+(mel-define-method-function (mime-insert-encoded-file filename (nil "8bit"))
+ 'insert-file-contents-as-binary)
+(mel-define-method-function (mime-write-decoded-region
+ start end filename (nil "8bit"))
+ 'write-region-as-binary)
+
+(mel-define-method-function (mime-encode-string string (nil "binary"))
+ 'identity)
+(mel-define-method-function (mime-decode-string string (nil "binary"))
+ 'identity)
+(mel-define-method mime-encode-region (start end (nil "binary")))
+(mel-define-method mime-decode-region (start end (nil "binary")))
+(mel-define-method-function (mime-insert-encoded-file filename (nil "binary"))
+ 'insert-file-contents-as-binary)
+(mel-define-method-function (mime-write-decoded-region
+ start end filename (nil "binary"))
+ 'write-region-as-binary)
;;; @ region
;;;
;;;###autoload
-(defvar mime-encoding-method-alist
- '(("base64" . base64-encode-region)
- ("quoted-printable" . quoted-printable-encode-region)
- ;; Not standard, their use is DISCOURAGED.
- ;; ("x-uue" . uuencode-encode-region)
- ;; ("x-gzip64" . gzip64-encode-region)
- ("7bit")
- ("8bit")
- ("binary")
- )
- "Alist of encoding vs. corresponding method to encode region.
-Each element looks like (STRING . FUNCTION) or (STRING . nil).
-STRING is content-transfer-encoding.
-FUNCTION is region encoder and nil means not to encode.")
-
-;;;###autoload
-(defvar mime-decoding-method-alist
- '(("base64" . base64-decode-region)
- ("quoted-printable" . quoted-printable-decode-region)
- ("x-uue" . uuencode-decode-region)
- ("x-uuencode" . uuencode-decode-region)
- ("x-gzip64" . gzip64-decode-region)
- )
- "Alist of encoding vs. corresponding method to decode region.
-Each element looks like (STRING . FUNCTION).
-STRING is content-transfer-encoding.
-FUNCTION is region decoder.")
-
-;;;###autoload
(defun mime-encode-region (start end encoding)
"Encode region START to END of current buffer using ENCODING.
-ENCODING must be string. If ENCODING is found in
-`mime-encoding-method-alist' as its key, this function encodes the
-region by its value."
+ENCODING must be string."
(interactive
(list (region-beginning) (region-end)
(completing-read "encoding: "
- mime-encoding-method-alist
- nil t "base64"))
- )
- (let ((f (cdr (assoc encoding mime-encoding-method-alist))))
- (if f
- (funcall f start end)
- )))
+ (mapcar #'list mime-content-transfer-encoding-list)
+ nil t "base64")))
+ (funcall (mel-find-function 'mime-encode-region encoding) start end)
+ )
+
;;;###autoload
(defun mime-decode-region (start end encoding)
"Decode region START to END of current buffer using ENCODING.
-ENCODING must be string. If ENCODING is found in
-`mime-decoding-method-alist' as its key, this function decodes the
-region by its value."
+ENCODING must be string."
(interactive
(list (region-beginning) (region-end)
(completing-read "encoding: "
- mime-decoding-method-alist
- nil t "base64"))
- )
- (let ((f (cdr (assoc encoding mime-decoding-method-alist))))
- (if f
- (funcall f start end)
- )))
+ (mapcar #'list mime-content-transfer-encoding-list)
+ nil t "base64")))
+ (funcall (mel-find-function 'mime-decode-region encoding)
+ start end))
;;; @ string
;;;
;;;###autoload
-(defvar mime-string-decoding-method-alist
- '(("base64" . base64-decode-string)
- ("quoted-printable" . quoted-printable-decode-string)
- ("7bit" . identity)
- ("8bit" . identity)
- ("binary" . identity)
- )
- "Alist of encoding vs. corresponding method to decode string.
-Each element looks like (STRING . FUNCTION).
-STRING is content-transfer-encoding.
-FUNCTION is string decoder.")
-
-;;;###autoload
(defun mime-decode-string (string encoding)
"Decode STRING using ENCODING.
ENCODING must be string. If ENCODING is found in
`mime-string-decoding-method-alist' as its key, this function decodes
the STRING by its value."
- (let ((f (cdr (assoc encoding mime-string-decoding-method-alist))))
- (if f
- (funcall f string)
- (with-temp-buffer
- (insert string)
- (mime-decode-region (point-min)(point-max) encoding)
- (buffer-string)
- ))))
+ (funcall (mel-find-function 'mime-decode-string encoding)
+ string))
+
+
+(mel-define-service encoded-text-encode-string (string encoding)
+ "Encode STRING as encoded-text using ENCODING.
+ENCODING must be string.")
+
+(mel-define-service encoded-text-decode-string (string encoding)
+ "Decode STRING as encoded-text using ENCODING.
+ENCODING must be string.")
+
+(defun base64-encoded-length (string)
+ (let ((len (length string)))
+ (* (+ (/ len 3)
+ (if (= (mod len 3) 0) 0 1)
+ ) 4)
+ ))
+
+(defsubst Q-encoding-printable-char-p (chr mode)
+ (and (not (memq chr '(?= ?? ?_)))
+ (<= ?\ chr)(<= chr ?~)
+ (cond ((eq mode 'text) t)
+ ((eq mode 'comment)
+ (not (memq chr '(?\( ?\) ?\\)))
+ )
+ (t
+ (string-match "[A-Za-z0-9!*+/=_---]" (char-to-string chr))
+ ))))
+
+(defun Q-encoded-text-length (string &optional mode)
+ (let ((l 0)(i 0)(len (length string)) chr)
+ (while (< i len)
+ (setq chr (elt string i))
+ (if (Q-encoding-printable-char-p chr mode)
+ (setq l (+ l 1))
+ (setq l (+ l 3))
+ )
+ (setq i (+ i 1)) )
+ l))
;;; @ file
;;;
;;;###autoload
-(defvar mime-file-encoding-method-alist
- '(("base64" . base64-insert-encoded-file)
- ("quoted-printable" . quoted-printable-insert-encoded-file)
- ;; Not standard, their use is DISCOURAGED.
- ;; ("x-uue" . uuencode-insert-encoded-file)
- ;; ("x-gzip64" . gzip64-insert-encoded-file)
- ("7bit" . insert-file-contents-as-binary)
- ("8bit" . insert-file-contents-as-binary)
- ("binary" . insert-file-contents-as-binary)
- )
- "Alist of encoding vs. corresponding method to insert encoded file.
-Each element looks like (STRING . FUNCTION).
-STRING is content-transfer-encoding.
-FUNCTION is function to insert encoded file.")
-
-;;;###autoload
-(defvar mime-file-decoding-method-alist
- '(("base64" . base64-write-decoded-region)
- ("quoted-printable" . quoted-printable-write-decoded-region)
- ("x-uue" . uuencode-write-decoded-region)
- ("x-gzip64" . gzip64-write-decoded-region)
- ("7bit" . write-region-as-binary)
- ("8bit" . write-region-as-binary)
- ("binary" . write-region-as-binary)
- )
- "Alist of encoding vs. corresponding method to write decoded region to file.
-Each element looks like (STRING . FUNCTION).
-STRING is content-transfer-encoding.
-FUNCTION is function to write decoded region to file.")
-
-;;;###autoload
(defun mime-insert-encoded-file (filename encoding)
"Insert file FILENAME encoded by ENCODING format."
(interactive
(list (read-file-name "Insert encoded file: ")
(completing-read "encoding: "
- mime-encoding-method-alist
- nil t "base64"))
- )
- (let ((f (cdr (assoc encoding mime-file-encoding-method-alist))))
- (if f
- (funcall f filename)
- )))
+ (mapcar #'list mime-content-transfer-encoding-list)
+ nil t "base64")))
+ (funcall (mel-find-function 'mime-insert-encoded-file encoding)
+ filename))
+
;;;###autoload
(defun mime-write-decoded-region (start end filename encoding)
(list (region-beginning) (region-end)
(read-file-name "Write decoded region to file: ")
(completing-read "encoding: "
- mime-file-decoding-method-alist
+ (mapcar #'list mime-content-transfer-encoding-list)
nil t "base64")))
- (let ((f (cdr (assoc encoding mime-file-decoding-method-alist))))
- (if f
- (funcall f start end filename)
- )))
+ (funcall (mel-find-function 'mime-write-decoded-region encoding)
+ start end filename))
;;; @ end
;;; Code:
(defconst mime-library-version
- '("FLIM" "Shin-Tanabe" 1 9 2)
+ '("Chao" "Karasuma Oike" 1 9 0)
"Implementation name, version name and numbers of MIME-library package.")
(defconst mime-library-version-string
(concat mime-token-regexp "/" mime-token-regexp))
-;;; @@ Quoted-Printable
+;;; @@ base64 / B
+;;;
+
+(defconst base64-token-regexp "[A-Za-z0-9+/]")
+(defconst base64-token-padding-regexp "[A-Za-z0-9+/=]")
+
+(defconst B-encoded-text-regexp
+ (concat "\\(\\("
+ base64-token-regexp
+ base64-token-regexp
+ base64-token-regexp
+ base64-token-regexp
+ "\\)*"
+ base64-token-regexp
+ base64-token-regexp
+ base64-token-padding-regexp
+ base64-token-padding-regexp
+ "\\)"))
+
+;; (defconst eword-B-encoding-and-encoded-text-regexp
+;; (concat "\\(B\\)\\?" eword-B-encoded-text-regexp))
+
+
+;;; @@ Quoted-Printable / Q
;;;
(defconst quoted-printable-hex-chars "0123456789ABCDEF")
(concat "=[" quoted-printable-hex-chars
"][" quoted-printable-hex-chars "]"))
+(defconst Q-encoded-text-regexp
+ (concat "\\([^=?]\\|" quoted-printable-octet-regexp "\\)+"))
+
+;; (defconst eword-Q-encoding-and-encoded-text-regexp
+;; (concat "\\(Q\\)\\?" eword-Q-encoded-text-regexp))
+
;;; @ Content-Type
;;;
;;; @ for mm-backend
;;;
+(require 'alist)
+
(defvar mime-entity-implementation-alist nil)
(defmacro mm-define-backend (type &optional parents)
(put 'mm-define-method 'edebug-form-spec
'(&define name ((arg symbolp) &rest arg) def-body))
+(defsubst mm-arglist-to-arguments (arglist)
+ (let (dest)
+ (while arglist
+ (let ((arg (car arglist)))
+ (or (memq arg '(&optional &rest))
+ (setq dest (cons arg dest)))
+ )
+ (setq arglist (cdr arglist)))
+ (nreverse dest)))
+
+
+;;; @ for mel-backend
+;;;
+
+(defmacro mel-define-service (name &optional args &rest rest)
+ (if args
+ `(progn
+ (defvar ,(intern (format "%s-obarray" name)) (make-vector 1 nil))
+ (defun ,name ,args
+ ,@rest
+ (funcall (mel-find-function ',name ,(car (last args)))
+ ,@(mm-arglist-to-arguments (butlast args)))
+ ))
+ `(defvar ,(intern (format "%s-obarray" name)) (make-vector 1 nil))
+ ))
+
+(put 'mel-define-service 'lisp-indent-function 'defun)
+
+(defmacro mel-define-method (name args &rest body)
+ (let* ((specializer (car (last args)))
+ (class (nth 1 specializer)))
+ `(progn
+ (mel-define-service ,name)
+ (fset (intern ,class ,(intern (format "%s-obarray" name)))
+ (lambda ,(butlast args)
+ ,@body)))))
+
+(put 'mel-define-method 'lisp-indent-function 'defun)
+
+(defmacro mel-define-method-function (spec function)
+ (let* ((name (car spec))
+ (args (cdr spec))
+ (specializer (car (last args)))
+ (class (nth 1 specializer)))
+ `(let (sym)
+ (mel-define-service ,name)
+ (setq sym (intern ,class ,(intern (format "%s-obarray" name))))
+ (or (fboundp sym)
+ (fset sym (symbol-function ,function))))))
+
+(defmacro mel-define-function (function spec)
+ (let* ((name (car spec))
+ (args (cdr spec))
+ (specializer (car (last args)))
+ (class (nth 1 specializer)))
+ `(progn
+ (define-function ,function
+ (intern ,class ,(intern (format "%s-obarray" name))))
+ )))
+
;;; @ end
;;;
entity
args))
-(defsubst mm-arglist-to-arguments (arglist)
- (let (dest)
- (while arglist
- (let ((arg (car arglist)))
- (or (memq arg '(&optional &rest))
- (setq dest (cons arg dest)))
- )
- (setq arglist (cdr arglist)))
- (nreverse dest)))
-
(defmacro mm-define-generic (name args &optional doc)
(if doc
`(defun ,(intern (format "mime-%s" name)) ,args
projects / elisp / flim.git / commitdiff