1 ;;; --------------------------------------------------------------------------
2 ;;; CLFSWM - FullScreen Window Manager
4 ;;; --------------------------------------------------------------------------
5 ;;; Documentation: Main 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 ;;; --------------------------------------------------------------------------
30 ;;; Conversion functions
31 ;;; Float -> Pixel conversion
32 (defun x-fl->px
(x parent
)
33 "Convert float X coordinate to pixel"
34 (round (+ (* x
(frame-rw parent
)) (frame-rx parent
))))
36 (defun y-fl->px
(y parent
)
37 "Convert float Y coordinate to pixel"
38 (round (+ (* y
(frame-rh parent
)) (frame-ry parent
))))
40 (defun w-fl->px
(w parent
)
41 "Convert float Width coordinate to pixel"
42 (round (* w
(frame-rw parent
))))
44 (defun h-fl->px
(h parent
)
45 "Convert float Height coordinate to pixel"
46 (round (* h
(frame-rh parent
))))
48 ;;; Pixel -> Float conversion
49 (defun x-px->fl
(x parent
)
50 "Convert pixel X coordinate to float"
51 (/ (- x
(frame-rx parent
)) (frame-rw parent
)))
53 (defun y-px->fl
(y parent
)
54 "Convert pixel Y coordinate to float"
55 (/ (- y
(frame-ry parent
)) (frame-rh parent
)))
57 (defun w-px->fl
(w parent
)
58 "Convert pixel Width coordinate to float"
59 (/ w
(frame-rw parent
)))
61 (defun h-px->fl
(h parent
)
62 "Convert pixel Height coordinate to float"
63 (/ h
(frame-rh parent
)))
68 (defgeneric frame-p
(frame))
69 (defmethod frame-p ((frame frame
))
70 (declare (ignore frame
))
72 (defmethod frame-p (frame)
73 (declare (ignore frame
))
80 (defun frame-selected-child (frame)
82 (with-slots (child selected-pos
) frame
83 (let ((len (length child
)))
84 (cond ((minusp selected-pos
) (setf selected-pos
0))
85 ((>= selected-pos len
) (setf selected-pos
(max (1- len
) 0)))))
86 (nth selected-pos child
))))
91 ;;; Frame data manipulation functions
92 (defun frame-data-slot (frame slot
)
93 "Return the value associated to data slot"
95 (second (assoc slot
(frame-data frame
)))))
97 (defun set-frame-data-slot (frame slot value
)
98 "Set the value associated to data slot"
100 (with-slots (data) frame
101 (setf data
(remove (assoc slot data
) data
))
102 (push (list slot value
) data
))
105 (defsetf frame-data-slot set-frame-data-slot
)
108 (defun managed-window-p (window frame
)
109 "Return t only if window is managed by frame"
111 (with-slots ((managed forced-managed-window
)
112 (unmanaged forced-unmanaged-window
)) frame
113 (and (not (member window unmanaged
))
114 (not (member (xlib:wm-name window
) unmanaged
:test
#'string-equal-p
))
115 (or (member :all
(frame-managed-type frame
))
116 (member (window-type window
) (frame-managed-type frame
))
117 (member window managed
)
118 (member (xlib:wm-name window
) managed
:test
#'string-equal-p
))))
122 (defun never-managed-window-p (window)
123 (dolist (type *never-managed-window-list
*)
124 (when (string-equal (funcall (first type
) window
) (second type
))
131 (defgeneric child-name
(child))
133 (defmethod child-name ((child xlib
:window
))
134 (xlib:wm-name child
))
136 (defmethod child-name ((child frame
))
139 (defmethod child-name (child)
140 (declare (ignore child
))
144 (defgeneric set-child-name
(child name
))
146 (defmethod set-child-name ((child xlib
:window
) name
)
147 (setf (xlib:wm-name child
) name
))
149 (defmethod set-child-name ((child frame
) name
)
150 (setf (frame-name child
) name
))
152 (defmethod set-child-name (child name
)
153 (declare (ignore child name
)))
155 (defsetf child-name set-child-name
)
160 (defgeneric child-fullname
(child))
162 (defmethod child-fullname ((child xlib
:window
))
163 (format nil
"~A (~A)" (or (xlib:wm-name child
) "?") (or (xlib:get-wm-class child
) "?")))
165 (defmethod child-fullname ((child frame
))
166 (aif (frame-name child
)
167 (format nil
"~A (Frame ~A)" it
(frame-number child
))
168 (format nil
"Frame ~A" (frame-number child
))))
170 (defmethod child-fullname (child)
171 (declare (ignore child
))
177 (defgeneric rename-child
(child name
))
179 (defmethod rename-child ((child frame
) name
)
180 (setf (frame-name child
) name
)
181 (display-frame-info child
))
183 (defmethod rename-child ((child xlib
:window
) name
)
184 (setf (xlib:wm-name child
) name
))
186 (defmethod rename-child (child name
)
187 (declare (ignore child name
)))
191 ;; (with-all-children (*root-frame* child) (typecase child (xlib:window (print child)) (frame (print (frame-number child)))))
192 (defmacro with-all-children
((root child
) &body body
)
194 (sub-child (gensym)))
195 `(labels ((,rec
(,child
)
197 (when (frame-p ,child
)
198 (dolist (,sub-child
(reverse (frame-child ,child
)))
199 (,rec
,sub-child
)))))
203 ;; (with-all-frames (*root-frame* frame) (print (frame-number frame)))
204 (defmacro with-all-frames
((root frame
) &body body
)
207 `(labels ((,rec
(,frame
)
208 (when (frame-p ,frame
)
210 (dolist (,child
(reverse (frame-child ,frame
)))
215 ;; (with-all-windows (*root-frame* window) (print window))
216 (defmacro with-all-windows
((root window
) &body body
)
219 `(labels ((,rec
(,window
)
220 (when (xlib:window-p
,window
)
222 (when (frame-p ,window
)
223 (dolist (,child
(reverse (frame-child ,window
)))
229 ;; (with-all-frames-windows (*root-frame* child) (print child) (print (frame-number child)))
230 (defmacro with-all-windows-frames
((root child
) body-window body-frame
)
232 (sub-child (gensym)))
233 `(labels ((,rec
(,child
)
235 (xlib:window
,body-window
)
237 (dolist (,sub-child
(reverse (frame-child ,child
)))
238 (,rec
,sub-child
))))))
241 (defmacro with-all-windows-frames-and-parent
((root child parent
) body-window body-frame
)
243 (sub-child (gensym)))
244 `(labels ((,rec
(,child
,parent
)
246 (xlib:window
,body-window
)
248 (dolist (,sub-child
(reverse (frame-child ,child
)))
249 (,rec
,sub-child
,child
))))))
254 (defun frame-find-free-number ()
255 (let ((all-numbers nil
))
256 (with-all-frames (*root-frame
* frame
)
257 (pushnew (frame-number frame
) all-numbers
))
258 (find-free-number all-numbers
)))
261 (defun create-frame (&rest args
&key
(number (frame-find-free-number)) &allow-other-keys
)
262 (let* ((window (xlib:create-window
:parent
*root
*
267 :background
(get-color *frame-background
*)
268 :colormap
(xlib:screen-default-colormap
*screen
*)
270 :border
(get-color *color-selected
*)
271 :event-mask
'(:exposure
:button-press
:button-release
:pointer-motion
:enter-window
)))
272 (gc (xlib:create-gcontext
:drawable window
273 :foreground
(get-color *frame-foreground
*)
274 :background
(get-color *frame-background
*)
276 :line-style
:solid
)))
277 (apply #'make-instance
'frame
:number number
:window window
:gc gc args
)))
283 (defun add-frame (frame parent
)
284 (push frame
(frame-child parent
))
288 (defun place-frame (frame parent prx pry prw prh
)
289 "Place a frame from real (pixel) coordinates"
290 (when (and (frame-p frame
) (frame-p parent
))
291 (with-slots (window x y w h
) frame
292 (setf (xlib:drawable-x window
) prx
293 (xlib:drawable-y window
) pry
294 (xlib:drawable-width window
) prw
295 (xlib:drawable-height window
) prh
296 x
(x-px->fl prx parent
)
297 y
(y-px->fl pry parent
)
298 w
(w-px->fl prw parent
)
299 h
(h-px->fl prh parent
)))))
301 (defun fixe-real-size (frame parent
)
302 "Fixe real (pixel) coordinates in float coordinates"
303 (when (frame-p frame
)
304 (with-slots (x y w h rx ry rw rh
) frame
305 (setf x
(x-px->fl rx parent
)
306 y
(y-px->fl ry parent
)
307 w
(w-px->fl rw parent
)
308 h
(h-px->fl rh parent
)))))
310 (defun fixe-real-size-current-child ()
311 "Fixe real (pixel) coordinates in float coordinates for children in the current child"
312 (when (frame-p *current-child
*)
313 (dolist (child (frame-child *current-child
*))
314 (fixe-real-size child
*current-child
*))))
319 (defun find-child (to-find root
)
320 "Find to-find in root or in its children"
321 (with-all-children (root child
)
322 (when (equal child to-find
)
323 (return-from find-child t
))))
327 (defmacro with-find-in-all-frames
(test &optional return-value
)
330 (with-all-frames (root frame
)
333 (return-from return-block
(or ,return-value frame
))
335 (or ,return-value ret
))))
337 (defun find-parent-frame (to-find &optional
(root *root-frame
*) first-foundp
)
338 "Return the parent frame of to-find"
339 (with-find-in-all-frames
340 (member to-find
(frame-child frame
))))
342 (defun find-frame-window (window &optional
(root *root-frame
*) first-foundp
)
343 "Return the frame with the window window"
344 (with-find-in-all-frames
345 (xlib:window-equal window
(frame-window frame
))))
347 (defun find-frame-by-name (name &optional
(root *root-frame
*) first-foundp
)
348 "Find a frame from its name"
350 (with-find-in-all-frames
351 (string-equal name
(frame-name frame
)))))
353 (defun find-frame-by-number (number &optional
(root *root-frame
*) first-foundp
)
354 "Find a frame from its number"
355 (when (numberp number
)
356 (with-find-in-all-frames
357 (= number
(frame-number frame
)))))
360 (defun find-child-in-parent (child base
)
361 "Return t if child is in base or in its parents"
363 (when (equal child base
)
364 (return-from find-child-in-parent t
))
365 (let ((parent (find-parent-frame base
)))
373 (defun get-all-windows (&optional
(root *root-frame
*))
374 "Return all windows in root and in its children"
376 (with-all-windows (root window
)
381 (defun get-hidden-windows ()
382 "Return all hiddens windows"
383 (let ((all-windows (get-all-windows))
384 (hidden-windows (remove-if-not #'window-hidden-p
385 (copy-list (xlib:query-tree
*root
*)))))
386 (set-difference hidden-windows all-windows
)))
390 ;;; Current window utilities
391 (defun get-current-window ()
392 (typecase *current-child
*
393 (xlib:window
*current-child
*)
394 (frame (frame-selected-child *current-child
*))))
396 (defmacro with-current-window
(&body body
)
397 "Bind 'window' to the current window"
398 `(let ((window (get-current-window)))
399 (when (xlib:window-p window
)
406 (defun display-frame-info (frame)
407 (let ((dy (+ (xlib:max-char-ascent
*default-font
*) (xlib:max-char-descent
*default-font
*))))
408 (with-slots (name number gc window child hidden-children
) frame
409 (setf (xlib:gcontext-background gc
) (get-color *frame-background
*)
410 (xlib:window-background window
) (get-color *frame-background
*))
411 (clear-pixmap-buffer window gc
)
412 (setf (xlib:gcontext-foreground gc
) (get-color (if (and (equal frame
*current-root
*)
413 (equal frame
*current-child
*))
414 *frame-foreground-root
* *frame-foreground
*)))
415 (xlib:draw-glyphs
*pixmap-buffer
* gc
5 dy
416 (format nil
"Frame: ~A~A"
418 (if name
(format nil
" - ~A" name
) "")))
420 (when (equal frame
*current-root
*)
421 (xlib:draw-glyphs
*pixmap-buffer
* gc
5 (incf pos dy
)
422 (format nil
"~A hidden windows" (length (get-hidden-windows))))
423 (when *child-selection
*
424 (xlib:draw-glyphs
*pixmap-buffer
* gc
5 (incf pos dy
)
425 (with-output-to-string (str)
426 (format str
"Selection: ")
427 (dolist (child *child-selection
*)
429 (xlib:window
(format str
"~A " (xlib:wm-name child
)))
430 (frame (format str
"frame:~A[~A] " (frame-number child
)
431 (aif (frame-name child
) it
"")))))))))
433 (xlib:draw-glyphs
*pixmap-buffer
* gc
5 (incf pos dy
) (ensure-printable (child-fullname ch
))))
434 (setf (xlib:gcontext-foreground gc
) (get-color *frame-foreground-hidden
*))
435 (dolist (ch hidden-children
)
436 (xlib:draw-glyphs
*pixmap-buffer
* gc
5 (incf pos dy
)
437 (format nil
"~A - hidden" (ensure-printable (child-fullname ch
))))))
438 (copy-pixmap-buffer window gc
))))
441 (defun display-all-frame-info (&optional
(root *current-root
*))
442 (with-all-frames (root frame
)
443 (display-frame-info frame
)))
449 (defun get-parent-layout (child parent
)
451 (aif (frame-layout parent
)
452 (funcall it child parent
)
453 (no-layout child parent
))
454 (get-fullscreen-size)))
458 (defgeneric adapt-child-to-parent
(child parent
))
460 (defmethod adapt-child-to-parent ((window xlib
:window
) parent
)
462 (when (managed-window-p window parent
)
463 (multiple-value-bind (nx ny nw nh
)
464 (get-parent-layout window parent
)
465 (setf nw
(max nw
1) nh
(max nh
1))
466 (let ((change (or (/= (xlib:drawable-x window
) nx
)
467 (/= (xlib:drawable-y window
) ny
)
468 (/= (xlib:drawable-width window
) nw
)
469 (/= (xlib:drawable-height window
) nh
))))
470 (setf (xlib:drawable-x window
) nx
471 (xlib:drawable-y window
) ny
472 (xlib:drawable-width window
) nw
473 (xlib:drawable-height window
) nh
)
474 (xlib:display-finish-output
*display
*)
478 (defmethod adapt-child-to-parent ((frame frame
) parent
)
480 (multiple-value-bind (nx ny nw nh
)
481 (get-parent-layout frame parent
)
482 (with-slots (rx ry rw rh window
) frame
486 (let ((change (or (/= (xlib:drawable-x window
) rx
)
487 (/= (xlib:drawable-y window
) ry
)
488 (/= (xlib:drawable-width window
) rw
)
489 (/= (xlib:drawable-height window
) rh
))))
490 (setf (xlib:drawable-x window
) rx
491 (xlib:drawable-y window
) ry
492 (xlib:drawable-width window
) rw
493 (xlib:drawable-height window
) rh
)
494 (xlib:display-finish-output
*display
*)
497 (defmethod adapt-child-to-parent (child parent
)
498 (declare (ignore child parent
))
504 (defgeneric show-child
(child parent raise-p
))
506 (defmethod show-child ((frame frame
) parent raise-p
)
507 (declare (ignore parent
))
509 (with-slots (window show-window-p
) frame
511 (when (or *show-root-frame-p
* (not (equal frame
*current-root
*)))
512 (setf (xlib:window-background window
) (get-color "Black"))
514 (when raise-p
(raise-window window
)))
515 (hide-window window
)))
516 (display-frame-info frame
)))
519 (defmethod show-child ((window xlib
:window
) parent raise-p
)
521 (if (or (managed-window-p window parent
)
522 (equal parent
*current-child
*))
525 (when raise-p
(raise-window window
)))
526 (hide-window window
))))
528 (defmethod show-child (child parent raise-p
)
529 (declare (ignore child parent raise-p
))
533 (defgeneric hide-child
(child))
535 (defmethod hide-child ((frame frame
))
537 (with-slots (window) frame
538 (xlib:unmap-window window
))))
540 (defmethod hide-child ((window xlib
:window
))
541 (hide-window window
))
543 (defmethod hide-child (child)
544 (declare (ignore child
))
550 (defgeneric child-coordinates
(child))
552 (defmethod child-coordinates ((frame frame
))
553 (values (frame-rx frame
)
555 (+ (frame-rx frame
) (frame-rw frame
))
556 (+ (frame-ry frame
) (frame-rh frame
))))
558 (defmethod child-coordinates ((window xlib
:window
))
559 (values (xlib:drawable-x window
)
560 (xlib:drawable-y window
)
561 (+ (xlib:drawable-x window
) (xlib:drawable-width window
))
562 (+ (xlib:drawable-y window
) (xlib:drawable-height window
))))
564 (defmethod child-coordinates (child)
565 (declare (ignore child
))
570 (defgeneric select-child
(child selected
))
572 (defmethod select-child ((frame frame
) selected
)
574 (when (and (frame-p frame
) (frame-window frame
))
575 (setf (xlib:window-border
(frame-window frame
))
576 (get-color (cond ((equal selected
:maybe
) *color-maybe-selected
*)
577 ((equal selected nil
) *color-unselected
*)
578 (selected *color-selected
*)))))))
580 (defmethod select-child ((window xlib
:window
) selected
)
582 (setf (xlib:window-border window
)
583 (get-color (cond ((equal selected
:maybe
) *color-maybe-selected
*)
584 ((equal selected nil
) *color-unselected
*)
585 (selected *color-selected
*))))))
587 (defmethod select-child (child selected
)
588 (declare (ignore child selected
))
591 (defun select-current-frame (selected)
592 (select-child *current-child
* selected
))
594 (defun unselect-all-frames ()
595 (with-all-children (*current-root
* child
)
596 (select-child child nil
)))
600 (defun set-focus-to-current-child ()
601 (labels ((rec (child)
603 (xlib:window
(focus-window child
))
604 (frame (rec (frame-selected-child child
))))))
606 (rec *current-child
*)))
611 (defun raise-p-list (children)
615 (multiple-value-bind (xo1 yo1 xo2 yo2
)
616 (child-coordinates (first list
))
617 (push (dolist (c (rest list
) t
)
618 (multiple-value-bind (x1 y1 x2 y2
)
619 (child-coordinates c
)
620 (when (and (<= x1 xo1
)
632 (defun show-all-children (&optional
(display-child *current-child
*))
633 "Show all children from *current-root*. Start the effective display
634 only for display-child and its children"
635 (let ((geometry-change nil
))
636 (labels ((rec-geom (root parent selected-p selected-parent-p
)
637 (when (adapt-child-to-parent root parent
)
638 (setf geometry-change t
))
639 (select-child root
(cond ((equal root
*current-child
*) t
)
640 ((and selected-p selected-parent-p
) :maybe
)
643 (let ((selected-child (frame-selected-child root
)))
644 (dolist (child (reverse (frame-child root
)))
645 (rec-geom child root
(equal child selected-child
) (and selected-p selected-parent-p
))))))
646 (rec (root parent raise-p
)
647 (show-child root parent raise-p
)
649 (let ((reversed-children (reverse (frame-child root
))))
650 (loop for child in reversed-children
651 for raise-p in
(raise-p-list reversed-children
)
652 do
(rec child root raise-p
))))))
653 (rec-geom *current-root
* nil t t
)
654 (rec display-child nil nil
)
655 (set-focus-to-current-child)
660 (defun hide-all-children (root)
661 "Hide all root children"
663 (dolist (child (frame-child root
))
666 (defun hide-all (root)
667 "Hide root and all its children"
669 (hide-all-children root
))
675 (defun focus-child (child parent
)
676 "Focus child - Return true if something has change"
677 (when (and (frame-p parent
)
678 (member child
(frame-child parent
)))
679 (when (not (equal child
(frame-selected-child parent
)))
680 (with-slots ((parent-child child
) selected-pos
) parent
681 (setf parent-child
(nth-insert selected-pos child
(remove child parent-child
))))
684 (defun focus-child-rec (child parent
)
685 "Focus child and its parents - Return true if something has change"
687 (labels ((rec (child parent
)
688 (when (focus-child child parent
)
691 (rec parent
(find-parent-frame parent
)))))
696 (defun set-current-child-generic (child)
697 (unless (equal *current-child
* child
)
698 (setf *current-child
* child
)
701 (defgeneric set-current-child
(child parent window-parent
))
703 (defmethod set-current-child ((child xlib
:window
) parent window-parent
)
704 (set-current-child-generic (if window-parent parent child
)))
706 (defmethod set-current-child ((child frame
) parent window-parent
)
707 (declare (ignore parent window-parent
))
708 (set-current-child-generic child
))
710 (defmethod set-current-child (child parent window-parent
)
711 (declare (ignore child parent window-parent
))
715 (defun set-current-root (parent)
716 "Set current root if parent is not in current root"
717 (unless (find-child parent
*current-root
*)
718 (setf *current-root
* parent
)))
721 (defun focus-all-children (child parent
&optional
(window-parent t
))
722 "Focus child and its parents -
723 For window: set current child to window or its parent according to window-parent"
724 (let ((new-focus (focus-child-rec child parent
))
725 (new-current-child (set-current-child child parent window-parent
))
726 (new-root (set-current-root parent
)))
727 (or new-focus new-current-child new-root
)))
732 (defun select-next-level ()
733 "Select the next level in frame"
734 (select-current-frame :maybe
)
735 (when (frame-p *current-child
*)
736 (awhen (frame-selected-child *current-child
*)
737 (setf *current-child
* it
)))
740 (defun select-previous-level ()
741 "Select the previous level in frame"
742 (unless (equal *current-child
* *current-root
*)
743 (select-current-frame :maybe
)
744 (awhen (find-parent-frame *current-child
*)
745 (setf *current-child
* it
))
746 (show-all-children)))
750 (defun enter-frame ()
751 "Enter in the selected frame - ie make it the root frame"
752 (hide-all *current-root
*)
753 (setf *current-root
* *current-child
*)
754 (show-all-children *current-root
*))
756 (defun leave-frame ()
757 "Leave the selected frame - ie make its parent the root frame"
758 (hide-all *current-root
*)
759 (awhen (find-parent-frame *current-root
*)
761 (setf *current-root
* it
)))
762 (show-all-children *current-root
*))
765 ;;; Other actions (select-next-child, select-next-brother...) are in
766 ;;; clfswm-circulate-mode.lisp
770 (defun frame-lower-child ()
771 "Lower the child in the current frame"
772 (when (frame-p *current-child
*)
773 (with-slots (child selected-pos
) *current-child
*
774 (unless (>= selected-pos
(length child
))
775 (when (nth (1+ selected-pos
) child
)
776 (rotatef (nth selected-pos child
)
777 (nth (1+ selected-pos
) child
)))
778 (incf selected-pos
)))
779 (show-all-children)))
782 (defun frame-raise-child ()
783 "Raise the child in the current frame"
784 (when (frame-p *current-child
*)
785 (with-slots (child selected-pos
) *current-child
*
786 (unless (< selected-pos
1)
787 (when (nth (1- selected-pos
) child
)
788 (rotatef (nth selected-pos child
)
789 (nth (1- selected-pos
) child
)))
790 (decf selected-pos
)))
791 (show-all-children)))
794 (defun switch-to-root-frame (&key
(show-later nil
))
795 "Switch to the root frame"
796 (hide-all *current-root
*)
797 (setf *current-root
* *root-frame
*)
799 (show-all-children *current-root
*)))
801 (defun switch-and-select-root-frame (&key
(show-later nil
))
802 "Switch and select the root frame"
803 (hide-all *current-root
*)
804 (setf *current-root
* *root-frame
*)
805 (setf *current-child
* *current-root
*)
807 (show-all-children *current-root
*)))
810 (defun toggle-show-root-frame ()
811 "Show/Hide the root frame"
812 (hide-all *current-root
*)
813 (setf *show-root-frame-p
* (not *show-root-frame-p
*))
814 (show-all-children *current-root
*))
817 (defun remove-child-in-frame (child frame
)
818 "Remove the child in frame"
819 (when (frame-p frame
)
820 (setf (frame-child frame
) (remove child
(frame-child frame
) :test
#'equal
))))
822 (defun remove-child-in-frames (child root
)
823 "Remove child in the frame root and in all its children"
824 (with-all-frames (root frame
)
825 (remove-child-in-frame child frame
)))
828 (defun remove-child-in-all-frames (child)
829 "Remove child in all frames from *root-frame*"
830 (when (equal child
*current-root
*)
831 (setf *current-root
* (find-parent-frame child
)))
832 (when (equal child
*current-child
*)
833 (setf *current-child
* *current-root
*))
834 (remove-child-in-frames child
*root-frame
*))
837 (defun delete-child-in-frames (child root
)
838 "Delete child in the frame root and in all its children
839 Warning:frame window and gc are freeed."
840 (with-all-frames (root frame
)
841 (remove-child-in-frame child frame
)
842 (unless (find-frame-window (frame-window frame
))
843 (awhen (frame-gc frame
) (xlib:free-gcontext it
) (setf it nil
))
844 (awhen (frame-window frame
) (xlib:destroy-window it
) (setf it nil
))))
845 (when (xlib:window-p child
)
846 (netwm-remove-in-client-list child
)))
849 (defun delete-child-in-all-frames (child)
850 "Delete child in all frames from *root-frame*"
851 (when (equal child
*current-root
*)
852 (setf *current-root
* (find-parent-frame child
)))
853 (when (equal child
*current-child
*)
854 (setf *current-child
* *current-root
*))
855 (delete-child-in-frames child
*root-frame
*))
858 (defun delete-child-and-children-in-frames (child root
&optional
(close-methode 'delete-window
))
859 "Delete child and its children in the frame root and in all its children
860 Warning:frame window and gc are freeed."
861 (when (and (frame-p child
) (frame-child child
))
862 (dolist (ch (frame-child child
))
863 (delete-child-and-children-in-frames ch root close-methode
)))
864 (delete-child-in-frames child root
)
865 (when (xlib:window-p child
)
866 (funcall close-methode child
)))
868 (defun delete-child-and-children-in-all-frames (child &optional
(close-methode 'delete-window
))
869 "Delete child and its children in all frames from *root-frame*"
870 (when (equal child
*current-root
*)
871 (setf *current-root
* (find-parent-frame child
)))
872 (when (equal child
*current-child
*)
873 (setf *current-child
* *current-root
*))
874 (delete-child-and-children-in-frames child
*root-frame
* close-methode
))
878 (defun place-window-from-hints (window)
879 "Place a window from its hints"
881 (let* ((hints (xlib:wm-normal-hints window
))
882 (min-width (or (and hints
(xlib:wm-size-hints-min-width hints
)) 0))
883 (min-height (or (and hints
(xlib:wm-size-hints-min-height hints
)) 0))
884 (max-width (or (and hints
(xlib:wm-size-hints-max-width hints
)) (xlib:drawable-width
*root
*)))
885 (max-height (or (and hints
(xlib:wm-size-hints-max-height hints
)) (xlib:drawable-height
*root
*)))
886 (rwidth (or (and hints
(or (xlib:wm-size-hints-width hints
) (xlib:wm-size-hints-base-width hints
)))
887 (xlib:drawable-width window
)))
888 (rheight (or (and hints
(or (xlib:wm-size-hints-height hints
) (xlib:wm-size-hints-base-height hints
)))
889 (xlib:drawable-height window
))))
890 (setf (xlib:drawable-width window
) (min (max min-width rwidth
*default-window-width
*) max-width
)
891 (xlib:drawable-height window
) (min (max min-height rheight
*default-window-height
*) max-height
))
892 (setf (xlib:drawable-x window
) (truncate (/ (- (xlib:screen-width
*screen
*) (+ (xlib:drawable-width window
) 2)) 2))
893 (xlib:drawable-y window
) (truncate (/ (- (xlib:screen-height
*screen
*) (+ (xlib:drawable-height window
) 2)) 2))))))
897 (defun do-all-frames-nw-hook (window)
898 "Call nw-hook of each frame."
900 (with-all-frames (*root-frame
* frame
)
901 (awhen (frame-nw-hook frame
)
902 (call-hook it
(list frame window
))
908 (defun process-new-window (window)
909 "When a new window is created (or when we are scanning initial
910 windows), this function dresses the window up and gets it ready to be
913 (setf (xlib:window-event-mask window
) *window-events
*)
914 (set-window-state window
+normal-state
+)
915 (setf (xlib:drawable-border-width window
) (case (window-type window
)
920 (grab-all-buttons window
)
921 (unless (never-managed-window-p window
)
922 (unless (do-all-frames-nw-hook window
)
923 (call-hook *default-nw-hook
* (list *root-frame
* window
))))
924 (netwm-add-in-client-list window
)))
929 (defun hide-existing-windows (screen)
930 "Hide all existing windows in screen"
931 (dolist (win (xlib:query-tree
(xlib:screen-root screen
)))
934 (defun process-existing-windows (screen)
935 "Windows present when clfswm starts up must be absorbed by clfswm."
937 (all-windows (get-all-windows)))
938 (dolist (win (xlib:query-tree
(xlib:screen-root screen
)))
939 (unless (member win all-windows
)
940 (let ((map-state (xlib:window-map-state win
))
941 (wm-state (window-state win
)))
942 (unless (or (eql (xlib:window-override-redirect win
) :on
)
943 (eql win
*no-focus-window
*))
944 (when (or (eql map-state
:viewable
)
945 (eql wm-state
+iconic-state
+))
946 (format t
"Processing ~S: type=~A ~S~%" (xlib:wm-name win
) (window-type win
) win
)
948 (process-new-window win
)
951 (pushnew (xlib:window-id win
) id-list
))))))
952 (netwm-set-client-list id-list
)))