dynamic viewports?

[Jeremy Hankins <nowan nowan org>]

This is an attempt at a dynamic mode for viewports -- the infinite bit
of infinite-desktop without the mouseyness.  The idea is that you can
easily go beyond the initial dimensions of the virtual workspace, and
when you do the dimensions will be adjusted to match.  It's enabled by
setting viewport-boundary-mode to 'dynamic.  Arguably it's not exactly a
boundary mode, but the logic is right: it's incompatible with stop or
wrap-around.  I've tested it to work with sawfish-pager, but I haven't
tried other pagers.

Issues that I know of:

 - There's a viewport-minimum-dimensions.  This should be mostly
   transparent and ignorable when not using dynamic viewports; the only
   impact there is that when set it increases viewport-dimensions to
   match if necessary.  On the other hand (when the ui is used) setting
   viewport-dimensions to smaller than viewport-minimum-dimensions sets
   viewport-minimum-dimensions to suit.  Would it be better to just
   ignore viewport-minimum-dimensions when not using dynamic viewports?

 - If you use multiple desktops as well as dynamic viewports you may
   sometimes end up with very large virtual-workspaces.  This apparently
   happens when the coordinates for the different workspaces "drift"
   over time so that when you switch from one to another you're well
   away from any of the windows in the new workspace.  The viewport
   dimensions will then be adjusted to include the windows and your
   current screen location.  Of course, once you move to one of the
   windows the virtual workspace shrinks back to normal size.  This
   should be fixable, but I don't (yet) understand the workspace code
   well enough to fix it (or even why it's happening, for that matter).

 - Overall it works with infinite-desktop.  But when using ID to move
   the viewport boundaries are shifted as well.  So if I start by using
   the mouse to move to the left, the move-viewport-right command wont
   snap back to the original viewport grid.  Since I don't use ID I'm
   not sure whether this is a problem or not.

So is this useful or a misfeature?  Or should it be done differently?
Comments welcome.... :)

------------------------------
diff --git a/lisp/sawfish/wm/viewport.jl b/lisp/sawfish/wm/viewport.jl
index 43e3e14..f200175 100644
--- a/lisp/sawfish/wm/viewport.jl
+++ b/lisp/sawfish/wm/viewport.jl
@@ -58,6 +58,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 +78,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 +132,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 +212,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 +297,42 @@ 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)))
 
 ;; commands
------------------------------

-- 
Jeremy Hankins <nowan nowan org>
PGP fingerprint: 748F 4D16 538E 75D6 8333  9E10 D212 B5ED 37D0 0A03