X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fsyntax.lisp;h=6d771da016dad928c3db849a92f7f637e60f4c84;hb=6b773c9d859a10b961df9c1c2c9b8a006b315aff;hp=f3f8372ead60213381c58282821bb4c8ed757d10;hpb=7f0e4a65d1b425f2fa58fc7cce8296c1a6c52c2f;p=clsql.git diff --git a/sql/syntax.lisp b/sql/syntax.lisp index f3f8372..6d771da 100644 --- a/sql/syntax.lisp +++ b/sql/syntax.lisp @@ -1,19 +1,20 @@ ;;;; -*- 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) @@ -83,9 +84,13 @@ syntax is disabled." (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 () @@ -156,7 +161,7 @@ attribute and type." 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)