Signed-off-by: Alexey I. Froloff <[email protected]> --- 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 <[email protected]> + +;; 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
