[sawfish] Added viewport-boundary-mode dynamic -- added new-viewport window matcher and viewport-windows

[Christopher Bratusek <chrisb src gnome org>]

commit 40dcc6a585cf64cad970804008875ed8c76ed89f
Author: chrisb <zanghar freenet de>
Date:   Mon Jul 27 11:49:40 2009 +0200

    Added viewport-boundary-mode dynamic -- added new-viewport window matcher and viewport-windows

 ChangeLog                           |    6 ++
 lisp/sawfish/wm/ext/match-window.jl |   45 +++++++++--
 lisp/sawfish/wm/viewport.jl         |  154 ++++++++++++++++++++++++++++++++---
 man/news.texi                       |    6 +-
 4 files changed, 191 insertions(+), 20 deletions(-)
---
diff --git a/ChangeLog b/ChangeLog
index 1bb59c7..6163ad1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2009-07-27  Christopher Bratusek <zanghar freenet de>
+	* lisp/sawfish/wm/viewport.jl: Added viewport-boundary-mode dynamic [Jeremy Hankins]
+
+	* lisp/sawfish/wm/viewport.jl
+	* lisp/sawfish/wm/ext/match-window.jl: added new-viewport window matcher and viewport-windows function [Jeremy Hankins]
+
 2009-07-26  Christopher Bratusek <zanghar freenet de>
 	* lisp/sawfish/wm/tabs/tab.jl
 	* lisp/sawfish/wm/tabs/tabgroup.jl
diff --git a/lisp/sawfish/wm/ext/match-window.jl b/lisp/sawfish/wm/ext/match-window.jl
index 4a7ea50..fbdebba 100644
--- a/lisp/sawfish/wm/ext/match-window.jl
+++ b/lisp/sawfish/wm/ext/match-window.jl
@@ -77,7 +77,9 @@
        (depth (number -16 16))
        (placement-weight number)
        (fixed-position boolean)
-       (maximized (choice all vertical horizontal)))
+       (maximized (choice all vertical horizontal))
+       (new-workspace boolean)
+       (new-viewport boolean))
       (focus ,(_ "Focus")
        (raise-on-focus boolean)
        (focus-when-mapped boolean)
@@ -109,8 +111,7 @@
        (auto-gravity boolean)
        (shade-hover boolean)
        (transients-above (choice all parents none))
-       (ignore-stacking-requests boolean)
-       (new-workspace boolean))))
+       (ignore-stacking-requests boolean))))
 
   ;; alist of (PROPERTY . FEATURE) mapping properties to the lisp
   ;; libraries implementing them
