Use text areas for events

This commit is contained in:
David Botton 2022-02-28 10:12:27 -05:00
parent 89c923b8f8
commit 312400d0d6
4 changed files with 31 additions and 12 deletions

View file

@ -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))

View file

@ -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"

View file

@ -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")

View file

@ -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)))))))))