mirror of https://codeberg.org/cage/tinmop/
- asking for confirmation when quitting the program using 'q'.
This commit is contained in:
parent
1acad1fad9
commit
74f363af3a
|
@ -137,10 +137,11 @@
|
||||||
|
|
||||||
;; global keymap
|
;; global keymap
|
||||||
|
|
||||||
(define-key "q" #'quit) ; here we are calling the custom
|
(define-key "q" #'confirm-and-clean-close-program)
|
||||||
; function defined above ...
|
|
||||||
|
|
||||||
(define-key "C-q" #'quit) ; ...also here
|
|
||||||
|
(define-key "C-q" #'quit) ; here we are calling the custom
|
||||||
|
; function defined above
|
||||||
|
|
||||||
(define-key "C-a" #'show-about-window)
|
(define-key "C-a" #'show-about-window)
|
||||||
|
|
||||||
|
|
|
@ -2620,6 +2620,7 @@
|
||||||
:open-manual
|
:open-manual
|
||||||
:quit-program
|
:quit-program
|
||||||
:clean-close-program
|
:clean-close-program
|
||||||
|
:confirm-and-clean-close-program
|
||||||
:notify
|
:notify
|
||||||
:notify-procedure
|
:notify-procedure
|
||||||
:with-blocking-notify-procedure
|
:with-blocking-notify-procedure
|
||||||
|
|
|
@ -47,10 +47,11 @@
|
||||||
|
|
||||||
(defmacro with-valid-yes-at-prompt ((input-text y-pressed-p) &body body)
|
(defmacro with-valid-yes-at-prompt ((input-text y-pressed-p) &body body)
|
||||||
(with-gensyms (not-null-input-p)
|
(with-gensyms (not-null-input-p)
|
||||||
`(multiple-value-bind (,y-pressed-p ,not-null-input-p)
|
`(multiple-value-bind (,y-pressed-p ,not-null-input-p)
|
||||||
(boolean-input-accepted-p ,input-text)
|
(boolean-input-accepted-p ,input-text)
|
||||||
(when ,not-null-input-p
|
(declare (ignorable ,y-pressed-p))
|
||||||
,@body))))
|
(when ,not-null-input-p
|
||||||
|
,@body))))
|
||||||
|
|
||||||
(defun clean-temporary-files ()
|
(defun clean-temporary-files ()
|
||||||
"Use this to close the program"
|
"Use this to close the program"
|
||||||
|
@ -82,6 +83,15 @@
|
||||||
temporary-files-count)))
|
temporary-files-count)))
|
||||||
(push-event (make-instance 'quit-program-event))))))
|
(push-event (make-instance 'quit-program-event))))))
|
||||||
|
|
||||||
|
(defun confirm-and-clean-close-program ()
|
||||||
|
(flet ((on-input-complete (maybe-accepted)
|
||||||
|
(with-valid-yes-at-prompt (maybe-accepted y-pressed-p)
|
||||||
|
(when y-pressed-p
|
||||||
|
(db-utils:with-ready-database (:connect nil)
|
||||||
|
(clean-close-program))))))
|
||||||
|
(ask-string-input #'on-input-complete
|
||||||
|
:prompt (format nil (_ "Quit ~a? [y/N] ") +program-name+))))
|
||||||
|
|
||||||
(defun clean-close-program ()
|
(defun clean-close-program ()
|
||||||
"Use this to close the program"
|
"Use this to close the program"
|
||||||
(flet ((on-input-complete (maybe-accepted)
|
(flet ((on-input-complete (maybe-accepted)
|
||||||
|
|
Loading…
Reference in New Issue