Merge pull request #3366 from atlas-engineer/input-handling-refactor

source/browser.lisp

@@ -107,6 +107,11 @@ Which commands will they invoke next?")
     nil
     :type (maybe function)
     :documentation "The last command invoked by the user.")
+   (command-dispatcher
+    #'dispatch-command
+    :type (or sym:function-symbol function)
+    :documentation "Function to process the command processed in `dispatch-input-event'.
+Takes the function/command as the only argument.")
    (prompt-buffer-generic-history
     (make-ring)
     :documentation "The default history of all prompt buffer entries.

source/buffer.lisp

@@ -36,7 +36,14 @@ inherited from the superclasses.")
     (new-id)
     :type unsigned-byte
     :documentation "Unique identifier for a buffer.")
-   ;; TODO: Or maybe a dead-buffer should just be a buffer history?
+   (key-stack
+    '()
+    :documentation "A stack of the key chords a user has pressed.")
+   (last-key
+    nil
+    :export nil
+    :type (or null keymaps:key)
+    :documentation "Last pressed key.  Useful for `self-insert'.")
    (profile
     (global-profile)
     :type nyxt-profile

source/changelog.lisp

@@ -27,6 +27,14 @@
 
 (define-version "4.0.0"
   (:ul
+   (:li "Refactor input to be handled on the buffer level rather than the window
+level.")
+   (:li "Deprecate " (:code "input-skip-dispatcher") ".")
+   (:li "Move slot " (:nxref :slot 'command-dispatcher :class-name 'browser)
+        " from window to the browser class.")
+   (:li "Move slots " (:nxref :slot 'last-key :class-name 'buffer)
+        " and " (:nxref :slot 'key-stack :class-name 'buffer)
+        " from window to the buffer class.")
    (:li "Refactor renderer interface input handling.")
    (:li "Refactor custom schemes URLs API.")
    (:li "Deprecate slot " (:code "input-dispatcher")

source/describe.lisp

@@ -645,26 +645,15 @@ A command is a special kind of function that can be called with
         :command (typecase command
                    (symbol command)
                    (command (name command))))
-    (setf (command-dispatcher (current-window)) #'dispatch-command
-          (input-skip-dispatcher (current-window)) #'dispatch-input-skip)))
-
-(defun skip-describe-dispatch (keyspec)
-  (declare (ignore keyspec))
-  (echo "Canceled describe-key.")
-  (setf (command-dispatcher (current-window)) #'dispatch-command
-        (input-skip-dispatcher (current-window)) #'dispatch-input-skip))
+    (setf (command-dispatcher *browser*) #'dispatch-command)))
 
 (define-command describe-key ()
   "Display binding of user-inputted keys."
-  (setf (command-dispatcher (current-window)) #'describe-key-dispatch
-        (input-skip-dispatcher (current-window)) #'skip-describe-dispatch)
+  (setf (command-dispatcher *browser*) #'describe-key-dispatch)
   (echo "Press a key sequence to describe:"))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; TODO: Move rest somewhere else?  Maybe too low-level for help.lisp.
-
 (export-always 'system-information)
-(defun system-information ()            ; TODO: Rename report-system-information?
+(defun system-information ()
   "Return a system information report as a string."
   (labels ((->string (obj) (princ-to-string obj))
            (asdf-information ()

source/input.lisp

@@ -86,7 +86,7 @@ KEYCODE-LESS-DISPLAY (KEYCODE-DISPLAY)."
 (-> dispatch-command ((or sym:function-symbol function)) *)
 (export-always 'dispatch-command)
 (defun dispatch-command (function)
-  "Default `command-dispatcher'. Runs FUNCTION asynchronously."
+  "Runs FUNCTION asynchronously."
   (echo-dismiss)                        ; Clean up message-view on command.
   ;; TODO: Instead of hard-coding these ignored-commands, we could add a boolean
   ;; slot to the `command' class.
@@ -113,10 +113,10 @@ KEYCODE-LESS-DISPLAY (KEYCODE-DISPLAY)."
   (log:debug "Skipping input event key ~s" keyspecs))
 
 (export-always 'dispatch-input-event)
-(defun dispatch-input-event (event buffer window)
-  "Dispatch keys in WINDOW `key-stack'.
+(defun dispatch-input-event (event buffer)
+  "Dispatch keys in BUFFER `key-stack'.
 Return nil to forward to renderer or non-nil otherwise."
-  (with-accessors ((key-stack key-stack)) window
+  (with-accessors ((key-stack key-stack)) buffer
     (labels ((keyspecs (key &optional translated-key)
                (if translated-key
                    (let ((specs (keyspecs key))
@@ -129,9 +129,15 @@ Return nil to forward to renderer or non-nil otherwise."
                    (keyspecs-with-optional-keycode key))))
       (when (input-buffer-p buffer)
         (setf (last-event buffer) event))
+      (when (prompt-buffer-p buffer)
+        ;; Prompt buffer updating must happen on a separate thread.
+        (run-thread "update-prompt-buffer"
+          (update-prompt-input buffer
+                               (ps-eval :buffer buffer
+                                 (ps:chain (nyxt/ps:qs document "#input") value)))))
       (multiple-value-bind (bound-function matching-keymap translated-key)
           (the keyscheme:nyxt-keymap-value
-               (keymaps:lookup-key key-stack (current-keymaps)))
+               (keymaps:lookup-key key-stack (current-keymaps buffer)))
         (declare (ignore matching-keymap))
         (cond
           ((keymaps:keymap-p bound-function)
@@ -148,9 +154,9 @@ Return nil to forward to renderer or non-nil otherwise."
              ;; We save the last key separately to keep it available to the
              ;; command even after key-stack has been reset in the other
              ;; thread.
-             (setf (last-key window) (first key-stack))
+             (setf (last-key buffer) (first key-stack))
              (unwind-protect
-                  (funcall (command-dispatcher window) command)
+                  (funcall (command-dispatcher *browser*) command)
                ;; We must reset the key-stack on errors or else all subsequent
                ;; keypresses will keep triggering the same erroring command.
                (setf key-stack nil))
@@ -162,13 +168,6 @@ Return nil to forward to renderer or non-nil otherwise."
            (setf key-stack nil)
            nil)
 
-          ((and (input-buffer-p buffer) (not (forward-input-events-p buffer)))
-           ;; After checking `pointer-event-p', otherwise pointer events
-           ;; might not be forwarded.
-           (funcall (input-skip-dispatcher window) (keyspecs key-stack))
-           (setf key-stack nil)
-           t)
-
           (t
            (log:debug "Fallback forward key ~s" (keyspecs key-stack))
            (setf key-stack nil)

source/mode/repeat.lisp

@@ -122,17 +122,9 @@ repeating it like a regular `repeat-mode' does."
                            :function (lambda (mode)
                                        (declare (ignore mode))
                                        (nyxt::run command)))
-          (setf (command-dispatcher (current-window)) #'dispatch-command
-                (input-skip-dispatcher (current-window)) #'dispatch-input-skip
+          (setf (command-dispatcher *browser*) #'dispatch-command
                 *repeat-times-stack* 0)))))
 
-(defun skip-repeat-dispatch (keyspec)
-  "A stub copy of `dispatch-input-skip' customized for `repeat-mode'."
-  (declare (ignore keyspec))
-  (echo "Canceled repeat-key.")
-  (setf (command-dispatcher (current-window)) #'dispatch-command
-        (input-skip-dispatcher (current-window)) #'dispatch-input-skip))
-
 (define-command-global repeat-key
     (&key (times (let ((nyxt::*interactive-p* t))
                    (or
@@ -147,6 +139,5 @@ repeating it like a regular `repeat-mode' does."
                                :sources 'prompter:raw-source)))))))
   "Repeat the command bound to the user-pressed keybinding TIMES times."
   (setf *repeat-times-stack* (+ times (* 10 *repeat-times-stack*))
-        (command-dispatcher (current-window)) (make-repeat-command-dispatcher *repeat-times-stack*)
-        (input-skip-dispatcher (current-window)) #'skip-repeat-dispatch)
+        (command-dispatcher *browser*) (make-repeat-command-dispatcher *repeat-times-stack*))
   (echo "Press a key sequence for command to repeat ~R times:" *repeat-times-stack*))

source/renderer/electron.lisp

@@ -113,6 +113,9 @@
   (:documentation "Electron buffer class."))
 
 (defmethod initialize-instance :after ((buffer electron-buffer) &key extra-modes no-hook-p)
+  (electron:register-before-input-event buffer
+                                        (lambda (buffer event)
+                                          (on-signal-key-press-event buffer event)))
   (finalize-buffer buffer :extra-modes extra-modes :no-hook-p no-hook-p))
 
 ;; TODO Needed for resurrect-buffer.
@@ -327,12 +330,7 @@
                 :width-p t)
     (electron:load-url status-buffer "about:blank")
     ;; KLUDGE Without it, the window won't intercept input events.
-    (electron:load-url window "about:blank")
-    ;; Each window listens to input events.  Another approach would be to listen
-    ;; the each buffer.
-    (electron:register-before-input-event window
-                                          (lambda (win event)
-                                            (on-signal-key-press-event win event)))))
+    (electron:load-url window "about:blank")))
 
 (defmethod add-buffer ((window electron-window) (buffer electron-buffer)
                        &key (x 0) (y 0) (width 1000) (height 1000)
@@ -454,17 +452,16 @@ Return nil when key must be discarded, e.g. for modifiers."
     ("F12" "f12")
     (_ key-string)))
 
-(defmethod on-signal-key-press-event ((sender electron-window) event)
-  (let ((key-string (translate-key-string (rest (assoc :key event))))
-        (buffer (or (current-prompt-buffer) (nyxt::active-buffer sender))))
+(defmethod on-signal-key-press-event ((sender electron-buffer) event)
+  (let ((key-string (translate-key-string (rest (assoc :key event)))))
     (flet ((key () (keymaps:make-key :value key-string
                                      :modifiers (translate-modifiers event)
                                      :status :pressed)))
       (when key-string
         (alex:appendf (key-stack sender)
                       (list (key)))
-        (run-thread "on-signal-key-press" (on-signal-key-press buffer (key)))
-        (dispatch-input-event event buffer sender)))))
+        (run-thread "on-signal-key-press" (on-signal-key-press sender (key)))
+        (dispatch-input-event event sender)))))
 
 (defmethod on-signal-key-release-event ((sender electron-window) event)
   (declare (ignore sender event)))

source/renderer/gi-gtk.lisp

@@ -35,14 +35,9 @@ For now it is also partly based on `nyxt/renderer/gtk'."))
 (defmethod nyxt/renderer/gtk::renderer-thread-p ((renderer gi-gtk-renderer)
                                                  &optional (thread (bt:current-thread)))
   (string= (bt:thread-name thread)
-           #+darwin
-           "thread"
-           #-darwin
            renderer-thread-name))
 
 (defmethod ffi-initialize ((browser gi-gtk-browser) urls startup-timestamp)
-  "On GNU/Linux we can create a separate thread to launch the GTK
-interface. On Darwin, we must run the GTK thread on the main thread."
   (declare (ignore urls startup-timestamp))
   (log:debug "Initializing GI-GTK Interface")
   (if nyxt/renderer/gtk::gtk-running-p
@@ -56,14 +51,11 @@ interface. On Darwin, we must run the GTK thread on the main thread."
                  (gir:invoke ((gir:ffi "Gtk" "3.0") 'main)))))
         (setf nyxt/renderer/gtk::gtk-running-p t)
         (call-next-method)
-        #-darwin
         (let ((main-thread (bt:make-thread #'main-func :name renderer-thread-name)))
           (unless nyxt::*run-from-repl-p*
             (bt:join-thread main-thread)
             ;; See comment about FreeBSD in gtk.lisp
-            (uiop:quit (slot-value browser 'nyxt::exit-code) #+freebsd nil)))
-        #+darwin
-        (main-func))))
+            (uiop:quit (slot-value browser 'nyxt::exit-code) #+freebsd nil))))))
 
 (nyxt/renderer/gtk:define-ffi-method ffi-kill-browser ((browser gi-gtk-browser))
   (unless nyxt::*run-from-repl-p*