Improved extensibility for window order

[Martin Stjernholm <mast lysator liu se>]

Hello and thanks for a nice window manager.

I wanted to implement my own window order algorithm (based on window
position instead of an MRU stack). This turned out to be a bit awkward
since it requires me to override the whole x-cycle package with my
own, which would basically just be a copy. The code is nicely
abstracted into cycling in commands/x-cycle.jl and window order stuff
in util/window-order.jl, but the problem is that window-order.jl
provides no way to hook in a custom window order function.

The attached patch adds that to window-order.jl. The hook-in code is
more or less ripped from placement.jl but without the autoload stuff
which I haven't figured out.

The patch also fixes a bug in x-cycle.jl which appeared when I used my
own window order: In one place it assumed that MRU order is used and
simply added the currently focused window to the front of the order.
To avoid clumsy code I split up the window-order function into two:
One that gets the window list to order (get-windows-to-order) and
another one that does the actual sorting (sort-windows-in-order).

The patch includes a fix for another minor bug in x-cycle.jl (sorry
for mixing it together): When focusing a window it did not call
warp-pointer-if-necessary which had the effect that
warp-to-window-enabled wasn't heeded by the x-cycle package. (A little
bit of refactoring between that code and activate-window in windows.jl
is probably in order to avoid this kind of bug in the future.)

Can this patch or something like it get in? I'd like to know so I can
make my window order package available using a supported API.


