X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Futils.lisp;h=362d16c178529ae67659996c181bbe5f2e4aac73;hp=8763216a34f951607c1c2c4e1bd4e89c73645518;hb=d9f41af62750c622945bb17b622a39689ee5b840;hpb=5257515973703e60f7ad3eca63c9a1ea0409cdd1 diff --git a/sql/utils.lisp b/sql/utils.lisp index 8763216..362d16c 100644 --- a/sql/utils.lisp +++ b/sql/utils.lisp @@ -56,7 +56,9 @@ (symbol (symbol-name identifier)) (string identifier))) (escaped (make-string (length unescaped)))) - (dotimes (i (length unescaped)) + (substitute #\_ #\- unescaped))) + +(dotimes (i (length unescaped)) (setf (char escaped i) (cond ((equal (char unescaped i) #\-) #\_) @@ -66,11 +68,12 @@ escaped)) (defmacro without-interrupts (&body body) - #+lispworks `(mp:without-preemption ,@body) #+allegro `(mp:without-scheduling ,@body) + #+clisp `(progn ,@body) #+cmu `(system:without-interrupts ,@body) - #+sbcl `(sb-sys::without-interrupts ,@body) - #+openmcl `(ccl:without-interrupts ,@body)) + #+lispworks `(mp:without-preemption ,@body) + #+openmcl `(ccl:without-interrupts ,@body) + #+sbcl `(sb-sys::without-interrupts ,@body)) (defun make-process-lock (name) #+allegro (mp:make-process-lock :name name) @@ -315,6 +318,17 @@ list of characters and replacement strings." (incf dpos)))))) +(defun getenv (var) + "Return the value of the environment variable." + #+allegro (sys::getenv (string var)) + #+clisp (ext:getenv (string var)) + #+(or cmu scl) + (cdr (assoc (string var) ext:*environment-list* :test #'equalp + :key #'string)) + #+lispworks (lw:environment-variable (string var)) + #+mcl (ccl::getenv var) + #+sbcl (sb-ext:posix-getenv var)) + (eval-when (:compile-toplevel :load-toplevel :execute) (when (char= #\a (schar (symbol-name '#:a) 0)) (pushnew :clsql-lowercase-reader *features*))) @@ -334,7 +348,6 @@ list of characters and replacement strings." ;; Default CommonSQL behavior is to upcase strings (string-upcase str))) - (defun ensure-keyword (name) "Returns keyword for a name" (etypecase name @@ -344,3 +357,4 @@ list of characters and replacement strings." (eval-when (:compile-toplevel :load-toplevel :execute) (setq cl:*features* (delete :clsql-lowercase-reader cl:*features*))) +