mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

Prompt Dialog

Browse source
This commit is contained in:
garlic0x1 2024-09-29 21:10:27 -05:00 • committed by David Botton
parent a5c84a6d92
commit a4ef26f6ef
2 changed files with 134 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

120
source/clog-gui.lisp
View file

@ -88,6 +88,7 @@
(alert-dialog function)
(input-dialog function)
(confirm-dialog function)
(prompt-dialog function)
(form-dialog function)
(server-file-dialog function)
@ -2100,6 +2101,125 @@ Calls on-input with t if confirmed or nil if canceled."
(window-close win)))
result))
;;;;;;;;;;;;;;;;;;;
;; prompt-dialog ;;
;;;;;;;;;;;;;;;;;;;
(defun prompt-dialog (obj callback
&key
(title "Prompt")
(completion #'list)
(validation (constantly t))
(presentation (lambda (it) (format nil "~a" it)))
(initial-value "")
(modal t)
time-out
left top (width 390) (height 425)
maximize
client-movement
(keep-on-top t)
html-id)
"Create a prompt dialog box with a selection of items generated by
the provided COMPLETION function.
COMPLETION is a function that takes the current string and returns
a list of options.
VALIDATION is a predicate that you can specify to prevent the user
from entering a malformed text input.
PRESENTATION is used if COMPLETION yields something other than strings.
Pressing <Tab> will replace the input field with the top completion,
as you might expect in an IDE. Clicking an item will also put it in
the input field.
Pressing <Escape> will cancel the prompt."
(let* ((sem (when time-out (bt2:make-semaphore)))
(result nil)
(body (connection-body obj))
(win (create-gui-window obj
:title title
:maximize maximize
:top top
:left left
:width width
:height height
:hidden t
:client-movement client-movement
:keep-on-top keep-on-top
:html-id html-id))
(form (create-form (window-content win)
:style "width:100%;display:flex;"))
(input (create-form-element form :input :style "flex-grow:1;"))
(ok (create-button form
:content "Okay"
:class "w3-button w3-black"))
(cancel (create-button form
:content "Cancel"
:class "w3-button w3-black"))
(items-list (create-unordered-list
(window-content win)
:class "w3-ul w3-hoverable"))
(items '()))
(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 (overflow items-list) :auto)
(setf (visiblep win) t)
(setf (value input) initial-value)
(setf (attribute input "autocomplete") "off")
(when modal
(window-make-modal win))
(flet ((refresh-completions ()
(setf (inner-html items-list) "")
(setf items '())
(dolist (it (funcall completion (value input)))
(setf items (append items (list it)))
(let ((li (create-list-item
items-list
:content (funcall presentation it))))
(set-on-click li (lambda (obj)
(declare (ignore obj))
(setf (value input) it)
(focus input)))))
(focus input)))
(refresh-completions)
(set-on-window-close win (lambda (obj)
(declare (ignore obj))
(when modal
(window-end-modal win))
(when sem
(bt2:signal-semaphore sem))))
(set-on-click ok (lambda (obj)
(declare (ignore obj))
(when (funcall validation (value input))
(when modal
(window-end-modal win))
(setf result (funcall callback (value input)))
(window-close win)))
:one-time t)
(set-on-click cancel (lambda (obj)
(declare (ignore obj))
(window-close win)))
(set-on-key-down input (lambda (obj ev)
(declare (ignore obj))
(let ((key (getf ev :key)))
(cond ((equal "Escape" key)
(window-close win))
((equal "Tab" key)
(setf (value input) (car items))
)))
(refresh-completions)))
(when sem
(unless (bt2:wait-on-semaphore sem :timeout time-out)
(setf sem nil)
(window-close win)))
result)))
;;;;;;;;;;;;;;;;;
;; form-dialog ;;
;;;;;;;;;;;;;;;;;