--- sawfish-1.3+cvs20031104.orig/lisp/sawfish/wm/commands/x-cycle.jl
+++ sawfish-1.3+cvs20031104/lisp/sawfish/wm/commands/x-cycle.jl
@@ -166,10 +166,12 @@
 
   (define (cycle-next windows count)
     (fluid-set x-cycle-windows windows)
-    (let ((win (window-order (if cycle-all-workspaces
-				 nil
-			       current-workspace)
-			     cycle-include-iconified cycle-all-viewports)))
+    (let ((win (get-windows-to-order
+		(if cycle-all-workspaces
+		    nil
+		  current-workspace)
+		cycle-include-iconified cycle-all-viewports))
+	  (current (fluid x-cycle-current)))
       (setq win (delete-if (lambda (w)
 			     (not (memq w windows))) win))
       (unless win
@@ -179,19 +181,31 @@
 		    (not (window-appears-in-workspace-p
 			  (fluid x-cycle-current) current-workspace)))
 	    (hide-window (fluid x-cycle-current)))
-	;; first call, push the currently focused window onto
-	;; the top of the stack
-	(when (input-focus)
-	  (fluid-set x-cycle-current (input-focus))
-	  (window-order-push (fluid x-cycle-current))
-	  (setq win (cons (fluid x-cycle-current)
-			  (delq (fluid x-cycle-current) win)))))
+	;; first call, add the currently focused window to the order
+	(if (input-focus)
+	    (progn
+	      (setq current (input-focus))
+	      (fluid-set x-cycle-current current)
+	      (window-order-push current)
+	      (unless (memq current win)
+		(setq win (cons current win))))
+	  (when (window-order-handles-rects-p)
+	    ;; The focus is outside all windows but we can use the
+	    ;; position of the mouse pointer as a hint to the window
+	    ;; order mode to choose an appropriate window (presumably
+	    ;; close to the mouse pointer). This is done by inserting
+	    ;; a rectangle for the pointer into the order that gets
+	    ;; sorted to the right position.
+	    (setq current (rectangle-from-coords (query-pointer) '(1 . 1)))
+	    (setq win (cons current win)))))
+      (setq win (sort-windows-in-order win))
       (when (fluid x-cycle-stacking)
 	(restack-windows (fluid x-cycle-stacking))
 	(fluid-set x-cycle-stacking nil))
-      (if (fluid x-cycle-current)
-	  (setq win (forwards win (fluid x-cycle-current) count))
+      (if current
+	  (setq win (forwards win current count))
 	(setq win (car win)))
+      (when (windowp win) ; In case we arrive at the rectangle inserted above.
       (fluid-set x-cycle-current win)
       (when (not (window-get win 'sticky))
 	(select-workspace (nearest-workspace-with-window
@@ -206,7 +220,8 @@
 	(cycle-display-message))
       (when (window-really-wants-input-p win)
 	(set-input-focus win))
-      (allow-events 'sync-keyboard)))
+      (warp-pointer-if-necessary win)
+      (allow-events 'sync-keyboard))))
 
   (define (cycle-begin windows step)
     "Cycle through all windows in order of recent selections."
--- sawfish-1.3+cvs20031104.orig/lisp/sawfish/wm/util/window-order.jl
+++ sawfish-1.3+cvs20031104/lisp/sawfish/wm/util/window-order.jl
@@ -21,7 +21,14 @@
 
 (define-structure sawfish.wm.util.window-order
 
-    (export window-order
+    (export window-order-mode
+	    window-order-modes
+	    define-window-order-mode
+	    window-order-handles-rects-p
+	    get-windows-to-order
+	    sort-windows-in-order
+	    window-order
+	    sort-windows-in-mru-order
 	    window-order-push
 	    window-order-pop
 	    window-order-most-recent
@@ -32,15 +39,37 @@
 	  sawfish.wm.windows
 	  sawfish.wm.session.init
 	  sawfish.wm.workspace
-	  sawfish.wm.viewport)
+	  sawfish.wm.viewport
+	  sawfish.wm.custom)
 
   (define-structure-alias window-order sawfish.wm.util.window-order)
 
-  ;; window order high-water-mark
-  (define window-order-highest 1)
+  ;; Handling of window order modes.
 
-  ;; return windows in MRU order
-  (define (window-order #!optional workspace allow-iconified all-viewports)
+  (defcustom window-order-mode 'mru
+    "Method to order windows for window cycling etc."
+    :type symbol
+    :group focus)
+
+  (defvar window-order-modes nil
+    "List of names of all window order modes.")
+
+  (define (define-window-order-mode name fun #!key handle-rects)
+    "Define a new window order mode called NAME (a symbol). The function
+FUN will be called with a list of windows and should return that list
+sorted as appropriate. If the optional key #:handle-rects is true,
+then the sort function can handle plain rectangles in the window list
+and sort them too as if they were windows. Rectangles are lists on the
+form (X-MIN Y-MIN X-MAX Y-MAX)."
+    (unless (memq name window-order-modes)
+      (setq window-order-modes (nconc window-order-modes (list name))))
+    (put name 'window-order-function fun)
+    (put name 'window-order-handles-rects handle-rects))
+
+  (define (window-order-handles-rects-p)
+    (get window-order-mode 'window-order-handles-rects))
+
+  (define (get-windows-to-order #!optional workspace allow-iconified all-viewports)
     (let ((windows (managed-windows)))
       (setq windows (delete-if (lambda (w)
 				 (or (not (window-mapped-p w))
@@ -53,13 +82,31 @@
 			       windows))
       (unless all-viewports
 	(setq windows (delete-if window-outside-viewport-p windows)))
-      (sort windows (lambda (x y)
+      windows))
+
+  (define (sort-windows-in-order windows)
+    ((get window-order-mode 'window-order-function) windows))
+
+  ;; return windows in an appropriate order
+  (define (window-order #!optional workspace allow-iconified all-viewports)
+    (sort-windows-in-order
+     (get-windows-to-order workspace allow-iconified all-viewports)))
+
+  ;; MRU order.
+
+  ;; window order high-water-mark
+  (define window-order-highest 1)
+
+  (define (sort-windows-in-mru-order windows)
+    (sort windows (lambda (x y)
 		      (setq x (window-get x 'order))
 		      (setq y (window-get y 'order))
 		      (cond ((and x y)
 			     (> x y))
 			    (x t)
-			    (t nil))))))
+			    (t nil)))))
+
+  (define-window-order-mode 'mru sort-windows-in-mru-order)
 
   ;; push window W onto the top of the cycle stack
   (define (window-order-push w)
@@ -74,7 +121,8 @@
 
   ;; compress the order stack
   (define (window-order-compress)
-    (let ((order (nreverse (window-order nil t t)))	;all windows
+    (let ((order (nreverse (sort-windows-in-mru-order
+			    (get-windows-to-order nil t t)))) ;all windows
 	  (i 1))
       (map-windows (lambda (w)
 		     (window-put w 'order nil)))
@@ -87,7 +135,8 @@
     "Return the most-recently focused window in the current workspace. If the
 WINDOWS argument is given it should be a list of windows, in this case the
 function will restrict its search to the elements of this list."
-    (let loop ((rest (window-order current-workspace nil)))
+    (let loop ((rest (sort-windows-in-mru-order
+		      (get-windows-to-order current-workspace nil))))
       (cond ((null rest) nil)
 	    ((or (window-get (car rest) 'never-focus)
 		 (and (listp windows) (not (memq (car rest) windows))))
@@ -103,7 +152,8 @@
     ;; (since the topmost window is _always_ focused when entering a new
     ;; workspace). The hacky solution is to remove the order of any sticky
     ;; windows
-    (let ((order (window-order current-workspace)))
+    (let ((order (sort-windows-in-mru-order
+		  (get-windows-to-order current-workspace))))
       (mapc (lambda (w)
 	      (when (window-get w 'sticky-viewport)
 		(window-put w 'order nil))) order))