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) 2010 Philippe Brochard <hocwp@free.fr>
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))
43 (defun set-nw-hook (hook)
44 "Set the hook of the current child"
45 (let ((frame (if (xlib:window-p
*current-child
*)
46 (find-parent-frame *current-child
*)
48 (setf (frame-nw-hook frame
) hook
)
51 (defun register-nw-hook (hook)
52 (add-menu-key 'frame-nw-hook-menu
(code-char *nw-hook-current-key
*) hook
)
53 (incf *nw-hook-current-key
*))
56 (defun default-window-placement (frame window
)
57 (if (managed-window-p window frame
)
58 (adapt-child-to-parent window frame
)
59 (place-window-from-hints window
)))
61 (defun leave-if-not-frame (child)
62 "Leave the child if it's not a frame"
63 (when (xlib:window-p child
)
65 (select-previous-level)))
67 (defun clear-nw-hook (frame)
68 "Clear the frame new window hook"
69 (setf (frame-nw-hook frame
) nil
))
71 (defun clear-all-nw-hooks ()
72 "Clear all new window hooks for all frames"
73 (with-all-frames (*root-frame
* frame
)
74 (clear-nw-hook frame
)))
78 ;;; Default frame new window hook
79 (defun default-frame-nw-hook (frame window
)
80 "Open the next window in the current frame"
81 (declare (ignore frame
))
82 (leave-if-not-frame *current-child
*)
83 (when (frame-p *current-child
*)
84 (pushnew window
(frame-child *current-child
*)))
85 (default-window-placement *current-child
* window
)
88 (defun set-default-frame-nw-hook ()
89 "Open the next window in the current frame"
90 (set-nw-hook #'default-frame-nw-hook
))
92 (register-nw-hook 'set-default-frame-nw-hook
)
95 ;;; Open new window in current root hook
96 (defun open-in-current-root-nw-hook (frame window
)
97 "Open the next window in the current root"
99 (leave-if-not-frame *current-root
*)
100 (pushnew window
(frame-child *current-root
*))
101 (setf *current-child
* (frame-selected-child *current-root
*))
102 (default-window-placement *current-root
* window
)
105 (defun set-open-in-current-root-nw-hook ()
106 "Open the next window in the current root"
107 (set-nw-hook #'open-in-current-root-nw-hook
))
109 (register-nw-hook 'set-open-in-current-root-nw-hook
)
112 ;;; Open new window in a new frame in the current root hook
113 (defun open-in-new-frame-in-current-root-nw-hook (frame window
)
114 "Open the next window in a new frame in the current root"
115 (clear-nw-hook frame
)
116 (leave-if-not-frame *current-root
*)
117 (let ((new-frame (create-frame)))
118 (pushnew new-frame
(frame-child *current-root
*))
119 (pushnew window
(frame-child new-frame
))
120 (setf *current-child
* new-frame
)
121 (default-window-placement new-frame window
))
124 (defun set-open-in-new-frame-in-current-root-nw-hook ()
125 "Open the next window in a new frame in the current root"
126 (set-nw-hook #'open-in-new-frame-in-current-root-nw-hook
))
128 (register-nw-hook 'set-open-in-new-frame-in-current-root-nw-hook
)
131 ;;; Open new window in a new frame in the root frame hook
132 (defun open-in-new-frame-in-root-frame-nw-hook (frame window
)
133 "Open the next window in a new frame in the root frame"
134 (clear-nw-hook frame
)
135 (let ((new-frame (create-frame)))
136 (pushnew new-frame
(frame-child *root-frame
*))
137 (pushnew window
(frame-child new-frame
))
138 (switch-to-root-frame :show-later t
)
139 (setf *current-child
* *current-root
*)
140 (set-layout-once #'tile-space-layout
)
141 (setf *current-child
* new-frame
)
142 (default-window-placement new-frame window
))
145 (defun set-open-in-new-frame-in-root-frame-nw-hook ()
146 "Open the next window in a new frame in the root frame"
147 (set-nw-hook #'open-in-new-frame-in-root-frame-nw-hook
))
149 (register-nw-hook 'set-open-in-new-frame-in-root-frame-nw-hook
)
152 ;;; Open new window in a new frame in the parent frame hook
153 (defun open-in-new-frame-in-parent-frame-nw-hook (frame window
)
154 "Open the next window in a new frame in the parent frame"
155 (clear-nw-hook frame
)
156 (let ((new-frame (create-frame))
157 (parent (find-parent-frame frame
)))
159 (pushnew new-frame
(frame-child parent
))
160 (pushnew window
(frame-child new-frame
))
161 (hide-all *current-root
*)
162 (setf *current-root
* parent
163 *current-child
* parent
)
164 (set-layout-once #'tile-space-layout
)
165 (setf *current-child
* new-frame
)
166 (default-window-placement new-frame window
)
167 (show-all-children *current-root
*)
171 (defun set-open-in-new-frame-in-parent-frame-nw-hook ()
172 "Open the next window in a new frame in the parent frame"
173 (set-nw-hook #'open-in-new-frame-in-parent-frame-nw-hook
))
175 (register-nw-hook 'set-open-in-new-frame-in-parent-frame-nw-hook
)
179 ;;; Open a new window but leave the focus on the current child
180 (defun leave-focus-frame-nw-hook (frame window
)
181 "Open the next window in the current frame and leave the focus on the current child"
182 (clear-nw-hook frame
)
183 (leave-if-not-frame *current-child
*)
184 (when (frame-p *current-child
*)
185 (with-slots (child) *current-child
*
186 (pushnew window child
)
187 (setf child
(rotate-list child
))))
188 (default-window-placement *current-child
* window
)
191 (defun set-leave-focus-frame-nw-hook ()
192 "Open the next window in the current frame and leave the focus on the current child"
193 (set-nw-hook #'leave-focus-frame-nw-hook
))
195 (register-nw-hook 'set-leave-focus-frame-nw-hook
)
201 (defun nw-hook-open-in-frame (window frame
)
202 (when (frame-p frame
)
203 (pushnew window
(frame-child frame
))
204 (unless (find-child frame
*current-root
*)
205 (hide-all *current-root
*)
206 (setf *current-root
* frame
))
207 (setf *current-child
* frame
)
208 (focus-all-children window frame
)
209 (default-window-placement frame window
)
210 (show-all-children *current-root
*)
213 ;;; Open a new window in a named frame
214 (defun named-frame-nw-hook (frame window
)
215 (clear-nw-hook frame
)
216 (let* ((frame-name (ask-frame-name "Open the next window in frame named:"))
217 (new-frame (find-frame-by-name frame-name
)))
218 (nw-hook-open-in-frame window new-frame
))
221 (defun set-named-frame-nw-hook ()
222 "Open the next window in a named frame"
223 (set-nw-hook #'named-frame-nw-hook
))
225 (register-nw-hook 'set-named-frame-nw-hook
)
228 ;;; Open a new window in a numbered frame
229 (defun numbered-frame-nw-hook (frame window
)
230 (clear-nw-hook frame
)
231 (let ((new-frame (find-frame-by-number (query-number "Open a new frame in the group numbered:"))))
232 (nw-hook-open-in-frame window new-frame
))
235 (defun set-numbered-frame-nw-hook ()
236 "Open the next window in a numbered frame"
237 (set-nw-hook #'numbered-frame-nw-hook
))
239 (register-nw-hook 'set-numbered-frame-nw-hook
)
243 ;;; The frame absorb the new window if it match the absorb-nw-test
245 (defun absorb-window-nw-hook (frame window
)
246 (let ((absorb-nw-test (frame-data-slot frame
:nw-absorb-test
)))
247 (when (and absorb-nw-test
248 (funcall absorb-nw-test window
))
249 (pushnew window
(frame-child frame
))
250 (unless *in-process-existing-windows
*
251 (unless (find-child frame
*current-root
*)
252 (hide-all *current-root
*)
253 (setf *current-root
* frame
))
254 (setf *current-child
* frame
)
255 (focus-all-children window frame
)
256 (default-window-placement frame window
)
257 (show-all-children *current-root
*))
258 (throw 'nw-hook-loop t
)))
261 (defun set-absorb-window-nw-hook ()
262 "Open the window in this frame if it match absorb-nw-test"
263 (set-nw-hook #'absorb-window-nw-hook
))
265 (register-nw-hook 'set-absorb-window-nw-hook
)
268 (defun nw-absorb-test-class (class-string)
270 (and (xlib:window-p c
)
271 (string-equal (xlib:get-wm-class c
) class-string
))))