mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
events for db-table
This commit is contained in:
David Botton
parent
312400d0d6
commit
e681bc3b9d
3 changed files with 121 additions and 72 deletions
|
|
@ -362,8 +362,21 @@ the displayed option."
|
|||
:accessor on-header
|
||||
:initform nil
|
||||
:documentation "on-header event, called after get-row and
|
||||
before outputing rows. (private)"))
|
||||
(:documentation "CLOG Database Table View Object"));
|
||||
before outputing rows. (private)")
|
||||
(on-footer
|
||||
:accessor on-footer
|
||||
:initform nil
|
||||
:documentation "on-footer event, called after get-row and
|
||||
before outputing rows. (private)")
|
||||
(on-row
|
||||
:accessor on-row
|
||||
:initform nil
|
||||
:documentation "on-row event. (private)")
|
||||
(on-column
|
||||
:accessor on-column
|
||||
:initform nil
|
||||
:documentation "on-column. (private)"))
|
||||
(:documentation "CLOG Database Table View Object"))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;
|
||||
;; create-db-table ;;
|
||||
|
|
@ -408,12 +421,16 @@ the displayed option."
|
|||
(return))
|
||||
(when (on-fetch obj)
|
||||
(funcall (on-fetch obj) obj))
|
||||
(create-child obj (format nil "<tr>~{~A~}</tr>"
|
||||
(let ((result))
|
||||
(let ((tr (create-table-row obj)))
|
||||
(when (on-row obj)
|
||||
(funcall (on-row obj) obj tr))
|
||||
(loop for (key value) on row by #'cddr while value
|
||||
do
|
||||
(push (format nil "<td>~A</td>" value) result))
|
||||
(reverse result))))))
|
||||
(let ((td (create-table-column obj :content value)))
|
||||
(when (on-column obj)
|
||||
(funcall (on-column obj) obj key td)))))))
|
||||
(when (on-footer obj)
|
||||
(funcall (on-footer obj) obj))
|
||||
(dolist (slave (slaves obj))
|
||||
(get-row slave panel))
|
||||
(rowid obj))
|
||||
|
|
@ -428,3 +445,26 @@ is nil unbind the event. The on-header event is called before the first row is o
|
|||
after the table is cleared to all adding a header information to the table."))
|
||||
(defmethod set-on-header ((obj clog-db-table) on-header-handler)
|
||||
(setf (on-header obj) on-header-handler))
|
||||
|
||||
(defgeneric set-on-footer (clog-db-table on-footer-handler)
|
||||
(:documentation "Set the ON-FOOTER-HANDLER for CLOG-DB-TABLE. If ON-FOOTER-HANDLER
|
||||
is nil unbind the event. The on-footer event is called after all rows are output
|
||||
after the table is cleared for adding footer information to the table."))
|
||||
(defmethod set-on-footer ((obj clog-db-table) on-footer-handler)
|
||||
(setf (on-footer obj) on-footer-handler))
|
||||
|
||||
(defgeneric set-on-row (clog-db-table on-row-handler)
|
||||
(:documentation "Set the ON-ROW-HANDLER for CLOG-DB-TABLE. If ON-ROW-HANDLER
|
||||
is nil unbind the event. The on-row event is called for each row. The row handler
|
||||
is passed also the clog-table-row object before the columns are added in second parameter to
|
||||
handler."))
|
||||
(defmethod set-on-row ((obj clog-db-table) on-row-handler)
|
||||
(setf (on-row obj) on-row-handler))
|
||||
|
||||
(defgeneric set-on-column (clog-db-table on-column-handler)
|
||||
(:documentation "Set the ON-COLUMN-HANDLER for CLOG-DB-TABLE. If ON-COLUMN-HANDLER
|
||||
is nil unbind the event. The on-column event is called for each column as added to
|
||||
the current row being processsed. It is passed also the keyworld symbol name of
|
||||
the column and the clog-table-column object."))
|
||||
(defmethod set-on-column ((obj clog-db-table) on-column-handler)
|
||||
(setf (on-column obj) on-column-handler))
|
||||
|
|
|
|||
|
|
@ -573,7 +573,10 @@ embedded in a native template application.)"
|
|||
|
||||
(clog-db-table class)
|
||||
(create-db-table generic-function)
|
||||
(set-on-header generic-function))
|
||||
(set-on-header generic-function)
|
||||
(set-on-footer generic-function)
|
||||
(set-on-row generic-function)
|
||||
(set-on-column generic-function))
|
||||
|
||||
(defsection @clog-panels (:title "CLOG Panels")
|
||||
"CLOG-Panel - CLOG Panels"
|
||||
|
|
|
|||
|
|
@ -1359,7 +1359,7 @@
|
|||
:attr "data-clog-dbi-dbname")
|
||||
,@*props-element*))
|
||||
`(:name "one-row"
|
||||
:description "Table One Row"
|
||||
:description "One Row"
|
||||
:clog-type clog:clog-one-row
|
||||
:create clog:create-one-row
|
||||
:create-type :base
|
||||
|
|
@ -1417,6 +1417,73 @@
|
|||
(:name "join to slot-name (optional)"
|
||||
:attr "data-clog-one-row-master")
|
||||
,@*props-element*))
|
||||
`(:name "db-table"
|
||||
:description "Table Many Rows"
|
||||
:clog-type clog:clog-db-table
|
||||
:create clog:create-db-table
|
||||
:create-type :base
|
||||
:setup ,(lambda (control content control-record)
|
||||
(declare (ignore content) (ignore control-record))
|
||||
(setf (attribute control "data-clog-one-row-table") "")
|
||||
(setf (attribute control "data-clog-one-row-where") "")
|
||||
(setf (attribute control "data-clog-one-row-order") "")
|
||||
(setf (attribute control "data-clog-one-row-limit") "")
|
||||
(setf (attribute control "data-clog-one-row-master") "")
|
||||
(setf (attribute control "data-clog-one-row-id-name") "rowid")
|
||||
(setf (attribute control "data-clog-one-row-columns") "rowid"))
|
||||
:on-setup ,(lambda (control control-record)
|
||||
(declare (ignore control-record))
|
||||
(let ((parent (attribute (parent-element control) "data-clog-name"))
|
||||
(master (attribute control "data-clog-one-row-master")))
|
||||
(when (equal master "")
|
||||
(setf master nil))
|
||||
(format nil "(setf (clog-database target) ~A) ~
|
||||
~A ~
|
||||
(setf (table-name target) \"~A\") ~
|
||||
(setf (where-clause target) \"~A\") ~
|
||||
(setf (order-by target) \"~A\") ~
|
||||
(setf (limit target) \"~A\") ~
|
||||
(setf (row-id-name target) \"~A\") ~
|
||||
(setf (table-columns target) '(~A))"
|
||||
(if master
|
||||
(format nil "(clog-database (~A panel))" parent)
|
||||
(format nil "(~A panel)" parent))
|
||||
(if master
|
||||
(format nil "(set-master-one-row target (~A panel) \"~A\")"
|
||||
parent master)
|
||||
"")
|
||||
(attribute control "data-clog-one-row-table")
|
||||
(attribute control "data-clog-one-row-where")
|
||||
(attribute control "data-clog-one-row-order")
|
||||
(attribute control "data-clog-one-row-limit")
|
||||
(attribute control "data-clog-one-row-id-name")
|
||||
(attribute control "data-clog-one-row-columns"))))
|
||||
:events ((:name "on-fetch"
|
||||
:parameters "target")
|
||||
(:name "on-header"
|
||||
:parameters "target")
|
||||
(:name "on-footer"
|
||||
:parameters "target")
|
||||
(:name "on-row"
|
||||
:parameters "target table-row")
|
||||
(:name "on-column"
|
||||
:parameters "target column table-column")
|
||||
,@*events-element*)
|
||||
:properties ((:name "table name"
|
||||
:attr "data-clog-one-row-table")
|
||||
(:name "table row id name"
|
||||
:attr "data-clog-one-row-id-name")
|
||||
(:name "table columns"
|
||||
:attr "data-clog-one-row-columns")
|
||||
(:name "where clause (optional)"
|
||||
:attr "data-clog-one-row-where")
|
||||
(:name "order by (optional)"
|
||||
:attr "data-clog-one-row-order")
|
||||
(:name "limit (optional)"
|
||||
:attr "data-clog-one-row-limit")
|
||||
(:name "join to slot-name (optional)"
|
||||
:attr "data-clog-one-row-master")
|
||||
,@*props-element*))
|
||||
`(:name "lookup-drop"
|
||||
:description "Drop down table lookup"
|
||||
:clog-type clog:clog-lookup
|
||||
|
|
@ -1571,68 +1638,7 @@
|
|||
:attr "data-clog-one-row-limit")
|
||||
(:name "join to slot-name (optional)"
|
||||
:attr "data-clog-one-row-master")
|
||||
,@*props-form-element*))
|
||||
`(:name "db-table"
|
||||
:description "Table Many Rows"
|
||||
:clog-type clog:clog-db-table
|
||||
:create clog:create-db-table
|
||||
:create-type :base
|
||||
:setup ,(lambda (control content control-record)
|
||||
(declare (ignore content) (ignore control-record))
|
||||
(setf (attribute control "data-clog-one-row-table") "")
|
||||
(setf (attribute control "data-clog-one-row-where") "")
|
||||
(setf (attribute control "data-clog-one-row-order") "")
|
||||
(setf (attribute control "data-clog-one-row-limit") "")
|
||||
(setf (attribute control "data-clog-one-row-master") "")
|
||||
(setf (attribute control "data-clog-one-row-id-name") "rowid")
|
||||
(setf (attribute control "data-clog-one-row-columns") "rowid"))
|
||||
:on-setup ,(lambda (control control-record)
|
||||
(declare (ignore control-record))
|
||||
(let ((parent (attribute (parent-element control) "data-clog-name"))
|
||||
(master (attribute control "data-clog-one-row-master")))
|
||||
(when (equal master "")
|
||||
(setf master nil))
|
||||
(format nil "(setf (clog-database target) ~A) ~
|
||||
~A ~
|
||||
(setf (table-name target) \"~A\") ~
|
||||
(setf (where-clause target) \"~A\") ~
|
||||
(setf (order-by target) \"~A\") ~
|
||||
(setf (limit target) \"~A\") ~
|
||||
(setf (row-id-name target) \"~A\") ~
|
||||
(setf (table-columns target) '(~A))"
|
||||
(if master
|
||||
(format nil "(clog-database (~A panel))" parent)
|
||||
(format nil "(~A panel)" parent))
|
||||
(if master
|
||||
(format nil "(set-master-one-row target (~A panel) \"~A\")"
|
||||
parent master)
|
||||
"")
|
||||
(attribute control "data-clog-one-row-table")
|
||||
(attribute control "data-clog-one-row-where")
|
||||
(attribute control "data-clog-one-row-order")
|
||||
(attribute control "data-clog-one-row-limit")
|
||||
(attribute control "data-clog-one-row-id-name")
|
||||
(attribute control "data-clog-one-row-columns"))))
|
||||
:events ((:name "on-fetch"
|
||||
:parameters "target")
|
||||
(:name "on-header"
|
||||
:parameters "target")
|
||||
,@*events-element*)
|
||||
:properties ((:name "table name"
|
||||
:attr "data-clog-one-row-table")
|
||||
(:name "table row id name"
|
||||
:attr "data-clog-one-row-id-name")
|
||||
(:name "table columns"
|
||||
:attr "data-clog-one-row-columns")
|
||||
(:name "where clause (optional)"
|
||||
:attr "data-clog-one-row-where")
|
||||
(:name "order by (optional)"
|
||||
:attr "data-clog-one-row-order")
|
||||
(:name "limit (optional)"
|
||||
:attr "data-clog-one-row-limit")
|
||||
(:name "join to slot-name (optional)"
|
||||
:attr "data-clog-one-row-master")
|
||||
,@*props-element*))))
|
||||
,@*props-form-element*))))
|
||||
|
||||
(defparameter *supported-templates*
|
||||
(list
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue