refactor the way oodml find-all and select deal with their keyword args.

[clsql.git] / sql / utils.lisp

diff --git a/sql/utils.lisp b/sql/utils.lisp
index 92c96fdd557501cbcf455d8bd730924ab337a7ce..60fedc3f971d4a8fd6b9b2d39471dfcb5350064d 100644 (file)
--- a/sql/utils.lisp
+++ b/sql/utils.lisp
@@ -18,13 +18,16 @@
 
 (defvar +whitespace-chars+
   '(#\space #\tab #\newline #\return
-    ;; Tested: sbcl unicode, allegrocl, and clisp use #\no-break_space
+    ;; 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
-    #+lispworks #\no-break-space
-    #+(or (and sbcl sb-unicode) (and allegro ics) clisp) #\no-break_space
+    ;; 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.")
 
@@ -40,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))
@@ -122,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
@@ -163,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))
@@ -372,3 +378,30 @@ 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))))
+
+
+(defun filter-plist (plist &rest keys-to-remove)
+  "Returns a copy of the given plist with indicated key-value pairs
+removed. keys are searched with #'MEMBER"
+  (declare (dynamic-extent keys-to-remove))
+  (when plist
+    (loop for (k v . rest) = plist then rest
+          unless (member k keys-to-remove)
+            collect k and collect v
+          while rest)))