[clfswm-cvs] r18 - clfswm
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Thu Mar 6 16:15:27 UTC 2008
Author: pbrochard
Date: Thu Mar 6 11:15:26 2008
New Revision: 18
Modified:
clfswm/bindings-second-mode.lisp
clfswm/bindings.lisp
clfswm/clfswm-info.lisp
clfswm/clfswm-internal.lisp
clfswm/clfswm-keys.lisp
clfswm/clfswm-second-mode.lisp
clfswm/clfswm.asd
clfswm/clfswm.lisp
clfswm/package.lisp
clfswm/xlib-util.lisp
Log:
Handle mouse in the main mode the same way as in the second mode. Main mouse actions are now defined in bindings.lisp
Modified: clfswm/bindings-second-mode.lisp
==============================================================================
--- clfswm/bindings-second-mode.lisp (original)
+++ clfswm/bindings-second-mode.lisp Thu Mar 6 11:15:26 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Tue Mar 4 22:41:24 2008
+;;; #Date#: Thu Mar 6 16:32:54 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse for second mode
@@ -228,10 +228,11 @@
;;; Mouse action
-(defun sm-handle-click-to-focus (root-x root-y)
+(defun sm-handle-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)))
+ (handle-click-to-focus win root-x root-y)))
(define-second-mouse (1) 'sm-handle-click-to-focus)
Modified: clfswm/bindings.lisp
==============================================================================
--- clfswm/bindings.lisp (original)
+++ clfswm/bindings.lisp Thu Mar 6 11:15:26 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sat Mar 1 23:24:37 2008
+;;; #Date#: Thu Mar 6 17:10:55 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse
@@ -73,6 +73,37 @@
(define-main-key ("less" :control) 'second-key-mode)
+
+
+
+
+;;; Mouse actions
+
+(defun handle-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)
+ (child window)
+ (father (find-father-group window *current-root*)))
+ (unless father
+ (setf child (find-group-window window *current-root*)
+ father (find-father-group child *current-root*)))
+ (when (and child father (focus-all-childs child father))
+ (show-all-childs)
+ (setf to-replay nil))
+ (if to-replay
+ (replay-button-event)
+ (stop-button-event))))
+
+
+(defun test-mouse-binding (window root-x root-y)
+ (dbg window root-x root-y))
+
+(define-main-mouse (1) 'handle-click-to-focus)
+;;(define-main-mouse (1) 'handle-click-to-focus 'test-mouse-binding)
+;;(define-main-mouse ('motion) 'test-mouse-binding)
+
+
;;(define-main-key ("a") (lambda ()
;; (dbg 'key-a)
;; (show-all-childs *root-group*)))
Modified: clfswm/clfswm-info.lisp
==============================================================================
--- clfswm/clfswm-info.lisp (original)
+++ clfswm/clfswm-info.lisp Thu Mar 6 11:15:26 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Tue Feb 19 21:43:15 2008
+;;; #Date#: Thu Mar 6 16:45:37 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Info function (see the end of this file for user definition
@@ -35,9 +35,9 @@
(declare (ignore info))
(throw 'exit-info-loop nil))
-(defun mouse-leave-info-mode (root-x root-y info)
+(defun mouse-leave-info-mode (window root-x root-y info)
"Leave the info mode"
- (declare (ignore root-x root-y info))
+ (declare (ignore window root-x root-y info))
(throw 'exit-info-loop nil))
@@ -152,35 +152,38 @@
(defparameter *info-start-grab-y* nil)
-(defun info-begin-grab (root-x root-y info)
+(defun info-begin-grab (window root-x root-y info)
"Begin grab text"
+ (declare (ignore window))
(setf *info-start-grab-x* (+ root-x (info-x info))
*info-start-grab-y* (+ root-y (info-y info)))
(draw-info-window info))
-(defun info-end-grab (root-x root-y info)
+(defun info-end-grab (window root-x root-y info)
"End grab"
+ (declare (ignore window))
(setf (info-x info) (- *info-start-grab-x* root-x)
(info-y info) (- *info-start-grab-y* root-y)
*info-start-grab-x* nil
*info-start-grab-y* nil)
(draw-info-window info))
-(defun info-mouse-next-line (root-x root-y info)
+(defun info-mouse-next-line (window root-x root-y info)
"Move one line down"
- (declare (ignore root-x root-y))
+ (declare (ignore window root-x root-y))
(incf (info-y info) (info-ilh info))
(draw-info-window info))
-(defun info-mouse-previous-line (root-x root-y info)
+(defun info-mouse-previous-line (window root-x root-y info)
"Move one line up"
- (declare (ignore root-x root-y))
+ (declare (ignore window root-x root-y))
(decf (info-y info) (info-ilh info))
(draw-info-window info))
-(defun info-mouse-motion (root-x root-y info)
+(defun info-mouse-motion (window root-x root-y info)
"Grab text"
+ (declare (ignore window))
(when (and *info-start-grab-x* *info-start-grab-y*)
(setf (info-x info) (- *info-start-grab-x* root-x)
(info-y info) (- *info-start-grab-y* root-y))
@@ -190,11 +193,11 @@
-(define-info-mouse-action (1) 'info-begin-grab 'info-end-grab)
-(define-info-mouse-action (2) 'mouse-leave-info-mode)
-(define-info-mouse-action (4) 'info-mouse-previous-line)
-(define-info-mouse-action (5) 'info-mouse-next-line)
-(define-info-mouse-action ('Motion) 'info-mouse-motion nil)
+(define-info-mouse (1) 'info-begin-grab 'info-end-grab)
+(define-info-mouse (2) 'mouse-leave-info-mode)
+(define-info-mouse (4) 'info-mouse-previous-line)
+(define-info-mouse (5) 'info-mouse-next-line)
+(define-info-mouse ('Motion) 'info-mouse-motion nil)
;;;,-----
@@ -236,13 +239,13 @@
(declare (ignore event-slots))
(unless (xlib:event-case (*display* :discard-p nil :peek-p t :timeout 0)
(:motion-notify () t))
- (funcall-button-from-code *info-mouse-action* 'motion 0 root-x root-y #'first info)))
- (handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
+ (funcall-button-from-code *info-mouse* 'motion 0 window root-x root-y #'first info)))
+ (handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
(declare (ignore event-slots))
- (funcall-button-from-code *info-mouse-action* code state root-x root-y #'first info))
- (handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
+ (funcall-button-from-code *info-mouse* code state window root-x root-y #'first info))
+ (handle-button-release (&rest event-slots &key window root-x root-y code state &allow-other-keys)
(declare (ignore event-slots))
- (funcall-button-from-code *info-mouse-action* code state root-x root-y #'third info))
+ (funcall-button-from-code *info-mouse* code state window root-x root-y #'third info))
(info-handle-unmap-notify (&rest event-slots)
(apply #'handle-unmap-notify event-slots)
(draw-info-window info))
@@ -339,12 +342,12 @@
(defun show-global-key-binding ()
"Show all key binding"
- (show-key-binding *main-keys* *second-keys* *second-mouse*
- *info-keys* *info-mouse-action*))
+ (show-key-binding *main-keys* *main-mouse* *second-keys* *second-mouse*
+ *info-keys* *info-mouse*))
(defun show-main-mode-key-binding ()
"Show the main mode binding"
- (show-key-binding *main-keys*))
+ (show-key-binding *main-keys* *main-mouse*))
(defun show-second-mode-key-binding ()
"Show the second mode key binding"
Modified: clfswm/clfswm-internal.lisp
==============================================================================
--- clfswm/clfswm-internal.lisp (original)
+++ clfswm/clfswm-internal.lisp Thu Mar 6 11:15:26 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Wed Mar 5 23:09:42 2008
+;;; #Date#: Thu Mar 6 16:58:18 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -166,7 +166,7 @@
:colormap (xlib:screen-default-colormap *screen*)
:border-width 1
:border (get-color "Red")
- :event-mask '(:exposure :button-press)))
+ :event-mask '(:exposure :button-press :button-release :pointer-motion)))
(gc (xlib:create-gcontext :drawable window
:foreground (get-color "Green")
:background (get-color "Black")
Modified: clfswm/clfswm-keys.lisp
==============================================================================
--- clfswm/clfswm-keys.lisp (original)
+++ clfswm/clfswm-keys.lisp Thu Mar 6 11:15:26 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 16:11:27 2008
+;;; #Date#: Thu Mar 6 16:47:42 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Keys functions definition
@@ -33,10 +33,11 @@
;;; CONFIG - Key mode names
(define-hash-table-key-name *main-keys* "Main mode keys")
+(define-hash-table-key-name *main-mouse* "Mouse buttons actions in main mode")
(define-hash-table-key-name *second-keys* "Second mode keys")
(define-hash-table-key-name *second-mouse* "Mouse buttons actions in second mode")
(define-hash-table-key-name *info-keys* "Info mode keys")
-(define-hash-table-key-name *info-mouse-action* "Mouse buttons actions in info mode")
+(define-hash-table-key-name *info-mouse* "Mouse buttons actions in info mode")
(defmacro define-define-key (name hashtable)
@@ -84,17 +85,12 @@
-
-;;(defun undefine-main-keys (&rest keys)
-;; (dolist (k keys)
-;; (undefine-main-key k)))
-
(defun undefine-info-key-fun (key)
(remhash key *info-keys*))
-;;(define-define-mouse "main-mouse" *main-mouse*)
+(define-define-mouse "main-mouse" *main-mouse*)
(define-define-mouse "second-mouse" *second-mouse*)
-(define-define-mouse "info-mouse-action" *info-mouse-action*)
+(define-define-mouse "info-mouse" *info-mouse*)
@@ -160,18 +156,20 @@
-(defun funcall-button-from-code (hash-table-key code state root-x root-y
+(defun funcall-button-from-code (hash-table-key code state window root-x root-y
&optional (action #'first) args)
- "Action: first=press third=release"
+ "Action: first=press third=release - Return t if a function is found"
(let ((state (modifiers->state (set-difference (state->modifiers state)
'(:button-1 :button-2 :button-3 :button-4 :button-5)))))
(multiple-value-bind (function foundp)
(gethash (list code state) hash-table-key)
(if (and foundp (funcall action function))
- (if args
- (funcall (funcall action function) root-x root-y args)
- (funcall (funcall action function) root-x root-y))
- t))))
+ (progn
+ (if args
+ (funcall (funcall action function) window root-x root-y args)
+ (funcall (funcall action function) window root-x root-y))
+ t)
+ nil))))
@@ -228,8 +226,8 @@
(defun produce-doc-html-in-file (filename)
(with-open-file (stream filename :direction :output
:if-exists :supersede :if-does-not-exist :create)
- (produce-doc-html (list *main-keys* *second-keys* *second-mouse*
- *info-keys* *info-mouse-action*)
+ (produce-doc-html (list *main-keys* *main-mouse* *second-keys* *second-mouse*
+ *info-keys* *info-mouse*)
stream)))
@@ -261,8 +259,8 @@
(defun produce-doc-in-file (filename)
(with-open-file (stream filename :direction :output
:if-exists :supersede :if-does-not-exist :create)
- (produce-doc (list *main-keys* *second-keys* *second-mouse*
- *info-keys* *info-mouse-action*)
+ (produce-doc (list *main-keys* *main-mouse* *second-keys* *second-mouse*
+ *info-keys* *info-mouse*)
stream)))
Modified: clfswm/clfswm-second-mode.lisp
==============================================================================
--- clfswm/clfswm-second-mode.lisp (original)
+++ clfswm/clfswm-second-mode.lisp Thu Mar 6 11:15:26 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Fri Feb 22 21:38:53 2008
+;;; #Date#: Thu Mar 6 16:30:51 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Second mode functions
@@ -83,14 +83,14 @@
(unless (compress-motion-notify)
(funcall-button-from-code *second-mouse* 'motion 0 root-x root-y #'first)))
-(defun sm-handle-button-press (&rest event-slots &key root-x root-y code state &allow-other-keys)
+(defun sm-handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
(declare (ignore event-slots))
- (funcall-button-from-code *second-mouse* code state root-x root-y #'first)
+ (funcall-button-from-code *second-mouse* code state window root-x root-y #'first)
(draw-second-mode-window))
-(defun sm-handle-button-release (&rest event-slots &key root-x root-y code state &allow-other-keys)
+(defun sm-handle-button-release (&rest event-slots &key window root-x root-y code state &allow-other-keys)
(declare (ignore event-slots))
- (funcall-button-from-code *second-mouse* code state root-x root-y #'third)
+ (funcall-button-from-code *second-mouse* code state window root-x root-y #'third)
(draw-second-mode-window))
(defun sm-handle-configure-request (&rest event-slots)
Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd (original)
+++ clfswm/clfswm.asd Thu Mar 6 11:15:26 2008
@@ -2,7 +2,7 @@
;;;; Author: Philippe Brochard <hocwp at free.fr>
;;;; ASDF System Definition
;;;
-;;; #date#: Wed Mar 5 23:08:25 2008
+;;; #date#: Thu Mar 6 16:21:25 2008
(in-package #:asdf)
@@ -44,7 +44,7 @@
(:file "bindings"
:depends-on ("clfswm" "clfswm-internal"))
(:file "bindings-second-mode"
- :depends-on ("clfswm" "clfswm-util" "clfswm-query"))))
+ :depends-on ("clfswm" "clfswm-util" "clfswm-query" "bindings"))))
Modified: clfswm/clfswm.lisp
==============================================================================
--- clfswm/clfswm.lisp (original)
+++ clfswm/clfswm.lisp Thu Mar 6 11:15:26 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 15:34:27 2008
+;;; #Date#: Thu Mar 6 16:57:45 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -37,6 +37,23 @@
(funcall-key-from-code *main-keys* code state))
+;; PHIL: TODO: focus-policy par 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))
+ (unless (funcall-button-from-code *main-mouse* code state window root-x root-y #'first)
+ (replay-button-event)))
+
+
+(defun handle-button-release (&rest event-slots &key code state window root-x root-y &allow-other-keys)
+ (declare (ignore event-slots))
+ (unless (funcall-button-from-code *main-mouse* code state window root-x root-y #'third)
+ (replay-button-event)))
+
+(defun handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+ (declare (ignore event-slots))
+ (unless (compress-motion-notify)
+ (funcall-button-from-code *main-mouse* 'motion 0 root-x root-y #'first)))
(defun handle-configure-request (&rest event-slots &key stack-mode #|parent|# window #|above-sibling|#
@@ -121,29 +138,6 @@
-;; PHIL: TODO: focus-policy par group
-;; :click, :sloppy, :nofocus
-(defun handle-click-to-focus (window)
- (let ((to-replay t)
- (child window)
- (father (find-father-group window *current-root*)))
- (unless father
- (setf child (find-group-window window *current-root*)
- father (find-father-group child *current-root*)))
- (when (and child father (focus-all-childs child father))
- (show-all-childs)
- (setf to-replay nil))
- (if to-replay (replay-button-event) (stop-button-event))))
-
-
-(defun handle-button-press (&rest event-slots &key code state window &allow-other-keys)
- (declare (ignore event-slots))
- (if (and (= code 1) (= state 0))
- (handle-click-to-focus window)
- (replay-button-event)))
-
-
-
@@ -157,7 +151,9 @@
*map-request-hook* #'handle-map-request
*unmap-notify-hook* 'handle-unmap-notify
*create-notify-hook* #'handle-create-notify
- *button-press-hook* 'handle-button-press)
+ *button-press-hook* 'handle-button-press
+ *button-release-hook* 'handle-button-release
+ *motion-notify-hook* 'handle-motion-notify)
@@ -168,7 +164,8 @@
(with-xlib-protect
(case event-key
(:button-press (call-hook *button-press-hook* event-slots))
- (:motion-notify (call-hook *button-motion-notify-hook* event-slots))
+ (:button-release (call-hook *button-release-hook* event-slots))
+ (:motion-notify (call-hook *motion-notify-hook* event-slots))
(:key-press (call-hook *key-press-hook* event-slots))
(:configure-request (call-hook *configure-request-hook* event-slots))
(:configure-notify (call-hook *configure-notify-hook* event-slots))
@@ -221,7 +218,9 @@
:substructure-notify
:property-change
:exposure
- :button-press))
+ :button-press
+ :button-release
+ :pointer-motion))
;;(intern-atoms *display*)
(netwm-set-properties)
(xlib:display-force-output *display*)
Modified: clfswm/package.lisp
==============================================================================
--- clfswm/package.lisp (original)
+++ clfswm/package.lisp Thu Mar 6 11:15:26 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Mar 6 16:11:59 2008
+;;; #Date#: Thu Mar 6 16:52:01 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Package definition
@@ -96,10 +96,11 @@
(defparameter *main-keys* (make-hash-table :test 'equal))
+(defparameter *main-mouse* (make-hash-table :test 'equal))
(defparameter *second-keys* (make-hash-table :test 'equal))
(defparameter *second-mouse* (make-hash-table :test 'equal))
(defparameter *info-keys* (make-hash-table :test 'equal))
-(defparameter *info-mouse-action* (make-hash-table :test 'equal))
+(defparameter *info-mouse* (make-hash-table :test 'equal))
(defparameter *open-next-window-in-new-workspace* nil
@@ -131,7 +132,8 @@
;;; Main mode hooks (set in clfswm.lisp)
(defparameter *button-press-hook* nil)
-(defparameter *button-motion-notify-hook* nil)
+(defparameter *button-release-hook* nil)
+(defparameter *motion-notify-hook* nil)
(defparameter *key-press-hook* nil)
(defparameter *configure-request-hook* nil)
(defparameter *configure-notify-hook* nil)
Modified: clfswm/xlib-util.lisp
==============================================================================
--- clfswm/xlib-util.lisp (original)
+++ clfswm/xlib-util.lisp Thu Mar 6 11:15:26 2008
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Wed Mar 5 22:22:59 2008
+;;; #Date#: Thu Mar 6 17:03:02 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Utility functions
@@ -39,9 +39,10 @@
:colormap-change
:focus-change
:enter-window
- :exposure)
- ;;:button-press
- ;;:button-release)
+ :exposure
+ :button-press
+ :button-release
+ :pointer-motion)
"The events to listen for on managed windows.")
@@ -402,7 +403,7 @@
(defun grab-all-buttons (window)
(ungrab-all-buttons window)
- (xlib:grab-button window :any '(:button-press)
+ (xlib:grab-button window :any '(:button-press :button-release :pointer-motion)
:modifiers :any
:owner-p nil
:sync-pointer-p t
More information about the clfswm-cvs
mailing list