X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Futils.lisp;h=7f307d63d2da32ce1c8a646df1cbd8b68ca432f9;hb=925a29060928f773d4bc7d8e6bdd13c97e0ef65a;hp=0ead522e403bfff993eb9d4229a73446973f0d43;hpb=360b8e79c4009b49eeffedad9249ad3227b07ed8;p=clsql.git diff --git a/sql/utils.lisp b/sql/utils.lisp index 0ead522..7f307d6 100644 --- a/sql/utils.lisp +++ b/sql/utils.lisp @@ -24,7 +24,7 @@ ;; 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 - #+lispworks #\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 @@ -43,6 +43,7 @@ (defun float-to-sql-string (num) "Convert exponent character for SQL" (let ((str (write-to-string num :readably t))) + (declare (type string str)) (cond ((find #\f str) (substitute #\e #\f str)) @@ -125,6 +126,7 @@ (defun substitute-string-for-char (procstr match-char subst-str) "Substitutes a string for a single matching character of a string" + (declare (type string procstr)) (let ((pos (position match-char procstr))) (if pos (concatenate 'string @@ -166,6 +168,7 @@ (setq pos (1+ end)))) (defun string-to-list-connection-spec (str) + (declare (type string str)) (let ((at-pos (position-char #\@ str 0 (length str)))) (cond ((and at-pos (> (length str) at-pos)) @@ -375,3 +378,19 @@ 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)))) \ No newline at end of file