X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Futils.lisp;h=2e46d7ba39f7830df5b3a05f8282428ac87b61b5;hb=f716bb1161cf9e89a96945c4a444244f9d303691;hp=84e28b937bc77ff1fa69dfedf8990e853c22db31;hpb=7fd52b8de887a2a328f78bddb6a2fb4230ef2b3a;p=clsql.git diff --git a/base/utils.lisp b/base/utils.lisp index 84e28b9..2e46d7b 100644 --- a/base/utils.lisp +++ b/base/utils.lisp @@ -257,23 +257,6 @@ returns (VALUES string-output error-output exit-status)" )) -(eval-when (:compile-toplevel :load-toplevel :execute) - (when (char= #\a (schar (symbol-name '#:a) 0)) - (pushnew :lowercase-reader *features*))) - -(defun string-default-case (str) - #-lowercase-reader - (string-upcase str) - #+lowercase-reader - (string-downcase str)) - -;; From KMRCL -(defun ensure-keyword (name) - "Returns keyword for a name" - (etypecase name - (keyword name) - (string (nth-value 0 (intern (string-default-case name) :keyword))) - (symbol (nth-value 0 (intern (symbol-name name) :keyword))))) ;; From KMRCL (defmacro in (obj &rest choices) @@ -331,3 +314,30 @@ list of characters and replacement strings." (setf (char new-string dpos) c) (incf dpos)))))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (when (char= #\a (schar (symbol-name '#:a) 0)) + (pushnew :lowercase-reader *features*))) + +(defun symbol-name-default-case (str) + #-lowercase-reader + (string-upcase str) + #+lowercase-reader + (string-downcase str)) + +(defun convert-to-db-default-case (str database) + (if database + (case (db-type-default-case (database-underlying-type database)) + (:upper (string-upcase str)) + (:lower (string-downcase str)) + (t str)) + ;; Default CommonSQL behavior is to upcase strings + (string-upcase str))) + + +(defun ensure-keyword (name) + "Returns keyword for a name" + (etypecase name + (keyword name) + (string (nth-value 0 (intern (symbol-name-default-case name) :keyword))) + (symbol (nth-value 0 (intern (symbol-name name) :keyword)))))