[clfswm-cvs] r342 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Sat Oct 2 21:51:31 UTC 2010
Author: pbrochard
Date: Sat Oct 2 17:51:31 2010
New Revision: 342
Log:
src/clfswm-circulate-mode.lisp (select-next-subchild): Add the possibility to circulate over subchild of the current child.
Modified:
clfswm/ChangeLog
clfswm/src/bindings-second-mode.lisp
clfswm/src/bindings.lisp
clfswm/src/clfswm-circulate-mode.lisp
clfswm/src/clfswm-expose-mode.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sat Oct 2 17:51:31 2010
@@ -1,5 +1,12 @@
2010-10-02 Philippe Brochard <pbrochard at common-lisp.net>
+ * src/clfswm-circulate-mode.lisp (select-next-subchild): Add the
+ possibility to circulate over subchild of the current child.
+
+ * src/clfswm-expose-mode.lisp (expose-all-windows-mode)
+ (expose-windows-generic): Add an escape-body function to return to
+ the original state on escape key.
+
* src/clfswm-util.lisp (bind-on-slot): Add an optional parameter
to bind the current child from the configuration file.
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Sat Oct 2 17:51:31 2010
@@ -115,7 +115,8 @@
(define-second-key ("Tab" :mod-1) 'select-next-child)
(define-second-key ("Tab" :mod-1 :shift) 'select-previous-child)
- (define-second-key (#\Tab :shift) 'switch-to-last-child)
+ (define-second-key ("Tab" :mod-1 :control) 'select-next-subchild)
+ (define-second-key ("Tab" :shift) 'switch-to-last-child)
(define-second-key ("Return" :mod-1) 'enter-frame)
(define-second-key ("Return" :mod-1 :shift) 'leave-frame)
(define-second-key ("Return" :mod-5) 'frame-toggle-maximize)
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Sat Oct 2 17:51:31 2010
@@ -50,6 +50,7 @@
(define-main-key ("Up" :mod-1) 'select-next-level)
(define-main-key ("Tab" :mod-1) 'select-next-child)
(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
+ (define-main-key ("Tab" :mod-1 :control) 'select-next-subchild)
(define-main-key ("Tab" :shift) 'switch-to-last-child)
(define-main-key ("Return" :mod-1) 'enter-frame)
(define-main-key ("Return" :mod-1 :shift) 'leave-frame)
Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp (original)
+++ clfswm/src/clfswm-circulate-mode.lisp Sat Oct 2 17:51:31 2010
@@ -103,6 +103,18 @@
(find-parent-frame *current-child*)))
(draw-circulate-mode-window)))
+(defun reorder-subchild (direction)
+ (declare (ignore direction))
+ (when (frame-p *current-child*)
+ (let ((selected-child (frame-selected-child *current-child*)))
+ (when (frame-p selected-child)
+ (no-focus)
+ (with-slots (child) selected-child
+ (let ((elem (first (last child))))
+ (setf child (nconc (list elem) (child-remove elem child)))
+ (show-all-children)
+ (draw-circulate-mode-window)))))))
+
@@ -134,6 +146,10 @@
(reset-circulate-brother))
(reorder-brother -1))
+(defun circulate-select-next-subchild ()
+ "Select the next subchild"
+ (reorder-subchild +1))
+
(add-hook *binding-hook* 'set-default-circulate-keys)
@@ -144,11 +160,13 @@
(define-circulate-key ("Escape" :alt) 'leave-circulate-mode)
(define-circulate-key ("g" :control :alt) 'leave-circulate-mode)
(define-circulate-key ("Tab" :mod-1) 'circulate-select-next-child)
+ (define-circulate-key ("Tab" :mod-1 :control) 'circulate-select-next-subchild)
(define-circulate-key ("Tab" :mod-1 :shift) 'circulate-select-previous-child)
(define-circulate-key ("Iso_Left_Tab" :mod-1 :shift) 'circulate-select-previous-child)
(define-circulate-key ("Right" :mod-1) 'circulate-select-next-brother)
(define-circulate-key ("Left" :mod-1) 'circulate-select-previous-brother)
- (define-circulate-release-key ("Alt_L" :alt) 'leave-circulate-mode))
+ (define-circulate-release-key ("Alt_L" :alt) 'leave-circulate-mode)
+ (define-circulate-release-key ("Alt_L") 'leave-circulate-mode))
(defun circulate-leave-function ()
@@ -180,7 +198,7 @@
-(defun circulate-mode (&key child-direction brother-direction)
+(defun circulate-mode (&key child-direction brother-direction subchild-direction)
(setf *circulate-hit* 0)
(with-placement (*circulate-mode-placement* x y *circulate-width* *circulate-height*)
(setf *circulate-font* (xlib:open-font *display* *circulate-font-string*)
@@ -205,6 +223,8 @@
(reorder-child child-direction))
(when brother-direction
(reorder-brother brother-direction))
+ (when subchild-direction
+ (reorder-subchild subchild-direction))
(let ((grab-keyboard-p (xgrab-keyboard-p))
(grab-pointer-p (xgrab-pointer-p)))
(xgrab-pointer *root* 92 93)
@@ -253,3 +273,10 @@
(setf *circulate-orig* (frame-child *circulate-parent*)))
(circulate-mode :brother-direction -1))
+(defun select-next-subchild ()
+ "Select the next subchild"
+ (when (and (frame-p *current-child*)
+ (frame-p (frame-selected-child *current-child*)))
+ (setf *circulate-orig* (frame-child *current-child*)
+ *circulate-parent* nil)
+ (circulate-mode :subchild-direction +1)))
Modified: clfswm/src/clfswm-expose-mode.lisp
==============================================================================
--- clfswm/src/clfswm-expose-mode.lisp (original)
+++ clfswm/src/clfswm-expose-mode.lisp Sat Oct 2 17:51:31 2010
@@ -142,7 +142,7 @@
(expose-draw-letter))
-(defun expose-windows-generic (first-restore-frame body)
+(defun expose-windows-generic (first-restore-frame &optional body body-escape)
(setf *expose-font* (xlib:open-font *display* *expose-font-string*)
*expose-windows-list* nil)
(xlib:warp-pointer *root* (truncate (/ (xlib:screen-width *screen*) 2))
@@ -158,14 +158,15 @@
(unless grab-keyboard-p
(ungrab-main-keys)
(xgrab-keyboard *root*))
- (when (generic-mode 'expose-mode 'exit-expose-loop
- :original-mode '(main-mode))
- (multiple-value-bind (x y) (xlib:query-pointer *root*)
- (let* ((child (find-child-under-mouse x y))
- (parent (find-parent-frame child *root-frame*)))
- (when (and child parent)
- (pfuncall body parent)
- (focus-all-children child parent)))))
+ (if (generic-mode 'expose-mode 'exit-expose-loop
+ :original-mode '(main-mode))
+ (multiple-value-bind (x y) (xlib:query-pointer *root*)
+ (let* ((child (find-child-under-mouse x y))
+ (parent (find-parent-frame child *root-frame*)))
+ (when (and child parent)
+ (pfuncall body parent)
+ (focus-all-children child parent))))
+ (pfuncall body-escape))
(dolist (lwin *expose-windows-list*)
(awhen (first lwin)
(xlib:destroy-window it))
@@ -190,13 +191,17 @@
(defun expose-windows-mode ()
"Present all windows in the current frame (An expose like)"
(stop-button-event)
- (expose-windows-generic *current-root* nil))
+ (expose-windows-generic *current-root*))
(defun expose-all-windows-mode ()
"Present all windows in all frames (An expose like)"
(stop-button-event)
- (switch-to-root-frame :show-later t)
- (expose-windows-generic *root-frame*
- (lambda (parent)
- (hide-all-children *root-frame*)
- (setf *current-root* parent))))
+ (let ((orig-root *current-root*))
+ (switch-to-root-frame :show-later t)
+ (expose-windows-generic *root-frame*
+ (lambda (parent)
+ (hide-all-children *root-frame*)
+ (setf *current-root* parent))
+ (lambda ()
+ (hide-all-children *current-root*)
+ (setf *current-root* orig-root)))))
More information about the clfswm-cvs
mailing list