[clfswm-cvs] r46 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Sun Mar 16 14:57:27 UTC 2008
Author: pbrochard
Date: Sun Mar 16 09:57:22 2008
New Revision: 46
Modified:
clfswm/ChangeLog
clfswm/src/bindings-second-mode.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-nw-hooks.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/package.lisp
Log:
Register system for new window hooks. Bind control+o to open the next window in a new group in the root group (as open in next window in a new workspace in 0801 version).
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sun Mar 16 09:57:22 2008
@@ -1,3 +1,9 @@
+2008-03-16 Philippe Brochard <hocwp at free.fr>
+
+ * src/clfswm-nw-hooks.lisp: Register system for new window hooks.
+ Bind control+o to open the next window in a new group in the root group
+ (as open in next window in a new workspace in 0801 version).
+
2008-03-15 Philippe Brochard <hocwp at free.fr>
* src/clfswm-util.lisp (show/hide-all-groups-info/key): Show/hide all groups info
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Sun Mar 16 09:57:22 2008
@@ -49,6 +49,12 @@
for i from 0
collect (list (code-char (+ (char-code #\a) i)) l))))
+(defun group-nw-hook-menu ()
+ "Group new window hook menu"
+ (info-mode-menu (loop for l in *nw-hook-list*
+ for i from 0
+ collect (list (code-char (+ (char-code #\a) i)) l))))
+
@@ -99,13 +105,21 @@
(#\c copy-current-child-by-number))))
+(defun group-info-menu ()
+ "Group information menu"
+ (info-mode-menu '((#\s show-all-groups-info)
+ (#\h hide-all-groups-info))))
+
+
(defun group-menu ()
"Group menu"
(info-mode-menu '((#\a group-adding-menu)
(#\l group-layout-menu)
+ (#\n group-nw-hook-menu)
(#\m group-movement-menu)
(#\r rename-current-child)
- (#\n renumber-current-group))))
+ (#\u renumber-current-group)
+ (#\i group-info-menu))))
(defun window-menu ()
"Window menu"
@@ -191,6 +205,8 @@
(define-second-key (#\b :mod-1) 'banish-pointer)
+(define-second-key (#\o) 'set-open-in-new-group-in-root-group-nw-hook)
+
;;;; Escape
(define-second-key ("Escape" :control :shift) 'delete-focus-window)
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Sun Mar 16 09:57:22 2008
@@ -612,45 +612,32 @@
-(defun default-group-nw-hook (window)
- (when (xlib:window-p *current-child*)
- (leave-group)
- (select-previous-level))
- ;;(unless (eql (window-type window) :maxsize) ;; PHIL: this is sufficient for the ROX panel
- (when (group-p *current-child*)
- (pushnew window (group-child *current-child*))) ;)
- ;;(dbg (xlib:wm-name window) (xlib:get-wm-class window) (window-type window)) ;;; PHIL
- (case (window-type window)
- (:normal (adapt-child-to-father window *current-child*))
- (t (place-window-from-hints window))))
-
-
-(defun open-in-new-group-nw-hook (group window)
- (declare (ignore group))
- (pushnew window (group-child *current-root*))
- ;;(dbg (xlib:wm-name window) (xlib:get-wm-class window) (window-type window)) ;;; PHIL
- (case (window-type window)
- (:normal (adapt-child-to-father window *current-root*))
- (t (place-window-from-hints window)))
- (list t nil))
-
-
+;;(defun do-all-groups-nw-hook (window)
+;; "Call nw-hook of each group. A hook must return one value or a list of two values.
+;;If the value or the first value is true then the default nw-hook is not executed.
+;;If the second value is true then no more group can do an action with the window (ie leave the loop)."
+;; (let ((result nil))
+;; (with-all-groups (*root-group* group)
+;; (let ((ret (call-hook (group-nw-hook group) (list group window))))
+;; (typecase ret
+;; (cons (when (first ret)
+;; (setf result t))
+;; (when (second ret)
+;; (return-from do-all-groups-nw-hook result)))
+;; (t (when ret
+;; (setf result t))))))
+;; result))
(defun do-all-groups-nw-hook (window)
- "Call nw-hook of each group. A hook must return one value or a list of two values.
-If the value or the first value is true then the default nw-hook is not executed.
-If the second value is true then no more group can do an action with the window (ie leave the loop)."
- (let ((result nil))
+ "Call nw-hook of each group."
+ (let ((found nil))
(with-all-groups (*root-group* group)
- (let ((ret (call-hook (group-nw-hook group) (list group window))))
- (typecase ret
- (cons (when (first ret)
- (setf result t))
- (when (second ret)
- (return-from do-all-groups-nw-hook result)))
- (t (when ret
- (setf result t))))))
- result))
+ (awhen (group-nw-hook group)
+ (call-hook it (list group window))
+ (setf found t)))
+ found))
+
+
(defun process-new-window (window)
"When a new window is created (or when we are scanning initial
@@ -668,7 +655,7 @@
;; (when (group-p *current-child*) ;; PHIL: Remove this!!!
;; (setf (group-nw-hook *current-child*) #'open-in-new-group-nw-hook))
(unless (do-all-groups-nw-hook window)
- (default-group-nw-hook window))
+ (default-group-nw-hook nil window))
(unhide-window window)
(netwm-add-in-client-list window)))
Modified: clfswm/src/clfswm-nw-hooks.lisp
==============================================================================
--- clfswm/src/clfswm-nw-hooks.lisp (original)
+++ clfswm/src/clfswm-nw-hooks.lisp Sun Mar 16 09:57:22 2008
@@ -28,4 +28,104 @@
(in-package :clfswm)
-;;; TODO: fill this file.
+
+;;; CONFIG - New window menu
+;;;
+;;; To add a new window hook (nw-hook):
+;;; 1- define your own nw-hook
+;;; 2- Define a seter function for your new hook
+;;; 3- Register your new hook with register-nw-hook.
+
+
+
+(defun set-nw-hook (hook)
+ "Set the hook of the current child"
+ (let ((group (if (xlib:window-p *current-child*)
+ (find-father-group *current-child*)
+ *current-child*)))
+ (setf (group-nw-hook group) hook)
+ (leave-second-mode)))
+
+(defun register-nw-hook (hook)
+ (setf *nw-hook-list* (append *nw-hook-list* (list hook))))
+
+
+(defun default-window-placement (group window)
+ (case (window-type window)
+ (:normal (adapt-child-to-father window group))
+ (t (place-window-from-hints window))))
+
+(defun leave-if-not-group (child)
+ "Leave the child if it's not a group"
+ (when (xlib:window-p child)
+ (leave-group)
+ (select-previous-level)))
+
+
+
+;;; Default group new window hook
+(defun default-group-nw-hook (group window)
+ "Open the next window in the current group"
+ (declare (ignore group))
+ (leave-if-not-group *current-child*)
+ (when (group-p *current-child*)
+ (pushnew window (group-child *current-child*))) ;)
+ (default-window-placement *current-child* window))
+
+(defun set-default-group-nw-hook ()
+ "Open the next window in the current group"
+ (set-nw-hook #'default-group-nw-hook))
+
+(register-nw-hook 'set-default-group-nw-hook)
+
+
+;;; Open new window in current root hook
+(defun open-in-current-root-nw-hook (group window)
+ "Open the next window in the current root"
+ (leave-if-not-group *current-root*)
+ (pushnew window (group-child *current-root*))
+ (setf *current-child* (first (group-child *current-root*)))
+ (default-window-placement *current-root* window)
+ (setf (group-nw-hook group) nil))
+
+(defun set-open-in-current-root-nw-hook ()
+ "Open the next window in the current root"
+ (set-nw-hook #'open-in-current-root-nw-hook))
+
+(register-nw-hook 'set-open-in-current-root-nw-hook)
+
+
+;;; Open new window in a new group in the current root hook
+(defun open-in-new-group-in-current-root-nw-hook (group window)
+ "Open the next window in a new group in the current root"
+ (leave-if-not-group *current-root*)
+ (let ((new-group (create-group)))
+ (pushnew new-group (group-child *current-root*))
+ (pushnew window (group-child new-group))
+ (setf *current-child* new-group)
+ (default-window-placement new-group window))
+ (setf (group-nw-hook group) nil))
+
+(defun set-open-in-new-group-in-current-root-nw-hook ()
+ "Open the next window in a new group in the current root"
+ (set-nw-hook #'open-in-new-group-in-current-root-nw-hook))
+
+(register-nw-hook 'set-open-in-new-group-in-current-root-nw-hook)
+
+
+;;; Open new window in a new group in the root group hook
+(defun open-in-new-group-in-root-group-nw-hook (group window)
+ "Open the next window in a new group in the root group"
+ (let ((new-group (create-group)))
+ (pushnew new-group (group-child *root-group*))
+ (pushnew window (group-child new-group))
+ (switch-to-root-group)
+ (setf *current-child* new-group)
+ (default-window-placement new-group window))
+ (setf (group-nw-hook group) nil))
+
+(defun set-open-in-new-group-in-root-group-nw-hook ()
+ "Open the next window in a new group in the root group"
+ (set-nw-hook #'open-in-new-group-in-root-group-nw-hook))
+
+(register-nw-hook 'set-open-in-new-group-in-root-group-nw-hook)
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Sun Mar 16 09:57:22 2008
@@ -465,21 +465,22 @@
;;; Show group info
(defun show-all-groups-info ()
"Show all groups info windows"
- (with-all-groups (*current-root* group)
- (raise-window (group-window group))
- (display-group-info group)))
+ (let ((*show-root-group-p* t))
+ (show-all-childs)
+ (with-all-groups (*current-root* group)
+ (raise-window (group-window group))
+ (display-group-info group))))
(defun hide-all-groups-info ()
"Hide all groups info windows"
(with-all-windows (*current-root* window)
(raise-window window))
+ (hide-child *current-root*)
(show-all-childs))
(defun show-all-groups-info-key ()
"Show all groups info windows until a key is release"
- (with-all-groups (*current-root* group)
- (raise-window (group-window group))
- (display-group-info group))
+ (show-all-groups-info)
(wait-no-key-or-button-press)
(hide-all-groups-info))
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Sun Mar 16 09:57:22 2008
@@ -49,6 +49,7 @@
(defparameter *child-selection* nil)
(defparameter *layout-list* nil)
+(defparameter *nw-hook-list* nil)
;;(defstruct group (number (incf *current-group-number*)) name
More information about the clfswm-cvs
mailing list