Merge pull request #301 from szos/master

Implement the ability to grab modifier keys as individual keys

README.org

@@ -85,6 +85,7 @@ Advertise your module here, open a PR and include a org-mode link!
 - [[./media/stumpwm-mixer/README.md][stumpwm-mixer]] :: Interface to FreeBSD's built-in sound mixer
 - [[./media/stumpwm-sndioctl/README.md][stumpwm-sndioctl]] :: Interface to OpenBSD's sndioctl from StumpWM.
 ** Minor Modes
+- [[./minor-mode/grabbable-modifier-keys/README.md][grabbable-modifier-keys]] :: Allow StumpWM users to grab modifier keys and bind them
 - [[./minor-mode/mpd/README.org][mpd]] :: Displays information about the music player daemon (MPD).
 - [[./minor-mode/notifications/README.org][notifications]] :: A notification library that sends notifications to the modeline via stumpish or from stumpwm itself.
 ** Modeline

minor-mode/grabbable-modifier-keys/README.md

@@ -0,0 +1,45 @@
+# Grabbable Modifier Keys
+
+This module implements grabbable modifier keys, allowing the user to bind
+actions to the press and/or release of a modifier key.
+
+## Usage
+
+After loading the module, use `SWM/GMK:SET-MODIFIER-ACTIONS` to set actions for
+a modifier key (`:MOD1`, `:LOCK`, `:MOD4`, etc.). Setting an action
+automatically registers the modifier key to be grabbed. As an example, to bind
+mod4 (super on the authors machine) to toggle the mode line on press/release, we
+would place the following in our `.stumpwmrc`
+
+```
+(flet ((toggler (c s)
+         (declare (ignore c s))
+         (let* ((s (stumpwm:current-screen))
+                (g (stumpwm:current-group s))
+                (h (stumpwm:current-head g)))
+           (stumpwm:toggle-mode-line s h))))
+  (swm/gmk:set-modifier-actions :mod4 #'toggler #'toggler))
+```
+
+## Quirks
+
+Modifier key presses do not follow the normal key binding and command invocation
+of StumpWM. Rather they expose the key event parameters `CODE` and `STATE` to
+the user, and expect the user to do whatever legwork is neccessary based on
+those parameters.
+
+This minor mode *will* clobber any custom key event handler the user has
+installed. A way around this is to modify the `:KEY-PRESS` event handler and
+change the `UNLESS` form into an `IF`, which calls
+`SWM/GMK:MODIFIER-KEY-PRESS-HANDLER` when a modifier code sneaks through.
+
+Additionally, the key press will not have the modifier set in its state mask,
+but on key release the modifier will be set in the state mask. E.g. from the
+above example if only super is pressed with no other modifiers then the state
+will be zero on press and 64 on release (on the authors machine).
+
+Finally, if a key is defined in the top map that uses the modifier, then a press
+to that key binding will prevent the firing of the release action. E.g. from our
+above example, if `super-p` is bound then pressing super will toggle the mode
+line, pressing p will fire whatever command it is bound to, and releasing super
+will ***not*** fire the release action.

minor-mode/grabbable-modifier-keys/gmk.lisp

