From 8efe3736455c869fa33342ad0731b48258d30e93 Mon Sep 17 00:00:00 2001
From: Lionel Flandrin <address@hidden>
Date: Mon, 2 Nov 2009 16:42:59 +0100
Subject: [PATCH] Fixed gkill when all groups are hidden.

The behaviour and interface of the function "next-group" has been
slightly modified (and documented):
- Instead of an &optional list parameter it takes two &key: groups and
allow-hidden.
- If there is no "next-group" (i.e. the "current" is the last
remaining group) it returns NIL instead of "current".
- If "allow-hidden" is T don't exclude the hidden groups.
---
 group.lisp |   55 ++++++++++++++++++++++++++++++++-----------------------
 1 files changed, 32 insertions(+), 23 deletions(-)

diff --git a/group.lisp b/group.lisp
index 61b36c8..95d5455 100644
--- a/group.lisp
+++ b/group.lisp
@@ -180,16 +180,23 @@ at 0. Return a netwm compliant group id."
       (t
        (really-move-window window to-group)))))
 
-(defun next-group (current &optional (list (screen-groups (group-screen current))))
+(defun next-group (current &key (groups (screen-groups (group-screen current))) allow-hidden)
+  "Return the group following @var{current} in @var{groups} ignoring
+the hidden ones unless @var{allow-hidden} is @code{T}. If no other
+group than @var{current} is found, return @code{NIL}"
   ;; ditch the negative groups
-  (setf list (non-hidden-groups list))
-  (let* ((matches (member current list)))
-    (if (null (cdr matches))
-        ;; If the last one in the list is current, then
-        ;; use the first one.
-        (car list)
-        ;; Otherwise, use the next one in the list.
-        (cadr matches))))
+  (unless allow-hidden
+    (setf groups (non-hidden-groups groups)))
+  (let* ((matches (member current groups))
+         (next-group (if (null (cdr matches))
+                         ;; If the last one in the list is current, then
+                         ;; use the first one.
+                         (car groups)
+                         ;; Otherwise, use the next one in the list.
+                         (cadr matches))))
+    (if (eq next-group current)
+        nil
+        next-group)))
 
 (defun merge-groups (from-group to-group)
   "Merge all windows in FROM-GROUP into TO-GROUP."
@@ -297,7 +304,7 @@ Groups are known as \"virtual desktops\" in the NETWM standard."
 (defun group-forward (current list)
   "Switch to the next group in the list, if one exists. Returns the
 new group."
-  (let ((ng (next-group current list)))
+  (let ((ng (next-group current :groups list)))
     (when ng
       (switch-to-group ng)
       ng)))
@@ -433,21 +440,23 @@ the default group formatting and window formatting, respectively."
 (defcommand gkill () ()
 "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))))
-    (if (eq dead-group to-group)
-    (message "There's only one visible group")
-    (if (or (not %interactivep%)
-	    (not (group-windows dead-group))
-	    (y-or-n-p
-	     (format nil "You are about to kill non-empty group \"^B^3*~a^n\"
+  (let* ((dead-group (current-group))
+         ;; If no "visible" group is found, fallback on a hidden one
+	(to-group (or (next-group dead-group)
+                      (next-group dead-group :allow-hidden t))))
+    (if to-group
+        (if (or (not %interactivep%)
+            (not (group-windows dead-group))
+            (y-or-n-p
+             (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")))))
+            (progn
+              (switch-to-group to-group)
+              (kill-group dead-group to-group)
+              (message "Deleted"))
+            (message "Canceled"))
+        (message "There's only one group left"))))
 
 (defcommand gmerge (from) ((:group "From Group: "))
 "Merge @var{from} into the current group. @var{from} is not deleted."
-- 
1.6.5.2