[clfswm-cvs] r20 - clfswm
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Fri Mar 7 22:20:29 UTC 2008
Author: pbrochard
Date: Fri Mar 7 17:20:27 2008
New Revision: 20
Modified:
clfswm/bindings-second-mode.lisp
clfswm/bindings.lisp
clfswm/clfswm-internal.lisp
clfswm/clfswm-util.lisp
clfswm/clfswm.lisp
clfswm/xlib-util.lisp
Log:
Begining of mouse handling -> wheel mouse
Modified: clfswm/bindings-second-mode.lisp
==============================================================================
--- clfswm/bindings-second-mode.lisp (original)
+++ clfswm/bindings-second-mode.lisp Fri Mar 7 17:20:27 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 16:32:54 2008
+;;; #Date#: Fri Mar 7 23:14:21 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse for second mode
@@ -228,13 +228,54 @@
;;; Mouse action
-(defun sm-handle-click-to-focus (window root-x root-y)
+
+
+(defun sm-mouse-click-to-focus (window root-x root-y)
"Give the focus to the clicked child"
(declare (ignore window))
- (let ((win (find-child-under-mouse root-x root-y)))
- (handle-click-to-focus win root-x root-y)))
+ (let ((win (find-window-under-mouse root-x root-y)))
+ (mouse-click-to-focus win root-x root-y)))
+
+
+
+
+(defun sm-mouse-select-next-level (window root-x root-y)
+ "Select the next level in group"
+ (declare (ignore window root-x root-y))
+ (select-next-level))
+
+
+
+
+(defun sm-mouse-select-previous-level (window root-x root-y)
+ "Select the previous level in group"
+ (declare (ignore window root-x root-y))
+ (select-previous-level))
+
+
+
+(defun sm-mouse-enter-group (window root-x root-y)
+ "Enter in the selected group - ie make it the root group"
+ (declare (ignore window root-x root-y))
+ (enter-group))
+
+
+
+(defun sm-mouse-leave-group (window root-x root-y)
+ "Leave the selected group - ie make its father the root group"
+ (declare (ignore window root-x root-y))
+ (leave-group))
+
+
+
+
+(define-second-mouse (1) 'sm-mouse-click-to-focus)
+
+(define-second-mouse (4) 'sm-mouse-select-next-level)
+(define-second-mouse (5) 'sm-mouse-select-previous-level)
-(define-second-mouse (1) 'sm-handle-click-to-focus)
+(define-second-mouse (4 :mod-1) 'sm-mouse-enter-group)
+(define-second-mouse (5 :mod-1) 'sm-mouse-leave-group)
Modified: clfswm/bindings.lisp
==============================================================================
--- clfswm/bindings.lisp (original)
+++ clfswm/bindings.lisp Fri Mar 7 17:20:27 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 17:10:55 2008
+;;; #Date#: Fri Mar 7 22:58:01 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse
@@ -79,7 +79,7 @@
;;; Mouse actions
-(defun handle-click-to-focus (window root-x root-y)
+(defun mouse-click-to-focus (window root-x root-y)
"Focus the current group or the current window father"
(declare (ignore root-x root-y))
(let ((to-replay t)
@@ -99,7 +99,56 @@
(defun test-mouse-binding (window root-x root-y)
(dbg window root-x root-y))
-(define-main-mouse (1) 'handle-click-to-focus)
+
+
+(defun mouse-select-next-level (window root-x root-y)
+ "Select the next level in group"
+ (declare (ignore root-x root-y))
+ (let ((group (find-group-window window)))
+ (when (or group (xlib:window-equal window *root*))
+ (select-next-level))
+ (replay-button-event)))
+
+
+
+(defun mouse-select-previous-level (window root-x root-y)
+ "Select the previous level in group"
+ (declare (ignore root-x root-y))
+ (let ((group (find-group-window window)))
+ (when (or group (xlib:window-equal window *root*))
+ (select-previous-level))
+ (replay-button-event)))
+
+
+
+(defun mouse-enter-group (window root-x root-y)
+ "Enter in the selected group - ie make it the root group"
+ (declare (ignore root-x root-y))
+ (let ((group (find-group-window window)))
+ (when (or group (xlib:window-equal window *root*))
+ (enter-group))
+ (replay-button-event)))
+
+
+
+(defun mouse-leave-group (window root-x root-y)
+ "Leave the selected group - ie make its father the root group"
+ (declare (ignore root-x root-y))
+ (let ((group (find-group-window window)))
+ (when (or group (xlib:window-equal window *root*))
+ (leave-group))
+ (replay-button-event)))
+
+
+(define-main-mouse (1) 'mouse-click-to-focus)
+
+
+(define-main-mouse (4) 'mouse-select-next-level)
+(define-main-mouse (5) 'mouse-select-previous-level)
+
+(define-main-mouse (4 :mod-1) 'mouse-enter-group)
+(define-main-mouse (5 :mod-1) 'mouse-leave-group)
+
;;(define-main-mouse (1) 'handle-click-to-focus 'test-mouse-binding)
;;(define-main-mouse ('motion) 'test-mouse-binding)
Modified: clfswm/clfswm-internal.lisp
==============================================================================
--- clfswm/clfswm-internal.lisp (original)
+++ clfswm/clfswm-internal.lisp Fri Mar 7 17:20:27 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 16:58:18 2008
+;;; #Date#: Fri Mar 7 22:25:37 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -31,10 +31,11 @@
;;; Minimal hook
(defun call-hook (hook &optional args)
"Call a hook (a function, a symbol or a list of function)"
- (typecase hook
- (list (dolist (h hook)
- (apply 'call-hook (list h args))))
- (t (apply hook args))))
+ (when hook
+ (typecase hook
+ (cons (dolist (h hook)
+ (call-hook h args)))
+ (t (apply hook args)))))
@@ -590,17 +591,30 @@
+(defun place-window-from-hints (window)
+ "Place a window from its hints"
+ (let* ((hints (xlib:wm-normal-hints window))
+ (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
+ (min-height (or (and hints (xlib:wm-size-hints-min-height hints)) 0))
+ (max-width (or (and hints (xlib:wm-size-hints-max-width hints)) (xlib:drawable-width *root*)))
+ (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) (xlib:drawable-height *root*)))
+ (rwidth (or (and hints (or (xlib:wm-size-hints-width hints) (xlib:wm-size-hints-base-width hints)))
+ (xlib:drawable-width window)))
+ (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
+ (xlib:drawable-height window))))
+ (setf (xlib:drawable-width window) (min (max min-width rwidth) max-width)
+ (xlib:drawable-height window) (min (max min-height rheight) max-height))
+ (setf (xlib:drawable-x window) (truncate (+ (group-rx *current-child*) (/ (- (group-rw *current-child*) (xlib:drawable-width window)) 2)))
+ (xlib:drawable-y window) (truncate (+ (group-ry *current-child*) (/ (- (group-rh *current-child*) (xlib:drawable-height window)) 2))))))
+
+
(defun process-new-window (window)
"When a new window is created (or when we are scanning initial
windows), this function dresses the window up and gets it ready to be
managed."
- ;; Listen for events
- ;;(create-workspace-on-request)
- ;;(create-group-on-request)
- ;; PHIL: TODO: add a hook here
(with-xlib-protect
- (setf (xlib:window-event-mask window) *window-events*)
+ (setf (xlib:window-event-mask window) *window-events*)
(set-window-state window +normal-state+)
(setf (xlib:drawable-border-width window) (case (window-type window)
(:normal 1)
@@ -618,19 +632,7 @@
;;(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 (let* ((hints (xlib:wm-normal-hints window))
- (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
- (min-height (or (and hints (xlib:wm-size-hints-min-height hints)) 0))
- (max-width (or (and hints (xlib:wm-size-hints-max-width hints)) (xlib:drawable-width *root*)))
- (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) (xlib:drawable-height *root*)))
- (rwidth (or (and hints (or (xlib:wm-size-hints-width hints) (xlib:wm-size-hints-base-width hints)))
- (xlib:drawable-width window)))
- (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
- (xlib:drawable-height window))))
- (setf (xlib:drawable-width window) (min (max min-width rwidth) max-width)
- (xlib:drawable-height window) (min (max min-height rheight) max-height))
- (setf (xlib:drawable-x window) (truncate (+ (group-rx *current-child*) (/ (- (group-rw *current-child*) (xlib:drawable-width window)) 2)))
- (xlib:drawable-y window) (truncate (+ (group-ry *current-child*) (/ (- (group-rh *current-child*) (xlib:drawable-height window)) 2)))))))
+ (t (place-window-from-hints window)))
(netwm-add-in-client-list window)))
Modified: clfswm/clfswm-util.lisp
==============================================================================
--- clfswm/clfswm-util.lisp (original)
+++ clfswm/clfswm-util.lisp Fri Mar 7 17:20:27 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 15:26:18 2008
+;;; #Date#: Fri Mar 7 23:07:03 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility
@@ -110,27 +110,41 @@
(defun unhide-all-windows-in-current-child ()
"Unhide all hidden windows into the current child"
(with-xlib-protect
- (dolist (window (get-hidden-windows))
- (unhide-window window)
- (process-new-window window)
- (xlib:map-window window)))
+ (dolist (window (get-hidden-windows))
+ (unhide-window window)
+ (process-new-window window)
+ (xlib:map-window window)))
(show-all-childs))
-(defun find-child-under-mouse (x y)
+(defun find-window-under-mouse (x y)
"Return the child window under the mouse"
(with-xlib-protect
- (let ((win nil))
- (with-all-windows-groups (*current-root* child)
- (when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
- (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
- (setf win child))
- (when (and (<= (group-rx child) x (+ (group-rx child) (group-rw child)))
- (<= (group-ry child) y (+ (group-ry child) (group-rh child))))
- (setf win (group-window child))))
- win)))
+ (let ((win nil))
+ (with-all-windows-groups (*current-root* child)
+ (when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
+ (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
+ (setf win child))
+ (when (and (<= (group-rx child) x (+ (group-rx child) (group-rw child)))
+ (<= (group-ry child) y (+ (group-ry child) (group-rh child))))
+ (setf win (group-window child))))
+ win)))
+
+
+(defun find-child-under-mouse (x y)
+ "Return the child under the mouse"
+ (with-xlib-protect
+ (let ((ret nil))
+ (with-all-windows-groups (*current-root* child)
+ (when (and (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
+ (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
+ (setf ret child))
+ (when (and (<= (group-rx child) x (+ (group-rx child) (group-rw child)))
+ (<= (group-ry child) y (+ (group-ry child) (group-rh child))))
+ (setf ret child)))
+ ret)))
Modified: clfswm/clfswm.lisp
==============================================================================
--- clfswm/clfswm.lisp (original)
+++ clfswm/clfswm.lisp Fri Mar 7 17:20:27 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 16:57:45 2008
+;;; #Date#: Fri Mar 7 21:16:29 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -37,7 +37,7 @@
(funcall-key-from-code *main-keys* code state))
-;; PHIL: TODO: focus-policy par group
+;; PHIL: TODO: focus-policy by group
;; :click, :sloppy, :nofocus
(defun handle-button-press (&rest event-slots &key code state window root-x root-y &allow-other-keys)
(declare (ignore event-slots))
Modified: clfswm/xlib-util.lisp
==============================================================================
--- clfswm/xlib-util.lisp (original)
+++ clfswm/xlib-util.lisp Fri Mar 7 17:20:27 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 17:33:40 2008
+;;; #Date#: Fri Mar 7 21:18:17 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility functions
@@ -121,9 +121,10 @@
(defun unhide-window (window)
(when window
(with-xlib-protect
- (xlib:map-window window)
- (setf (window-state window) +normal-state+
- (xlib:window-event-mask window) *window-events*))))
+ (when (window-hidden-p window)
+ (xlib:map-window window)
+ (setf (window-state window) +normal-state+
+ (xlib:window-event-mask window) *window-events*)))))
More information about the clfswm-cvs
mailing list