cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

- used the brand new dialog window made available from croatoan.

This commit is contained in:
cage 2023-01-30 20:49:57 +01:00
parent 5138d53fa5
commit 13286e44e0
3 changed files with 46 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/package.lisp
View File

@ -1789,7 +1789,8 @@
(:shadowing-import-from :misc :random-elt :shuffle)
(:shadowing-import-from :stack :stack :stack-push :stack-pop :stack-empty-p)
(:shadowing-import-from :text-utils :split-lines)
(:local-nicknames (:c :croatoan))
(:local-nicknames (:c :croatoan)
(:c-dlg #:de.anvi.croatoan.dialog))
(:export
:key-config-holder
:key-config

4
src/program-events.lisp
View File

@ -560,7 +560,7 @@
(title object)
(payload object)
(buttons object))))
(windows:menu-select dialog-window)))
(windows:menu-select dialog-window :force-show-cursor nil)))
(defclass info-dialog-event (dialog-event) ())
@ -569,7 +569,7 @@
(title object)
(payload object)
(buttons object))))
(windows:menu-select dialog-window)))
(windows:menu-select dialog-window :force-show-cursor nil)))
(defclass move-selected-tree-event (program-event)
((new-folder

61
src/windows.lisp
View File

@ -152,10 +152,14 @@ height, position and so on)"
(gen-simple-win->croatoan-specialized-wrapper touch win)
(defun menu-select (window)
(defun menu-select (window &key (force-show-cursor t))
(with-croatoan-window (croatoan-window window)
(when force-show-cursor
(cursor-show))
(prog1
(c:select croatoan-window)
(c:edit croatoan-window)
(when force-show-cursor
(cursor-hide))
(win-close window))))
(defun win-visible-p (win)
@ -521,57 +525,56 @@ list of strings (the text lines)."
(c:get-char low-level-window)
(win-close window)))
(defun make-dialog (parent title message color-pair
(defun make-dialog (parent title message style
&optional (buttons nil)
(append-ok-button t))
(let* ((lines (text-utils:split-lines message))
(max-line-size (text-utils:find-max-line-length lines))
(actual-buttons (if append-ok-button
(append (list +menu-button-ok+)
buttons)
buttons))
(max-button-size (text-utils:find-max-line-length actual-buttons))
(max-message-height (- (win-height-no-border parent)
4))
(message (join-with-strings lines (format nil "~%")))
(dialog-window (make-instance 'c:dialog-window
(dialog-window (make-instance 'c-dlg:msgbox
;:parent parent
:stacked nil
:center t
:message-text message
:message message
:input-blocking t
:current-item-mark ""
:color-pair color-pair
:width (min (+ max-line-size 4)
(- (win-width parent)
4))
:border t
:style style
:wrap-message t
:enable-function-keys t
:name title
:title t
:max-item-length (min (+ max-button-size 4)
(- (win-width parent)
4))
:message-height (min (1+ (length lines))
max-message-height)
:items actual-buttons)))
:title title
:buttons actual-buttons)))
(make-instance 'wrapper-window
:croatoan-window dialog-window)))
(defun make-simple-dialog-style (fg bg)
`(:foreground (:fgcolor ,fg :bgcolor ,bg)
:background (:fgcolor ,fg :bgcolor ,bg)
:title (:fgcolor ,fg :bgcolor ,bg)
c:label (:foreground (:fgcolor ,fg :bgcolor ,bg))
c:button (:border (:fgcolor ,bg)
:foreground (:fgcolor ,fg)
:selected-border (:fgcolor ,fg)
:selected-background (:bgcolor ,bg))))
(defun make-error-message-dialog (parent title message
&optional
(buttons nil)
(append-ok-button t))
(let ((bg (swconf:win-bg swconf:+key-error-dialog+))
(fg (swconf:win-fg swconf:+key-error-dialog+)))
(make-dialog parent title message (list fg bg) buttons append-ok-button)))
(let* ((bg (swconf:win-bg swconf:+key-error-dialog+))
(fg (swconf:win-fg swconf:+key-error-dialog+))
(style (make-simple-dialog-style fg bg)))
(make-dialog parent title message style buttons append-ok-button)))
(defun make-info-message-dialog (parent title message
&optional
(buttons nil)
(append-ok-button t))
(let ((bg (swconf:win-bg swconf:+key-info-dialog+))
(fg (swconf:win-fg swconf:+key-info-dialog+)))
(make-dialog parent title message (list fg bg) buttons append-ok-button)))
(let* ((bg (swconf:win-bg swconf:+key-info-dialog+))
(fg (swconf:win-fg swconf:+key-info-dialog+))
(style (make-simple-dialog-style fg bg)))
(make-dialog parent title message style buttons append-ok-button)))
(defun make-simple-style (foreground background
selected-foreground selected-background)