@@ -395,10 +396,40 @@
    (lambda (w prop value)
      (declare (unused prop))
      (when value
-       (let ((space (car (workspace-limits))))
-         (while (not (workspace-empty-p space))
-	   (setq space (1+ space)))
-	     (set-window-workspaces w (list space))))))
+       (unless (window-get w 'placed)
+         (let ((space (car (workspace-limits))))
+           (while (not (workspace-empty-p space))
+             (setq space (1+ space)))
+           (set-window-workspaces w (list space)))))))
+	   
+  (define-match-window-setter 'new-viewport
+    (lambda (w prop value)
+      (declare (unused prop))
+      (when value
+        (unless (window-get w 'placed)
+          (let ((row 0) 
+                (col 0)
+                (nomatch t))
+            (while (and nomatch (< row (cdr viewport-dimensions)))
+              (setq col 0)
+              (while (and nomatch (< col (car viewport-dimensions)))
+                (if (null (viewport-windows col row nil t))
+                    (setq nomatch nil)
+                  (setq col (1+ col))))
+              (if nomatch
+                  (setq row (1+ row))))
+            (when nomatch
+              (let ((cols (car viewport-dimensions))
+                    (rows (cdr viewport-dimensions)))
+                (if (<= cols rows)
+                    (setq viewport-dimensions (cons (1+ cols) rows)
+                          col cols
+                          row 0)
+                  (setq viewport-dimensions (cons cols (1+ rows))
+                        col 0
+                        row rows))))
+            (set-screen-viewport col row)
+            (set-window-viewport w col row))))))
 
   (define-match-window-setter 'fullscreen-xinerama
    (lambda (w prop value)
diff --git a/lisp/sawfish/wm/viewport.jl b/lisp/sawfish/wm/viewport.jl
index 43e3e14..117ff2b 100644
--- a/lisp/sawfish/wm/viewport.jl
+++ b/lisp/sawfish/wm/viewport.jl
@@ -34,7 +34,8 @@
 	    move-window-viewport
 	    window-viewport
 	    window-absolute-position
-	    set-number-of-viewports)
+	    set-number-of-viewports
+	    viewport-windows)
 
     (open rep
 	  rep.system
@@ -58,6 +59,12 @@
     :type (pair (number 1) (number 1))
     :after-set (lambda () (viewport-size-changed)))
 
+  (defcustom viewport-minimum-dimensions '(1 . 1)
+    "Minimum number of columns and rows in each virtual workspace: \\w"
+    :group (workspace viewport)
+    :type (pair (number 1) (number 1))
+    :after-set (lambda () (viewport-minimum-size-changed)))
+
   (defcustom uniconify-to-current-viewport t
     "Windows uniconify to the current viewport."
     :type boolean
@@ -72,7 +79,7 @@
   (defcustom viewport-boundary-mode 'stop
     "Whether to stop or wrap-around on first/last viewport"
     :group (workspace viewport)
-    :type (choice wrap-around stop))
+    :type (choice wrap-around stop dynamic))
 
 ;;; raw viewport handling
 
@@ -126,6 +133,75 @@ The scrolling makes a number of increments equal to `scroll-viewport-steps'."
 
   (add-hook 'before-exit-hook viewport-before-exiting t)
 
+  (define (viewport-dynamic-resize)
+    (when (eq viewport-boundary-mode 'dynamic)
+      (let ((windows
+	     (filter-windows
+	      (lambda (w)
+		(window-in-workspace-p w current-workspace)))))
+	(if windows
+	    (let*
+		((points
+		  (nconc
+		   (mapcar (lambda (w)
+			     (let ((pos (window-position w))
+				   (dims (window-frame-dimensions w)))
+			       (list (car pos)
+				     (cdr pos)
+				     (+ (car pos) (car dims))
+				     (+ (cdr pos) (cdr dims)))))
+			   windows)
+		   ;; Include a region in the current screen:
+		   `((0 0 1 1))))
+		 (x-min (apply min (mapcar car points)))
+		 (y-min (apply min (mapcar (lambda (e) (nth 1 e)) points)))
+		 (x-max (apply max (mapcar (lambda (e) (nth 2 e)) points)))
+		 (y-max (apply max (mapcar (lambda (e) (nth 3 e)) points)))
+		 (width (screen-width))
+		 (height (screen-height))
+		 (high-rows (+ (quotient y-max height)
+			       (if (> (mod y-max height) 0)
+				   1
+				 0)))
+		 (low-rows (if (< y-min 0)
+			       (+ (- (quotient y-min height))
+				  (if (> (mod y-min height) 0)
+				      1
+				    0))
+			     0))
+		 (rows (+ low-rows high-rows))
+		 (high-cols (+ (quotient x-max width)
+			       (if (> (mod x-max width) 0)
+				   1
+				 0)))
+		 (low-cols (if (< x-min 0)
+			       (+ (- (quotient x-min width))
+				  (if (> (mod x-min width) 0)
+				      1
+				    0))
+			     0))
+		 (cols (+ low-cols high-cols)))
+	      (setq
+	       viewport-y-offset (* low-rows height)
+	       viewport-x-offset (* low-cols width)
+	       viewport-dimensions (cons
+				    (max cols
+					 (car viewport-minimum-dimensions))
+				    (max rows
+					 (cdr viewport-minimum-dimensions)))))
+	  (setq viewport-y-offset 0
+		viewport-x-offset 0
+		viewport-dimensions viewport-minimum-dimensions))
+	(call-hook 'viewport-resized-hook))))
+
+  ;; Resize virtual workspace on workspace switch or viewport move.
+  ;; TODO: Ensure that the viewport is set reasonably in the new
+  ;; workspace.
+  (add-hook 'enter-workspace-hook
+	    viewport-dynamic-resize)
+  (add-hook 'viewport-moved-hook
+	    viewport-dynamic-resize)
+
 ;; screen sized viewport handling
 
   (define (screen-viewport)
@@ -137,8 +213,9 @@ The scrolling makes a number of increments equal to `scroll-viewport-steps'."
     (when (eq viewport-boundary-mode 'wrap-around)
       (setq col (mod col (car viewport-dimensions))
             row (mod row (cdr viewport-dimensions))))
-    (when (and (>= col 0) (< col (car viewport-dimensions))
-               (>= row 0) (< row (cdr viewport-dimensions)))
+    (when (or (eq viewport-boundary-mode 'dynamic)
+	      (and (>= col 0) (< col (car viewport-dimensions))
+		   (>= row 0) (< row (cdr viewport-dimensions))))
       (set-viewport (* col (screen-width))
                     (* row (screen-height)))
       t))
@@ -221,17 +298,70 @@ The scrolling makes a number of increments equal to `scroll-viewport-steps'."
 	position)))
 
   (define (viewport-size-changed)
-    (let ((port (screen-viewport)))
-      (set-screen-viewport (min (car port) (1- (car viewport-dimensions)))
-			   (min (cdr port) (1- (cdr viewport-dimensions))))
-      (map-windows (lambda (w)
-		     (when (window-outside-workspace-p w)
-		       (move-window-to-current-viewport w))))
-      (call-hook 'viewport-resized-hook)))
+    (when (or (< (car viewport-dimensions) (car viewport-minimum-dimensions))
+	      (< (cdr viewport-dimensions) (cdr viewport-minimum-dimensions)))
+      (setq viewport-minimum-dimensions
+	    (cons (min (car viewport-dimensions)
+		       (car viewport-minimum-dimensions))
+		  (min (cdr viewport-dimensions)
+		       (cdr viewport-minimum-dimensions))))
+      (when (eq viewport-boundary-mode 'dynamic)
+	(viewport-dynamic-resize)))
+    (unless (eq viewport-boundary-mode 'dynamic)
+      (let ((port (screen-viewport)))
+	(set-screen-viewport (min (car port) (1- (car viewport-dimensions)))
+			     (min (cdr port) (1- (cdr viewport-dimensions))))
+	(map-windows (lambda (w)
+		       (when (window-outside-workspace-p w)
+			 (move-window-to-current-viewport w))))
+	(call-hook 'viewport-resized-hook))))
+
+  (define (viewport-minimum-size-changed)
+    (if (eq viewport-boundary-mode 'dynamic)
+	(viewport-dynamic-resize)
+      (when (or (< (car viewport-dimensions) (car viewport-minimum-dimensions))
+		(< (cdr viewport-dimensions) (cdr viewport-minimum-dimensions)))
+	(setq viewport-dimensions
+	      (cons (max (car viewport-dimensions)
+			 (car viewport-minimum-dimensions))
+		    (max (cdr viewport-dimensions)
+			 (cdr viewport-minimum-dimensions))))
+	(viewport-size-changed))))
 
   (define (set-number-of-viewports width height)
     (setq viewport-dimensions (cons width height))
-    (viewport-size-changed))
+    (setq viewport-minimum-dimensions (cons width height))
+    (if (eq viewport-boundary-mode 'dynamic)
+	(viewport-dynamic-resize)
+      (viewport-size-changed)))
+
+  (define (viewport-windows #!optional vp-col vp-row workspace
+                            exclude-sticky exclude-iconified)
+    "Provide a list of windows that are mapped to the specified viewport."
+    (let* ((cur-vp (screen-viewport))
+           (col (or vp-col (car cur-vp)))
+           (row (or vp-row (cdr cur-vp)))
+           (ws (or workspace current-workspace))
+           (width (screen-width))
+           (height (screen-height))
+           (left (+ (- viewport-x-offset) (* col width)))
+           (right (+ left (1- width)))
+           (top (+ (- viewport-y-offset) (* row height)))
+           (bottom (+ top (1- height))))
+      (filter-windows (lambda (w)
+                        (let ((pos (window-position w))
+                              (dims (window-frame-dimensions w)))
+                          (and (window-mapped-p w)
+                               (not (window-get w 'ignored))
+                               (if exclude-sticky
+                                   (window-in-workspace-p w ws)
+                                 (window-appears-in-workspace-p w ws))
+                               (not (and exclude-iconified
+                                         (window-get w 'iconified)))
+                               (not (or (<= (+ (car pos) (car dims)) left)
+                                        (<= (+ (cdr pos) (cdr dims)) top)
+                                        (>= (car pos) right)
+                                        (>= (cdr pos) bottom)))))))))
 
 ;; commands
 
diff --git a/man/news.texi b/man/news.texi
index d5124fa..494b1f0 100644
--- a/man/news.texi
+++ b/man/news.texi
@@ -40,7 +40,11 @@ they occurred between. For more detailed information see the
 
 @item 5 new move-cursor commands (move-cursor -northwest, -northeast, -southwest, -southeast), and move-cursor-center [Christopher Bratusek]
 
- item Added fullscreen, fullscreen-xinerama and new-workspace matches [Jeremy Hankins]
+ item Added fullscreen, fullscreen-xinerama, new-workspace and new-viewport window-matchers [Jeremy Hankins]
+
+ item Added viewport-windows function (equivalent to workspace-windows) [Jeremy Hankins]
+
+ item Added viewport-boundary-mode dynamic (creates a new viewport then hitting the screen-edge) [Jeremy Hankins]
 
 @item When GNOME Integration is loaded, the apps menu now shows the content of the GNOME Menu (uncategorized atm) [Christopher Bratusek]