1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: New window Hooks
7 ;;; Those hooks can be set for each frame to manage new window when they are
9 ;;; --------------------------------------------------------------------------
11 ;;; (C) 2005-2013 Philippe Brochard <pbrochard@common-lisp.net>
13 ;;; This program is free software; you can redistribute it and/or modify
14 ;;; it under the terms of the GNU General Public License as published by
15 ;;; the Free Software Foundation; either version 3 of the License, or
16 ;;; (at your option) any later version.
18 ;;; This program is distributed in the hope that it will be useful,
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;;; GNU General Public License for more details.
23 ;;; You should have received a copy of the GNU General Public License
24 ;;; along with this program; if not, write to the Free Software
25 ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
27 ;;; --------------------------------------------------------------------------
32 ;;; CONFIG - New window menu
34 ;;; To add a new window hook (nw-hook):
35 ;;; 1- define your own nw-hook
36 ;;; 2- Define a seter function for your new hook
37 ;;; 3- Register your new hook with register-nw-hook.
40 (defparameter *nw-hook-current-key
* (char-code #\a))
41 (defparameter *permanent-nw-hook-frames
* nil
)
44 (defun set-nw-hook (hook)
45 "Set the hook of the current child"
46 (let ((frame (if (xlib:window-p
(current-child))
47 (find-parent-frame (current-child))
49 (unless (or (child-member frame
*permanent-nw-hook-frames
*)
50 (child-original-root-p frame
))
51 (setf (frame-nw-hook frame
) hook
)
52 (leave-second-mode))))
54 (defun register-nw-hook (hook)
55 (add-menu-key 'frame-nw-hook-menu
(code-char *nw-hook-current-key
*) hook
)
56 (incf *nw-hook-current-key
*))
59 (defun default-window-placement (frame window
)
60 (if (managed-window-p window frame
)
61 (adapt-child-to-parent window frame
)
62 (place-window-from-hints window
)))
64 (defun leave-if-not-frame (child)
65 "Leave the child if it's not a frame"
66 (unless (frame-p child
)
68 (select-previous-level)))
70 (defun clear-nw-hook (frame)
71 "Clear the frame new window hook"
72 (unless (child-member frame
*permanent-nw-hook-frames
*)
73 (setf (frame-nw-hook frame
) nil
)))
76 (defun clear-all-nw-hooks ()
77 "Clear all new window hooks for all frames"
78 (with-all-frames (*root-frame
* frame
)
79 (clear-nw-hook frame
)))
82 (defun make-permanent-nw-hook-frame (frame)
83 "Prevent to add or delete a new window hook for this frame"
85 (push frame
*permanent-nw-hook-frames
*)))
88 ;;; Default frame new window hook
89 (defun default-frame-nw-hook (frame window
)
90 "Open the next window in the current frame"
91 (declare (ignore frame
))
92 (leave-if-not-frame (current-child))
93 (when (frame-p (current-child))
94 (pushnew window
(frame-child (current-child))))
95 (default-window-placement (current-child) window
)
98 (defun set-default-frame-nw-hook ()
99 "Open the next window in the current frame"
100 (set-nw-hook #'default-frame-nw-hook
))
102 (register-nw-hook 'set-default-frame-nw-hook
)
105 ;;; Open new window in current root hook
106 (defun open-in-current-root-nw-hook (frame window
)
107 "Open the next window in the current root"
108 (clear-nw-hook frame
)
109 (leave-if-not-frame (find-current-root))
110 (let ((root (find-current-root)))
111 (pushnew window
(frame-child root
))
112 (setf (current-child) (frame-selected-child root
))
113 (default-window-placement root window
))
116 (defun set-open-in-current-root-nw-hook ()
117 "Open the next window in the current root"
118 (set-nw-hook #'open-in-current-root-nw-hook
))
120 (register-nw-hook 'set-open-in-current-root-nw-hook
)
123 ;;; Open new window in a new frame in the current root hook
124 (defun open-in-new-frame-in-current-root-nw-hook (frame window
)
125 "Open the next window in a new frame in the current root"
126 (clear-nw-hook frame
)
127 (leave-if-not-frame (find-current-root))
128 (let ((new-frame (create-frame))
129 (root (find-current-root)))
130 (pushnew new-frame
(frame-child root
))
131 (pushnew window
(frame-child new-frame
))
132 (setf (current-child) new-frame
)
133 (default-window-placement new-frame window
))
136 (defun set-open-in-new-frame-in-current-root-nw-hook ()
137 "Open the next window in a new frame in the current root"
138 (set-nw-hook #'open-in-new-frame-in-current-root-nw-hook
))
140 (register-nw-hook 'set-open-in-new-frame-in-current-root-nw-hook
)
143 ;;; Open new window in a new frame in the root frame hook
144 (defun open-in-new-frame-in-root-frame-nw-hook (frame window
)
145 "Open the next window in a new frame in the root frame"
146 (clear-nw-hook frame
)
147 (let ((new-frame (create-frame))
148 (root (find-current-root)))
149 (pushnew new-frame
(frame-child root
))
150 (pushnew window
(frame-child new-frame
))
151 (switch-to-root-frame :show-later t
)
152 (setf (current-child) root
)
153 (set-layout-once #'tile-space-layout
)
154 (setf (current-child) new-frame
)
155 (default-window-placement new-frame window
))
158 (defun set-open-in-new-frame-in-root-frame-nw-hook ()
159 "Open the next window in a new frame in the root frame"
160 (set-nw-hook #'open-in-new-frame-in-root-frame-nw-hook
))
162 (register-nw-hook 'set-open-in-new-frame-in-root-frame-nw-hook
)
165 ;;; Open new window in a new frame in the parent frame hook
166 (defun open-in-new-frame-in-parent-frame-nw-hook (frame window
)
167 "Open the next window in a new frame in the parent frame"
168 (clear-nw-hook frame
)
169 (let ((new-frame (create-frame))
170 (parent (find-parent-frame frame
)))
172 (pushnew new-frame
(frame-child parent
))
173 (pushnew window
(frame-child new-frame
))
174 (change-root (find-root parent
) parent
)
175 (setf (current-child) parent
)
176 (set-layout-once #'tile-space-layout
)
177 (setf (current-child) new-frame
)
178 (default-window-placement new-frame window
)
179 (show-all-children t
)
183 (defun set-open-in-new-frame-in-parent-frame-nw-hook ()
184 "Open the next window in a new frame in the parent frame"
185 (set-nw-hook #'open-in-new-frame-in-parent-frame-nw-hook
))
187 (register-nw-hook 'set-open-in-new-frame-in-parent-frame-nw-hook
)
191 ;;; Open a new window but leave the focus on the current child
192 (defun leave-focus-frame-nw-hook (frame window
)
193 "Open the next window in the current frame and leave the focus on the current child"
194 (clear-nw-hook frame
)
195 (leave-if-not-frame (current-child))
196 (when (frame-p (current-child))
197 (with-slots (child) (current-child)
198 (pushnew window child
)
199 (setf child
(rotate-list child
))))
200 (default-window-placement (current-child) window
)
203 (defun set-leave-focus-frame-nw-hook ()
204 "Open the next window in the current frame and leave the focus on the current child"
205 (set-nw-hook #'leave-focus-frame-nw-hook
))
207 (register-nw-hook 'set-leave-focus-frame-nw-hook
)
213 (defun nw-hook-open-in-frame (window frame
)
214 (when (frame-p frame
)
215 (pushnew window
(frame-child frame
))
216 (unless (find-child-in-all-root frame
)
217 (change-root (find-root frame
) frame
))
218 (setf (current-child) frame
)
219 (focus-all-children window frame
)
220 (default-window-placement frame window
)
221 (show-all-children t
)
224 ;;; Open a new window in a named frame
225 (defun named-frame-nw-hook (frame window
)
226 (clear-nw-hook frame
)
227 (let* ((frame-name (ask-frame-name "Open the next window in frame named:"))
228 (new-frame (find-frame-by-name frame-name
)))
229 (nw-hook-open-in-frame window new-frame
))
232 (defun set-named-frame-nw-hook ()
233 "Open the next window in a named frame"
234 (set-nw-hook #'named-frame-nw-hook
))
236 (register-nw-hook 'set-named-frame-nw-hook
)
239 ;;; Open a new window in a numbered frame
240 (defun numbered-frame-nw-hook (frame window
)
241 (clear-nw-hook frame
)
242 (let ((new-frame (find-frame-by-number (query-number "Open a new frame in the group numbered:"))))
243 (nw-hook-open-in-frame window new-frame
))
246 (defun set-numbered-frame-nw-hook ()
247 "Open the next window in a numbered frame"
248 (set-nw-hook #'numbered-frame-nw-hook
))
250 (register-nw-hook 'set-numbered-frame-nw-hook
)
254 ;;; The frame absorb the new window if it match the nw-absorb-test
256 (defun absorb-window-nw-hook (frame window
)
257 (let ((absorb-nw-test (frame-data-slot frame
:nw-absorb-test
)))
258 (when (and absorb-nw-test
259 (funcall absorb-nw-test window
))
260 (pushnew window
(frame-child frame
))
261 (unless *in-process-existing-windows
*
262 (unless (find-child-in-all-root frame
)
263 (change-root (find-root frame
) frame
))
264 (setf (current-child) frame
)
265 (focus-all-children window frame
)
266 (default-window-placement frame window
)
267 (show-all-children t
))
268 (throw 'nw-hook-loop t
)))
271 (defun set-absorb-window-nw-hook ()
272 "Open the window in this frame if it match nw-absorb-test"
273 (set-nw-hook #'absorb-window-nw-hook
))
275 (register-nw-hook 'set-absorb-window-nw-hook
)
278 (defun nw-absorb-test-class (class-string)
280 (and (xlib:window-p c
)
281 (string-equal (xlib:get-wm-class c
) class-string
))))