[sawfish/viewport] Fixed viewport-scrambling bugs.
- From: Jeremy Hankins <jjhankins src gnome org>
- To: svn-commits-list gnome org
- Cc:
- Subject: [sawfish/viewport] Fixed viewport-scrambling bugs.
- Date: Mon, 12 Oct 2009 12:53:55 +0000 (UTC)
commit 6071da522763e524d3a7ac6a061edb430d222161
Author: Jeremy Hankins <nowan nowan org>
Date: Sun Oct 11 20:34:01 2009 -0500
Fixed viewport-scrambling bugs.
Canged logic of stop-at-workspace-borders in infinite-desktop.
ChangeLog | 10 +++
lisp/sawfish/wm/ext/infinite-desktop.jl | 26 +++++--
lisp/sawfish/wm/ext/match-window.jl | 5 +-
lisp/sawfish/wm/state/maximize.jl | 111 ++++++++++++++++++-------------
lisp/sawfish/wm/util/edges.jl | 53 ++++++++-------
lisp/sawfish/wm/viewport.jl | 70 +++++++++++++++++--
man/news.texi | 5 ++
7 files changed, 195 insertions(+), 85 deletions(-)
---
diff --git a/ChangeLog b/ChangeLog
index 1343bef..e9618f8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2009-10-11 Jeremy Hankins <nowan nowan org>
+ * lisp/sawfish/wm/ext/match-window.jl
+ * lisp/sawfish/wm/state/maximize.jl
+ * lisp/sawfish/wm/util/edges.jl
+ * lisp/sawfish/wm/viewport.jl: Fix bugs that shift windows between viewports on restart:
+ - maximize-window and maximize-window-fullscreen now work for windows outside of the current viewport
+ - the position window matcher now preserves the current viewport
+
+ * lisp/sawfish/wm/ext/infinite-desktop.jl: infinite-desktop.stop-at-workspace-borders is now true iff viewport-boundary-mode is not dynamic.
+
2009-10-09 Christopher Bratusek <zanghar freenet de>
* lisp/sawfish/wm/menus.jl: added "Reload Appsmenu" entry
diff --git a/lisp/sawfish/wm/ext/infinite-desktop.jl b/lisp/sawfish/wm/ext/infinite-desktop.jl
index 3dc9f97..8f09b0d 100644
--- a/lisp/sawfish/wm/ext/infinite-desktop.jl
+++ b/lisp/sawfish/wm/ext/infinite-desktop.jl
@@ -65,56 +65,65 @@
:type number
:range (1 . nil))
- (defcustom infinite-desktop.stop-at-workspace-borders nil
- "Stop scrolling at workspace borders (Fixes warp-to-window bugs)."
- :group (workspace infinite-desktop)
- :type boolean )
+ (define (infinite-desktop.stop-at-workspace-borders)
+ "Whether or not to prevent the display from moving past the
+current viewport boundaries. Returns true if `viewport-boundary-mode'
+is not set to 'dynamic."
+ (not (eq viewport-boundary-mode 'dynamic)))
(define (infinite-desktop.move-right)
+ "Shifts the display `infinite-desktop.move-distance' pixels to the
+right."
(let ((dist infinite-desktop.move-distance)
(cdist infinite-desktop.move-cursor-distance)
(maxx (* (screen-width) (1- (car viewport-dimensions)))))
(if
- (and infinite-desktop.stop-at-workspace-borders
+ (and (infinite-desktop.stop-at-workspace-borders)
(> (+ dist viewport-x-offset) maxx))
(setq dist (- maxx viewport-x-offset)))
(set-viewport (+ viewport-x-offset dist) viewport-y-offset)
(move-cursor (- (min dist cdist)) 0)))
(define (infinite-desktop.move-left)
+ "Shifts the display `infinite-desktop.move-distance' pixels to the
+left."
(let ((dist (- infinite-desktop.move-distance))
(cdist (- infinite-desktop.move-cursor-distance))
(minx 0))
(if
- (and infinite-desktop.stop-at-workspace-borders
+ (and (infinite-desktop.stop-at-workspace-borders)
(< (+ viewport-x-offset dist) minx))
(setq dist (- minx viewport-x-offset)))
(set-viewport (+ viewport-x-offset dist) viewport-y-offset)
(move-cursor (- (max dist cdist)) 0)))
(define (infinite-desktop.move-top)
+ "Shifts the display `infinite-desktop.move-distance' pixels up."
(let ((dist (- infinite-desktop.move-distance))
(cdist (- infinite-desktop.move-cursor-distance))
(miny 0))
(if
- (and infinite-desktop.stop-at-workspace-borders
+ (and (infinite-desktop.stop-at-workspace-borders)
(< (+ viewport-y-offset dist) miny))
(setq dist (- miny viewport-y-offset)))
(set-viewport viewport-x-offset (+ viewport-y-offset dist))
(move-cursor 0 (- (max dist cdist)))))
(define (infinite-desktop.move-bottom)
+ "Shifts the display `infinite-desktop.move-distance' pixels down."
(let ((dist infinite-desktop.move-distance)
(cdist infinite-desktop.move-cursor-distance)
(maxy (* (screen-height) (1- (cdr viewport-dimensions)))))
(if
- (and infinite-desktop.stop-at-workspace-borders
+ (and (infinite-desktop.stop-at-workspace-borders)
(> (+ dist viewport-y-offset) maxy))
(setq dist (- maxy viewport-y-offset)))
(set-viewport viewport-x-offset (+ viewport-y-offset dist))
(move-cursor 0 (- (min dist cdist)))))
(define (infinite-desktop.enter-flipper-hook w)
+ "Called when a desktop flipper is triggered to shift the visible
+desktop."
(if infinite-desktop-p
(cond ((eq w 'right) (infinite-desktop.move-right))
((eq w 'left) (infinite-desktop.move-left))
@@ -123,6 +132,7 @@
(t (display-message "move-unknown")))))
(define (infinite-desktop.infinite-desktop)
+ "Turn on infinite-desktop if `infinite-desktop-p' is true."
(if infinite-desktop-p
(enable-flippers)))
diff --git a/lisp/sawfish/wm/ext/match-window.jl b/lisp/sawfish/wm/ext/match-window.jl
index 71c94ad..a03a2d1 100644
--- a/lisp/sawfish/wm/ext/match-window.jl
+++ b/lisp/sawfish/wm/ext/match-window.jl
@@ -352,6 +352,7 @@
(lambda (w prop value)
(declare (unused prop))
(let* ((size (window-frame-dimensions w))
+ (vp-offset (viewport-offset (window-viewport w)))
(x (if (symbolp value)
(cond ((memq value '(east south-east north-east))
(- (screen-width) (car size)))
@@ -383,7 +384,9 @@
(setq x (+ (- (screen-width) (car size)) x)))
(when (< y 0)
(setq y (+ (- (screen-height) (cdr size)) y)))
- (move-window-to w x y))))
+ (move-window-to w
+ (+ (car vp-offset) x)
+ (+ (cdr vp-offset) y)))))
(define-match-window-setter 'dimensions
(lambda (w prop value)
diff --git a/lisp/sawfish/wm/state/maximize.jl b/lisp/sawfish/wm/state/maximize.jl
index 2c89973..b6c98a0 100644
--- a/lisp/sawfish/wm/state/maximize.jl
+++ b/lisp/sawfish/wm/state/maximize.jl
@@ -68,6 +68,8 @@
sawfish.wm.frames
sawfish.wm.misc
sawfish.wm.focus
+ sawfish.wm.viewport
+ sawfish.wm.state.shading
sawfish.wm.util.prompt)
(define-structure-alias maximize sawfish.wm.state.maximize)
@@ -132,8 +134,8 @@ that dimension.")
;; currently maximize window to `(X Y W H)', the saved geometry.
(define (save-unmaximized-geometry w)
(unless (window-get w 'unmaximized-geometry)
- (let ((coords (window-position w))
- (dims (window-dimensions w)))
+ (let* ((coords (window-relative-position w))
+ (dims (window-dimensions w)))
(window-put w 'unmaximized-geometry (list (car coords) (cdr coords)
(car dims) (cdr dims))))))
@@ -150,7 +152,7 @@ that dimension.")
(when vertically
(window-put w 'maximized-vertically nil))
(let ((dims (window-dimensions w))
- (coords (window-position w))
+ (coords (window-relative-position w))
(saved (unmaximized-geometry w)))
(when saved
(unless (window-maximized-horizontally-p w)
@@ -336,54 +338,61 @@ that dimension.")
(define (maximize-window w #!optional direction only-1d)
"Maximize the dimensions of the window."
- (let ((unshade-selected-windows t))
- (display-window-without-focusing w))
+ (when (window-get w 'shaded)
+ (unshade-window w))
(when (window-maximized-fullscreen-p w)
(maximize-window-fullscreen w nil))
- (let* ((coords (window-position w))
- (dims (window-dimensions w))
- (fdims (window-frame-dimensions w))
- (hints (window-size-hints w))
- (avoided (and maximize-avoid-avoided (avoided-windows w)))
- (edges (get-visible-window-edges
- #:with-ignored-windows t
- #:windows avoided
- #:include-heads (list (current-head w)))))
+ (let* ((viewport (window-viewport w))
+ (vp-offset (viewport-offset viewport))
+ (coords (window-position w))
+ (head (find-head (- (car coords) (car vp-offset))
+ (- (cdr coords) (cdr vp-offset))))
+ (dims (window-dimensions w))
+ (fdims (window-frame-dimensions w))
+ (hints (window-size-hints w))
+ (avoided (and maximize-avoid-avoided (avoided-windows w)))
+ (edges (get-visible-window-edges
+ #:with-ignored-windows t
+ #:windows avoided
+ #:include-heads (list head)
+ #:viewport viewport)))
(when (window-maximizable-p w direction hints)
- (save-unmaximized-geometry w)
- (cond ((null direction)
- (if (not only-1d)
- (do-both w avoided edges coords dims fdims)
- (do-horizontal w edges coords dims fdims)
- (do-vertical w edges coords dims fdims))
- (window-put w 'maximized-horizontally t)
- (window-put w 'maximized-vertically t))
- ((eq direction 'horizontal)
- (do-horizontal w edges coords dims fdims)
- (window-put w 'maximized-horizontally t))
- ((eq direction 'vertical)
- (do-vertical w edges coords dims fdims)
- (window-put w 'maximized-vertically t)))
- (maximize-truncate-dims w dims direction hints)
- (move-resize-window-to w (car coords) (cdr coords)
- (car dims) (cdr dims))
- (when maximize-raises
- (raise-window* w))
- (call-window-hook 'window-maximized-hook w (list direction))
- (call-window-hook 'window-state-change-hook w (list '(maximized))))))
+ (save-unmaximized-geometry w)
+ (cond ((null direction)
+ (if (not only-1d)
+ (do-both w avoided edges coords dims fdims)
+ (do-horizontal w edges coords dims fdims)
+ (do-vertical w edges coords dims fdims))
+ (window-put w 'maximized-horizontally t)
+ (window-put w 'maximized-vertically t))
+ ((eq direction 'horizontal)
+ (do-horizontal w edges coords dims fdims)
+ (window-put w 'maximized-horizontally t))
+ ((eq direction 'vertical)
+ (do-vertical w edges coords dims fdims)
+ (window-put w 'maximized-vertically t)))
+ (maximize-truncate-dims w dims direction hints)
+ (move-resize-window-to w (car coords) (cdr coords)
+ (car dims) (cdr dims))
+ (when maximize-raises
+ (raise-window* w))
+ (call-window-hook 'window-maximized-hook w (list direction))
+ (call-window-hook 'window-state-change-hook w
+ (list '(maximized))))))
;; does all unmaximizing except for changing the window properties and
;; calling the hooks
(define (unmaximize-window-1 w #!optional direction before)
- (let ((geom (unmaximized-geometry w))
+ (let ((vp-offset (viewport-offset (window-viewport w)))
+ (geom (unmaximized-geometry w))
(coords (window-position w))
(dims (window-dimensions w)))
(when geom
(when (memq direction '(() fullscreen horizontal))
- (rplaca coords (nth 0 geom))
+ (rplaca coords (+ (nth 0 geom) (car vp-offset)))
(rplaca dims (nth 2 geom)))
(when (memq direction '(() fullscreen vertical))
- (rplacd coords (nth 1 geom))
+ (rplacd coords (+ (nth 1 geom) (cdr vp-offset)))
(rplacd dims (nth 3 geom)))
(when before
(before))
@@ -521,13 +530,20 @@ unmaximized."
"Fullscreen maximize the window."
(cond ((and state (not (window-maximized-fullscreen-p w)))
(when (window-maximizable-p w)
- (let ((head-offset (current-head-offset w))
- (head-dims (current-head-dimensions w)))
+ (let* ((viewport (window-viewport w))
+ (vp-offset (viewport-offset viewport))
+ (coords (window-position w))
+ (head (find-head (- (car coords) (car vp-offset))
+ (- (cdr coords) (cdr vp-offset))))
+ (head-offset (head-offset head))
+ (head-dims (head-dimensions head)))
(save-unmaximized-geometry w)
(window-put w 'unmaximized-type (window-type w))
(push-window-type w 'unframed 'sawfish.wm.state.maximize)
- (move-resize-window-to w (car head-offset) (cdr head-offset)
- (car head-dims) (cdr head-dims))
+ (move-resize-window-to w
+ (+ (car head-offset) (car vp-offset))
+ (+ (cdr head-offset) (cdr vp-offset))
+ (car head-dims) (cdr head-dims))
(raise-window* w)
(window-put w 'maximized-fullscreen t)
(window-put w 'maximized-vertically t)
@@ -554,13 +570,16 @@ unmaximized."
"Fullscreen maximize the window across all Xinerama screens."
(cond ((and state (not (window-maximized-fullscreen-p w)))
(when (window-maximizable-p w)
- (let ((screen-dims (screen-dimensions)))
+ (let ((screen-dims (screen-dimensions))
+ (vp-offset (viewport-offset (window-viewport w))))
(save-unmaximized-geometry w)
(window-put w 'unmaximized-type (window-type w))
(push-window-type w 'unframed 'sawfish.wm.state.maximize)
- (move-resize-window-to w 0 0
- (car screen-dims)
- (cdr screen-dims))
+ (move-resize-window-to w
+ (car vp-offset)
+ (cdr vp-offset)
+ (+ (car screen-dims) (car vp-offset))
+ (+ (cdr screen-dims) (cdr vp-offset)))
(raise-window* w)
(window-put w 'maximized-fullscreen t)
(window-put w 'maximized-vertically t)
diff --git a/lisp/sawfish/wm/util/edges.jl b/lisp/sawfish/wm/util/edges.jl
index d76a048..8d01e77 100644
--- a/lisp/sawfish/wm/util/edges.jl
+++ b/lisp/sawfish/wm/util/edges.jl
@@ -34,7 +34,8 @@
(define (get-visible-window-edges #!key with-ignored-windows
windows-to-ignore (windows t)
- include-screen include-heads)
+ include-screen include-heads
+ viewport)
"Returns (X-EDGES . Y-EDGES), X-EDGES is a list of (X Y1 Y2 OPEN-P),
and Y-EDGES is a list of (Y X1 X2 OPEN-P). OPEN-P is t if the edge is
the left or top edge of a window. For the root window, the meaning of
@@ -43,14 +44,20 @@ OPEN-P is reversed.
#:include-heads may be a list of head ids, or a true non-list, in which
case all heads are included.
+#:viewport may be a cons cell specifying (col . row); if specified
+edges are given for that viewport rather than the current one.
+
The returned lists may contain duplicates, and are unsorted."
- (let (x-edges y-edges)
+ (let* ((width (screen-width))
+ (height (screen-height))
+ (vp-offset (viewport-offset viewport))
+ x-edges y-edges)
(map-windows
(lambda (w)
(when (and (window-mapped-p w)
(window-visible-p w)
- (not (window-outside-viewport-p w))
+ (not (window-outside-viewport-p w viewport))
(or with-ignored-windows
(not (window-get w 'ignored)))
(not (memq w windows-to-ignore))
@@ -73,12 +80,16 @@ The returned lists may contain duplicates, and are unsorted."
y-edges)))))))
(when include-screen
- (setq x-edges (list* (list 0 0 (screen-height) nil)
- (list (screen-width) 0 (screen-height) t)
- x-edges))
- (setq y-edges (list* (list 0 0 (screen-width) nil)
- (list (screen-height) 0 (screen-width) t)
- y-edges)))
+ (let* ((x-min (car vp-offset))
+ (y-min (cdr vp-offset))
+ (x-max (+ x-min width))
+ (y-max (+ y-min height)))
+ (setq x-edges (list* (list x-min y-min y-max nil)
+ (list x-max y-min y-max t)
+ x-edges))
+ (setq y-edges (list* (list y-min x-min x-max nil)
+ (list y-max x-min x-max t)
+ y-edges))))
(when (and include-heads (not (listp include-heads)))
(setq include-heads (do ((i 0 (1+ i))
@@ -86,21 +97,17 @@ The returned lists may contain duplicates, and are unsorted."
((= i (head-count)) lst))))
(when include-heads
(mapc (lambda (h)
- (let ((dims (head-dimensions h))
- (offset (head-offset h)))
- (setq x-edges (list* (list (car offset)
- (cdr offset)
- (+ (cdr offset) (cdr dims)) nil)
- (list (+ (car offset) (car dims))
- (cdr offset)
- (+ (cdr offset) (cdr dims)) t)
+ (let* ((dims (head-dimensions h))
+ (offset (head-offset h))
+ (x-min (+ (car offset) (car vp-offset)))
+ (y-min (+ (cdr offset) (cdr vp-offset)))
+ (x-max (+ x-min (car dims)))
+ (y-max (+ y-min (cdr dims))))
+ (setq x-edges (list* (list x-min y-min y-max nil)
+ (list x-max y-min y-max t)
x-edges))
- (setq y-edges (list* (list (cdr offset)
- (car offset)
- (+ (car offset) (car dims)) nil)
- (list (+ (cdr offset) (cdr dims))
- (car offset)
- (+ (car offset) (car dims)) t)
+ (setq y-edges (list* (list y-min x-min x-max nil)
+ (list y-max x-min x-max t)
y-edges))))
include-heads))
diff --git a/lisp/sawfish/wm/viewport.jl b/lisp/sawfish/wm/viewport.jl
index c9f8297..77c0909 100644
--- a/lisp/sawfish/wm/viewport.jl
+++ b/lisp/sawfish/wm/viewport.jl
@@ -32,6 +32,8 @@
set-window-viewport
move-window-viewport
window-viewport
+ viewport-offset
+ window-relative-position
window-absolute-position
set-number-of-viewports
viewport-minimum-size-changed
@@ -217,6 +219,9 @@ well as any windows in the current workspace."
(add-hook 'viewport-moved-hook
viewport-dynamic-resize)
+ (add-hook 'after-initialization-hook
+ viewport-dynamic-resize)
+
(define (viewport-leave-workspace-handler ws)
"On leaving a workspace, store information about the viewport
configuration so that it can be restored properly later."
@@ -266,6 +271,7 @@ viewport is within `viewport-dimensions'."
;;; screen sized viewport handling
(define (screen-viewport)
+ "Gives the row and column of the current viewport."
(cons (quotient viewport-x-offset (screen-width))
(quotient viewport-y-offset (screen-height))))
@@ -300,6 +306,10 @@ viewport is within `viewport-dimensions'."
(quotient (cdr pos) (screen-height))))))
(define (window-outside-workspace-p window)
+ "True if `window' is outside the virtual workspace. Note that
+this does not check which workspace the windows is in; the window is
+outside the virtual workspace if it's position is not within any
+viewport."
(let ((pos (window-position window))
(dims (window-frame-dimensions window))
(left (- viewport-x-offset))
@@ -313,13 +323,29 @@ viewport is within `viewport-dimensions'."
(<= (+ (car pos) (car dims)) left)
(<= (+ (cdr pos) (cdr dims)) top))))
- (define (window-outside-viewport-p window)
- (let ((pos (window-position window))
- (dims (window-frame-dimensions window)))
- (or (<= (+ (car pos) (car dims)) 0)
- (<= (+ (cdr pos) (cdr dims)) 0)
- (>= (car pos) (screen-width))
- (>= (cdr pos) (screen-height)))))
+ (define (window-outside-viewport-p window #!optional viewport)
+ "True if some part of `window' is inside the current viewport. If
+`viewport' is specified check against that viewport rather than the
+current one."
+ (let* ((cur-vp (screen-viewport))
+ (width (screen-width))
+ (height (screen-height))
+ (x-min (if viewport
+ (* (- (car viewport) (car cur-vp))
+ width)
+ 0))
+ (x-max (+ x-min width))
+ (y-min (if viewport
+ (* (- (cdr viewport) (cdr cur-vp))
+ height)
+ 0))
+ (y-max (+ y-min width))
+ (pos (window-position window))
+ (dims (window-frame-dimensions window)))
+ (or (<= (+ (car pos) (car dims)) x-min)
+ (<= (+ (cdr pos) (cdr dims)) y-min)
+ (>= (car pos) x-max)
+ (>= (cdr pos) y-max))))
(define (move-window-to-current-viewport window)
(when (and (window-outside-viewport-p window)
@@ -347,11 +373,41 @@ viewport is within `viewport-dimensions'."
(screen-height)) row))))
(define (window-viewport w)
+ "Returns a cons cell consisting of the column and row of the
+viewport containing w."
(let ((position (window-position w)))
(cons (quotient (+ (car position) viewport-x-offset) (screen-width))
(quotient (+ (cdr position) viewport-y-offset) (screen-height)))))
+ (define (viewport-offset vp)
+ "`vp' is (column . row) of a viewport (whether or not that
+viewport currently exists). A cons cell consisting of the x and y
+offset between the specified viewport and the current viewport is
+returned. The offset can be used to translate between locations in
+the two viewports. For example:
+
+<position in current vp> + <offset> = <equivalent position in other vp>
+
+If `vp' is nil treat it as the current viewport -- i.e., return '(0 . 0)"
+ (if (consp vp)
+ (let* ((cur-vp (screen-viewport)))
+ (cons
+ (* (- (car vp) (car cur-vp)) (screen-width))
+ (* (- (cdr vp) (cdr cur-vp)) (screen-height))))
+ '(0 . 0)))
+
+ (define (window-relative-position w)
+ "Returns a cons cell with the coordinates of the window relative
+to the viewport it occupies."
+ (let ((offset (viewport-offset (window-viewport w)))
+ (coords (window-position w)))
+ (cons
+ (- (car coords) (car offset))
+ (- (cdr coords) (cdr offset)))))
+
(define (window-absolute-position w)
+ "Returns a cons cell with the coordinates of the window relative
+to the viewport 0,0."
(let ((position (window-position w)))
(if (window-outside-viewport-p w)
(cons (mod (+ (car position) viewport-x-offset) (screen-width))
diff --git a/man/news.texi b/man/news.texi
index 0a27dd1..d6bb389 100644
--- a/man/news.texi
+++ b/man/news.texi
@@ -29,6 +29,11 @@ they occurred between. For more detailed information see the
@item User visible changes:
@itemize @minus
+ item In @code{infinite-desktop} there is no longer any option to
+prevent the viewport from going beyond the edge of the workspace.
+Instead it is prevented if and only if @code{viewport-boundary-mode} is
+not set to @code{'dynamic}.
+
@item Sawfish now got an implementation of the FDO (freedesktop.org) application menu, it is
beeing generated, if there's no customized apps-menu
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
