[clfswm-cvs] r340 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Fri Oct 1 21:46:37 UTC 2010
Author: pbrochard
Date: Fri Oct 1 17:46:37 2010
New Revision: 340
Log:
src/clfswm-nw-hooks.lisp (absorb-window-nw-hook): Absorb new window hook: the frame absorb all new windows that match nw-absorb-test frame data slot.
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-nw-hooks.lisp
clfswm/src/package.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Fri Oct 1 17:46:37 2010
@@ -1,3 +1,9 @@
+2010-10-01 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-nw-hooks.lisp (absorb-window-nw-hook): Absorb new
+ window hook: the frame absorb all new windows that match
+ nw-absorb-test frame data slot.
+
2010-09-30 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-expose-mode.lisp (expose-create-window): Show window
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Fri Oct 1 17:46:37 2010
@@ -969,12 +969,12 @@
(defun do-all-frames-nw-hook (window)
"Call nw-hook of each frame."
- (let ((found nil))
- (with-all-frames (*root-frame* frame)
- (awhen (frame-nw-hook frame)
- (call-hook it (list frame window))
- (setf found t)))
- found))
+ (catch 'nw-hook-loop
+ (let ((found nil))
+ (with-all-frames (*root-frame* frame)
+ (awhen (frame-nw-hook frame)
+ (setf found (call-hook it (list frame window)))))
+ found)))
@@ -1005,6 +1005,7 @@
(defun process-existing-windows (screen)
"Windows present when clfswm starts up must be absorbed by clfswm."
+ (setf *in-process-existing-windows* t)
(let ((id-list nil)
(all-windows (get-all-windows)))
(dolist (win (xlib:query-tree (xlib:screen-root screen)))
@@ -1021,4 +1022,5 @@
(map-window win)
(raise-window win)
(pushnew (xlib:window-id win) id-list))))))
- (netwm-set-client-list id-list)))
+ (netwm-set-client-list id-list))
+ (setf *in-process-existing-windows* nil))
Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp (original)
+++ clfswm/src/clfswm-nw-hooks.lisp Fri Oct 1 17:46:37 2010
@@ -82,7 +82,8 @@
(leave-if-not-frame *current-child*)
(when (frame-p *current-child*)
(pushnew window (frame-child *current-child*)))
- (default-window-placement *current-child* window))
+ (default-window-placement *current-child* window)
+ t)
(defun set-default-frame-nw-hook ()
"Open the next window in the current frame"
@@ -98,7 +99,8 @@
(leave-if-not-frame *current-root*)
(pushnew window (frame-child *current-root*))
(setf *current-child* (frame-selected-child *current-root*))
- (default-window-placement *current-root* window))
+ (default-window-placement *current-root* window)
+ t)
(defun set-open-in-current-root-nw-hook ()
"Open the next window in the current root"
@@ -116,7 +118,8 @@
(pushnew new-frame (frame-child *current-root*))
(pushnew window (frame-child new-frame))
(setf *current-child* new-frame)
- (default-window-placement new-frame window)))
+ (default-window-placement new-frame window))
+ t)
(defun set-open-in-new-frame-in-current-root-nw-hook ()
"Open the next window in a new frame in the current root"
@@ -136,7 +139,8 @@
(setf *current-child* *current-root*)
(set-layout-once #'tile-space-layout)
(setf *current-child* new-frame)
- (default-window-placement new-frame window)))
+ (default-window-placement new-frame window))
+ t)
(defun set-open-in-new-frame-in-root-frame-nw-hook ()
"Open the next window in a new frame in the root frame"
@@ -160,7 +164,8 @@
(set-layout-once #'tile-space-layout)
(setf *current-child* new-frame)
(default-window-placement new-frame window)
- (show-all-children *current-root*))))
+ (show-all-children *current-root*)
+ t)))
(defun set-open-in-new-frame-in-parent-frame-nw-hook ()
@@ -180,7 +185,8 @@
(with-slots (child) *current-child*
(pushnew window child)
(setf child (rotate-list child))))
- (default-window-placement *current-child* window))
+ (default-window-placement *current-child* window)
+ t)
(defun set-leave-focus-frame-nw-hook ()
"Open the next window in the current frame and leave the focus on the current child"
@@ -201,14 +207,16 @@
(setf *current-child* frame)
(focus-all-children window frame)
(default-window-placement frame window)
- (show-all-children *current-root*)))
+ (show-all-children *current-root*)
+ t))
;;; Open a new window in a named frame
(defun named-frame-nw-hook (frame window)
(clear-nw-hook frame)
(let* ((frame-name (ask-frame-name "Open the next window in frame named:"))
(new-frame (find-frame-by-name frame-name)))
- (nw-hook-open-in-frame window new-frame)))
+ (nw-hook-open-in-frame window new-frame))
+ t)
(defun set-named-frame-nw-hook ()
"Open the next window in a named frame"
@@ -221,7 +229,8 @@
(defun numbered-frame-nw-hook (frame window)
(clear-nw-hook frame)
(let ((new-frame (find-frame-by-number (query-number "Open a new frame in the group numbered:"))))
- (nw-hook-open-in-frame window new-frame)))
+ (nw-hook-open-in-frame window new-frame))
+ t)
(defun set-numbered-frame-nw-hook ()
"Open the next window in a numbered frame"
@@ -229,3 +238,35 @@
(register-nw-hook 'set-numbered-frame-nw-hook)
+
+;;; Absorb window.
+;;; The frame absorb the new window if it match the absorb-nw-test
+;;; frame data slot.
+(defun absorb-window-nw-hook (frame window)
+ (let ((absorb-nw-test (frame-data-slot frame :nw-absorb-test)))
+ (when (and absorb-nw-test
+ (funcall absorb-nw-test window))
+ (pushnew window (frame-child frame))
+ (unless *in-process-existing-windows*
+ (unless (find-child frame *current-root*)
+ (hide-all *current-root*)
+ (setf *current-root* frame))
+ (setf *current-child* frame)
+ (focus-all-children window frame)
+ (default-window-placement frame window)
+ (show-all-children *current-root*))
+ (throw 'nw-hook-loop t)))
+ nil)
+
+(defun set-absorb-window-nw-hook ()
+ "Open the window in this frame if it match absorb-nw-test"
+ (set-nw-hook #'absorb-window-nw-hook))
+
+(register-nw-hook 'set-absorb-window-nw-hook)
+
+
+(defun nw-absorb-test-class (class-string)
+ (lambda (c)
+ (and (xlib:window-p c)
+ (string-equal (xlib:get-wm-class c) class-string))))
+
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Fri Oct 1 17:46:37 2010
@@ -211,6 +211,7 @@
+(defparameter *in-process-existing-windows* nil)
;; For debug - redefine defun
;;(shadow :defun)
More information about the clfswm-cvs
mailing list