From d16f69d260753ff706aab52b6990012441fce2a6 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Tue, 4 Mar 2008 23:12:35 +0100
Subject: Fix syntax enhancement enabling and disabling functions.

darcs-hash:9bab32834009040b90d1d10f12abadad6d1391fa
---
 Lisp/reader-syntax.lisp | 44 ++++++++++++++++++++++++++++++++++----------
 Lisp/tests.lisp         | 14 ++++++++++----
 2 files changed, 44 insertions(+), 14 deletions(-)

(limited to 'Lisp')

diff --git a/Lisp/reader-syntax.lisp b/Lisp/reader-syntax.lisp
index 4263df0..7a79fb0 100644
--- a/Lisp/reader-syntax.lisp
+++ b/Lisp/reader-syntax.lisp
@@ -20,6 +20,19 @@
 
 (defvar *method-syntax-macro-chars* (list))
 (defvar *bracket-syntax-macro-chars* (list))
+(defvar *readtable-stack* (list))
+
+
+(defun restore-readtable ()
+  (when *readtable-stack*
+    (setq *readtable* (pop *readtable-stack*)))
+  (values))
+
+
+(defun save-readtable ()
+  (push *readtable* *readtable-stack*)
+  (setq *readtable* (copy-readtable *readtable*))
+  (values))
 
 
 (defun enable-method-syntax ()
@@ -70,17 +83,22 @@ __defgeneric__ form has been executed.
 
   __enable-objective-c-syntax__"
 
+  (save-readtable)
   (push (get-dispatch-macro-character #\# #\/) *method-syntax-macro-chars*)
   (set-dispatch-macro-character #\# #\/ #'(lambda (stream char arg)
                                             (declare (ignore char arg))
-                                            (read-objective-c-method stream))))
+                                            (read-objective-c-method stream)))
+  (values))
 
 
 (defun disable-method-syntax ()
   "FIXME"
-  (when *method-syntax-macro-chars*
-    (let ((macro-char (pop *method-syntax-macro-chars*)))
-      (set-dispatch-macro-character #\# #\/ macro-char))))
+  (restore-readtable)
+  #+(or) (when *method-syntax-macro-chars*
+           (let ((macro-char (pop *method-syntax-macro-chars*)))
+             (when macro-char
+               (set-dispatch-macro-character #\# #\/ macro-char))))
+  (values))
 
 
 (defun read-objective-c-method (stream)
@@ -214,19 +232,25 @@ __enable-method-syntax__"
   (push (cons (get-macro-character #\[)
               (get-macro-character #\]))
         *bracket-syntax-macro-chars*)
+  (save-readtable)
   (set-macro-character #\] (get-macro-character #\)))
   (set-macro-character #\[ #'(lambda (stream char)
                                (declare (ignore char))
-                               (parse-objc-call stream))))
+                               (parse-objc-call stream)))
+  (values))
 
 
 (defun disable-objective-c-syntax ()
   "FIXME"
-  (when *bracket-syntax-macro-chars*
-    (destructuring-bind (open . close)
-        (pop *bracket-syntax-macro-chars*)
-      (set-macro-character #\[ open)
-      (set-macro-character #\[ close))))
+  (restore-readtable)
+  #+(or) (when *bracket-syntax-macro-chars*
+           (destructuring-bind (open . close)
+               (pop *bracket-syntax-macro-chars*)
+             (when open
+               (set-macro-character #\[ open))
+             (when close
+               (set-macro-character #\] close))))
+  (values))
 
 
 (defun parse-objc-call (stream)
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index 57da341..89593ca 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -34,10 +34,6 @@
 (in-root-suite)
 
 
-(eval-when (:compile-toplevel)
-  (objcl:install-reader-syntax))
-
-
 (defun run-all-tests ()
   (objective-cl))
 
@@ -116,6 +112,7 @@
                         (find-objc-class 'ns-object))))
 
 
+#.(enable-objective-c-syntax)
 (deftest method-invocation ()
   (signals error [NSObject 300])
   (signals error [300 self])
@@ -135,6 +132,7 @@
   #+(or)
   (is [NSString performSelector: (selector "stringWithUTF8String:")
                 withObject: [NSObject class]]))
+#.(disable-objective-c-syntax)
 
 
 (deftest parsing-typespecs ()
@@ -316,6 +314,7 @@
              "^^{OpaqueStruct}")))
 
 
+#.(enable-objective-c-syntax)
 (deftest data-coercion ()
   (is (objc-equal [NSString stringWithUTF8String: "Mulk."]
                   [NSString stringWithCString: "Mulk." encoding: 4]))
@@ -325,15 +324,19 @@
                   [NSString respondsToSelector: "new"]))
   (is (typep [NSString isEqual: [NSString self]] 'boolean))
   (is (typep [NSString isEqual: [NSObject self]] 'boolean)))
+#.(disable-objective-c-syntax)
 
 
+#.(enable-objective-c-syntax)
 (deftest numbers ()
   (is (objc-equal [[NSDecimalNumber decimalNumberWithString:
                                       [NSString stringWithUTF8String: "-12345"]]
                    doubleValue]
                   -12345d0)))
+#.(disable-objective-c-syntax)
 
 
+#.(enable-objective-c-syntax)
 (deftest exception-handling ()
   (is (typep (handler-case [NSString selph]
                (error (e) e))
@@ -341,8 +344,10 @@
   (is (typep (handler-case [NSObject string]
                (error (e) e))
              'message-not-understood)))
+#.(disable-objective-c-syntax)
 
 
+#.(enable-objective-c-syntax)
 (deftest reader-syntax ()
   (is (objc-equal [NSObject self]
                   (find-objc-class 'ns-object)))
@@ -362,6 +367,7 @@
                           :with-object (invoke
                                         (find-objc-class 'ns-object)
                                         'self)))))
+#.(disable-objective-c-syntax)
 
 
 (deftest compiler-macros ()
-- 
cgit v1.2.3