+
+(set-macro-character #\[
+ #'(lambda (stream char)
+ (declare (ignore char))
+ (let ((curr-string (make-array 1024 :fill-pointer 0 :adjustable t :element-type 'character))
+ (got-comma nil))
+ (do ((ch (read-char stream t nil t) (read-char stream t nil t)))
+ ((eql ch #\]))
+ (if got-comma
+ (if (eql ch #\()
+ ;; Starting top-level ,(
+ (progn
+ (princ curr-string)
+ (setf (fill-pointer curr-string) 0)
+ (setq got-comma nil)
+ (vector-push #\( curr-string)
+ (do ((ch (read-char stream t nil t) (Read-char stream t nil t)))
+ ((eql ch #\)))
+ (when (eql ch #\])
+ (format *trace-output* "Syntax error reading #\]")
+ (return nil))
+ (vector-push-extend ch curr-string))
+ (vector-push-extend #\) curr-string)
+ (princ (eval (read-from-string curr-string)))
+ (setf (fill-pointer curr-string) 0))
+ ;; read comma, then non #\( char
+ (progn
+ (unless (eql ch #\,)
+ (setq got-comma nil))
+ (vector-push-extend #\, curr-string) ;; push previous command
+ (vector-push-extend ch curr-string)))
+ ;; previous character is not a comma
+ (if (eql ch #\,)
+ (setq got-comma t)
+ (progn
+ (setq got-comma nil)
+ (vector-push-extend ch curr-string)))))
+ (princ curr-string))
+ t))
+
+