From: akr <akr>
Date: Fri, 13 Nov 1998 02:08:46 +0000 (+0000)
Subject: * pccl.el (define-ccl-program): Adviced.
X-Git-Tag: apel-9_10~2
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=d2d467cb2267c2d0029c0f4c144adf243106e60a;p=elisp%2Fapel.git

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

diff --git a/ChangeLog b/ChangeLog
index f5a3459..af21f42 100644
--- 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
--- 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