clog-lookup database table lookups for drop downs and lists boxes

source/clog-dbi.lisp

@@ -109,7 +109,7 @@ CLOG-Builder. If not using builder use to connect:
     :accessor on-fetch
     :initform nil
     :documentation "on-fetch event, called after fetch complete. (private)"))
-  (:documentation "Manipulate one row of a table."))
+  (:documentation "Manipulate one row of a table at a time on panel."))
 
 ;;;;;;;;;;;;;;;;;;;;
 ;; create-one-row ;;
@@ -131,15 +131,15 @@ of type-of CLOG-DATABASE it is used as database source unless
 					       :html-id html-id
 					       :auto-place auto-place)
 			       'clog-one-row)))
-    (when (and (typep obj 'clog-database) (not clog-database))
-      (setf clog-database obj))
-    (setf (clog-database new-obj) clog-database)
+    (if (and (typep obj 'clog-database) (not clog-database))
+	(setf (clog-database new-obj) obj)
+	(setf (clog-database new-obj) clog-database))
     new-obj))
 
 (defgeneric query-row (clog-one-row panel sql)
   (:documentation "Ignore query related prperties and instead execute
 SQL. row-id-name is required for updates. All PANEL items or custom
-rows on panel will be set using DATA-LOAD-PLIST."))
+slots on panel will be set using DATA-LOAD-PLIST."))
 (defmethod query-row ((obj clog-one-row) panel sql)
   (setf (queryid obj) (dbi:execute
 		       (dbi:prepare
@@ -150,7 +150,7 @@ rows on panel will be set using DATA-LOAD-PLIST."))
 (defgeneric get-row (clog-one-row panel)
   (:documentation "Get first row from a database table based on
 CLOG-ONE-ROW's table-name using where-clause and table-columns.
-row-id-name is required. All PANEL items or custom rows on panel will
+row-id-name is required. All PANEL items or custom slots on panel will
 be set using DATA-LOAD-PLIST."))
 (defmethod get-row ((obj clog-one-row) panel)
   (let ((where (where-clause obj)))
@@ -177,7 +177,7 @@ be set using DATA-LOAD-PLIST."))
 
 (defgeneric next-row (clog-one-row panel)
   (:documentation "Get next row from a database table based on query
-made for get-row. All PANEL items or custom rows on panel will be set
+made for get-row. All PANEL items or custom slots on panel will be set
 using DATA-LOAD-PLIST."))
 (defmethod next-row ((obj clog-one-row) panel)
   (dolist (slave (slaves obj))
@@ -198,7 +198,7 @@ using DATA-LOAD-PLIST."))
 (defgeneric insert-row (clog-one-row panel)
   (:documentation "Insert new row in to database table based on
 CLOG-ONE-ROW's table-name and table-columns. DATA-WRITE-PLIST is
-used to extract data from PANEL items and custom rows."))
+used to extract data from PANEL items and custom slots."))
 (defmethod insert-row ((obj clog-one-row) panel)
   (dbi:do-sql (database-connection (clog-database obj))
     (sql-insert* (table-name obj)
@@ -254,3 +254,92 @@ Calculated fields, transformations to field values, etc. can be done in on-fetch
 new-row will block until on-fetch returns."))
 (defmethod set-on-fetch ((obj clog-one-row) on-fetch-handler)
   (setf (on-fetch obj) on-fetch-handler))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Implementation - clog-lookup
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass clog-lookup (clog-one-row clog-select)
+  ((value-field
+    :accessor value-field
+    :initform nil
+    :documentation "Field used to for value of lookup option.
+                    Case sensitive keyword")
+   (option-field
+    :accessor option-field
+    :initform nil
+    :documentation "Filed used to display for value of lookup option.
+                    Case sensitive keyword"))
+  (:documentation "CLOG Table Lookup Object"));
+
+;;;;;;;;;;;;;;;;;;;
+;; create-lookup ;;
+;;;;;;;;;;;;;;;;;;;
+
+(defgeneric create-lookup (clog-obj &key name multiple label class html-id)
+  (:documentation "Create a new clog-lookup as child of CLOG-OBJ."))
+
+(defmethod create-lookup ((obj clog-obj)
+			  &key (clog-database nil)
+			    (name nil)
+			    (multiple nil)
+			    (label nil)
+			    (class nil)
+			    (html-id nil))
+  (let ((element (create-child
+		  obj (format nil "<select~A~A~A/>"
+			      (if multiple
+				  " multiple"
+				  "")
+			      (if name
+				  (format nil " name='~A'" name)
+				  "")
+			      (if class
+				  (format nil " class='~A'"
+					  (escape-string class))
+				  ""))
+		 :clog-type 'clog-lookup :html-id html-id :auto-place t)))
+    (when label
+      (label-for label element))
+    (if (and (typep obj 'clog-database) (not clog-database))
+	(setf (clog-database element) obj)
+	(setf (clog-database element) clog-database))
+    element))
+
+(defmethod next-row ((obj clog-lookup) panel)
+  "In clog-lookup objects, next-row adds options to lookup's
+select tag for every row returned. The option value is set to
+the VALUE-FIELD property and the OPTION-FIELD property is the
+the displayed option."
+  (dolist (slave (slaves obj))
+    (clear-row slave panel))
+  ;; loop through fetches
+  (let ((select-value (text-value obj)))
+    (setf (rowid obj) nil)
+    (setf (inner-html obj) "")
+    (loop
+      (let ((selected nil)
+	    (row      (dbi:fetch (queryid obj))))
+	(unless row
+	  (return))
+	(when (on-fetch obj)
+	  (funcall (on-fetch obj) obj))
+	(when (equal select-value (getf row (value-field obj)))
+	  (setf selected t)
+	  (setf (rowid obj) (data-load-plist panel
+					     (last-fetch obj)
+					     :row-id-name (row-id-name obj))))
+	(add-select-option obj
+			   (getf row (value-field obj))
+			   (getf row (option-field obj))
+			   :selected selected))))
+  (if (rowid obj)
+      (dolist (slave (slaves obj))
+	(get-row slave panel))
+      (unless (slave-to-slot obj)
+	(clear-row obj panel)))
+  (rowid obj))
+
+(defmethod clear-row ((obj clog-lookup) panel)
+  (setf (inner-html obj) "")
+  (call-next-method))