[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[STUMP] [PATCH] Confirmation when gkill is called interactively
From: |
Lionel Flandrin |
Subject: |
[STUMP] [PATCH] Confirmation when gkill is called interactively |
Date: |
Tue, 15 Jul 2008 00:15:23 +0200 |
* Ask for confirmation when gkill is called interactively in a
non-empty group.
* New function "ask-confirmation" that prints a message and returns T
if the user presses 'y', NIL otherwise.
---
group.lisp | 17 ++++++++++++++---
input.lisp | 8 ++++++++
2 files changed, 22 insertions(+), 3 deletions(-)
diff --git a/group.lisp b/group.lisp
index 424dc88..f5d99fa 100644
--- a/group.lisp
+++ b/group.lisp
@@ -356,9 +356,20 @@ the default group formatting and window formatting,
respectively."
"Kill the current group. All windows in the current group are migrated
to the next group."
(let ((dead-group (current-group))
- (to-group (next-group (current-group))))
- (switch-to-group to-group)
- (kill-group dead-group to-group)))
+ (to-group (next-group (current-group))))
+ (if (eq dead-group to-group)
+ (message "There's only one visible group")
+ (if (or (not %interactivep%)
+ (not (group-windows dead-group))
+ (ask-confirmation
+ (format nil "You are about to kill non-empty group \"^B^3*~a^n\"
+The windows will be moved to group \"^B^2*~a^n\"
+^B^6*Confirm ?^n" (group-name dead-group) (group-name to-group))))
+ (progn
+ (switch-to-group to-group)
+ (kill-group dead-group to-group)
+ (message "Deleted"))
+ (message "Canceled")))))
(defcommand gmerge (from) ((:group "From Group: "))
"Merge @var{from} into the current group. @var{from} is not deleted."
diff --git a/input.lisp b/input.lisp
index 0171b92..c8c4241 100644
--- a/input.lisp
+++ b/input.lisp
@@ -638,3 +638,11 @@ input (pressing Return), nil otherwise."
;; (defun cook-keycode (code state)
;; (values (xlib:keycode->keysym *display* code 0) (x11mod->stumpmod state)))
+
+
+(defun ask-confirmation (message)
+ "ask a yes-or-no question on the current screen and return T if the
+user presses 'y'"
+ (message (concatenate 'string message " [y/N]"))
+ (char= (read-one-char (current-screen))
+ #\y))
--
1.5.6