Re: dynamic viewports?

[Jeremy Hankins <nowan nowan org>]

Christopher Roy Bratusek <zanghar freenet de> writes:

> P.S.: Do you think you can finish new-viewport? Would be nice :)

Sure; here you go.  :)

-------------------------
diff --git a/lisp/sawfish/wm/ext/match-window.jl b/lisp/sawfish/wm/ext/match-window.jl
index 4a7ea50..291e8f8 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..674bb58 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
@@ -233,6 +234,35 @@ The scrolling makes a number of increments equal to `scroll-viewport-steps'."
     (setq viewport-dimensions (cons width height))
     (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
 
   (define (activate-viewport x y)
-------------------------

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