sawfish r4298 - in trunk: . lisp/sawfish/wm lisp/sawfish/wm/commands

[chrisb svn gnome org]

Author: chrisb
Date: Tue Nov 18 20:52:05 2008
New Revision: 4298
URL: http://svn.gnome.org/viewvc/sawfish?rev=4298&view=rev

Log:
Honour ICCCM Aspect Ratio [Andrea Vetorello]


Modified:
   trunk/ChangeLog
   trunk/lisp/sawfish/wm/commands/move-resize.jl
   trunk/lisp/sawfish/wm/windows.jl

Modified: trunk/lisp/sawfish/wm/commands/move-resize.jl
==============================================================================
--- trunk/lisp/sawfish/wm/commands/move-resize.jl	(original)
+++ trunk/lisp/sawfish/wm/commands/move-resize.jl	Tue Nov 18 20:52:05 2008
@@ -308,7 +308,10 @@
 		 ((x-base (or (cdr (assq 'base-width move-resize-hints)) 0))
 		  (x-inc (or (cdr (assq 'width-inc move-resize-hints)) 1))
 		  (y-base (or (cdr (assq 'base-height move-resize-hints)) 0))
-		  (y-inc (or (cdr (assq 'height-inc move-resize-hints)) 1)))
+		  (y-inc (or (cdr (assq 'height-inc move-resize-hints)) 1))
+		  (min-aspect (assq 'min-aspect move-resize-hints))
+		  (max-aspect (assq 'max-aspect move-resize-hints)))
+               
 	       (when (memq resize-edge-mode '(grab border-grab))
 		 (add-edges ptr-x ptr-y))
 	       (cond
@@ -317,13 +320,23 @@
 		       (constrain-dimension-to-hints
 			(+ move-resize-old-width
 			   (- ptr-x move-resize-old-ptr-x))
-			'x move-resize-hints)))
+			'x move-resize-hints))
+                 (when (or min-aspect max-aspect)
+                   (setq move-resize-height
+                         (constrain-aspect-to-hints
+                          move-resize-width
+                          move-resize-old-height 'x min-aspect max-aspect))))
+                
 		((memq 'left move-resize-moving-edges)
 		 (setq move-resize-width
 		       (constrain-dimension-to-hints
 			(+ move-resize-old-width
-			   (- move-resize-old-ptr-x ptr-x))
-			'x move-resize-hints))
+			   (- move-resize-old-ptr-x ptr-x)) 'x move-resize-hints))
+                 (when (or min-aspect max-aspect)
+                   (setq move-resize-height
+                         (constrain-aspect-to-hints
+                          move-resize-width
+                          move-resize-old-height 'x min-aspect max-aspect)))
 		 (setq move-resize-x (- move-resize-old-x
 					(- move-resize-width
 					   move-resize-old-width)))))
@@ -333,13 +346,24 @@
 		       (constrain-dimension-to-hints
 			(+ move-resize-old-height
 			   (- ptr-y move-resize-old-ptr-y))
-			'y move-resize-hints)))
+			'y move-resize-hints))
+                 (when (or min-aspect max-aspect)
+                   (setq move-resize-width
+                         (constrain-aspect-to-hints
+                          move-resize-height
+                          move-resize-old-width 'y min-aspect max-aspect)))
+                 )
 		((memq 'top move-resize-moving-edges)
 		 (setq move-resize-height
 		       (constrain-dimension-to-hints
 			(+ move-resize-old-height
 			   (- move-resize-old-ptr-y ptr-y))
 			'y move-resize-hints))
+                 (when (or min-aspect max-aspect)
+                   (setq move-resize-width
+                         (constrain-aspect-to-hints
+                          move-resize-height
+                          move-resize-old-width 'y min-aspect max-aspect)))
 		 (setq move-resize-y (- move-resize-old-y
 					(- move-resize-height
 					   move-resize-old-height)))))

Modified: trunk/lisp/sawfish/wm/windows.jl
==============================================================================
--- trunk/lisp/sawfish/wm/windows.jl	(original)
+++ trunk/lisp/sawfish/wm/windows.jl	Tue Nov 18 20:52:05 2008
@@ -39,6 +39,7 @@
 	     warp-cursor-to-window
 	     activate-window
 	     constrain-dimension-to-hints
+	     constrain-aspect-to-hints
 	     resize-window-with-hints
 	     resize-window-with-hints*
 	     window-gravity
@@ -265,6 +266,13 @@
 		   (+ (* (ceiling (/ (- x bottom) inc)) inc) bottom)))))
       (clamp x (or minimum base 1) maximum)))
 
+  (define (constrain-aspect-to-hints a old-b dimension min-aspect max-aspect)
+    (let ((min-ratio (/ (cadr min-aspect) (cddr min-aspect)))
+          (max-ratio (/ (cadr max-aspect) (cddr min-aspect))))
+      (if (eq dimension 'y)
+          (clamp old-b (floor (* a min-ratio)) (floor (* a max-ratio)))
+        (clamp old-b (floor (/ a max-ratio)) (floor (/ a min-ratio))))))
+
   (define (resize-window-with-hints w cols rows #!optional hints)
     "Resize window W to COLS x ROWS, using the window's size hints to define
 the row and column size, and the minimum possible size.