1;; top-left.jl -- place windows on the diagonal from the top-left corner 2;; 3;; Copyright (C) 2000 Eazel, Inc. 4;; 5;; This file is part of sawfish. 6;; 7;; sawfish is free software; you can redistribute it and/or modify it 8;; under the terms of the GNU General Public License as published by 9;; the Free Software Foundation; either version 2, or (at your option) 10;; any later version. 11;; 12;; sawfish is distributed in the hope that it will be useful, but 13;; WITHOUT ANY WARRANTY; without even the implied warranty of 14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15;; GNU General Public License for more details. 16;; 17;; You should have received a copy of the GNU General Public License 18;; along with sawfish; see the file COPYING. If not, write to 19;; the Free Software Foundation, 51 Franklin Street, Fifth Floor, 20;; Boston, MA 02110-1301 USA. 21;; 22;; Authors: John Harper <jsh@eazel.com> 23 24;; Commentary: 25 26;; The idea here is that there's a fixed number of possible placement 27;; positions on a diagonal from the top-left corner, each successive 28;; spot is slightly below and to the right of the previous spot. 29 30;; The placement algorithm searches these spots for the first one that 31;; doesn't have the top-left corner of a window in its immediate 32;; vicinity. If placing the window on the first found spot would push 33;; the window off the right or bottom of the screen, then resize the 34;; window to avoid this happening. 35 36;; If no spot can be found to accommodate the window's minimum allowed 37;; size, then fallback to placing the window randomly. 38 39;; (note, for `screen' above, I actually mean the work-area, i.e. the 40;; area not reserved for special windows, e.g. the panel) 41 42(define-structure sawfish.wm.placement.top-left 43 44 (export ) 45 46 (open rep 47 sawfish.wm.windows 48 sawfish.wm.misc 49 sawfish.wm.placement 50 sawfish.wm.workspace 51 sawfish.wm.viewport 52 sawfish.wm.util.workarea 53 sawfish.wm.state.iconify) 54 55 (define top-left '(8 . 8)) 56 (define fuzz '(8 . 16)) 57 (define step '(16 . 32)) 58 59 (define resize-windows nil) 60 61 (define (round-up x mult) (* (quotient (+ x (1- mult)) mult) mult)) 62 63 (define (next-position point) 64 (cons (+ (car point) (car step)) 65 (+ (cdr point) (cdr step)))) 66 67 (define (windows-around point) 68 (filter-windows 69 (lambda (w) 70 (and (window-get w 'placed) 71 (window-in-workspace-p w current-workspace) 72 (not (window-outside-viewport-p w)) 73 (window-mapped-p w) 74 (not (window-iconified-p w)) 75 (let ((w-point (window-position w))) 76 (and (< (abs (- (car w-point) (car point))) (car fuzz)) 77 (< (abs (- (cdr w-point) (cdr point))) (cdr fuzz)))))))) 78 79 (define (next-free-position point boundary) 80 (let loop ((point point)) 81 (cond ((or (>= (car point) (car boundary)) 82 (>= (cdr point) (cdr boundary))) 83 nil) 84 ((null (windows-around point)) 85 point) 86 (t (loop (next-position point)))))) 87 88 (define (place-window-top-left w) 89 (let* ((workarea (calculate-workarea #:window w #:head (current-head))) 90 (dims (window-dimensions w)) 91 (f-dims (window-frame-dimensions w)) 92 (hints (window-size-hints w)) 93 94 (min-dims (if resize-windows 95 (cons (or (cdr (or (assq 'min-width hints) 96 (assq 'base-width hints))) 1) 97 (or (cdr (or (assq 'min-height hints) 98 (assq 'base-height hints))) 1)) 99 dims)) 100 101 (first (cons (max (round-up (nth 0 workarea) (car step)) 102 (car top-left)) 103 (max (round-up (nth 1 workarea) (cdr step)) 104 (cdr top-left)))) 105 106 (boundary (cons (- (nth 2 workarea) (car min-dims) 107 (- (car f-dims) (car dims))) 108 (- (nth 3 workarea) (cdr min-dims) 109 (- (cdr f-dims) (cdr dims)))))) 110 111 (let ((point (next-free-position first boundary))) 112 (if point 113 (progn 114 (move-window-to w (car point) (cdr point)) 115 (let ((changed nil)) 116 (when (>= (+ (car point) (car f-dims)) (nth 2 workarea)) 117 (rplaca dims (- (nth 2 workarea) (car point) 118 (- (car f-dims) (car dims)))) 119 (setq changed t)) 120 (when (>= (+ (cdr point) (cdr f-dims)) (nth 3 workarea)) 121 (rplacd dims (- (nth 3 workarea) (cdr point) 122 (- (cdr f-dims) (cdr dims)))) 123 (setq changed t)) 124 (when changed 125 (resize-window-with-hints* w (car dims) (cdr dims))))) 126 ;; fall back to random placement 127 ((placement-mode 'randomly) w))))) 128 129 ;;###autoload 130 (define-placement-mode 'top-left place-window-top-left #:for-normal t)) 131