[clfswm-cvs] r329 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Sat Sep 25 13:07:04 UTC 2010
Author: pbrochard
Date: Sat Sep 25 09:07:04 2010
New Revision: 329
Log:
src/clfswm-expose-mode.lisp: Move and rename present*-windows in a separate clfswm-expose-mode.lisp file.
Added:
clfswm/src/clfswm-expose-mode.lisp
Modified:
clfswm/ChangeLog
clfswm/clfswm.asd
clfswm/src/bindings-second-mode.lisp
clfswm/src/bindings.lisp
clfswm/src/clfswm-corner.lisp
clfswm/src/clfswm-keys.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/package.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sat Sep 25 09:07:04 2010
@@ -1,5 +1,8 @@
2010-09-25 Philippe Brochard <pbrochard at common-lisp.net>
+ * src/clfswm-expose-mode.lisp: Move and rename present*-windows in
+ a separate clfswm-expose-mode.lisp file.
+
* src/clfswm-util.lisp (speed-mouse-right, speed-mouse-down): Use
screen size instead of hardcoded test coordinates.
Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd (original)
+++ clfswm/clfswm.asd Sat Sep 25 09:07:04 2010
@@ -46,8 +46,10 @@
(:file "clfswm-second-mode"
:depends-on ("package" "clfswm" "clfswm-internal" "clfswm-generic-mode"
"clfswm-placement"))
+ (:file "clfswm-expose-mode"
+ :depends-on ("package" "config" "clfswm-internal" "xlib-util" "tools"))
(:file "clfswm-corner"
- :depends-on ("package" "config" "clfswm-internal"))
+ :depends-on ("package" "config" "clfswm-internal" "clfswm-expose-mode" "xlib-util"))
(:file "clfswm-info"
:depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"
"clfswm-autodoc" "clfswm-corner"
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Sat Sep 25 09:07:04 2010
@@ -147,7 +147,9 @@
(define-second-key ("F10" :mod-1) 'fast-layout-switch)
(define-second-key ("F10" :shift) 'show-all-frames-info-key)
(define-second-key ("F10" :shift :mod-1) 'show-all-frames-info)
- (define-second-key ("F10" :control) 'toggle-show-root-frame)
+ (define-second-key ("F10" :shift :control) 'toggle-show-root-frame)
+ (define-second-key ("F10") 'expose-windows)
+ (define-second-key ("F10" :control) 'expose-all-windows)
;; Bind or jump functions
(define-second-key ("1" :mod-1) 'bind-or-jump 1)
(define-second-key ("2" :mod-1) 'bind-or-jump 2)
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Sat Sep 25 09:07:04 2010
@@ -61,7 +61,9 @@
(define-main-key ("F10" :mod-1) 'fast-layout-switch)
(define-main-key ("F10" :shift) 'show-all-frames-info-key)
(define-main-key ("F10" :shift :mod-1) 'show-all-frames-info)
- (define-main-key ("F10" :control) 'toggle-show-root-frame)
+ (define-main-key ("F10" :shift :control) 'toggle-show-root-frame)
+ (define-main-key ("F10") 'expose-windows)
+ (define-main-key ("F10" :control) 'expose-all-windows)
(define-main-key (#\b :mod-1) 'banish-pointer)
;; Escape
(define-main-key ("Escape" :control) 'ask-close/kill-current-window)
Modified: clfswm/src/clfswm-corner.lisp
==============================================================================
--- clfswm/src/clfswm-corner.lisp (original)
+++ clfswm/src/clfswm-corner.lisp Sat Sep 25 09:07:04 2010
@@ -73,44 +73,6 @@
;;;***************************************;;;
;;; CONFIG - Corner actions definitions: ;;;
;;;***************************************;;;
-
-(defmacro present-windows-generic ((first-restore-frame) &body body)
- `(progn
- (with-all-frames (,first-restore-frame frame)
- (setf (frame-data-slot frame :old-layout) (frame-layout frame)
- (frame-layout frame) #'tile-space-layout))
- (show-all-children *current-root*)
- (wait-no-key-or-button-press)
- (wait-a-key-or-button-press )
- (wait-no-key-or-button-press)
- (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)
- , at body
- (focus-all-children child parent))))
- (with-all-frames (,first-restore-frame frame)
- (setf (frame-layout frame) (frame-data-slot frame :old-layout)
- (frame-data-slot frame :old-layout) nil))
- (show-all-children *current-root*)))
-
-(defun present-windows ()
- "Present all windows in the current frame (An expose like)"
- (stop-button-event)
- (present-windows-generic (*current-root*))
- t)
-
-(defun present-all-windows ()
- "Present all windows in all frames (An expose like)"
- (stop-button-event)
- (switch-to-root-frame :show-later t)
- (present-windows-generic (*root-frame*)
- (hide-all-children *root-frame*)
- (setf *current-root* parent))
- t)
-
-
-
(defun find-window-in-query-tree (target-win)
(dolist (win (xlib:query-tree *root*))
(when (child-equal-p win target-win)
Added: clfswm/src/clfswm-expose-mode.lisp
==============================================================================
--- (empty file)
+++ clfswm/src/clfswm-expose-mode.lisp Sat Sep 25 09:07:04 2010
@@ -0,0 +1,60 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Expose functions - An expose like.
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2010 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(defun expose-windows-generic (first-restore-frame func)
+ (with-all-frames (first-restore-frame frame)
+ (setf (frame-data-slot frame :old-layout) (frame-layout frame)
+ (frame-layout frame) #'tile-space-layout))
+ (show-all-children *current-root*)
+ (wait-no-key-or-button-press)
+ (wait-a-key-or-button-press )
+ (wait-no-key-or-button-press)
+ (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 func parent)
+ (focus-all-children child parent))))
+ (with-all-frames (first-restore-frame frame)
+ (setf (frame-layout frame) (frame-data-slot frame :old-layout)
+ (frame-data-slot frame :old-layout) nil))
+ (show-all-children *current-root*)
+ t)
+
+(defun expose-windows ()
+ "Present all windows in the current frame (An expose like)"
+ (stop-button-event)
+ (expose-windows-generic *current-root* nil))
+
+(defun expose-all-windows ()
+ "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))))
Modified: clfswm/src/clfswm-keys.lisp
==============================================================================
--- clfswm/src/clfswm-keys.lisp (original)
+++ clfswm/src/clfswm-keys.lisp Sat Sep 25 09:07:04 2010
@@ -65,7 +65,8 @@
(define-init-hash-table-key *circulate-keys* "Circulate mode keys")
(define-init-hash-table-key *circulate-keys-release* "Circulate mode release keys")
-
+(define-init-hash-table-key *expose-keys* "Expose windows mode keys")
+(define-init-hash-table-key *expose-mouse* "Mouse buttons actions in expose windows mode")
(defun unalias-modifiers (list)
(dolist (mod *modifier-alias*)
@@ -122,9 +123,12 @@
(define-define-key "circulate" *circulate-keys*)
(define-define-key "circulate-release" *circulate-keys-release*)
+(define-define-key "expose" *expose-keys*)
+
(define-define-mouse "main-mouse" *main-mouse*)
(define-define-mouse "second-mouse" *second-mouse*)
(define-define-mouse "info-mouse" *info-mouse*)
+(define-define-mouse "expose" *expose-mouse*)
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Sat Sep 25 09:07:04 2010
@@ -1377,7 +1377,7 @@
(leave-second-mode))
-;;; Speed mouse movement
+;;; Speed mouse movement.
(let (minx miny maxx maxy history lx ly)
(labels ((middle (x1 x2)
(round (/ (+ x1 x2) 2)))
Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp (original)
+++ clfswm/src/package.lisp Sat Sep 25 09:07:04 2010
@@ -161,6 +161,8 @@
(defparameter *query-keys* nil)
(defparameter *circulate-keys* nil)
(defparameter *circulate-keys-release* nil)
+(defparameter *expose-keys* nil)
+(defparameter *expose-mouse* nil)
(defparameter *other-window-manager* nil)
More information about the clfswm-cvs
mailing list