From affe3dd05e38d82053740881bb835ff67048cd28 Mon Sep 17 00:00:00 2001 From: David Botton Date: Wed, 24 Feb 2021 13:16:26 -0500 Subject: [PATCH] :filename and :select support for form-dialog --- source/clog-gui.lisp | 57 ++++++++++++++++++++++++++++------------ tools/clog-db-admin.lisp | 11 +++++--- 2 files changed, 48 insertions(+), 20 deletions(-) diff --git a/source/clog-gui.lisp b/source/clog-gui.lisp index 4934af1..a8126f0 100644 --- a/source/clog-gui.lisp +++ b/source/clog-gui.lisp @@ -108,6 +108,10 @@ :accessor modal-background :initform nil :documentation "Modal Background") + (modal-count + :accessor modal-count + :initform 0 + :documentation "Count of nested modal windows") (in-drag :accessor in-drag :initform nil @@ -971,8 +975,10 @@ interactions. Use window-end-modal to undo.")) (defmethod window-make-modal ((obj clog-gui-window)) (let ((app (connection-data-item obj "clog-gui"))) - (setf (modal-background app) (create-div (body app) :class "w3-overlay")) - (setf (display (modal-background app)) :block) + (when (= (modal-count app) 0) + (setf (modal-background app) (create-div (body app) :class "w3-overlay")) + (setf (display (modal-background app)) :block)) + (incf (modal-count app)) (setf (keep-on-top obj) t) (setf (z-index obj) 4))) @@ -985,7 +991,9 @@ interactions. Use window-end-modal to undo.")) (defmethod window-end-modal ((obj clog-gui-window)) (let ((app (connection-data-item obj "clog-gui"))) - (destroy (modal-background app)) + (decf (modal-count app)) + (when (<= (modal-count app) 0) + (destroy (modal-background app))) (window-focus obj))) ;;;;;;;;;;;;;;;;;;; @@ -1392,27 +1400,30 @@ Calls on-input with t if confirmed or nil if canceled." (html-id nil)) "Create a form dialog box with CONTENT followed by FIELDS centered. Fields is an a-list of field names to field descriptions, a third element -can be added of another a-list of option Text to Value. Calls on-input +can be added to state field is :filename followed by default dir or +is a select followed by an a-list of option Text to Value. Calls on-input with a-list of field name to value if confirmed or nil if canceled." (unless html-id (setf html-id (clog-connection:generate-id))) (let* ((body (connection-data-item obj "clog-body")) (fls (format nil "~{~A~}" (mapcar (lambda (l) - (if (third l) - (format nil - "
~ + (cond + ((eq (third l) :select) + (format nil + "
~ " - (first l) html-id (second l) - (format nil "~{~A~}" - (mapcar (lambda (s) - (format nil - "" (second s) (first s))) - (third l)))) - (format nil + (first l) html-id (second l) + (format nil "~{~A~}" + (mapcar (lambda (s) + (format nil + "" (second s) (first s))) + (fourth l))))) + (t + (format nil "
~ -
" - (first l) html-id (second l)))) +
" + (first l) html-id (second l) html-id (second l))))) fields))) (win (create-gui-window obj :title title @@ -1450,6 +1461,18 @@ with a-list of field name to value if confirmed or nil if canceled." (setf (visiblep win) t) (when modal (window-make-modal win)) + (mapcar (lambda (l) + (when (eq (third l) :filename) + (let ((fld (attach-as-child body (format nil "~A-~A" + html-id + (second l)) + :clog-type 'clog:clog-form-element))) + (set-on-click fld (lambda (obj) + (declare (ignore obj)) + (server-file-dialog body (first l) (fourth l) + (lambda (fname) + (setf (value fld) fname)))))))) + fields) (js-execute obj (format nil "$('[name=~A-~A]').focus()" html-id (cadar fields))) @@ -1464,7 +1487,7 @@ with a-list of field name to value if confirmed or nil if canceled." (window-end-modal win)) (let ((result (mapcar (lambda (l) `(,(second l) - ,(if (third l) + ,(if (eq (third l) :select) (select-value win (format nil "~A-~A" html-id (second l))) diff --git a/tools/clog-db-admin.lisp b/tools/clog-db-admin.lisp index 75458f2..d43c13a 100644 --- a/tools/clog-db-admin.lisp +++ b/tools/clog-db-admin.lisp @@ -8,6 +8,10 @@ ((body :accessor body :documentation "Top level access to browser window") + (db-type + :accessor db-type + :initform nil + :documentation "Database type") (db-connection :accessor db-connection :initform nil @@ -16,11 +20,12 @@ (defun on-db-open (obj) (let* ((app (connection-data-item obj "app-data"))) (form-dialog obj nil - '(("Database Type" :db-type (("SQLite3" :sqlite3))) - ("Database Name" :db-name)) + '(("Database Type" :db-type :select (("SQLite3" :sqlite3))) + ("Database Name" :db-name :filename "./")) (lambda (results) (when results (format t "open db : ~A" (cadr (assoc :db-name results))) + (setf (db-type app) (cadr (assoc :db-type results))) (setf (db-connection app) (sqlite:connect (cadr (assoc :db-name results)))) (setf (title (html-document (body app))) @@ -30,7 +35,7 @@ (defun on-db-close (obj) (let ((app (connection-data-item obj "app-data"))) (when (db-connection app) - (sqlite:disconnect (db-connection app)) + (sqlite:disconnect (db-connection app)) (setf (db-connection app) nil)) (print "db disconnected") (setf (title (html-document (body app))) "CLOG DB Admin")))