diff --git a/source/clog-gui.lisp b/source/clog-gui.lisp
index ce9103b..8210cc7 100644
--- a/source/clog-gui.lisp
+++ b/source/clog-gui.lisp
@@ -71,6 +71,7 @@
(alert-dialog function)
(input-dialog function)
(confirm-dialog function)
+ (form-dialog function)
(server-file-dialog function))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1378,6 +1379,86 @@ Calls on-input with t if confirmed or nil if canceled."
(window-end-modal win))
(funcall on-input nil)))))
+(defun form-dialog (obj content fields on-input &key (modal t)
+ (title "Form")
+ (ok-text "OK")
+ (cancel-text "Cancel")
+ (left nil) (top nil)
+ (width 400) (height 500)
+ (client-movement nil)
+ (html-id nil))
+ "Create a form dialog box with CONTENT followed by FIELDS centered.
+Fields is an alist of field names to field descriptions. Calls on-input
+with t 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)
+ (format nil
+"
~
+
"
+ (first l) html-id (second l)))
+ fields)))
+ (win (create-gui-window obj
+ :title title
+ :content (format nil
+"
+
~A
+
+" content
+ fls
+ html-id ok-text ; ok
+ html-id cancel-text) ; cancel
+ :top top
+ :left left
+ :width width
+ :height height
+ :hidden t
+ :client-movement client-movement
+ :html-id html-id))
+ (ok (attach-as-child win (format nil "~A-ok" html-id)))
+ (cancel (attach-as-child win (format nil "~A-cancel" html-id))))
+ (unless top
+ (setf (top win) (unit :px (- (/ (inner-height (window body)) 2.0)
+ (/ (height win) 2.0)))))
+ (unless left
+ (setf (left win) (unit :px (- (/ (inner-width (window body)) 2.0)
+ (/ (width win) 2.0)))))
+ (setf (visiblep win) t)
+ (when modal
+ (window-make-modal win))
+ (set-on-click cancel (lambda (obj)
+ (declare (ignore obj))
+ (window-close win))
+ :one-time t)
+ (set-on-click ok (lambda (obj)
+ (declare (ignore obj))
+ (set-on-window-close win nil)
+ (when modal
+ (window-end-modal win))
+ (let ((result (mapcar (lambda (l)
+ `(,(second l)
+ ,(name-value win (format nil "~A-~A"
+ html-id
+ (second l)))))
+ fields)))
+ (window-close win)
+ (funcall on-input result)))
+
+ :one-time t)
+ (set-on-window-close win (lambda (obj)
+ (declare (ignore obj))
+ (when modal
+ (window-end-modal win))
+ (funcall on-input nil)))))
+
(defun server-file-dialog (obj title initial-dir on-file-name
&key (modal t)
(left nil) (top nil) (width 375) (height 420)
diff --git a/tutorial/22-tutorial.lisp b/tutorial/22-tutorial.lisp
index 09ef491..35740a8 100644
--- a/tutorial/22-tutorial.lisp
+++ b/tutorial/22-tutorial.lisp
@@ -72,6 +72,15 @@
(server-file-dialog obj "Server files" "./" (lambda (fname)
(alert-dialog obj fname))))
+(defun on-dlg-form (obj)
+ (form-dialog obj "Please enter your information." '(("Name" "name")
+ ("Address" "address")
+ ("City" "city")
+ ("State" "st")
+ ("Zip" "zip"))
+ (lambda (results)
+ (alert-dialog obj results))))
+
(defun on-help-about (obj)
(let* ((about (create-gui-window obj
:title "About"
@@ -109,6 +118,7 @@
(tmp (create-gui-menu-item dlg :content "Alert Dialog Box" :on-click #'on-dlg-alert))
(tmp (create-gui-menu-item dlg :content "Input Dialog Box" :on-click #'on-dlg-input))
(tmp (create-gui-menu-item dlg :content "Confirm Dialog Box" :on-click #'on-dlg-confirm))
+ (tmp (create-gui-menu-item dlg :content "Form Dialog Box" :on-click #'on-dlg-form))
(tmp (create-gui-menu-item dlg :content "Server File Dialog Box" :on-click #'on-dlg-file))
(help (create-gui-menu-drop-down menu :content "Help"))
(tmp (create-gui-menu-item help :content "About" :on-click #'on-help-about))