;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; ======================================================================
-;;;; File: package.lisp
-;;;; Updated: <04/04/2004 12:05:16 marcusp>
-;;;; ======================================================================
+;;;; *************************************************************************
;;;;
-;;;; Description ==========================================================
-;;;; ======================================================================
+;;;; $Id$
;;;;
-;;;; CLSQL-USQL square bracket symbolic query syntax. Functions for
+;;;; CLSQL square bracket symbolic query syntax. Functions for
;;;; enabling and disabling the syntax and for building SQL
;;;; expressions using the syntax.
;;;;
-;;;; ======================================================================
+;;;; This file is part of CLSQL.
+;;;;
+;;;; CLSQL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
-(in-package :clsql-usql-sys)
+(in-package #:clsql-sys)
(defvar *original-reader-enter* nil)
(defun sql-reader-open (stream char)
(declare (ignore char))
(let ((sqllist (read-delimited-list #\] stream t)))
- (if (sql-operator (car sqllist))
- (cons (sql-operator (car sqllist)) (cdr sqllist))
- (apply #'generate-sql-reference sqllist))))
+ (cond ((string= (write-to-string (car sqllist)) "||")
+ (cons (sql-operator 'concat) (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)))))
;; Internal function that disables the close syntax when leaving sql context.
(defun disable-sql-close-syntax ()
for the operator."
(typecase operation
(string nil)
- (symbol (gethash (string-upcase (symbol-name operation))
+ (symbol (gethash (symbol-name-default-case (symbol-name operation))
*sql-op-table*))))
(defun sql-operation (operation &rest rest)