[STUMP] [PATCH] Clean up run-or-raise, add run-or-pull.

[John Li]

---

This splits the labeled "find-windows" and "sort-windows-by-group" fns
from run-or-raise out into a real fn: "find-matching-windows". Much
cleaner, yay. The newly defined "run-or-pull" uses it.

run-or-pull is nice because run-or-raise isn't always appropriate. I
may be working in a group with a meticulously crafted frame tree, and
a number of windows carefully selected and placed, and I don't want to
lose that context with a run-or-raise. run-or-pull will bring the
window to me instead of the other way around.

Note1: run-or-pull just does move-window-to-group and pull-window. Are
these too low-level, and do they always work?

Note2: pull-window only makes sense for tiled groups. For float
groups, it'd make sense to at least move the window to the group, but
this doesn't do that, bleh.

Patch for automatically defining commands and keybindings will
follow....


<3,
jli


 user.lisp |   62 +++++++++++++++++++++++++++++++++++++++++-------------------
 1 files changed, 42 insertions(+), 20 deletions(-)

diff --git a/user.lisp b/user.lisp
index 707e583..6d6106b 100644
--- a/user.lisp
+++ b/user.lisp
@@ -221,6 +221,23 @@ (defcommand soft-restart () ()
 process."
   (throw :top-level :restart))
 
+(defun find-matching-windows (props all-groups all-screens)
+  "Returns list of windows matching @var{props} (see run-or-raise
+documentation for details). @var{all-groups} will find windows on all
+groups. Same for @{all-screens}. Result is sorted by group and window
+number, with group being more significant (think radix sort)."
+  (let* ((screens (if all-screens
+                      *screen-list*
+                      (list (current-screen))))
+         (winlist (if all-groups
+                      (mapcan (lambda (s) (screen-windows s)) screens)
+                      (group-windows (current-group))))
+         (matches (remove-if-not (lambda (w)
+                                   (apply 'window-matches-properties-p w 
props))
+                                 winlist)))
+    (stable-sort (sort matches #'< :key #'window-number)
+                 #'< :key (lambda (w) (group-number (window-group w))))))
+
 (defun run-or-raise (cmd props &optional (all-groups 
*run-or-raise-all-groups*) (all-screens *run-or-raise-all-screens*))
   "Run the shell command, @var{cmd}, unless an existing window
 matches @var{props}. @var{props} is a property list with the following keys:
@@ -250,30 +267,35 @@ (defun run-or-raise (cmd props &optional (all-groups 
*run-or-raise-all-groups*) 
            (frame-raise-window group frame win)
            (focus-all win)
            (unless (eq frame old-frame)
-             (show-frame-indicator group))))
-       (sort-windows-by-group (winlist)
-         (stable-sort (sort winlist #'< :key #'window-number)
-                      #'< :key #'(lambda (w) (group-number (window-group w)))))
-       (find-window (winlist)
-         (let* ((match (remove-if-not #'(lambda (w)
-                                          (apply 'window-matches-properties-p 
w props))
-                                      winlist))
-                (match-sorted (sort-windows-by-group match))
-                (rest (member (current-window) match-sorted)))
-           (if (<= (length rest) 1) ; current win not a match or no matches 
left
-               (car match-sorted)
-               (cadr rest)))))
-    (let* ((screens (if all-screens
-                        *screen-list*
-                        (list (current-screen))))
-           (winlist (if all-groups
-                        (mapcan (lambda (s) (screen-windows s)) screens)
-                        (group-windows (current-group))))
-           (win (find-window winlist)))
+             (show-frame-indicator group)))))
+    (let* ((matches (find-matching-windows props all-groups all-screens))
+           ;; other-matches is list of matches "after" the current
+           ;; win, if current win matches. getting 2nd element means
+           ;; skipping over the current win, to cycle through matches
+           (other-matches (member (current-window) matches))
+           (win (if (> (length other-matches) 1)
+                    (second other-matches)
+                    (first matches))))
       (if win
           (goto-win win)
           (run-shell-command cmd)))))
 
+(defun run-or-pull (cmd props &optional (all-groups *run-or-raise-all-groups*)
+                    (all-screens *run-or-raise-all-screens*))
+  "Similar to run-or-raise, but move the matching window to the
+current frame instead of switching to the window."
+  (let* ((matches (find-matching-windows props all-groups all-screens))
+         ;; other-matches is for cycling through matches
+         (other-matches (member (current-window) matches))
+         (win (if (> (length other-matches) 1)
+                  (second other-matches)
+                  (first matches))))
+    (if win
+        (progn
+          (move-window-to-group win (current-group))
+          (pull-window win))
+        (run-shell-command cmd))))
+
 (defcommand reload () ()
 "Reload StumpWM using @code{asdf}."
   (message "Reloading StumpWM...")
-- 
1.5.6.5