[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[STUMP] Mouse mode first shoot
From: |
Philippe Brochard |
Subject: |
[STUMP] Mouse mode first shoot |
Date: |
Thu, 16 Mar 2006 23:32:30 +0100 |
User-agent: |
Gnus/5.1007 (Gnus v5.10.7) Emacs/21.4 (gnu/linux) |
Hi everyboy,
Here is a first shoot for the mouse mode :)
I've tried to keep the stumpwm way. So you define commands as usual
with define-stumpwm-command.
Then you can bind them to a button event with define-mouse (see
below).
My default binding is as follow:
button 1: leave the mouse mode and focus the frame under the pointer
button 2: idem but maximize the frame after leaving
Control + button 1: first click select a window
second click move the selected window in frame
under the pointer
button 4/5 (mouse wheel): focus previous/next window in the frame
under the pointer.
Shift button 2: split horizontally the frame under the pointer
Alt button 2: split vertically the frame under the pointer
Shift button 2: remove the split in the frame under the pointer
And so on.
I haven't try this a lot, so maybe I'll rebind the default binding.
And maybe you'll fall in love again with you mouse :)
For me, icewm, sawfish and fvwm are FAR FAR away from stumpwm !!!
-- mouse.lisp --------------------------------------------------------
(in-package :stumpwm)
(defstruct mouse-event button state root-x root-y)
;;; This is a little bit uggly but this prevent to redefine all the
;;; interactive-command way.
(defvar *current-mouse-event* nil)
(defvar *ignore-next-mouse-event* nil)
(defvar *frame-number-wins* nil)
;;; Little helpers
(defun define-mouse (map button command)
(define-key map button command))
(defun button (buttons)
(kbd buttons))
;;; Default binding
(defparameter *mouse-map*
(let ((m (make-sparse-keymap)))
(define-mouse m (button "1") "leave-mouse-mode")
(define-mouse m (button "3") "leave-mouse-mode-and-maximize")
(define-mouse m (button "C-1") "select-or-move-window")
(define-mouse m (button "4") "wheel-prev-window")
(define-mouse m (button "5") "wheel-next-window")
(define-mouse m (button "S-2") "mouse-h-split")
(define-mouse m (button "A-2") "mouse-v-split")
(define-mouse m (button "C-2") "mouse-remove-split")
m))
(define-key *root-map* (kbd "x") "mouse-mode")
(define-stumpwm-command "mouse-mode" (screen)
(mouse-mode screen))
;;; If command return t we leave mouse-mode, else we stay in it
(define-stumpwm-command "leave-mouse-mode" (screen)
(focus-frame screen (find-frame-under-cursor screen *current-mouse-event*))
t)
(define-stumpwm-command "leave-mouse-mode-and-maximize" (screen)
(let ((frame (find-frame-under-cursor screen *current-mouse-event*)))
(focus-frame screen frame)
(maximize-frame screen frame))
t)
(define-stumpwm-command "wheel-prev-window" (screen)
(focus-frame screen (find-frame-under-cursor screen *current-mouse-event*))
(focus-prev-window screen)
(when *ignore-next-mouse-event*
(read-mouse))
(display-frame-numbers screen)
nil)
(define-stumpwm-command "wheel-next-window" (screen)
(focus-frame screen (find-frame-under-cursor screen *current-mouse-event*))
(focus-next-window screen)
(when *ignore-next-mouse-event*
(read-mouse))
(display-frame-numbers screen)
nil)
;; First clic: select the window under the pointer
;; Second clic: move the selected window in frame under the pointer
(let ((current-window nil))
(define-stumpwm-command "select-or-move-window" (screen)
(let ((frame (find-frame-under-cursor screen *current-mouse-event*)))
(if current-window
(progn
(setf (window-frame screen current-window) frame)
(sync-frame-windows screen frame)
(frame-raise-window screen frame current-window)
(setf current-window nil))
(setf current-window (first (frame-windows screen frame)))))
(display-frame-numbers screen)
nil))
(define-stumpwm-command "mouse-h-split" (screen)
(focus-frame screen (find-frame-under-cursor screen *current-mouse-event*))
(split-frame screen (lambda (f) (split-frame-h screen f)))
(display-frame-numbers screen)
nil)
(define-stumpwm-command "mouse-v-split" (screen)
(focus-frame screen (find-frame-under-cursor screen *current-mouse-event*))
(split-frame screen (lambda (f) (split-frame-v screen f)))
(display-frame-numbers screen)
nil)
(define-stumpwm-command "mouse-remove-split" (screen)
(focus-frame screen (find-frame-under-cursor screen *current-mouse-event*))
(remove-split screen)
(display-frame-numbers screen)
nil)
;;; Main code begin here
(defun find-frame-under-cursor (screen event)
(mapc (lambda (f)
(when (and (<= (frame-x f)
(mouse-event-root-x event)
(+ (frame-x f) (frame-width f)))
(<= (frame-y f)
(mouse-event-root-y event)
(+ (frame-y f) (frame-height f))))
(return-from find-frame-under-cursor f)))
(screen-frames screen)))
;;; Maybe an additional cursor font parameter and event-mask
;;; in grab-pointer in core.lisp is a better way.
(defun mouse-grab-pointer (screen)
"Grab the pointer and set the pointer shape."
(let* ((white (xlib:make-color :red 1.0 :green 1.0 :blue 1.0))
(black (xlib:make-color :red 0.0 :green 0.0 :blue 0.0))
(cursor-font (xlib:open-font *display* "cursor"))
(cursor (xlib:create-glyph-cursor :source-font cursor-font
:source-char 20
:mask-font cursor-font
:mask-char 65
:foreground black
:background white)))
(xlib:grab-pointer (xlib:screen-root (screen-number screen))
(xlib:make-event-mask :button-press)
:owner-p nil
:cursor cursor)))
(defun mouse-handle-event (&rest event-slots &key display event-key
&allow-other-keys)
(declare (ignorable display))
(labels ((button-press (&rest event-slots &key root code state root-x root-y
&allow-other-keys)
(declare (ignorable event-slots))
(declare (ignorable root))
(make-mouse-event :button code :state state :root-x root-x :root-y
root-y)))
(case event-key
(:button-press
(apply #'button-press event-slots))
(t nil))))
(defun read-mouse ()
"Return a mouse-event structure"
(do ((ret nil (xlib:process-event *display* :handler #'mouse-handle-event
:timeout nil)))
(ret ret)))
(defun mouse-event->key (event)
(let ((mods (xlib:make-state-keys (mouse-event-state event))))
(make-key :char (char-code (character (format nil "~A" (mouse-event-button
event))))
:control (and (find :control mods) t)
:shift (and (find :shift mods) t)
:alt (or (and (find :alt mods) t)
(and (find :mod-1 mods) t)))))
(defun mouse-interactive-command (cmd screen)
"exec cmd and return the result."
(let ((result (handler-case (parse-and-run-command cmd screen)
(error (c)
(format nil "~A" c)))))
(when (stringp result)
(echo-string screen result))
result))
(defun analyse-mouse-event (screen event)
(setf *current-mouse-event* event)
(let ((cmd (lookup-key *mouse-map* (mouse-event->key event))))
(when cmd
(prog1
(mouse-interactive-command cmd screen)
(setf *current-mouse-event* nil)))))
(defun display-frame-numbers (screen)
(hide-frame-numbers)
(setf *frame-number-wins* (draw-frame-numbers screen)))
(defun hide-frame-numbers ()
(mapc #'xlib:destroy-window *frame-number-wins*)
(setf *frame-number-wins* nil))
(defun mouse-mode (screen)
(minimize-frame screen)
(mouse-grab-pointer screen)
(display-frame-numbers screen)
(do ((ret (read-mouse) (read-mouse)))
((analyse-mouse-event screen ret)))
(hide-frame-numbers)
(ungrab-pointer))
----------------------------------------------------------------------
Philippe
--
Philippe Brochard <address@hidden>
http://hocwp.free.fr
-=-= http://www.gnu.org/home.fr.html =-=-