summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Benkard <code@mail.matthias.benkard.de>2008-03-04 23:12:35 +0100
committerMatthias Benkard <code@mail.matthias.benkard.de>2008-03-04 23:12:35 +0100
commitd16f69d260753ff706aab52b6990012441fce2a6 (patch)
tree35ac4cbb0b67d963f5b7163fdb8576343cd019f7
parente06aa593fb25fb4e31e500fec9dc67b9ea842ba1 (diff)
Fix syntax enhancement enabling and disabling functions.
darcs-hash:9bab32834009040b90d1d10f12abadad6d1391fa
-rw-r--r--Lisp/reader-syntax.lisp44
-rw-r--r--Lisp/tests.lisp14
2 files changed, 44 insertions, 14 deletions
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 ()