[clfswm-cvs] r140 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Tue Jun 3 12:27:47 UTC 2008
Author: pbrochard
Date: Tue Jun 3 08:27:46 2008
New Revision: 140
Modified:
clfswm/ChangeLog
clfswm/src/bindings-second-mode.lisp
clfswm/src/clfswm-info.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/config.lisp
clfswm/src/tools.lisp
clfswm/src/xlib-util.lisp
Log:
have-to-present-windows, have-to-present-all-windows: New functions to have an MaxOS expose like on mouse click in screen corner. Info-mode: Page_Down, Page_Up: Add boundaries.
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Tue Jun 3 08:27:46 2008
@@ -1,3 +1,11 @@
+2008-06-03 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-util.lisp (have-to-present-windows)
+ (have-to-present-all-windows): New functions to have an MaxOS
+ expose like on mouse click in screen corner.
+
+ * src/clfswm-info.lisp ("Page_Down", "Page_Up"): Add boundaries.
+
2008-05-30 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-util.lisp (unhide-a-child-from-all-frames): Unhide a
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Tue Jun 3 08:27:46 2008
@@ -197,14 +197,22 @@
;;; Mouse action
(defun sm-mouse-click-to-focus-and-move (window root-x root-y)
- "Move and focus the current child - Create a new frame on the root window"
+ "Move and focus the current child - Create a new frame on the root window.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames."
(declare (ignore window))
- (mouse-focus-move/resize-generic root-x root-y #'move-frame nil))
+ (or (have-to-present-windows root-x root-y)
+ (have-to-present-all-windows root-x root-y)
+ (mouse-focus-move/resize-generic root-x root-y #'move-frame nil)))
(defun sm-mouse-click-to-focus-and-resize (window root-x root-y)
- "Resize and focus the current child - Create a new frame on the root window"
+ "Resize and focus the current child - Create a new frame on the root window.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames."
(declare (ignore window))
- (mouse-focus-move/resize-generic root-x root-y #'resize-frame nil))
+ (or (have-to-present-windows root-x root-y)
+ (have-to-present-all-windows root-x root-y)
+ (mouse-focus-move/resize-generic root-x root-y #'resize-frame nil)))
Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp (original)
+++ clfswm/src/clfswm-info.lisp Tue Jun 3 08:27:46 2008
@@ -110,13 +110,13 @@
(define-info-key ("Page_Down")
(defun info-next-ten-lines (info)
"Move ten lines down"
- (incf (info-y info) (* (info-ilh info) 10))
+ (setf (info-y info) (min (+ (info-y info) (* (info-ilh info) 10)) (info-max-y info)))
(draw-info-window info)))
(define-info-key ("Page_Up")
(defun info-previous-ten-lines (info)
"Move ten lines up"
- (decf (info-y info) (* (info-ilh info) 10))
+ (setf (info-y info) (max (- (info-y info) (* (info-ilh info) 10)) 0))
(draw-info-window info)))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Tue Jun 3 08:27:46 2008
@@ -481,6 +481,46 @@
;;; Mouse utilities
+(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 have-to-present-windows (root-x root-y)
+ (when (and (frame-p *current-root*)
+ (in-corner *present-windows-corner* root-x root-y))
+ (stop-button-event)
+ (present-windows-generic (*current-root*))
+ t))
+
+(defun have-to-present-all-windows (root-x root-y)
+ (when (and (frame-p *current-root*)
+ (in-corner *present-all-windows-corner* root-x root-y))
+ (stop-button-event)
+ (switch-to-root-frame)
+ (present-windows-generic (*root-frame*)
+ (hide-all-children *root-frame*)
+ (setf *current-root* parent))
+ t))
+
+
+
+
(defun move-frame (frame parent orig-x orig-y)
(when frame
(hide-all-children frame)
@@ -509,7 +549,7 @@
(child window)
(parent (find-parent-frame child *current-root*))
(root-p (or (equal window *root*)
- (and (frame-p child)
+ (and (frame-p *current-root*)
(equal child (frame-window *current-root*))))))
(when (or (not root-p) *create-frame-on-root*)
(unless parent
@@ -533,12 +573,20 @@
(stop-button-event))))
(defun mouse-click-to-focus-and-move (window root-x root-y)
- "Move and focus the current frame or focus the current window parent"
- (mouse-click-to-focus-generic window root-x root-y #'move-frame))
+ "Move and focus the current frame or focus the current window parent.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames."
+ (or (have-to-present-windows root-x root-y)
+ (have-to-present-all-windows root-x root-y)
+ (mouse-click-to-focus-generic window root-x root-y #'move-frame)))
(defun mouse-click-to-focus-and-resize (window root-x root-y)
- "Resize and focus the current frame or focus the current window parent"
- (mouse-click-to-focus-generic window root-x root-y #'resize-frame))
+ "Resize and focus the current frame or focus the current window parent.
+On *present-windows-corner*: Present windows in the current root.
+On *present-all-windows-corner*: Present all windows in all frames."
+ (or (have-to-present-windows root-x root-y)
+ (have-to-present-all-windows root-x root-y)
+ (mouse-click-to-focus-generic window root-x root-y #'resize-frame)))
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Tue Jun 3 08:27:46 2008
@@ -47,6 +47,11 @@
;; (values 100 100 800 600))
+(defparameter *corner-size* 3
+ "The size of the corner square")
+
+
+
;;; Hook definitions
;;;
@@ -79,6 +84,19 @@
on the root window in the main mode with the mouse")
+;;; CONFIG: Corner where to present windows (An expose like)
+(defparameter *present-windows-corner* :bottom-right
+ "Which corner enable the mouse present windows.
+One of :bottom-right :bottom-left :top-right :top-left")
+
+(defparameter *present-all-windows-corner* :bottom-left
+ "Which corner enable the mouse present all windows
+One of :bottom-right :bottom-left :top-right :top-left")
+
+
+
+
+
;;; CONFIG: Main mode colors
(defparameter *color-selected* "Red")
(defparameter *color-unselected* "Blue")
Modified: clfswm/src/tools.lisp
==============================================================================
--- clfswm/src/tools.lisp (original)
+++ clfswm/src/tools.lisp Tue Jun 3 08:27:46 2008
@@ -35,6 +35,7 @@
:dbg
:dbgnl
:setf/=
+ :in-corner
:create-symbol
:split-string
:expand-newline
@@ -82,10 +83,12 @@
(in-package :tools)
+
(setq *random-state* (make-random-state t))
+
(defmacro awhen (test &body body)
`(let ((it ,test))
(when it
@@ -169,6 +172,8 @@
(setf ,var ,gval)))))
+
+
(defun create-symbol (&rest names)
"Return a new symbol from names"
(intern (string-upcase (apply #'concatenate 'string names))))
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Tue Jun 3 08:27:46 2008
@@ -95,6 +95,33 @@
+(defun in-corner (corner x y)
+ "Return t if (x, y) is in corner.
+Corner is one of :bottom-right :bottom-left :top-right :top-left"
+ (multiple-value-bind (xmin ymin xmax ymax)
+ (case corner
+ (:bottom-right (values (- (xlib:screen-width *screen*) *corner-size*)
+ (- (xlib:screen-height *screen*) *corner-size*)
+ (xlib:screen-width *screen*)
+ (xlib:screen-height *screen*)))
+ (:bottom-left (values 0
+ (- (xlib:screen-height *screen*) *corner-size*)
+ *corner-size*
+ (xlib:screen-height *screen*)))
+ (:top-left (values 0 0 *corner-size* *corner-size*))
+ (:top-right (values (- (xlib:screen-width *screen*) *corner-size*)
+ 0
+ (xlib:screen-width *screen*)
+ *corner-size*))
+ (t (values 10 10 0 0)))
+ (and (<= xmin x xmax)
+ (<= ymin y ymax))))
+
+
+
+
+
+
(defun window-state (win)
"Get the state (iconic, normal, withdraw of a window."
(first (xlib:get-property win :WM_STATE)))
@@ -626,20 +653,45 @@
+(defmacro with-grab-keyboard-and-pointer ((cursor mask old-cursor old-mask) &body body)
+ `(let ((pointer-grabbed (xgrab-pointer-p))
+ (keyboard-grabbed (xgrab-keyboard-p)))
+ (xgrab-pointer *root* ,cursor ,mask)
+ (unless keyboard-grabbed
+ (xgrab-keyboard *root*))
+ , at body
+ (if pointer-grabbed
+ (xgrab-pointer *root* ,old-cursor ,old-mask)
+ (xungrab-pointer))
+ (unless keyboard-grabbed
+ (xungrab-keyboard))))
+
(defun wait-no-key-or-button-press ()
- (loop
- (let ((key (loop for k across (xlib:query-keymap *display*)
- unless (zerop k) return t))
- (button (plusp (nth-value 4 (xlib:query-pointer *root*)))))
- (when (and (not key) (not button))
- (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0)
- (:motion-notify () t)
- (:key-press () t)
- (:button-press () t)
- (:button-release () t)
- (t nil)))
- (return-from wait-no-key-or-button-press nil)))))
+ (with-grab-keyboard-and-pointer (66 67 66 67)
+ (loop
+ (let ((key (loop for k across (xlib:query-keymap *display*)
+ unless (zerop k) return t))
+ (button (plusp (nth-value 4 (xlib:query-pointer *root*)))))
+ (when (and (not key) (not button))
+ (loop while (xlib:event-case (*display* :discard-p t :peek-p nil :timeout 0)
+ (:motion-notify () t)
+ (:key-press () t)
+ (:key-release () t)
+ (:button-press () t)
+ (:button-release () t)
+ (t nil)))
+ (return))))))
+
+
+(defun wait-a-key-or-button-press ()
+ (with-grab-keyboard-and-pointer (24 25 66 67)
+ (loop
+ (let ((key (loop for k across (xlib:query-keymap *display*)
+ unless (zerop k) return t))
+ (button (plusp (nth-value 4 (xlib:query-pointer *root*)))))
+ (when (or key button)
+ (return))))))
More information about the clfswm-cvs
mailing list