diff --git a/source/clog-dbi.lisp b/source/clog-dbi.lisp index dae2668..168766b 100644 --- a/source/clog-dbi.lisp +++ b/source/clog-dbi.lisp @@ -357,7 +357,12 @@ the displayed option." ;; Implementation - clog-db-table ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defclass clog-db-table (clog-one-row clog-table)() +(defclass clog-db-table (clog-one-row clog-table) + ((on-header + :accessor on-header + :initform nil + :documentation "on-header event, called after get-row and + before outputing rows. (private)")) (:documentation "CLOG Database Table View Object")); ;;;;;;;;;;;;;;;;;;;;; @@ -395,6 +400,8 @@ the displayed option." ;; loop through fetches (setf (rowid obj) nil) (setf (inner-html obj) "") + (when (on-header obj) + (funcall (on-header obj) obj)) (loop (let ((row (dbi:fetch (queryid obj)))) (unless row @@ -414,3 +421,10 @@ the displayed option." (defmethod clear-row ((obj clog-db-table) panel) (setf (inner-html obj) "") (call-next-method)) + +(defgeneric set-on-header (clog-db-table on-header-handler) + (:documentation "Set the ON-HEADER-HANDLER for CLOG-DB-TABLE. If ON-HEADER-HANDLER +is nil unbind the event. The on-header event is called before the first row is output +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)) diff --git a/source/clog.lisp b/source/clog.lisp index ceee7b0..74c7b8f 100644 --- a/source/clog.lisp +++ b/source/clog.lisp @@ -572,7 +572,8 @@ embedded in a native template application.)" (option-field generic-function) (clog-db-table class) - (create-db-table generic-function)) + (create-db-table generic-function) + (set-on-header generic-function)) (defsection @clog-panels (:title "CLOG Panels") "CLOG-Panel - CLOG Panels" diff --git a/tools/clog-builder-settings.lisp b/tools/clog-builder-settings.lisp index 0fac209..c59c70d 100644 --- a/tools/clog-builder-settings.lisp +++ b/tools/clog-builder-settings.lisp @@ -1615,6 +1615,8 @@ (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") diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index cca50ef..0414df1 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -646,28 +646,30 @@ not a temporary attached one when using select-control." ,(getf event :parameters) ,(getf event :setup) ,(lambda (obj) - (let ((txt (text obj))) + (let ((txt (text-value obj))) (if (or (equal txt "") (equalp txt "undefined")) (remove-attribute control attr) - (setf (attribute control attr) (text obj)))))) + (setf (attribute control attr) (text-value obj)))))) events))) (dolist (item events) - (let* ((tr (create-table-row table)) - (td1 (create-table-column tr :content (first item))) - (td2 (if (second item) - (create-table-column tr :content (second item)) - (create-table-column tr)))) + (let* ((tr (create-table-row table)) + (td1 (create-table-column tr :content (first item))) + (td2 (create-table-column tr)) + (editor nil)) (setf (width td1) "30%") (setf (width td2) "70%") (set-border td1 "1px" :dotted :black) - (setf (spellcheckp td2) nil) (setf (advisory-title td1) (format nil "params: panel ~A" (third item))) (cond ((fourth item) + (setf editor td2) (setf (editablep td2) (funcall (fourth item) control td1 td2))) (t - (setf (editablep td2) t))) - (set-on-blur td2 + (setf editor (create-text-area td2)) + (setf (spellcheckp editor) nil) + (setf (width editor) "95%"))) ; leave space for scroll bar + (setf (text-value editor) (second item)) + (set-on-blur editor (lambda (obj) (funcall (fifth item) obj)))))))))