X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Futils.lisp;h=39ee349387e2f437c2b7f88388e75fec1e1cb7a5;hp=12d5d286b5024116360e92a9319adc688a7136db;hb=534849c88501e0ea2ee5dbf78d13d8cb73814d71;hpb=47d5ae2b1454553fa6d71c08862c7dfc5df97a92 diff --git a/sql/utils.lisp b/sql/utils.lisp index 12d5d28..39ee349 100644 --- a/sql/utils.lisp +++ b/sql/utils.lisp @@ -17,10 +17,21 @@ (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)) @@ -455,6 +466,12 @@ removed. keys are searched with #'MEMBER" (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" @@ -466,3 +483,8 @@ removed. keys are searched with #'MEMBER" "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))