(in-package #:clsql-sys)
-(defvar *original-reader-enter* nil)
-
-(defvar *original-reader-exit* nil)
+(defvar *original-readtable* nil)
(defvar *sql-macro-open-char* #\[)
(%disable-sql-reader-syntax)))
(defun %disable-sql-reader-syntax ()
- (when *original-reader-enter*
- (set-macro-character *sql-macro-open-char* *original-reader-enter*))
- (setf *original-reader-enter* nil)
+ (when *original-readtable*
+ (setf *readtable* *original-readtable*
+ *original-readtable* nil))
(values))
(%enable-sql-reader-syntax)))
(defun %enable-sql-reader-syntax ()
- (unless *original-reader-enter*
- (setf *original-reader-enter* (get-macro-character *sql-macro-open-char*)))
- (set-macro-character *sql-macro-open-char* #'sql-reader-open)
- (enable-sql-close-syntax)
+ (unless *original-readtable*
+ (setf *original-readtable* *readtable*
+ *readtable* (copy-readtable))
+ (set-macro-character *sql-macro-open-char* #'sql-reader-open)
+ (set-macro-character *sql-macro-close-char* (get-macro-character #\))))
(values))
(defmacro restore-sql-reader-syntax-state ()
(defun sql-reader-open (stream char)
(declare (ignore char))
(let ((sqllist (read-delimited-list #\] stream t)))
- (handler-case
- (cond ((string= (write-to-string (car sqllist)) "||")
- (cons (sql-operator 'concat-op) (cdr sqllist)))
- ((and (= (length sqllist) 1) (eql (car sqllist) '*))
- (apply #'generate-sql-reference sqllist))
- ((sql-operator (car sqllist))
- (cons (sql-operator (car sqllist)) (cdr sqllist)))
- (t (apply #'generate-sql-reference sqllist)))
- (sql-user-error (c)
- (error 'sql-user-error
- :message (format nil "Error ~A occured while attempting to parse '~A' at file position ~A"
- (sql-user-error-message c) sqllist (file-position stream)))))))
-
-(defun disable-sql-close-syntax ()
- "Internal function that disables the close syntax when leaving
- sql context."
- (set-macro-character *sql-macro-close-char* *original-reader-exit*)
- (setf *original-reader-exit* nil))
-
-(defun enable-sql-close-syntax ()
- "Internal function that enables close syntax when entering SQL
- context."
- (setf *original-reader-exit* (get-macro-character *sql-macro-close-char*))
- (set-macro-character *sql-macro-close-char* (get-macro-character #\))))
+ (unless *read-suppress*
+ (handler-case
+ (cond ((string= (write-to-string (car sqllist)) "||")
+ (cons (sql-operator 'concat-op) (cdr sqllist)))
+ ((and (= (length sqllist) 1) (eql (car sqllist) '*))
+ (apply #'generate-sql-reference sqllist))
+ ((sql-operator (car sqllist))
+ (cons (sql-operator (car sqllist)) (cdr sqllist)))
+ (t (apply #'generate-sql-reference sqllist)))
+ (sql-user-error (c)
+ (error 'sql-user-error
+ :message (format nil "Error ~A occured while attempting to parse '~A' at file position ~A"
+ (sql-user-error-message c) sqllist (file-position stream))))))))
(defun generate-sql-reference (&rest arglist)
(cond ((= (length arglist) 1) ; string, table or attribute