1
#| top-left.jl -- place windows on the diagonal from the top-left corner
3
Copyright (C) 2000 Eazel, Inc.
5
This file is part of sawfish.
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)
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.
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, 675 Mass Ave, Cambridge, MA 02139, USA.
21
$Id: top-left.jl,v 1.4 2001/12/18 01:35:29 federico Exp $
23
Authors: John Harper <jsh@eazel.com>
28
;; The idea here is that there's a fixed number of possible placement
29
;; positions on a diagonal from the top-left corner, each successive
30
;; spot is slightly below and to the right of the previous spot.
32
;; The placement algorithm searches these spots for the first one that
33
;; doesn't have the top-left corner of a window in its immediate
34
;; vicinity. If placing the window on the first found spot would push
35
;; the window off the right or bottom of the screen, then resize the
36
;; window to avoid this happening.
38
;; If no spot can be found to accomodate the window's minimum allowed
39
;; size, then fallback to placing the window randomly.
41
;; (note, for `screen' above, I actually mean the work-area, i.e. the
42
;; area not reserved for special windows, e.g. the panel)
44
(define-structure sawfish.wm.placement.top-left ()
52
sawfish.wm.state.maximize
53
sawfish.wm.state.iconify)
55
(define top-left '(8 . 8))
56
(define fuzz '(8 . 16))
57
(define step '(16 . 32))
59
(define resize-windows nil)
61
(define (round-up x mult) (* (quotient (+ x (1- mult)) mult) mult))
63
(define (next-position point)
64
(cons (+ (car point) (car step))
65
(+ (cdr point) (cdr step))))
67
(define (windows-around point)
70
(and (window-get w 'placed)
71
(window-in-workspace-p w current-workspace)
72
(not (window-outside-viewport-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))))))))
79
(define (next-free-position point boundary)
80
(let loop ((point point))
81
(cond ((or (>= (car point) (car boundary))
82
(>= (cdr point) (cdr boundary)))
84
((null (windows-around point))
86
(t (loop (next-position point))))))
88
(define (place-window-top-left w)
89
(let* ((workarea (maximize-find-workarea w #:head-fallback t))
90
(dims (window-dimensions w))
91
(f-dims (window-frame-dimensions w))
92
(hints (window-size-hints w))
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))
101
(first (cons (max (round-up (nth 0 workarea) (car step))
103
(max (round-up (nth 1 workarea) (cdr step))
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))))))
111
(let ((point (next-free-position first boundary)))
114
(move-window-to w (car point) (cdr point))
116
(when (>= (+ (car point) (car f-dims)) (nth 2 workarea))
117
(rplaca dims (- (nth 2 workarea) (car point)
118
(- (car f-dims) (car dims))))
120
(when (>= (+ (cdr point) (cdr f-dims)) (nth 3 workarea))
121
(rplacd dims (- (nth 3 workarea) (cdr point)
122
(- (cdr f-dims) (cdr dims))))
125
(resize-window-with-hints* w (car dims) (cdr dims)))))
126
;; fall back to random placement
127
((placement-mode 'randomly) w)))))
130
(define-placement-mode 'top-left place-window-top-left))
added
removed
lisp/sawfish/wm/placement/top-left.jl
