* pccl.el (define-ccl-program): Adviced.

diff --git a/ChangeLog b/ChangeLog
index f5a3459..af21f42 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,8 @@
-1998-11-10  Tanaka Akira  <akr@jaist.ac.jp>
+1998-11-13  Tanaka Akira  <akr@jaist.ac.jp>
+
+       * pccl.el (define-ccl-program): Adviced.
+
+1998-11-12  Tanaka Akira  <akr@jaist.ac.jp>
 
        * pccl-om.el (ccl-cascading-read): New facility.
 

diff --git a/pccl.el b/pccl.el
index 0107a84..03e3d86 100644 (file)
--- a/pccl.el
+++ b/pccl.el
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (require 'ccl)
+(require 'advice)
 (require 'broken)
 
 (if (featurep 'mule)
@@ -45,22 +46,23 @@
            (>= emacs-major-version 21)
          t)))
 
-(defmacro define-long-ccl-program (name ccl-program &optional doc)
-  "Define CCL program as define-ccl-program."
-  (setq ccl-program (eval ccl-program))
-  (let ((try-ccl-compile t))
+(defadvice define-ccl-program
+  (before accept-long-ccl-program activate)
+  "When CCL-PROGRAM is too long, internal buffer is lengthened."
+  (let ((try-ccl-compile t)
+        (prog (eval (ad-get-arg 1))))
+    (ad-set-arg 1 (` '(, prog)))
     (while try-ccl-compile
       (setq try-ccl-compile nil)
       (condition-case sig
-         (ccl-compile ccl-program)
-       (args-out-of-range
-        (if (and (eq (car (cdr sig)) ccl-program-vector)
-                 (= (car (cdr (cdr sig))) (length ccl-program-vector)))
-            (setq ccl-program-vector
-                  (make-vector (* 2 (length ccl-program-vector)) 0)
-                  try-ccl-compile t)
-          (signal (car sig) (cdr sig))))))
-    (` (define-ccl-program (, name) '(, ccl-program) (, doc)))))
+          (ccl-compile prog)
+        (args-out-of-range
+         (if (and (eq (car (cdr sig)) ccl-program-vector)
+                  (= (car (cdr (cdr sig))) (length ccl-program-vector)))
+             (setq ccl-program-vector
+                   (make-vector (* 2 (length ccl-program-vector)) 0)
+                   try-ccl-compile t)
+           (signal (car sig) (cdr sig))))))))
 
 
 ;;; @ end