X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Futils.lisp;h=b43e3180e64f6f8d392446229660c6eed1caaab1;hb=d86f73be9a261b9c071ab905aeff5d1ee30a3f31;hp=51eef9ebe20b5ff52a1c9c7bbaf821279a37f175;hpb=158319d9e98eabc92b285c2cbabec71b085aed46;p=clsql.git diff --git a/sql/utils.lisp b/sql/utils.lisp index 51eef9e..b43e318 100644 --- a/sql/utils.lisp +++ b/sql/utils.lisp @@ -7,9 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id$ -;;;; -;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg +;;;; This file, part of CLSQL, is Copyright (c) 2002-2010 by Kevin M. Rosenberg ;;;; ;;;; CLSQL users are granted the rights to distribute and use this software ;;;; as governed by the terms of the Lisp Lesser GNU Public License @@ -18,6 +16,21 @@ (in-package #:clsql-sys) +(defvar +whitespace-chars+ + '(#\space #\tab #\newline #\return + ;; Tested: sbcl unicode, allegrocl, openmcl,clisp use #\no-break_space + ;; lispworks uses #\no-break-space + ;; sbcl non-unicode doesn't support no break space + ;; AllegroCL 8-bit strings don't fail on reading #\no-break_space, + ;; but can't represent such a character + ;; CMUCL errors when trying to read #\no-break_space + #+(and lispworks unicode) #\no-break-space + #+(or (and sbcl sb-unicode) (and allegro ics) (and clisp i18n) + (and openmcl openmcl-unicode-strings)) + #\no-break_space + ) + "List of whitespace characters for this lisp implementation.") + (defun number-to-sql-string (num) (etypecase num (integer @@ -64,7 +77,8 @@ #+lispworks (defvar +lw-global-lock+ (unless +lw-has-without-preemption+ - (mp:make-lock :name "CLSQL" :important-p nil :safep t :recursivep nil))) + (mp:make-lock :name "CLSQL" :important-p nil :safep t :recursivep nil + :sharing t))) (defmacro without-interrupts (&body body) #+allegro `(mp:without-scheduling ,@body) @@ -352,7 +366,7 @@ list of characters and replacement strings." (string-upcase str))) (defun ensure-keyword (name) - "Returns keyword for a name" + "Returns keyword for a name." (etypecase name (keyword name) (string (nth-value 0 (intern (symbol-name-default-case name) :keyword))) @@ -361,3 +375,20 @@ list of characters and replacement strings." (eval-when (:compile-toplevel :load-toplevel :execute) (setq cl:*features* (delete :clsql-lowercase-reader cl:*features*))) +(defun replace-all (string part replacement &key (test #'char=) stream) + "Returns a new string in which all the occurences of the part +is replaced with replacement. [FROM http://cl-cookbook.sourceforge.net/strings.html#manip]" + (let ((out (or stream (make-string-output-stream)))) + (loop with part-length = (length part) + for old-pos = 0 then (+ pos part-length) + for pos = (search part string + :start2 old-pos + :test test) + do (write-string string out + :start old-pos + :end (or pos (length string))) + when pos do (write-string replacement out) + while pos) + (unless stream + (get-output-stream-string out)))) +