[PATCH 1/4] "dockapp" placement mode

["Alexey I. Froloff" <raorn altlinux org>]

Signed-off-by: Alexey I. Froloff <raorn altlinux org>
---
 lisp/sawfish/wm/placement/dockapp.jl |  144 ++++++++++++++++++++++++++++++++++
 1 files changed, 144 insertions(+), 0 deletions(-)
 create mode 100644 lisp/sawfish/wm/placement/dockapp.jl

diff --git a/lisp/sawfish/wm/placement/dockapp.jl b/lisp/sawfish/wm/placement/dockapp.jl
new file mode 100644
index 0000000..16b4894
--- /dev/null
+++ b/lisp/sawfish/wm/placement/dockapp.jl
@@ -0,0 +1,144 @@
+;; dockapp-placement.jl -- ``dockapp'' window placement
+
+;; Copyright (C) 2010 Alexey I. Froloff <raorn altlinux org>
+
+;; This file is part of sawfish.
+
+;; sawfish is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; sawfish is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with sawfish; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+(define-structure sawfish.wm.placement.dockapp
+
+  (export )
+
+  (open
+    rep
+    rep.regexp
+    rep.system
+    sawfish.wm.custom
+    sawfish.wm.events
+    sawfish.wm.frames
+    sawfish.wm.misc
+    sawfish.wm.placement
+    sawfish.wm.windows)
+
+  (defconst WMIconSize 64)
+
+  (defgroup dockapps "Dockapps"
+	    :group (misc placement)
+	    :require sawfish.wm.placement.dockapp)
+
+  (defcustom dockapps-placement-origin 'south-west
+	     "Dockapp placement origin: \\w"
+	     :type (choice north-west north-east south-east south-west)
+	     :group (misc placement dockapps))
+
+  (defcustom dockapps-placement-direction 'east
+	     "Dockapp placement direction: \\w"
+	     :type (choice north east south west)
+	     :group (misc placement dockapps))
+
+  (define dockapps-origin-x (case dockapps-placement-origin
+			      ((north-west south-west) 0)
+			      ((north-east south-east) (- (screen-width) WMIconSize))))
+  (define dockapps-origin-y (case dockapps-placement-origin
+			      ((north-east north-west) 0)
+			      ((south-east south-west) (- (screen-height) WMIconSize))))
+  (define dockapps-per-line (case dockapps-placement-direction
+			      ((east west) (quotient (screen-width) WMIconSize))
+			      ((north south) (quotient (screen-height) WMIconSize))))
+
+  (define (dockapp-slot-pos n)
+    "Returns screen coordinates of nth dockapp slot."
+    (cons (case dockapps-placement-direction
+	    ((north south) (case dockapps-placement-origin
+			     ((north-west south-west)
+			      (+ dockapps-origin-x (* (quotient n dockapps-per-line) WMIconSize)))
+			     ((north-east south-east)
+			      (- dockapps-origin-x (* (quotient n dockapps-per-line) WMIconSize)))))
+	    ((east) (+ dockapps-origin-x (* (% n dockapps-per-line) WMIconSize)))
+	    ((west) (- dockapps-origin-x (* (% n dockapps-per-line) WMIconSize))))
+	  (case dockapps-placement-direction
+	    ((east west) (case dockapps-placement-origin
+			   ((north-west north-east)
+			    (+ dockapps-origin-y (* (quotient n dockapps-per-line) WMIconSize)))
+			   ((south-west south-east)
+			    (- dockapps-origin-y (* (quotient n dockapps-per-line) WMIconSize)))))
+	    ((south) (+ dockapps-origin-y (* (% n dockapps-per-line) WMIconSize)))
+	    ((north) (- dockapps-origin-y (* (% n dockapps-per-line) WMIconSize))))))
+
+  (define (dockapps-around point)
+    "Returns list of dockapp windows around given point."
+    (filter-windows
+      (lambda (w)
+	(and (dockapp-window-p w)
+	     (window-get w 'placed)
+	     (let ((w-point (window-position w)))
+	       (and (< (abs (- (car w-point) (car point))) (/ WMIconSize 2))
+		    (< (abs (- (cdr w-point) (cdr point))) (/ WMIconSize 2))))))))
+
+  (define (snap-dockapp w)
+    "Snap dockapp window to placement origin."
+    (let* ((w-pos (window-position w))
+	   (x (car w-pos))
+	   (y (cdr w-pos))
+	   (slot
+	     (case dockapps-placement-direction
+	       ((north south)
+		(% (min (quotient (+ (abs (- dockapps-origin-y y))
+				     (/ WMIconSize 2))
+				  WMIconSize)
+			(1- dockapps-per-line))
+		   dockapps-per-line))
+	       ((east west)
+		(% (min (quotient (+ (abs (- dockapps-origin-x x))
+				     (/ WMIconSize 2))
+				  WMIconSize)
+			(1- dockapps-per-line))
+		   dockapps-per-line)))))
+      (window-put w 'placed nil)
+      (while (dockapps-around (dockapp-slot-pos slot))
+	     (setq slot (+ slot dockapps-per-line)))
+      (let ((point (dockapp-slot-pos slot)))
+	;;;; Unbound variable: backquote-splice
+	;;(move-window-to w ,@(dockapp-slot-pos slot))
+	(move-window-to w (car point) (cdr point))
+	(window-put w 'placed t))))
+
+  (define (snap-window-if-dockapp w)
+    "Snap window toplacement origin if it's dockapp."
+    (when (dockapp-window-p w)
+      (snap-dockapp w)))
+
+  (add-hook 'after-move-hook snap-window-if-dockapp)
+  (add-hook 'enter-workspace-hook (lambda ()
+				    (mapc snap-window-if-dockapp
+					  (managed-windows))))
+
+  (define (place-dockapp w)
+    "Place new dockapp window on free space."
+    (let ((placed nil)
+	  (i 0))
+      (while (not placed)
+	     (let ((point (dockapp-slot-pos i)))
+	       (if (dockapps-around point)
+		 (setq i (1+ i))
+		 ;;;; Unbound variable: backquote-splice
+		 ;;(move-window-to w ,@point)
+		 (move-window-to w (car point) (cdr point))
+		 (window-put w 'placed t)
+		 (setq placed t))))))
+
+  ;;###autoload
+  (define-placement-mode 'dockapp place-dockapp))
-- 
1.7.0.4