@@ -0,0 +1,120 @@
+
+(uiop:define-package #:swm/gmk
+  (:use :cl)
+  (:export set-modifier-actions
+           *modifiers*
+           modifier-key-release-handler
+           modifier-key-press-handler))
+
+(in-package #:swm/gmk)
+
+(stumpwm:define-minor-mode grabbable-modifier-keys-mode () ()
+  (:documentation
+   "When enabled, modifiers specified by the user are grabbed and functions fired
+on their press and release.")
+  (:scope :unscoped)
+  (:interactive make-modifiers-grabbable)
+  (:lighter "GMK")
+  (:expose-keymaps t))
+
+(defvar *modifiers-to-grab* nil
+  "Set by the user to control which mods are grabbable")
+
+ ; grabbable-modifier-keys actions, called on modifier key press and release
+   ; with both the code and the state
+(defparameter *gmk-on-mod-press-release* nil
+  "Internal variable, hold a plist with modifiers as keys and a cons of
+press/release functions as the value.")
+
+(defun set-modifier-actions (mod press release)
+  "Add or replace a modifiers press and release actions. PRESS and RELEASE must be
+functions of arity 2 which take the key code and state mask."
+  (pushnew mod *modifiers-to-grab*)
+  (setf (getf *gmk-on-mod-press-release* mod) (cons press release))
+  (when (and (null press) (null release))
+    (setf *modifiers-to-grab* (remove mod *modifiers-to-grab*))))
+
+(defun invoke-on-press-action (mod code state)
+  (let ((todo (getf *gmk-on-mod-press-release* mod)))
+    (when (car todo)
+      (values (funcall (car todo) code state) t))))
+
+(defun invoke-on-release-action (mod code state)
+  (let ((todo (getf *gmk-on-mod-press-release* mod)))
+    (when (cdr todo)
+      (values (funcall (cdr todo) code state) t))))
+
+ ; Our modifier map
+(defvar *modifiers* nil
+  "Map our modifiers to their individual keys so we can grab them")
+
+(defun fill-*modifiers* ()
+  "Fill in our modifier map"
+  (multiple-value-bind (shift lock control mod1 mod2 mod3 mod4 mod5)
+      (xlib:modifier-mapping stumpwm:*display*)
+    (setf *modifiers*
+          (list :shift shift
+                :lock lock
+                :control control
+                :mod1 mod1
+                :mod2 mod2
+                :mod3 mod3
+                :mod4 mod4
+                :mod5 mod5))))
+
+(defun grab-modifier-keys (modifier &optional ungrab)
+  "Grab or ungrab modifier keys for the screen root"
+  (if ungrab
+      (loop for key-code in (getf *modifiers* modifier)
+            do (xlib:ungrab-key (stumpwm:screen-root (stumpwm:current-screen))
+                                key-code))
+      (loop for key-code in (getf *modifiers* modifier)
+            do (xlib:grab-key (stumpwm:screen-root (stumpwm:current-screen))
+                              key-code))))
+
+(defun compute-which-mod (code)
+  "Given CODE, find which modifier it belongs to"
+  (let ((which-mod
+          (loop for (mod codes) on *modifiers* by #'cddr
+                when (member code codes :test #'=)
+                  collect mod)))
+    (when (cdr which-mod)
+      (warn "Multiple mods defined for key code ~D" code))
+    (car which-mod)))
+
+(defun modifier-key-release-handler (code state)
+  (let ((which-mod (compute-which-mod code)))
+    (multiple-value-bind (res found)
+        (invoke-on-release-action which-mod code state)
+      (when found
+        (values t res)))))
+
+(defun modifier-key-press-handler (code state)
+  (let ((which-mod (compute-which-mod code)))
+    (multiple-value-bind (res found)
+        (invoke-on-press-action which-mod code state)
+      (when found
+        (values t res)))))
+
+(defun on-enter (sym obj)
+  (declare (ignore sym obj))
+  (fill-*modifiers*)
+  (setf stumpwm::*custom-key-event-handler* 'modifier-key-press-handler)
+  (dolist (mod *modifiers-to-grab*)
+    (grab-modifier-keys mod)))
+
+(defun on-exit (sym obj)
+  (declare (ignore sym obj))
+  (setf stumpwm::*custom-key-event-handler* nil)
+  (dolist (mod *modifiers-to-grab*)
+    (grab-modifier-keys mod t)))
+
+(stumpwm:add-hook *grabbable-modifier-keys-mode-enable-hook* 'on-enter)
+(stumpwm:add-hook *grabbable-modifier-keys-mode-disable-hook* 'on-exit)
+
+(in-package :stumpwm)
+
+(define-stump-event-handler :key-release (code state)
+  (declare (ignorable code state))
+  (dformat 1 "~&>>> Key Release ~A ~A~&" code state)
+  (swm/gmk::modifier-key-release-handler code state))

minor-mode/grabbable-modifier-keys/grabbable-modifier-keys.asd

@@ -0,0 +1,8 @@
+
+
+(asdf:defsystem #:grabbable-modifier-keys
+  :description "Allow StumpWM users to grab modifier keys and bind them"
+  :license "GLPv3"
+  :depends-on (#:stumpwm)
+  :serial t
+  :components ((:file "gmk")))