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

+
+~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))