2000-12-04 Daiki Ueno <ueno@unixuser.org>
- * luna.el (luna-class-find-functions): Don't quote colon keywords.
- (luna-send): Ditto.
- (luna-call-next-method): Ditto.
-
-2000-11-28 Daiki Ueno <ueno@unixuser.org>
-
- * luna.el: Don't require `static'.
- (luna-define-class-function): Don't bind colon keywords.
- (luna-class-find-functions): Quote colon keywords.
- (luna-send): Likewise.
- (luna-call-next-method): Likewise.
-
-2000-11-12 Daiki Ueno <ueno@unixuser.org>
-
- * luna.el (luna-define-method): Clear method cache.
- (luna-apply-generic): New function.
- (luna-define-generic): Use `luna-apply-generic' instead of
- `luna-send'.
-
-2000-12-04 Daiki Ueno <ueno@unixuser.org>
-
* smtpmail.el (smtpmail-send-it): Use `smtp-send-buffer' instead of
`smtp-via-smtp'.
(smtpmail-send-queued-mail): Ditto.
* mmexternal.el: New module.
+\f
+1999-12-14 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * CLIME: Version 1.13.6 (Nakanosh\e-Dò)\e-A released.
+
1999-12-13 Katsumi Yamaoka <yamaoka@jpl.org>
* README.en, README.ja, mime-en.sgml, mime-ja.sgml: Update for the
recent ML address and ftp site.
+1999-11-12 Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
+
+ * mel-q-ccl.el (q-encoding-ccl-encoded-length): Removed comment.
+
+1999-10-21 Tsukamoto Tetsuo <czkmt@remus.dti.ne.jp>
+
+ * eword-decode.el (mime-set-field-decoder): Doc string typo.
+
1999-10-17 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
* FLIM-MK (install-flim-package): Delete auto-autoloads.el
and custom-load.el
+\f
+1999-10-18 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * CLIME: Version 1.13.5 (Kaga-Fukuoka) released.
+
1999-09-20 Katsumi Yamaoka <yamaoka@jpl.org>
* mailcap.el (mailcap-look-at-schar): Protect against unexpected
* smtpmail.el (smtpmail-send-it): Remove needless `concat'.
-1999-09-08 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
+\f
+1999-09-13 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * CLIME: Version 1.13.4 (Shin-Terai) released.
+
+1999-09-13 MORIOKA Tomohiko <tomo@m17n.org>
- * mime-ja.sgml, mime-en.sgml (Entity creation): Fix typo.
+ * README.en (Installation): Modify for APEL 9.22; modify location
+ of APEL.
1999-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
1999-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
+ * FLIM-CFG: Emulate `add-to-list' and `data-directory' for old
+ Emacsen; require `poe' if the function `member' is not bound
+ because the function `add-path' uses it.
+
* smtpmail.el (smtpmail-send-it): Use `time-stamp-yyyy-mm-dd' and
`time-stamp-hh:mm:ss' instead of `current-time'.
* FLIM-ELS: Use `if' instead of `unless'.
\f
+1999-08-24 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * CLIME: Version 1.13.3 (Hirahata) released.
+
+ * README.en (Installation): Modify for APEL 9.21.
+
+1999-08-24 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime-def.el: Don't require cl.
+ (make-mime-content-type): Don't use `list*'.
+
+1999-08-24 Taiji Can <Taiji.Can@atesoft.advantest.co.jp>
+
+ * mime-def.el: Use `int-to-string' instead of `number-to-string'.
+
+\f
+1999-08-23 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * CLIME: Version 1.13.2 (Nukatabe) released.
+
+1999-08-19 TSUMURA Tomoaki <tsumura@kuis.kyoto-u.ac.jp>
+
+ * mel-b-el.el (base64-num-to-char): Use <(` ...)> and <(, ...)>
+ instead of <`...> and <,...>.
+ (base64-char-to-num): Likewise.
+
+1999-08-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mel-b-ccl.el (mel-ccl-decode-b): Use <(` ...)>, <(, ...)> and
+ <(,@ ...)> instead of <`...>, <,...> and <,@...> unless
+ `ccl-cascading-read' is broken.
+
+ * mel-q-ccl.el (mel-ccl-decode-quoted-printable-generic): Fix
+ quotation.
+
+1999-08-19 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+
+ * mel-b-ccl.el (mel-ccl-decode-b): Use <(` ...)>, <(, ...)> and
+ <(,@ ...)> instead of <`...>, <,...> and <,@...>.
+ (mel-ccl-encode-base64-generic): Likewise.
+
+ * mel-q-ccl.el (mel-ccl-decode-q): Use <(` ...)>, <(, ...)> and
+ <(,@ ...)> instead of <`...>, <,...> and <,@...>.
+ (mel-ccl-encode-q-generic): Likewise.
+ (mel-ccl-count-q-length): Likewise.
+ (mel-ccl-set-eof-block): Likewise.
+ (mel-ccl-try-to-read-crlf): Likewise.
+ (mel-ccl-encode-quoted-printable-generic): Likewise.
+ (mel-ccl-decode-quoted-printable-generic): Likewise.
+
+\f
+1999-08-19 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * CLIME: Version 1.13.1 (Ando) released.
+
+1999-08-19 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * luna.el (luna-define-generic): Use <(` ...)>, <(, ...)> and <(,@
+ ...)> instead of <`...>, <,...> and <,@...>.
+ (luna-define-internal-accessors): Use <(` ...)> and <(, ...)>
+ instead of <`...> and <,...>.
+
+1999-08-19 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * smtpmail.el (smtpmail-send-it): Don't use bare lambda.
+
+ * mime-def.el (mm-define-backend): Don't use bare lambda.
+ (mel-define-backend): Likewise.
+ (mel-define-method): Likewise.
+
+ * luna.el (luna-define-class-function): Don't use bare lambda.
+ (luna-define-method): Likewise.
+ (luna-define-internal-accessors): Likewise.
+
+ * mime-def.el: Delete <(require 'custom)>.
+
+\f
+1999-08-19 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * CLIME: Version 1.13.0 (Shin-H\e-Dòryþji)\e-A released.
+
+1999-08-18 MORIOKA Tomohiko <tomo@m17n.org>
+
+ * mime.el (mime-entity-send): Use <(` ...)>, <(, ...)> and <(,@
+ ...)> instead of <`...>, <,...> and <,@...>.
+
+ * mime-parse.el (mime-parse-Content-Type): Use
+ `eval-when-compile'.
+
+ * mime-def.el (mime-product-name): Use <(` ...)> and <(, ...)>
+ instead of <`...> and <,...>.
+ (mime-product-version): Likewise.
+ (mime-product-code-name): Likewise.
+ (mime-library-version): Use <(function ...)> instead of <#'...>.
+ (mm-expand-class-name): Use <(` ...)> and <(, ...)> instead of
+ <`...> and <,...>.
+ (mm-define-backend): Likewise.
+ (mm-define-method): Use <(` ...)>, <(, ...)> and <(,@ ...)>
+ instead of <`...>, <,...> and <,@...>.
+ (mel-define-service): Likewise.
+ (mel-define-backend): Use <(` ...)> and <(, ...)> instead of
+ <`...> and <,...>.
+ (mel-define-method-function): Likewise.
+ (mel-define-function): Likewise.
+
+ * mel.el (mime-encoding-alist): Use <(function ...)> instead of
+ <#'...>.
+
+ * luna.el (luna-find-class): Use <(` ...)> and <(, ...)> instead
+ of <`...> and <,...>.
+ (luna-set-class): Likewise.
+ (luna-class-obarray): Likewise.
+ (luna-class-parents): Likewise.
+ (luna-class-number-of-slots): Likewise.
+ (luna-define-class): Likewise.
+ (luna-class-slot-index): Likewise.
+ (luna-slot-index): Likewise.
+ (luna-define-method): Use <(` ...)>, <(, ...)> and <(,@ ...)>
+ instead of <`...>, <,...> and <,@...>.
+ (luna-find-functions): Use <(` ...)> and <(, ...)> instead of
+ <`...> and <,...>.
+ (luna-class-name): Likewise.
+ (luna-set-class-name): Likewise.
+ (luna-get-obarray): Likewise.
+ (luna-set-obarray): Likewise.
+ (luna-make-entity): Use <(function ...)> instead of <#'...>.
+
+ * eword-decode.el (mime-find-field-presentation-method): Use <(`
+ ...)> and <(, ...)> instead of <`...> and <,...>.
+ - Use <(function ...)> instead of <#'...>.
+
+\f
1999-08-17 MORIOKA Tomohiko <tomo@m17n.org>
* FLIM: Version 1.13.2 (Kasanui) released.
1999-08-03 Yuuichi Teranishi <teranisi@gohome.org>
-
+
* smtp.el (smtp-notify-success): New option.
* (smtp-via-smtp): Request return receipt (defined in RFC1891) to
SMTP server if `smtp-notify-success' is non-nil.
\f
1998-07-01 MORIOKA Tomohiko <morioka@jaist.ac.jp>
- * FLIM: Version 1.8.0 (\83\81kubo) was released.
+ * FLIM: Version 1.8.0 (\e-DÒkubo)\e-A was released.
* README.en: Delete `How to use'.
(defvar default-load-path load-path)
+(if (fboundp 'add-to-list)
+ nil
+ ;; Emacs 19.29 emulating function.
+ (defun add-to-list (list-var element)
+ (set list-var (cons element (symbol-value list-var))))
+ )
+
+(if (boundp 'data-directory)
+ nil
+ ;; Emacs 19 emulating variable.
+ (defvar data-directory exec-directory)
+ )
+
(add-to-list 'load-path
(expand-file-name "../../site-lisp/apel" data-directory))
(if (boundp 'VERSION_SPECIFIC_LISPDIR)
(add-to-list 'load-path VERSION_SPECIFIC_LISPDIR))
+(if (fboundp 'member)
+ nil
+ ;; It is needed because the function `add-path' uses it.
+ (require 'poe))
+
(require 'install)
(add-latest-path "custom")
# Makefile for FLIM.
#
-PACKAGE = flim
+PACKAGE = clime
API = 1.14
RELEASE = 0
\e$BF3F~\e(B (install)
==============
-(0) \e$BF3F~\e(B (install) \e$B$9$kA0$K!"\e(BAPEL (9.22 \e$B0J9_\e(B) \e$B$rF3F~$7$F$/$@$5$$!#\e(BAPEL
+(0) \e$BF3F~\e(B (install) \e$B$9$kA0$K!"\e(BAPEL (9.19 \e$B0J9_\e(B) \e$B$rF3F~$7$F$/$@$5$$!#\e(BAPEL
\e$B$O0J2<$N$H$3$m$G<hF@$G$-$^$9\e(B:
ftp://ftp.m17n.org/pub/mule/apel/
1.14.0 Momoyama \e$(BEm;3\e(B
1.14.1 Rokujiz\e-Dò\e-A \e$(BO;COB"\e(B
------ Kohata \e$(BLZH(\e(B
+
+
+[CLIME Version names]
+
+;;-------------------------------------------------------------------------
+;; \e$(BBg:eEE5$50F;\e(B
+;; \e$(BK!N4;{@~\e(B \e$(B!J5l\e(B \e$(BE7M}7ZJXoDF;\e(B \e$(BE7M}@~!K\e(B
+;;-------------------------------------------------------------------------
+1.13.0 Shin-H\e-Dòryþji\e-A \e$(B?7K!N4;{\e(B ; <=> \e$(B4X@>K\@~\e(B \e$(BK!N4;{\e(B
+1.13.1 Ando \e$(B0BEH\e(B
+1.13.2 Nukatabe \e$(B3[EDIt\e(B
+1.13.3 Hirahata \e$(BJ?C<\e(B ; = \e$(BBg50\e(B \e$(BE7M}@~!"@&K5@~\e(B
+
+;;-------------------------------------------------------------------------
+;; Hokuriku Railway \e$(BKLN&E4F;\e(B
+;; Nomi Line \e$(BG=H~@~\e(B \e$(B!J5l\e(B \e$(BG=H~EE5$E4F;!K\e(B
+;;-------------------------------------------------------------------------
+1.13.4 Shin-Terai \e$(B?7;{0f\e(B ; <=> \e$(BKLN&K\@~\e(B \e$(B;{0f\e(B
+1.13.5 Kaga-Fukuoka \e$(B2C2lJ!2,\e(B
+1.13.6 Nakanosh\e-Dò\e-A \e$(BCf%N>1\e(B
+1.14.0 Gokend\e-Dò\e-A \e$(B8^4VF2\e(B
;;;###autoload
(defun mime-set-field-decoder (field &rest specs)
- "Set decoder of FILED.
+ "Set decoder of FIELD.
SPECS must be like `MODE1 DECODER1 MODE2 DECODER2 ...'.
Each mode must be `nil', `plain', `wide', `summary' or `nov'.
If mode is `nil', corresponding decoder is set up for every modes."
"Return field-presentation-method from NAME.
NAME must be `plain', `wide', `summary' or `nov'."
(cond ((eq name nil)
- `(or (assq 'summary mime-field-decoder-cache)
- '(summary))
- )
+ (` (or (assq 'summary mime-field-decoder-cache)
+ '(summary))
+ ))
((and (consp name)
(car name)
(consp (cdr name))
(symbolp (car (cdr name)))
(null (cdr (cdr name))))
- `(or (assq ,name mime-field-decoder-cache)
- (cons ,name nil))
- )
+ (` (or (assq (, name) mime-field-decoder-cache)
+ (cons (, name) nil))
+ ))
(t
- `(or (assq (or ,name 'summary) mime-field-decoder-cache)
- (cons (or ,name 'summary) nil))
+ (` (or (assq (or (, name) 'summary) mime-field-decoder-cache)
+ (cons (or (, name) 'summary) nil)))
)))
(defun mime-find-field-decoder-internal (field &optional mode)
(setq field (pop fields))
(mime-set-field-decoder
field
- 'plain #'eword-decode-structured-field-body
- 'wide #'eword-decode-and-fold-structured-field-body
- 'summary #'eword-decode-and-unfold-structured-field-body
- 'nov #'eword-decode-and-unfold-structured-field-body)
- ))
+ 'plain (function eword-decode-structured-field-body)
+ 'wide (function eword-decode-and-fold-structured-field-body)
+ 'summary (function eword-decode-and-unfold-structured-field-body)
+ 'nov (function eword-decode-and-unfold-structured-field-body)
+ )))
;; unstructured fields (default)
(mime-set-field-decoder
t
- 'plain #'eword-decode-unstructured-field-body
- 'wide #'eword-decode-unstructured-field-body
- 'summary #'eword-decode-and-unfold-unstructured-field-body
- 'nov #'eword-decode-unfolded-unstructured-field-body)
+ 'plain (function eword-decode-unstructured-field-body)
+ 'wide (function eword-decode-unstructured-field-body)
+ 'summary (function eword-decode-and-unfold-unstructured-field-body)
+ 'nov (function eword-decode-unfolded-unstructured-field-body))
;;;###autoload
(defun mime-decode-field-body (field-body field-name
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
+
+(static-condition-case nil
+ :symbol-for-testing-whether-colon-keyword-is-available-or-not
+ (void-variable
+ (defconst :before ':before)
+ (defconst :after ':after)
+ (defconst :around ':around)))
+
;;; @ class
;;;
(defmacro luna-find-class (name)
"Return the luna-class of the given NAME."
- `(get ,name 'luna-class))
+ (` (get (, name) 'luna-class)))
(defmacro luna-set-class (name class)
- `(put ,name 'luna-class ,class))
+ (` (put (, name) 'luna-class (, class))))
(defmacro luna-class-obarray (class)
- `(aref ,class 1))
+ (` (aref (, class) 1)))
(defmacro luna-class-parents (class)
- `(aref ,class 2))
+ (` (aref (, class) 2)))
(defmacro luna-class-number-of-slots (class)
- `(aref ,class 3))
+ (` (aref (, class) 3)))
(defmacro luna-define-class (type &optional parents slots)
"Define TYPE as a luna-class.
If PARENTS is specified, TYPE inherits PARENTS.
Each parent must be name of luna-class (symbol).
If SLOTS is specified, TYPE will be defined to have them."
- `(luna-define-class-function ',type ',(append parents '(standard-object))
- ',slots))
+ (` (luna-define-class-function '(, type)
+ '(, (append parents '(standard-object)))
+ '(, slots))))
(defun luna-define-class-function (type &optional parents slots)
+ (static-condition-case nil
+ :symbol-for-testing-whether-colon-keyword-is-available-or-not
+ (void-variable
+ (let (key)
+ (dolist (slot slots)
+ (setq key (intern (format ":%s" slot)))
+ (set key key)))))
(let ((oa (make-vector 31 0))
(rest parents)
parent name
(while rest
(setq parent (pop rest)
b (- i 2))
- (mapatoms (lambda (sym)
- (when (setq j (get sym 'luna-slot-index))
- (setq name (symbol-name sym))
- (unless (intern-soft name oa)
- (put (intern name oa) 'luna-slot-index (+ j b))
- (setq i (1+ i)))))
- (luna-class-obarray (luna-find-class parent))))
+ (mapatoms (function
+ (lambda (sym)
+ (when (setq j (get sym 'luna-slot-index))
+ (setq name (symbol-name sym))
+ (unless (intern-soft name oa)
+ (put (intern name oa) 'luna-slot-index (+ j b))
+ (setq i (1+ i))
+ ))))
+ (luna-class-obarray (luna-find-class parent)))
+ )
(setq rest slots)
(while rest
(setq name (symbol-name (pop rest)))
(intern member-name (luna-class-obarray class)))
(defmacro luna-class-slot-index (class slot-name)
- `(get (luna-class-find-member ,class ,slot-name) 'luna-slot-index))
+ (` (get (luna-class-find-member (, class) (, slot-name)) 'luna-slot-index)))
(defmacro luna-define-method (name &rest definition)
"Define NAME as a method function of a class.
(setq specializer (car args)
class (nth 1 specializer)
self (car specializer))
- `(let ((func (lambda ,(if self
- (cons self (cdr args))
- (cdr args))
- ,@definition))
- (sym (luna-class-find-or-make-member
- (luna-find-class ',class) ',name))
- (cache (get ',name 'luna-method-cache)))
- (if cache
- (unintern ',class cache))
- (fset sym func)
- (put sym 'luna-method-qualifier ,method-qualifier))))
+ (` (let ((func (function
+ (lambda (, (if self
+ (cons self (cdr args))
+ (cdr args)))
+ (,@ definition))))
+ (sym (luna-class-find-or-make-member
+ (luna-find-class '(, class)) '(, name))))
+ (fset sym func)
+ (put sym 'luna-method-qualifier (, method-qualifier))
+ ))
+ ))
(put 'luna-define-method 'lisp-indent-function 'defun)
(defmacro luna-class-name (entity)
"Return class-name of the ENTITY."
- `(aref ,entity 0))
+ (` (aref (, entity) 0)))
(defmacro luna-set-class-name (entity name)
- `(aset ,entity 0 ,name))
+ (` (aset (, entity) 0 (, name))))
(defmacro luna-get-obarray (entity)
- `(aref ,entity 1))
+ (` (aref (, entity) 1)))
(defmacro luna-set-obarray (entity obarray)
- `(aset ,entity 1 ,obarray))
+ (` (aset (, entity) 1 (, obarray))))
(defmacro luna-slot-index (entity slot-name)
- `(luna-class-slot-index (luna-find-class (luna-class-name ,entity))
- ,slot-name))
+ (` (luna-class-slot-index (luna-find-class (luna-class-name (, entity)))
+ (, slot-name))))
(defsubst luna-slot-value (entity slot)
"Return the value of SLOT of ENTITY."
(aset entity (luna-slot-index entity slot) value))
(defmacro luna-find-functions (entity service)
- `(luna-class-find-functions (luna-find-class (luna-class-name ,entity))
- ,service))
+ (` (luna-class-find-functions (luna-find-class (luna-class-name (, entity)))
+ (, service))))
(defsubst luna-send (entity message &rest luna-current-method-arguments)
"Send MESSAGE to ENTITY, and return the result.
(v (make-vector (luna-class-number-of-slots c) nil)))
(luna-set-class-name v type)
(luna-set-obarray v (make-vector 7 0))
- (apply #'luna-send v 'initialize-instance v init-args)))
+ (apply (function luna-send) v 'initialize-instance v init-args)))
;;; @ interface (generic function)
;;;
-(defun luna-apply-generic (entity message &rest luna-current-method-arguments)
- (let* ((class (luna-class-name entity))
- (cache (get message 'luna-method-cache))
- (sym (intern-soft (symbol-name class) cache))
- luna-next-methods)
- (if sym
- (setq luna-next-methods (symbol-value sym))
- (setq luna-next-methods
- (luna-find-functions entity message))
- (set (intern (symbol-name class) cache)
- luna-next-methods))
- (luna-call-next-method)))
-
(defsubst luna-arglist-to-arguments (arglist)
(let (dest)
(while arglist
"Define generic-function NAME.
ARGS is argument of and DOC is DOC-string."
(if doc
- `(progn
- (defun ,(intern (symbol-name name)) ,args
- ,doc
- (luna-apply-generic ,(car args) ',name
- ,@(luna-arglist-to-arguments args)))
- (put ',name 'luna-method-cache (make-vector 31 0)))
- `(progn
- (defun ,(intern (symbol-name name)) ,args
- (luna-apply-generic ,(car args) ',name
- ,@(luna-arglist-to-arguments args)))
- (put ',name 'luna-method-cache (make-vector 31 0)))))
+ (` (defun (, (intern (symbol-name name))) (, args)
+ (, doc)
+ (luna-send (, (car args)) '(, name)
+ (,@ (luna-arglist-to-arguments args)))
+ ))
+ (` (defun (, (intern (symbol-name name))) (, args)
+ (luna-send (, (car args)) '(, name)
+ (,@ (luna-arglist-to-arguments args)))
+ ))))
(put 'luna-define-generic 'lisp-indent-function 'defun)
(let ((entity-class (luna-find-class class-name))
parents parent-class)
(mapatoms
- (lambda (slot)
- (if (luna-class-slot-index entity-class slot)
- (catch 'derived
- (setq parents (luna-class-parents entity-class))
- (while parents
- (setq parent-class (luna-find-class (car parents)))
- (if (luna-class-slot-index parent-class slot)
- (throw 'derived nil))
- (setq parents (cdr parents)))
- (eval
- `(progn
- (defmacro ,(intern (format "%s-%s-internal"
- class-name slot))
- (entity)
- (list 'aref entity
- ,(luna-class-slot-index entity-class
- (intern (symbol-name slot)))))
- (defmacro ,(intern (format "%s-set-%s-internal"
- class-name slot))
- (entity value)
- (list 'aset entity
- ,(luna-class-slot-index
- entity-class (intern (symbol-name slot)))
- value)))))))
+ (function
+ (lambda (slot)
+ (if (luna-class-slot-index entity-class slot)
+ (catch 'derived
+ (setq parents (luna-class-parents entity-class))
+ (while parents
+ (setq parent-class (luna-find-class (car parents)))
+ (if (luna-class-slot-index parent-class slot)
+ (throw 'derived nil))
+ (setq parents (cdr parents))
+ )
+ (eval
+ (` (progn
+ (defmacro (, (intern (format "%s-%s-internal"
+ class-name slot)))
+ (entity)
+ (list 'aref entity
+ (, (luna-class-slot-index entity-class
+ (intern (symbol-name slot))))
+ ))
+ (defmacro (, (intern (format "%s-set-%s-internal"
+ class-name slot)))
+ (entity value)
+ (list 'aset entity
+ (, (luna-class-slot-index
+ entity-class (intern (symbol-name slot))))
+ value))
+ )))
+ ))))
(luna-class-obarray entity-class))))
(if-broken ccl-cascading-read
(define-ccl-program mel-ccl-decode-b
- `(1
- (loop
- (loop
- (read-branch
- r1
- ,@(mapcar
- (lambda (v)
- (cond
- ((or (eq v nil) (eq v t)) '(repeat))
- (t `((r0 = ,(lsh v 2)) (break)))))
- mel-ccl-256-to-64-table)))
- (loop
- (read-branch
- r1
- ,@(mapcar
- (lambda (v)
- (cond
- ((or (eq v nil) (eq v t)) '(repeat))
- ((= (lsh v -4) 0) `((write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))
- (t `((r0 |= ,(lsh v -4)) (write r0) (r0 = ,(lsh (logand v 15) 4)) (break)))))
- mel-ccl-256-to-64-table)))
- (loop
- (read-branch
- r1
- ,@(mapcar
- (lambda (v)
- (cond
- ((eq v nil) '(repeat))
- ((eq v t) '(end))
- ((= (lsh v -2) 0) `((write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))
- (t `((r0 |= ,(lsh v -2)) (write r0) (r0 = ,(lsh (logand v 3) 6)) (break)))))
- mel-ccl-256-to-64-table)))
- (loop
- (read-branch
- r1
- ,@(mapcar
- (lambda (v)
- (cond
- ((eq v nil) '(repeat))
- ((eq v t) '(end))
- (t `((r0 |= ,v) (write r0) (break)))))
- mel-ccl-256-to-64-table)))
- (repeat))))
+ (` (1
+ (loop
+ (loop
+ (read-branch
+ r1
+ (,@ (mapcar
+ (lambda (v)
+ (cond
+ ((or (eq v nil) (eq v t)) '(repeat))
+ (t (` ((r0 = (, (lsh v 2))) (break))))))
+ mel-ccl-256-to-64-table))))
+ (loop
+ (read-branch
+ r1
+ (,@ (mapcar
+ (lambda (v)
+ (cond
+ ((or (eq v nil) (eq v t)) '(repeat))
+ ((= (lsh v -4) 0)
+ (` ((write r0)
+ (r0 = (, (lsh (logand v 15) 4)))
+ (break))))
+ (t
+ (` ((r0 |= (, (lsh v -4)))
+ (write r0)
+ (r0 = (, (lsh (logand v 15) 4)))
+ (break))))))
+ mel-ccl-256-to-64-table))))
+ (loop
+ (read-branch
+ r1
+ (,@ (mapcar
+ (lambda (v)
+ (cond
+ ((eq v nil) '(repeat))
+ ((eq v t) '(end))
+ ((= (lsh v -2) 0)
+ (` ((write r0)
+ (r0 = (, (lsh (logand v 3) 6)))
+ (break))))
+ (t
+ (` ((r0 |= (, (lsh v -2)))
+ (write r0)
+ (r0 = (, (lsh (logand v 3) 6)))
+ (break))))))
+ mel-ccl-256-to-64-table))))
+ (loop
+ (read-branch
+ r1
+ (,@ (mapcar
+ (lambda (v)
+ (cond
+ ((eq v nil) '(repeat))
+ ((eq v t) '(end))
+ (t (` ((r0 |= (, v)) (write r0) (break))))))
+ mel-ccl-256-to-64-table))))
+ (repeat)))))
(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)
+ (` (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)
- (r4 >8= 0)
- (write r7)
- (write (r4 & 255))
- (end) ; Excessive (end) is workaround for XEmacs 21.0.
+ (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))))))
+ (end))
+ ;; BB==
+ ((write (r4 & 255))
+ (end))))
+ ((r4 >8= 0)
+ (write r7)
+ (r4 >8= 0)
+ (write r7)
+ (write-repeat r4)))))))
)
(eval-when-compile
;; is not executed.
(defun mel-ccl-encode-base64-generic
(&optional quantums-per-line output-crlf terminate-with-newline)
- `(2
- ((r3 = 0)
- (r2 = 0)
- (read r1)
- (loop
+ (` (2
+ ((r3 = 0)
+ (r2 = 0)
+ (read r1)
+ (loop
+ (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)
+ (r2 = 0)
+ (read r1)
+ (,@ (when quantums-per-line
+ (` ((if (r3 == (, quantums-per-line))
+ ((write (, (if output-crlf "\r\n" "\n")))
+ (r3 = 0)))))))
+ (repeat)))
(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)
- (r2 = 0)
- (read r1)
- ,@(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")
- "="))))
- ))
+ 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
)
(defmacro base64-num-to-char (n)
- `(aref base64-characters ,n))
+ (` (aref base64-characters (, n))))
(defun base64-encode-1 (pack)
(let ((buf (make-string 4 ?=)))
vec)))
(defmacro base64-char-to-num (c)
- `(aref base64-numbers ,c))
+ (` (aref base64-numbers (, c))))
(defsubst base64-internal-decode (string buffer)
(let* ((len (length string))
;;; 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))))))
+ (` (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))))
+ (` (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))))))
+ (` (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))))))))
)
(unless p
(setq p (cons branch (length eof-block-branches))
eof-block-branches (cons p eof-block-branches)))
- `(,eof-block-reg = ,(cdr p))))
+ (` ((, eof-block-reg) = (, (cdr p))))))
)
lf-eof lf-fail
crlf-eof crlf-fail)
(if input-crlf
- `(,(mel-ccl-set-eof-block cr-eof)
- (read-if (,reg == ?\r)
- (,(mel-ccl-set-eof-block lf-eof)
- (read-if (,reg == ?\n)
- ,succ
- ,lf-fail))
- ,cr-fail))
- `(,(mel-ccl-set-eof-block crlf-eof)
- (read-if (,reg == ?\n)
- ,succ
- ,crlf-fail))))
+ (` ((, (mel-ccl-set-eof-block cr-eof))
+ (read-if ((, reg) == ?\r)
+ ((, (mel-ccl-set-eof-block lf-eof))
+ (read-if ((, reg) == ?\n)
+ (, succ)
+ (, lf-fail)))
+ (, cr-fail))))
+ (` ((, (mel-ccl-set-eof-block crlf-eof))
+ (read-if ((, reg) == ?\n)
+ (, succ)
+ (, crlf-fail))))))
)
(type-wsp 2)
(type-brk 3)
)
- `(4
- ((,column = 0)
- (,after-wsp = 0)
- ,(mel-ccl-set-eof-block '(end))
- (read r0)
- (loop ; invariant: column <= 75
- (loop
- (loop
- (branch
- r0
- ,@(mapcar
- (lambda (r0)
- (let ((tmp (aref mel-ccl-qp-table r0)))
- (cond
- ((eq r0 (char-int ?F))
- `(if (,column == 0)
- (,(mel-ccl-set-eof-block '((write "F") (end)))
- (read-if (r0 == ?r)
- (,(mel-ccl-set-eof-block '((write "Fr") (end)))
- (read-if (r0 == ?o)
- (,(mel-ccl-set-eof-block '((write "Fro") (end)))
- (read-if (r0 == ?m)
- (,(mel-ccl-set-eof-block '((write "From") (end)))
- (read-if (r0 == ? )
- ((,column = 7)
- (,after-wsp = 1)
- ,(mel-ccl-set-eof-block '((write "From=20") (end)))
- (read r0)
- (write-repeat "=46rom "))
- ((,column = 4)
- (write-repeat "From"))))
- ((,column = 3)
- (write-repeat "Fro"))))
- ((,column = 2)
- (write-repeat "Fr"))))
- ((,column = 1)
- (write-repeat "F"))))
- ((,type = ,type-raw) (break)) ; RAW
- ))
- ((eq r0 (char-int ?.))
- `(if (,column == 0)
- ,(mel-ccl-try-to-read-crlf
- input-crlf 'r0
- ;; "." CR LF (input-crlf: t)
- ;; "." LF (input-crlf: nil)
- `((write ,(concat "=2E" hard))
- ,(mel-ccl-set-eof-block '(end))
- (read r0)
- (repeat))
- ;; "." <EOF>
- '((write ".") (end))
- ;; "." noCR (input-crlf: t)
- `((,column = 1)
- (write-repeat "."))
- ;; "." CR <EOF> (input-crlf: t)
- '((write ".=0D") (end))
- ;; "." CR noLF (input-crlf: t)
- `((,column = 4)
- (write-repeat ".=0D"))
- ;; "." <EOF> (input-crlf: nil)
- '((write ".") (end))
- ;; "." noLF (input-crlf: nil)
- `((,column = 1)
- (write-repeat ".")))
- ((,type = ,type-raw) (break)) ; RAW
- ))
- ((eq tmp 'raw) `((,type = ,type-raw) (break)))
- ((eq tmp 'enc) `((,type = ,type-enc) (break)))
- ((eq tmp 'wsp) `((,type = ,type-wsp) (break)))
- ((eq tmp 'cr) `((,type = ,(if input-crlf type-brk type-enc))
- (break)))
- ((eq tmp 'lf) `((,type = ,(if input-crlf type-enc type-brk))
- (break)))
- )))
- mel-ccl-256-table)))
- ;; r0:type{raw,enc,wsp,brk}
- (branch
- ,type
- ;; r0:type-raw
- (if (,column < 75)
- ((,column += 1)
- (,after-wsp = 0)
- ,(mel-ccl-set-eof-block '(end))
- (write-read-repeat r0))
- ((r1 = (r0 + 0))
- (,after-wsp = 0)
- ,@(mel-ccl-try-to-read-crlf
- input-crlf 'r0
- `((,column = 0)
- (write r1)
- ,(mel-ccl-set-eof-block `((write ,hard) (end)))
- (read r0)
- (write-repeat ,hard))
- '((write r1) (end))
- `((,column = 1)
- (write ,soft) (write-repeat r1))
- `((write ,soft) (write r1) (write "=0D") (end))
- `((,column = 4)
- (write ,soft) (write r1) (write-repeat "=0D"))
- '((write r1) (end))
- `((,column = 1)
- (write ,soft) (write-repeat r1)))))
- ;; r0:type-enc
- ((,after-wsp = 0)
- (if (,column < 73)
- ((,column += 3)
- (write "=")
- (write r0 ,mel-ccl-high-table)
- ,(mel-ccl-set-eof-block '(end))
- (write-read-repeat r0 ,mel-ccl-low-table))
- (if (,column < 74)
- ((r1 = (r0 + 0))
- (,after-wsp = 0)
- ,@(mel-ccl-try-to-read-crlf
- input-crlf 'r0
- `((,column = 0)
- (write "=")
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (write ,hard)
- ,(mel-ccl-set-eof-block '(end))
- (read r0)
- (repeat))
- `((write "=")
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (end))
- `((,column = 3)
- (write ,(concat soft "="))
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (repeat))
- `((write ,(concat soft "="))
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (write "=0D")
- (end))
- `((,column = 6)
- (write ,(concat soft "="))
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (write-repeat "=0D"))
- `((write "=")
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (end))
- `((,column = 3)
- (write ,(concat soft "="))
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (repeat))))
- ((,column = 3)
- (write ,(concat soft "="))
- (write r0 ,mel-ccl-high-table)
- ,(mel-ccl-set-eof-block '(end))
- (write-read-repeat r0 ,mel-ccl-low-table)))))
- ;; r0:type-wsp
- (if (,column < 73)
+ (` (4
+ (((, column) = 0)
+ ((, after-wsp) = 0)
+ (, (mel-ccl-set-eof-block '(end)))
+ (read r0)
+ (loop ; invariant: column <= 75
+ (loop
+ (loop
+ (branch
+ r0
+ (,@ (mapcar
+ (lambda (r0)
+ (let ((tmp (aref mel-ccl-qp-table r0)))
+ (cond
+ ((eq r0 (char-int ?F))
+ (` (if ((, column) == 0)
+ ((, (mel-ccl-set-eof-block '((write "F") (end))))
+ (read-if (r0 == ?r)
+ ((, (mel-ccl-set-eof-block '((write "Fr") (end))))
+ (read-if (r0 == ?o)
+ ((, (mel-ccl-set-eof-block '((write "Fro") (end))))
+ (read-if (r0 == ?m)
+ ((, (mel-ccl-set-eof-block '((write "From") (end))))
+ (read-if (r0 == ? )
+ (((, column) = 7)
+ ((, after-wsp) = 1)
+ (, (mel-ccl-set-eof-block '((write "From=20") (end))))
+ (read r0)
+ (write-repeat "=46rom "))
+ (((, column) = 4)
+ (write-repeat "From"))))
+ (((, column) = 3)
+ (write-repeat "Fro"))))
+ (((, column) = 2)
+ (write-repeat "Fr"))))
+ (((, column) = 1)
+ (write-repeat "F"))))
+ (((, type) = (, type-raw)) (break)) ; RAW
+ )))
+ ((eq r0 (char-int ?.))
+ (` (if ((, column) == 0)
+ (, (mel-ccl-try-to-read-crlf
+ input-crlf 'r0
+ ;; "." CR LF (input-crlf: t)
+ ;; "." LF (input-crlf: nil)
+ (` ((write (, (concat "=2E" hard)))
+ (, (mel-ccl-set-eof-block '(end)))
+ (read r0)
+ (repeat)))
+ ;; "." <EOF>
+ '((write ".") (end))
+ ;; "." noCR (input-crlf: t)
+ (` (((, column) = 1)
+ (write-repeat ".")))
+ ;; "." CR <EOF> (input-crlf: t)
+ '((write ".=0D") (end))
+ ;; "." CR noLF (input-crlf: t)
+ (` (((, column) = 4)
+ (write-repeat ".=0D")))
+ ;; "." <EOF> (input-crlf: nil)
+ '((write ".") (end))
+ ;; "." noLF (input-crlf: nil)
+ (` (((, column) = 1)
+ (write-repeat ".")))))
+ (((, type) = (, type-raw)) (break)) ; RAW
+ )))
+ ((eq tmp 'raw) (` (((, type) = (, type-raw)) (break))))
+ ((eq tmp 'enc) (` (((, type) = (, type-enc)) (break))))
+ ((eq tmp 'wsp) (` (((, type) = (, type-wsp)) (break))))
+ ((eq tmp 'cr) (` (((, type) = (, (if input-crlf type-brk type-enc)))
+ (break))))
+ ((eq tmp 'lf) (` (((, type) = (, (if input-crlf type-enc type-brk)))
+ (break))))
+ )))
+ mel-ccl-256-table))))
+ ;; r0:type{raw,enc,wsp,brk}
+ (branch
+ (, type)
+ ;; r0:type-raw
+ (if ((, column) < 75)
+ (((, column) += 1)
+ ((, after-wsp) = 0)
+ (, (mel-ccl-set-eof-block '(end)))
+ (write-read-repeat r0))
((r1 = (r0 + 0))
- ,@(mel-ccl-try-to-read-crlf
- input-crlf 'r0
- `((,column = 0)
- (,after-wsp = 0)
- (write "=")
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (write ,hard)
- ,(mel-ccl-set-eof-block `(end))
- (read r0)
- (repeat))
- `((write "=")
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (end))
- `((,column += 1)
- (,after-wsp = 1)
- (write-repeat r1))
- `((write r1)
- (write "=0D")
- (end))
- `((,column += 4)
- (,after-wsp = 0)
- (write r1)
- (write-repeat "=0D"))
- `((write "=")
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (end))
- `((,column += 1)
- (,after-wsp = 1)
- (write-repeat r1))))
- (if (,column < 74)
- ((r1 = (r0 + 0))
- ,@(mel-ccl-try-to-read-crlf
+ ((, after-wsp) = 0)
+ (,@ (mel-ccl-try-to-read-crlf
input-crlf 'r0
- `((,column = 0)
- (,after-wsp = 0)
- (write "=")
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (write ,hard)
- ,(mel-ccl-set-eof-block `(end))
- (read r0)
- (repeat))
- `((write "=")
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (end))
- `((,column += 1)
- (,after-wsp = 1)
- (write-repeat r1))
- `((write r1)
- (write ,(concat soft "=0D"))
- (end))
- `((,column = 3)
- (,after-wsp = 0)
- (write r1)
- (write-repeat ,(concat soft "=0D")))
- `((write "=")
- (write r1 ,mel-ccl-high-table)
- (write r1 ,mel-ccl-low-table)
- (end))
- `((,column += 1)
- (,after-wsp = 1)
- (write-repeat r1))))
- (if (,column < 75)
- ((,column += 1)
- (,after-wsp = 1)
- ,(mel-ccl-set-eof-block `((write ,soft) (end)))
- (write-read-repeat r0))
- ((write ,soft)
- (,column = 0)
- (,after-wsp = 0)
- (repeat)))))
- ;; r0:type-brk
- ,(if input-crlf
- ;; r0{CR}:type-brk
- `((if ((,column > 73) & ,after-wsp)
- ((,column = 0)
- (,after-wsp = 0)
- (write ,soft)))
- ,(mel-ccl-set-eof-block `((if (,column > 73) (write ,soft))
- (write "=0D") (end)))
- (read-if (r0 == ?\n)
- (if ,after-wsp
- ((,after-wsp = 0)
- (,column = 0)
- (write ,(concat soft hard))
- ,(mel-ccl-set-eof-block '(end))
+ (` (((, column) = 0)
+ (write r1)
+ (, (mel-ccl-set-eof-block (` ((write (, hard)) (end)))))
(read r0)
- (repeat))
- ((,after-wsp = 0)
- (,column = 0)
- (write ,hard)
- ,(mel-ccl-set-eof-block '(end))
- (read r0)
- (repeat)))
- (if (,column < 73)
- ((,after-wsp = 0)
- (,column += 3)
- (write-repeat "=0D"))
- (if (,column < 74)
- (if (r0 == ?\r)
- ((,after-wsp = 0)
- ,(mel-ccl-set-eof-block
- `((write ,(concat soft "=0D=0D")) (end)))
- (read-if (r0 == ?\n)
- ((,column = 0)
- ,(mel-ccl-set-eof-block
- `((write ,(concat "=0D" hard)) (end)))
- (read r0)
- (write-repeat ,(concat "=0D" hard)))
- ((,column = 6)
- (write-repeat ,(concat soft "=0D=0D")))))
- ((,after-wsp = 0)
- (,column = 3)
- (write-repeat ,(concat soft "=0D"))))
- ((,after-wsp = 0)
- (,column = 3)
- (write-repeat ,(concat soft "=0D")))))))
- ;; r0{LF}:type-brk
- `(if ,after-wsp
- ;; WSP ; r0{LF}:type-brk
- ((,after-wsp = 0)
- (,column = 0)
- (write ,(concat soft (if output-crlf "\r" "")))
- ,(mel-ccl-set-eof-block `(end))
- (write-read-repeat r0))
- ;; noWSP ; r0{LF}:type-brk
- ((,after-wsp = 0)
- (,column = 0)
- ,@(if output-crlf '((write ?\r)) '())
- ,(mel-ccl-set-eof-block `(end))
- (write-read-repeat r0)))
- )))))
- (branch
- ,eof-block-reg
- ,@(reverse (mapcar 'car eof-block-branches))))))
+ (write-repeat (, hard))))
+ '((write r1) (end))
+ (` (((, column) = 1)
+ (write (, soft)) (write-repeat r1)))
+ (` ((write (, soft)) (write r1) (write "=0D") (end)))
+ (` (((, column) = 4)
+ (write (, soft)) (write r1) (write-repeat "=0D")))
+ '((write r1) (end))
+ (` (((, column) = 1)
+ (write (, soft)) (write-repeat r1)))))))
+ ;; r0:type-enc
+ (((, after-wsp) = 0)
+ (if ((, column) < 73)
+ (((, column) += 3)
+ (write "=")
+ (write r0 (, mel-ccl-high-table))
+ (, (mel-ccl-set-eof-block '(end)))
+ (write-read-repeat r0 (, mel-ccl-low-table)))
+ (if ((, column) < 74)
+ ((r1 = (r0 + 0))
+ ((, after-wsp) = 0)
+ (,@ (mel-ccl-try-to-read-crlf
+ input-crlf 'r0
+ (` (((, column) = 0)
+ (write "=")
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (write (, hard))
+ (, (mel-ccl-set-eof-block '(end)))
+ (read r0)
+ (repeat)))
+ (` ((write "=")
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (end)))
+ (` (((, column) = 3)
+ (write (, (concat soft "=")))
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (repeat)))
+ (` ((write (, (concat soft "=")))
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (write "=0D")
+ (end)))
+ (` (((, column) = 6)
+ (write (, (concat soft "=")))
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (write-repeat "=0D")))
+ (` ((write "=")
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (end)))
+ (` (((, column) = 3)
+ (write (, (concat soft "=")))
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (repeat))))))
+ (((, column) = 3)
+ (write (, (concat soft "=")))
+ (write r0 (, mel-ccl-high-table))
+ (, (mel-ccl-set-eof-block '(end)))
+ (write-read-repeat r0 (, mel-ccl-low-table))))))
+ ;; r0:type-wsp
+ (if ((, column) < 73)
+ ((r1 = (r0 + 0))
+ (,@ (mel-ccl-try-to-read-crlf
+ input-crlf 'r0
+ (` (((, column) = 0)
+ ((, after-wsp) = 0)
+ (write "=")
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (write (, hard))
+ (, (mel-ccl-set-eof-block (` (end))))
+ (read r0)
+ (repeat)))
+ (` ((write "=")
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (end)))
+ (` (((, column) += 1)
+ ((, after-wsp) = 1)
+ (write-repeat r1)))
+ (` ((write r1)
+ (write "=0D")
+ (end)))
+ (` (((, column) += 4)
+ ((, after-wsp) = 0)
+ (write r1)
+ (write-repeat "=0D")))
+ (` ((write "=")
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table)) (end)))
+ (` (((, column) += 1)
+ ((, after-wsp) = 1)
+ (write-repeat r1))))))
+ (if ((, column) < 74)
+ ((r1 = (r0 + 0))
+ (,@ (mel-ccl-try-to-read-crlf
+ input-crlf 'r0
+ (` (((, column) = 0)
+ ((, after-wsp) = 0)
+ (write "=")
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (write (, hard))
+ (, (mel-ccl-set-eof-block (` (end))))
+ (read r0)
+ (repeat)))
+ (` ((write "=")
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table)) (end)))
+ (` (((, column) += 1)
+ ((, after-wsp) = 1)
+ (write-repeat r1)))
+ (` ((write r1)
+ (write (, (concat soft "=0D")))
+ (end)))
+ (` (((, column) = 3)
+ ((, after-wsp) = 0)
+ (write r1)
+ (write-repeat (, (concat soft "=0D")))))
+ (` ((write "=")
+ (write r1 (, mel-ccl-high-table))
+ (write r1 (, mel-ccl-low-table))
+ (end)))
+ (` (((, column) += 1)
+ ((, after-wsp) = 1)
+ (write-repeat r1))))))
+ (if ((, column) < 75)
+ (((, column) += 1)
+ ((, after-wsp) = 1)
+ (, (mel-ccl-set-eof-block (` ((write (, soft)) (end)))))
+ (write-read-repeat r0))
+ ((write (, soft))
+ ((, column) = 0)
+ ((, after-wsp) = 0)
+ (repeat)))))
+ ;; r0:type-brk
+ (, (if input-crlf
+ ;; r0{CR}:type-brk
+ (` ((if (((, column) > 73) & (, after-wsp))
+ (((, column) = 0)
+ ((, after-wsp) = 0)
+ (write (, soft))))
+ (, (mel-ccl-set-eof-block (` ((if ((, column) > 73) (write (, soft)))
+ (write "=0D") (end)))))
+ (read-if (r0 == ?\n)
+ (if (, after-wsp)
+ (((, after-wsp) = 0)
+ ((, column) = 0)
+ (write (, (concat soft hard)))
+ (, (mel-ccl-set-eof-block '(end)))
+ (read r0)
+ (repeat))
+ (((, after-wsp) = 0)
+ ((, column) = 0)
+ (write (, hard))
+ (, (mel-ccl-set-eof-block '(end)))
+ (read r0)
+ (repeat)))
+ (if ((, column) < 73)
+ (((, after-wsp) = 0)
+ ((, column) += 3)
+ (write-repeat "=0D"))
+ (if ((, column) < 74)
+ (if (r0 == ?\r)
+ (((, after-wsp) = 0)
+ (, (mel-ccl-set-eof-block
+ (` ((write (, (concat soft "=0D=0D"))) (end)))))
+ (read-if (r0 == ?\n)
+ (((, column) = 0)
+ (, (mel-ccl-set-eof-block
+ (` ((write (, (concat "=0D" hard))) (end)))))
+ (read r0)
+ (write-repeat (, (concat "=0D" hard))))
+ (((, column) = 6)
+ (write-repeat (, (concat soft "=0D=0D"))))))
+ (((, after-wsp) = 0)
+ ((, column) = 3)
+ (write-repeat (, (concat soft "=0D")))))
+ (((, after-wsp) = 0)
+ ((, column) = 3)
+ (write-repeat (, (concat soft "=0D")))))))))
+ ;; r0{LF}:type-brk
+ (` (if (, after-wsp)
+ ;; WSP ; r0{LF}:type-brk
+ (((, after-wsp) = 0)
+ ((, column) = 0)
+ (write (, (concat soft (if output-crlf "\r" ""))))
+ (, (mel-ccl-set-eof-block (` (end)))) (write-read-repeat r0))
+ ;; noWSP ; r0{LF}:type-brk
+ (((, after-wsp) = 0)
+ ((, column) = 0)
+ (,@ (if output-crlf '((write ?\r)) '()))
+ (, (mel-ccl-set-eof-block (` (end))))
+ (write-read-repeat r0))))
+ ))))))
+ (branch
+ (, eof-block-reg)
+ (,@ (reverse (mapcar (quote car) eof-block-branches))))))))
(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 + 0))
- (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 + 0))
- (write-repeat r1)))
- (t
- ;; r0:[^\t\r -~]
- ;; invalid character found.
- ;; -> ignore.
- `((read r0)
- (repeat))))))
- mel-ccl-256-table))
+ (` (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 + 0))
+ (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 + 0))
+ (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)))
+ (,@ (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)))
+ (, (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)
- ))))
+ )))))
)
(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) ; XXX: Is this necessary?
+ (fillarray status nil)
(ccl-execute-on-string
(cond
((eq mode 'text) 'mel-ccl-count-uq)
(defun mime-encoding-alist (&optional service)
"Return table of Content-Transfer-Encoding for completion."
- (mapcar #'list (mime-encoding-list service)))
+ (mapcar (function list) (mime-encoding-list service)))
(defsubst mel-use-module (name encodings)
(while encodings
-;;; mime-def.el --- definition module about MIME -*- coding: iso-8859-4; -*-
+;;; mime-def.el --- definition module about MIME -*- coding: iso-2022-jp; -*-
;; Copyright (C) 1995,96,97,98,99,2000 Free Software Foundation, Inc.
)
(eval-and-compile
- (defconst mime-library-product ["FLIM" (1 14 0) "Ninokuchi"]
- "Product name, version number and code name of MIME-library package."))
+ (defconst mime-library-product ["CLIME" (1 14 0) "\e$B8^4VF2\e(B"]
+ "Product name, version number and code name of MIME-library package.")
+ )
(defmacro mime-product-name (product)
- `(aref ,product 0))
+ (` (aref (, product) 0)))
(defmacro mime-product-version (product)
- `(aref ,product 1))
+ (` (aref (, product) 1)))
(defmacro mime-product-code-name (product)
- `(aref ,product 2))
+ (` (aref (, product) 2)))
(defconst mime-library-version
(eval-when-compile
(concat (mime-product-name mime-library-product) " "
- (mapconcat #'number-to-string
+ (mapconcat (function int-to-string)
(mime-product-version mime-library-product) ".")
" - \"" (mime-product-code-name mime-library-product) "\"")))
;;; @ variables
;;;
-(require 'custom)
-
(defgroup mime '((default-mime-charset custom-variable))
"Emacs MIME Interfaces"
:group 'news
;;;
(defsubst make-mime-content-type (type subtype &optional parameters)
- (list* (cons 'type type)
- (cons 'subtype subtype)
- (nreverse parameters))
- )
+ (cons (cons 'type type)
+ (cons (cons 'subtype subtype)
+ (nreverse parameters))))
(defsubst mime-content-type-primary-type (content-type)
"Return primary-type of CONTENT-TYPE."
"Define NAME as a service for Content-Transfer-Encodings.
If ARGS is specified, NAME is defined as a generic function for the
service."
- `(progn
- (add-to-list 'mel-service-list ',name)
- (defvar ,(intern (format "%s-obarray" name)) (make-vector 7 0))
- ,@(if args
- `((defun ,name ,args
- ,@rest
- (funcall (mel-find-function ',name ,(car (last args)))
- ,@(luna-arglist-to-arguments (butlast args)))
- )))
- ))
+ (` (progn
+ (add-to-list 'mel-service-list '(, name))
+ (defvar (, (intern (format "%s-obarray" name))) (make-vector 7 0))
+ (,@ (if args
+ (` ((defun (, name) (, args)
+ (,@ rest)
+ (funcall (mel-find-function '(, name)
+ (, (car (last args))))
+ (,@ (luna-arglist-to-arguments (butlast args))))
+ )))))
+ )))
(put 'mel-define-service 'lisp-indent-function 'defun)
If PARENTS is specified, TYPE inherits PARENTS.
Each parent must be backend name (string)."
(cons 'progn
- (mapcar (lambda (parent)
- `(mel-copy-backend ,parent ,type)
- )
+ (mapcar (function
+ (lambda (parent)
+ (` (mel-copy-backend (, parent) (, type)))
+ ))
parents)))
(defmacro mel-define-method (name args &rest body)
and (nth 1 (car (last ARGS))) is name of backend (encoding)."
(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)))))
+ (` (progn
+ (mel-define-service (, name))
+ (fset (intern (, class) (, (intern (format "%s-obarray" name))))
+ (function
+ (lambda (, (butlast args))
+ (,@ body))))))))
(put 'mel-define-method 'lisp-indent-function 'defun)
(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))))))
+ (` (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))))
- )))
+ (` (progn
+ (define-function (, function)
+ (intern (, class) (, (intern (format "%s-obarray" name)))))
+ ))))
(defvar base64-dl-module
(if (and (fboundp 'base64-encode-string)
or nil. PRIMARY-TYPE and SUBTYPE are symbol and NAME_n and VALUE_n
are string."
(setq string (std11-unfold-string string))
- (if (string-match `,(concat "^\\(" mime-token-regexp
- "\\)/\\(" mime-token-regexp "\\)") string)
+ (if (string-match (eval-when-compile
+ (concat "^\\(" mime-token-regexp
+ "\\)/\\(" mime-token-regexp "\\)")) string)
(let* ((type (downcase
(substring string (match-beginning 1) (match-end 1))))
(subtype (downcase
;;;
(defmacro mime-entity-send (entity message &rest args)
- `(luna-send ,entity ',(intern (format "mime-%s" (eval message))) ,@args))
+ (` (luna-send (, entity)
+ '(, (intern (format "mime-%s" (eval message)))) (,@ args))))
(defun mime-open-entity (type location)
"Open an entity and return it.
projects / elisp / flim.git / commitdiff