[clfswm-cvs] r188 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Tue Oct 14 21:22:52 UTC 2008
Author: pbrochard
Date: Tue Oct 14 21:22:47 2008
New Revision: 188
Log:
src/clfswm-keys.lisp: Add a default modifiers list before bindings keys. This allow the use of Numlock or Caps_Lock while using clfswm.
Modified:
clfswm/TODO
clfswm/load.lisp
clfswm/src/bindings.lisp
clfswm/src/clfswm-info.lisp
clfswm/src/clfswm-keys.lisp
clfswm/src/clfswm-menu.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
clfswm/src/config.lisp
clfswm/src/xlib-util.lisp
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Tue Oct 14 21:22:47 2008
@@ -11,8 +11,9 @@
(with-numlock) -> add :mod-2 in *default-modifiers*
(without-numlock)
alias :mod-1 -> :alt :mod-2 -> :numlock
+ => *default-modifiers* is done. <=
-- hook to create bindings and menu
+- hook to create bindings and menu -> build keys and menu at runtime.
- Show config -> list and display documentation for all tweakable global variables. [Philippe]
TODO :
Modified: clfswm/load.lisp
==============================================================================
--- clfswm/load.lisp (original)
+++ clfswm/load.lisp Tue Oct 14 21:22:47 2008
@@ -23,8 +23,6 @@
;;;
;;; --------------------------------------------------------------------------
-;;test
-
(defparameter *base-dir* (directory-namestring *load-truename*))
(export '*base-dir*)
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Tue Oct 14 21:22:47 2008
@@ -31,6 +31,8 @@
;;;| CONFIG - Bindings main mode
;;;`-----
+(with-numlock)
+
(define-main-key ("F1" :mod-1) 'help-on-clfswm)
(define-main-key ("Home" :mod-1 :control :shift) 'exit-clfswm)
Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp (original)
+++ clfswm/src/clfswm-info.lisp Tue Oct 14 21:22:47 2008
@@ -305,7 +305,7 @@
(let ((info-list nil)
(action nil))
(labels ((define-key (key function)
- (define-info-key-fun (list key 0)
+ (define-info-key-fun (list key (modifiers->state *default-modifiers*))
(lambda (&optional args)
(declare (ignore args))
(setf action function)
@@ -328,7 +328,7 @@
(dolist (item item-list)
(when (consp item)
(let ((key (first item)))
- (undefine-info-key-fun (list key 0)))))
+ (undefine-info-key-fun (list key (modifiers->state *default-modifiers*))))))
(typecase action
(function (funcall action))
(symbol (when (fboundp action)
Modified: clfswm/src/clfswm-keys.lisp
==============================================================================
--- clfswm/src/clfswm-keys.lisp (original)
+++ clfswm/src/clfswm-keys.lisp Tue Oct 14 21:22:47 2008
@@ -30,6 +30,8 @@
(defparameter *fun-release* #'second)
+
+
(defun define-hash-table-key-name (hash-table name)
(setf (gethash 'name hash-table) name))
@@ -49,20 +51,21 @@
(undefine-name (create-symbol "undefine-" name "-key"))
(undefine-multi-name (create-symbol "undefine-" name "-multi-keys")))
`(progn
- (defun ,name-key-fun (key function &rest args)
- "Define a new key, a key is '(char '(modifier list))"
- (setf (gethash key ,hashtable) (list function args)))
+ (defun ,name-key-fun (key function &rest args)
+ "Define a new key, a key is '(char '(modifier list))"
+ (setf (gethash key ,hashtable) (list function args)))
- (defmacro ,name-key ((key &rest modifiers) function &rest args)
- `(,',name-key-fun (list ,key ,(modifiers->state modifiers)) ,function , at args))
+ (defmacro ,name-key ((key &rest modifiers) function &rest args)
+ `(,',name-key-fun (list ,key ,(modifiers->state (append modifiers *default-modifiers*))) ,function , at args))
- (defmacro ,undefine-name ((key &rest modifiers))
- `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable))
+ (defmacro ,undefine-name ((key &rest modifiers))
+ `(remhash (list ,key ,(modifiers->state (append modifiers *default-modifiers*))) ,',hashtable))
+
+ (defmacro ,undefine-multi-name (&rest keys)
+ `(progn
+ ,@(loop for k in keys
+ collect `(,',undefine-name ,k)))))))
- (defmacro ,undefine-multi-name (&rest keys)
- `(progn
- ,@(loop for k in keys
- collect `(,',undefine-name ,k)))))))
(defmacro define-define-mouse (name hashtable)
@@ -75,10 +78,10 @@
(setf (gethash button ,hashtable) (list function-press function-release args)))
(defmacro ,name-mouse ((button &rest modifiers) function-press &optional function-release &rest args)
- `(,',name-mouse-fun (list ,button ,(modifiers->state modifiers)) ,function-press ,function-release , at args))
+ `(,',name-mouse-fun (list ,button ,(modifiers->state (append modifiers *default-modifiers*))) ,function-press ,function-release , at args))
(defmacro ,undefine-name ((key &rest modifiers))
- `(remhash (list ,key ,(modifiers->state modifiers)) ,',hashtable)))))
+ `(remhash (list ,key ,(modifiers->state (append modifiers *default-modifiers*))) ,',hashtable)))))
Modified: clfswm/src/clfswm-menu.lisp
==============================================================================
--- clfswm/src/clfswm-menu.lisp (original)
+++ clfswm/src/clfswm-menu.lisp Tue Oct 14 21:22:47 2008
@@ -129,14 +129,14 @@
(format nil ": ~A" (documentation value 'function)))))
info-list)
(when (menu-item-key item)
- (define-info-key-fun (list (menu-item-key item) 0)
+ (define-info-key-fun (list (menu-item-key item) (modifiers->state *default-modifiers*))
(lambda (&optional args)
(declare (ignore args))
(setf action value)
(throw 'exit-info-loop nil))))))
(info-mode (nreverse info-list))
(dolist (item (menu-item menu))
- (undefine-info-key-fun (list (menu-item-key item) 0)))
+ (undefine-info-key-fun (list (menu-item-key item) (modifiers->state *default-modifiers*))))
(typecase action
(menu (open-menu action (cons menu parent)))
(null (awhen (first parent)
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Tue Oct 14 21:22:47 2008
@@ -260,7 +260,7 @@
(keysym (keysym->keysym-name (xlib:keycode->keysym *display* code (cond ((member :shift modifiers) 1)
((member :mod-5 modifiers) 2)
(t 0))))))
- (setf done (and (equal key #\q) (null modifiers)))
+ (setf done (and (equal key #\q) (equal modifiers *default-modifiers*)))
(dbg code keysym key modifiers)
(print-key code state keysym key modifiers)
(force-output)))
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Tue Oct 14 21:22:47 2008
@@ -231,6 +231,7 @@
*in-second-mode* nil
*clfswm-terminal* nil
*vt-keyboard-on* nil)
+ (init-modifier-list)
(xgrab-init-pointer)
(xgrab-init-keyboard)
(init-last-child)
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Tue Oct 14 21:22:47 2008
@@ -38,6 +38,12 @@
+;;; CONFIG - Default modifiers
+(defparameter *default-modifiers* '()
+ "Config(): Default modifiers list to append to explicit modifiers
+Example: :mod-2 for num_lock, :lock for Caps_lock...")
+
+
;;; CONFIG - Never managed window list
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Tue Oct 14 21:22:47 2008
@@ -656,21 +656,39 @@
(xungrab-keyboard))))
+
+
+
+
+(let ((modifier-list nil))
+ (defun init-modifier-list ()
+ (dolist (name '("Shift_L" "Shift_R" "Control_L" "Control_R"
+ "Alt_L" "Alt_R" "Meta_L" "Meta_R" "Hyper_L" "Hyper_R"
+ "Mode_switch" "script_switch" "ISO_Level3_Shift"
+ "Caps_Lock" "Scroll_Lock" "Num_Lock"))
+ (awhen (xlib:keysym->keycodes *display* (keysym-name->keysym name))
+ (push it modifier-list))))
+
+ (defun modifier-p (code)
+ (member code modifier-list)))
+
(defun wait-no-key-or-button-press ()
(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))))))
+ (let ((key (loop for k across (xlib:query-keymap *display*)
+ for code from 0
+ when (and (plusp k) (not (modifier-p code))) return t))
+ (button (member (nth-value 4 (xlib:query-pointer *root*))
+ '(:button-1 :button-2 :button-3 :button-4 :button-5))))
+ (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 ()
More information about the clfswm-cvs
mailing list