;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;;
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;;
;;;; CLSQL square bracket symbolic query syntax. Functions for
;;;; enabling and disabling the syntax and for building SQL
;;;; expressions using the syntax.
;;;; CLSQL square bracket symbolic query syntax. Functions for
;;;; enabling and disabling the syntax and for building SQL
;;;; expressions using the syntax.
+(defmacro file-enable-sql-reader-syntax ()
+ "Turns on the SQL reader syntax for the rest of the file.
+The CL spec says that when finished loading a file the original
+*readtable* is restored. clhs COMPILE-FILE"
+ '(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setf *readtable* (copy-readtable))
+ (set-macro-character *sql-macro-open-char* #'sql-reader-open)
+ (set-macro-character *sql-macro-close-char* (get-macro-character #\)))))
+
(defun %enable-sql-reader-syntax ()
(unless *original-readtable*
(setf *original-readtable* *readtable*
(defun %enable-sql-reader-syntax ()
(unless *original-readtable*
(setf *original-readtable* *readtable*
- (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))))))))
+ (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))))))))
- (cond ((= (length arglist) 1) ; string, table or attribute
- (if (stringp (car arglist))
- (sql-expression :string (car arglist))
+ (cond ((= (length arglist) 1) ; string, table or attribute
+ (if (stringp (car arglist))
+ (sql-expression :string (car arglist))
- (sql-expression :table (car arglist)
- :alias (cadr arglist)
- :type sqltype))
- ((keywordp (cadr arglist))
- (sql-expression :attribute (car arglist)
- :type (cadr arglist)))
- (t
- (sql-expression :attribute (cadr arglist)
- :table (car arglist)
- :type sqltype)))))
- (t
- (error 'sql-user-error :message "bad expression syntax"))))
-
-
-;; Exported functions for dealing with SQL syntax
+ (sql-expression :table (car arglist)
+ :alias (cadr arglist)
+ :type sqltype))
+ ((keywordp (cadr arglist))
+ (sql-expression :attribute (car arglist)
+ :type (cadr arglist)))
+ (t
+ (sql-expression :attribute (cadr arglist)
+ :table (car arglist)
+ :type sqltype)))))
+ (t
+ (error 'sql-user-error :message "bad expression syntax"))))
+
+
+;; Exported functions for dealing with SQL syntax