* we can handle symbols, so we can probably handle quoted symbols
* slot-definition initargs seem to some in unevaluated, so lets handle
people doing the obvious thing and puting a quote in front of their symbols
+2012-06-25 Russ Tyndall <russ@acceleration.net>
+ * sql/util.lisp, sql/metaclasses.lisp
+ Dequote database-identifiers if needed (passed a quoted symbol)
+ Metaclass args come through unquoted, so this eases interactions
+ with them
+
2012-06-22 Russ Tyndall <russ@acceleration.net>
* sql/metaclasses.lisp: Changed compute-effective-slot-definition
to correctly copy the autoincrement-sequence slot to the ESD
2012-06-22 Russ Tyndall <russ@acceleration.net>
* sql/metaclasses.lisp: Changed compute-effective-slot-definition
to correctly copy the autoincrement-sequence slot to the ESD
(defmethod database-identifier ( name &optional database find-class-p
&aux cls)
(defmethod database-identifier ( name &optional database find-class-p
&aux cls)
- "A function that takes whatever you give it, recurively coerces it,
+ "A function that takes whatever you give it, recursively coerces it,
and returns a database-identifier.
(escaped-database-identifiers *any-reasonable-object*) should be called to
and returns a database-identifier.
(escaped-database-identifiers *any-reasonable-object*) should be called to
a new db-id with that string as escaped"
(let ((s (sql-output id database)))
(make-instance '%database-identifier :escaped s :unescaped s))))
a new db-id with that string as escaped"
(let ((s (sql-output id database)))
(make-instance '%database-identifier :escaped s :unescaped s))))
+ (setf name (dequote name))
(etypecase name
(null nil)
(string (%make-database-identifier name database))
(etypecase name
(null nil)
(string (%make-database-identifier name database))
(defmethod initialize-instance :after
((obj view-class-direct-slot-definition)
&key &allow-other-keys)
(defmethod initialize-instance :after
((obj view-class-direct-slot-definition)
&key &allow-other-keys)
- (setf (view-class-slot-column obj) (compute-column-name obj)))
+ (setf (view-class-slot-column obj) (compute-column-name obj)
+ (view-class-slot-autoincrement-sequence obj)
+ (dequote
+ (view-class-slot-autoincrement-sequence obj))))
(defmethod compute-effective-slot-definition ((class standard-db-class)
#+kmr-normal-cesd slot-name
(defmethod compute-effective-slot-definition ((class standard-db-class)
#+kmr-normal-cesd slot-name
(integer v)
(number (truncate v))))
(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
(defvar +whitespace-chars+
'(#\space #\tab #\newline #\return
;; Tested: sbcl unicode, allegrocl, openmcl,clisp use #\no-break_space