[STUMP] [PATCH] Confirmation when gkill is called interactively

[Lionel Flandrin]

* 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