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