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 :misc :random-elt :shuffle)
(:shadowing-import-from :stack :stack :stack-push :stack-pop :stack-empty-p) (:shadowing-import-from :stack :stack :stack-push :stack-pop :stack-empty-p)
(:shadowing-import-from :text-utils :split-lines) (:shadowing-import-from :text-utils :split-lines)
(:local-nicknames (:c :croatoan)) (:local-nicknames (:c :croatoan)
(:c-dlg #:de.anvi.croatoan.dialog))
(:export (:export
:key-config-holder :key-config-holder
:key-config :key-config

4
src/program-events.lisp
View File

@ -560,7 +560,7 @@
(title object) (title object)
(payload object) (payload object)
(buttons object)))) (buttons object))))
(windows:menu-select dialog-window))) (windows:menu-select dialog-window :force-show-cursor nil)))
(defclass info-dialog-event (dialog-event) ()) (defclass info-dialog-event (dialog-event) ())
@ -569,7 +569,7 @@
(title object) (title object)
(payload object) (payload object)
(buttons object)))) (buttons object))))
(windows:menu-select dialog-window))) (windows:menu-select dialog-window :force-show-cursor nil)))
(defclass move-selected-tree-event (program-event) (defclass move-selected-tree-event (program-event)
((new-folder ((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) (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) (with-croatoan-window (croatoan-window window)
(when force-show-cursor
(cursor-show))
(prog1 (prog1
(c:select croatoan-window) (c:edit croatoan-window)
(when force-show-cursor
(cursor-hide))
(win-close window)))) (win-close window))))
(defun win-visible-p (win) (defun win-visible-p (win)
@ -521,57 +525,56 @@ list of strings (the text lines)."
(c:get-char low-level-window) (c:get-char low-level-window)
(win-close window))) (win-close window)))
(defun make-dialog (parent title message color-pair (defun make-dialog (parent title message style
&optional (buttons nil) &optional (buttons nil)
(append-ok-button t)) (append-ok-button t))
(let* ((lines (text-utils:split-lines message)) (let* ((lines (text-utils:split-lines message))
(max-line-size (text-utils:find-max-line-length lines))
(actual-buttons (if append-ok-button (actual-buttons (if append-ok-button
(append (list +menu-button-ok+) (append (list +menu-button-ok+)
buttons) buttons)
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 "~%"))) (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 :stacked nil
:center t :center t
:message-text message :message message
:input-blocking t :input-blocking t
:current-item-mark "" :style style
:color-pair color-pair :wrap-message t
:width (min (+ max-line-size 4)
(- (win-width parent)
4))
:border t
:enable-function-keys t :enable-function-keys t
:name title :title title
:title t :buttons actual-buttons)))
:max-item-length (min (+ max-button-size 4)
(- (win-width parent)
4))
:message-height (min (1+ (length lines))
max-message-height)
:items actual-buttons)))
(make-instance 'wrapper-window (make-instance 'wrapper-window
:croatoan-window dialog-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 (defun make-error-message-dialog (parent title message
&optional &optional
(buttons nil) (buttons nil)
(append-ok-button t)) (append-ok-button t))
(let ((bg (swconf:win-bg swconf:+key-error-dialog+)) (let* ((bg (swconf:win-bg swconf:+key-error-dialog+))
(fg (swconf:win-fg swconf:+key-error-dialog+))) (fg (swconf:win-fg swconf:+key-error-dialog+))
(make-dialog parent title message (list fg bg) buttons append-ok-button))) (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 (defun make-info-message-dialog (parent title message
&optional &optional
(buttons nil) (buttons nil)
(append-ok-button t)) (append-ok-button t))
(let ((bg (swconf:win-bg swconf:+key-info-dialog+)) (let* ((bg (swconf:win-bg swconf:+key-info-dialog+))
(fg (swconf:win-fg swconf:+key-info-dialog+))) (fg (swconf:win-fg swconf:+key-info-dialog+))
(make-dialog parent title message (list fg bg) buttons append-ok-button))) (style (make-simple-dialog-style fg bg)))
(make-dialog parent title message style buttons append-ok-button)))
(defun make-simple-style (foreground background (defun make-simple-style (foreground background
selected-foreground selected-background) selected-foreground selected-background)