mirror of https://codeberg.org/cage/tinmop/
- used the brand new dialog window made available from croatoan.
This commit is contained in:
cage
parent
5138d53fa5
commit
13286e44e0
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
:stacked nil
|
||||
:center t
|
||||
:message-text message
|
||||
:input-blocking t
|
||||
:current-item-mark ""
|
||||
:color-pair color-pair
|
||||
:width (min (+ max-line-size 4)
|
||||
(- (win-width parent)
|
||||
4))
|
||||
:border 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)))
|
||||
(let* ((lines (text-utils:split-lines message))
|
||||
(actual-buttons (if append-ok-button
|
||||
(append (list +menu-button-ok+)
|
||||
buttons)
|
||||
buttons))
|
||||
(message (join-with-strings lines (format nil "~%")))
|
||||
(dialog-window (make-instance 'c-dlg:msgbox
|
||||
;:parent parent
|
||||
:stacked nil
|
||||
:center t
|
||||
:message message
|
||||
:input-blocking t
|
||||
:style style
|
||||
:wrap-message t
|
||||
:enable-function-keys t
|
||||
: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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue