Tweak enable-scribble-at-syntax and friends.
authorFrancois-Rene Rideau <fare@tunes.org>
Tue, 12 Oct 2010 04:48:55 +0000 (00:48 -0400)
committerFrancois-Rene Rideau <fare@tunes.org>
Tue, 12 Oct 2010 14:46:40 +0000 (10:46 -0400)
Some more error checking.

package.lisp
scribble.lisp

index fe1cf86..e0f3fa2 100644 (file)
@@ -5,7 +5,9 @@
   #+(or clisp sbcl ccl)
   (:import-from #+clisp :gray #+sbcl :sb-gray #+ccl :ccl
                 :stream-line-column)
-  (:export #:enable-scribble-syntax #:disable-scribble-syntax
+  (:export #:enable-scribble-at-syntax #:disable-scribble-at-syntax
+          #:reenable-scribble-at-syntax
+           #:enable-scribble-syntax #:disable-scribble-syntax
           #:reenable-scribble-syntax
           #:enable-sub-scribble-syntax #:disable-sub-scribble-syntax
           #:reenable-sub-scribble-syntax
index e524f27..c846561 100644 (file)
 
 (defun parse-at-syntax (i)
   ;; Parse an @ expression.
-  (with-nesting ()
-    (let* (;;(i (make-instance 'ωs :stream stream)) ; buffered input
-           (o (make-string-output-stream)) ; buffered output of "current stuff"
-           (cmdonly nil)
-           (col 0)
-           (line ())
-           (lines ())
-           (mrof '()))) ; current form (reversed)
+  (let* ((o (make-string-output-stream)) ; buffered output of "current stuff"
+         (cmdonly nil)
+         (col 0)
+         (line ())
+         (lines ())
+         (mrof '())) ; current form (reversed)
     (labels
         ((?@1 () ; what to do after a @
            (cond
+             ((expect-char i #.(coerce '(#\space #\tab #\return #\newline) 'base-string))
+              (error "Unexpected whitespace after @"))
              ((expect-char i #\;)
               (?at-comment))
              (t
                 (funcall cont)))))
          (at-pipe ()
            (read-char i)
-           (let ((r (read-to-char #\| i)))
-             (multiple-value-bind (s #|n|#) (read-from-string r)
-               #|(unless (symbolp s)
-               (error "Expected a symbol, got ~S" r))
-               (unless (= n (length r))
-               (error "Unexpected characters in ~S" r))|#
+           (let ((r (read-to-char #\| i))
+                 (eof '#:eof))
+             (multiple-value-bind (s n) (read-from-string r)
+               (unless (eq eof (ignore-errors (read-from-string r nil eof :start n)))
+                 (error "Unexpected characters in ~S after position ~D" r n))
                (setf cmdonly t)
                (form! s)
                (?end))))
                (reverse mrof))))
       (?@1))))
 
-(defun do-enable-scribble-at-syntax (&optional (readtable *readtable*))
+(defun do-enable-scribble-at-syntax (&key (readtable *readtable*) scribe)
   (enable-quasiquote :readtable readtable)
   (set-macro-character
    #\[ #'(lambda (stream char)
            (declare (ignore char))
            (parse-at-syntax stream))
    nil readtable)
-  ;;(do-enable-scribble-syntax readtable) ; backward compatibility with former scribble?
+  (when scribe ;; backward compatibility with former scribble?
+    (do-enable-scribble-syntax readtable))
   (set-macro-character
    #\| #'(lambda (stream char)
            (declare (ignore stream char))
   t)
 
 (defvar *scribble-at-readtable* nil)
-(defun enable-scribble-at-syntax (&optional (readtable *readtable*))
+(defun enable-scribble-at-syntax (&key (readtable *readtable*) (scribe nil))
   (setf *scribble-at-readtable* (push-readtable readtable))
-  (do-enable-scribble-at-syntax *scribble-at-readtable*)
+  (do-enable-scribble-at-syntax :readtable *scribble-at-readtable* :scribe scribe)
   *scribble-at-readtable*)
+(defun disable-scribble-syntax ()
+  (pop-readtable))
+(defun reenable-scribble-at-syntax (&key scribe)
+  (if (readtablep *scribble-at-readtable*)
+      (enable-scribble-at-syntax :scribe scribe)
+    (push-readtable *scribble-at-readtable*))
+  *scribble-readtable*)
 
 (defun parse-at-string (x)
   (with-input-from-string (i x)