1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Layout functions
6 ;;; --------------------------------------------------------------------------
8 ;;; (C) 2011 Philippe Brochard <hocwp@free.fr>
10 ;;; This program is free software; you can redistribute it and/or modify
11 ;;; it under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 3 of the License, or
13 ;;; (at your option) any later version.
15 ;;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with this program; if not, write to the Free Software
22 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
24 ;;; --------------------------------------------------------------------------
29 ;;; CONFIG - Layout menu
31 ;;; To add a new layout:
32 ;;; 1- define your own layout: a method returning the real size of the
33 ;;; child in screen size (integer) as 4 values (rx, ry, rw, rh).
34 ;;; This method can use the float size of the child (x, y ,w , h).
35 ;;; It can be specialized for xlib:window or frame
36 ;;; 2- Define a setter function for your layout
37 ;;; 3- Register your new layout with register-layout or create
38 ;;; a sub menu for it with register-layout-sub-menu.
42 (defparameter *layout-current-key
* (1- (char-code #\a)))
46 (defun set-layout (layout)
47 "Set the layout of the current child"
48 (when (frame-p *current-child
*)
49 (setf (frame-layout *current-child
*) layout
)
52 (defun set-layout-dont-leave (layout)
53 "Set the layout of the current child"
54 (when (frame-p *current-child
*)
55 (setf (frame-layout *current-child
*) layout
)))
57 (defun set-layout-once (layout-name)
58 (set-layout-dont-leave layout-name
)
60 (fixe-real-size-current-child)
61 (set-layout-dont-leave #'no-layout
))
64 (defun get-managed-child (parent)
65 "Return only the windows that are managed for tiling"
66 (when (frame-p parent
)
67 (remove-if #'(lambda (x)
68 (and (xlib:window-p x
) (not (managed-window-p x parent
))))
69 (frame-child parent
))))
72 (defun next-layout-key ()
73 (code-char (incf *layout-current-key
*)))
76 (defun register-layout (layout)
77 (add-menu-key 'frame-layout-menu
(next-layout-key) layout
))
80 (defun register-layout-sub-menu (name doc layout-list
)
81 (add-sub-menu 'frame-layout-menu
(next-layout-key) name doc
)
82 (loop :for item
:in layout-list
85 (cons (add-menu-key name
(first item
) (second item
)))
86 (string (add-menu-comment name item
))
87 (t (add-menu-key name
(number->char i
) item
)))))
92 (defun layout-ask-size (msg slot
&optional
(min 80))
93 (when (frame-p *current-child
*)
94 (let ((new-size (/ (or (query-number msg
(* (frame-data-slot *current-child
* slot
) 100)) min
) 100)))
95 (when (<= 0 new-size
1)
96 (setf (frame-data-slot *current-child
* slot
) new-size
)))))
102 (defun fast-layout-switch ()
103 "Switch between two layouts"
104 (when (frame-p *current-child
*)
105 (with-slots (layout) *current-child
*
106 (let* ((layout-list (frame-data-slot *current-child
* :fast-layout
))
107 (first-layout (ensure-function (first layout-list
)))
108 (second-layout (ensure-function (second layout-list
))))
109 (setf layout
(if (eql layout first-layout
)
112 (leave-second-mode)))))
115 (defun push-in-fast-layout-list ()
116 "Push the current layout in the fast layout list"
117 (when (frame-p *current-child
*)
118 (setf (frame-data-slot *current-child
* :fast-layout
)
119 (list (frame-layout *current-child
*)
120 (first (frame-data-slot *current-child
* :fast-layout
))))
121 (leave-second-mode)))
125 (register-layout-sub-menu 'frame-fast-layout-menu
"Frame fast layout menu"
126 '(("s" fast-layout-switch
)
127 ("p" push-in-fast-layout-list
)))
131 (defgeneric no-layout
(child parent
)
132 (:documentation
"No layout: Maximize windows in there frame - Leave frames to there original size"))
134 (defmethod no-layout ((child xlib
:window
) parent
)
135 (with-slots (rx ry rw rh
) parent
136 (values (adj-border-xy rx child
)
137 (adj-border-xy ry child
)
138 (adj-border-wh rw child
)
139 (adj-border-wh rh child
))))
141 (defmethod no-layout ((child frame
) parent
)
142 (values (adj-border-xy (x-fl->px
(frame-x child
) parent
) child
)
143 (adj-border-xy (y-fl->px
(frame-y child
) parent
) child
)
144 (adj-border-wh (w-fl->px
(frame-w child
) parent
) child
)
145 (adj-border-wh (h-fl->px
(frame-h child
) parent
) child
)))
149 (defun set-no-layout ()
150 "No layout: Maximize windows in there frame - Leave frames to there original size"
151 (set-layout #'no-layout
))
153 (register-layout 'set-no-layout
)
155 ;;; No layout remember size
156 (defun set-no-layout-remember-size ()
157 "No layout: Maximize windows in there frame - Leave frames to there actual size"
158 (fixe-real-size-current-child)
161 (register-layout 'set-no-layout-remember-size
)
166 (defgeneric maximize-layout
(child parent
)
167 (:documentation
"Maximize layout: Maximize windows and frames in there parent frame"))
169 (defmethod maximize-layout (child parent
)
170 (with-slots (rx ry rw rh
) parent
171 (values (adj-border-xy rx child
)
172 (adj-border-xy ry child
)
173 (adj-border-wh rw child
)
174 (adj-border-wh rh child
))))
177 (defun set-maximize-layout ()
178 "Maximize layout: Maximize windows and frames in there parent frame"
179 (set-layout #'maximize-layout
))
181 (register-layout 'set-maximize-layout
)
187 (defun tile-layout-ask-keep-position ()
188 (when (frame-p *current-child
*)
189 (if (query-yes-or-no "Keep frame children positions?")
190 (setf (frame-data-slot *current-child
* :tile-layout-keep-position
) :yes
)
191 (remove-frame-data-slot *current-child
* :tile-layout-keep-position
))))
195 (labels ((set-managed ()
196 (setf (frame-data-slot *current-child
* :layout-managed-children
)
197 (copy-list (get-managed-child *current-child
*)))))
198 (defun set-layout-managed-children ()
199 (when (frame-p *current-child
*)
201 (tile-layout-ask-keep-position)))
204 (defun update-layout-managed-children-position ()
205 "Update layout managed children position"
206 (when (frame-p *current-child
*)
208 (leave-second-mode))))
212 (defun update-layout-managed-children-keep-position (child parent
)
213 (let ((managed-children (frame-data-slot parent
:layout-managed-children
))
214 (managed-in-parent (get-managed-child parent
)))
215 (dolist (ch managed-in-parent
)
216 (unless (child-member ch managed-children
)
217 (setf managed-children
(append managed-children
(list child
)))))
218 (setf managed-children
(remove-if-not (lambda (x)
219 (child-member x managed-in-parent
))
221 (setf (frame-data-slot parent
:layout-managed-children
) managed-children
)
224 (defun update-layout-managed-children (child parent
)
225 (if (eql (frame-data-slot parent
:tile-layout-keep-position
) :yes
)
226 (update-layout-managed-children-keep-position child parent
)
227 (get-managed-child parent
)))
231 (defgeneric tile-layout
(child parent
)
232 (:documentation
"Tile child in its frame (vertical)"))
234 (defmethod tile-layout (child parent
)
235 (let* ((managed-children (update-layout-managed-children child parent
))
236 (pos (child-position child managed-children
))
237 (len (length managed-children
))
238 (nx (ceiling (sqrt len
)))
239 (ny (ceiling (/ len nx
)))
240 (dx (/ (frame-rw parent
) nx
))
241 (dy (/ (frame-rh parent
) ny
))
242 (dpos (- (* nx ny
) len
))
246 (setf width
(* dx
(1+ dpos
)))
248 (values (round (adj-border-xy (+ (frame-rx parent
) (truncate (* (mod pos nx
) dx
))) child
))
249 (round (adj-border-xy (+ (frame-ry parent
) (truncate (* (truncate (/ pos nx
)) dy
))) child
))
250 (round (adj-border-wh width child
))
251 (round (adj-border-wh dy child
)))))
253 (defun set-tile-layout ()
254 "Tile child in its frame (vertical)"
255 (set-layout-managed-children)
256 (set-layout #'tile-layout
))
260 ;; Horizontal tiling layout
261 (defgeneric tile-horizontal-layout
(child parent
)
262 (:documentation
"Tile child in its frame (horizontal)"))
264 (defmethod tile-horizontal-layout (child parent
)
265 (let* ((managed-children (update-layout-managed-children child parent
))
266 (pos (child-position child managed-children
))
267 (len (length managed-children
))
268 (ny (ceiling (sqrt len
)))
269 (nx (ceiling (/ len ny
)))
270 (dx (/ (frame-rw parent
) nx
))
271 (dy (/ (frame-rh parent
) ny
))
272 (dpos (- (* nx ny
) len
))
276 (setf height
(* dy
(1+ dpos
)))
278 (values (round (adj-border-xy (+ (frame-rx parent
) (truncate (* (truncate (/ pos ny
)) dx
))) child
))
279 (round (adj-border-xy (+ (frame-ry parent
) (truncate (* (mod pos ny
) dy
))) child
))
280 (round (adj-border-wh dx child
))
281 (round (adj-border-wh height child
)))))
283 (defun set-tile-horizontal-layout ()
284 "Tile child in its frame (horizontal)"
285 (set-layout-managed-children)
286 (set-layout #'tile-horizontal-layout
))
291 (defgeneric one-column-layout
(child parent
)
292 (:documentation
"One column layout"))
294 (defmethod one-column-layout (child parent
)
295 (let* ((managed-children (update-layout-managed-children child parent
))
296 (pos (child-position child managed-children
))
297 (len (length managed-children
))
298 (dy (/ (frame-rh parent
) len
)))
299 (values (round (adj-border-xy (frame-rx parent
) child
))
300 (round (adj-border-xy (+ (frame-ry parent
) (* pos dy
)) child
))
301 (round (adj-border-wh (frame-rw parent
) child
))
302 (round (adj-border-wh dy child
)))))
304 (defun set-one-column-layout ()
306 (set-layout-managed-children)
307 (set-layout #'one-column-layout
))
311 (defgeneric one-line-layout
(child parent
)
312 (:documentation
"One line layout"))
314 (defmethod one-line-layout (child parent
)
315 (let* ((managed-children (update-layout-managed-children child parent
))
316 (pos (child-position child managed-children
))
317 (len (length managed-children
))
318 (dx (/ (frame-rw parent
) len
)))
319 (values (round (adj-border-xy (+ (frame-rx parent
) (* pos dx
)) child
))
320 (round (adj-border-xy (frame-ry parent
) child
))
321 (round (adj-border-wh dx child
))
322 (round (adj-border-wh (frame-rh parent
) child
)))))
324 (defun set-one-line-layout ()
326 (set-layout-managed-children)
327 (set-layout #'one-line-layout
))
334 (defun tile-space-layout (child parent
)
335 "Tile Space: tile child in its frame leaving spaces between them"
336 (with-slots (rx ry rw rh
) parent
337 (let* ((managed-children (update-layout-managed-children child parent
))
338 (pos (child-position child managed-children
))
339 (len (length managed-children
))
340 (n (ceiling (sqrt len
)))
342 (dy (/ rh
(ceiling (/ len n
))))
343 (size (or (frame-data-slot parent
:tile-space-size
) 0.1)))
344 (when (> size
0.5) (setf size
0.45))
345 (values (round (adj-border-xy (+ rx
(truncate (* (mod pos n
) dx
)) (* dx size
)) child
))
346 (round (adj-border-xy (+ ry
(truncate (* (truncate (/ pos n
)) dy
)) (* dy size
)) child
))
347 (round (adj-border-wh (- dx
(* dx size
2)) child
))
348 (round (adj-border-wh (- dy
(* dy size
2)) child
))))))
353 (defun set-tile-space-layout ()
354 "Tile Space: tile child in its frame leaving spaces between them"
355 (layout-ask-size "Space size in percent (%)" :tile-space-size
0.01)
356 (set-layout-managed-children)
357 (set-layout #'tile-space-layout
))
361 (register-layout-sub-menu 'frame-tile-layout-menu
"Frame tile layout menu"
362 '(("v" set-tile-layout
)
363 ("h" set-tile-horizontal-layout
)
364 ("c" set-one-column-layout
)
365 ("l" set-one-line-layout
)
366 ("s" set-tile-space-layout
)))
371 (defun tile-left-layout (child parent
)
372 "Tile Left: main child on left and others on right"
373 (with-slots (rx ry rw rh
) parent
374 (let* ((managed-children (update-layout-managed-children child parent
))
375 (pos (child-position child managed-children
))
376 (len (max (1- (length managed-children
)) 1))
378 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
379 (if (> (length managed-children
) 1)
381 (values (adj-border-xy rx child
)
382 (adj-border-xy ry child
)
383 (adj-border-wh (round (* rw size
)) child
)
384 (adj-border-wh rh child
))
385 (values (adj-border-xy (round (+ rx
(* rw size
))) child
)
386 (adj-border-xy (round (+ ry
(* dy
(1- pos
)))) child
)
387 (adj-border-wh (round (* rw
(- 1 size
))) child
)
388 (adj-border-wh (round dy
) child
)))
389 (no-layout child parent
)))))
392 (defun set-tile-left-layout ()
393 "Tile Left: main child on left and others on right"
394 (layout-ask-size "Tile size in percent (%)" :tile-size
)
395 (set-layout-managed-children)
396 (set-layout #'tile-left-layout
))
401 (defun tile-right-layout (child parent
)
402 "Tile Right: main child on right and others on left"
403 (with-slots (rx ry rw rh
) parent
404 (let* ((managed-children (update-layout-managed-children child parent
))
405 (pos (child-position child managed-children
))
406 (len (max (1- (length managed-children
)) 1))
408 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
409 (if (> (length managed-children
) 1)
411 (values (adj-border-xy (round (+ rx
(* rw
(- 1 size
)))) child
)
412 (adj-border-xy ry child
)
413 (adj-border-wh (round (* rw size
)) child
)
414 (adj-border-wh rh child
))
415 (values (adj-border-xy rx child
)
416 (adj-border-xy (round (+ ry
(* dy
(1- pos
)))) child
)
417 (adj-border-wh (round (* rw
(- 1 size
))) child
)
418 (adj-border-wh (round dy
) child
)))
419 (no-layout child parent
)))))
422 (defun set-tile-right-layout ()
423 "Tile Right: main child on right and others on left"
424 (layout-ask-size "Tile size in percent (%)" :tile-size
)
425 (set-layout-managed-children)
426 (set-layout #'tile-right-layout
))
434 (defun tile-top-layout (child parent
)
435 "Tile Top: main child on top and others on bottom"
436 (with-slots (rx ry rw rh
) parent
437 (let* ((managed-children (update-layout-managed-children child parent
))
438 (pos (child-position child managed-children
))
439 (len (max (1- (length managed-children
)) 1))
441 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
442 (if (> (length managed-children
) 1)
444 (values (adj-border-xy rx child
)
445 (adj-border-xy ry child
)
446 (adj-border-wh rw child
)
447 (adj-border-wh (round (* rh size
)) child
))
448 (values (adj-border-xy (round (+ rx
(* dx
(1- pos
)))) child
)
449 (adj-border-xy (round (+ ry
(* rh size
))) child
)
450 (adj-border-wh (round dx
) child
)
451 (adj-border-wh (round (* rh
(- 1 size
))) child
)))
452 (no-layout child parent
)))))
455 (defun set-tile-top-layout ()
456 "Tile Top: main child on top and others on bottom"
457 (layout-ask-size "Tile size in percent (%)" :tile-size
)
458 (set-layout-managed-children)
459 (set-layout #'tile-top-layout
))
465 (defun tile-bottom-layout (child parent
)
466 "Tile Bottom: main child on bottom and others on top"
467 (with-slots (rx ry rw rh
) parent
468 (let* ((managed-children (update-layout-managed-children child parent
))
469 (pos (child-position child managed-children
))
470 (len (max (1- (length managed-children
)) 1))
472 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
473 (if (> (length managed-children
) 1)
475 (values (adj-border-xy rx child
)
476 (adj-border-xy (round (+ ry
(* rh
(- 1 size
)))) child
)
477 (adj-border-wh rw child
)
478 (adj-border-wh (round (* rh size
)) child
))
479 (values (adj-border-xy (round (+ rx
(* dx
(1- pos
)))) child
)
480 (adj-border-xy ry child
)
481 (adj-border-wh (round dx
) child
)
482 (adj-border-wh (round (* rh
(- 1 size
))) child
)))
483 (no-layout child parent
)))))
487 (defun set-tile-bottom-layout ()
488 "Tile Bottom: main child on bottom and others on top"
489 (layout-ask-size "Tile size in percent (%)" :tile-size
)
490 (set-layout-managed-children)
491 (set-layout #'tile-bottom-layout
))
494 (register-layout-sub-menu 'frame-tile-dir-layout-menu
"Tile in one direction layout menu"
495 '(("l" set-tile-left-layout
)
496 ("r" set-tile-right-layout
)
497 ("t" set-tile-top-layout
)
498 ("b" set-tile-bottom-layout
)))
505 ;;; Left and space layout: like left layout but leave a space on the left
506 (defun layout-ask-space (msg slot
&optional
(default 100))
507 (when (frame-p *current-child
*)
508 (let ((new-space (or (query-number msg
(or (frame-data-slot *current-child
* slot
) default
)) default
)))
509 (setf (frame-data-slot *current-child
* slot
) new-space
))))
512 (defun tile-left-space-layout (child parent
)
513 "Tile Left Space: main child on left and others on right. Leave some space (in pixels) on the left."
514 (with-slots (rx ry rw rh
) parent
515 (let* ((managed-children (update-layout-managed-children child parent
))
516 (pos (child-position child managed-children
))
517 (len (max (1- (length managed-children
)) 1))
519 (size (or (frame-data-slot parent
:tile-size
) 0.8))
520 (space (or (frame-data-slot parent
:tile-left-space
) 100)))
521 (if (> (length managed-children
) 1)
523 (values (adj-border-xy (+ rx space
) child
)
524 (adj-border-xy ry child
)
525 (adj-border-wh (- (round (* rw size
)) space
) child
)
526 (adj-border-wh rh child
))
527 (values (adj-border-xy (round (+ rx
(* rw size
))) child
)
528 (adj-border-xy (round (+ ry
(* dy
(1- pos
)))) child
)
529 (adj-border-wh (round (* rw
(- 1 size
))) child
)
530 (adj-border-wh (round dy
) child
)))
531 (multiple-value-bind (rnx rny rnw rnh
)
532 (no-layout child parent
)
533 (values (+ rnx space
)
539 (defun set-tile-left-space-layout ()
540 "Tile Left Space: main child on left and others on right. Leave some space on the left."
541 (layout-ask-size "Tile size in percent (%)" :tile-size
)
542 (layout-ask-space "Tile space (in pixels)" :tile-left-space
)
543 (set-layout-managed-children)
544 (set-layout #'tile-left-space-layout
))
546 (register-layout-sub-menu 'frame-tile-space-layout-menu
"Tile with some space on one side menu"
547 '(set-tile-left-space-layout))
552 ;;; Main windows layout - A possible GIMP layout
553 ;;; The windows in the main list are tiled on the frame
554 ;;; others windows are on one side of the frame.
555 (defun main-window-right-layout (child parent
)
556 "Main window right: Main windows on the right. Others on the left."
557 (with-slots (rx ry rw rh
) parent
558 (let* ((main-windows (frame-data-slot parent
:main-window-list
))
559 (len (length main-windows
))
560 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
562 (no-layout child parent
)
563 (if (child-member child main-windows
)
564 (let* ((dy (/ rh len
))
565 (pos (child-position child main-windows
)))
566 (values (adj-border-xy (round (+ rx
(* rw
(- 1 size
)))) child
)
567 (adj-border-xy (round (+ ry
(* dy pos
))) child
)
568 (adj-border-wh (round (* rw size
)) child
)
569 (adj-border-wh (round dy
) child
)))
570 (values (adj-border-xy rx child
)
571 (adj-border-xy ry child
)
572 (adj-border-wh (round (* rw
(- 1 size
))) child
)
573 (adj-border-wh rh child
)))))))
575 (defun set-main-window-right-layout ()
576 "Main window right: Main windows on the right. Others on the left."
577 (layout-ask-size "Split size in percent (%)" :tile-size
)
578 (set-layout #'main-window-right-layout
))
583 (defun main-window-left-layout (child parent
)
584 "Main window left: Main windows on the left. Others on the right."
585 (with-slots (rx ry rw rh
) parent
586 (let* ((main-windows (frame-data-slot parent
:main-window-list
))
587 (len (length main-windows
))
588 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
590 (no-layout child parent
)
591 (if (child-member child main-windows
)
592 (let* ((dy (/ rh len
))
593 (pos (child-position child main-windows
)))
594 (values (adj-border-xy rx child
)
595 (adj-border-xy (round (+ ry
(* dy pos
))) child
)
596 (adj-border-wh (round (* rw size
)) child
)
597 (adj-border-wh (round dy
) child
)))
598 (values (adj-border-xy (round (+ rx
(* rw size
))) child
)
599 (adj-border-xy ry child
)
600 (adj-border-wh (round (* rw
(- 1 size
))) child
)
601 (adj-border-wh rh child
)))))))
603 (defun set-main-window-left-layout ()
604 "Main window left: Main windows on the left. Others on the right."
605 (layout-ask-size "Split size in percent (%)" :tile-size
)
606 (set-layout #'main-window-left-layout
))
610 (defun main-window-top-layout (child parent
)
611 "Main window top: Main windows on the top. Others on the bottom."
612 (with-slots (rx ry rw rh
) parent
613 (let* ((main-windows (frame-data-slot parent
:main-window-list
))
614 (len (length main-windows
))
615 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
617 (no-layout child parent
)
618 (if (child-member child main-windows
)
619 (let* ((dx (/ rw len
))
620 (pos (child-position child main-windows
)))
621 (values (adj-border-xy (round (+ rx
(* dx pos
))) child
)
622 (adj-border-xy ry child
)
623 (adj-border-wh (round dx
) child
)
624 (adj-border-wh (round (* rh size
)) child
)))
625 (values (adj-border-xy rx child
)
626 (adj-border-xy (round (+ ry
(* rh size
))) child
)
627 (adj-border-wh rw child
)
628 (adj-border-wh (round (* rh
(- 1 size
))) child
)))))))
630 (defun set-main-window-top-layout ()
631 "Main window top: Main windows on the top. Others on the bottom."
632 (layout-ask-size "Split size in percent (%)" :tile-size
)
633 (set-layout #'main-window-top-layout
))
637 (defun main-window-bottom-layout (child parent
)
638 "Main window bottom: Main windows on the bottom. Others on the top."
639 (with-slots (rx ry rw rh
) parent
640 (let* ((main-windows (frame-data-slot parent
:main-window-list
))
641 (len (length main-windows
))
642 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
644 (no-layout child parent
)
645 (if (child-member child main-windows
)
646 (let* ((dx (/ rw len
))
647 (pos (child-position child main-windows
)))
648 (values (adj-border-xy (round (+ rx
(* dx pos
))) child
)
649 (adj-border-xy (round (+ ry
(* rh
(- 1 size
)))) child
)
650 (adj-border-wh (round dx
) child
)
651 (adj-border-wh (round (* rh size
)) child
)))
652 (values (adj-border-xy rx child
)
653 (adj-border-xy ry child
)
654 (adj-border-wh rw child
)
655 (adj-border-wh (round (* rh
(- 1 size
))) child
)))))))
657 (defun set-main-window-bottom-layout ()
658 "Main window bottom: Main windows on the bottom. Others on the top."
659 (layout-ask-size "Split size in percent (%)" :tile-size
)
660 (set-layout #'main-window-bottom-layout
))
666 (defun add-in-main-window-list ()
667 "Add the current window in the main window list"
668 (when (frame-p *current-child
*)
670 (when (child-member window
(get-managed-child *current-child
*))
671 (pushnew window
(frame-data-slot *current-child
* :main-window-list
)))))
675 (defun remove-in-main-window-list ()
676 "Remove the current window from the main window list"
677 (when (frame-p *current-child
*)
679 (when (child-member window
(get-managed-child *current-child
*))
680 (setf (frame-data-slot *current-child
* :main-window-list
)
681 (child-remove window
(frame-data-slot *current-child
* :main-window-list
))))))
684 (defun clear-main-window-list ()
685 "Clear the main window list"
686 (when (frame-p *current-child
*)
687 (setf (frame-data-slot *current-child
* :main-window-list
) nil
))
693 (register-layout-sub-menu 'frame-main-window-layout-menu
"Main window layout menu"
694 '(("r" set-main-window-right-layout
)
695 ("l" set-main-window-left-layout
)
696 ("t" set-main-window-top-layout
)
697 ("b" set-main-window-bottom-layout
)
698 "-=- Actions on main windows list -=-"
699 ("a" add-in-main-window-list
)
700 ("v" remove-in-main-window-list
)
701 ("c" clear-main-window-list
)))
704 ;;; GIMP layout specifics functions
706 (defconfig *gimp-layout-notify-window-delay
* 30 'gimp-layout
707 "Time to display the GIMP layout notify window help")
710 (defun select-next/previous-child-no-main-window
(fun-rotate)
711 "Select the next/previous child - Skip windows in main window list"
712 (when (frame-p *current-child
*)
713 (with-slots (child) *current-child
*
714 (let* ((main-windows (frame-data-slot *current-child
* :main-window-list
))
715 (to-skip?
(not (= (length main-windows
)
718 (setf child
(funcall fun-rotate child
))
720 (child-member (frame-selected-child *current-child
*) main-windows
))
722 (unselect-all-frames)
724 (show-all-children))))))
727 (defun select-next-child-no-main-window ()
728 "Select the next child - Skip windows in main window list"
729 (select-next/previous-child-no-main-window
#'rotate-list
))
731 (defun select-previous-child-no-main-window ()
732 "Select the previous child - Skip windows in main window list"
733 (select-next/previous-child-no-main-window
#'anti-rotate-list
))
736 (defun mouse-click-to-focus-and-move-no-main-window (window root-x root-y
)
737 "Move and focus the current frame or focus the current window parent.
738 Or do actions on corners - Skip windows in main window list"
739 (unless (do-corner-action root-x root-y
*corner-main-mode-left-button
*)
740 (if (and (frame-p *current-child
*)
741 (child-member window
(frame-data-slot *current-child
* :main-window-list
)))
742 (replay-button-event)
743 (mouse-click-to-focus-generic window root-x root-y
#'move-frame
))))
747 (let ((help-text-list `(("-=- Help on The GIMP layout -=-" ,*info-color-title
*)
749 "The GIMP layout is a main-window-layout with a sloppy focus policy."
750 "You can change the main windows direction with the layout menu."
752 "Press Alt+F8 to add a window to the main windows list."
753 "Press Alt+F9 to remove a window from the main windows list."
754 "Press Alt+F10 to clear the main windows list."
756 "You can select a main window with the right mouse button."
758 "Use the layout menu to restore the previous layout and keybinding.")))
759 (defun help-on-gimp-layout ()
760 "Help on the GIMP layout"
761 (info-mode help-text-list
)
764 (defun set-gimp-layout ()
766 (when (frame-p *current-child
*)
767 ;; Note: There is no need to ungrab/grab keys because this
768 ;; is done when leaving the second mode.
769 (define-main-key ("F8" :mod-1
) 'add-in-main-window-list
)
770 (define-main-key ("F9" :mod-1
) 'remove-in-main-window-list
)
771 (define-main-key ("F10" :mod-1
) 'clear-main-window-list
)
772 (define-main-key ("Tab" :mod-1
) 'select-next-child-no-main-window
)
773 (define-main-key ("Tab" :mod-1
:shift
) 'select-previous-child-no-main-window
)
774 (define-main-mouse (1) 'mouse-click-to-focus-and-move-no-main-window
)
775 (setf (frame-data-slot *current-child
* :focus-policy-save
)
776 (frame-focus-policy *current-child
*))
777 (setf (frame-focus-policy *current-child
*) :sloppy
)
778 (setf (frame-data-slot *current-child
* :layout-save
)
779 (frame-layout *current-child
*))
780 (open-notify-window help-text-list
)
781 (add-timer *gimp-layout-notify-window-delay
* #'close-notify-window
)
782 ;; Set the default layout and leave the second mode.
783 (set-main-window-right-layout))))
786 (defun set-previous-layout ()
787 "Restore the previous layout"
788 (undefine-main-key ("F8" :mod-1
))
789 (undefine-main-key ("F9" :mod-1
))
790 (undefine-main-key ("F10" :mod-1
))
791 (define-main-key ("Tab" :mod-1
) 'select-next-child
)
792 (define-main-key ("Tab" :mod-1
:shift
) 'select-previous-child
)
793 (define-main-mouse (1) 'mouse-click-to-focus-and-move
)
794 (setf (frame-focus-policy *current-child
*)
795 (frame-data-slot *current-child
* :focus-policy-save
))
796 (setf (frame-layout *current-child
*)
797 (frame-data-slot *current-child
* :layout-save
))
803 (register-layout-sub-menu 'frame-gimp-layout-menu
"The GIMP layout menu"
804 '(("g" set-gimp-layout
)
805 ("p" set-previous-layout
)
806 ("h" help-on-gimp-layout
)
807 "-=- Main window layout -=-"
808 ("r" set-main-window-right-layout
)
809 ("l" set-main-window-left-layout
)
810 ("t" set-main-window-top-layout
)
811 ("b" set-main-window-bottom-layout
)
812 "-=- Actions on main windows list -=-"
813 ("a" add-in-main-window-list
)
814 ("v" remove-in-main-window-list
)
815 ("c" clear-main-window-list
)))