mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2026-01-03 07:42:32 -08:00
Code Issues Projects Releases Wiki Activity

escape brackets in one-of-dialog

Browse source
This commit is contained in:
David Botton 2024-04-14 20:15:57 -04:00
parent 0d19a10987
commit da6f42eb2e
1 changed files with 25 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

45
source/clog-gui.lisp
View file

@ -2264,26 +2264,31 @@ make-two-way-stream to provide a *query-io* using a clog-gui instead of console)
(defun one-of-dialog (obj intro choices &key (title "Please choose one") (prompt "Choice")) (defun one-of-dialog (obj intro choices &key (title "Please choose one") (prompt "Choice"))
"Prompt a dialog box with TITLE and INTRO using list of CHOICES and PROMPT" "Prompt a dialog box with TITLE and INTRO using list of CHOICES and PROMPT"
(let ((q (format nil "<pre>~A</pre><p style='text-align:left'>" intro)) (flet ((qb (q)
(n (length choices)) (i)) (setf q (format nil "~A" q))
(do ((c choices (cdr c)) (i 1 (+ i 1))) (setf q (ppcre:regex-replace-all "<" q "&lt;"))
((null c)) (setf q (ppcre:regex-replace-all ">" q "&gt;"))
(setf q (format nil "~A~&[~D] ~A~%<br>" q i (car c)))) q))
(do () ((typep i `(integer 1 ,n))) (let ((q (format nil "<pre>~A</pre><p style='text-align:left'>" (qb intro)))
(let ((trc (make-array '(0) :element-type 'base-char (n (length choices)) (i))
:fill-pointer 0 :adjustable t))) (do ((c choices (cdr c)) (i 1 (+ i 1)))
(with-output-to-string (s trc) ((null c))
(uiop:print-condition-backtrace intro :stream s)) (setf q (format nil "~A~&[~D] ~A~%<br>" q i (qb (car c)))))
(when trc (do () ((typep i `(integer 1 ,n)))
(format t "~A" trc))) (let ((trc (make-array '(0) :element-type 'base-char
(setf q (format nil "~A~&~A:" q prompt)) :fill-pointer 0 :adjustable t)))
(setq i (read-from-string (input-dialog obj q (lambda (result) (or result "")) (with-output-to-string (s trc)
:title title (uiop:print-condition-backtrace intro :stream s))
:time-out 999 (when trc
:modal nil (format t "~A" trc)))
:width 640 (setf q (format nil "~A~&~A:" q prompt))
:height 480)))) (setq i (read-from-string (input-dialog obj q (lambda (result) (or result ""))
(nth (- i 1) choices))) :title title
:time-out 999
:modal nil
:width 640
:height 480))))
(nth (- i 1) choices))))
(defparameter *default-icon* (defparameter *default-icon*
"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAACAAAAAcCAYAAAAAwr0iAAAAAXNSR0IArs4c6QAAAKZlWElmTU0A "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAACAAAAAcCAYAAAAAwr0iAAAAAXNSR0IArs4c6QAAAKZlWElmTU0A