1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Layout functions
6 ;;; --------------------------------------------------------------------------
8 ;;; (C) 2010 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 5 values (rx, ry, rw, rh).
34 ;;; This method can use the float size of the child (x, y ,w , h).
35 ;;; It can be specialised 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
)))
132 (defgeneric no-layout
(child parent
)
133 (:documentation
"No layout: Maximize windows in there frame - Leave frames to there original size"))
135 (defmethod no-layout ((child xlib
:window
) parent
)
136 (with-slots (rx ry rw rh
) parent
142 (defmethod no-layout ((child frame
) parent
)
143 (values (x-fl->px
(frame-x child
) parent
)
144 (y-fl->px
(frame-y child
) parent
)
145 (w-fl->px
(frame-w child
) parent
)
146 (h-fl->px
(frame-h child
) parent
)))
150 (defun set-no-layout ()
151 "No layout: Maximize windows in there frame - Leave frames to there original size"
152 (set-layout #'no-layout
))
154 (register-layout 'set-no-layout
)
156 ;;; No layout remember size
157 (defun set-no-layout-remember-size ()
158 "No layout: Maximize windows in there frame - Leave frames to there actual size"
159 (fixe-real-size-current-child)
162 (register-layout 'set-no-layout-remember-size
)
167 (defgeneric maximize-layout
(child parent
)
168 (:documentation
"Maximize layout: Maximize windows and frames in there parent frame"))
170 (defmethod maximize-layout (child parent
)
171 (declare (ignore child
))
172 (with-slots (rx ry rw rh
) parent
179 (defun set-maximize-layout ()
180 "Maximize layout: Maximize windows and frames in there parent frame"
181 (set-layout #'maximize-layout
))
183 (register-layout 'set-maximize-layout
)
189 (defun tile-layout-ask-keep-position ()
190 (when (frame-p *current-child
*)
191 (if (query-yes-or-no "Keep frame children positions?")
192 (setf (frame-data-slot *current-child
* :tile-layout-keep-positiion
) :yes
)
193 (remove-frame-data-slot *current-child
* :tile-layout-keep-positiion
))))
196 (defun set-layout-managed-children ()
197 (when (frame-p *current-child
*)
198 (setf (frame-data-slot *current-child
* :layout-managed-children
)
199 (copy-list (get-managed-child *current-child
*)))
200 (tile-layout-ask-keep-position)))
202 (defun update-layout-managed-children-keep-position (child parent
)
203 (let ((managed-children (frame-data-slot parent
:layout-managed-children
))
204 (managed-in-parent (get-managed-child parent
)))
205 (dolist (ch managed-in-parent
)
206 (unless (child-member ch managed-children
)
207 (setf managed-children
(append managed-children
(list child
)))))
208 (setf managed-children
(remove-if-not (lambda (x)
209 (child-member x managed-in-parent
))
211 (setf (frame-data-slot parent
:layout-managed-children
) managed-children
)
214 (defun update-layout-managed-children (child parent
)
215 (if (eql (frame-data-slot *current-child
* :tile-layout-keep-positiion
) :yes
)
216 (update-layout-managed-children-keep-position child parent
)
217 (get-managed-child parent
)))
221 (defgeneric tile-layout
(child parent
)
222 (:documentation
"Tile child in its frame (vertical)"))
224 (defmethod tile-layout (child parent
)
225 (let* ((managed-children (update-layout-managed-children child parent
))
226 (pos (child-position child managed-children
))
227 (len (length managed-children
))
228 (nx (ceiling (sqrt len
)))
229 (ny (ceiling (/ len nx
)))
230 (dx (/ (frame-rw parent
) nx
))
231 (dy (/ (frame-rh parent
) ny
))
232 (dpos (- (* nx ny
) len
))
236 (setf width
(* dx
(1+ dpos
)))
238 (values (round (+ (frame-rx parent
) (truncate (* (mod pos nx
) dx
)) 1))
239 (round (+ (frame-ry parent
) (truncate (* (truncate (/ pos nx
)) dy
)) 1))
243 (defun set-tile-layout ()
244 "Tile child in its frame (vertical)"
245 (set-layout-managed-children)
246 (set-layout #'tile-layout
))
250 ;; Horizontal tiling layout
251 (defgeneric tile-horizontal-layout
(child parent
)
252 (:documentation
"Tile child in its frame (horizontal)"))
254 (defmethod tile-horizontal-layout (child parent
)
255 (let* ((managed-children (update-layout-managed-children child parent
))
256 (pos (child-position child managed-children
))
257 (len (length managed-children
))
258 (ny (ceiling (sqrt len
)))
259 (nx (ceiling (/ len ny
)))
260 (dx (/ (frame-rw parent
) nx
))
261 (dy (/ (frame-rh parent
) ny
))
262 (dpos (- (* nx ny
) len
))
266 (setf height
(* dy
(1+ dpos
)))
268 (values (round (+ (frame-rx parent
) (truncate (* (truncate (/ pos ny
)) dx
)) 1))
269 (round (+ (frame-ry parent
) (truncate (* (mod pos ny
) dy
)) 1))
271 (round (- height
2)))))
273 (defun set-tile-horizontal-layout ()
274 "Tile child in its frame (horizontal)"
275 (set-layout-managed-children)
276 (set-layout #'tile-horizontal-layout
))
281 (defgeneric one-column-layout
(child parent
)
282 (:documentation
"One column layout"))
284 (defmethod one-column-layout (child parent
)
285 (let* ((managed-children (update-layout-managed-children child parent
))
286 (pos (child-position child managed-children
))
287 (len (length managed-children
))
288 (dy (/ (frame-rh parent
) len
)))
289 (values (round (+ (frame-rx parent
) 1))
290 (round (+ (frame-ry parent
) (* pos dy
) 1))
291 (round (- (frame-rw parent
) 2))
294 (defun set-one-column-layout ()
296 (set-layout-managed-children)
297 (set-layout #'one-column-layout
))
301 (defgeneric one-line-layout
(child parent
)
302 (:documentation
"One line layout"))
304 (defmethod one-line-layout (child parent
)
305 (let* ((managed-children (update-layout-managed-children child parent
))
306 (pos (child-position child managed-children
))
307 (len (length managed-children
))
308 (dx (/ (frame-rw parent
) len
)))
309 (values (round (+ (frame-rx parent
) (* pos dx
) 1))
310 (round (+ (frame-ry parent
) 1))
312 (round (- (frame-rh parent
) 2)))))
314 (defun set-one-line-layout ()
316 (set-layout-managed-children)
317 (set-layout #'one-line-layout
))
324 (defun tile-space-layout (child parent
)
325 "Tile Space: tile child in its frame leaving spaces between them"
326 (with-slots (rx ry rw rh
) parent
327 (let* ((managed-children (update-layout-managed-children child parent
))
328 (pos (child-position child managed-children
))
329 (len (length managed-children
))
330 (n (ceiling (sqrt len
)))
332 (dy (/ rh
(ceiling (/ len n
))))
333 (size (or (frame-data-slot parent
:tile-space-size
) 0.1)))
334 (when (> size
0.5) (setf size
0.45))
335 (values (round (+ rx
(truncate (* (mod pos n
) dx
)) (* dx size
) 1))
336 (round (+ ry
(truncate (* (truncate (/ pos n
)) dy
)) (* dy size
) 1))
337 (round (- dx
(* dx size
2) 2))
338 (round (- dy
(* dy size
2) 2))))))
343 (defun set-tile-space-layout ()
344 "Tile Space: tile child in its frame leaving spaces between them"
345 (layout-ask-size "Space size in percent (%)" :tile-space-size
0.01)
346 (set-layout-managed-children)
347 (set-layout #'tile-space-layout
))
351 (register-layout-sub-menu 'frame-tile-layout-menu
"Frame tile layout menu"
352 '(("v" set-tile-layout
)
353 ("h" set-tile-horizontal-layout
)
354 ("c" set-one-column-layout
)
355 ("l" set-one-line-layout
)
356 ("s" set-tile-space-layout
)))
361 (defun tile-left-layout (child parent
)
362 "Tile Left: main child on left and others on right"
363 (with-slots (rx ry rw rh
) parent
364 (let* ((managed-children (get-managed-child parent
))
365 (pos (child-position child managed-children
))
366 (len (max (1- (length managed-children
)) 1))
368 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
369 (if (> (length managed-children
) 1)
373 (- (round (* rw size
)) 2)
375 (values (1+ (round (+ rx
(* rw size
))))
376 (1+ (round (+ ry
(* dy
(1- pos
)))))
377 (- (round (* rw
(- 1 size
))) 2)
379 (no-layout child parent
)))))
382 (defun set-tile-left-layout ()
383 "Tile Left: main child on left and others on right"
384 (layout-ask-size "Tile size in percent (%)" :tile-size
)
385 (set-layout #'tile-left-layout
))
390 (defun tile-right-layout (child parent
)
391 "Tile Right: main child on right and others on left"
392 (with-slots (rx ry rw rh
) parent
393 (let* ((managed-children (get-managed-child parent
))
394 (pos (child-position child managed-children
))
395 (len (max (1- (length managed-children
)) 1))
397 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
398 (if (> (length managed-children
) 1)
400 (values (1+ (round (+ rx
(* rw
(- 1 size
)))))
402 (- (round (* rw size
)) 2)
405 (1+ (round (+ ry
(* dy
(1- pos
)))))
406 (- (round (* rw
(- 1 size
))) 2)
408 (no-layout child parent
)))))
411 (defun set-tile-right-layout ()
412 "Tile Right: main child on right and others on left"
413 (layout-ask-size "Tile size in percent (%)" :tile-size
)
414 (set-layout #'tile-right-layout
))
422 (defun tile-top-layout (child parent
)
423 "Tile Top: main child on top and others on bottom"
424 (with-slots (rx ry rw rh
) parent
425 (let* ((managed-children (get-managed-child parent
))
426 (pos (child-position child managed-children
))
427 (len (max (1- (length managed-children
)) 1))
429 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
430 (if (> (length managed-children
) 1)
435 (- (round (* rh size
)) 2))
436 (values (1+ (round (+ rx
(* dx
(1- pos
)))))
437 (1+ (round (+ ry
(* rh size
))))
439 (- (round (* rh
(- 1 size
))) 2)))
440 (no-layout child parent
)))))
443 (defun set-tile-top-layout ()
444 "Tile Top: main child on top and others on bottom"
445 (layout-ask-size "Tile size in percent (%)" :tile-size
)
446 (set-layout #'tile-top-layout
))
452 (defun tile-bottom-layout (child parent
)
453 "Tile Bottom: main child on bottom and others on top"
454 (with-slots (rx ry rw rh
) parent
455 (let* ((managed-children (get-managed-child parent
))
456 (pos (child-position child managed-children
))
457 (len (max (1- (length managed-children
)) 1))
459 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
460 (if (> (length managed-children
) 1)
463 (1+ (round (+ ry
(* rh
(- 1 size
)))))
465 (- (round (* rh size
)) 2))
466 (values (1+ (round (+ rx
(* dx
(1- pos
)))))
469 (- (round (* rh
(- 1 size
))) 2)))
470 (no-layout child parent
)))))
474 (defun set-tile-bottom-layout ()
475 "Tile Bottom: main child on bottom and others on top"
476 (layout-ask-size "Tile size in percent (%)" :tile-size
)
477 (set-layout #'tile-bottom-layout
))
480 (register-layout-sub-menu 'frame-tile-dir-layout-menu
"Tile in one direction layout menu"
481 '(("l" set-tile-left-layout
)
482 ("r" set-tile-right-layout
)
483 ("t" set-tile-top-layout
)
484 ("b" set-tile-bottom-layout
)))
491 ;;; Left and space layout: like left layout but leave a space on the left
492 (defun layout-ask-space (msg slot
&optional
(default 100))
493 (when (frame-p *current-child
*)
494 (let ((new-space (or (query-number msg
(or (frame-data-slot *current-child
* slot
) default
)) default
)))
495 (setf (frame-data-slot *current-child
* slot
) new-space
))))
498 (defun tile-left-space-layout (child parent
)
499 "Tile Left Space: main child on left and others on right. Leave some space on the left."
500 (with-slots (rx ry rw rh
) parent
501 (let* ((managed-children (get-managed-child parent
))
502 (pos (child-position child managed-children
))
503 (len (max (1- (length managed-children
)) 1))
505 (size (or (frame-data-slot parent
:tile-size
) 0.8))
506 (space (or (frame-data-slot parent
:tile-left-space
) 100)))
507 (if (> (length managed-children
) 1)
509 (values (+ rx space
1)
511 (- (round (* rw size
)) 2 space
)
513 (values (1+ (round (+ rx
(* rw size
))))
514 (1+ (round (+ ry
(* dy
(1- pos
)))))
515 (- (round (* rw
(- 1 size
))) 2)
517 (multiple-value-bind (rnx rny rnw rnh
)
518 (no-layout child parent
)
519 (values (+ rnx space
)
525 (defun set-tile-left-space-layout ()
526 "Tile Left Space: main child on left and others on right. Leave some space on the left."
527 (layout-ask-size "Tile size in percent (%)" :tile-size
)
528 (layout-ask-space "Tile space" :tile-left-space
)
529 (set-layout #'tile-left-space-layout
))
531 (register-layout-sub-menu 'frame-tile-space-layout-menu
"Tile with some space on one side menu"
532 '(set-tile-left-space-layout))
537 ;;; Main windows layout - A possible GIMP layout
538 ;;; The windows in the main list are tiled on the frame
539 ;;; others windows are on one side of the frame.
540 (defun main-window-right-layout (child parent
)
541 "Main window right: Main windows on the right. Others on the left."
542 (with-slots (rx ry rw rh
) parent
543 (let* ((main-windows (frame-data-slot parent
:main-window-list
))
544 (len (length main-windows
))
545 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
547 (no-layout child parent
)
548 (if (child-member child main-windows
)
549 (let* ((dy (/ rh len
))
550 (pos (child-position child main-windows
)))
551 (values (1+ (round (+ rx
(* rw
(- 1 size
)))))
552 (1+ (round (+ ry
(* dy pos
))))
553 (- (round (* rw size
)) 2)
557 (- (round (* rw
(- 1 size
))) 2)
560 (defun set-main-window-right-layout ()
561 "Main window right: Main windows on the right. Others on the left."
562 (layout-ask-size "Split size in percent (%)" :tile-size
)
563 (set-layout #'main-window-right-layout
))
568 (defun main-window-left-layout (child parent
)
569 "Main window left: Main windows on the left. Others on the right."
570 (with-slots (rx ry rw rh
) parent
571 (let* ((main-windows (frame-data-slot parent
:main-window-list
))
572 (len (length main-windows
))
573 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
575 (no-layout child parent
)
576 (if (child-member child main-windows
)
577 (let* ((dy (/ rh len
))
578 (pos (child-position child main-windows
)))
580 (1+ (round (+ ry
(* dy pos
))))
581 (- (round (* rw size
)) 2)
583 (values (1+ (round (+ rx
(* rw size
))))
585 (- (round (* rw
(- 1 size
))) 2)
588 (defun set-main-window-left-layout ()
589 "Main window left: Main windows on the left. Others on the right."
590 (layout-ask-size "Split size in percent (%)" :tile-size
)
591 (set-layout #'main-window-left-layout
))
595 (defun main-window-top-layout (child parent
)
596 "Main window top: Main windows on the top. Others on the bottom."
597 (with-slots (rx ry rw rh
) parent
598 (let* ((main-windows (frame-data-slot parent
:main-window-list
))
599 (len (length main-windows
))
600 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
602 (no-layout child parent
)
603 (if (child-member child main-windows
)
604 (let* ((dx (/ rw len
))
605 (pos (child-position child main-windows
)))
606 (values (1+ (round (+ rx
(* dx pos
))))
609 (- (round (* rh size
)) 2)))
611 (1+ (round (+ ry
(* rh size
))))
613 (- (round (* rh
(- 1 size
))) 2)))))))
615 (defun set-main-window-top-layout ()
616 "Main window top: Main windows on the top. Others on the bottom."
617 (layout-ask-size "Split size in percent (%)" :tile-size
)
618 (set-layout #'main-window-top-layout
))
622 (defun main-window-bottom-layout (child parent
)
623 "Main window bottom: Main windows on the bottom. Others on the top."
624 (with-slots (rx ry rw rh
) parent
625 (let* ((main-windows (frame-data-slot parent
:main-window-list
))
626 (len (length main-windows
))
627 (size (or (frame-data-slot parent
:tile-size
) 0.8)))
629 (no-layout child parent
)
630 (if (child-member child main-windows
)
631 (let* ((dx (/ rw len
))
632 (pos (child-position child main-windows
)))
633 (values (1+ (round (+ rx
(* dx pos
))))
634 (1+ (round (+ ry
(* rh
(- 1 size
)))))
636 (- (round (* rh size
)) 2)))
640 (- (round (* rh
(- 1 size
))) 2)))))))
642 (defun set-main-window-bottom-layout ()
643 "Main window bottom: Main windows on the bottom. Others on the top."
644 (layout-ask-size "Split size in percent (%)" :tile-size
)
645 (set-layout #'main-window-bottom-layout
))
651 (defun add-in-main-window-list ()
652 "Add the current window in the main window list"
653 (when (frame-p *current-child
*)
655 (when (child-member window
(get-managed-child *current-child
*))
656 (pushnew window
(frame-data-slot *current-child
* :main-window-list
)))))
660 (defun remove-in-main-window-list ()
661 "Remove the current window from the main window list"
662 (when (frame-p *current-child
*)
664 (when (child-member window
(get-managed-child *current-child
*))
665 (setf (frame-data-slot *current-child
* :main-window-list
)
666 (child-remove window
(frame-data-slot *current-child
* :main-window-list
))))))
669 (defun clear-main-window-list ()
670 "Clear the main window list"
671 (when (frame-p *current-child
*)
672 (setf (frame-data-slot *current-child
* :main-window-list
) nil
))
678 (register-layout-sub-menu 'frame-main-window-layout-menu
"Main window layout menu"
679 '(("r" set-main-window-right-layout
)
680 ("l" set-main-window-left-layout
)
681 ("t" set-main-window-top-layout
)
682 ("b" set-main-window-bottom-layout
)
683 "-=- Actions on main windows list -=-"
684 ("a" add-in-main-window-list
)
685 ("v" remove-in-main-window-list
)
686 ("c" clear-main-window-list
)))
690 (defun select-next/previous-child-no-main-window
(fun-rotate)
691 "Select the next/previous child - Skip windows in main window list"
692 (when (frame-p *current-child
*)
693 (with-slots (child) *current-child
*
694 (let* ((main-windows (frame-data-slot *current-child
* :main-window-list
))
695 (to-skip?
(not (= (length main-windows
)
698 (setf child
(funcall fun-rotate child
))
700 (child-member (frame-selected-child *current-child
*) main-windows
))
702 (unselect-all-frames)
704 (show-all-children))))))
707 (defun select-next-child-no-main-window ()
708 "Select the next child - Skip windows in main window list"
709 (select-next/previous-child-no-main-window
#'rotate-list
))
711 (defun select-previous-child-no-main-window ()
712 "Select the previous child - Skip windows in main window list"
713 (select-next/previous-child-no-main-window
#'anti-rotate-list
))
716 (defun mouse-click-to-focus-and-move-no-main-window (window root-x root-y
)
717 "Move and focus the current frame or focus the current window parent.
718 Or do actions on corners - Skip windows in main window list"
719 (unless (do-corner-action root-x root-y
*corner-main-mode-left-button
*)
720 (if (and (frame-p *current-child
*)
721 (child-member window
(frame-data-slot *current-child
* :main-window-list
)))
722 (replay-button-event)
723 (mouse-click-to-focus-generic window root-x root-y
#'move-frame
))))
727 (defun set-gimp-layout ()
729 (when (frame-p *current-child
*)
730 ;; Note: There is no need to ungrab/grab keys because this
731 ;; is done when leaving the second mode.
732 (define-main-key ("F8" :mod-1
) 'add-in-main-window-list
)
733 (define-main-key ("F9" :mod-1
) 'remove-in-main-window-list
)
734 (define-main-key ("F10" :mod-1
) 'clear-main-window-list
)
735 (define-main-key ("Tab" :mod-1
) 'select-next-child-no-main-window
)
736 (define-main-key ("Tab" :mod-1
:shift
) 'select-previous-child-no-main-window
)
737 (define-main-mouse (1) 'mouse-click-to-focus-and-move-no-main-window
)
738 (setf (frame-data-slot *current-child
* :focus-policy-save
)
739 (frame-focus-policy *current-child
*))
740 (setf (frame-focus-policy *current-child
*) :sloppy
)
741 (setf (frame-data-slot *current-child
* :layout-save
)
742 (frame-layout *current-child
*))
743 ;; Set the default layout and leave the second mode.
744 (set-main-window-right-layout)))
747 (defun set-previous-layout ()
748 "Restore the previous layout"
749 (undefine-main-key ("F8" :mod-1
))
750 (undefine-main-key ("F9" :mod-1
))
751 (undefine-main-key ("F10" :mod-1
))
752 (define-main-key ("Tab" :mod-1
) 'select-next-child
)
753 (define-main-key ("Tab" :mod-1
:shift
) 'select-previous-child
)
754 (define-main-mouse (1) 'mouse-click-to-focus-and-move
)
755 (setf (frame-focus-policy *current-child
*)
756 (frame-data-slot *current-child
* :focus-policy-save
))
757 (setf (frame-layout *current-child
*)
758 (frame-data-slot *current-child
* :layout-save
))
762 (defun help-on-gimp-layout ()
763 "Help on the GIMP layout"
764 (info-mode `(("-=- Help on The GIMP layout -=-" ,*info-color-title
*)
766 "The GIMP layout is a main-window-layout with a sloppy focus policy."
767 "You can change the main windows direction with the layout menu."
769 "Press Alt+F8 to add a window to the main windows list."
770 "Press Alt+F9 to remove a window from the main windows list."
771 "Press Alt+F10 to clear the main windows list."
773 "You can select a main window with the right mouse button."
775 "Use the layout menu to restore the previous layout and keybinding."))
779 (register-layout-sub-menu 'frame-gimp-layout-menu
"The GIMP layout menu"
780 '(("g" set-gimp-layout
)
781 ("p" set-previous-layout
)
782 ("h" help-on-gimp-layout
)
783 "-=- Main window layout -=-"
784 ("r" set-main-window-right-layout
)
785 ("l" set-main-window-left-layout
)
786 ("t" set-main-window-top-layout
)
787 ("b" set-main-window-bottom-layout
)
788 "-=- Actions on main windows list -=-"
789 ("a" add-in-main-window-list
)
790 ("v" remove-in-main-window-list
)
791 ("c" clear-main-window-list
)))