Improved documentation of normalized classes and changelog entry

[clsql.git] / sql / utils.lisp

diff --git a/sql/utils.lisp b/sql/utils.lisp
index 6e4230d84d94486d8448cc9c84f9c89839bd47e4..39ee349387e2f437c2b7f88388e75fec1e1cb7a5 100644 (file)
--- a/sql/utils.lisp
+++ b/sql/utils.lisp
@@ -16,6 +16,33 @@
 
 (in-package #:clsql-sys)
 
+(defmacro defaulting (&rest place-value-plist)
+  "for places and values (as an &rest plist)
+   if place-n is null set it to value-n"
+  `(progn
+    ,@(loop for (place value . rest) on place-value-plist by #'cddr
+            collect `(unless ,place (setf ,place ,value)))))
+
+(defmacro pop-n (place &optional (n 1))
+  "pops n items off of a list in place and returns their values in a new list
+
+   if n > the length of the list in place, then we return the full list,
+     setting the place to nil"
+  `(loop repeat ,n
+    while ,place
+    collect (pop ,place)))
+
+(defun %get-int (v)
+  (etypecase v
+    (string (parse-integer v :junk-allowed t))
+    (integer v)
+    (number (truncate v))))
+
+(defun dequote (it)
+  (if (and (listp it) (eql (first it) 'quote))
+      (second it)
+      it))
+
 (defvar +whitespace-chars+
   '(#\space #\tab #\newline #\return
     ;; Tested: sbcl unicode, allegrocl, openmcl,clisp use #\no-break_space
@@ -125,15 +152,17 @@
   (substitute-string-for-char s #\' "''"))
 
 (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
-          (subseq procstr 0 pos) subst-str
-          (substitute-string-for-char
-           (subseq procstr (1+ pos)) match-char subst-str))
-      procstr)))
+  "Substitutes a string for a single matching character of a string"
+  (when procstr
+    (locally
+        (declare (type string procstr))
+      (let ((pos (position match-char procstr)))
+        (if pos
+            (concatenate 'string
+                         (subseq procstr 0 pos) subst-str
+                         (substitute-string-for-char
+                          (subseq procstr (1+ pos)) match-char subst-str))
+            procstr)))))
 
 
 (defun position-char (char string start max)
@@ -424,3 +453,38 @@ removed. keys are searched with #'MEMBER"
       #+sbcl :weakness #+sbcl :value
       ,@args)
     ))
+
+(defun to-slot-name (slot)
+  "try to turn what we got representing the slot into a slot name"
+  (etypecase slot
+    (symbol slot)
+    (slot-definition (slot-definition-name slot))))
+
+(defun to-class (it)
+  (etypecase it
+    (class it)
+    (symbol (find-class it))
+    (standard-object (class-of it))))
+
+(defun to-class-name (o)
+  (etypecase o
+    (symbol o)
+    (standard-class (class-name o))
+    (standard-object (class-name (class-of o)))))
+
+(defun easy-slot-value (obj slot)
+  "like slot-value except it accepts slot-names or defs
+   and returns nil when the slot is unbound"
+  (let ((n (to-slot-name slot)))
+    (when (and obj (slot-boundp obj n))
+      (slot-value obj n))))
+
+(defun (setf easy-slot-value) (new obj slot)
+  "like slot-value except it accepts slot-names or defs"
+  (setf (slot-value obj (to-slot-name slot)) new))
+
+(defun delist-if-single (x)
+  "if this is a single item in a list return it"
+  (if (and (listp x) (= 1 (length x)))
+      (first x)
+      x))