Don't pass on key events when handling keybindings

heart/include/hrt/hrt_input.h

@@ -1,6 +1,7 @@
 #ifndef HRT_HRT_INPUT_H
 #define HRT_HRT_INPUT_H
 
+#include <wayland-server-protocol.h>
 #include <wayland-server.h>
 #include <wlr/types/wlr_input_device.h>
 #include <wlr/types/wlr_keyboard_group.h>
@@ -38,6 +39,7 @@ struct hrt_keypress_info {
   const xkb_keysym_t *keysyms;
   uint32_t modifiers;
   size_t keysyms_len;
+  enum wl_keyboard_key_state wl_key_state;
 };
 
 struct hrt_seat_callbacks {

heart/src/keyboard.c

@@ -68,7 +68,8 @@ static void seat_handle_key(struct wl_listener *listener, void *data) {
     struct hrt_keypress_info key_info = {
       .keysyms = translated_keysyms,
       .keysyms_len = translated_keysyms_len,
-      .modifiers = translated_modifiers
+      .modifiers = translated_modifiers,
+	  .wl_key_state = event->state
     };
     handled = seat->callbacks->keyboard_keypress_event(seat, &key_info);
   }
@@ -79,7 +80,7 @@ static void seat_handle_key(struct wl_listener *listener, void *data) {
   }
 
   // TODO: I don't know if this condition is correct
-  if(!handled || event->state == WL_KEYBOARD_KEY_STATE_PRESSED) {
+  if(!handled) {
     wlr_seat_keyboard_notify_key(seat->seat, event->time_msec, event->keycode, event->state);
   }
 }

lisp/bindings/hrt-bindings.lisp

@@ -30,7 +30,8 @@
 (cffi:defcstruct hrt-keypress-info
   (keysyms :pointer #| xkb-keysym-t |# )
   (modifiers :uint32)
-  (keysyms-len :size))
+  (keysyms-len :size)
+  (wl-key-state :int #| enum wl-keyboard-key-state |#))
 
 (cffi:defcstruct hrt-seat-callbacks
   (button-event :pointer #| function ptr void (struct hrt_seat *) |#)

lisp/bindings/package.lisp

@@ -37,7 +37,9 @@
 	   #:hrt-server-start
 	   #:hrt-server-stop
 	   #:hrt-server-finish
+	   ;; keypress info slots:
 	   #:keysyms
 	   #:modifiers
 	   #:keysyms-len
+	   #:wl-key-state
 	   #:load-foreign-libraries))

lisp/input.lisp

@@ -3,11 +3,10 @@
 (defun execute-command (function key-sequence seat)
   (funcall function key-sequence seat))
 
-(defun check-and-run-keybinding (key seat)
-  (declare (type key key) (optimize speed))
+(defun check-and-run-keybinding (key seat key-state)
+  (declare (type key key) (optimize (speed 3)))
   (when (not (key-modifier-key-p key))
-    (let* ((key-state (mahogany-state-key-state *compositor-state*))
-	   (handling-keybinding (key-state-active-p key-state)))
+    (let* ((handling-keybinding (key-state-active-p key-state)))
       (log-string :trace "Already handling keybinding: ~A" handling-keybinding)
       (flet ((reset-state ()
 	       (log-string :trace "Reseting keyboard state")
@@ -30,13 +29,15 @@
 		(t  nil)))
 	  (log-string :trace "Keyboard state: ~A" (mahogany-state-key-state *compositor-state*)))))))
 
-(defun handle-key-event (key seat)
-  (declare (type key key))
-  (cond
-    ((check-and-run-keybinding key seat) t)
-    (t
-     ;; TODO: add the keysym constants (or compute them at compile time)
-     ;; in xkb library
-     (when (eql 65307 (key-keysym key))
-       (server-stop *compositor-state*)
-       t))))
+(defun handle-key-event (key seat event-state)
+  (declare (type key key)
+	   (type bit event-state)
+	   (optimize(speed 3)))
+  (let ((key-state (mahogany-state-key-state *compositor-state*)))
+    (declare (type key-state key-state))
+    (if (= event-state 1)
+	(or (check-and-run-keybinding key seat key-state)
+	    (when (eql 65307 (key-keysym key))
+	      (server-stop *compositor-state*)
+	      t))
+	 (key-state-active-p key-state))))

lisp/main.lisp

@@ -1,16 +1,19 @@
 (in-package #:mahogany)
 
-(cffi:defcallback cursor-callback :void ((seat (:pointer (:struct hrt-seat))))
+(cffi:defcallback cursor-callback :void ((seat (:pointer (:struct hrt:hrt-seat))))
   (declare (ignore seat))
   (log-string :trace "cursor callback called"))
 
 (cffi:defcallback keyboard-callback :bool
-    ((seat (:pointer (:struct hrt-seat)))
-     (info (:pointer (:struct hrt-keypress-info))))
-  (cffi:with-foreign-slots ((keysyms modifiers keysyms-len) info (:struct hrt-keypress-info))
-    (dotimes (i keysyms-len)
-      (let ((key (make-key (cffi:mem-aref keysyms :uint32 i) modifiers)))
-	(handle-key-event key seat)))))
+    ((seat (:pointer (:struct hrt:hrt-seat)))
+     (info (:pointer (:struct hrt:hrt-keypress-info))))
+  (cffi:with-foreign-slots ((hrt:keysyms hrt:modifiers hrt:keysyms-len hrt:wl-key-state)
+			    info (:struct hrt:hrt-keypress-info))
+    ;; I'm not sure why this is an array, but it's what tinywl does:
+    (dotimes (i hrt:keysyms-len)
+      (let ((key (make-key (cffi:mem-aref hrt:keysyms :uint32 i) hrt:modifiers)))
+	(when (handle-key-event key seat hrt:wl-key-state)
+	  (return t))))))
 
 (defmacro init-callback-struct (variable type &body sets)
   (let ((vars (mapcar #'car sets)))
@@ -19,37 +22,37 @@
 		     append (list (car pair) `(cffi:callback ,(cadr pair))))))))
 
 (defun init-view-callbacks (view-callbacks)
-  (init-callback-struct view-callbacks (:struct hrt-view-callbacks)
-    (new-view handle-new-view-event)
-    (view-destroyed handle-view-destroyed-event)))
+  (init-callback-struct view-callbacks (:struct hrt:hrt-view-callbacks)
+    (hrt:new-view handle-new-view-event)
+    (hrt:view-destroyed handle-view-destroyed-event)))
 
 (defun run-server ()
   (disable-fpu-exceptions)
   (hrt:load-foreign-libraries)
   (log-init :level :trace)
   (enable-debugger)
-  (cffi:with-foreign-objects ((output-callbacks '(:struct hrt-output-callbacks))
-			      (seat-callbacks '(:struct hrt-seat-callbacks))
-			      (view-callbacks '(:struct hrt-view-callbacks))
-			      (server '(:struct hrt-server)))
-    (init-callback-struct output-callbacks (:struct hrt-output-callbacks)
-      (output-added handle-new-output)
-      (output-removed handle-output-removed)
-      (output-layout-changed handle-output-layout-change))
-    (init-callback-struct seat-callbacks (:struct hrt-seat-callbacks)
-      (button-event cursor-callback)
-      (wheel-event cursor-callback)
-      (keyboard-keypress-event keyboard-callback))
+  (cffi:with-foreign-objects ((output-callbacks '(:struct hrt:hrt-output-callbacks))
+			      (seat-callbacks '(:struct hrt:hrt-seat-callbacks))
+			      (view-callbacks '(:struct hrt:hrt-view-callbacks))
+			      (server '(:struct hrt:hrt-server)))
+    (init-callback-struct output-callbacks (:struct hrt:hrt-output-callbacks)
+      (hrt:output-added handle-new-output)
+      (hrt:output-removed handle-output-removed)
+      (hrt:output-layout-changed handle-output-layout-change))
+    (init-callback-struct seat-callbacks (:struct hrt:hrt-seat-callbacks)
+      (hrt:button-event cursor-callback)
+      (hrt:wheel-event cursor-callback)
+      (hrt:keyboard-keypress-event keyboard-callback))
     (init-view-callbacks view-callbacks)
 
     (setf (mahogany-state-server *compositor-state*) server)
     (log-string :debug "Initialized mahogany state")
-    (hrt-server-init server output-callbacks seat-callbacks view-callbacks 3)
+    (hrt:hrt-server-init server output-callbacks seat-callbacks view-callbacks 3)
     (log-string :debug "Initialized heart state")
     (unwind-protect
-	 (hrt-server-start server)
+	 (hrt:hrt-server-start server)
       (log-string :debug "Cleaning up...")
       (server-stop *compositor-state*)
-      (hrt-server-finish server)
+      (hrt:hrt-server-finish server)
       (server-state-reset *compositor-state*)
       (log-string :debug "Shutdown reached."))))

lisp/output.lisp

@@ -1,10 +1,10 @@
 (in-package #:mahogany)
 
 (defun %get-output-full-name (hrt-output)
-  (let ((make (hrt-output-make hrt-output))
-	(name (hrt-output-name hrt-output))
-	(serial (hrt-output-serial hrt-output))
-	(model (hrt-output-model hrt-output)))
+  (let ((make (hrt:hrt-output-make hrt-output))
+	(name (hrt:hrt-output-name hrt-output))
+	(serial (hrt:hrt-output-serial hrt-output))
+	(model (hrt:hrt-output-model hrt-output)))
     (concatenate 'string
 		 (or name "")
 		 (or make "")
@@ -15,11 +15,11 @@
   (let ((name (%get-output-full-name hrt-output)))
     (%make-mahogany-output hrt-output name)))
 
-(cffi:defcallback handle-new-output :void ((output (:pointer (:struct hrt-output))))
+(cffi:defcallback handle-new-output :void ((output (:pointer (:struct hrt:hrt-output))))
   (let ((mh-output (construct-mahogany-output output)))
     (mahogany-state-output-add *compositor-state* mh-output)))
 
-(cffi:defcallback handle-output-removed :void ((output (:pointer (:struct hrt-output))))
+(cffi:defcallback handle-output-removed :void ((output (:pointer (:struct hrt:hrt-output))))
   (mahogany-state-output-remove *compositor-state* output))
 
 (cffi:defcallback handle-output-layout-change :void ()

lisp/package.lisp

@@ -4,6 +4,5 @@
 	#:mahogany/log
 	#:mahogany/wm-interface
 	#:mahogany/util
-	#:mahogany/core
 	#:mahogany/keyboard)
   (:local-nicknames (#:tree #:mahogany/tree)))

lisp/state.lisp

@@ -65,7 +65,7 @@
 		   (current-group mahogany-current-group)
 		   (server mahogany-state-server))
       state
-    (let ((new-view (hrt:view-init view-ptr (hrt-server-scene-tree server))))
+    (let ((new-view (hrt:view-init view-ptr (hrt:hrt-server-scene-tree server))))
       (setf (gethash (cffi:pointer-address view-ptr) view-tbl) new-view)
       (group-add-view current-group new-view))))
 

lisp/view.lisp

@@ -1,11 +1,11 @@
 (in-package #:mahogany)
 
 (cffi:defcallback handle-new-view-event :void
-    ((view (:pointer (:struct hrt-view))))
+    ((view (:pointer (:struct hrt:hrt-view))))
   (log-string :trace "New view callback called!")
   (mahogany-state-view-add *compositor-state* view))
 
 (cffi:defcallback handle-view-destroyed-event :void
-    ((view (:pointer (:struct hrt-view))))
+    ((view (:pointer (:struct hrt:hrt-view))))
   (log-string :trace "View destroyed callback called!")
   (mahogany-state-view-remove *compositor-state*  view))