From: akr <akr>
Date: Thu, 27 Aug 1998 03:23:52 +0000 (+0000)
Subject: * emu-e20.el (ccl-use-symbol-as-program): New constant.
X-Git-Tag: apel-8_16~18
X-Git-Url: http://git.chise.org/gitweb/?p=elisp%2Fapel.git;a=commitdiff_plain;h=e6f8914b6b8022762db5581ce7af16cea233fc7f

* emu-e20.el (ccl-use-symbol-as-program): New constant.
(make-ccl-coding-system): New function.
(ccl-encoder-eof-block-is-broken): New constant.
(ccl-decoder-eof-block-is-broken): New constant.
(ccl-eof-block-is-broken): New constant.
(ccl-execute): Redefine if `ccl-use-symbol-as-program' is nil.
(ccl-execute-on-string): Ditto.
---

diff --git a/ChangeLog b/ChangeLog
index 6e77863..c3de24b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+1998-08-27  Tanaka Akira  <akr@jaist.ac.jp>
+
+	* emu-e20.el (ccl-use-symbol-as-program): New constant.
+	(make-ccl-coding-system): New function.
+	(ccl-encoder-eof-block-is-broken): New constant.
+	(ccl-decoder-eof-block-is-broken): New constant.
+	(ccl-eof-block-is-broken): New constant.
+	(ccl-execute): Redefine if `ccl-use-symbol-as-program' is nil.
+	(ccl-execute-on-string): Ditto.
+
 1998-08-24  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
 
 	* emu-20.el (mime-charset-coding-system-alist): Add `unknown' and
@@ -334,7 +344,7 @@
 
 	* APEL: Version 8.4 was released.
 
-	* EMU-ELS: Don't use HIRAGANA LETTER A ($(B$"(B) to detect character
+	* EMU-ELS: Don't use HIRAGANA LETTER A ($B$"(B) to detect character
  	indexing (Emacs 20.3 or later).
 
 1998-04-20  MORIOKA Tomohiko  <morioka@jaist.ac.jp>
diff --git a/emu-e20.el b/emu-e20.el
index 2284da8..cbb03b0 100644
--- a/emu-e20.el
+++ b/emu-e20.el
@@ -163,6 +163,98 @@ TABLE defaults to the current buffer's category table."
   )
 
 
+;;; @ CCL
+;;;
+
+(eval-and-compile
+(defconst ccl-use-symbol-as-program
+  (eval-when-compile
+    (define-ccl-program ew-ccl-identity-program
+      '(1 ((read r0) (loop (write-read-repeat r0)))))
+    (condition-case nil
+        (progn
+          (make-coding-system
+           'ew-ccl-identity 4 ?I
+           "Identity coding system for byte-compile time checking"
+           '(ew-ccl-identity-program . ew-ccl-identity-program))
+          t)
+      (error nil)))
+  "t if CCL related builtins accept symbol as CCL
+program. (20.2 with ExCCL, 20.3 or later)
+Otherwise nil (20.2 without ExCCL or former).
+
+Because emu provides functions accepting symbol as CCL program,
+user programs should not refer this variable.")
+
+(defun make-ccl-coding-system
+  (coding-system mnemonic doc-string decoder encoder)
+  "Define a new CODING-SYSTEM (symbol) by CCL programs
+DECODER (symbol) and ENCODER (symbol)."
+  (unless ccl-use-symbol-as-program
+    (setq decoder (symbol-value decoder))
+    (setq encoder (symbol-value encoder)))
+  (make-coding-system coding-system 4 mnemonic doc-string
+    (cons decoder encoder)))
+)
+
+(eval-when-compile
+(define-ccl-program test-ccl-eof-block
+  '(1
+    (read r0)
+    (write "[EOF]")))
+
+(make-ccl-coding-system 'test-ccl-eof-block-cs ?T
+  "CCL_EOF_BLOCK tester"
+  'test-ccl-eof-block
+  'test-ccl-eof-block)
+)
+
+(defconst ccl-encoder-eof-block-is-broken
+  (eval-when-compile
+    (not (equal (encode-coding-string "" 'test-ccl-eof-block-cs)
+                "[EOF]")))
+  "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on
+encoding.")
+
+(defconst ccl-decoder-eof-block-is-broken
+  (eval-when-compile
+    (not (equal (decode-coding-string "" 'test-ccl-eof-block-cs)
+                "[EOF]")))
+  "t if CCL_EOF_BLOCK is not executed when coding system encounts EOF on
+decoding.")
+
+(defconst ccl-eof-block-is-broken
+  (or ccl-encoder-eof-block-is-broken
+      ccl-decoder-eof-block-is-broken))
+
+(unless ccl-use-symbol-as-program
+
+(when (subrp (symbol-function 'ccl-execute))
+  (fset 'ccl-vector-program-execute
+    (symbol-function 'ccl-execute))
+  (defun ccl-execute (ccl-prog reg)
+    "Execute CCL-PROG `ccl-vector-program-execute'.
+If CCL-PROG is symbol, it is dereferenced.
+\[Emacs 20.3 emulating function]"
+    (ccl-vector-program-execute
+      (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
+      reg)))
+
+(when (subrp (symbol-function 'ccl-execute-on-string))
+  (fset 'ccl-vector-program-execute-on-string
+    (symbol-function 'ccl-execute-on-string))
+  (defun ccl-execute-on-string (ccl-prog status &optional contin)
+    "Execute CCL-PROG `ccl-vector-program-execute-on-string'.
+If CCL-PROG is symbol, it is dereferenced.
+\[Emacs 20.3 emulating function]"
+    (ccl-vector-program-execute-on-string
+      (if (symbolp ccl-prog) (symbol-value ccl-prog) ccl-prog)
+      status
+      contin)))
+
+)
+
+
 ;;; @ end
 ;;;