From 04dcd3a67e1f5e3b63b55071d3bd67653582a12d Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 14 Jan 2026 19:53:41 +0200 Subject: [PATCH 01/63] rewrite keymap system --- extensions/vi-mode/binds.lisp | 26 ++- extensions/vi-mode/core.lisp | 14 +- extensions/vi-mode/states.lisp | 3 +- src/internal-packages.lisp | 7 +- src/keymap.lisp | 382 ++++++++++++++++++++++++++------- 5 files changed, 331 insertions(+), 101 deletions(-) diff --git a/extensions/vi-mode/binds.lisp b/extensions/vi-mode/binds.lisp index 2732a15c6..5282af236 100644 --- a/extensions/vi-mode/binds.lisp +++ b/extensions/vi-mode/binds.lisp @@ -7,8 +7,6 @@ :lem-vi-mode/commands :lem-vi-mode/ex :lem-vi-mode/visual) - (:import-from :lem-core - :keymap-table) (:import-from :lem/prompt-window :prompt-previous-history :prompt-next-history)) @@ -201,11 +199,19 @@ (define-key *outer-text-objects-keymap* "p" 'vi-a-paragraph) (define-key *inner-text-objects-keymap* "p" 'vi-inner-paragraph) -(setf (gethash (lem:make-key :sym "a") (keymap-table *operator-keymap*)) - (keymap-table *outer-text-objects-keymap*)) -(setf (gethash (lem:make-key :sym "i") (keymap-table *operator-keymap*)) - (keymap-table *inner-text-objects-keymap*)) -(setf (gethash (lem:make-key :sym "a") (keymap-table *visual-keymap*)) - (keymap-table *outer-text-objects-keymap*)) -(setf (gethash (lem:make-key :sym "i") (keymap-table *visual-keymap*)) - (keymap-table *inner-text-objects-keymap*)) +(lem-core:keymap-add-prefix + *operator-keymap* + (lem:make-prefix :key (lem:make-key :sym "a") + :suffix *outer-text-objects-keymap*)) +(lem-core:keymap-add-prefix + *operator-keymap* + (lem:make-prefix :key (lem:make-key :sym "i") + :suffix *inner-text-objects-keymap*)) +(lem-core:keymap-add-prefix + *visual-keymap* + (lem:make-prefix :key (lem:make-key :sym "a") + :suffix *outer-text-objects-keymap*)) +(lem-core:keymap-add-prefix + *visual-keymap* + (lem:make-prefix :key (lem:make-key :sym "i") + :suffix *inner-text-objects-keymap*)) diff --git a/extensions/vi-mode/core.lisp b/extensions/vi-mode/core.lisp index 45e8a0a91..c5ad329b8 100644 --- a/extensions/vi-mode/core.lisp +++ b/extensions/vi-mode/core.lisp @@ -266,16 +266,14 @@ `(let ((*vi-current-window* ,window)) ,@body)) -(defstruct (vi-keymap (:include keymap) - (:constructor %make-vi-keymap))) +(defclass vi-keymap (keymap*) + ()) (defun make-vi-keymap (&rest args &key undef-hook parent name) (declare (ignore undef-hook parent name)) - (let ((keymap (apply #'%make-vi-keymap args))) - (push keymap *keymaps*) - keymap)) + (apply 'make-instance 'vi-keymap (alexandria:remove-from-plist args :parent))) -(defmacro define-keymap (name &key undef-hook parent) +(defmacro define-keymap (name &key undef-hook) + (declare (ignore parent)) `(defvar ,name (make-vi-keymap :name ',name - :undef-hook ,undef-hook - :parent ,parent))) + :undef-hook ,undef-hook))) diff --git a/extensions/vi-mode/states.lisp b/extensions/vi-mode/states.lisp index af09a2d66..add88e4ab 100644 --- a/extensions/vi-mode/states.lisp +++ b/extensions/vi-mode/states.lisp @@ -44,7 +44,8 @@ (defvar *emacs-keymap* *global-keymap*) (define-keymap *motion-keymap*) -(define-keymap *normal-keymap* :parent *motion-keymap*) +(define-keymap *normal-keymap*) +(keymap-add-child *normal-keymap* *motion-keymap*) (define-keymap *insert-keymap*) (define-keymap *operator-keymap*) (define-keymap *replace-char-state-keymap* :undef-hook 'return-last-read-char) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index 00c91875f..b486fdfad 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -470,10 +470,13 @@ (:export :*keymaps* :keymap + :keymap* + :*root-keymap* :keymap-name :keymap-parent :keymap-undef-hook :make-keymap + :make-prefix :*global-keymap* :define-key :define-keys @@ -489,7 +492,9 @@ :with-special-keymap :traverse-keymap :compute-keymaps - :collect-command-keybindings) + :collect-command-keybindings + :keymap-add-child + :keymap-add-prefix) ;; reexport common/timer (:export :timer diff --git a/src/keymap.lisp b/src/keymap.lisp index 12d8bc14e..54e7e55e6 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -1,8 +1,121 @@ (in-package :lem-core) -(defvar *keymaps* nil) +(defmacro defclass-dynamic (name direct-superclasses direct-slots &rest options) + "defines a class with support for 'dynamic' slots. -(defvar *special-keymap* nil) +slots with the :dynamic t option will have accessors that automatically handle values which are functions. +if a dynamic slot contains a function, the accessor will call it and return the result. otherwise, +it returns the value directly. +the underlying storage slot is renamed with a '*' suffix." + (let ((dynamic-slots + (loop :for slot :in direct-slots + :when (getf (cdr slot) :dynamic) + :collect slot))) + (setf direct-slots + (loop :for slot :in direct-slots + :collect (if (getf (cdr slot) :dynamic) + (let* ((slot-name (first slot)) + (accessor-name + (intern (format nil "~A-~A" name slot-name))) + (internal-accessor-name + (intern (format nil "~A*" accessor-name))) + (new-slot (copy-list slot))) + (remf (cdr new-slot) :dynamic) + (setf (getf (cdr new-slot) :accessor) + internal-accessor-name) + new-slot) + slot))) + `(progn + (defclass ,name ,direct-superclasses + ,direct-slots + ,@options) + ,@(loop :for slot :in dynamic-slots + :for slot-name := (first slot) + :for accessor := (intern (format nil "~A-~A" name slot-name)) + :for internal-accessor := (intern (format nil "~A*" accessor)) + :collect `(defmethod ,accessor ((object ,name)) + (let ((value (,internal-accessor object))) + (if (functionp value) + (funcall value) + value))) + :collect `(defmethod (setf ,accessor) (new-value (object ,name)) + (setf (,internal-accessor object) new-value)))))) + +;; a non-suffix prefix cannot be a keymap, thats why keymap doesnt inherit from prefix. this makes sense because a "prefix keymap" is a keymap that shares a common prefix, but the root map for example may contain keybindings with no prefixes. +(defclass-dynamic prefix () + ((key + :initarg :key + :dynamic t + :documentation "the key defined for the prefix. could be a function that returns a key.") + (description + :initarg :description + :accessor prefix-description) + (suffix + :initarg :suffix + :accessor prefix-suffix + :documentation "the suffix defined for the prefix, could be another prefix or a keymap or a function that returns one.") + (show-p + :initarg :show-p + :accessor prefix-show-p + :documentation "whether to show the children menu." + :initform nil) + (hidden-p + :initarg :hidden-p + :accessor prefix-hidden-p + :documentation "whether to hide/show a prefix in its parent menu." + :initform nil) + (active-p + :initarg :active-p + :accessor prefix-active-p + :documentation "whether a prefix is active." + :initform t) + (metadata + :initarg :metadata + :accessor prefix-metadata + :documentation "extra metadata that a prefix may hold."))) + +(defun make-prefix (&key key suffix) + (let ((prefix (make-instance + 'prefix + :key key + :suffix suffix))) + prefix)) + +(defclass-dynamic keymap () + ;; children could contain keymaps or prefixes. + ((children + :initarg :children + :dynamic t + :initform nil + :documentation "the children of the keymap. could be a function that returns a list of children."))) + +(defmethod keymap-add-prefix ((keymap keymap) (prefix prefix)) + (unless (listp (keymap-children* keymap)) + (error "trying to add key to a non-static keymap.")) + (push prefix (keymap-children* keymap))) + +(defmethod keymap-add-child ((keymap keymap) (keymap2 keymap)) + (unless (listp (keymap-children* keymap)) + (error "trying to add nested keymap to a non-static keymap.")) + (push keymap2 (keymap-children* keymap))) + +(defgeneric prefix-p (keymap) + (:documentation "check whether this is a prefix of another prefix. + +a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) + +(defmethod prefix-p ((km keymap)) + t) + +(defmethod prefix-p ((p prefix)) + (or (typep (prefix-suffix p) 'prefix) + (typep (prefix-suffix p) 'keymap))) + +(defgeneric keymap-activate (keymap) + (:documentation "a hook for when a keymap is entered by some prefix.") + ;; default keymap-activate does nothing + (:method ((keymap t)) + nil)) (deftype key-sequence () '(trivial-types:proper-list key)) @@ -11,12 +124,25 @@ (check-type key-sequence key-sequence) (format nil "~{~A~^ ~}" key-sequence)) -(defstruct (keymap (:constructor %make-keymap)) - undef-hook - parent - (table (make-hash-table :test 'eq)) - (function-table (make-hash-table :test 'eq)) - name) +;; this is for backwards compatibility for now +(defclass keymap* (keymap) + ((undef-hook + :initarg :undef-hook + :accessor keymap-undef-hook + :initform nil) + (function-table + :initarg :function-table + :accessor keymap-function-table + :initform (make-hash-table :test 'eq)) + (name + :initarg :name + :accessor keymap-name + :initform nil))) + +;; *root-keymap* contains all keymaps as (possibly nested, possibly "dynamic") children +(defvar *root-keymap* (make-instance 'keymap*)) + +(defvar *special-keymap* nil) (defmethod print-object ((object keymap) stream) (print-unreadable-object (object stream :identity t :type t) @@ -24,17 +150,18 @@ (princ (keymap-name object) stream)))) (defun make-keymap (&key undef-hook parent name) - (let ((keymap (%make-keymap + (let ((keymap (make-instance + 'keymap* :undef-hook undef-hook - :parent parent :name name))) - (push keymap *keymaps*) keymap)) (defun prefix-command-p (command) - (hash-table-p command)) + (and (or (typep command 'keymap) + (typep command 'prefix)) + (prefix-p command))) -(defun define-key (keymap keyspec command-name) +(defmethod define-key ((keymap keymap) keyspec command-name) "Bind a command COMMAND-NAME to a KEYSPEC in a KEYMAP. Global bindings use `*global-keymap*' as KEYMAP argument. @@ -62,19 +189,53 @@ Example: (define-key *global-keymap* \"C-'\" 'list-modes)" ,(second binding))) bindings))) -(defun define-key-internal (keymap keys symbol) - (loop :with table := (keymap-table keymap) - :for rest :on (uiop:ensure-list keys) - :for k := (car rest) - :do (cond ((null (cdr rest)) - (setf (gethash k table) symbol)) - (t - (let ((next (gethash k table))) - (if (and next (prefix-command-p next)) - (setf table next) - (let ((new-table (make-hash-table :test 'eq))) - (setf (gethash k table) new-table) - (setf table new-table)))))))) +;; this takes a single key and not a key sequence +;; i think this could be split into 2 defmethods but ill leave it for now +(defun prefix-for-key (binding key) + "takes a keymap or a prefix, returns the prefix that corresponds to the given key (could be just BINDING)." + (check-type binding (or prefix keymap)) + (cond ((typep binding 'prefix) + (when (equal (prefix-key binding) key) + binding)) + ((typep binding 'keymap) + (loop for item in (keymap-children binding) + for p = (prefix-for-key item key) + do (when p + (return p)))))) + +(defmethod define-key-internal ((keymap keymap) keys symbol) + (let* ((rest (uiop:ensure-list keys)) + (k (car rest))) + (if (null (cdr rest)) + ;; if theres no more keys in the sequence we simply bind the last key. + (let ((prefix (prefix-for-key keymap k))) + (if prefix + (setf (prefix-suffix prefix) symbol) + ;; if we didnt find a pre-existing prefix we insert one + (keymap-add-prefix keymap (make-prefix :key k :suffix symbol)))) + ;; here we're creating intermediate keymaps to bind the keys in the sequence + ;; one by one. which is the way emacs does it, and the way lem used to it. + ;; but it should be possible to completely bind the sequence to prefixes that + ;; lead to one another. + (let* ((next-prefix (prefix-for-key keymap k)) + (next-keymap)) + ;; we expect the suffix of next-prefix to be a keymap, if next-prefix isnt yet + ;; existent we create a prefixed keymap and work with it. + (if next-prefix + (let ((suffix (prefix-suffix next-prefix))) + (if (typep suffix 'keymap) + (setf next-keymap suffix) + ;; suffix is a command, need to create intermediate keymap. but why would we get here? + (progn + (setf next-keymap (make-instance 'keymap*)) + (setf (prefix-suffix next-prefix) next-keymap)))) + (progn + (setf next-keymap (make-instance 'keymap*)) + (setf next-prefix + (make-prefix :suffix next-keymap + :key k)) + (keymap-add-prefix keymap next-prefix))) + (define-key-internal next-keymap (cdr rest) symbol))))) (defun undefine-key (keymap keyspec) "Remove a binding for a KEYSPEC in a KEYMAP. @@ -141,42 +302,71 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" str)))))))) (mapcar #'parse (uiop:split-string string :separator " ")))) -(defun traverse-keymap (keymap fun) - (labels ((f (table prefix) - (maphash (lambda (k v) - (cond ((prefix-command-p v) - (f v (cons k prefix))) - ((keymap-p v) - (f (keymap-table v) (cons k prefix))) - (t (funcall fun (reverse (cons k prefix)) v)))) - table))) - (f (keymap-table keymap) nil))) - -(defgeneric keymap-find-keybind (keymap key cmd) - (:method ((keymap t) key cmd) - (let ((table (keymap-table keymap))) - (labels ((f (k) - (let ((cmd (gethash k table))) - (cond ((prefix-command-p cmd) - (setf table cmd)) - ((keymap-p cmd) - (setf table (keymap-table cmd))) - (t cmd))))) - (let ((parent (keymap-parent keymap))) - (when parent - (setf cmd (keymap-find-keybind parent key cmd)))) - (or (etypecase key - (key - (f key)) - (list - (let (cmd) - (dolist (k key) - (unless (setf cmd (f k)) - (return))) - cmd))) - (gethash cmd (keymap-function-table keymap)) - (keymap-undef-hook keymap) - cmd))))) +(defun find-matching-prefixes (binding key) + "find prefixes in children that match KEY." + (cond ((typep binding 'prefix) + (when (equal (prefix-key binding) key) + (list binding))) + ((typep binding 'keymap) + (loop for item in (keymap-children binding) + append (find-matching-prefixes item key))))) + +(defun find-in-function-table (binding key) + "search function-table of keymaps in hierarchy for KEY." + (cond ((typep binding 'keymap*) + (let ((result)) + (maphash (lambda (k v) + (when (and (null result) (equal k key)) + (setf result (if (prefix-command-p v) + v + (make-prefix :key k :suffix v))))) + (keymap-function-table binding)) + ;; if found, return it; otherwise search children + (or result + (loop for child in (keymap-children binding) + thereis (find-in-function-table child key))))) + ((typep binding 'keymap) + (loop for child in (keymap-children binding) + thereis (find-in-function-table child key))) + ((typep binding 'prefix) + (find-in-function-table (prefix-suffix binding) key)))) + +(defun find-undef-hook-in-hierarchy (binding) + "find the first undef-hook from active keymaps." + (declare (ignore binding)) + (loop for km in (all-keymaps) + when (and (typep km 'keymap*) (keymap-undef-hook km)) + return (keymap-undef-hook km))) + +(defmethod find-suffix ((keymap keymap) keyseq) + "search KEYMAP tree for exact binding matching KEYSEQ." + (labels ((search-tree (binding keys) + (if (null keys) + (if (typep binding 'prefix) + (prefix-suffix binding) + binding) + ;; try all matches and return first successful result + (loop for match in (find-matching-prefixes binding (car keys)) + for result = (search-tree (prefix-suffix match) (cdr keys)) + when result return result)))) + (search-tree keymap keyseq))) + +;; this is currently here for backwards compatibility +;; im not yet sure whether 'cmd' or function-table lookup is necessary (i think so but im not sure how to get rid of it.) +(defmethod keymap-find-keybind ((keymap keymap) key cmd) + (let ((keyseq (etypecase key + (key (list key)) + (list key)))) + (or ;; search children prefixes + (find-suffix keymap keyseq) + ;; search function-table in hierarchy + (find-in-function-table keymap (car keyseq)) + ;; check function-table for cmd symbol + (gethash cmd (keymap-function-table keymap)) + ;; find undef-hook in hierarchy (e.g. self-insert) + (find-undef-hook-in-hierarchy keymap) + ;; return cmd as fallback + cmd))) (defun insertion-key-p (key) (let* ((key (typecase key @@ -194,29 +384,59 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (:method ((mode global-mode)) nil)) (defun all-keymaps () - (let* ((keymaps (compute-keymaps (current-global-mode))) - (keymaps - (append keymaps - (alexandria:when-let* ((mode (major-mode-at-point (current-point))) - (keymap (mode-keymap mode))) - (list keymap)) - (loop :for mode :in (all-active-modes (current-buffer)) - :when (mode-keymap mode) - :collect :it)))) + ;; build list in reverse priority order, then nreverse at end + ;; lower priority first, higher priority last (before nreverse) + (let* ((keymaps nil)) + ;; first add global/minor modes (lowest priority) + (dolist (mode (all-active-modes (current-buffer))) + (when (mode-keymap mode) + (push (mode-keymap mode) keymaps))) + ;; add major-mode keymap + (alexandria:when-let* ((mode (major-mode-at-point (current-point))) + (keymap (mode-keymap mode))) + (push keymap keymaps)) + ;; add state keymaps from compute-keymaps (highest priority) + (dolist (km (compute-keymaps (current-global-mode))) + (push km keymaps)) + ;; special keymap has highest priority (when *special-keymap* (push *special-keymap* keymaps)) - (delete-duplicates (nreverse keymaps)))) + (delete-duplicates keymaps))) -(defun lookup-keybind (key &key (keymaps (all-keymaps))) - (let (cmd) - (loop :for keymap :in keymaps - :do (setf cmd (keymap-find-keybind keymap key cmd))) - cmd)) +;; this is for some "other" keymaps that i need to inject into the root-keymap (atleast this way for now). +;; we could make *root-keymap* itself have dynamic children and inject those into it but i dont want that, +;; so we create a second-level keymap as the root for all 'other-keymaps' and inject that keymap +;; into *root-keymap* +(defun other-keymaps () + (all-keymaps)) +(defparameter *other-keymaps-root* + (make-instance 'keymap* + :children #'other-keymaps)) + +(defun lookup-keybind (key) + (unless (find *other-keymaps-root* (keymap-children *root-keymap*)) + (keymap-add-child *root-keymap* *other-keymaps-root*)) + (keymap-find-keybind *root-keymap* key nil)) (defun find-keybind (key) - (let ((cmd (lookup-keybind key))) - (when (symbolp cmd) - cmd))) + (let ((result (keymap-find-keybind *root-keymap* key nil))) + (when result + result))) + +(defun traverse-keymap (keymap fun) + (labels ((f (node prefix) + (cond ((typep node 'keymap) + (mapc (lambda (child) (f child prefix)) + (keymap-children node))) + ((typep node 'prefix) + (let ((key (prefix-key node)) + (suffix (prefix-suffix node))) + (cond ((or (typep suffix 'keymap) + (typep suffix 'prefix)) + (f suffix (cons key prefix))) + (t + (funcall fun (reverse (cons key prefix)) suffix)))))))) + (f keymap nil))) (defun collect-command-keybindings (command keymap) (let ((bindings '())) @@ -234,4 +454,4 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (defmacro with-special-keymap ((keymap) &body body) `(let ((*special-keymap* (or ,keymap *special-keymap*))) - ,@body)) + ,@body)) \ No newline at end of file From eb57d77c7bcb4ae9a93a28e32f79965c08e463b7 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 14 Jan 2026 23:58:50 +0200 Subject: [PATCH 02/63] introduce keymap-activate and initialize transient.lisp --- extensions/transient/transient.asd | 3 +++ extensions/transient/transient.lisp | 11 +++++++++++ lem.asd | 1 + src/commands/help.lisp | 1 - src/input.lisp | 10 ++++++---- src/internal-packages.lisp | 3 +-- 6 files changed, 22 insertions(+), 7 deletions(-) create mode 100644 extensions/transient/transient.asd create mode 100644 extensions/transient/transient.lisp diff --git a/extensions/transient/transient.asd b/extensions/transient/transient.asd new file mode 100644 index 000000000..c6d2a4c1d --- /dev/null +++ b/extensions/transient/transient.asd @@ -0,0 +1,3 @@ +(defsystem "transient" + :depends-on ("lem/core") + :components ((:file "transient"))) \ No newline at end of file diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp new file mode 100644 index 000000000..4ca6f6302 --- /dev/null +++ b/extensions/transient/transient.lisp @@ -0,0 +1,11 @@ +(defpackage :transient + (:use :cl :lem) + (:export)) + +(in-package :transient) + +(defmethod keymap-activate ((keymap (eql *root-keymap*))) + (log:info "activated root keymap~%")) + +(defmethod keymap-activate ((keymap keymap)) + (log:info "activated ~A~%" keymap)) \ No newline at end of file diff --git a/lem.asd b/lem.asd index 7b99888d3..021e567af 100644 --- a/lem.asd +++ b/lem.asd @@ -297,6 +297,7 @@ "lem-claude-code" "lem-bookmark" "lem-mcp-server" + "transient" #+sbcl "lem-living-canvas" "lem-tree-sitter" diff --git a/src/commands/help.lisp b/src/commands/help.lisp index 2906dd79a..2b1daa243 100644 --- a/src/commands/help.lisp +++ b/src/commands/help.lisp @@ -38,7 +38,6 @@ column-width (keyseq-to-string kseq) (symbol-name command))))) - (setf keymap (keymap-parent keymap)) (terpri s)))) (define-command describe-bindings () () diff --git a/src/input.lisp b/src/input.lisp index 7b88470fb..83f06edb4 100644 --- a/src/input.lisp +++ b/src/input.lisp @@ -76,16 +76,18 @@ (set-last-mouse-event event) (find-mouse-command event)) (key - (let* ((cmd (lookup-keybind event)) + (let* ((result (lookup-keybind event)) (kseq (list event))) (loop - (cond ((prefix-command-p cmd) + (cond ((prefix-command-p result) + (when (typep result 'keymap) + (keymap-activate result)) (let ((event (read-key))) (setf kseq (nconc kseq (list event))) - (setf cmd (lookup-keybind kseq)))) + (setf result (lookup-keybind kseq)))) (t (set-last-read-key-sequence kseq) - (return cmd))))))))) + (return result))))))))) (defun read-key-sequence () (read-command) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index b486fdfad..d90dcfd7d 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -468,13 +468,12 @@ :paste-using-mode) ;; keymap.lisp (:export - :*keymaps* :keymap :keymap* :*root-keymap* :keymap-name - :keymap-parent :keymap-undef-hook + :keymap-activate :make-keymap :make-prefix :*global-keymap* From 7a213e7e22529c708bbc0f163d3bc868bd8bd27c Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 15 Jan 2026 00:32:02 +0200 Subject: [PATCH 03/63] add simple popup --- extensions/transient/transient.lisp | 36 +++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp index 4ca6f6302..905cc791b 100644 --- a/extensions/transient/transient.lisp +++ b/extensions/transient/transient.lisp @@ -4,8 +4,40 @@ (in-package :transient) +(defvar *transient-popup-window* nil) + +(defun show-transient-popup (keymap) + (let* ((buffer (make-buffer "*transient*" :temporary t :enable-undo-p nil)) + (out (make-buffer-output-stream (buffer-point buffer)))) + (erase-buffer buffer) + (format out "Keymap: ~A~%" (keymap-name keymap)) + (format out "~%bindings:~%") + (traverse-keymap keymap + (lambda (kseq cmd) + (format out "~A ~A~%" + (keyseq-to-string kseq) + cmd))) + (buffer-start (buffer-point buffer)) + (let ((width (lem/popup-window::compute-buffer-width buffer)) + (height (lem/popup-window::compute-buffer-height buffer))) + (if (and *transient-popup-window* + (not (deleted-window-p *transient-popup-window*))) + (lem/popup-window::update-popup-window :destination-window *transient-popup-window* + :source-window (current-window) + :width width + :height height) + (setf *transient-popup-window* + (lem/popup-window::make-popup-window :source-window (current-window) + :buffer buffer + :width width + :height height + :style '(:gravity :topright))))) + (redraw-display))) + (defmethod keymap-activate ((keymap (eql *root-keymap*))) - (log:info "activated root keymap~%")) + (log:info "activated root keymap~%") + (show-transient-popup keymap)) (defmethod keymap-activate ((keymap keymap)) - (log:info "activated ~A~%" keymap)) \ No newline at end of file + (log:info "activated ~A~%" keymap) + (show-transient-popup keymap)) \ No newline at end of file From e3f6d6a221fcce9188924705e269b73e091beeaa Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sun, 18 Jan 2026 21:36:48 +0200 Subject: [PATCH 04/63] make popup more informative --- extensions/transient/demo.lisp | 50 +++++ extensions/transient/keymap.lisp | 92 ++++++++ extensions/transient/popup.lisp | 335 ++++++++++++++++++++++++++++ extensions/transient/transient.asd | 5 +- extensions/transient/transient.lisp | 42 +--- src/input.lisp | 1 + src/internal-packages.lisp | 9 + src/keymap.lisp | 87 +++++--- 8 files changed, 543 insertions(+), 78 deletions(-) create mode 100644 extensions/transient/demo.lisp create mode 100644 extensions/transient/keymap.lisp create mode 100644 extensions/transient/popup.lisp diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp new file mode 100644 index 000000000..0882ca572 --- /dev/null +++ b/extensions/transient/demo.lisp @@ -0,0 +1,50 @@ +(in-package :transient) + +(define-transient *demo-keymap* + :display-style :row + (:keymap + :display-style :column + :description "file operations" + (:key "o" :suffix demo-open :description "demo open") + (:key "s" :suffix demo-save :description "demo save (disabled)" :active-p nil) + (:key "w" :suffix demo-write :description "demo write") + (:key "x" + :suffix (:keymap + (:key "p" :suffix demo-pdf :description "pdf") + (:key "h" :suffix demo-html :description "html") + (:key "m" :suffix demo-md :description "markdown")) + :description "export format")) + (:keymap + :display-style :column + :description "edit operations" + (:key "c" :suffix demo-copy) + (:key "v" :suffix demo-paste) + (:key "u" :suffix demo-undo)) + (:key "f" + :suffix (:keymap + (:key "g" :suffix demo-grep :description "grep") + (:key "f" :suffix demo-find :description "find") + (:key "r" :suffix demo-replace :description "replace")) + :description "search menu") + (:key "t" + :suffix (:keymap + :display-style :row + (:keymap + :description "languages" + (:key "l" + :type :choice + :choices ("lisp" "python" "js") + :description "mode")) + (:keymap + :description "editor" + (:key "v" + :type :choice + :choices ("vim" "emacs") + :description "keys"))) + :description "langs demo") + (:key "d" + :type :choice + :choices ("on" "off") + :description "debug toggle")) + +(define-key *global-keymap* "C-c t" *demo-keymap*) \ No newline at end of file diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp new file mode 100644 index 000000000..e5bcf35e1 --- /dev/null +++ b/extensions/transient/keymap.lisp @@ -0,0 +1,92 @@ +(in-package :transient) + +(defmethod keymap-activate ((keymap keymap)) + (log:info "keymap ~A activated" keymap) + (show-transient keymap)) + +(defmacro add-dynamic-property (class-name properties-accessor property-name &optional default-value) + "define - getter and setter methods. + +the getter retrieves from PROPERTIES-ACCESSOR using :PROPERTY-NAME as key. +if the value is a function, it funcalls it. the setter stores directly. +if DEFAULT-VALUE is provided and non-nil, it is used as the default for getf." + (let* ((keyword (intern (symbol-name property-name) :keyword)) + (getter-name (intern (format nil "~A-~A" class-name property-name))) + (obj-sym (gensym "OBJ"))) + `(progn + (defmethod ,getter-name ((,obj-sym ,class-name)) + (let ((prop ,(if default-value + `(getf (,properties-accessor ,obj-sym) ,keyword ,default-value) + `(getf (,properties-accessor ,obj-sym) ,keyword)))) + (if (functionp prop) + (funcall prop) + prop))) + (defmethod (setf ,getter-name) (val (,obj-sym ,class-name)) + (setf (getf (,properties-accessor ,obj-sym) ,keyword) val))))) + +(add-dynamic-property keymap keymap-properties show-p t) +(add-dynamic-property prefix prefix-properties show-p t) + +(defgeneric prefix-render (prefix) + (:documentation "render prefix into a layout item. returns nil to use default rendering.")) + +;; should return :row or :column +(defmethod keymap-display-style ((keymap keymap)) + (getf (keymap-properties keymap) :display-style :row)) + +(defmethod (setf keymap-display-style) (val (keymap keymap)) + (setf (getf (keymap-properties keymap) :display-style) val)) + +(defclass choice (prefix) + ((choices + :accessor prefix-choices))) + +(defmacro define-transient (name &body bindings) + `(defparameter ,name (parse-transient ',bindings))) + +(defun parse-transient (bindings) + (let ((keymap (make-keymap))) + (loop for tail = bindings then (cdr tail) + while tail + do (let ((binding (car tail))) + (cond + ;; inline property + ((keywordp binding) + (let ((val (second tail))) + (setf (getf (keymap-properties keymap) binding) val)) + ;; advance another cell because we're already consumed it (second tail) + (setf tail (cdr tail))) + ;; direct child keymap (:keymap ...) + ((eq (car binding) :keymap) + (let ((sub-map (parse-transient (cdr binding)))) + (keymap-add-child keymap sub-map t))) + ;; key binding (:key ...) + ((eq (car binding) :key) + (let* ((key (second binding)) + ;; prefix-class depends on the first cell in the :suffix value (if its a list at all) + (prefix-type (intern (symbol-name (getf binding :type 'prefix)))) + (prefix (make-instance prefix-type))) + (setf (prefix-key prefix) (car (parse-keyspec key))) + ;; sometimes the suffix will not be set (e.g. prefix-type is :choice). we + ;; initialize it to nil to avoid unbound errors. + (setf (prefix-suffix prefix) nil) + (loop for (key value) on (cddr binding) by 'cddr + ;; key-method is used for (setf prefix- ) + for key-method = (intern (format nil "PREFIX-~A" (string key))) + do (let ((setf-expr `(setf (,key-method prefix) value)) + (final-value) + (should-set t)) + (cond + ;; if the suffix is a keymap we need to parse recursively + ((and (listp value) (eq (car value) :keymap)) + (setf final-value (parse-transient value))) + ((eq key :type) + (setf should-set nil)) + (t + (setf final-value value))) + (when should-set + (funcall (fdefinition (list 'setf key-method)) + final-value + prefix)))) + (keymap-add-prefix keymap prefix t)))))) + keymap)) \ No newline at end of file diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp new file mode 100644 index 000000000..c4432fbd0 --- /dev/null +++ b/extensions/transient/popup.lisp @@ -0,0 +1,335 @@ +(in-package :transient) + +(defvar *transient-popup-window* nil) + +(defvar *transient-popup-max-lines* 20) + +(defvar *transient-popup-max-width* 80) + +(defparameter *transient-window-margin* 4 + "margin in columns from the edge of the screen.") + +(defparameter *transient-column-separator* " | " + "string used to separate columns in row layout.") + +(define-attribute transient-key-attribute + (t + :foreground (attribute-foreground (ensure-attribute 'syntax-function-name-attribute)))) + +(define-attribute transient-title-attribute + (t + :foreground (attribute-foreground (ensure-attribute 'document-header1-attribute)) + :bold (attribute-bold (ensure-attribute 'document-header1-attribute)))) + +(define-attribute transient-separator-attribute + (t + :foreground (attribute-foreground (ensure-attribute 'modeline-inactive)))) + +(define-attribute transient-bracket-attribute + (t + :foreground (attribute-foreground (ensure-attribute 'syntax-string-attribute)))) + +(define-attribute transient-inactive-attribute + (t + :foreground (attribute-foreground (ensure-attribute 'syntax-comment-attribute)) + :background (attribute-background (ensure-attribute 'syntax-comment-attribute)))) + +;; custom floating window class that repositions on each redraw +(defclass transient-popup-window (floating-window) + ((base-width :initarg :base-width :accessor transient-base-width) + (base-height :initarg :base-height :accessor transient-base-height))) + +(defun compute-bottom-offset () + "compute the offset from the bottom of the display where the transient popup should appear. + +this accounts for the status line if present, the prompt window if active, and the bottom +completion interface if present." + (let ((offset (if (window-use-modeline-p (current-window)) + 1 + 0))) + ;; add height of prompt window if it exists + (alexandria:when-let ((prompt-window (lem/prompt-window:current-prompt-window))) + (incf offset (window-height prompt-window)) + ;; add height of completion window if it exists + (when lem/completion-mode::*completion-context* + (alexandria:when-let* ((context lem/completion-mode::*completion-context*) + (popup-menu (lem/completion-mode::context-popup-menu context)) + (completion-window (lem/popup-menu::popup-menu-window popup-menu))) + (incf offset (window-height completion-window))))) + offset)) + +(defun compute-transient-position (width height) + (let* ((bottom-offset (compute-bottom-offset)) + ;; position above minibuffer area: y = display-height - height - bottom-offset - border + (y (max 0 (- (display-height) height bottom-offset 2))) + (x (max 0 (- (display-width) width *transient-window-margin*)))) + (values x y))) + +(defmethod window-redraw ((window transient-popup-window) force) + "reposition the transient popup on each redraw to stay above the minibuffer/completion." + (let ((width (transient-base-width window)) + (height (transient-base-height window))) + (multiple-value-bind (x y) (compute-transient-position width height) + (window-set-pos window x y))) + (call-next-method)) + +(defstruct layout-separator + "a visual separator between items.") + +(defstruct layout-item + "a single displayable item (prefix binding)" + key + description + (key-attribute 'transient-key-attribute) + description-attribute) + +(defstruct layout-title + "a title/header for a keymap section." + text) + +(defstruct layout-row + "items arranged horizontally." + items) + +(defstruct layout-column + "items arranged vertically." + items + ;; max key width for even spacing + (key-width 0)) + +(defun get-description (prefix) + (let ((desc (prefix-description prefix))) + (if desc + (princ-to-string desc) + (let ((suffix (prefix-suffix prefix))) + (cond ((typep suffix 'keymap) + (princ-to-string (or (keymap-name suffix) "+prefix"))) + ((typep suffix 'prefix) + (or (prefix-description suffix) "+prefix")) + (t (princ-to-string suffix))))))) + +(defmethod prefix-render ((prefix prefix)) + (make-layout-item + :key (princ-to-string (prefix-key prefix)) + :description (get-description prefix))) + +(defmethod prefix-render ((prefix choice)) + (let* ((desc (get-description prefix)) + (choices (prefix-choices prefix)) + (choices-str (format nil "~{~A~^/~}" choices))) + (let ((description-segments + (list (cons desc nil) + (cons " " nil) + (cons "[" 'transient-bracket-attribute) + (cons choices-str nil) + (cons "]" 'transient-bracket-attribute)))) + (make-layout-item + :key (princ-to-string (prefix-key prefix)) + :description description-segments)))) + +(defmethod prefix-render :around ((prefix prefix)) + (let ((item (call-next-method))) + (when item + (unless (prefix-active-p prefix) + (setf (layout-item-key-attribute item) 'transient-inactive-attribute) + (setf (layout-item-description-attribute item) 'transient-inactive-attribute))) + item)) + +(defun generate-layout (keymap) + "generate layout from keymap structure. + +prefixes always display vertically as items. +nested keymaps are arranged based on display-style (:row or :column)." + (unless (keymap-show-p keymap) + (return-from generate-layout nil)) + (let ((prefix-items) + (keymap-layouts)) + ;; process children, separating prefixes from keymaps + (dolist (child (keymap-children keymap)) + (cond + ;; nested keymap: recurse and collect + ((typep child 'keymap) + (alexandria:when-let ((child-layout (generate-layout child))) + (push child-layout keymap-layouts))) + ;; prefix: create item if show-p + ((typep child 'prefix) + (when (prefix-show-p child) + (let ((item (prefix-render child))) + (push item prefix-items)))))) + ;; build result: title first, then content (prefixes + keymaps arranged by display-style) + (setf prefix-items (nreverse prefix-items)) + (setf keymap-layouts (nreverse keymap-layouts)) + (let ((parts) + (content-items)) + (let ((title (or (keymap-name keymap) "[unnamed keymap]"))) + (push (make-layout-title :text title) parts)) + ;; collect prefix column and keymap layouts as content items + (when prefix-items + (let ((max-key-width (reduce 'max + prefix-items + :key (lambda (item) + (length (layout-item-key item))) + :initial-value 0))) + (push (make-layout-column :items prefix-items :key-width max-key-width) + content-items))) + (dolist (km keymap-layouts) + (when content-items + (push (make-layout-separator) content-items)) + (push km content-items)) + (setf content-items (nreverse content-items)) + ;; arrange content items based on display-style + (when content-items + (ecase (keymap-display-style keymap) + (:row (push (make-layout-row :items content-items) parts)) + (:column (dolist (item content-items) (push item parts))))) + ;; wrap everything in a column (separates title from content, may contain the rest of the items) + (when parts + (make-layout-column :items (nreverse parts)))))) + +(defun render-layout-to-segments (layout &optional (key-width 0)) + "pre-render layout to a list of lines, where each line is a list of (text . attribute) segments." + (cond + ((null layout) nil) + ((layout-title-p layout) + (list (list (cons (format nil "-- ~A --" (layout-title-text layout)) + 'transient-title-attribute)))) + ((layout-separator-p layout) + (list (list (cons "----------------" 'transient-separator-attribute)))) + ((layout-item-p layout) + (let* ((key (layout-item-key layout)) + (padding (max 0 (- key-width (length key)))) + (desc (layout-item-description layout)) + (inactive (eq (layout-item-key-attribute layout) 'transient-inactive-attribute)) + (base-segments + (list (cons key (layout-item-key-attribute layout)) + (cons (make-string padding :initial-element #\space) nil) + (cons " " nil)))) + ;; if desc is a list of segments, append them. otherwise treat as string. + (list (append base-segments + (if (listp desc) + (if inactive + (mapcar + (lambda (seg) + (cons (car seg) 'transient-inactive-attribute)) + desc) + desc) + (list (cons (or desc "") + (layout-item-description-attribute layout)))))))) + ((layout-column-p layout) + (let ((col-key-width (layout-column-key-width layout))) + (loop for item in (layout-column-items layout) + append (render-layout-to-segments item col-key-width)))) + ((layout-row-p layout) + (render-row-as-grid-segments layout)))) + +(defun segment-line-width (segments) + (reduce '+ + segments + :key (lambda (seg) (length (car seg))) + :initial-value 0)) + +(defun insert-segment-line (point segments) + "insert a segment line at point, applying attributes." + (dolist (seg segments) + (let ((text (car seg)) + (attr (cdr seg))) + (if attr + (insert-string point text :attribute attr) + (insert-string point text))))) + +(defun render-row-as-grid-segments (row) + "render row to segment lines (for nested rows in pre-rendering)." + (let* ((items (layout-row-items row)) + ;; map items: for separator use :separator, otherwise generate segments + (columns (mapcar (lambda (item) + (if (layout-separator-p item) + :separator + (render-layout-to-segments item))) + items)) + ;; calculate widths: separator -> length of separator, normal -> max segment line width + (widths (mapcar (lambda (lines) + (if (eq lines :separator) + (length *transient-column-separator*) + (reduce 'max lines :key 'segment-line-width))) + columns)) + ;; max-height: max length of normal columns (ignore separators) + (max-height (reduce 'max + columns + :key (lambda (col) + (if (eq col :separator) + 0 + (length col))) + :initial-value 0)) + (result)) + (dotimes (row-idx max-height) + (let ((line-segments)) + (loop for col-data in columns + for col-width in widths + do (cond + ((eq col-data :separator) + (push (cons *transient-column-separator* 'transient-separator-attribute) + line-segments)) + (t + (let* ((seg-line (if (< row-idx (length col-data)) + (nth row-idx col-data) + nil)) + (line-width (if seg-line (segment-line-width seg-line) 0)) + (padding (- col-width line-width))) + (when seg-line + (dolist (seg seg-line) + (push seg line-segments))) + (when (> padding 0) + (push (cons (make-string padding :initial-element #\space) nil) + line-segments)))))) + (push (nreverse line-segments) result))) + (nreverse result))) + +(defun render-layout-to-buffer (layout point &optional (key-width 0)) + "render layout to buffer at point. + +key-width is used for even key spacing in items." + (let ((lines (render-layout-to-segments layout key-width))) + (loop for line in lines + for first = t then nil + do (unless first + (insert-character point #\newline)) + (insert-segment-line point line)))) + +(defmethod show-transient ((keymap keymap)) + (let* ((existing-window (and (not (deleted-window-p *transient-popup-window*)) + *transient-popup-window*)) + (buffer (if existing-window + (window-buffer existing-window) + (make-buffer "*transient*" :temporary t :enable-undo-p nil))) + (layout (generate-layout keymap))) + (erase-buffer buffer) + ;; we dont want lines to be cut off for now (no wrapping), until we have scrollbars or something + (setf (variable-value 'line-wrap :buffer buffer) nil) + (if layout + (render-layout-to-buffer layout (buffer-point buffer)) + (insert-string (buffer-point buffer) "(no bindings)")) + (buffer-start (buffer-point buffer)) + (log:info "buffer text:~%~A" (buffer-text buffer)) + (let* ((width (min (lem/popup-window::compute-buffer-width buffer) + (- (display-width) (* 2 *transient-window-margin*)))) + (height (min (lem/popup-window::compute-buffer-height buffer) + *transient-popup-max-lines*))) + (multiple-value-bind (x y) (compute-transient-position width height) + (if existing-window + (progn + (setf (transient-base-width existing-window) width) + (setf (transient-base-height existing-window) height) + (window-set-pos existing-window x y) + (window-set-size existing-window width height)) + (setf *transient-popup-window* + (make-instance 'transient-popup-window + :buffer buffer + :x x + :y y + :width width + :height height + :base-width width + :base-height height + :use-modeline-p nil + :border 1)))))) + (redraw-display)) \ No newline at end of file diff --git a/extensions/transient/transient.asd b/extensions/transient/transient.asd index c6d2a4c1d..064793439 100644 --- a/extensions/transient/transient.asd +++ b/extensions/transient/transient.asd @@ -1,3 +1,6 @@ (defsystem "transient" :depends-on ("lem/core") - :components ((:file "transient"))) \ No newline at end of file + :components ((:file "transient") + (:file "keymap") + (:file "popup") + (:file "demo"))) \ No newline at end of file diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp index 905cc791b..95d2b530f 100644 --- a/extensions/transient/transient.lisp +++ b/extensions/transient/transient.lisp @@ -1,43 +1,5 @@ (defpackage :transient (:use :cl :lem) - (:export)) + (:export :define-transient)) -(in-package :transient) - -(defvar *transient-popup-window* nil) - -(defun show-transient-popup (keymap) - (let* ((buffer (make-buffer "*transient*" :temporary t :enable-undo-p nil)) - (out (make-buffer-output-stream (buffer-point buffer)))) - (erase-buffer buffer) - (format out "Keymap: ~A~%" (keymap-name keymap)) - (format out "~%bindings:~%") - (traverse-keymap keymap - (lambda (kseq cmd) - (format out "~A ~A~%" - (keyseq-to-string kseq) - cmd))) - (buffer-start (buffer-point buffer)) - (let ((width (lem/popup-window::compute-buffer-width buffer)) - (height (lem/popup-window::compute-buffer-height buffer))) - (if (and *transient-popup-window* - (not (deleted-window-p *transient-popup-window*))) - (lem/popup-window::update-popup-window :destination-window *transient-popup-window* - :source-window (current-window) - :width width - :height height) - (setf *transient-popup-window* - (lem/popup-window::make-popup-window :source-window (current-window) - :buffer buffer - :width width - :height height - :style '(:gravity :topright))))) - (redraw-display))) - -(defmethod keymap-activate ((keymap (eql *root-keymap*))) - (log:info "activated root keymap~%") - (show-transient-popup keymap)) - -(defmethod keymap-activate ((keymap keymap)) - (log:info "activated ~A~%" keymap) - (show-transient-popup keymap)) \ No newline at end of file +(in-package :transient) \ No newline at end of file diff --git a/src/input.lisp b/src/input.lisp index 83f06edb4..0effce927 100644 --- a/src/input.lisp +++ b/src/input.lisp @@ -86,6 +86,7 @@ (setf kseq (nconc kseq (list event))) (setf result (lookup-keybind kseq)))) (t + (keymap-activate *root-keymap*) (set-last-read-key-sequence kseq) (return result))))))))) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index d90dcfd7d..8427166ab 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -469,13 +469,22 @@ ;; keymap.lisp (:export :keymap + :prefix :keymap* :*root-keymap* + :prefix-active-p :keymap-name + :keymap-children + :keymap-properties + :parse-keyspec + :prefix-properties :keymap-undef-hook :keymap-activate :make-keymap :make-prefix + :prefix-description + :prefix-key + :prefix-suffix :*global-keymap* :define-key :define-keys diff --git a/src/keymap.lisp b/src/keymap.lisp index 54e7e55e6..8bad39981 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -49,36 +49,29 @@ the underlying storage slot is renamed with a '*' suffix." :documentation "the key defined for the prefix. could be a function that returns a key.") (description :initarg :description - :accessor prefix-description) + :dynamic t + :initform nil) (suffix :initarg :suffix - :accessor prefix-suffix + :dynamic t :documentation "the suffix defined for the prefix, could be another prefix or a keymap or a function that returns one.") - (show-p - :initarg :show-p - :accessor prefix-show-p - :documentation "whether to show the children menu." - :initform nil) - (hidden-p - :initarg :hidden-p - :accessor prefix-hidden-p - :documentation "whether to hide/show a prefix in its parent menu." - :initform nil) (active-p :initarg :active-p - :accessor prefix-active-p + :dynamic t :documentation "whether a prefix is active." :initform t) - (metadata - :initarg :metadata - :accessor prefix-metadata + (properties + :initarg :properties + :accessor prefix-properties + :initform nil :documentation "extra metadata that a prefix may hold."))) -(defun make-prefix (&key key suffix) +(defun make-prefix (&key key suffix description) (let ((prefix (make-instance 'prefix :key key - :suffix suffix))) + :suffix suffix + :description description))) prefix)) (defclass-dynamic keymap () @@ -87,17 +80,35 @@ the underlying storage slot is renamed with a '*' suffix." :initarg :children :dynamic t :initform nil - :documentation "the children of the keymap. could be a function that returns a list of children."))) + :documentation "the children of the keymap. could be a function that returns a list of children.") + (properties + :initarg :properties + :accessor keymap-properties + :initform nil + :documentation "additional metadata that a keymap holds.") + (description + :initarg :description + :dynamic t + :initform nil) + (active-p + :initarg :active-p + :dynamic t + :documentation "whether a prefix is active." + :initform t))) -(defmethod keymap-add-prefix ((keymap keymap) (prefix prefix)) +(defmethod keymap-add-prefix ((keymap keymap) (prefix prefix) &optional after) (unless (listp (keymap-children* keymap)) (error "trying to add key to a non-static keymap.")) - (push prefix (keymap-children* keymap))) + (if after + (setf (keymap-children* keymap) (append (keymap-children* keymap) (list prefix))) + (push prefix (keymap-children* keymap)))) -(defmethod keymap-add-child ((keymap keymap) (keymap2 keymap)) +(defmethod keymap-add-child ((keymap keymap) (keymap2 keymap) &optional after) (unless (listp (keymap-children* keymap)) (error "trying to add nested keymap to a non-static keymap.")) - (push keymap2 (keymap-children* keymap))) + (if after + (setf (keymap-children* keymap) (append (keymap-children* keymap) (list keymap2))) + (push keymap2 (keymap-children* keymap)))) (defgeneric prefix-p (keymap) (:documentation "check whether this is a prefix of another prefix. @@ -185,7 +196,7 @@ Example: (define-key *global-keymap* \"C-'\" 'list-modes)" `(progn ,@(mapcar (lambda (binding) `(define-key ,keymap - ,(first binding) + ,(first binding) ,(second binding))) bindings))) @@ -305,11 +316,13 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (defun find-matching-prefixes (binding key) "find prefixes in children that match KEY." (cond ((typep binding 'prefix) - (when (equal (prefix-key binding) key) + (when (and (prefix-active-p binding) + (equal (prefix-key binding) key)) (list binding))) ((typep binding 'keymap) - (loop for item in (keymap-children binding) - append (find-matching-prefixes item key))))) + (when (keymap-active-p binding) + (loop for item in (keymap-children binding) + append (find-matching-prefixes item key)))))) (defun find-in-function-table (binding key) "search function-table of keymaps in hierarchy for KEY." @@ -336,7 +349,7 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (declare (ignore binding)) (loop for km in (all-keymaps) when (and (typep km 'keymap*) (keymap-undef-hook km)) - return (keymap-undef-hook km))) + return (keymap-undef-hook km))) (defmethod find-suffix ((keymap keymap) keyseq) "search KEYMAP tree for exact binding matching KEYSEQ." @@ -358,15 +371,15 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (key (list key)) (list key)))) (or ;; search children prefixes - (find-suffix keymap keyseq) - ;; search function-table in hierarchy - (find-in-function-table keymap (car keyseq)) - ;; check function-table for cmd symbol - (gethash cmd (keymap-function-table keymap)) - ;; find undef-hook in hierarchy (e.g. self-insert) - (find-undef-hook-in-hierarchy keymap) - ;; return cmd as fallback - cmd))) + (find-suffix keymap keyseq) + ;; search function-table in hierarchy + (find-in-function-table keymap (car keyseq)) + ;; check function-table for cmd symbol + (gethash cmd (keymap-function-table keymap)) + ;; find undef-hook in hierarchy (e.g. self-insert) + (find-undef-hook-in-hierarchy keymap) + ;; return cmd as fallback + cmd))) (defun insertion-key-p (key) (let* ((key (typecase key From a3d56b3bc24ab74814dcd141fc555826c1e3c16b Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sun, 18 Jan 2026 22:07:25 +0200 Subject: [PATCH 05/63] improve docstrings a little more --- extensions/transient/keymap.lisp | 7 ++++++- extensions/transient/popup.lisp | 3 +++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index e5bcf35e1..9fff8b9c0 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -1,6 +1,7 @@ (in-package :transient) (defmethod keymap-activate ((keymap keymap)) + "called when a keymap is activated by the event scheduler." (log:info "keymap ~A activated" keymap) (show-transient keymap)) @@ -24,20 +25,23 @@ if DEFAULT-VALUE is provided and non-nil, it is used as the default for getf." (defmethod (setf ,getter-name) (val (,obj-sym ,class-name)) (setf (getf (,properties-accessor ,obj-sym) ,keyword) val))))) +;; these are properties that we want to be "dynamic", as in can be assigned a function that +;; returns the value later instead of the value itself. (add-dynamic-property keymap keymap-properties show-p t) (add-dynamic-property prefix prefix-properties show-p t) (defgeneric prefix-render (prefix) (:documentation "render prefix into a layout item. returns nil to use default rendering.")) -;; should return :row or :column (defmethod keymap-display-style ((keymap keymap)) + "should return :row or :column. used to construct the display" (getf (keymap-properties keymap) :display-style :row)) (defmethod (setf keymap-display-style) (val (keymap keymap)) (setf (getf (keymap-properties keymap) :display-style) val)) (defclass choice (prefix) + "a prefix that may take on different values." ((choices :accessor prefix-choices))) @@ -45,6 +49,7 @@ if DEFAULT-VALUE is provided and non-nil, it is used as the default for getf." `(defparameter ,name (parse-transient ',bindings))) (defun parse-transient (bindings) + "defines a transient menu. args yet to be documented." (let ((keymap (make-keymap))) (loop for tail = bindings then (cdr tail) while tail diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index c4432fbd0..6e1dab493 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -108,6 +108,9 @@ completion interface if present." (or (prefix-description suffix) "+prefix")) (t (princ-to-string suffix))))))) +(defgeneric prefix-render (prefix) + (:documentation "return a layout item that should be displayed for the prefix in the popup.")) + (defmethod prefix-render ((prefix prefix)) (make-layout-item :key (princ-to-string (prefix-key prefix)) From d8ac6fb4f1aa40e7a5d9e060d15882ab861f7c0e Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sun, 18 Jan 2026 22:12:58 +0200 Subject: [PATCH 06/63] slight refactor --- extensions/transient/popup.lisp | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 6e1dab493..e9cde6bea 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -2,9 +2,9 @@ (defvar *transient-popup-window* nil) -(defvar *transient-popup-max-lines* 20) - -(defvar *transient-popup-max-width* 80) +(defvar *transient-popup-max-lines* + 15 + "max height of the transient buffer (measured in lines).") (defparameter *transient-window-margin* 4 "margin in columns from the edge of the screen.") @@ -98,6 +98,7 @@ completion interface if present." (key-width 0)) (defun get-description (prefix) + "returns a description for an entry that could be a prefix or a keymap." (let ((desc (prefix-description prefix))) (if desc (princ-to-string desc) @@ -299,6 +300,7 @@ key-width is used for even key spacing in items." (insert-segment-line point line)))) (defmethod show-transient ((keymap keymap)) + "show the transient popup. creates a window if it hasnt been created yet." (let* ((existing-window (and (not (deleted-window-p *transient-popup-window*)) *transient-popup-window*)) (buffer (if existing-window From fdb7bf95aa52047823aa29b751772c975888aea1 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 21 Jan 2026 01:51:03 +0200 Subject: [PATCH 07/63] make multi-choice prefix work --- extensions/transient/demo.lisp | 1 + extensions/transient/keymap.lisp | 28 +++++++++++++++++++++--- extensions/transient/popup.lisp | 22 +++++++++++++------ src/input.lisp | 37 ++++++++++++++++++++++++-------- src/internal-packages.lisp | 3 ++- src/interp.lisp | 3 ++- src/keymap.lisp | 37 ++++++++++++++++++++------------ 7 files changed, 96 insertions(+), 35 deletions(-) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index 0882ca572..c227c971c 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -34,6 +34,7 @@ (:key "l" :type :choice :choices ("lisp" "python" "js") + :value "python" :description "mode")) (:keymap :description "editor" diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 9fff8b9c0..8b469205d 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -2,7 +2,6 @@ (defmethod keymap-activate ((keymap keymap)) "called when a keymap is activated by the event scheduler." - (log:info "keymap ~A activated" keymap) (show-transient keymap)) (defmacro add-dynamic-property (class-name properties-accessor property-name &optional default-value) @@ -41,9 +40,32 @@ if DEFAULT-VALUE is provided and non-nil, it is used as the default for getf." (setf (getf (keymap-properties keymap) :display-style) val)) (defclass choice (prefix) - "a prefix that may take on different values." ((choices - :accessor prefix-choices))) + :accessor prefix-choices) + (value)) + (:documentation "a prefix that may take on different values.")) + +(defmethod prefix-value ((choice choice)) + (if (slot-boundp choice 'value) + (slot-value choice 'value) + (car (prefix-choices choice)))) + +(defmethod prefix-suffix ((choice choice)) + :drop) + +(defmethod (setf prefix-value) (new-value (choice choice)) + (setf (slot-value choice 'value) new-value)) + +(defmethod prefix-invoke ((choice choice)) + (let* ((choices (prefix-choices choice)) + (current-value (prefix-value choice)) + (position (position current-value choices :test 'equal))) + (let ((new-value (if position + ;; mod is to wrap around to 0. :D + (elt choices (mod (1+ position) (length choices))) + (first choices)))) + (log:info "switching to value ~A~%" new-value) + (setf (prefix-value choice) new-value)))) (defmacro define-transient (name &body bindings) `(defparameter ,name (parse-transient ',bindings))) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index e9cde6bea..53263eb62 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -1,15 +1,18 @@ (in-package :transient) -(defvar *transient-popup-window* nil) +(defvar *transient-popup-window* + nil) (defvar *transient-popup-max-lines* 15 "max height of the transient buffer (measured in lines).") -(defparameter *transient-window-margin* 4 +(defparameter *transient-window-margin* + 4 "margin in columns from the edge of the screen.") -(defparameter *transient-column-separator* " | " +(defparameter *transient-column-separator* + " | " "string used to separate columns in row layout.") (define-attribute transient-key-attribute @@ -34,6 +37,11 @@ :foreground (attribute-foreground (ensure-attribute 'syntax-comment-attribute)) :background (attribute-background (ensure-attribute 'syntax-comment-attribute)))) +(define-attribute transient-value-attribute + (t + :foreground (attribute-foreground (ensure-attribute 'syntax-constant-attribute)) + :bold t)) + ;; custom floating window class that repositions on each redraw (defclass transient-popup-window (floating-window) ((base-width :initarg :base-width :accessor transient-base-width) @@ -119,13 +127,13 @@ completion interface if present." (defmethod prefix-render ((prefix choice)) (let* ((desc (get-description prefix)) - (choices (prefix-choices prefix)) - (choices-str (format nil "~{~A~^/~}" choices))) + (value (prefix-value prefix)) + (value-str (princ-to-string value))) (let ((description-segments (list (cons desc nil) (cons " " nil) (cons "[" 'transient-bracket-attribute) - (cons choices-str nil) + (cons value-str 'transient-value-attribute) (cons "]" 'transient-bracket-attribute)))) (make-layout-item :key (princ-to-string (prefix-key prefix)) @@ -314,7 +322,7 @@ key-width is used for even key spacing in items." (render-layout-to-buffer layout (buffer-point buffer)) (insert-string (buffer-point buffer) "(no bindings)")) (buffer-start (buffer-point buffer)) - (log:info "buffer text:~%~A" (buffer-text buffer)) + ;; (log:info "buffer text:~%~A" (buffer-text buffer)) (let* ((width (min (lem/popup-window::compute-buffer-width buffer) (- (display-width) (* 2 *transient-window-margin*)))) (height (min (lem/popup-window::compute-buffer-height buffer) diff --git a/src/input.lisp b/src/input.lisp index 0effce927..3f96d86dc 100644 --- a/src/input.lisp +++ b/src/input.lisp @@ -77,18 +77,36 @@ (find-mouse-command event)) (key (let* ((result (lookup-keybind event)) + (prefix) + (suffix) (kseq (list event))) (loop - (cond ((prefix-command-p result) - (when (typep result 'keymap) - (keymap-activate result)) + (setf suffix (car result)) + (setf prefix (cdr result)) + (cond ((prefix-command-p suffix) + (when prefix + (prefix-invoke prefix)) + (when (typep suffix 'keymap) + (keymap-activate suffix)) (let ((event (read-key))) (setf kseq (nconc kseq (list event))) - (setf result (lookup-keybind kseq)))) + (setf result (lookup-keybind kseq)) + (setf suffix (car result)) + (setf prefix (cdr result)))) (t - (keymap-activate *root-keymap*) - (set-last-read-key-sequence kseq) - (return result))))))))) + (when prefix + (prefix-invoke prefix)) + (if (eq suffix :drop) + (progn + (set-last-read-key-sequence (butlast kseq)) + (setf result (lookup-keybind (butlast kseq))) + (setf suffix (car result)) + (setf prefix (cdr result)) + (setf kseq (butlast kseq))) + (progn + (set-last-read-key-sequence kseq) + (keymap-activate *root-keymap*) + (return suffix))))))))))) (defun read-key-sequence () (read-command) @@ -104,8 +122,9 @@ (do-command-loop (:interactive nil) (when (null *unread-keys*) (return)) - (let ((*this-command-keys* nil)) - (call-command (read-command) nil))))) + (let* ((*this-command-keys* nil) + (cmd (read-command))) + (call-command cmd nil))))) (defun sit-for (seconds &optional (update-window-p t) (force-update-p nil)) (when update-window-p (redraw-display :force force-update-p)) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index 8427166ab..8df410ef4 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -502,7 +502,8 @@ :compute-keymaps :collect-command-keybindings :keymap-add-child - :keymap-add-prefix) + :keymap-add-prefix + :prefix-invoke) ;; reexport common/timer (:export :timer diff --git a/src/interp.lisp b/src/interp.lisp index 28d06d408..74d51b52a 100644 --- a/src/interp.lisp +++ b/src/interp.lisp @@ -81,7 +81,8 @@ (unless (or (eq cmd ') (eq cmd ')) (message nil)) - (call-command cmd nil))) + (when cmd + (call-command cmd nil)))) (editor-abort-handler (c) (declare (ignore c)) diff --git a/src/keymap.lisp b/src/keymap.lisp index 8bad39981..461344606 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -128,6 +128,10 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (:method ((keymap t)) nil)) +(defgeneric prefix-invoke (prefix) + (:documentation "a hook for when a prefix is reached.") + (:method ((prefix t)) nil)) + (deftype key-sequence () '(trivial-types:proper-list key)) @@ -352,34 +356,39 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" return (keymap-undef-hook km))) (defmethod find-suffix ((keymap keymap) keyseq) - "search KEYMAP tree for exact binding matching KEYSEQ." - (labels ((search-tree (binding keys) + "search KEYMAP tree for exact binding matching KEYSEQ. returns (suffix . prefix)" + (labels ((search-tree (binding keys parent-prefix) (if (null keys) (if (typep binding 'prefix) - (prefix-suffix binding) - binding) + (cons (prefix-suffix binding) binding) + (when binding + (cons binding parent-prefix))) ;; try all matches and return first successful result (loop for match in (find-matching-prefixes binding (car keys)) - for result = (search-tree (prefix-suffix match) (cdr keys)) + for result = (search-tree (prefix-suffix match) (cdr keys) match) when result return result)))) - (search-tree keymap keyseq))) + (search-tree keymap keyseq nil))) ;; this is currently here for backwards compatibility ;; im not yet sure whether 'cmd' or function-table lookup is necessary (i think so but im not sure how to get rid of it.) (defmethod keymap-find-keybind ((keymap keymap) key cmd) + "finds key sequence in keymap, returns (suffix . prefix)." (let ((keyseq (etypecase key (key (list key)) (list key)))) (or ;; search children prefixes (find-suffix keymap keyseq) - ;; search function-table in hierarchy - (find-in-function-table keymap (car keyseq)) - ;; check function-table for cmd symbol - (gethash cmd (keymap-function-table keymap)) - ;; find undef-hook in hierarchy (e.g. self-insert) - (find-undef-hook-in-hierarchy keymap) - ;; return cmd as fallback - cmd))) + (cons + (or + ;; search function-table in hierarchy + (find-in-function-table keymap (car keyseq)) + ;; check function-table for cmd symbol + (gethash cmd (keymap-function-table keymap)) + ;; find undef-hook in hierarchy (e.g. self-insert) + (find-undef-hook-in-hierarchy keymap) + ;; return cmd as fallback + cmd) + nil)))) (defun insertion-key-p (key) (let* ((key (typecase key From 2d7e130b0427435c6aea3a7d0aa5fc4e70614625 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 23 Jan 2026 20:47:32 +0200 Subject: [PATCH 08/63] fix order of keymaps (hence fix priorities) --- src/keymap.lisp | 76 ++++++++++++++++++++++++++++--------------------- 1 file changed, 44 insertions(+), 32 deletions(-) diff --git a/src/keymap.lisp b/src/keymap.lisp index 461344606..647f5a328 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -364,31 +364,45 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (when binding (cons binding parent-prefix))) ;; try all matches and return first successful result - (loop for match in (find-matching-prefixes binding (car keys)) - for result = (search-tree (prefix-suffix match) (cdr keys) match) - when result return result)))) + (let ((matches (find-matching-prefixes binding (car keys)))) + (or (loop for match in matches + for result = (search-tree (prefix-suffix match) (cdr keys) match) + when result return result) + ;; if we have matches but none were exact/successful, we are still in a prefix + (when (and matches (null (cdr keys))) + (let ((match (car matches))) + (cons (prefix-suffix match) match)))))))) (search-tree keymap keyseq nil))) +(defun normalize-binding (found &optional parent-prefix) + (typecase found + (prefix (cons (prefix-suffix found) found)) + (keymap (cons found parent-prefix)) + (t (cons found parent-prefix)))) + ;; this is currently here for backwards compatibility ;; im not yet sure whether 'cmd' or function-table lookup is necessary (i think so but im not sure how to get rid of it.) (defmethod keymap-find-keybind ((keymap keymap) key cmd) "finds key sequence in keymap, returns (suffix . prefix)." - (let ((keyseq (etypecase key - (key (list key)) - (list key)))) - (or ;; search children prefixes - (find-suffix keymap keyseq) - (cons - (or - ;; search function-table in hierarchy - (find-in-function-table keymap (car keyseq)) - ;; check function-table for cmd symbol - (gethash cmd (keymap-function-table keymap)) - ;; find undef-hook in hierarchy (e.g. self-insert) - (find-undef-hook-in-hierarchy keymap) - ;; return cmd as fallback - cmd) - nil)))) + (let* ((keyseq (etypecase key + (key (list key)) + (list key))) + (suffix-result (find-suffix keymap keyseq)) + (suffix (car suffix-result))) + (cond (suffix + (normalize-binding (car suffix-result) (cdr suffix-result))) + (t + (let ((result + (or + ;; search function-table in hierarchy + (find-in-function-table keymap (car keyseq)) + ;; check function-table for cmd symbol + (gethash (if (consp cmd) (car cmd) cmd) (keymap-function-table keymap)) + ;; find undef-hook in hierarchy (e.g. self-insert) + (find-undef-hook-in-hierarchy keymap)))) + (if result + (normalize-binding result) + cmd)))))) (defun insertion-key-p (key) (let* ((key (typecase key @@ -406,24 +420,22 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (:method ((mode global-mode)) nil)) (defun all-keymaps () - ;; build list in reverse priority order, then nreverse at end - ;; lower priority first, higher priority last (before nreverse) - (let* ((keymaps nil)) - ;; first add global/minor modes (lowest priority) - (dolist (mode (all-active-modes (current-buffer))) - (when (mode-keymap mode) - (push (mode-keymap mode) keymaps))) - ;; add major-mode keymap + (let ((keymaps)) + ;; this one collects active modes. local shadows global. + (dolist (mode (reverse (all-active-modes (current-buffer)))) + (alexandria:when-let ((keymap (mode-keymap mode))) + (push keymap keymaps))) + ;; major mode keymaps at point (context-specific). (alexandria:when-let* ((mode (major-mode-at-point (current-point))) (keymap (mode-keymap mode))) (push keymap keymaps)) - ;; add state keymaps from compute-keymaps (highest priority) - (dolist (km (compute-keymaps (current-global-mode))) + ;; state keymaps (e.g. vi modes) + (dolist (km (reverse (compute-keymaps (current-global-mode)))) (push km keymaps)) - ;; special keymap has highest priority + ;; special keymap (highest priority) (when *special-keymap* (push *special-keymap* keymaps)) - (delete-duplicates keymaps))) + (delete-duplicates keymaps :from-end t))) ;; this is for some "other" keymaps that i need to inject into the root-keymap (atleast this way for now). ;; we could make *root-keymap* itself have dynamic children and inject those into it but i dont want that, @@ -472,7 +484,7 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (defun abort-key-p (key) (and (key-p key) - (eq *abort-key* (lookup-keybind key)))) + (eq *abort-key* (car (lookup-keybind key))))) (defmacro with-special-keymap ((keymap) &body body) `(let ((*special-keymap* (or ,keymap *special-keymap*))) From 8fe748d365711080e21504249fba461c7cd3a017 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 23 Jan 2026 21:55:28 +0200 Subject: [PATCH 09/63] slight change --- src/keymap.lisp | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/keymap.lisp b/src/keymap.lisp index 647f5a328..e1175cbda 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -94,7 +94,11 @@ the underlying storage slot is renamed with a '*' suffix." :initarg :active-p :dynamic t :documentation "whether a prefix is active." - :initform t))) + :initform t) + (name + :initarg :name + :accessor keymap-name + :initform nil))) (defmethod keymap-add-prefix ((keymap keymap) (prefix prefix) &optional after) (unless (listp (keymap-children* keymap)) @@ -148,11 +152,7 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (function-table :initarg :function-table :accessor keymap-function-table - :initform (make-hash-table :test 'eq)) - (name - :initarg :name - :accessor keymap-name - :initform nil))) + :initform (make-hash-table :test 'eq)))) ;; *root-keymap* contains all keymaps as (possibly nested, possibly "dynamic") children (defvar *root-keymap* (make-instance 'keymap*)) @@ -445,7 +445,8 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (all-keymaps)) (defparameter *other-keymaps-root* (make-instance 'keymap* - :children #'other-keymaps)) + :children #'other-keymaps + :name '*other-keymaps-root*)) (defun lookup-keybind (key) (unless (find *other-keymaps-root* (keymap-children *root-keymap*)) From 7b9f3a6a35956f237aa2fc65ab51d362008ab8c7 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sat, 24 Jan 2026 00:33:20 +0200 Subject: [PATCH 10/63] add find-prefix-by-id --- extensions/transient/demo.lisp | 8 ++++++- extensions/transient/keymap.lisp | 37 ++++++++++++++++++++++++++++++-- 2 files changed, 42 insertions(+), 3 deletions(-) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index c227c971c..d19f192c9 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -33,6 +33,7 @@ :description "languages" (:key "l" :type :choice + :id :mode :choices ("lisp" "python" "js") :value "python" :description "mode")) @@ -46,6 +47,11 @@ (:key "d" :type :choice :choices ("on" "off") - :description "debug toggle")) + :description "debug toggle") + (:key "R" :suffix demo-run :description "run with mode")) + +(define-command demo-run () () + (let ((mode-prefix (find-prefix-by-id *demo-keymap* :mode))) + (message "mode thing value: ~A" (prefix-value mode-prefix)))) (define-key *global-keymap* "C-c t" *demo-keymap*) \ No newline at end of file diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 8b469205d..21ff4cdc9 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -24,10 +24,43 @@ if DEFAULT-VALUE is provided and non-nil, it is used as the default for getf." (defmethod (setf ,getter-name) (val (,obj-sym ,class-name)) (setf (getf (,properties-accessor ,obj-sym) ,keyword) val))))) +(defmacro add-static-property (class-name properties-accessor property-name &optional default-value) + "define - getter and setter methods. + +the getter retrieves from PROPERTIES-ACCESSOR using :PROPERTY-NAME as key. +the setter stores directly." + (let* ((keyword (intern (symbol-name property-name) :keyword)) + (getter-name (intern (format nil "~A-~A" class-name property-name))) + (obj-sym (gensym "OBJ"))) + `(progn + (defmethod ,getter-name ((,obj-sym ,class-name)) + ,(if default-value + `(getf (,properties-accessor ,obj-sym) ,keyword ,default-value) + `(getf (,properties-accessor ,obj-sym) ,keyword))) + (defmethod (setf ,getter-name) (val (,obj-sym ,class-name)) + (setf (getf (,properties-accessor ,obj-sym) ,keyword) val))))) + ;; these are properties that we want to be "dynamic", as in can be assigned a function that ;; returns the value later instead of the value itself. (add-dynamic-property keymap keymap-properties show-p t) (add-dynamic-property prefix prefix-properties show-p t) +;; static properties dont take a function that returns a value, just a value. +(add-static-property prefix prefix-properties id) + +(defun find-prefix-by-id (keymap id) + (labels ((f (node) + (cond ((typep node 'keymap) + (dolist (child (keymap-children node)) + (let ((res (f child))) + (when res (return-from f res))))) + ((typep node 'prefix) + (if (eql (prefix-id node) id) + node + (let ((suffix (prefix-suffix node))) + (when (or (typep suffix 'keymap) + (typep suffix 'prefix)) + (f suffix)))))))) + (f keymap))) (defgeneric prefix-render (prefix) (:documentation "render prefix into a layout item. returns nil to use default rendering.")) @@ -99,14 +132,14 @@ if DEFAULT-VALUE is provided and non-nil, it is used as the default for getf." (setf (prefix-suffix prefix) nil) (loop for (key value) on (cddr binding) by 'cddr ;; key-method is used for (setf prefix- ) - for key-method = (intern (format nil "PREFIX-~A" (string key))) + for key-method = (intern (format nil "PREFIX-~A" (string key)) :transient) do (let ((setf-expr `(setf (,key-method prefix) value)) (final-value) (should-set t)) (cond ;; if the suffix is a keymap we need to parse recursively ((and (listp value) (eq (car value) :keymap)) - (setf final-value (parse-transient value))) + (setf final-value (parse-transient (cdr value)))) ((eq key :type) (setf should-set nil)) (t From 42977a41f60d55ce2c037a8565f30e4e9cf96e7e Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sat, 24 Jan 2026 00:47:12 +0200 Subject: [PATCH 11/63] introduce :back, :cancel suffix values --- extensions/transient/demo.lisp | 6 ++++-- src/input.lisp | 33 ++++++++++++++++++++++----------- 2 files changed, 26 insertions(+), 13 deletions(-) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index d19f192c9..92adae581 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -12,14 +12,16 @@ :suffix (:keymap (:key "p" :suffix demo-pdf :description "pdf") (:key "h" :suffix demo-html :description "html") - (:key "m" :suffix demo-md :description "markdown")) + (:key "m" :suffix demo-md :description "markdown") + (:key "b" :suffix :back :description "back")) :description "export format")) (:keymap :display-style :column :description "edit operations" (:key "c" :suffix demo-copy) (:key "v" :suffix demo-paste) - (:key "u" :suffix demo-undo)) + (:key "u" :suffix demo-undo) + (:key "q" :suffix :cancel :description "quit")) (:key "f" :suffix (:keymap (:key "g" :suffix demo-grep :description "grep") diff --git a/src/input.lisp b/src/input.lisp index 3f96d86dc..f7b5f4f5d 100644 --- a/src/input.lisp +++ b/src/input.lisp @@ -96,17 +96,28 @@ (t (when prefix (prefix-invoke prefix)) - (if (eq suffix :drop) - (progn - (set-last-read-key-sequence (butlast kseq)) - (setf result (lookup-keybind (butlast kseq))) - (setf suffix (car result)) - (setf prefix (cdr result)) - (setf kseq (butlast kseq))) - (progn - (set-last-read-key-sequence kseq) - (keymap-activate *root-keymap*) - (return suffix))))))))))) + (cond + ((eq suffix :drop) + (setf kseq (butlast kseq)) + (set-last-read-key-sequence kseq) + (setf result (lookup-keybind kseq)) + (setf suffix (car result)) + (setf prefix (cdr result))) + ((eq suffix :back) + (setf kseq (subseq kseq 0 (max 0 (- (length kseq) 2)))) + (set-last-read-key-sequence kseq) + (setf result (lookup-keybind kseq)) + (setf suffix (car result)) + (setf prefix (cdr result))) + ((eq suffix :cancel) + (setf kseq nil) + (set-last-read-key-sequence nil) + (keymap-activate *root-keymap*) + (return nil)) + (t + (set-last-read-key-sequence kseq) + (keymap-activate *root-keymap*) + (return suffix))))))))))) (defun read-key-sequence () (read-command) From 7e73c23d2b5a033628ae5d9e5f0c012fe30bb79f Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sun, 25 Jan 2026 23:10:02 +0200 Subject: [PATCH 12/63] rename package to lem/transient --- extensions/transient/demo.lisp | 2 +- extensions/transient/keymap.lisp | 4 ++-- extensions/transient/popup.lisp | 2 +- extensions/transient/transient.lisp | 4 ++-- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index 92adae581..b0f5dd70b 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -1,4 +1,4 @@ -(in-package :transient) +(in-package :lem/transient) (define-transient *demo-keymap* :display-style :row diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 21ff4cdc9..1699aa72b 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -1,4 +1,4 @@ -(in-package :transient) +(in-package :lem/transient) (defmethod keymap-activate ((keymap keymap)) "called when a keymap is activated by the event scheduler." @@ -132,7 +132,7 @@ the setter stores directly." (setf (prefix-suffix prefix) nil) (loop for (key value) on (cddr binding) by 'cddr ;; key-method is used for (setf prefix- ) - for key-method = (intern (format nil "PREFIX-~A" (string key)) :transient) + for key-method = (intern (format nil "PREFIX-~A" (string key)) :lem/transient) do (let ((setf-expr `(setf (,key-method prefix) value)) (final-value) (should-set t)) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 53263eb62..dcb56bc75 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -1,4 +1,4 @@ -(in-package :transient) +(in-package :lem/transient) (defvar *transient-popup-window* nil) diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp index 95d2b530f..1b1b36cf8 100644 --- a/extensions/transient/transient.lisp +++ b/extensions/transient/transient.lisp @@ -1,5 +1,5 @@ -(defpackage :transient +(defpackage :lem/transient (:use :cl :lem) (:export :define-transient)) -(in-package :transient) \ No newline at end of file +(in-package :lem/transient) \ No newline at end of file From ebce66e6d4bb22d70f96093695f54b1b65840f5d Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sun, 25 Jan 2026 23:15:39 +0200 Subject: [PATCH 13/63] rename package to lem/transient --- extensions/transient/transient.asd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extensions/transient/transient.asd b/extensions/transient/transient.asd index 064793439..c97491610 100644 --- a/extensions/transient/transient.asd +++ b/extensions/transient/transient.asd @@ -1,4 +1,4 @@ -(defsystem "transient" +(defsystem "lem/transient" :depends-on ("lem/core") :components ((:file "transient") (:file "keymap") From ba5694bd15ab6b8168ddbc34134dd004dd13b411 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sun, 25 Jan 2026 23:32:16 +0200 Subject: [PATCH 14/63] rename package to lem/transient and system to lem-transient --- extensions/transient/{transient.asd => lem-transient.asd} | 2 +- lem.asd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) rename extensions/transient/{transient.asd => lem-transient.asd} (85%) diff --git a/extensions/transient/transient.asd b/extensions/transient/lem-transient.asd similarity index 85% rename from extensions/transient/transient.asd rename to extensions/transient/lem-transient.asd index c97491610..2c9413d8c 100644 --- a/extensions/transient/transient.asd +++ b/extensions/transient/lem-transient.asd @@ -1,4 +1,4 @@ -(defsystem "lem/transient" +(defsystem "lem-transient" :depends-on ("lem/core") :components ((:file "transient") (:file "keymap") diff --git a/lem.asd b/lem.asd index 021e567af..d00b0d04c 100644 --- a/lem.asd +++ b/lem.asd @@ -297,7 +297,7 @@ "lem-claude-code" "lem-bookmark" "lem-mcp-server" - "transient" + "lem-transient" #+sbcl "lem-living-canvas" "lem-tree-sitter" From 33cdde7c70f8d283fcc32c611c2f126305a84a89 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Tue, 27 Jan 2026 16:02:59 +0200 Subject: [PATCH 15/63] use "intern" with explicit package name --- extensions/transient/keymap.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 1699aa72b..8854dd359 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -11,7 +11,7 @@ the getter retrieves from PROPERTIES-ACCESSOR using :PROPERTY-NAME as key. if the value is a function, it funcalls it. the setter stores directly. if DEFAULT-VALUE is provided and non-nil, it is used as the default for getf." (let* ((keyword (intern (symbol-name property-name) :keyword)) - (getter-name (intern (format nil "~A-~A" class-name property-name))) + (getter-name (intern (format nil "~A-~A" class-name property-name) :lem/transient)) (obj-sym (gensym "OBJ"))) `(progn (defmethod ,getter-name ((,obj-sym ,class-name)) @@ -30,7 +30,7 @@ if DEFAULT-VALUE is provided and non-nil, it is used as the default for getf." the getter retrieves from PROPERTIES-ACCESSOR using :PROPERTY-NAME as key. the setter stores directly." (let* ((keyword (intern (symbol-name property-name) :keyword)) - (getter-name (intern (format nil "~A-~A" class-name property-name))) + (getter-name (intern (format nil "~A-~A" class-name property-name) :lem/transient)) (obj-sym (gensym "OBJ"))) `(progn (defmethod ,getter-name ((,obj-sym ,class-name)) @@ -124,7 +124,7 @@ the setter stores directly." ((eq (car binding) :key) (let* ((key (second binding)) ;; prefix-class depends on the first cell in the :suffix value (if its a list at all) - (prefix-type (intern (symbol-name (getf binding :type 'prefix)))) + (prefix-type (intern (symbol-name (getf binding :type 'prefix)) :lem/transient)) (prefix (make-instance prefix-type))) (setf (prefix-key prefix) (car (parse-keyspec key))) ;; sometimes the suffix will not be set (e.g. prefix-type is :choice). we From d5023be9aefd6e266c73152dbb1e79d5476724d5 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 28 Jan 2026 04:31:14 +0200 Subject: [PATCH 16/63] introduce prefix-behavior, with-last-read-key-sequence, and handle explicit function suffixes --- extensions/transient/keymap.lisp | 32 +++++++----- src/input.lisp | 88 +++++++++++++++++--------------- src/internal-packages.lisp | 2 + src/keymap.lisp | 9 ++++ 4 files changed, 79 insertions(+), 52 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 8854dd359..04d5634d8 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -72,7 +72,10 @@ the setter stores directly." (defmethod (setf keymap-display-style) (val (keymap keymap)) (setf (getf (keymap-properties keymap) :display-style) val)) -(defclass choice (prefix) +(defclass infix (prefix) + ()) + +(defclass choice (infix) ((choices :accessor prefix-choices) (value)) @@ -83,22 +86,27 @@ the setter stores directly." (slot-value choice 'value) (car (prefix-choices choice)))) -(defmethod prefix-suffix ((choice choice)) +;; infixes dont modify the keymap menu, we drop the key and dont append it to the recorded keyseq +(defmethod prefix-behavior ((prefix infix)) :drop) (defmethod (setf prefix-value) (new-value (choice choice)) (setf (slot-value choice 'value) new-value)) -(defmethod prefix-invoke ((choice choice)) - (let* ((choices (prefix-choices choice)) - (current-value (prefix-value choice)) - (position (position current-value choices :test 'equal))) - (let ((new-value (if position - ;; mod is to wrap around to 0. :D - (elt choices (mod (1+ position) (length choices))) - (first choices)))) - (log:info "switching to value ~A~%" new-value) - (setf (prefix-value choice) new-value)))) +(defmethod prefix-suffix ((choice choice)) + (labels ((suffix () + ;; (with-last-read-key-sequence + ;; (log:info (prompt-for-string "enter test value: "))) + (let* ((choices (prefix-choices choice)) + (current-value (prefix-value choice)) + (position (position current-value choices :test 'equal))) + (let ((new-value (if position + ;; mod is to wrap around to 0. :D + (elt choices (mod (1+ position) (length choices))) + (first choices)))) + (log:info "switching to value ~A~%" new-value) + (setf (prefix-value choice) new-value))))) + #'suffix)) (defmacro define-transient (name &body bindings) `(defparameter ,name (parse-transient ',bindings))) diff --git a/src/input.lisp b/src/input.lisp index f7b5f4f5d..bf6ed6e86 100644 --- a/src/input.lisp +++ b/src/input.lisp @@ -12,6 +12,14 @@ (defun set-last-read-key-sequence (key-sequence) (setf last-read-key-sequence key-sequence))) +(defmacro with-last-read-key-sequence (&body body) + "execute BODY with `last-read-key-sequence' temporarily set to NIL, preserving its original value." + (alexandria:with-gensyms (old-value) + `(let ((,old-value (last-read-key-sequence))) + (set-last-read-key-sequence nil) + (unwind-protect (progn ,@body) + (set-last-read-key-sequence ,old-value))))) + (let ((key-recording-status-name " Def")) (defun start-record-key () (modeline-add-status-list key-recording-status-name) @@ -76,48 +84,48 @@ (set-last-mouse-event event) (find-mouse-command event)) (key - (let* ((result (lookup-keybind event)) - (prefix) - (suffix) - (kseq (list event))) - (loop - (setf suffix (car result)) - (setf prefix (cdr result)) - (cond ((prefix-command-p suffix) - (when prefix - (prefix-invoke prefix)) - (when (typep suffix 'keymap) - (keymap-activate suffix)) - (let ((event (read-key))) - (setf kseq (nconc kseq (list event))) + (let ((result) + (prefix) + (suffix) + (behavior) + (kseq (list event))) + (labels ((reset () (setf result (lookup-keybind kseq)) (setf suffix (car result)) - (setf prefix (cdr result)))) - (t - (when prefix - (prefix-invoke prefix)) - (cond - ((eq suffix :drop) - (setf kseq (butlast kseq)) - (set-last-read-key-sequence kseq) - (setf result (lookup-keybind kseq)) - (setf suffix (car result)) - (setf prefix (cdr result))) - ((eq suffix :back) - (setf kseq (subseq kseq 0 (max 0 (- (length kseq) 2)))) - (set-last-read-key-sequence kseq) - (setf result (lookup-keybind kseq)) - (setf suffix (car result)) - (setf prefix (cdr result))) - ((eq suffix :cancel) - (setf kseq nil) - (set-last-read-key-sequence nil) - (keymap-activate *root-keymap*) - (return nil)) - (t - (set-last-read-key-sequence kseq) - (keymap-activate *root-keymap*) - (return suffix))))))))))) + (setf prefix (cdr result)) + (when prefix + (setf behavior (prefix-behavior prefix))))) + (loop + (reset) + (when prefix + (prefix-invoke prefix)) + (when (functionp suffix) + (funcall suffix)) + (cond ((prefix-command-p suffix) + (when (typep suffix 'keymap) + (keymap-activate suffix)) + (let ((event (read-key))) + (setf kseq (nconc kseq (list event))) + (reset))) + (t + (cond + ((eq behavior :drop) + (setf kseq (butlast kseq)) + (set-last-read-key-sequence kseq) + (reset)) + ((eq behavior :back) + (setf kseq (subseq kseq 0 (max 0 (- (length kseq) 2)))) + (set-last-read-key-sequence kseq) + (reset)) + ((eq behavior :cancel) + (setf kseq nil) + (set-last-read-key-sequence nil) + (keymap-activate *root-keymap*) + (return nil)) + (t + (set-last-read-key-sequence kseq) + (keymap-activate *root-keymap*) + (return suffix)))))))))))) (defun read-key-sequence () (read-command) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index 8df410ef4..3e80031e1 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -473,6 +473,7 @@ :keymap* :*root-keymap* :prefix-active-p + :prefix-behavior :keymap-name :keymap-children :keymap-properties @@ -536,6 +537,7 @@ (:export :*input-hook* :last-read-key-sequence + :with-last-read-key-sequence :start-record-key :stop-record-key :key-recording-p diff --git a/src/keymap.lisp b/src/keymap.lisp index e1175cbda..5cbe236ba 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -136,6 +136,15 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (:documentation "a hook for when a prefix is reached.") (:method ((prefix t)) nil)) +(defgeneric prefix-behavior (prefix) + (:documentation "should return one of `:drop', `:back', `:cancel', or NIL to decide the effect of the suffix on the key sequence. + +:cancel to drop the current key sequence entirely without invoking a command +:drop to avoid adding the current key to the key sequence, which makes the prefix act as an \"infix\" key +:back to avoid adding the current key and to pop the last recorded key which has the effect of \"going back\" to parent menu in the transient popup. +NIL to append it to the key sequence normally.") + (:method ((prefix t)) nil)) + (deftype key-sequence () '(trivial-types:proper-list key)) From 2397e14378c90c8d92fc56b8d8a312d38e4cae25 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 29 Jan 2026 00:20:23 +0200 Subject: [PATCH 17/63] use :description instead of :name for keymaps --- extensions/bookmark/bookmark.lisp | 2 +- extensions/copilot/copilot.lisp | 2 +- extensions/lem-dashboard/lem-dashboard.lisp | 2 +- extensions/living-canvas/living-canvas.lisp | 2 +- extensions/transient/popup.lisp | 4 ++-- extensions/vi-mode/core.lisp | 6 +++--- extensions/vi-mode/ex.lisp | 2 +- extensions/vi-mode/visual.lisp | 2 +- src/commands/help.lisp | 2 +- src/ext/completion-mode.lisp | 2 +- src/ext/frame-multiplexer.lisp | 2 +- src/ext/grep.lisp | 2 +- src/ext/isearch.lisp | 2 +- src/ext/prompt-window.lisp | 2 +- src/ext/rectangle.lisp | 2 +- src/ext/universal-argument.lisp | 2 +- src/fundamental-mode.lisp | 2 +- src/internal-packages.lisp | 2 +- src/keymap.lisp | 24 +++++++++------------ src/mode.lisp | 10 ++++----- 20 files changed, 36 insertions(+), 40 deletions(-) diff --git a/extensions/bookmark/bookmark.lisp b/extensions/bookmark/bookmark.lisp index cc17f0fd5..375ad71db 100644 --- a/extensions/bookmark/bookmark.lisp +++ b/extensions/bookmark/bookmark.lisp @@ -58,7 +58,7 @@ Use (DESCRIBE (FIND-PACKAGE \"LEM-BOOKMARK\")) to find all available commands.") If the file is a relative path, it is relative to LEM-HOME.") (defvar *keymap* - (make-keymap :name "Bookmark keymap") + (make-keymap :description "Bookmark keymap") "Keymap for bookmark related commands.") (defvar *bookmark-table* (make-hash-table :test #'equal)) diff --git a/extensions/copilot/copilot.lisp b/extensions/copilot/copilot.lisp index 03e6dfd3d..6471b64d0 100644 --- a/extensions/copilot/copilot.lisp +++ b/extensions/copilot/copilot.lisp @@ -238,7 +238,7 @@ (defvar *inline-completion-request* nil) (defvar *completion-canceled* nil) -(defvar *copilot-completion-keymap* (make-keymap :name "Copilot Completion")) +(defvar *copilot-completion-keymap* (make-keymap :description "Copilot Completion")) (define-key *copilot-completion-keymap* "Tab" 'copilot-accept-suggestion) (define-key *copilot-completion-keymap* 'copilot-next-suggestion 'copilot-next-suggestion) diff --git a/extensions/lem-dashboard/lem-dashboard.lisp b/extensions/lem-dashboard/lem-dashboard.lisp index 96c01b229..c276e890c 100644 --- a/extensions/lem-dashboard/lem-dashboard.lisp +++ b/extensions/lem-dashboard/lem-dashboard.lisp @@ -17,7 +17,7 @@ (defvar *dashboard-buffer-name* "*dashboard*") (defvar *dashboard-enable* t) -(defvar *dashboard-mode-keymap* (make-keymap :name '*dashboard-mode-keymap* :parent *global-keymap*)) +(defvar *dashboard-mode-keymap* (make-keymap :description '*dashboard-mode-keymap* :parent *global-keymap*)) (defvar *dashboard-layout* nil "List of dashboard-item instances; will be drawn in order.") diff --git a/extensions/living-canvas/living-canvas.lisp b/extensions/living-canvas/living-canvas.lisp index ef80b6901..9434b60af 100644 --- a/extensions/living-canvas/living-canvas.lisp +++ b/extensions/living-canvas/living-canvas.lisp @@ -41,7 +41,7 @@ "Current overlay used to highlight the selected function in source view.") (defvar *living-canvas-keymap* - (lem:make-keymap :name '*living-canvas-keymap*)) + (lem:make-keymap :description '*living-canvas-keymap*)) ;;; Attributes diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index dcb56bc75..0064882b5 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -112,7 +112,7 @@ completion interface if present." (princ-to-string desc) (let ((suffix (prefix-suffix prefix))) (cond ((typep suffix 'keymap) - (princ-to-string (or (keymap-name suffix) "+prefix"))) + (princ-to-string (or (keymap-description suffix) "+prefix"))) ((typep suffix 'prefix) (or (prefix-description suffix) "+prefix")) (t (princ-to-string suffix))))))) @@ -173,7 +173,7 @@ nested keymaps are arranged based on display-style (:row or :column)." (setf keymap-layouts (nreverse keymap-layouts)) (let ((parts) (content-items)) - (let ((title (or (keymap-name keymap) "[unnamed keymap]"))) + (let ((title (or (keymap-description keymap) "[unnamed keymap]"))) (push (make-layout-title :text title) parts)) ;; collect prefix column and keymap layouts as content items (when prefix-items diff --git a/extensions/vi-mode/core.lisp b/extensions/vi-mode/core.lisp index c5ad329b8..a425d9389 100644 --- a/extensions/vi-mode/core.lisp +++ b/extensions/vi-mode/core.lisp @@ -269,11 +269,11 @@ (defclass vi-keymap (keymap*) ()) -(defun make-vi-keymap (&rest args &key undef-hook parent name) - (declare (ignore undef-hook parent name)) +(defun make-vi-keymap (&rest args &key undef-hook parent description) + (declare (ignore undef-hook parent description)) (apply 'make-instance 'vi-keymap (alexandria:remove-from-plist args :parent))) (defmacro define-keymap (name &key undef-hook) (declare (ignore parent)) - `(defvar ,name (make-vi-keymap :name ',name + `(defvar ,name (make-vi-keymap :description ',name :undef-hook ,undef-hook))) diff --git a/extensions/vi-mode/ex.lisp b/extensions/vi-mode/ex.lisp index b3549d0b2..ab184b82d 100644 --- a/extensions/vi-mode/ex.lisp +++ b/extensions/vi-mode/ex.lisp @@ -14,7 +14,7 @@ :*ex-keymap*)) (in-package :lem-vi-mode/ex) -(defvar *ex-keymap* (make-keymap :name '*ex-keymap*)) +(defvar *ex-keymap* (make-keymap :description '*ex-keymap*)) (define-state ex () () (:default-initargs diff --git a/extensions/vi-mode/visual.lisp b/extensions/vi-mode/visual.lisp index eafc2e962..4c698dfb0 100644 --- a/extensions/vi-mode/visual.lisp +++ b/extensions/vi-mode/visual.lisp @@ -34,7 +34,7 @@ :vi-visual-opposite-side)) (in-package :lem-vi-mode/visual) -(defvar *visual-keymap* (make-keymap :name '*visual-keymap*)) +(defvar *visual-keymap* (make-keymap :description '*visual-keymap*)) (defmethod make-region-overlays-using-global-mode ((global-mode vi-mode) cursor) (let ((buffer (point-buffer cursor))) diff --git a/src/commands/help.lisp b/src/commands/help.lisp index 2b1daa243..5673f95aa 100644 --- a/src/commands/help.lisp +++ b/src/commands/help.lisp @@ -28,7 +28,7 @@ (terpri s)) (let ((column-width 16)) (loop :while keymap - :do (format s "~A (~(~A~))~%" name (keymap-name keymap)) + :do (format s "~A (~(~A~))~%" name (keymap-description keymap)) (format s "~va~a~%" column-width "key" "binding") (format s "~va~a~%" column-width "---" "-------") (traverse-keymap keymap diff --git a/src/ext/completion-mode.lisp b/src/ext/completion-mode.lisp index 0abb0d1c1..1e90e52c8 100644 --- a/src/ext/completion-mode.lisp +++ b/src/ext/completion-mode.lisp @@ -98,7 +98,7 @@ (declare (ignore label chunks detail start end focus-action)) (apply #'make-instance 'completion-item initargs)) -(defvar *completion-mode-keymap* (make-keymap :name '*completion-mode-keymap* +(defvar *completion-mode-keymap* (make-keymap :description '*completion-mode-keymap* :undef-hook 'completion-self-insert)) (define-minor-mode completion-mode (:name "completion" diff --git a/src/ext/frame-multiplexer.lisp b/src/ext/frame-multiplexer.lisp index b2a8edd23..0a7721c31 100644 --- a/src/ext/frame-multiplexer.lisp +++ b/src/ext/frame-multiplexer.lisp @@ -53,7 +53,7 @@ (frame-multiplexer-off)))) (defvar *keymap* - (make-keymap :name '*frame-multiplexer-keymap*) + (make-keymap :description '*frame-multiplexer-keymap*) "Keymap for commands related to the frame-multiplexer.") (define-key *keymap* "c" 'frame-multiplexer-create-with-new-buffer-list) diff --git a/src/ext/grep.lisp b/src/ext/grep.lisp index 4a0d7a522..1c24f2693 100644 --- a/src/ext/grep.lisp +++ b/src/ext/grep.lisp @@ -182,7 +182,7 @@ ""))) (format s "~%"))) -(defvar *peek-grep-mode-keymap* (make-keymap :name '*peek-grep-mode-keymap* +(defvar *peek-grep-mode-keymap* (make-keymap :description '*peek-grep-mode-keymap* :parent lem/peek-source:*peek-source-keymap*)) (define-minor-mode peek-grep-mode (:name "Peek" diff --git a/src/ext/isearch.lisp b/src/ext/isearch.lisp index d565b1b6e..534714eda 100644 --- a/src/ext/isearch.lisp +++ b/src/ext/isearch.lisp @@ -37,7 +37,7 @@ (:lock t)) (in-package :lem/isearch) -(defvar *isearch-keymap* (make-keymap :name '*isearch-keymap* +(defvar *isearch-keymap* (make-keymap :description '*isearch-keymap* :undef-hook 'isearch-self-insert)) (defvar *isearch-prompt*) (defvar *isearch-string*) diff --git a/src/ext/prompt-window.lisp b/src/ext/prompt-window.lisp index 16f82c2c3..a10d1e096 100644 --- a/src/ext/prompt-window.lisp +++ b/src/ext/prompt-window.lisp @@ -522,7 +522,7 @@ (setf *prompt-buffer-completion-function* 'prompt-buffer-completion) (setf *prompt-command-completion-function* 'prompt-command-completion) -(defvar *file-prompt-keymap* (make-keymap :name '*file-mode-prompt-keymap*)) +(defvar *file-prompt-keymap* (make-keymap :description '*file-mode-prompt-keymap*)) (define-key *file-prompt-keymap* "C-Backspace" 'file-prompt-parent-folder) (define-command file-prompt-parent-folder () () diff --git a/src/ext/rectangle.lisp b/src/ext/rectangle.lisp index 9e779fb76..031404940 100644 --- a/src/ext/rectangle.lisp +++ b/src/ext/rectangle.lisp @@ -9,7 +9,7 @@ (defvar *overlays* '()) (defvar *rectangle-mark-mode-keymap* - (make-keymap :name '*rectangle-mark-mode-keymap* + (make-keymap :description '*rectangle-mark-mode-keymap* :undef-hook 'rectangle-self-insert)) (define-minor-mode rectangle-mark-mode diff --git a/src/ext/universal-argument.lisp b/src/ext/universal-argument.lisp index a6121a90c..f8bb028e0 100644 --- a/src/ext/universal-argument.lisp +++ b/src/ext/universal-argument.lisp @@ -30,7 +30,7 @@ (defvar *argument* (make-arg-state)) (defvar *universal-argument-keymap* - (make-keymap :name '*universal-argument-keymap* + (make-keymap :description '*universal-argument-keymap* :undef-hook 'universal-argument-default)) (define-editor-variable universal-argument-function diff --git a/src/fundamental-mode.lisp b/src/fundamental-mode.lisp index d4d33d38f..e132c3ac2 100644 --- a/src/fundamental-mode.lisp +++ b/src/fundamental-mode.lisp @@ -3,7 +3,7 @@ (define-major-mode lem/buffer/fundamental-mode:fundamental-mode nil (:name "Fundamental")) -(defvar *global-keymap* (make-keymap :name '*global-keymap*)) +(defvar *global-keymap* (make-keymap :description '*global-keymap*)) (define-global-mode emacs-mode () (:name "emacs" diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index 3e80031e1..d184aff0d 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -474,8 +474,8 @@ :*root-keymap* :prefix-active-p :prefix-behavior - :keymap-name :keymap-children + :keymap-description :keymap-properties :parse-keyspec :prefix-properties diff --git a/src/keymap.lisp b/src/keymap.lisp index 5cbe236ba..d4bf2628b 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -94,11 +94,7 @@ the underlying storage slot is renamed with a '*' suffix." :initarg :active-p :dynamic t :documentation "whether a prefix is active." - :initform t) - (name - :initarg :name - :accessor keymap-name - :initform nil))) + :initform t))) (defmethod keymap-add-prefix ((keymap keymap) (prefix prefix) &optional after) (unless (listp (keymap-children* keymap)) @@ -170,14 +166,14 @@ NIL to append it to the key sequence normally.") (defmethod print-object ((object keymap) stream) (print-unreadable-object (object stream :identity t :type t) - (when (keymap-name object) - (princ (keymap-name object) stream)))) - -(defun make-keymap (&key undef-hook parent name) - (let ((keymap (make-instance - 'keymap* - :undef-hook undef-hook - :name name))) + (when (keymap-description object) + (princ (keymap-description object) stream)))) + +;; TODO: we arent using parent properly here +(defun make-keymap (&key undef-hook parent description) + (let ((keymap (make-instance 'keymap* + :undef-hook undef-hook + :description description))) keymap)) (defun prefix-command-p (command) @@ -455,7 +451,7 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (defparameter *other-keymaps-root* (make-instance 'keymap* :children #'other-keymaps - :name '*other-keymaps-root*)) + :description '*other-keymaps-root*)) (defun lookup-keybind (key) (unless (find *other-keymaps-root* (keymap-children *root-keymap*)) diff --git a/src/mode.lisp b/src/mode.lisp index 50216181b..90d80eab0 100644 --- a/src/mode.lisp +++ b/src/mode.lisp @@ -149,7 +149,7 @@ ,@(when mode-hook `((defvar ,mode-hook '()))) ,@(when keymap - `((defvar ,keymap (make-keymap :name ',keymap + `((defvar ,keymap (make-keymap :description ',keymap :parent ,(when parent-mode `(mode-keymap ',parent-mode)))))) (define-command (,major-mode (:class ,command-class-name)) () () @@ -205,7 +205,7 @@ (let ((command-class-name (make-mode-command-class-name minor-mode))) `(progn ,@(when keymapp - `((defvar ,keymap (make-keymap :name ',keymap)))) + `((defvar ,keymap (make-keymap :description ',keymap)))) (define-command (,minor-mode (:class ,command-class-name)) (&optional (arg nil arg-p)) (:universal) (cond ((not arg-p) (toggle-minor-mode ',minor-mode)) @@ -251,9 +251,9 @@ (let ((command-class-name (make-mode-command-class-name mode))) `(progn ,@(when keymap - `((defvar ,keymap - (make-keymap :name ',keymap - :parent (alexandria:when-let ((,parent-mode + `((defvar ,keymap + (make-keymap :description ',keymap + :parent (alexandria:when-let ((,parent-mode ,(when parent `(get-mode-object ',parent)))) (mode-keymap ,parent-mode)))))) From 4d37d3576ede93dde66eaf5e8117cf88ddaa36ba Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 30 Jan 2026 00:34:31 +0200 Subject: [PATCH 18/63] introduce toggle infix, use prompt for multi-choice infix --- extensions/transient/demo.lisp | 8 +++-- extensions/transient/keymap.lisp | 53 ++++++++++++++++++++++++-------- extensions/transient/popup.lisp | 8 ++++- src/keymap.lisp | 24 +++++++++------ 4 files changed, 67 insertions(+), 26 deletions(-) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index b0f5dd70b..436d9dc1d 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -13,7 +13,7 @@ (:key "p" :suffix demo-pdf :description "pdf") (:key "h" :suffix demo-html :description "html") (:key "m" :suffix demo-md :description "markdown") - (:key "b" :suffix :back :description "back")) + (:key "b" :behavior :back :description "back")) :description "export format")) (:keymap :display-style :column @@ -21,7 +21,7 @@ (:key "c" :suffix demo-copy) (:key "v" :suffix demo-paste) (:key "u" :suffix demo-undo) - (:key "q" :suffix :cancel :description "quit")) + (:key "q" :behavior :cancel :description "quit")) (:key "f" :suffix (:keymap (:key "g" :suffix demo-grep :description "grep") @@ -50,7 +50,9 @@ :type :choice :choices ("on" "off") :description "debug toggle") - (:key "R" :suffix demo-run :description "run with mode")) + (:key "R" :suffix demo-run :description "run with mode") + (:key "T" :type toggle :value t :suffix demo-toggle :description "demo toggle") + ) (define-command demo-run () () (let ((mode-prefix (find-prefix-by-id *demo-keymap* :mode))) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 04d5634d8..e34231bc2 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -81,33 +81,60 @@ the setter stores directly." (value)) (:documentation "a prefix that may take on different values.")) -(defmethod prefix-value ((choice choice)) - (if (slot-boundp choice 'value) - (slot-value choice 'value) - (car (prefix-choices choice)))) +(defclass toggle (infix) + ((value :initform nil)) + (:documentation "a boolean infix.")) + +(defmethod prefix-value ((prefix prefix)) + (slot-value prefix 'value)) + +(defmethod prefix-value ((prefix choice)) + (if (slot-boundp prefix 'value) + (slot-value prefix 'value) + (car (prefix-choices prefix)))) + +(defmethod (setf prefix-value) (new-value (prefix prefix)) + (setf (slot-value prefix 'value) new-value)) ;; infixes dont modify the keymap menu, we drop the key and dont append it to the recorded keyseq (defmethod prefix-behavior ((prefix infix)) :drop) -(defmethod (setf prefix-value) (new-value (choice choice)) - (setf (slot-value choice 'value) new-value)) +;; this one applies the next value from the choices list without a prompt +;; (defmethod prefix-suffix ((choice choice)) +;; (labels ((suffix () +;; (let* ((choices (prefix-choices choice)) +;; (current-value (prefix-value choice)) +;; (position (position current-value choices :test 'equal))) +;; (let ((new-value (if position +;; ;; mod is to wrap around to 0. :D +;; (elt choices (mod (1+ position) (length choices))) +;; (first choices)))) +;; (log:info "switching to value ~A~%" new-value) +;; (setf (prefix-value choice) new-value))))) +;; #'suffix)) (defmethod prefix-suffix ((choice choice)) (labels ((suffix () - ;; (with-last-read-key-sequence - ;; (log:info (prompt-for-string "enter test value: "))) (let* ((choices (prefix-choices choice)) (current-value (prefix-value choice)) - (position (position current-value choices :test 'equal))) - (let ((new-value (if position - ;; mod is to wrap around to 0. :D - (elt choices (mod (1+ position) (length choices))) - (first choices)))) + (new-value)) + (with-last-read-key-sequence + (setf new-value + (prompt-for-string "new value: " + :initial-value current-value + :completion-function (lambda (x) + choices)))) + (when new-value (log:info "switching to value ~A~%" new-value) (setf (prefix-value choice) new-value))))) #'suffix)) +(defmethod prefix-suffix ((prefix toggle)) + (labels ((suffix () + (setf (prefix-value prefix) (not (prefix-value prefix))))) + #'suffix)) + (defmacro define-transient (name &body bindings) `(defparameter ,name (parse-transient ',bindings))) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 0064882b5..34da52dda 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -125,7 +125,7 @@ completion interface if present." :key (princ-to-string (prefix-key prefix)) :description (get-description prefix))) -(defmethod prefix-render ((prefix choice)) +(defun prefix-render-with-value (prefix) (let* ((desc (get-description prefix)) (value (prefix-value prefix)) (value-str (princ-to-string value))) @@ -139,6 +139,12 @@ completion interface if present." :key (princ-to-string (prefix-key prefix)) :description description-segments)))) +(defmethod prefix-render ((prefix choice)) + (prefix-render-with-value prefix)) + +(defmethod prefix-render ((prefix toggle)) + (prefix-render-with-value prefix)) + (defmethod prefix-render :around ((prefix prefix)) (let ((item (call-next-method))) (when item diff --git a/src/keymap.lisp b/src/keymap.lisp index d4bf2628b..6dc7778e6 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -60,6 +60,15 @@ the underlying storage slot is renamed with a '*' suffix." :dynamic t :documentation "whether a prefix is active." :initform t) + (behavior + :initarg :behavior + :initform nil + :documentation "should be one of `:drop', `:back', `:cancel', or NIL to decide the effect of the suffix on the key sequence. + +:cancel to drop the current key sequence entirely without invoking a command. +:drop to avoid adding the current key to the key sequence, which makes the prefix act as an \"infix\" key. +:back to avoid adding the current key and to pop the last recorded key which has the effect of \"going back\" to parent menu in the transient popup. +NIL to append it to the key sequence normally.") (properties :initarg :properties :accessor prefix-properties @@ -122,6 +131,12 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (or (typep (prefix-suffix p) 'prefix) (typep (prefix-suffix p) 'keymap))) +(defmethod (setf prefix-behavior) (new-value (prefix prefix)) + (setf (slot-value prefix 'behavior) new-value)) + +(defmethod prefix-behavior ((prefix prefix)) + (slot-value prefix 'behavior)) + (defgeneric keymap-activate (keymap) (:documentation "a hook for when a keymap is entered by some prefix.") ;; default keymap-activate does nothing @@ -132,15 +147,6 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (:documentation "a hook for when a prefix is reached.") (:method ((prefix t)) nil)) -(defgeneric prefix-behavior (prefix) - (:documentation "should return one of `:drop', `:back', `:cancel', or NIL to decide the effect of the suffix on the key sequence. - -:cancel to drop the current key sequence entirely without invoking a command -:drop to avoid adding the current key to the key sequence, which makes the prefix act as an \"infix\" key -:back to avoid adding the current key and to pop the last recorded key which has the effect of \"going back\" to parent menu in the transient popup. -NIL to append it to the key sequence normally.") - (:method ((prefix t)) nil)) - (deftype key-sequence () '(trivial-types:proper-list key)) From 8a418d8fd7e3c2d1d69bc34a48363648f5fbef1f Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 30 Jan 2026 04:41:29 +0200 Subject: [PATCH 19/63] fix vim search before this, after typing / and trying to search, the following keys would be interpreted as if they were entered in normal mode instead, and searching functionality was broken. this is more of a bandaid than a fix, i need to rewrite the whole 'undef-hook' thing which i think is annoying and unintuitive --- src/keymap.lisp | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/keymap.lisp b/src/keymap.lisp index 6dc7778e6..06f7d0f01 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -337,7 +337,10 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" ((typep binding 'keymap) (when (keymap-active-p binding) (loop for item in (keymap-children binding) - append (find-matching-prefixes item key)))))) + append (find-matching-prefixes item key) into matches + when (and (typep item 'keymap*) (keymap-undef-hook item)) + do (return matches) + finally (return matches)))))) (defun find-in-function-table (binding key) "search function-table of keymaps in hierarchy for KEY." @@ -352,7 +355,9 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" ;; if found, return it; otherwise search children (or result (loop for child in (keymap-children binding) - thereis (find-in-function-table child key))))) + thereis (or (find-in-function-table child key) + (and (typep child 'keymap*) + (keymap-undef-hook child))))))) ((typep binding 'keymap) (loop for child in (keymap-children binding) thereis (find-in-function-table child key))) From 4b3354532b2cc574439b1583a891ce0c8b8edc45 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 30 Jan 2026 21:58:24 +0200 Subject: [PATCH 20/63] fix undefine-key (actually undefine-key-internal) --- src/keymap.lisp | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/src/keymap.lisp b/src/keymap.lisp index 06f7d0f01..c0bc360d7 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -287,15 +287,16 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" bindings))) (defun undefine-key-internal (keymap keys) - (loop :with table := (keymap-table keymap) - :for rest :on (uiop:ensure-list keys) - :for k := (car rest) - :do (cond ((null (cdr rest)) - (remhash k table)) - (t - (let ((next (gethash k table))) - (when (prefix-command-p next) - (setf table next))))))) + (labels ((search-tree (binding keys-to-find) + (when keys-to-find + (let ((matches (find-matching-prefixes binding (car keys-to-find)))) + (loop for match in matches + for suffix = (prefix-suffix match) + do (if (cdr keys-to-find) + (search-tree suffix (cdr keys-to-find)) + (setf (keymap-children binding) + (delete match (keymap-children binding))))))))) + (search-tree keymap keys))) (defun parse-keyspec (string) (labels ((fail () From 30d4ea5914d3d0490a408b61b2402a23f3174d82 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 30 Jan 2026 22:57:09 +0200 Subject: [PATCH 21/63] remvoe some redundant stuff --- extensions/transient/keymap.lisp | 3 --- extensions/transient/popup.lisp | 5 +++-- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index e34231bc2..11fe892d1 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -62,9 +62,6 @@ the setter stores directly." (f suffix)))))))) (f keymap))) -(defgeneric prefix-render (prefix) - (:documentation "render prefix into a layout item. returns nil to use default rendering.")) - (defmethod keymap-display-style ((keymap keymap)) "should return :row or :column. used to construct the display" (getf (keymap-properties keymap) :display-style :row)) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 34da52dda..509ea44b8 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -179,8 +179,9 @@ nested keymaps are arranged based on display-style (:row or :column)." (setf keymap-layouts (nreverse keymap-layouts)) (let ((parts) (content-items)) - (let ((title (or (keymap-description keymap) "[unnamed keymap]"))) - (push (make-layout-title :text title) parts)) + (let ((title (keymap-description keymap))) + (when title + (push (make-layout-title :text title) parts))) ;; collect prefix column and keymap layouts as content items (when prefix-items (let ((max-key-width (reduce 'max From 79229a8b0fa6ca0b29d6ea3d51faf0f588c69f5a Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 30 Jan 2026 23:41:15 +0200 Subject: [PATCH 22/63] properly parse keymap keywords in transient, change title styling --- extensions/transient/keymap.lisp | 31 ++++++++++++++----------------- extensions/transient/popup.lisp | 6 ++++-- 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 11fe892d1..a0ca9107a 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -45,6 +45,7 @@ the setter stores directly." (add-dynamic-property keymap keymap-properties show-p t) (add-dynamic-property prefix prefix-properties show-p t) ;; static properties dont take a function that returns a value, just a value. +(add-static-property keymap keymap-properties display-style :row) (add-static-property prefix prefix-properties id) (defun find-prefix-by-id (keymap id) @@ -62,13 +63,6 @@ the setter stores directly." (f suffix)))))))) (f keymap))) -(defmethod keymap-display-style ((keymap keymap)) - "should return :row or :column. used to construct the display" - (getf (keymap-properties keymap) :display-style :row)) - -(defmethod (setf keymap-display-style) (val (keymap keymap)) - (setf (getf (keymap-properties keymap) :display-style) val)) - (defclass infix (prefix) ()) @@ -142,16 +136,19 @@ the setter stores directly." while tail do (let ((binding (car tail))) (cond - ;; inline property - ((keywordp binding) - (let ((val (second tail))) - (setf (getf (keymap-properties keymap) binding) val)) - ;; advance another cell because we're already consumed it (second tail) - (setf tail (cdr tail))) - ;; direct child keymap (:keymap ...) - ((eq (car binding) :keymap) - (let ((sub-map (parse-transient (cdr binding)))) - (keymap-add-child keymap sub-map t))) + ;; inline property + ((keywordp binding) + (let ((val (second tail))) + (let ((key-method (intern (format nil "KEYMAP-~A" (string binding)) :lem/transient))) + (if (fboundp key-method) + (funcall (fdefinition (list 'setf key-method)) val keymap) + (setf (getf (keymap-properties keymap) binding) val)))) + ;; advance another cell because we're already consumed it (second tail) + (setf tail (cdr tail))) + ;; direct child keymap (:keymap ...) + ((eq (car binding) :keymap) + (let ((sub-map (parse-transient (cdr binding)))) + (keymap-add-child keymap sub-map t))) ;; key binding (:key ...) ((eq (car binding) :key) (let* ((key (second binding)) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 509ea44b8..e2c99004e 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -210,8 +210,10 @@ nested keymaps are arranged based on display-style (:row or :column)." (cond ((null layout) nil) ((layout-title-p layout) - (list (list (cons (format nil "-- ~A --" (layout-title-text layout)) - 'transient-title-attribute)))) + (let ((text (princ-to-string (layout-title-text layout)))) + (list (list (cons "[" 'transient-bracket-attribute) + (cons text 'transient-title-attribute) + (cons "]" 'transient-bracket-attribute))))) ((layout-separator-p layout) (list (list (cons "----------------" 'transient-separator-attribute)))) ((layout-item-p layout) From 3d8b2d5235db6f7a9d9fe0ca32fb3d9eee4f4e6d Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Mon, 2 Feb 2026 00:40:53 +0200 Subject: [PATCH 23/63] small fix --- src/keymap.lisp | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/keymap.lisp b/src/keymap.lisp index c0bc360d7..900d17cbb 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -404,9 +404,8 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (let* ((keyseq (etypecase key (key (list key)) (list key))) - (suffix-result (find-suffix keymap keyseq)) - (suffix (car suffix-result))) - (cond (suffix + (suffix-result (find-suffix keymap keyseq))) + (cond (suffix-result (normalize-binding (car suffix-result) (cdr suffix-result))) (t (let ((result From 891b2f30d95d4468168e05be083825ef2a2f7a78 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Tue, 3 Feb 2026 23:37:18 +0200 Subject: [PATCH 24/63] introduce "intermediate" prefixes --- extensions/transient/demo.lisp | 3 +- extensions/transient/keymap.lisp | 40 ++++++- extensions/transient/popup.lisp | 194 +++++++++++++++++++++++-------- src/input.lisp | 30 ++++- src/internal-packages.lisp | 1 + src/keymap.lisp | 11 ++ 6 files changed, 222 insertions(+), 57 deletions(-) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index 436d9dc1d..6cbf3fe9c 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -52,7 +52,8 @@ :description "debug toggle") (:key "R" :suffix demo-run :description "run with mode") (:key "T" :type toggle :value t :suffix demo-toggle :description "demo toggle") - ) + (:key "e e" :type toggle :value t :suffix demo-toggle :description "another demo toggle") + (:key "e a" :type toggle :value t :suffix demo-toggle :description "and another demo toggle")) (define-command demo-run () () (let ((mode-prefix (find-prefix-by-id *demo-keymap* :mode))) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index a0ca9107a..ea4bba31d 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -47,6 +47,8 @@ the setter stores directly." ;; static properties dont take a function that returns a value, just a value. (add-static-property keymap keymap-properties display-style :row) (add-static-property prefix prefix-properties id) +;; TODO: it would be better to store the parsed key sequence instead of the stringified one and work with that. +(add-static-property prefix prefix-properties display-key) (defun find-prefix-by-id (keymap id) (labels ((f (node) @@ -152,10 +154,39 @@ the setter stores directly." ;; key binding (:key ...) ((eq (car binding) :key) (let* ((key (second binding)) - ;; prefix-class depends on the first cell in the :suffix value (if its a list at all) (prefix-type (intern (symbol-name (getf binding :type 'prefix)) :lem/transient)) - (prefix (make-instance prefix-type))) - (setf (prefix-key prefix) (car (parse-keyspec key))) + (prefix (make-instance prefix-type)) + (last-keymap keymap)) + (let ((parsed-key (parse-keyspec key))) + ;; store the full key string for multi-key bindings + (when (cdr parsed-key) + (setf (prefix-display-key prefix) key)) + ;; we need to create intermediate prefixes if the key is longer than one + (loop for cell on parsed-key + for i from 0 + for lastp = (null (cdr cell)) + for current-key = (car cell) + for current-prefix = (if lastp + prefix + ;; reuse existing intermediate prefix with same key, or create new one + (let ((existing (find current-key (keymap-children last-keymap) + :test (lambda (k child) + (and (typep child 'prefix) + (prefix-intermediate-p child) + (equal k (prefix-key child))))))) + (if existing + (progn + (setf last-keymap (prefix-suffix existing)) + existing) + (let* ((new-prefix (make-instance 'prefix)) + (new-keymap (make-instance 'keymap*))) + (keymap-add-prefix last-keymap new-prefix t) + (setf (prefix-suffix new-prefix) new-keymap) + (setf (prefix-intermediate-p new-prefix) t) + (setf last-keymap new-keymap) + new-prefix)))) + do (setf (prefix-key current-prefix) current-key)) + (keymap-add-prefix last-keymap prefix t) ;; sometimes the suffix will not be set (e.g. prefix-type is :choice). we ;; initialize it to nil to avoid unbound errors. (setf (prefix-suffix prefix) nil) @@ -176,6 +207,5 @@ the setter stores directly." (when should-set (funcall (fdefinition (list 'setf key-method)) final-value - prefix)))) - (keymap-add-prefix keymap prefix t)))))) + prefix)))))))))) keymap)) \ No newline at end of file diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index e2c99004e..8b800e44a 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -15,6 +15,10 @@ " | " "string used to separate columns in row layout.") +(define-attribute transient-matched-key-attribute + (t + :foreground (attribute-foreground (ensure-attribute 'syntax-string-attribute)))) + (define-attribute transient-key-attribute (t :foreground (attribute-foreground (ensure-attribute 'syntax-function-name-attribute)))) @@ -117,35 +121,97 @@ completion interface if present." (or (prefix-description suffix) "+prefix")) (t (princ-to-string suffix))))))) -(defgeneric prefix-render (prefix) - (:documentation "return a layout item that should be displayed for the prefix in the popup.")) - -(defmethod prefix-render ((prefix prefix)) - (make-layout-item - :key (princ-to-string (prefix-key prefix)) - :description (get-description prefix))) - -(defun prefix-render-with-value (prefix) - (let* ((desc (get-description prefix)) - (value (prefix-value prefix)) - (value-str (princ-to-string value))) - (let ((description-segments - (list (cons desc nil) - (cons " " nil) - (cons "[" 'transient-bracket-attribute) - (cons value-str 'transient-value-attribute) - (cons "]" 'transient-bracket-attribute)))) - (make-layout-item - :key (princ-to-string (prefix-key prefix)) - :description description-segments)))) - -(defmethod prefix-render ((prefix choice)) - (prefix-render-with-value prefix)) - -(defmethod prefix-render ((prefix toggle)) - (prefix-render-with-value prefix)) - -(defmethod prefix-render :around ((prefix prefix)) +(defun prefix-effective-display-key (prefix) + "return the display key for PREFIX, falling back to one returned by prefix-key." + (or (prefix-display-key prefix) + (princ-to-string (prefix-key prefix)))) + +(defun keymap-contains-via-intermediates-p (keymap target) + "return T if TARGET is reachable from KEYMAP through a sequence of intermediate prefixes." + (dolist (child (keymap-children keymap)) + (when (and (typep child 'prefix) (prefix-intermediate-p child)) + (let ((suffix (prefix-suffix child))) + (when (and (typep suffix 'keymap) + (or (eq suffix target) + (keymap-contains-via-intermediates-p suffix target))) + (return t)))))) + +;; TODO: this is hacky +(defun make-key-with-highlight (key-str matched-depth) + "return KEY-STR as highlighted segments if MATCHED-DEPTH > 0. + +MATCHED-DEPTH is the number of key parts (space-separated) to highlight." + (if (and matched-depth (> matched-depth 0)) + (let ((pos 0) + (parts-found 0)) + ;; walk through key-str counting space-separated parts + (loop :for i :from 0 :below (length key-str) + :while (< parts-found matched-depth) + :do (if (char= (char key-str i) #\Space) + (incf parts-found) + (setf pos (1+ i)))) + (if (> pos 0) + (let ((matched (subseq key-str 0 pos)) + (unmatched (subseq key-str pos))) + (list (cons matched 'transient-matched-key-attribute) + (cons unmatched 'transient-key-attribute))) + key-str)) + key-str)) + +(defun make-value-description (prefix) + "build description segments for a prefix that displays its value, e.g. 'desc [value]'." + (let ((desc (get-description prefix)) + (value-str (princ-to-string (prefix-value prefix)))) + (list (cons desc nil) + (cons " " nil) + (cons "[" 'transient-bracket-attribute) + (cons value-str 'transient-value-attribute) + (cons "]" 'transient-bracket-attribute)))) + +(defgeneric prefix-render (prefix &optional matched-depth) + (:documentation "return a layout item that should be displayed for the prefix in the popup. + +MATCHED-DEPTH is the number of key parts (space-separated) to highlight.")) + +(defmethod prefix-render ((prefix prefix) &optional matched-depth) + (let ((key-str (prefix-effective-display-key prefix))) + (make-layout-item + :key (make-key-with-highlight key-str matched-depth) + :description (get-description prefix)))) + +(defun prefix-render-with-value (prefix matched-depth) + (let ((key-str (prefix-effective-display-key prefix))) + (make-layout-item + :key (make-key-with-highlight key-str matched-depth) + :description (make-value-description prefix)))) + +(defmethod prefix-render ((prefix choice) &optional matched-depth) + (prefix-render-with-value prefix matched-depth)) + +(defmethod prefix-render ((prefix toggle) &optional matched-depth) + (prefix-render-with-value prefix matched-depth)) + +(defun find-intermediate-root (active-keymap) + "find the effective root keymap for ACTIVE-KEYMAP by searching from *root-keymap* tree. + +returns the nearest ancestor keymap that reaches ACTIVE-KEYMAP through intermediate prefixes, +or ACTIVE-KEYMAP itself if no such ancestor exists." + (labels ((find-root (keymap) + ;; check if this keymap reaches active-keymap via intermediates + (when (keymap-contains-via-intermediates-p keymap active-keymap) + (return-from find-intermediate-root keymap)) + ;; recurse into child keymaps + (dolist (child (keymap-children keymap)) + (cond ((typep child 'keymap) + (find-root child)) + ((typep child 'prefix) + (let ((suffix (prefix-suffix child))) + (when (typep suffix 'keymap) + (find-root suffix)))))))) + (find-root *root-keymap*) + active-keymap)) + +(defmethod prefix-render :around ((prefix prefix) &optional matched-depth) (let ((item (call-next-method))) (when item (unless (prefix-active-p prefix) @@ -153,27 +219,46 @@ completion interface if present." (setf (layout-item-description-attribute item) 'transient-inactive-attribute))) item)) -(defun generate-layout (keymap) +(defun generate-layout (keymap &optional active-keymap) "generate layout from keymap structure. -prefixes always display vertically as items. -nested keymaps are arranged based on display-style (:row or :column)." +prefixes always display vertically in their own column. +nested keymaps are arranged based on display-style (:row or :column). +prefixes marked as :intermediate-p are flattened and shown with concatenated keys." (unless (keymap-show-p keymap) (return-from generate-layout nil)) (let ((prefix-items) (keymap-layouts)) - ;; process children, separating prefixes from keymaps - (dolist (child (keymap-children keymap)) - (cond - ;; nested keymap: recurse and collect - ((typep child 'keymap) - (alexandria:when-let ((child-layout (generate-layout child))) - (push child-layout keymap-layouts))) - ;; prefix: create item if show-p - ((typep child 'prefix) - (when (prefix-show-p child) - (let ((item (prefix-render child))) - (push item prefix-items)))))) + (labels ((collect-items (node &optional (matched-depth 0)) + (cond + ;; nested keymap: recurse and collect + ((typep node 'keymap) + (alexandria:when-let ((child-layout (generate-layout node active-keymap))) + (push child-layout keymap-layouts))) + ;; prefix: create item if show-p + ((typep node 'prefix) + (when (prefix-show-p node) + (if (prefix-intermediate-p node) + (let* ((suffix (prefix-suffix node)) + (new-depth (if (and active-keymap + (typep suffix 'keymap) + (or (eq suffix active-keymap) + (keymap-contains-via-intermediates-p + suffix active-keymap))) + (1+ matched-depth) + matched-depth))) + (if (typep suffix 'keymap) + (dolist (child (keymap-children suffix)) + (collect-items child new-depth)) + (push (prefix-render node new-depth) prefix-items))) + (push (prefix-render + node + (when (prefix-display-key node) + matched-depth)) + prefix-items))))))) + ;; process children, separating prefixes from keymaps + (dolist (child (keymap-children keymap)) + (collect-items child))) ;; build result: title first, then content (prefixes + keymaps arranged by display-style) (setf prefix-items (nreverse prefix-items)) (setf keymap-layouts (nreverse keymap-layouts)) @@ -187,7 +272,10 @@ nested keymaps are arranged based on display-style (:row or :column)." (let ((max-key-width (reduce 'max prefix-items :key (lambda (item) - (length (layout-item-key item))) + (let ((key (layout-item-key item))) + (if (listp key) + (segment-line-width key) + (length key)))) :initial-value 0))) (push (make-layout-column :items prefix-items :key-width max-key-width) content-items))) @@ -218,13 +306,18 @@ nested keymaps are arranged based on display-style (:row or :column)." (list (list (cons "----------------" 'transient-separator-attribute)))) ((layout-item-p layout) (let* ((key (layout-item-key layout)) - (padding (max 0 (- key-width (length key)))) + (key-is-segments (listp key)) + (padding (if key-is-segments + (max 0 (- key-width (segment-line-width key))) + (max 0 (- key-width (length key))))) (desc (layout-item-description layout)) (inactive (eq (layout-item-key-attribute layout) 'transient-inactive-attribute)) (base-segments - (list (cons key (layout-item-key-attribute layout)) - (cons (make-string padding :initial-element #\space) nil) - (cons " " nil)))) + (append (if key-is-segments + key + (list (cons key (layout-item-key-attribute layout)))) + (list (cons (make-string padding :initial-element #\space) nil) + (cons " " nil))))) ;; if desc is a list of segments, append them. otherwise treat as string. (list (append base-segments (if (listp desc) @@ -323,7 +416,8 @@ key-width is used for even key spacing in items." (buffer (if existing-window (window-buffer existing-window) (make-buffer "*transient*" :temporary t :enable-undo-p nil))) - (layout (generate-layout keymap))) + (root (find-intermediate-root keymap)) + (layout (generate-layout root keymap))) (erase-buffer buffer) ;; we dont want lines to be cut off for now (no wrapping), until we have scrollbars or something (setf (variable-value 'line-wrap :buffer buffer) nil) diff --git a/src/input.lisp b/src/input.lisp index bf6ed6e86..02a4a1d1e 100644 --- a/src/input.lisp +++ b/src/input.lisp @@ -77,6 +77,19 @@ (pop *this-command-keys*) (push key *unread-keys*)) +(defun count-intermediate-keys (keymap kseq) + "count how many keys in KSEQ traversed through intermediate prefixes." + (let ((count 0)) + (labels ((walk (binding keys) + (when keys + (let ((matches (find-matching-prefixes binding (car keys)))) + (dolist (match matches) + (when (prefix-intermediate-p match) + (incf count)) + (walk (prefix-suffix match) (cdr keys))))))) + (walk keymap kseq)) + count)) + (defun read-command () (let ((event (read-event))) (etypecase event @@ -109,12 +122,27 @@ (reset))) (t (cond + ;; note: menu in these comments might mean keymaps, i used menu because + ;; this is mostly intended for transient keymaps (i.e. key menus). + ;; :drop removes the current key from kseq without changing "menus". + ;; used for "infix" keys (toggles, choices) that act in-place. + ;; also pops any intermediate prefix keys so the recorded + ;; sequence reflects only the menu-level key that was pressed. ((eq behavior :drop) (setf kseq (butlast kseq)) + (dotimes (_ (count-intermediate-keys *root-keymap* kseq)) + (setf kseq (butlast kseq))) (set-last-read-key-sequence kseq) (reset)) + ;; :back removes the current key and the key that entered + ;; the current menu, navigating up one menu level. + ;; also pops any intermediate prefix keys in between. ((eq behavior :back) - (setf kseq (subseq kseq 0 (max 0 (- (length kseq) 2)))) + (setf kseq (butlast kseq)) + (dotimes (_ (count-intermediate-keys *root-keymap* kseq)) + (setf kseq (butlast kseq))) + ;; pop the key that entered the current "menu" + (setf kseq (butlast kseq)) (set-last-read-key-sequence kseq) (reset)) ((eq behavior :cancel) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index d184aff0d..a80e3ec9c 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -473,6 +473,7 @@ :keymap* :*root-keymap* :prefix-active-p + :prefix-intermediate-p :prefix-behavior :keymap-children :keymap-description diff --git a/src/keymap.lisp b/src/keymap.lisp index 900d17cbb..47c2f8d84 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -60,6 +60,11 @@ the underlying storage slot is renamed with a '*' suffix." :dynamic t :documentation "whether a prefix is active." :initform t) + ;; intermediate-p means a prefix is just a "continuation" of another and servers as an intermediate key + (intermediate-p + :initarg :intermediate-p + :documentation "whether a prefix is an intermediary to another, this effects the :drop and :back behavior." + :initform nil) (behavior :initarg :behavior :initform nil @@ -137,6 +142,12 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (defmethod prefix-behavior ((prefix prefix)) (slot-value prefix 'behavior)) +(defmethod (setf prefix-intermediate-p) (new-value (prefix prefix)) + (setf (slot-value prefix 'intermediate-p) new-value)) + +(defmethod prefix-intermediate-p ((prefix prefix)) + (slot-value prefix 'intermediate-p)) + (defgeneric keymap-activate (keymap) (:documentation "a hook for when a keymap is entered by some prefix.") ;; default keymap-activate does nothing From 3ea00ea16ff2471089961cf40afad53c733853c8 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 4 Feb 2026 18:18:33 +0200 Subject: [PATCH 25/63] introduce *transient-always-show* --- extensions/transient/keymap.lisp | 10 +++++++--- extensions/transient/popup.lisp | 14 +++++++++++++- 2 files changed, 20 insertions(+), 4 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index ea4bba31d..c992d25a0 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -2,7 +2,9 @@ (defmethod keymap-activate ((keymap keymap)) "called when a keymap is activated by the event scheduler." - (show-transient keymap)) + (if (or (keymap-show-p keymap) *transient-always-show*) + (show-transient keymap) + (hide-transient))) (defmacro add-dynamic-property (class-name properties-accessor property-name &optional default-value) "define - getter and setter methods. @@ -42,7 +44,7 @@ the setter stores directly." ;; these are properties that we want to be "dynamic", as in can be assigned a function that ;; returns the value later instead of the value itself. -(add-dynamic-property keymap keymap-properties show-p t) +(add-dynamic-property keymap keymap-properties show-p nil) (add-dynamic-property prefix prefix-properties show-p t) ;; static properties dont take a function that returns a value, just a value. (add-static-property keymap keymap-properties display-style :row) @@ -134,6 +136,7 @@ the setter stores directly." (defun parse-transient (bindings) "defines a transient menu. args yet to be documented." (let ((keymap (make-keymap))) + (setf (keymap-show-p keymap) t) (loop for tail = bindings then (cdr tail) while tail do (let ((binding (car tail))) @@ -179,10 +182,11 @@ the setter stores directly." (setf last-keymap (prefix-suffix existing)) existing) (let* ((new-prefix (make-instance 'prefix)) - (new-keymap (make-instance 'keymap*))) + (new-keymap (make-keymap))) (keymap-add-prefix last-keymap new-prefix t) (setf (prefix-suffix new-prefix) new-keymap) (setf (prefix-intermediate-p new-prefix) t) + (setf (keymap-show-p new-keymap) t) (setf last-keymap new-keymap) new-prefix)))) do (setf (prefix-key current-prefix) current-key)) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 8b800e44a..3e7243a41 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -15,6 +15,10 @@ " | " "string used to separate columns in row layout.") +(defvar *transient-always-show* + nil + "whether to always show the transient buffer. by default only keymaps that have show-p set are shown.") + (define-attribute transient-matched-key-attribute (t :foreground (attribute-foreground (ensure-attribute 'syntax-string-attribute)))) @@ -448,4 +452,12 @@ key-width is used for even key spacing in items." :base-height height :use-modeline-p nil :border 1)))))) - (redraw-display)) \ No newline at end of file + (redraw-display)) + +(defun hide-transient () + "hide (delete) the transient popup window." + (when (and *transient-popup-window* + (not (deleted-window-p *transient-popup-window*))) + (delete-window *transient-popup-window*) + (setf *transient-popup-window* nil) + (redraw-display))) \ No newline at end of file From 1f3a109b5b76a87d9153f4fb283ecc3f693973ef Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 4 Feb 2026 18:48:13 +0200 Subject: [PATCH 26/63] small refactor --- extensions/transient/keymap.lisp | 93 ++++++++++++++------------------ 1 file changed, 39 insertions(+), 54 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index c992d25a0..066a27a90 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -95,20 +95,6 @@ the setter stores directly." (defmethod prefix-behavior ((prefix infix)) :drop) -;; this one applies the next value from the choices list without a prompt -;; (defmethod prefix-suffix ((choice choice)) -;; (labels ((suffix () -;; (let* ((choices (prefix-choices choice)) -;; (current-value (prefix-value choice)) -;; (position (position current-value choices :test 'equal))) -;; (let ((new-value (if position -;; ;; mod is to wrap around to 0. :D -;; (elt choices (mod (1+ position) (length choices))) -;; (first choices)))) -;; (log:info "switching to value ~A~%" new-value) -;; (setf (prefix-value choice) new-value))))) -;; #'suffix)) - (defmethod prefix-suffix ((choice choice)) (labels ((suffix () (let* ((choices (prefix-choices choice)) @@ -121,7 +107,6 @@ the setter stores directly." :completion-function (lambda (x) choices)))) (when new-value - (log:info "switching to value ~A~%" new-value) (setf (prefix-value choice) new-value))))) #'suffix)) @@ -141,19 +126,19 @@ the setter stores directly." while tail do (let ((binding (car tail))) (cond - ;; inline property - ((keywordp binding) - (let ((val (second tail))) - (let ((key-method (intern (format nil "KEYMAP-~A" (string binding)) :lem/transient))) - (if (fboundp key-method) - (funcall (fdefinition (list 'setf key-method)) val keymap) - (setf (getf (keymap-properties keymap) binding) val)))) - ;; advance another cell because we're already consumed it (second tail) - (setf tail (cdr tail))) - ;; direct child keymap (:keymap ...) - ((eq (car binding) :keymap) - (let ((sub-map (parse-transient (cdr binding)))) - (keymap-add-child keymap sub-map t))) + ;; inline property + ((keywordp binding) + (let ((val (second tail))) + (let ((key-method (intern (format nil "KEYMAP-~A" (string binding)) :lem/transient))) + (if (fboundp key-method) + (funcall (fdefinition (list 'setf key-method)) val keymap) + (setf (getf (keymap-properties keymap) binding) val)))) + ;; advance another cell because we're already consumed it (second tail) + (setf tail (cdr tail))) + ;; direct child keymap (:keymap ...) + ((eq (car binding) :keymap) + (let ((sub-map (parse-transient (cdr binding)))) + (keymap-add-child keymap sub-map t))) ;; key binding (:key ...) ((eq (car binding) :key) (let* ((key (second binding)) @@ -173,10 +158,10 @@ the setter stores directly." prefix ;; reuse existing intermediate prefix with same key, or create new one (let ((existing (find current-key (keymap-children last-keymap) - :test (lambda (k child) - (and (typep child 'prefix) - (prefix-intermediate-p child) - (equal k (prefix-key child))))))) + :test (lambda (k child) + (and (typep child 'prefix) + (prefix-intermediate-p child) + (equal k (prefix-key child))))))) (if existing (progn (setf last-keymap (prefix-suffix existing)) @@ -190,26 +175,26 @@ the setter stores directly." (setf last-keymap new-keymap) new-prefix)))) do (setf (prefix-key current-prefix) current-key)) - (keymap-add-prefix last-keymap prefix t) - ;; sometimes the suffix will not be set (e.g. prefix-type is :choice). we - ;; initialize it to nil to avoid unbound errors. - (setf (prefix-suffix prefix) nil) - (loop for (key value) on (cddr binding) by 'cddr - ;; key-method is used for (setf prefix- ) - for key-method = (intern (format nil "PREFIX-~A" (string key)) :lem/transient) - do (let ((setf-expr `(setf (,key-method prefix) value)) - (final-value) - (should-set t)) - (cond - ;; if the suffix is a keymap we need to parse recursively - ((and (listp value) (eq (car value) :keymap)) - (setf final-value (parse-transient (cdr value)))) - ((eq key :type) - (setf should-set nil)) - (t - (setf final-value value))) - (when should-set - (funcall (fdefinition (list 'setf key-method)) - final-value - prefix)))))))))) + (keymap-add-prefix last-keymap prefix t) + ;; sometimes the suffix will not be set (e.g. prefix-type is :choice). we + ;; initialize it to nil to avoid unbound errors. + (setf (prefix-suffix prefix) nil) + (loop for (key value) on (cddr binding) by 'cddr + ;; key-method is used for (setf prefix- ) + for key-method = (intern (format nil "PREFIX-~A" (string key)) :lem/transient) + do (let ((setf-expr `(setf (,key-method prefix) value)) + (final-value) + (should-set t)) + (cond + ;; if the suffix is a keymap we need to parse recursively + ((and (listp value) (eq (car value) :keymap)) + (setf final-value (parse-transient (cdr value)))) + ((eq key :type) + (setf should-set nil)) + (t + (setf final-value value))) + (when should-set + (funcall (fdefinition (list 'setf key-method)) + final-value + prefix)))))))))) keymap)) \ No newline at end of file From facc26c5aee12212df0925d466b7beb1e5092f21 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 4 Feb 2026 19:29:21 +0200 Subject: [PATCH 27/63] introduce multi-value infix to demo --- extensions/transient/demo.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index 6cbf3fe9c..f052dd5ab 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -46,10 +46,10 @@ :choices ("vim" "emacs") :description "keys"))) :description "langs demo") - (:key "d" + (:key "a" :type :choice - :choices ("on" "off") - :description "debug toggle") + :choices ("value1" "value2" "value3") + :description "multi-value infix") (:key "R" :suffix demo-run :description "run with mode") (:key "T" :type toggle :value t :suffix demo-toggle :description "demo toggle") (:key "e e" :type toggle :value t :suffix demo-toggle :description "another demo toggle") From eb7fc25cc484d2c3073c293cd7d42f7876c66553 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 5 Feb 2026 19:40:30 +0200 Subject: [PATCH 28/63] remove outdated comment --- src/keymap.lisp | 1 - 1 file changed, 1 deletion(-) diff --git a/src/keymap.lisp b/src/keymap.lisp index 47c2f8d84..9e827468f 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -41,7 +41,6 @@ the underlying storage slot is renamed with a '*' suffix." :collect `(defmethod (setf ,accessor) (new-value (object ,name)) (setf (,internal-accessor object) new-value)))))) -;; a non-suffix prefix cannot be a keymap, thats why keymap doesnt inherit from prefix. this makes sense because a "prefix keymap" is a keymap that shares a common prefix, but the root map for example may contain keybindings with no prefixes. (defclass-dynamic prefix () ((key :initarg :key From caf8743832c4b941d90e8cead711112a179d68bc Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 5 Feb 2026 20:05:55 +0200 Subject: [PATCH 29/63] introduce variable-syncing (sync infix with var) --- extensions/transient/demo.lisp | 12 +++++++++++- extensions/transient/keymap.lisp | 33 ++++++++++++++++++++++++++------ 2 files changed, 38 insertions(+), 7 deletions(-) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index f052dd5ab..826e2f832 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -1,5 +1,8 @@ (in-package :lem/transient) +(defvar *demo-language* "lisp" + "a demo variable that stays in sync with an infix.") + (define-transient *demo-keymap* :display-style :row (:keymap @@ -50,6 +53,12 @@ :type :choice :choices ("value1" "value2" "value3") :description "multi-value infix") + (:key "s" + :type :choice + :id :synced-infix + :choices ("lisp" "python" "js") + :variable *demo-language* + :description "variable-synced infix") (:key "R" :suffix demo-run :description "run with mode") (:key "T" :type toggle :value t :suffix demo-toggle :description "demo toggle") (:key "e e" :type toggle :value t :suffix demo-toggle :description "another demo toggle") @@ -57,6 +66,7 @@ (define-command demo-run () () (let ((mode-prefix (find-prefix-by-id *demo-keymap* :mode))) - (message "mode thing value: ~A" (prefix-value mode-prefix)))) + (message "mode thing value: ~A" (prefix-value mode-prefix)) + (message "synced var value: ~A" *demo-language*))) (define-key *global-keymap* "C-c t" *demo-keymap*) \ No newline at end of file diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 066a27a90..850e589fc 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -68,7 +68,10 @@ the setter stores directly." (f keymap))) (defclass infix (prefix) - ()) + ((variable + :accessor infix-variable + :initarg :variable + :initform nil))) (defclass choice (infix) ((choices @@ -81,15 +84,24 @@ the setter stores directly." (:documentation "a boolean infix.")) (defmethod prefix-value ((prefix prefix)) - (slot-value prefix 'value)) + (let ((var (infix-variable prefix))) + (if var + (symbol-value var) + (slot-value prefix 'value)))) (defmethod prefix-value ((prefix choice)) - (if (slot-boundp prefix 'value) - (slot-value prefix 'value) - (car (prefix-choices prefix)))) + (let ((var (infix-variable prefix))) + (if var + (symbol-value var) + (if (slot-boundp prefix 'value) + (slot-value prefix 'value) + (car (prefix-choices prefix)))))) (defmethod (setf prefix-value) (new-value (prefix prefix)) - (setf (slot-value prefix 'value) new-value)) + (let ((var (infix-variable prefix))) + (if var + (setf (symbol-value var) new-value) + (setf (slot-value prefix 'value) new-value)))) ;; infixes dont modify the keymap menu, we drop the key and dont append it to the recorded keyseq (defmethod prefix-behavior ((prefix infix)) @@ -189,6 +201,15 @@ the setter stores directly." ;; if the suffix is a keymap we need to parse recursively ((and (listp value) (eq (car value) :keymap)) (setf final-value (parse-transient (cdr value)))) + ;; variable syncing: set the variable slot on the infix + ;; we need a special case for it since its "infix-variable" and + ;; not "prefix-variable" since its a slot in the infix class. + ;; there's probably a nicer way to go about things but this is + ;; just for 'parse-transient' which is designed as a + ;; convenience anyway. + ((eq key :variable) + (setf (infix-variable prefix) value) + (setf should-set nil)) ((eq key :type) (setf should-set nil)) (t From 06b58e5c2113148f66370b684d0fcbd6284cca10 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sat, 7 Feb 2026 05:01:37 +0200 Subject: [PATCH 30/63] add :extend keyword to make-keymap --- extensions/lem-dashboard/lem-dashboard.lisp | 2 +- extensions/vi-mode/core.lisp | 6 ++-- src/ext/grep.lisp | 2 +- src/keymap.lisp | 35 ++++++++++++++++----- src/mode.lisp | 8 ++--- 5 files changed, 36 insertions(+), 17 deletions(-) diff --git a/extensions/lem-dashboard/lem-dashboard.lisp b/extensions/lem-dashboard/lem-dashboard.lisp index c276e890c..895ee853b 100644 --- a/extensions/lem-dashboard/lem-dashboard.lisp +++ b/extensions/lem-dashboard/lem-dashboard.lisp @@ -17,7 +17,7 @@ (defvar *dashboard-buffer-name* "*dashboard*") (defvar *dashboard-enable* t) -(defvar *dashboard-mode-keymap* (make-keymap :description '*dashboard-mode-keymap* :parent *global-keymap*)) +(defvar *dashboard-mode-keymap* (make-keymap :description '*dashboard-mode-keymap*)) (defvar *dashboard-layout* nil "List of dashboard-item instances; will be drawn in order.") diff --git a/extensions/vi-mode/core.lisp b/extensions/vi-mode/core.lisp index a425d9389..97f77dba4 100644 --- a/extensions/vi-mode/core.lisp +++ b/extensions/vi-mode/core.lisp @@ -269,9 +269,9 @@ (defclass vi-keymap (keymap*) ()) -(defun make-vi-keymap (&rest args &key undef-hook parent description) - (declare (ignore undef-hook parent description)) - (apply 'make-instance 'vi-keymap (alexandria:remove-from-plist args :parent))) +(defun make-vi-keymap (&rest args &key undef-hook extend description) + (declare (ignore undef-hook extend description)) + (apply 'make-instance 'vi-keymap (alexandria:remove-from-plist args :extend))) (defmacro define-keymap (name &key undef-hook) (declare (ignore parent)) diff --git a/src/ext/grep.lisp b/src/ext/grep.lisp index 1c24f2693..ef5c54460 100644 --- a/src/ext/grep.lisp +++ b/src/ext/grep.lisp @@ -183,7 +183,7 @@ (format s "~%"))) (defvar *peek-grep-mode-keymap* (make-keymap :description '*peek-grep-mode-keymap* - :parent lem/peek-source:*peek-source-keymap*)) + :extend lem/peek-source:*peek-source-keymap*)) (define-minor-mode peek-grep-mode (:name "Peek" :keymap *peek-grep-mode-keymap*)) diff --git a/src/keymap.lisp b/src/keymap.lisp index 9e827468f..c5ff7d6ce 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -107,7 +107,12 @@ NIL to append it to the key sequence normally.") :initarg :active-p :dynamic t :documentation "whether a prefix is active." - :initform t))) + :initform t) + (extend + :initarg :extend + :accessor keymap-extend + :initform nil + :documentation "the keymap that this keymap extends."))) (defmethod keymap-add-prefix ((keymap keymap) (prefix prefix) &optional after) (unless (listp (keymap-children* keymap)) @@ -185,11 +190,12 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (when (keymap-description object) (princ (keymap-description object) stream)))) -;; TODO: we arent using parent properly here -(defun make-keymap (&key undef-hook parent description) +(defun make-keymap (&key undef-hook children description extend) (let ((keymap (make-instance 'keymap* :undef-hook undef-hook - :description description))) + :children children + :description description + :extend extend))) keymap)) (defun prefix-command-p (command) @@ -351,7 +357,10 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" append (find-matching-prefixes item key) into matches when (and (typep item 'keymap*) (keymap-undef-hook item)) do (return matches) - finally (return matches)))))) + finally (return (or matches + (let ((extend (keymap-extend binding))) + (when extend + (find-matching-prefixes extend key)))))))))) (defun find-in-function-table (binding key) "search function-table of keymaps in hierarchy for KEY." @@ -368,10 +377,16 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (loop for child in (keymap-children binding) thereis (or (find-in-function-table child key) (and (typep child 'keymap*) - (keymap-undef-hook child))))))) + (keymap-undef-hook child)))) + (let ((extend (keymap-extend binding))) + (when extend + (find-in-function-table extend key)))))) ((typep binding 'keymap) (loop for child in (keymap-children binding) - thereis (find-in-function-table child key))) + thereis (find-in-function-table child key)) + (let ((extend (keymap-extend binding))) + (when extend + (find-in-function-table extend key)))) ((typep binding 'prefix) (find-in-function-table (prefix-suffix binding) key)))) @@ -398,7 +413,11 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" ;; if we have matches but none were exact/successful, we are still in a prefix (when (and matches (null (cdr keys))) (let ((match (car matches))) - (cons (prefix-suffix match) match)))))))) + (cons (prefix-suffix match) match))) + (when (typep binding 'keymap) + (let ((extend (keymap-extend binding))) + (when extend + (search-tree extend keys parent-prefix))))))))) (search-tree keymap keyseq nil))) (defun normalize-binding (found &optional parent-prefix) diff --git a/src/mode.lisp b/src/mode.lisp index 90d80eab0..fb3907870 100644 --- a/src/mode.lisp +++ b/src/mode.lisp @@ -150,7 +150,7 @@ `((defvar ,mode-hook '()))) ,@(when keymap `((defvar ,keymap (make-keymap :description ',keymap - :parent ,(when parent-mode + :extend ,(when parent-mode `(mode-keymap ',parent-mode)))))) (define-command (,major-mode (:class ,command-class-name)) () () (clear-editor-local-variables (current-buffer)) @@ -251,9 +251,9 @@ (let ((command-class-name (make-mode-command-class-name mode))) `(progn ,@(when keymap - `((defvar ,keymap - (make-keymap :description ',keymap - :parent (alexandria:when-let ((,parent-mode + `((defvar ,keymap + (make-keymap :description ',keymap + :extend (alexandria:when-let ((,parent-mode ,(when parent `(get-mode-object ',parent)))) (mode-keymap ,parent-mode)))))) From f708a1e976a94724bb48a40997c1dd408ac47349 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sat, 7 Feb 2026 23:32:56 +0200 Subject: [PATCH 31/63] add mode-transient-keymap, show extended keymap keys in transient --- extensions/transient/keymap.lisp | 35 ++++++++++++++++++++++++++--- extensions/transient/popup.lisp | 9 ++++---- extensions/transient/transient.lisp | 5 ++++- src/internal-packages.lisp | 3 +++ 4 files changed, 44 insertions(+), 8 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 850e589fc..e6b62aceb 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -2,9 +2,24 @@ (defmethod keymap-activate ((keymap keymap)) "called when a keymap is activated by the event scheduler." - (if (or (keymap-show-p keymap) *transient-always-show*) - (show-transient keymap) - (hide-transient))) + (let ((active-modes (all-active-modes (current-buffer)))) + (cond ((loop for mode in active-modes + for mode-keymap = (mode-transient-keymap mode) + when mode-keymap + do (show-transient + (if (keymap-contains-p mode-keymap keymap) + keymap + mode-keymap)) + (return t))) + ((or (keymap-show-p keymap) *transient-always-show*) + (show-transient keymap)) + (t + (hide-transient))))) + +(defgeneric mode-transient-keymap (mode) + (:documentation "returns the keymap to be passed to show-transient.") + (:method ((mode mode)) + nil)) (defmacro add-dynamic-property (class-name properties-accessor property-name &optional default-value) "define - getter and setter methods. @@ -67,6 +82,20 @@ the setter stores directly." (f suffix)))))))) (f keymap))) +(defun keymap-contains-p (keymap target) + "return T if KEYMAP contains TARGET as a direct or indirect child." + (labels ((f (node) + (cond ((eq node target) t) + ((typep node 'keymap) + (dolist (child (keymap-children node)) + (when (f child) (return t)))) + ((typep node 'prefix) + (let ((suffix (prefix-suffix node))) + (when (or (typep suffix 'keymap) + (typep suffix 'prefix)) + (f suffix))))))) + (f keymap))) + (defclass infix (prefix) ((variable :accessor infix-variable diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 3e7243a41..b9eafcb5f 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -229,8 +229,6 @@ or ACTIVE-KEYMAP itself if no such ancestor exists." prefixes always display vertically in their own column. nested keymaps are arranged based on display-style (:row or :column). prefixes marked as :intermediate-p are flattened and shown with concatenated keys." - (unless (keymap-show-p keymap) - (return-from generate-layout nil)) (let ((prefix-items) (keymap-layouts)) (labels ((collect-items (node &optional (matched-depth 0)) @@ -261,8 +259,11 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key matched-depth)) prefix-items))))))) ;; process children, separating prefixes from keymaps - (dolist (child (keymap-children keymap)) - (collect-items child))) + (let ((current keymap)) + (loop while current + do (dolist (child (keymap-children current)) + (collect-items child)) + (setf current (keymap-extend current))))) ;; build result: title first, then content (prefixes + keymaps arranged by display-style) (setf prefix-items (nreverse prefix-items)) (setf keymap-layouts (nreverse keymap-layouts)) diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp index 1b1b36cf8..856faeb1d 100644 --- a/extensions/transient/transient.lisp +++ b/extensions/transient/transient.lisp @@ -1,5 +1,8 @@ (defpackage :lem/transient (:use :cl :lem) - (:export :define-transient)) + (:export + :define-transient + :mode-transient-keymap + :keymap-contains-p)) (in-package :lem/transient) \ No newline at end of file diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index a80e3ec9c..cee3fe636 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -440,6 +440,7 @@ (:export :ensure-mode-object :major-mode + :mode :mode-name :mode-description :mode-keymap @@ -449,6 +450,7 @@ :mode-active-p :major-modes :minor-modes + :all-active-modes :find-mode :toggle-minor-mode :define-major-mode @@ -478,6 +480,7 @@ :keymap-children :keymap-description :keymap-properties + :keymap-extend :parse-keyspec :prefix-properties :keymap-undef-hook From 0af36511565116a467b6efd31bb2d21eb7194620 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sat, 7 Feb 2026 23:42:15 +0200 Subject: [PATCH 32/63] rename keymap-extend to keymap-base --- extensions/transient/popup.lisp | 2 +- extensions/vi-mode/core.lisp | 6 +++--- src/ext/grep.lisp | 2 +- src/internal-packages.lisp | 2 +- src/keymap.lisp | 34 ++++++++++++++++----------------- src/mode.lisp | 4 ++-- 6 files changed, 25 insertions(+), 25 deletions(-) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index b9eafcb5f..9e740251a 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -263,7 +263,7 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key (loop while current do (dolist (child (keymap-children current)) (collect-items child)) - (setf current (keymap-extend current))))) + (setf current (keymap-base current))))) ;; build result: title first, then content (prefixes + keymaps arranged by display-style) (setf prefix-items (nreverse prefix-items)) (setf keymap-layouts (nreverse keymap-layouts)) diff --git a/extensions/vi-mode/core.lisp b/extensions/vi-mode/core.lisp index 97f77dba4..f56caf19f 100644 --- a/extensions/vi-mode/core.lisp +++ b/extensions/vi-mode/core.lisp @@ -269,9 +269,9 @@ (defclass vi-keymap (keymap*) ()) -(defun make-vi-keymap (&rest args &key undef-hook extend description) - (declare (ignore undef-hook extend description)) - (apply 'make-instance 'vi-keymap (alexandria:remove-from-plist args :extend))) +(defun make-vi-keymap (&rest args &key undef-hook base description) + (declare (ignore undef-hook base description)) + (apply 'make-instance 'vi-keymap (alexandria:remove-from-plist args :base))) (defmacro define-keymap (name &key undef-hook) (declare (ignore parent)) diff --git a/src/ext/grep.lisp b/src/ext/grep.lisp index ef5c54460..9b60e0ee3 100644 --- a/src/ext/grep.lisp +++ b/src/ext/grep.lisp @@ -183,7 +183,7 @@ (format s "~%"))) (defvar *peek-grep-mode-keymap* (make-keymap :description '*peek-grep-mode-keymap* - :extend lem/peek-source:*peek-source-keymap*)) + :base lem/peek-source:*peek-source-keymap*)) (define-minor-mode peek-grep-mode (:name "Peek" :keymap *peek-grep-mode-keymap*)) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index cee3fe636..e9ef11300 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -480,7 +480,7 @@ :keymap-children :keymap-description :keymap-properties - :keymap-extend + :keymap-base :parse-keyspec :prefix-properties :keymap-undef-hook diff --git a/src/keymap.lisp b/src/keymap.lisp index c5ff7d6ce..ead8f0e39 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -108,9 +108,9 @@ NIL to append it to the key sequence normally.") :dynamic t :documentation "whether a prefix is active." :initform t) - (extend - :initarg :extend - :accessor keymap-extend + (base + :initarg :base + :accessor keymap-base :initform nil :documentation "the keymap that this keymap extends."))) @@ -190,12 +190,12 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (when (keymap-description object) (princ (keymap-description object) stream)))) -(defun make-keymap (&key undef-hook children description extend) +(defun make-keymap (&key undef-hook children description base) (let ((keymap (make-instance 'keymap* :undef-hook undef-hook :children children :description description - :extend extend))) + :base base))) keymap)) (defun prefix-command-p (command) @@ -358,9 +358,9 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" when (and (typep item 'keymap*) (keymap-undef-hook item)) do (return matches) finally (return (or matches - (let ((extend (keymap-extend binding))) - (when extend - (find-matching-prefixes extend key)))))))))) + (let ((base (keymap-base binding))) + (when base + (find-matching-prefixes base key)))))))))) (defun find-in-function-table (binding key) "search function-table of keymaps in hierarchy for KEY." @@ -378,15 +378,15 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" thereis (or (find-in-function-table child key) (and (typep child 'keymap*) (keymap-undef-hook child)))) - (let ((extend (keymap-extend binding))) - (when extend - (find-in-function-table extend key)))))) + (let ((base (keymap-base binding))) + (when base + (find-in-function-table base key)))))) ((typep binding 'keymap) (loop for child in (keymap-children binding) thereis (find-in-function-table child key)) - (let ((extend (keymap-extend binding))) - (when extend - (find-in-function-table extend key)))) + (let ((base (keymap-base binding))) + (when base + (find-in-function-table base key)))) ((typep binding 'prefix) (find-in-function-table (prefix-suffix binding) key)))) @@ -415,9 +415,9 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (let ((match (car matches))) (cons (prefix-suffix match) match))) (when (typep binding 'keymap) - (let ((extend (keymap-extend binding))) - (when extend - (search-tree extend keys parent-prefix))))))))) + (let ((base (keymap-base binding))) + (when base + (search-tree base keys parent-prefix))))))))) (search-tree keymap keyseq nil))) (defun normalize-binding (found &optional parent-prefix) diff --git a/src/mode.lisp b/src/mode.lisp index fb3907870..63846624f 100644 --- a/src/mode.lisp +++ b/src/mode.lisp @@ -150,7 +150,7 @@ `((defvar ,mode-hook '()))) ,@(when keymap `((defvar ,keymap (make-keymap :description ',keymap - :extend ,(when parent-mode + :base ,(when parent-mode `(mode-keymap ',parent-mode)))))) (define-command (,major-mode (:class ,command-class-name)) () () (clear-editor-local-variables (current-buffer)) @@ -253,7 +253,7 @@ ,@(when keymap `((defvar ,keymap (make-keymap :description ',keymap - :extend (alexandria:when-let ((,parent-mode + :base (alexandria:when-let ((,parent-mode ,(when parent `(get-mode-object ',parent)))) (mode-keymap ,parent-mode)))))) From 64631a3a73634d68c8478b46466738738892db81 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 12 Feb 2026 02:15:09 +0200 Subject: [PATCH 33/63] export more symbols --- extensions/transient/transient.lisp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp index 856faeb1d..22fd935e1 100644 --- a/extensions/transient/transient.lisp +++ b/extensions/transient/transient.lisp @@ -3,6 +3,7 @@ (:export :define-transient :mode-transient-keymap - :keymap-contains-p)) + :prefix-value + :prefix-render)) (in-package :lem/transient) \ No newline at end of file From feafe41473a8ae989645b173c11211988f3c89af Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 13 Feb 2026 19:22:22 +0200 Subject: [PATCH 34/63] remove redundant keymap-find-keybind arg and rename it to keymap-find --- extensions/vi-mode/commands.lisp | 2 +- extensions/vi-mode/leader.lisp | 8 ++++---- src/internal-packages.lisp | 2 +- src/keymap.lisp | 24 +++++++++++++++--------- 4 files changed, 21 insertions(+), 15 deletions(-) diff --git a/extensions/vi-mode/commands.lisp b/extensions/vi-mode/commands.lisp index 8b7c55cf2..0a30f7568 100644 --- a/extensions/vi-mode/commands.lisp +++ b/extensions/vi-mode/commands.lisp @@ -164,7 +164,7 @@ (defun extract-count-keys (keys) (loop for key in keys - for cmd = (lem-core::keymap-find-keybind *motion-keymap* key nil) + for cmd = (lem-core::keymap-find *motion-keymap* key) unless (member cmd '(lem/universal-argument:universal-argument-0 lem/universal-argument:universal-argument-1 lem/universal-argument:universal-argument-2 diff --git a/extensions/vi-mode/leader.lisp b/extensions/vi-mode/leader.lisp index 12f92dcc0..a082fac2d 100644 --- a/extensions/vi-mode/leader.lisp +++ b/extensions/vi-mode/leader.lisp @@ -19,12 +19,12 @@ (defun leader-key () (make-key :sym "Leader")) -(defmethod keymap-find-keybind ((keymap vi-keymap) (key lem-core::key) cmd) +(defmethod keymap-find ((keymap vi-keymap) (key lem-core::key)) (if (mapleader-key-p key) - (call-next-method keymap (leader-key) cmd) + (call-next-method keymap (leader-key)) (call-next-method))) -(defmethod keymap-find-keybind ((keymap vi-keymap) (key cons) cmd) +(defmethod keymap-find ((keymap vi-keymap) (key cons)) (if (mapleader-key-p (first key)) - (call-next-method keymap (cons (leader-key) (rest key)) cmd) + (call-next-method keymap (cons (leader-key) (rest key))) (call-next-method))) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index e9ef11300..6aae5e8b4 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -499,7 +499,7 @@ :find-keybind :insertion-key-p :lookup-keybind - :keymap-find-keybind + :keymap-find :*abort-key* :abort-key-p :with-special-keymap diff --git a/src/keymap.lisp b/src/keymap.lisp index ead8f0e39..f0f4eb278 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -398,7 +398,7 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" return (keymap-undef-hook km))) (defmethod find-suffix ((keymap keymap) keyseq) - "search KEYMAP tree for exact binding matching KEYSEQ. returns (suffix . prefix)" + "search KEYMAP tree for exact binding matching KEYSEQ. returns (suffix . prefix)." (labels ((search-tree (binding keys parent-prefix) (if (null keys) (if (typep binding 'prefix) @@ -426,9 +426,18 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (keymap (cons found parent-prefix)) (t (cons found parent-prefix)))) +(defmethod keymap-find ((keymap keymap) key) + "finds key sequence in keymap, returns (suffix . prefix)." + (let* ((keyseq (etypecase key + (key (list key)) + (list key))) + (suffix-result (find-suffix keymap keyseq))) + (when suffix-result + (normalize-binding (car suffix-result) (cdr suffix-result))))) + ;; this is currently here for backwards compatibility ;; im not yet sure whether 'cmd' or function-table lookup is necessary (i think so but im not sure how to get rid of it.) -(defmethod keymap-find-keybind ((keymap keymap) key cmd) +(defmethod keymap-find ((keymap keymap*) key) "finds key sequence in keymap, returns (suffix . prefix)." (let* ((keyseq (etypecase key (key (list key)) @@ -441,13 +450,10 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (or ;; search function-table in hierarchy (find-in-function-table keymap (car keyseq)) - ;; check function-table for cmd symbol - (gethash (if (consp cmd) (car cmd) cmd) (keymap-function-table keymap)) ;; find undef-hook in hierarchy (e.g. self-insert) (find-undef-hook-in-hierarchy keymap)))) - (if result - (normalize-binding result) - cmd)))))) + (when result + (normalize-binding result))))))) (defun insertion-key-p (key) (let* ((key (typecase key @@ -496,10 +502,10 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (defun lookup-keybind (key) (unless (find *other-keymaps-root* (keymap-children *root-keymap*)) (keymap-add-child *root-keymap* *other-keymaps-root*)) - (keymap-find-keybind *root-keymap* key nil)) + (keymap-find *root-keymap* key)) (defun find-keybind (key) - (let ((result (keymap-find-keybind *root-keymap* key nil))) + (let ((result (keymap-find *root-keymap* key))) (when result result))) From d11647bcb5e91ef4e0e240872a01f6bd7a37d6ec Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 13 Feb 2026 23:06:01 +0200 Subject: [PATCH 35/63] remove "dynamic properties" and just rely on CLOS the idea of "dynamic" properties/slots that i had before i think was redundant and just overcomplicated things. this is a refactors things. now we just rely on CLOS even for instance-specific "overrides" in keymaps/prefixes. --- extensions/copilot/copilot.lisp | 2 +- extensions/transient/demo.lisp | 5 +- extensions/transient/keymap.lisp | 134 +++++++++++----------- src/keymap.lisp | 189 ++++++++++++++++--------------- 4 files changed, 167 insertions(+), 163 deletions(-) diff --git a/extensions/copilot/copilot.lisp b/extensions/copilot/copilot.lisp index 6471b64d0..bbb061f4f 100644 --- a/extensions/copilot/copilot.lisp +++ b/extensions/copilot/copilot.lisp @@ -246,7 +246,7 @@ (defun find-copilot-completion-command (key) (lookup-keybind key - :keymaps (append (lem-core::all-keymaps) + :keymaps (append (lem-core::other-keymaps) (list *copilot-completion-keymap*)))) (defun search-preffix (str1 str2) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index 826e2f832..806feb514 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -1,6 +1,7 @@ (in-package :lem/transient) -(defvar *demo-language* "lisp" +(defvar *demo-language* + "lisp" "a demo variable that stays in sync with an infix.") (define-transient *demo-keymap* @@ -39,7 +40,7 @@ (:key "l" :type :choice :id :mode - :choices ("lisp" "python" "js") + :choices-func (list "lisp" "python" "js") :value "python" :description "mode")) (:keymap diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index e6b62aceb..1d1dd435c 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -21,27 +21,7 @@ (:method ((mode mode)) nil)) -(defmacro add-dynamic-property (class-name properties-accessor property-name &optional default-value) - "define - getter and setter methods. - -the getter retrieves from PROPERTIES-ACCESSOR using :PROPERTY-NAME as key. -if the value is a function, it funcalls it. the setter stores directly. -if DEFAULT-VALUE is provided and non-nil, it is used as the default for getf." - (let* ((keyword (intern (symbol-name property-name) :keyword)) - (getter-name (intern (format nil "~A-~A" class-name property-name) :lem/transient)) - (obj-sym (gensym "OBJ"))) - `(progn - (defmethod ,getter-name ((,obj-sym ,class-name)) - (let ((prop ,(if default-value - `(getf (,properties-accessor ,obj-sym) ,keyword ,default-value) - `(getf (,properties-accessor ,obj-sym) ,keyword)))) - (if (functionp prop) - (funcall prop) - prop))) - (defmethod (setf ,getter-name) (val (,obj-sym ,class-name)) - (setf (getf (,properties-accessor ,obj-sym) ,keyword) val))))) - -(defmacro add-static-property (class-name properties-accessor property-name &optional default-value) +(defmacro add-property (class-name properties-accessor property-name &optional default-value) "define - getter and setter methods. the getter retrieves from PROPERTIES-ACCESSOR using :PROPERTY-NAME as key. @@ -57,15 +37,13 @@ the setter stores directly." (defmethod (setf ,getter-name) (val (,obj-sym ,class-name)) (setf (getf (,properties-accessor ,obj-sym) ,keyword) val))))) -;; these are properties that we want to be "dynamic", as in can be assigned a function that -;; returns the value later instead of the value itself. -(add-dynamic-property keymap keymap-properties show-p nil) -(add-dynamic-property prefix prefix-properties show-p t) -;; static properties dont take a function that returns a value, just a value. -(add-static-property keymap keymap-properties display-style :row) -(add-static-property prefix prefix-properties id) +;; some stuff we need for working with "transient keymaps" +(add-property keymap keymap-properties show-p nil) +(add-property keymap keymap-properties display-style :row) +(add-property prefix prefix-properties show-p t) +(add-property prefix prefix-properties id) ;; TODO: it would be better to store the parsed key sequence instead of the stringified one and work with that. -(add-static-property prefix prefix-properties display-key) +(add-property prefix prefix-properties display-key) (defun find-prefix-by-id (keymap id) (labels ((f (node) @@ -159,6 +137,27 @@ the setter stores directly." (defmacro define-transient (name &body bindings) `(defparameter ,name (parse-transient ',bindings))) +(defun parse-transient-method (object key val method-name) + (let* ((key-string (string key)) + (key-method (intern (format nil "~A-~A" method-name key-string) :lem/transient)) + (length (length key-string))) + (cond ((and (> length 5) + (string-equal "-func" (subseq key-string (- length 5)))) + (let* ((prefix-key-string (subseq key-string 0 (- length 5))) + (key-method (intern (format nil "~A-~A" method-name prefix-key-string) + :lem/transient))) + (eval `(defmethod ,key-method ((object (eql ,object))) + ,val)))) + ((fboundp key-method) + (funcall (fdefinition (list 'setf key-method)) val object)) + (t + (let ((property-method (intern (format nil "~A-PROPERTIES" method-name) + :lem/transient))) + (when (fboundp property-method) + (let ((props (funcall (fdefinition property-method) object))) + (setf (getf props key) val) + (funcall (fdefinition (list 'setf property-method)) props object)))))))) + (defun parse-transient (bindings) "defines a transient menu. args yet to be documented." (let ((keymap (make-keymap))) @@ -170,12 +169,9 @@ the setter stores directly." ;; inline property ((keywordp binding) (let ((val (second tail))) - (let ((key-method (intern (format nil "KEYMAP-~A" (string binding)) :lem/transient))) - (if (fboundp key-method) - (funcall (fdefinition (list 'setf key-method)) val keymap) - (setf (getf (keymap-properties keymap) binding) val)))) - ;; advance another cell because we're already consumed it (second tail) - (setf tail (cdr tail))) + (parse-transient-method keymap binding val "KEYMAP") + ;; advance another cell because we're already consumed it (second tail) + (setf tail (cdr tail)))) ;; direct child keymap (:keymap ...) ((eq (car binding) :keymap) (let ((sub-map (parse-transient (cdr binding)))) @@ -191,40 +187,43 @@ the setter stores directly." (when (cdr parsed-key) (setf (prefix-display-key prefix) key)) ;; we need to create intermediate prefixes if the key is longer than one - (loop for cell on parsed-key - for i from 0 - for lastp = (null (cdr cell)) - for current-key = (car cell) - for current-prefix = (if lastp - prefix - ;; reuse existing intermediate prefix with same key, or create new one - (let ((existing (find current-key (keymap-children last-keymap) - :test (lambda (k child) - (and (typep child 'prefix) - (prefix-intermediate-p child) - (equal k (prefix-key child))))))) - (if existing - (progn - (setf last-keymap (prefix-suffix existing)) - existing) - (let* ((new-prefix (make-instance 'prefix)) - (new-keymap (make-keymap))) - (keymap-add-prefix last-keymap new-prefix t) - (setf (prefix-suffix new-prefix) new-keymap) - (setf (prefix-intermediate-p new-prefix) t) - (setf (keymap-show-p new-keymap) t) - (setf last-keymap new-keymap) - new-prefix)))) - do (setf (prefix-key current-prefix) current-key)) + (loop + for cell on parsed-key + for i from 0 + for lastp = (null (cdr cell)) + for current-key = (car cell) + do (let ((current-prefix + (if lastp + prefix + ;; reuse existing intermediate prefix with same key, or create new one + (let ((existing (find + current-key + (keymap-children last-keymap) + :test (lambda (k child) + (and (typep child 'prefix) + (prefix-intermediate-p child) + (equal + k + (prefix-key child))))))) + (if existing + (progn + (setf last-keymap (prefix-suffix existing)) + existing) + (let* ((new-prefix (make-instance 'prefix)) + (new-keymap (make-keymap))) + (keymap-add-prefix last-keymap new-prefix t) + (setf (prefix-suffix new-prefix) new-keymap) + (setf (prefix-intermediate-p new-prefix) t) + (setf (keymap-show-p new-keymap) t) + (setf last-keymap new-keymap) + new-prefix)))))) + (setf (prefix-key current-prefix) current-key))) (keymap-add-prefix last-keymap prefix t) ;; sometimes the suffix will not be set (e.g. prefix-type is :choice). we ;; initialize it to nil to avoid unbound errors. (setf (prefix-suffix prefix) nil) (loop for (key value) on (cddr binding) by 'cddr - ;; key-method is used for (setf prefix- ) - for key-method = (intern (format nil "PREFIX-~A" (string key)) :lem/transient) - do (let ((setf-expr `(setf (,key-method prefix) value)) - (final-value) + do (let ((final-value) (should-set t)) (cond ;; if the suffix is a keymap we need to parse recursively @@ -244,7 +243,8 @@ the setter stores directly." (t (setf final-value value))) (when should-set - (funcall (fdefinition (list 'setf key-method)) - final-value - prefix)))))))))) + (parse-transient-method prefix + key + final-value + "PREFIX")))))))))) keymap)) \ No newline at end of file diff --git a/src/keymap.lisp b/src/keymap.lisp index f0f4eb278..18e4958e7 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -1,62 +1,17 @@ (in-package :lem-core) -(defmacro defclass-dynamic (name direct-superclasses direct-slots &rest options) - "defines a class with support for 'dynamic' slots. - -slots with the :dynamic t option will have accessors that automatically handle values which are functions. -if a dynamic slot contains a function, the accessor will call it and return the result. otherwise, -it returns the value directly. -the underlying storage slot is renamed with a '*' suffix." - (let ((dynamic-slots - (loop :for slot :in direct-slots - :when (getf (cdr slot) :dynamic) - :collect slot))) - (setf direct-slots - (loop :for slot :in direct-slots - :collect (if (getf (cdr slot) :dynamic) - (let* ((slot-name (first slot)) - (accessor-name - (intern (format nil "~A-~A" name slot-name))) - (internal-accessor-name - (intern (format nil "~A*" accessor-name))) - (new-slot (copy-list slot))) - (remf (cdr new-slot) :dynamic) - (setf (getf (cdr new-slot) :accessor) - internal-accessor-name) - new-slot) - slot))) - `(progn - (defclass ,name ,direct-superclasses - ,direct-slots - ,@options) - ,@(loop :for slot :in dynamic-slots - :for slot-name := (first slot) - :for accessor := (intern (format nil "~A-~A" name slot-name)) - :for internal-accessor := (intern (format nil "~A*" accessor)) - :collect `(defmethod ,accessor ((object ,name)) - (let ((value (,internal-accessor object))) - (if (functionp value) - (funcall value) - value))) - :collect `(defmethod (setf ,accessor) (new-value (object ,name)) - (setf (,internal-accessor object) new-value)))))) - -(defclass-dynamic prefix () +(defclass prefix () ((key :initarg :key - :dynamic t :documentation "the key defined for the prefix. could be a function that returns a key.") (description :initarg :description - :dynamic t :initform nil) (suffix :initarg :suffix - :dynamic t :documentation "the suffix defined for the prefix, could be another prefix or a keymap or a function that returns one.") (active-p :initarg :active-p - :dynamic t :documentation "whether a prefix is active." :initform t) ;; intermediate-p means a prefix is just a "continuation" of another and servers as an intermediate key @@ -79,6 +34,38 @@ NIL to append it to the key sequence normally.") :initform nil :documentation "extra metadata that a prefix may hold."))) +(defgeneric prefix-key (prefix) + (:method ((prefix prefix)) + (slot-value prefix 'key))) + +(defgeneric (setf prefix-key) (new-value prefix) + (:method (new-value (prefix prefix)) + (setf (slot-value prefix 'key) new-value))) + +(defgeneric prefix-suffix (prefix) + (:method ((prefix prefix)) + (slot-value prefix 'suffix))) + +(defgeneric (setf prefix-suffix) (new-value prefix) + (:method (new-value (prefix prefix)) + (setf (slot-value prefix 'suffix) new-value))) + +(defgeneric prefix-description (prefix) + (:method ((prefix prefix)) + (slot-value prefix 'description))) + +(defgeneric (setf prefix-description) (new-value prefix) + (:method (new-value (prefix prefix)) + (setf (slot-value prefix 'description) new-value))) + +(defgeneric prefix-active-p (prefix) + (:method ((prefix prefix)) + (slot-value prefix 'active-p))) + +(defgeneric (setf prefix-active-p) (new-value prefix) + (:method (new-value (prefix prefix)) + (setf (slot-value prefix 'active-p) new-value))) + (defun make-prefix (&key key suffix description) (let ((prefix (make-instance 'prefix @@ -87,11 +74,10 @@ NIL to append it to the key sequence normally.") :description description))) prefix)) -(defclass-dynamic keymap () +(defclass keymap () ;; children could contain keymaps or prefixes. ((children :initarg :children - :dynamic t :initform nil :documentation "the children of the keymap. could be a function that returns a list of children.") (properties @@ -101,11 +87,9 @@ NIL to append it to the key sequence normally.") :documentation "additional metadata that a keymap holds.") (description :initarg :description - :dynamic t :initform nil) (active-p :initarg :active-p - :dynamic t :documentation "whether a prefix is active." :initform t) (base @@ -114,19 +98,44 @@ NIL to append it to the key sequence normally.") :initform nil :documentation "the keymap that this keymap extends."))) -(defmethod keymap-add-prefix ((keymap keymap) (prefix prefix) &optional after) - (unless (listp (keymap-children* keymap)) - (error "trying to add key to a non-static keymap.")) +(defgeneric keymap-children (keymap) + (:method ((keymap keymap)) + (slot-value keymap 'children))) + +(defgeneric (setf keymap-children) (new-value keymap) + (:method (new-value (keymap keymap)) + (setf (slot-value keymap 'children) new-value))) + +(defgeneric keymap-children (keymap) + (:method ((keymap keymap)) + (slot-value keymap 'children))) + +(defgeneric keymap-description (keymap) + (:method ((keymap keymap)) + (slot-value keymap 'description))) + +(defgeneric (setf keymap-description) (new-value keymap) + (:method (new-value (keymap keymap)) + (setf (slot-value keymap 'description) new-value))) + +(defgeneric keymap-active-p (keymap) + (:method ((keymap keymap)) + (slot-value keymap 'active-p))) + +(defgeneric (setf keymap-active-p) (new-value keymap) + (:method (new-value (keymap keymap)) + (setf (slot-value keymap 'active-p) new-value))) + +(defmethod keymap-add-item ((keymap keymap) item &optional after) (if after - (setf (keymap-children* keymap) (append (keymap-children* keymap) (list prefix))) - (push prefix (keymap-children* keymap)))) + (setf (keymap-children keymap) (append (slot-value keymap 'children) (list item))) + (push item (slot-value keymap 'children)))) + +(defmethod keymap-add-prefix ((keymap keymap) (prefix prefix) &optional after) + (keymap-add-item keymap prefix after)) (defmethod keymap-add-child ((keymap keymap) (keymap2 keymap) &optional after) - (unless (listp (keymap-children* keymap)) - (error "trying to add nested keymap to a non-static keymap.")) - (if after - (setf (keymap-children* keymap) (append (keymap-children* keymap) (list keymap2))) - (push keymap2 (keymap-children* keymap)))) + (keymap-add-item keymap keymap2 after)) (defgeneric prefix-p (keymap) (:documentation "check whether this is a prefix of another prefix. @@ -180,8 +189,8 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) :accessor keymap-function-table :initform (make-hash-table :test 'eq)))) -;; *root-keymap* contains all keymaps as (possibly nested, possibly "dynamic") children -(defvar *root-keymap* (make-instance 'keymap*)) +;; *root-keymap* contains the full keymap hierarchy +(defvar *root-keymap* (make-instance 'keymap)) (defvar *special-keymap* nil) @@ -269,10 +278,10 @@ Example: (define-key *global-keymap* \"C-'\" 'list-modes)" (setf next-keymap suffix) ;; suffix is a command, need to create intermediate keymap. but why would we get here? (progn - (setf next-keymap (make-instance 'keymap*)) + (setf next-keymap (make-instance 'keymap)) (setf (prefix-suffix next-prefix) next-keymap)))) (progn - (setf next-keymap (make-instance 'keymap*)) + (setf next-keymap (make-instance 'keymap)) (setf next-prefix (make-prefix :suffix next-keymap :key k)) @@ -355,6 +364,8 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (when (keymap-active-p binding) (loop for item in (keymap-children binding) append (find-matching-prefixes item key) into matches + ;; if we reach a keymap with an undef-hook we exit prematurely to cause that + ;; keymap to be activated when (and (typep item 'keymap*) (keymap-undef-hook item)) do (return matches) finally (return (or matches @@ -386,16 +397,7 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" thereis (find-in-function-table child key)) (let ((base (keymap-base binding))) (when base - (find-in-function-table base key)))) - ((typep binding 'prefix) - (find-in-function-table (prefix-suffix binding) key)))) - -(defun find-undef-hook-in-hierarchy (binding) - "find the first undef-hook from active keymaps." - (declare (ignore binding)) - (loop for km in (all-keymaps) - when (and (typep km 'keymap*) (keymap-undef-hook km)) - return (keymap-undef-hook km))) + (find-in-function-table base key)))))) (defmethod find-suffix ((keymap keymap) keyseq) "search KEYMAP tree for exact binding matching KEYSEQ. returns (suffix . prefix)." @@ -446,12 +448,8 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (cond (suffix-result (normalize-binding (car suffix-result) (cdr suffix-result))) (t - (let ((result - (or - ;; search function-table in hierarchy - (find-in-function-table keymap (car keyseq)) - ;; find undef-hook in hierarchy (e.g. self-insert) - (find-undef-hook-in-hierarchy keymap)))) + ;; search function-table in hierarchy + (let ((result (find-in-function-table keymap (car keyseq)))) (when result (normalize-binding result))))))) @@ -470,7 +468,7 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (defgeneric compute-keymaps (global-mode) (:method ((mode global-mode)) nil)) -(defun all-keymaps () +(defun other-keymaps () (let ((keymaps)) ;; this one collects active modes. local shadows global. (dolist (mode (reverse (all-active-modes (current-buffer)))) @@ -488,21 +486,26 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (push *special-keymap* keymaps)) (delete-duplicates keymaps :from-end t))) -;; this is for some "other" keymaps that i need to inject into the root-keymap (atleast this way for now). -;; we could make *root-keymap* itself have dynamic children and inject those into it but i dont want that, -;; so we create a second-level keymap as the root for all 'other-keymaps' and inject that keymap -;; into *root-keymap* -(defun other-keymaps () - (all-keymaps)) (defparameter *other-keymaps-root* - (make-instance 'keymap* - :children #'other-keymaps - :description '*other-keymaps-root*)) + (make-instance 'keymap :description '*other-keymaps-root*)) + +;; this is for some "other" keymaps that i need to inject into the root-keymap (atleast this way for now). +(defmethod keymap-children ((keymap (eql *other-keymaps-root*))) + (other-keymaps)) + +(defmethod keymap-children ((keymap (eql *root-keymap*))) + (cons *other-keymaps-root* + (slot-value keymap 'children))) + +(defun find-undef-hook () + (loop for km in (other-keymaps) + when (and (typep km 'keymap*) (keymap-undef-hook km)) + return (keymap-undef-hook km))) (defun lookup-keybind (key) - (unless (find *other-keymaps-root* (keymap-children *root-keymap*)) - (keymap-add-child *root-keymap* *other-keymaps-root*)) - (keymap-find *root-keymap* key)) + (or (keymap-find *root-keymap* key) + ;; find undef-hook in hierarchy (e.g. self-insert) + (normalize-binding (find-undef-hook)))) (defun find-keybind (key) (let ((result (keymap-find *root-keymap* key))) From 50be8c8638ca84c598862f20288e78ccd3f5dbc6 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sat, 14 Feb 2026 18:33:42 +0200 Subject: [PATCH 36/63] small fixes --- extensions/transient/keymap.lisp | 3 ++- src/input.lisp | 4 +++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 1d1dd435c..ad9b3af1d 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -82,7 +82,8 @@ the setter stores directly." (defclass choice (infix) ((choices - :accessor prefix-choices) + :accessor prefix-choices + :initform nil) (value)) (:documentation "a prefix that may take on different values.")) diff --git a/src/input.lisp b/src/input.lisp index 02a4a1d1e..5db6ad55b 100644 --- a/src/input.lisp +++ b/src/input.lisp @@ -112,8 +112,10 @@ (reset) (when prefix (prefix-invoke prefix)) + ;; if suffix was a function we call it and set to NIL so that we dont return it (when (functionp suffix) - (funcall suffix)) + (funcall suffix) + (setf suffix nil)) (cond ((prefix-command-p suffix) (when (typep suffix 'keymap) (keymap-activate suffix)) From 42158ab4d3c2bb7c5de1a15fc57524102517b25d Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Tue, 17 Feb 2026 16:47:26 +0200 Subject: [PATCH 37/63] make parse-transient eval values, so that quotes are needed --- extensions/transient/demo.lisp | 46 ++++++++++++++++------------- extensions/transient/keymap.lisp | 11 ++++--- extensions/transient/popup.lisp | 9 +++--- extensions/transient/transient.lisp | 7 ++++- 4 files changed, 43 insertions(+), 30 deletions(-) diff --git a/extensions/transient/demo.lisp b/extensions/transient/demo.lisp index 806feb514..7c8bc9a17 100644 --- a/extensions/transient/demo.lisp +++ b/extensions/transient/demo.lisp @@ -9,28 +9,28 @@ (:keymap :display-style :column :description "file operations" - (:key "o" :suffix demo-open :description "demo open") - (:key "s" :suffix demo-save :description "demo save (disabled)" :active-p nil) - (:key "w" :suffix demo-write :description "demo write") + (:key "o" :suffix 'demo-open :description "demo open") + (:key "s" :suffix 'demo-save :description "demo save (disabled)" :active-p nil) + (:key "w" :suffix 'demo-write :description "demo write") (:key "x" :suffix (:keymap - (:key "p" :suffix demo-pdf :description "pdf") - (:key "h" :suffix demo-html :description "html") - (:key "m" :suffix demo-md :description "markdown") + (:key "p" :suffix 'demo-pdf :description "pdf") + (:key "h" :suffix 'demo-html :description "html") + (:key "m" :suffix 'demo-md :description "markdown") (:key "b" :behavior :back :description "back")) :description "export format")) (:keymap :display-style :column :description "edit operations" - (:key "c" :suffix demo-copy) - (:key "v" :suffix demo-paste) - (:key "u" :suffix demo-undo) + (:key "c" :suffix 'demo-copy) + (:key "v" :suffix 'demo-paste) + (:key "u" :suffix 'demo-undo) (:key "q" :behavior :cancel :description "quit")) (:key "f" :suffix (:keymap - (:key "g" :suffix demo-grep :description "grep") - (:key "f" :suffix demo-find :description "find") - (:key "r" :suffix demo-replace :description "replace")) + (:key "g" :suffix 'demo-grep :description "grep") + (:key "f" :suffix 'demo-find :description "find") + (:key "r" :suffix 'demo-replace :description "replace")) :description "search menu") (:key "t" :suffix (:keymap @@ -40,30 +40,34 @@ (:key "l" :type :choice :id :mode - :choices-func (list "lisp" "python" "js") + :choices-func (progn + ;; something meaningless + (+ 1 1) + ;; then return value + (list "lisp" "python" "js")) :value "python" :description "mode")) (:keymap :description "editor" (:key "v" :type :choice - :choices ("vim" "emacs") + :choices '("vim" "emacs") :description "keys"))) :description "langs demo") (:key "a" :type :choice - :choices ("value1" "value2" "value3") + :choices '("value1" "value2" "value3") :description "multi-value infix") (:key "s" :type :choice :id :synced-infix - :choices ("lisp" "python" "js") - :variable *demo-language* + :choices '("lisp" "python" "js") + :variable '*demo-language* :description "variable-synced infix") - (:key "R" :suffix demo-run :description "run with mode") - (:key "T" :type toggle :value t :suffix demo-toggle :description "demo toggle") - (:key "e e" :type toggle :value t :suffix demo-toggle :description "another demo toggle") - (:key "e a" :type toggle :value t :suffix demo-toggle :description "and another demo toggle")) + (:key "R" :suffix 'demo-run :description "run with mode") + (:key "T" :type 'toggle :value t :suffix 'demo-toggle :description "demo toggle") + (:key "e e" :type 'toggle :value t :suffix 'demo-toggle :description "another demo toggle") + (:key "e a" :type 'toggle :value t :suffix 'demo-toggle :description "and another demo toggle")) (define-command demo-run () () (let ((mode-prefix (find-prefix-by-id *demo-keymap* :mode))) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index ad9b3af1d..f31ede615 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -150,13 +150,13 @@ the setter stores directly." (eval `(defmethod ,key-method ((object (eql ,object))) ,val)))) ((fboundp key-method) - (funcall (fdefinition (list 'setf key-method)) val object)) + (funcall (fdefinition (list 'setf key-method)) (eval val) object)) (t (let ((property-method (intern (format nil "~A-PROPERTIES" method-name) :lem/transient))) (when (fboundp property-method) (let ((props (funcall (fdefinition property-method) object))) - (setf (getf props key) val) + (setf (getf props key) (eval val)) (funcall (fdefinition (list 'setf property-method)) props object)))))))) (defun parse-transient (bindings) @@ -180,7 +180,10 @@ the setter stores directly." ;; key binding (:key ...) ((eq (car binding) :key) (let* ((key (second binding)) - (prefix-type (intern (symbol-name (getf binding :type 'prefix)) :lem/transient)) + (prefix-type (intern (symbol-name (if (getf binding :type) + (eval (getf binding :type)) + 'prefix)) + :lem/transient)) (prefix (make-instance prefix-type)) (last-keymap keymap)) (let ((parsed-key (parse-keyspec key))) @@ -237,7 +240,7 @@ the setter stores directly." ;; just for 'parse-transient' which is designed as a ;; convenience anyway. ((eq key :variable) - (setf (infix-variable prefix) value) + (setf (infix-variable prefix) (eval value)) (setf should-set nil)) ((eq key :type) (setf should-set nil)) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 9e740251a..5c941a32a 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -389,10 +389,11 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key (push (cons *transient-column-separator* 'transient-separator-attribute) line-segments)) (t - (let* ((seg-line (if (< row-idx (length col-data)) - (nth row-idx col-data) - nil)) - (line-width (if seg-line (segment-line-width seg-line) 0)) + (let* ((seg-line (when (< row-idx (length col-data)) + (nth row-idx col-data))) + (line-width (if seg-line + (segment-line-width seg-line) + 0)) (padding (- col-width line-width))) (when seg-line (dolist (seg seg-line) diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp index 22fd935e1..3e884e66a 100644 --- a/extensions/transient/transient.lisp +++ b/extensions/transient/transient.lisp @@ -4,6 +4,11 @@ :define-transient :mode-transient-keymap :prefix-value - :prefix-render)) + :prefix-render + :make-layout-item + :prefix-effective-display-key + :make-key-with-highlight + :transient-bracket-attribute + :transient-value-attribute)) (in-package :lem/transient) \ No newline at end of file From 9ca5ad67c6ca0a8dab57a372f5f3554d8f78b517 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Tue, 17 Feb 2026 22:32:36 +0200 Subject: [PATCH 38/63] add bottomside-window and define transient-mode --- extensions/transient/popup.lisp | 127 +++++++++++----------------- extensions/transient/transient.lisp | 4 +- src/frame.lisp | 13 ++- src/internal-packages.lisp | 6 +- src/window/side-window.lisp | 44 ++++++++++ src/window/window.lisp | 2 + 6 files changed, 114 insertions(+), 82 deletions(-) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 5c941a32a..72e6485f0 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -3,14 +3,14 @@ (defvar *transient-popup-window* nil) +(defvar *transient-shown-keymap* + nil + "the last keymap passed to show-transient. used to detect same-keymap redraws and preserve scroll position.") + (defvar *transient-popup-max-lines* 15 "max height of the transient buffer (measured in lines).") -(defparameter *transient-window-margin* - 4 - "margin in columns from the edge of the screen.") - (defparameter *transient-column-separator* " | " "string used to separate columns in row layout.") @@ -50,44 +50,10 @@ :foreground (attribute-foreground (ensure-attribute 'syntax-constant-attribute)) :bold t)) -;; custom floating window class that repositions on each redraw -(defclass transient-popup-window (floating-window) - ((base-width :initarg :base-width :accessor transient-base-width) - (base-height :initarg :base-height :accessor transient-base-height))) - -(defun compute-bottom-offset () - "compute the offset from the bottom of the display where the transient popup should appear. - -this accounts for the status line if present, the prompt window if active, and the bottom -completion interface if present." - (let ((offset (if (window-use-modeline-p (current-window)) - 1 - 0))) - ;; add height of prompt window if it exists - (alexandria:when-let ((prompt-window (lem/prompt-window:current-prompt-window))) - (incf offset (window-height prompt-window)) - ;; add height of completion window if it exists - (when lem/completion-mode::*completion-context* - (alexandria:when-let* ((context lem/completion-mode::*completion-context*) - (popup-menu (lem/completion-mode::context-popup-menu context)) - (completion-window (lem/popup-menu::popup-menu-window popup-menu))) - (incf offset (window-height completion-window))))) - offset)) - -(defun compute-transient-position (width height) - (let* ((bottom-offset (compute-bottom-offset)) - ;; position above minibuffer area: y = display-height - height - bottom-offset - border - (y (max 0 (- (display-height) height bottom-offset 2))) - (x (max 0 (- (display-width) width *transient-window-margin*)))) - (values x y))) - -(defmethod window-redraw ((window transient-popup-window) force) - "reposition the transient popup on each redraw to stay above the minibuffer/completion." - (let ((width (transient-base-width window)) - (height (transient-base-height window))) - (multiple-value-bind (x y) (compute-transient-position width height) - (window-set-pos window x y))) - (call-next-method)) +(define-minor-mode transient-mode + (:name "transient-mode" + :global t + :keymap *transient-mode-keymap*)) (defstruct layout-separator "a visual separator between items.") @@ -404,62 +370,69 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key (push (nreverse line-segments) result))) (nreverse result))) +(defun insert-segment-lines (point lines) + "insert a list of segment lines into buffer at POINT." + (loop :for line :in lines + :for first := t :then nil + :do (unless first + (insert-character point #\newline)) + (insert-segment-line point line))) + (defun render-layout-to-buffer (layout point &optional (key-width 0)) "render layout to buffer at point. key-width is used for even key spacing in items." - (let ((lines (render-layout-to-segments layout key-width))) - (loop for line in lines - for first = t then nil - do (unless first - (insert-character point #\newline)) - (insert-segment-line point line)))) + (insert-segment-lines point (render-layout-to-segments layout key-width))) + +(defun make-overflow-line (total-lines max-lines) + "make a segment line showing how many lines are hidden below the visible area." + (let ((hidden (- total-lines max-lines -1))) + (list (cons (format nil "+~d more..." hidden) + 'transient-separator-attribute)))) (defmethod show-transient ((keymap keymap)) - "show the transient popup. creates a window if it hasnt been created yet." - (let* ((existing-window (and (not (deleted-window-p *transient-popup-window*)) + "show the transient buffer." + (let* ((existing-window (and *transient-popup-window* + (not (deleted-window-p *transient-popup-window*)) *transient-popup-window*)) (buffer (if existing-window (window-buffer existing-window) (make-buffer "*transient*" :temporary t :enable-undo-p nil))) (root (find-intermediate-root keymap)) (layout (generate-layout root keymap))) + (setf *transient-shown-keymap* keymap) (erase-buffer buffer) - ;; we dont want lines to be cut off for now (no wrapping), until we have scrollbars or something (setf (variable-value 'line-wrap :buffer buffer) nil) (if layout - (render-layout-to-buffer layout (buffer-point buffer)) + (let* ((segments (render-layout-to-segments layout)) + (total-lines (length segments))) + (if (> total-lines *transient-popup-max-lines*) + ;; render full content with an overflow hint inserted at the boundary + (let ((overflow-line (make-overflow-line total-lines *transient-popup-max-lines*))) + (insert-segment-lines + (buffer-point buffer) + (append (subseq segments 0 (1- *transient-popup-max-lines*)) + (list overflow-line) + (nthcdr (1- *transient-popup-max-lines*) segments)))) + (insert-segment-lines (buffer-point buffer) segments))) (insert-string (buffer-point buffer) "(no bindings)")) (buffer-start (buffer-point buffer)) - ;; (log:info "buffer text:~%~A" (buffer-text buffer)) - (let* ((width (min (lem/popup-window::compute-buffer-width buffer) - (- (display-width) (* 2 *transient-window-margin*)))) - (height (min (lem/popup-window::compute-buffer-height buffer) - *transient-popup-max-lines*))) - (multiple-value-bind (x y) (compute-transient-position width height) - (if existing-window - (progn - (setf (transient-base-width existing-window) width) - (setf (transient-base-height existing-window) height) - (window-set-pos existing-window x y) - (window-set-size existing-window width height)) - (setf *transient-popup-window* - (make-instance 'transient-popup-window - :buffer buffer - :x x - :y y - :width width - :height height - :base-width width - :base-height height - :use-modeline-p nil - :border 1)))))) + (let ((height (min (lem/popup-window::compute-buffer-height buffer) + *transient-popup-max-lines*))) + (if existing-window + (unless (= (window-height existing-window) height) + (resize-bottomside-window existing-window height)) + (setf *transient-popup-window* + (make-bottomside-window buffer :height height))))) + (transient-mode t) (redraw-display)) (defun hide-transient () - "hide (delete) the transient popup window." + "hide (delete) the transient window." (when (and *transient-popup-window* (not (deleted-window-p *transient-popup-window*))) - (delete-window *transient-popup-window*) + (delete-bottomside-window) (setf *transient-popup-window* nil) + (setf *transient-shown-keymap* nil) + (transient-mode nil) (redraw-display))) \ No newline at end of file diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp index 3e884e66a..2fff43c77 100644 --- a/extensions/transient/transient.lisp +++ b/extensions/transient/transient.lisp @@ -9,6 +9,8 @@ :prefix-effective-display-key :make-key-with-highlight :transient-bracket-attribute - :transient-value-attribute)) + :transient-value-attribute + :transient-mode + :*transient-mode-keymap*)) (in-package :lem/transient) \ No newline at end of file diff --git a/src/frame.lisp b/src/frame.lisp index 16771619f..6986e2e24 100644 --- a/src/frame.lisp +++ b/src/frame.lisp @@ -73,7 +73,10 @@ redraw-display関数でキャッシュを捨てて画面全体を再描画しま :accessor frame-leftside-window) (rightside-window :initform nil - :accessor frame-rightside-window))) + :accessor frame-rightside-window) + (bottomside-window + :initform nil + :accessor frame-bottomside-window))) (defmethod frame-window-bottom-margin ((frame frame)) (if (frame-enable-window-modeline-per-window frame) @@ -149,7 +152,8 @@ redraw-display関数でキャッシュを捨てて画面全体を再描画しま (find window (frame-floating-windows frame)) (find window (frame-header-windows frame)) (eq window (frame-leftside-window frame)) - (eq window (frame-rightside-window frame))) + (eq window (frame-rightside-window frame)) + (eq window (frame-bottomside-window frame))) t)) (defun get-frame-of-window (window) @@ -198,7 +202,10 @@ redraw-display関数でキャッシュを捨てて画面全体を再描画しま (defun max-window-height (frame) (- (display-height) - (topleft-window-y frame))) + (topleft-window-y frame) + (if (frame-bottomside-window frame) + (window-height (frame-bottomside-window frame)) + 0))) (defun within-window-p (window x y) diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index 6aae5e8b4..c3f9e6c9a 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -206,6 +206,7 @@ :frame-message-window :frame-leftside-window :frame-rightside-window + :frame-bottomside-window :notify-frame-redisplay-required :map-frame :get-frame @@ -385,7 +386,10 @@ :make-leftside-window :delete-leftside-window :make-rightside-window - :delete-rightside-window) + :delete-rightside-window + :make-bottomside-window + :delete-bottomside-window + :resize-bottomside-window) ;; popup.lisp (:export :*default-popup-message-timeout* diff --git a/src/window/side-window.lisp b/src/window/side-window.lisp index bfad7c1d2..7a5d62eac 100644 --- a/src/window/side-window.lisp +++ b/src/window/side-window.lisp @@ -97,3 +97,47 @@ (window-height window)) (balance-windows) t))) + +(defclass bottomside-window (side-window) ()) + +(defun make-bottomside-window (buffer &key (height 10)) + "create a bottom-side window displaying BUFFER with the given HEIGHT. + +if a bottom-side window already exists, switch its buffer instead." + (let ((frame (current-frame))) + (cond ((frame-bottomside-window frame) + (let ((window (frame-bottomside-window frame))) + (set-window-buffer window buffer) + window)) + (t + (let* ((y (- (display-height) height)) + (window (make-instance 'bottomside-window + :buffer buffer + :x (topleft-window-x frame) + :y y + :width (max-window-width frame) + :height height + :use-modeline-p nil + :background-color nil + :border 0))) + (setf (frame-bottomside-window frame) window) + (balance-windows) + window))))) + +(defun delete-bottomside-window () + "delete the bottom-side window." + (let ((frame (current-frame))) + (when (frame-bottomside-window frame) + (delete-window (frame-bottomside-window frame)) + (setf (frame-bottomside-window frame) nil) + (balance-windows)))) + +(defun resize-bottomside-window (window height) + "resize the bottom-side WINDOW to HEIGHT lines and reposition it." + (check-type window bottomside-window) + (let ((frame (current-frame))) + (window-set-size window (max-window-width frame) height) + (window-set-pos window + (topleft-window-x frame) + (- (display-height) height)) + (balance-windows))) diff --git a/src/window/window.lisp b/src/window/window.lisp index 87f060cd7..17e5d6e98 100644 --- a/src/window/window.lisp +++ b/src/window/window.lisp @@ -1047,6 +1047,8 @@ You can pass in the optional argument WINDOW-LIST to replace the default (window-set-size window (display-width) 1)) (alexandria:when-let (window (frame-rightside-window (current-frame))) (resize-rightside-window window)) + (alexandria:when-let (window (frame-bottomside-window (current-frame))) + (resize-bottomside-window window (window-height window))) (balance-windows)) (defun update-on-display-resized () From e3da42097e6d298ba09da1c2707c415f87a38897 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 18 Feb 2026 20:16:37 +0200 Subject: [PATCH 39/63] add scrolling support --- extensions/transient/popup.lisp | 191 ++++++++++++++++++++++++-------- src/input.lisp | 24 +++- src/internal-packages.lisp | 1 + src/keymap.lisp | 128 +++++++++++---------- 4 files changed, 230 insertions(+), 114 deletions(-) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 72e6485f0..cbe569eb8 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -11,12 +11,24 @@ 15 "max height of the transient buffer (measured in lines).") +(defvar *transient-vertical-scroll-amount* + 1 + "number of lines to scroll vertically per step.") + +(defvar *transient-horizontal-scroll-amount* + 5 + "number of columns to scroll horizontally per step.") + +(defvar *transient-content-dirty* + nil + "when T, show-transient re-renders even for the same keymap (e.g. after infix changes).") + (defparameter *transient-column-separator* " | " "string used to separate columns in row layout.") (defvar *transient-always-show* - nil + t "whether to always show the transient buffer. by default only keymaps that have show-p set are shown.") (define-attribute transient-matched-key-attribute @@ -50,11 +62,45 @@ :foreground (attribute-foreground (ensure-attribute 'syntax-constant-attribute)) :bold t)) +;; this keymap has a special behavior. we're overriding its 'keymap-find' below. +(define-transient *transient-mode-keymap* + :display-style :row + (:key "M-Shift-Down" + :suffix 'transient-scroll-down + :behavior :drop + :description "scroll down") + (:key "M-Shift-Up" + :suffix 'transient-scroll-up + :behavior :drop + :description "scroll up") + (:key "M-Shift-Right" + :suffix 'transient-scroll-right + :behavior :drop + :description "scroll right") + (:key "M-Shift-Left" + :suffix 'transient-scroll-left + :behavior :drop + :description "scroll left")) + +(defmethod keymap-find ((keymap (eql *transient-mode-keymap*)) key) + (let* ((keyseq (etypecase key + (lem-core::key (list key)) + (list key)))) + ;; the keymap needs to work if any key we defined (e.g. M-S-Down) is the last one in our + ;; current keymap sequence, because we want these keys to be available in any transient + ;; keymap context + (loop for prefix in (keymap-children keymap) + when (equal (prefix-key prefix) (car (last keyseq))) + return (normalize-binding prefix (prefix-suffix prefix))))) + (define-minor-mode transient-mode (:name "transient-mode" :global t :keymap *transient-mode-keymap*)) +(defmethod prefix-invoke :after ((prefix infix)) + (setf *transient-content-dirty* t)) + (defstruct layout-separator "a visual separator between items.") @@ -378,61 +424,114 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key (insert-character point #\newline)) (insert-segment-line point line))) -(defun render-layout-to-buffer (layout point &optional (key-width 0)) - "render layout to buffer at point. - -key-width is used for even key spacing in items." - (insert-segment-lines point (render-layout-to-segments layout key-width))) - -(defun make-overflow-line (total-lines max-lines) - "make a segment line showing how many lines are hidden below the visible area." - (let ((hidden (- total-lines max-lines -1))) - (list (cons (format nil "+~d more..." hidden) - 'transient-separator-attribute)))) - (defmethod show-transient ((keymap keymap)) - "show the transient buffer." - (let* ((existing-window (and *transient-popup-window* - (not (deleted-window-p *transient-popup-window*)) - *transient-popup-window*)) - (buffer (if existing-window - (window-buffer existing-window) - (make-buffer "*transient*" :temporary t :enable-undo-p nil))) - (root (find-intermediate-root keymap)) - (layout (generate-layout root keymap))) - (setf *transient-shown-keymap* keymap) - (erase-buffer buffer) - (setf (variable-value 'line-wrap :buffer buffer) nil) - (if layout - (let* ((segments (render-layout-to-segments layout)) - (total-lines (length segments))) - (if (> total-lines *transient-popup-max-lines*) - ;; render full content with an overflow hint inserted at the boundary - (let ((overflow-line (make-overflow-line total-lines *transient-popup-max-lines*))) - (insert-segment-lines - (buffer-point buffer) - (append (subseq segments 0 (1- *transient-popup-max-lines*)) - (list overflow-line) - (nthcdr (1- *transient-popup-max-lines*) segments)))) - (insert-segment-lines (buffer-point buffer) segments))) - (insert-string (buffer-point buffer) "(no bindings)")) - (buffer-start (buffer-point buffer)) - (let ((height (min (lem/popup-window::compute-buffer-height buffer) - *transient-popup-max-lines*))) - (if existing-window - (unless (= (window-height existing-window) height) - (resize-bottomside-window existing-window height)) - (setf *transient-popup-window* - (make-bottomside-window buffer :height height))))) + "shows the transient buffer with the contents rendered." + (let ((same-keymap-p (eq keymap *transient-shown-keymap*))) + ;; skip re-render when same keymap, window alive, and no content changes + (when (and same-keymap-p (transient-window-alive-p) (not *transient-content-dirty*)) + (return-from show-transient)) + (let* ((existing-window (and *transient-popup-window* + (not (deleted-window-p *transient-popup-window*)) + *transient-popup-window*)) + (buffer (if existing-window + (window-buffer existing-window) + (make-buffer "*transient*" :temporary t :enable-undo-p nil))) + ;; save vertical scroll position before erase (only for same-keymap re-renders) + (saved-vp-line (when (and existing-window same-keymap-p) + (line-number-at-point (window-view-point existing-window)))) + (root (find-intermediate-root keymap)) + (layout (generate-layout root keymap))) + (setf *transient-content-dirty* nil) + (setf *transient-shown-keymap* keymap) + (erase-buffer buffer) + (setf (variable-value 'line-wrap :buffer buffer) nil) + (if layout + (insert-segment-lines (buffer-point buffer) (render-layout-to-segments layout)) + (insert-string (buffer-point buffer) "(no bindings)")) + (buffer-start (buffer-point buffer)) + (let ((height (min (lem/popup-window::compute-buffer-height buffer) + *transient-popup-max-lines*))) + (if existing-window + (unless (= (window-height existing-window) height) + (resize-bottomside-window existing-window height)) + (setf *transient-popup-window* + (make-bottomside-window buffer :height height)))) + ;; restore vertical scroll position for same-keymap re-renders + (when (and saved-vp-line (> saved-vp-line 1)) + (move-to-line (window-view-point *transient-popup-window*) saved-vp-line)) + ;; reset horizontal scroll when switching to a different keymap + (unless same-keymap-p + (setf (window-parameter *transient-popup-window* 'lem-core::horizontal-scroll-start) 0)))) + (modeline-add-status-list 'transient-scroll-status) (transient-mode t) (redraw-display)) +(defun transient-window-alive-p () + "return T if the transient popup window exists and is not deleted." + (and *transient-popup-window* + (not (deleted-window-p *transient-popup-window*)))) + +(defun transient-scroll-status (window) + "modeline status function showing scroll position when the transient buffer overflows." + (when (transient-window-alive-p) + (let* ((tw *transient-popup-window*) + (nlines (buffer-nlines (window-buffer tw))) + (height (window-height tw))) + (when (>= nlines height) + (let ((pos (cond ((first-line-p (window-view-point tw)) + "top") + ((null (line-offset (copy-point (window-view-point tw) :temporary) + height)) + "bot") + (t (format + nil + "~d%" + (floor (* 100 + (float (/ (line-number-at-point (window-view-point tw)) + nlines))))))))) + (values (format nil " transient[~a]" pos) + 'transient-separator-attribute)))))) + +(define-command transient-scroll-down () () + "scroll the transient buffer down by `*transient-vertical-scroll-amount*' lines." + (when (transient-window-alive-p) + (window-scroll *transient-popup-window* *transient-vertical-scroll-amount*) + (redraw-display))) + +(define-command transient-scroll-up () () + "scroll the transient buffer up by `*transient-vertical-scroll-amount*' lines." + (when (transient-window-alive-p) + (window-scroll *transient-popup-window* (- *transient-vertical-scroll-amount*)) + (redraw-display))) + +(define-command transient-scroll-right () () + "scroll the transient buffer to the right by `*transient-vertical-scroll-amount*' columns." + (when (transient-window-alive-p) + (let ((current (or (window-parameter *transient-popup-window* + 'lem-core::horizontal-scroll-start) + 0))) + (setf (window-parameter *transient-popup-window* 'lem-core::horizontal-scroll-start) + (+ current *transient-horizontal-scroll-amount*))) + (redraw-display))) + +(define-command transient-scroll-left () () + "scroll the transient buffer to the left by `*transient-vertical-scroll-amount*' columns." + (when (transient-window-alive-p) + (let ((current (or (window-parameter *transient-popup-window* + 'lem-core::horizontal-scroll-start) + 0))) + (setf (window-parameter *transient-popup-window* 'lem-core::horizontal-scroll-start) + (max 0 (- current *transient-horizontal-scroll-amount*)))) + (redraw-display))) + (defun hide-transient () "hide (delete) the transient window." (when (and *transient-popup-window* (not (deleted-window-p *transient-popup-window*))) + (modeline-remove-status-list 'transient-scroll-status) (delete-bottomside-window) (setf *transient-popup-window* nil) (setf *transient-shown-keymap* nil) + (setf *transient-content-dirty* nil) (transient-mode nil) (redraw-display))) \ No newline at end of file diff --git a/src/input.lisp b/src/input.lisp index 5db6ad55b..d246d91de 100644 --- a/src/input.lisp +++ b/src/input.lisp @@ -80,9 +80,19 @@ (defun count-intermediate-keys (keymap kseq) "count how many keys in KSEQ traversed through intermediate prefixes." (let ((count 0)) - (labels ((walk (binding keys) + (labels ((find-prefix-matches (km key) + "find prefix children of KM matching KEY, recursing into child keymaps." + (when (and (typep km 'keymap) (keymap-active-p km)) + (loop for item in (keymap-children km) + when (and (typep item 'prefix) + (prefix-active-p item) + (equal (prefix-key item) key)) + collect item + when (typep item 'keymap) + append (find-prefix-matches item key)))) + (walk (binding keys) (when keys - (let ((matches (find-matching-prefixes binding (car keys)))) + (let ((matches (find-prefix-matches binding (car keys)))) (dolist (match matches) (when (prefix-intermediate-p match) (incf count)) @@ -131,11 +141,19 @@ ;; also pops any intermediate prefix keys so the recorded ;; sequence reflects only the menu-level key that was pressed. ((eq behavior :drop) + ;; command symbols are executed via call-command before dropping. + (when suffix + (call-command suffix nil)) (setf kseq (butlast kseq)) (dotimes (_ (count-intermediate-keys *root-keymap* kseq)) (setf kseq (butlast kseq))) (set-last-read-key-sequence kseq) - (reset)) + ;; TODO: this check here shouldnt be necessary but it currently is. + (if (null kseq) + (progn + (keymap-activate *root-keymap*) + (return nil)) + (reset))) ;; :back removes the current key and the key that entered ;; the current menu, navigating up one menu level. ;; also pops any intermediate prefix keys in between. diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index c3f9e6c9a..16c14d11a 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -482,6 +482,7 @@ :prefix-intermediate-p :prefix-behavior :keymap-children + :normalize-binding :keymap-description :keymap-properties :keymap-base diff --git a/src/keymap.lisp b/src/keymap.lisp index 18e4958e7..782609e41 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -312,9 +312,16 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" bindings))) (defun undefine-key-internal (keymap keys) - (labels ((search-tree (binding keys-to-find) - (when keys-to-find - (let ((matches (find-matching-prefixes binding (car keys-to-find)))) + (labels ((find-prefix-matches (km key) + "find direct prefix children of KM matching KEY." + (loop for item in (keymap-children km) + when (and (typep item 'prefix) + (prefix-active-p item) + (equal (prefix-key item) key)) + collect item)) + (search-tree (binding keys-to-find) + (when (and keys-to-find (typep binding 'keymap)) + (let ((matches (find-prefix-matches binding (car keys-to-find)))) (loop for match in matches for suffix = (prefix-suffix match) do (if (cdr keys-to-find) @@ -354,24 +361,6 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" str)))))))) (mapcar #'parse (uiop:split-string string :separator " ")))) -(defun find-matching-prefixes (binding key) - "find prefixes in children that match KEY." - (cond ((typep binding 'prefix) - (when (and (prefix-active-p binding) - (equal (prefix-key binding) key)) - (list binding))) - ((typep binding 'keymap) - (when (keymap-active-p binding) - (loop for item in (keymap-children binding) - append (find-matching-prefixes item key) into matches - ;; if we reach a keymap with an undef-hook we exit prematurely to cause that - ;; keymap to be activated - when (and (typep item 'keymap*) (keymap-undef-hook item)) - do (return matches) - finally (return (or matches - (let ((base (keymap-base binding))) - (when base - (find-matching-prefixes base key)))))))))) (defun find-in-function-table (binding key) "search function-table of keymaps in hierarchy for KEY." @@ -399,59 +388,68 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (when base (find-in-function-table base key)))))) -(defmethod find-suffix ((keymap keymap) keyseq) - "search KEYMAP tree for exact binding matching KEYSEQ. returns (suffix . prefix)." - (labels ((search-tree (binding keys parent-prefix) - (if (null keys) - (if (typep binding 'prefix) - (cons (prefix-suffix binding) binding) - (when binding - (cons binding parent-prefix))) - ;; try all matches and return first successful result - (let ((matches (find-matching-prefixes binding (car keys)))) - (or (loop for match in matches - for result = (search-tree (prefix-suffix match) (cdr keys) match) - when result return result) - ;; if we have matches but none were exact/successful, we are still in a prefix - (when (and matches (null (cdr keys))) - (let ((match (car matches))) - (cons (prefix-suffix match) match))) - (when (typep binding 'keymap) - (let ((base (keymap-base binding))) - (when base - (search-tree base keys parent-prefix))))))))) - (search-tree keymap keyseq nil))) - (defun normalize-binding (found &optional parent-prefix) - (typecase found - (prefix (cons (prefix-suffix found) found)) - (keymap (cons found parent-prefix)) - (t (cons found parent-prefix)))) + (if (typep found 'prefix) + (cons (prefix-suffix found) found) + (cons found parent-prefix))) (defmethod keymap-find ((keymap keymap) key) "finds key sequence in keymap, returns (suffix . prefix)." - (let* ((keyseq (etypecase key - (key (list key)) - (list key))) - (suffix-result (find-suffix keymap keyseq))) - (when suffix-result - (normalize-binding (car suffix-result) (cdr suffix-result))))) + (let ((keyseq (etypecase key + (key (list key)) + (list key)))) + (labels ((search-keymap (km keys) + (when (keymap-active-p km) + (let ((prefix-matches) + (found)) + (loop for item in (keymap-children km) + do (cond + ;; child keymap: dispatch through keymap-find + ((typep item 'keymap) + (when (keymap-active-p item) + (let ((r (keymap-find item keys))) + (when r + (setf found r) + (return))))) + ;; child prefix: collect matches for current key + ((typep item 'prefix) + (when (and (prefix-active-p item) + (equal (prefix-key item) (car keys))) + (push item prefix-matches)))) + ;; when we find an undef-hook, stop searching further children + when (and (typep item 'keymap*) + (keymap-undef-hook item)) + do (return)) + (or found + ;; try collected prefix matches + (loop for match in prefix-matches + for suffix = (prefix-suffix match) + for result = (cond + ;; last key: return the binding + ((null (cdr keys)) + (normalize-binding suffix match)) + ;; more keys, suffix is a keymap: recurse through keymap-find + ((typep suffix 'keymap) + (keymap-find suffix (cdr keys))) + (t nil)) + when result return result) + ;; base keymap fallback + (let ((base (keymap-base km))) + (when base + (search-keymap base keys)))))))) + (search-keymap keymap keyseq)))) ;; this is currently here for backwards compatibility ;; im not yet sure whether 'cmd' or function-table lookup is necessary (i think so but im not sure how to get rid of it.) (defmethod keymap-find ((keymap keymap*) key) "finds key sequence in keymap, returns (suffix . prefix)." - (let* ((keyseq (etypecase key - (key (list key)) - (list key))) - (suffix-result (find-suffix keymap keyseq))) - (cond (suffix-result - (normalize-binding (car suffix-result) (cdr suffix-result))) - (t - ;; search function-table in hierarchy - (let ((result (find-in-function-table keymap (car keyseq)))) - (when result - (normalize-binding result))))))) + (or (call-next-method) + (let ((keyseq (etypecase key + (key (list key)) + (list key)))) + (let ((result (find-in-function-table keymap (car keyseq)))) + (when result + (normalize-binding result)))))) (defun insertion-key-p (key) (let* ((key (typecase key From ac9b67590e0e755d6f798f82686bbe5f2174b794 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 18 Feb 2026 22:21:27 +0200 Subject: [PATCH 40/63] fix horizontal scrolling --- src/display/physical-line.lisp | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/display/physical-line.lisp b/src/display/physical-line.lisp index efb3b3e92..efe3a9873 100644 --- a/src/display/physical-line.lisp +++ b/src/display/physical-line.lisp @@ -461,17 +461,17 @@ (+ cursor-x (object-width cursor-object))) (setf (horizontal-scroll-start window) (+ (- cursor-x width) - (object-width cursor-object)))))) - (setf objects - (extract-object-in-display-range - (mapcan (lambda (object) - (if (typep object 'text-object) - (explode-object object) - (list object))) - objects) - (horizontal-scroll-start window) - (+ (horizontal-scroll-start window) - (window-view-width window))))) + (object-width cursor-object))))))) + (setf objects + (extract-object-in-display-range + (mapcan (lambda (object) + (if (typep object 'text-object) + (explode-object object) + (list object))) + objects) + (horizontal-scroll-start window) + (+ (horizontal-scroll-start window) + (window-view-width window)))) (render-line-with-caching window 0 y (append left-side-objects objects) height)) height))) From c39df301c2e37b1f895962c4254065aa9f6fca1b Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 18 Feb 2026 22:39:34 +0200 Subject: [PATCH 41/63] set always-show to nil --- extensions/transient/popup.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index cbe569eb8..e83acef1f 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -28,7 +28,7 @@ "string used to separate columns in row layout.") (defvar *transient-always-show* - t + nil "whether to always show the transient buffer. by default only keymaps that have show-p set are shown.") (define-attribute transient-matched-key-attribute From a1533e35de5826b867075f23ed8f8056072e53ee Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 19 Feb 2026 00:20:56 +0200 Subject: [PATCH 42/63] remove "dirty" redrawing technique --- extensions/transient/popup.lisp | 11 ----------- src/keymap.lisp | 7 ++++--- 2 files changed, 4 insertions(+), 14 deletions(-) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index e83acef1f..1c1aca3ea 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -19,10 +19,6 @@ 5 "number of columns to scroll horizontally per step.") -(defvar *transient-content-dirty* - nil - "when T, show-transient re-renders even for the same keymap (e.g. after infix changes).") - (defparameter *transient-column-separator* " | " "string used to separate columns in row layout.") @@ -98,9 +94,6 @@ :global t :keymap *transient-mode-keymap*)) -(defmethod prefix-invoke :after ((prefix infix)) - (setf *transient-content-dirty* t)) - (defstruct layout-separator "a visual separator between items.") @@ -428,8 +421,6 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key "shows the transient buffer with the contents rendered." (let ((same-keymap-p (eq keymap *transient-shown-keymap*))) ;; skip re-render when same keymap, window alive, and no content changes - (when (and same-keymap-p (transient-window-alive-p) (not *transient-content-dirty*)) - (return-from show-transient)) (let* ((existing-window (and *transient-popup-window* (not (deleted-window-p *transient-popup-window*)) *transient-popup-window*)) @@ -441,7 +432,6 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key (line-number-at-point (window-view-point existing-window)))) (root (find-intermediate-root keymap)) (layout (generate-layout root keymap))) - (setf *transient-content-dirty* nil) (setf *transient-shown-keymap* keymap) (erase-buffer buffer) (setf (variable-value 'line-wrap :buffer buffer) nil) @@ -532,6 +522,5 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key (delete-bottomside-window) (setf *transient-popup-window* nil) (setf *transient-shown-keymap* nil) - (setf *transient-content-dirty* nil) (transient-mode nil) (redraw-display))) \ No newline at end of file diff --git a/src/keymap.lisp b/src/keymap.lisp index 782609e41..b930b07d6 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -127,9 +127,10 @@ NIL to append it to the key sequence normally.") (setf (slot-value keymap 'active-p) new-value))) (defmethod keymap-add-item ((keymap keymap) item &optional after) - (if after - (setf (keymap-children keymap) (append (slot-value keymap 'children) (list item))) - (push item (slot-value keymap 'children)))) + (unless (find item (keymap-children keymap)) + (if after + (setf (keymap-children keymap) (append (slot-value keymap 'children) (list item))) + (push item (slot-value keymap 'children))))) (defmethod keymap-add-prefix ((keymap keymap) (prefix prefix) &optional after) (keymap-add-item keymap prefix after)) From 24badca7c9ad681f5dce3f019a9ae7c66ef2dd18 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 19 Feb 2026 19:15:08 +0200 Subject: [PATCH 43/63] separate child keymaps from prefixes --- extensions/transient/keymap.lisp | 28 ++-- extensions/transient/popup.lisp | 88 +++++------ extensions/vi-mode/commands.lisp | 3 +- src/input.lisp | 24 ++- src/internal-packages.lisp | 2 +- src/keymap.lisp | 263 ++++++++++++++++--------------- 6 files changed, 210 insertions(+), 198 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index f31ede615..3d1a23479 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -46,18 +46,23 @@ the setter stores directly." (add-property prefix prefix-properties display-key) (defun find-prefix-by-id (keymap id) - (labels ((f (node) + (labels ((check-prefix (node) + (if (eql (prefix-id node) id) + node + (let ((suffix (prefix-suffix node))) + (when (or (typep suffix 'keymap) + (typep suffix 'prefix)) + (f suffix))))) + (f (node) (cond ((typep node 'keymap) + (dolist (p (keymap-prefixes node)) + (let ((res (check-prefix p))) + (when res (return-from f res)))) (dolist (child (keymap-children node)) (let ((res (f child))) (when res (return-from f res))))) ((typep node 'prefix) - (if (eql (prefix-id node) id) - node - (let ((suffix (prefix-suffix node))) - (when (or (typep suffix 'keymap) - (typep suffix 'prefix)) - (f suffix)))))))) + (check-prefix node))))) (f keymap))) (defun keymap-contains-p (keymap target) @@ -65,8 +70,10 @@ the setter stores directly." (labels ((f (node) (cond ((eq node target) t) ((typep node 'keymap) + (dolist (p (keymap-prefixes node)) + (when (f p) (return-from f t))) (dolist (child (keymap-children node)) - (when (f child) (return t)))) + (when (f child) (return-from f t)))) ((typep node 'prefix) (let ((suffix (prefix-suffix node))) (when (or (typep suffix 'keymap) @@ -202,10 +209,9 @@ the setter stores directly." ;; reuse existing intermediate prefix with same key, or create new one (let ((existing (find current-key - (keymap-children last-keymap) + (keymap-prefixes last-keymap) :test (lambda (k child) - (and (typep child 'prefix) - (prefix-intermediate-p child) + (and (prefix-intermediate-p child) (equal k (prefix-key child))))))) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 1c1aca3ea..07108418d 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -79,15 +79,15 @@ :description "scroll left")) (defmethod keymap-find ((keymap (eql *transient-mode-keymap*)) key) - (let* ((keyseq (etypecase key - (lem-core::key (list key)) - (list key)))) + (let ((keyseq (etypecase key + (lem-core::key (list key)) + (list key)))) ;; the keymap needs to work if any key we defined (e.g. M-S-Down) is the last one in our - ;; current keymap sequence, because we want these keys to be available in any transient + ;; current key sequence, because we want these keys to be available in any transient ;; keymap context - (loop for prefix in (keymap-children keymap) + (loop for prefix in (keymap-prefixes keymap) when (equal (prefix-key prefix) (car (last keyseq))) - return (normalize-binding prefix (prefix-suffix prefix))))) + return prefix))) (define-minor-mode transient-mode (:name "transient-mode" @@ -137,9 +137,9 @@ (defun keymap-contains-via-intermediates-p (keymap target) "return T if TARGET is reachable from KEYMAP through a sequence of intermediate prefixes." - (dolist (child (keymap-children keymap)) - (when (and (typep child 'prefix) (prefix-intermediate-p child)) - (let ((suffix (prefix-suffix child))) + (dolist (p (keymap-prefixes keymap)) + (when (prefix-intermediate-p p) + (let ((suffix (prefix-suffix p))) (when (and (typep suffix 'keymap) (or (eq suffix target) (keymap-contains-via-intermediates-p suffix target))) @@ -209,14 +209,14 @@ or ACTIVE-KEYMAP itself if no such ancestor exists." ;; check if this keymap reaches active-keymap via intermediates (when (keymap-contains-via-intermediates-p keymap active-keymap) (return-from find-intermediate-root keymap)) + ;; recurse into prefixes that have keymap suffixes + (dolist (p (keymap-prefixes keymap)) + (let ((suffix (prefix-suffix p))) + (when (typep suffix 'keymap) + (find-root suffix)))) ;; recurse into child keymaps (dolist (child (keymap-children keymap)) - (cond ((typep child 'keymap) - (find-root child)) - ((typep child 'prefix) - (let ((suffix (prefix-suffix child))) - (when (typep suffix 'keymap) - (find-root suffix)))))))) + (find-root child)))) (find-root *root-keymap*) active-keymap)) @@ -236,38 +236,36 @@ nested keymaps are arranged based on display-style (:row or :column). prefixes marked as :intermediate-p are flattened and shown with concatenated keys." (let ((prefix-items) (keymap-layouts)) - (labels ((collect-items (node &optional (matched-depth 0)) - (cond - ;; nested keymap: recurse and collect - ((typep node 'keymap) - (alexandria:when-let ((child-layout (generate-layout node active-keymap))) - (push child-layout keymap-layouts))) - ;; prefix: create item if show-p - ((typep node 'prefix) - (when (prefix-show-p node) - (if (prefix-intermediate-p node) - (let* ((suffix (prefix-suffix node)) - (new-depth (if (and active-keymap - (typep suffix 'keymap) - (or (eq suffix active-keymap) - (keymap-contains-via-intermediates-p - suffix active-keymap))) - (1+ matched-depth) - matched-depth))) - (if (typep suffix 'keymap) - (dolist (child (keymap-children suffix)) - (collect-items child new-depth)) - (push (prefix-render node new-depth) prefix-items))) - (push (prefix-render - node - (when (prefix-display-key node) - matched-depth)) - prefix-items))))))) - ;; process children, separating prefixes from keymaps + (labels ((collect-prefix (node &optional (matched-depth 0)) + (when (prefix-show-p node) + (if (prefix-intermediate-p node) + (let* ((suffix (prefix-suffix node)) + (new-depth (if (and active-keymap + (typep suffix 'keymap) + (or (eq suffix active-keymap) + (keymap-contains-via-intermediates-p + suffix active-keymap))) + (1+ matched-depth) + matched-depth))) + (if (typep suffix 'keymap) + (dolist (p (keymap-prefixes suffix)) + (collect-prefix p new-depth)) + (push (prefix-render node new-depth) prefix-items))) + (push (prefix-render + node + (when (prefix-display-key node) + matched-depth)) + prefix-items)))) + (collect-keymap (node) + (alexandria:when-let ((child-layout (generate-layout node active-keymap))) + (push child-layout keymap-layouts)))) + ;; process prefixes and child keymaps separately (let ((current keymap)) (loop while current - do (dolist (child (keymap-children current)) - (collect-items child)) + do (dolist (p (keymap-prefixes current)) + (collect-prefix p)) + (dolist (child (keymap-children current)) + (collect-keymap child)) (setf current (keymap-base current))))) ;; build result: title first, then content (prefixes + keymaps arranged by display-style) (setf prefix-items (nreverse prefix-items)) diff --git a/extensions/vi-mode/commands.lisp b/extensions/vi-mode/commands.lisp index 0a30f7568..1c8f37120 100644 --- a/extensions/vi-mode/commands.lisp +++ b/extensions/vi-mode/commands.lisp @@ -164,7 +164,8 @@ (defun extract-count-keys (keys) (loop for key in keys - for cmd = (lem-core::keymap-find *motion-keymap* key) + for prefix = (lem-core::keymap-find *motion-keymap* key) + for cmd = (when prefix (prefix-suffix prefix)) unless (member cmd '(lem/universal-argument:universal-argument-0 lem/universal-argument:universal-argument-1 lem/universal-argument:universal-argument-2 diff --git a/src/input.lisp b/src/input.lisp index d246d91de..e5ef376ac 100644 --- a/src/input.lisp +++ b/src/input.lisp @@ -83,13 +83,12 @@ (labels ((find-prefix-matches (km key) "find prefix children of KM matching KEY, recursing into child keymaps." (when (and (typep km 'keymap) (keymap-active-p km)) - (loop for item in (keymap-children km) - when (and (typep item 'prefix) - (prefix-active-p item) - (equal (prefix-key item) key)) - collect item - when (typep item 'keymap) - append (find-prefix-matches item key)))) + (append (loop for item in (keymap-prefixes km) + when (and (prefix-active-p item) + (equal (prefix-key item) key)) + collect item) + (loop for child in (keymap-children km) + append (find-prefix-matches child key))))) (walk (binding keys) (when keys (let ((matches (find-prefix-matches binding (car keys)))) @@ -107,17 +106,14 @@ (set-last-mouse-event event) (find-mouse-command event)) (key - (let ((result) - (prefix) + (let ((prefix) (suffix) (behavior) (kseq (list event))) (labels ((reset () - (setf result (lookup-keybind kseq)) - (setf suffix (car result)) - (setf prefix (cdr result)) - (when prefix - (setf behavior (prefix-behavior prefix))))) + (setf prefix (lookup-keybind kseq)) + (setf suffix (when prefix (prefix-suffix prefix))) + (setf behavior (when prefix (prefix-behavior prefix))))) (loop (reset) (when prefix diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp index 16c14d11a..6809cf34b 100644 --- a/src/internal-packages.lisp +++ b/src/internal-packages.lisp @@ -481,8 +481,8 @@ :prefix-active-p :prefix-intermediate-p :prefix-behavior + :keymap-prefixes :keymap-children - :normalize-binding :keymap-description :keymap-properties :keymap-base diff --git a/src/keymap.lisp b/src/keymap.lisp index b930b07d6..183815be7 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -75,11 +75,14 @@ NIL to append it to the key sequence normally.") prefix)) (defclass keymap () - ;; children could contain keymaps or prefixes. - ((children + ((prefixes + :initarg :prefixes + :initform nil + :documentation "prefix bindings owned by this keymap.") + (children :initarg :children :initform nil - :documentation "the children of the keymap. could be a function that returns a list of children.") + :documentation "child keymaps.") (properties :initarg :properties :accessor keymap-properties @@ -98,18 +101,22 @@ NIL to append it to the key sequence normally.") :initform nil :documentation "the keymap that this keymap extends."))) -(defgeneric keymap-children (keymap) +(defgeneric keymap-prefixes (keymap) (:method ((keymap keymap)) - (slot-value keymap 'children))) + (slot-value keymap 'prefixes))) -(defgeneric (setf keymap-children) (new-value keymap) +(defgeneric (setf keymap-prefixes) (new-value keymap) (:method (new-value (keymap keymap)) - (setf (slot-value keymap 'children) new-value))) + (setf (slot-value keymap 'prefixes) new-value))) (defgeneric keymap-children (keymap) (:method ((keymap keymap)) (slot-value keymap 'children))) +(defgeneric (setf keymap-children) (new-value keymap) + (:method (new-value (keymap keymap)) + (setf (slot-value keymap 'children) new-value))) + (defgeneric keymap-description (keymap) (:method ((keymap keymap)) (slot-value keymap 'description))) @@ -126,17 +133,17 @@ NIL to append it to the key sequence normally.") (:method (new-value (keymap keymap)) (setf (slot-value keymap 'active-p) new-value))) -(defmethod keymap-add-item ((keymap keymap) item &optional after) - (unless (find item (keymap-children keymap)) - (if after - (setf (keymap-children keymap) (append (slot-value keymap 'children) (list item))) - (push item (slot-value keymap 'children))))) - (defmethod keymap-add-prefix ((keymap keymap) (prefix prefix) &optional after) - (keymap-add-item keymap prefix after)) + (unless (find prefix (keymap-prefixes keymap)) + (if after + (setf (keymap-prefixes keymap) (append (slot-value keymap 'prefixes) (list prefix))) + (push prefix (slot-value keymap 'prefixes))))) (defmethod keymap-add-child ((keymap keymap) (keymap2 keymap) &optional after) - (keymap-add-item keymap keymap2 after)) + (unless (find keymap2 (keymap-children keymap)) + (if after + (setf (keymap-children keymap) (append (slot-value keymap 'children) (list keymap2))) + (push keymap2 (slot-value keymap 'children))))) (defgeneric prefix-p (keymap) (:documentation "check whether this is a prefix of another prefix. @@ -172,6 +179,27 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (:documentation "a hook for when a prefix is reached.") (:method ((prefix t)) nil)) +(defun find-prefix-matches (keymap key &key active-only) + (loop for item in (keymap-prefixes keymap) + when (and (equal (prefix-key item) key) + (or (not active-only) + (prefix-active-p item))) + collect item)) + +(defun first-prefix-match (keymap key &key active-only) + (loop for item in (keymap-prefixes keymap) + when (and (equal (prefix-key item) key) + (or (not active-only) + (prefix-active-p item))) + return item)) + +(defun search-with-base (keymap fn) + (or (funcall fn keymap) + (when (typep keymap 'keymap) + (let ((base (keymap-base keymap))) + (when base + (search-with-base base fn)))))) + (deftype key-sequence () '(trivial-types:proper-list key)) @@ -200,9 +228,10 @@ a prefix is a prefix of another if its a keymap or if its suffix is a prefix.")) (when (keymap-description object) (princ (keymap-description object) stream)))) -(defun make-keymap (&key undef-hook children description base) +(defun make-keymap (&key undef-hook prefixes children description base) (let ((keymap (make-instance 'keymap* :undef-hook undef-hook + :prefixes prefixes :children children :description description :base base))) @@ -241,19 +270,11 @@ Example: (define-key *global-keymap* \"C-'\" 'list-modes)" ,(second binding))) bindings))) -;; this takes a single key and not a key sequence -;; i think this could be split into 2 defmethods but ill leave it for now -(defun prefix-for-key (binding key) - "takes a keymap or a prefix, returns the prefix that corresponds to the given key (could be just BINDING)." - (check-type binding (or prefix keymap)) - (cond ((typep binding 'prefix) - (when (equal (prefix-key binding) key) - binding)) - ((typep binding 'keymap) - (loop for item in (keymap-children binding) - for p = (prefix-for-key item key) - do (when p - (return p)))))) +(defun prefix-for-key (keymap key) + "find a prefix matching KEY in KEYMAP, searching child keymaps recursively." + (or (first-prefix-match keymap key) + (loop for child in (keymap-children keymap) + thereis (prefix-for-key child key)))) (defmethod define-key-internal ((keymap keymap) keys symbol) (let* ((rest (uiop:ensure-list keys)) @@ -313,22 +334,15 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" bindings))) (defun undefine-key-internal (keymap keys) - (labels ((find-prefix-matches (km key) - "find direct prefix children of KM matching KEY." - (loop for item in (keymap-children km) - when (and (typep item 'prefix) - (prefix-active-p item) - (equal (prefix-key item) key)) - collect item)) - (search-tree (binding keys-to-find) + (labels ((search-tree (binding keys-to-find) (when (and keys-to-find (typep binding 'keymap)) - (let ((matches (find-prefix-matches binding (car keys-to-find)))) + (let ((matches (find-prefix-matches binding (car keys-to-find) :active-only t))) (loop for match in matches for suffix = (prefix-suffix match) do (if (cdr keys-to-find) (search-tree suffix (cdr keys-to-find)) - (setf (keymap-children binding) - (delete match (keymap-children binding))))))))) + (setf (keymap-prefixes binding) + (delete match (keymap-prefixes binding))))))))) (search-tree keymap keys))) (defun parse-keyspec (string) @@ -365,92 +379,82 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (defun find-in-function-table (binding key) "search function-table of keymaps in hierarchy for KEY." - (cond ((typep binding 'keymap*) - (let ((result)) - (maphash (lambda (k v) - (when (and (null result) (equal k key)) - (setf result (if (prefix-command-p v) - v - (make-prefix :key k :suffix v))))) - (keymap-function-table binding)) - ;; if found, return it; otherwise search children - (or result - (loop for child in (keymap-children binding) - thereis (or (find-in-function-table child key) - (and (typep child 'keymap*) - (keymap-undef-hook child)))) - (let ((base (keymap-base binding))) - (when base - (find-in-function-table base key)))))) - ((typep binding 'keymap) - (loop for child in (keymap-children binding) - thereis (find-in-function-table child key)) - (let ((base (keymap-base binding))) - (when base - (find-in-function-table base key)))))) - -(defun normalize-binding (found &optional parent-prefix) - (if (typep found 'prefix) - (cons (prefix-suffix found) found) - (cons found parent-prefix))) + (search-with-base + binding + (lambda (km) + (cond ((typep km 'keymap*) + (let ((result)) + (maphash (lambda (k v) + (when (and (null result) (equal k key)) + (setf result (if (prefix-command-p v) + v + (make-prefix :key k :suffix v))))) + (keymap-function-table km)) + (or result + (loop for child in (keymap-children km) + thereis (or (find-in-function-table child key) + (and (typep child 'keymap*) + (keymap-undef-hook child))))))) + ((typep km 'keymap) + (loop for child in (keymap-children km) + thereis (find-in-function-table child key))))))) (defmethod keymap-find ((keymap keymap) key) - "finds key sequence in keymap, returns (suffix . prefix)." + "finds key sequence in keymap, returns the matched prefix or nil." (let ((keyseq (etypecase key (key (list key)) (list key)))) - (labels ((search-keymap (km keys) - (when (keymap-active-p km) - (let ((prefix-matches) - (found)) - (loop for item in (keymap-children km) - do (cond - ;; child keymap: dispatch through keymap-find - ((typep item 'keymap) - (when (keymap-active-p item) - (let ((r (keymap-find item keys))) - (when r - (setf found r) - (return))))) - ;; child prefix: collect matches for current key - ((typep item 'prefix) - (when (and (prefix-active-p item) - (equal (prefix-key item) (car keys))) - (push item prefix-matches)))) - ;; when we find an undef-hook, stop searching further children - when (and (typep item 'keymap*) - (keymap-undef-hook item)) - do (return)) - (or found - ;; try collected prefix matches - (loop for match in prefix-matches - for suffix = (prefix-suffix match) - for result = (cond - ;; last key: return the binding - ((null (cdr keys)) - (normalize-binding suffix match)) - ;; more keys, suffix is a keymap: recurse through keymap-find - ((typep suffix 'keymap) - (keymap-find suffix (cdr keys))) - (t nil)) - when result return result) - ;; base keymap fallback - (let ((base (keymap-base km))) - (when base - (search-keymap base keys)))))))) - (search-keymap keymap keyseq)))) + (when (keymap-active-p keymap) + ;; collect prefix matches from the prefixes slot + (let ((prefix-matches + (loop for item in (keymap-prefixes keymap) + when (and (prefix-active-p item) + (equal (prefix-key item) (car keyseq))) + collect item)) + (found)) + ;; search nested keymaps + (loop for child in (keymap-children keymap) + when (keymap-active-p child) + do (let ((r (keymap-find child keyseq))) + (when r + (setf found r) + (return))) + ;; when we find an undef-hook, stop searching further to make find-undef-hook + ;; find the keymap instead + when (and (typep child 'keymap*) + (keymap-undef-hook child)) + do (return)) + (or found + ;; try collected prefix matches + (loop for match in prefix-matches + for suffix = (prefix-suffix match) + for result = (cond + ;; last key, return the matched prefix. + ((null (cdr keyseq)) + match) + ;; more keys, suffix is a keymap, recurse through keymap-find. + ((typep suffix 'keymap) + (keymap-find suffix (cdr keyseq))) + (t nil)) + when result + return result) + (let ((base (keymap-base keymap))) + (when base + (keymap-find base keyseq)))))))) ;; this is currently here for backwards compatibility ;; im not yet sure whether 'cmd' or function-table lookup is necessary (i think so but im not sure how to get rid of it.) (defmethod keymap-find ((keymap keymap*) key) - "finds key sequence in keymap, returns (suffix . prefix)." + "finds key sequence in keymap, returns the matched prefix or nil." (or (call-next-method) (let ((keyseq (etypecase key (key (list key)) (list key)))) (let ((result (find-in-function-table keymap (car keyseq)))) (when result - (normalize-binding result)))))) + (if (typep result 'prefix) + result + (make-prefix :key (car keyseq) :suffix result))))))) (defun insertion-key-p (key) (let* ((key (typecase key @@ -504,27 +508,33 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (defun lookup-keybind (key) (or (keymap-find *root-keymap* key) ;; find undef-hook in hierarchy (e.g. self-insert) - (normalize-binding (find-undef-hook)))) + (let ((hook (find-undef-hook))) + (when hook + (make-prefix :suffix hook))))) (defun find-keybind (key) - (let ((result (keymap-find *root-keymap* key))) - (when result - result))) + (let ((prefix (keymap-find *root-keymap* key))) + (when prefix + (prefix-suffix prefix)))) (defun traverse-keymap (keymap fun) - (labels ((f (node prefix) + (labels ((traverse-prefix (node prefix) + (let ((key (prefix-key node)) + (suffix (prefix-suffix node))) + (cond ((or (typep suffix 'keymap) + (typep suffix 'prefix)) + (traverse-node suffix (cons key prefix))) + (t + (funcall fun (reverse (cons key prefix)) suffix))))) + (traverse-node (node prefix) (cond ((typep node 'keymap) - (mapc (lambda (child) (f child prefix)) + (mapc (lambda (p) (traverse-prefix p prefix)) + (keymap-prefixes node)) + (mapc (lambda (child) (traverse-node child prefix)) (keymap-children node))) ((typep node 'prefix) - (let ((key (prefix-key node)) - (suffix (prefix-suffix node))) - (cond ((or (typep suffix 'keymap) - (typep suffix 'prefix)) - (f suffix (cons key prefix))) - (t - (funcall fun (reverse (cons key prefix)) suffix)))))))) - (f keymap nil))) + (traverse-prefix node prefix))))) + (traverse-node keymap nil))) (defun collect-command-keybindings (command keymap) (let ((bindings '())) @@ -538,7 +548,8 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (defun abort-key-p (key) (and (key-p key) - (eq *abort-key* (car (lookup-keybind key))))) + (let ((prefix (lookup-keybind key))) + (and prefix (eq *abort-key* (prefix-suffix prefix)))))) (defmacro with-special-keymap ((keymap) &body body) `(let ((*special-keymap* (or ,keymap *special-keymap*))) From 6e28acc840677b5a68cede293e13a840bad682f0 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Mon, 23 Feb 2026 10:27:01 +0200 Subject: [PATCH 44/63] handle editor-abort in suffix prompts --- extensions/transient/keymap.lisp | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 3d1a23479..2934a5719 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -129,10 +129,13 @@ the setter stores directly." (new-value)) (with-last-read-key-sequence (setf new-value - (prompt-for-string "new value: " - :initial-value current-value - :completion-function (lambda (x) - choices)))) + (handler-case + (prompt-for-string "new value: " + :initial-value current-value + :completion-function (lambda (x) + choices)) + (editor-abort () + current-value)))) (when new-value (setf (prefix-value choice) new-value))))) #'suffix)) From 7ea0eda5351c4960c95efdc2a1eca8ad91b77ba0 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Mon, 23 Feb 2026 11:40:04 +0200 Subject: [PATCH 45/63] add define-transient-key --- extensions/transient/keymap.lisp | 149 ++++++++++++++-------------- extensions/transient/transient.lisp | 1 + 2 files changed, 78 insertions(+), 72 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 2934a5719..bd1a34e95 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -189,75 +189,80 @@ the setter stores directly." (keymap-add-child keymap sub-map t))) ;; key binding (:key ...) ((eq (car binding) :key) - (let* ((key (second binding)) - (prefix-type (intern (symbol-name (if (getf binding :type) - (eval (getf binding :type)) - 'prefix)) - :lem/transient)) - (prefix (make-instance prefix-type)) - (last-keymap keymap)) - (let ((parsed-key (parse-keyspec key))) - ;; store the full key string for multi-key bindings - (when (cdr parsed-key) - (setf (prefix-display-key prefix) key)) - ;; we need to create intermediate prefixes if the key is longer than one - (loop - for cell on parsed-key - for i from 0 - for lastp = (null (cdr cell)) - for current-key = (car cell) - do (let ((current-prefix - (if lastp - prefix - ;; reuse existing intermediate prefix with same key, or create new one - (let ((existing (find - current-key - (keymap-prefixes last-keymap) - :test (lambda (k child) - (and (prefix-intermediate-p child) - (equal - k - (prefix-key child))))))) - (if existing - (progn - (setf last-keymap (prefix-suffix existing)) - existing) - (let* ((new-prefix (make-instance 'prefix)) - (new-keymap (make-keymap))) - (keymap-add-prefix last-keymap new-prefix t) - (setf (prefix-suffix new-prefix) new-keymap) - (setf (prefix-intermediate-p new-prefix) t) - (setf (keymap-show-p new-keymap) t) - (setf last-keymap new-keymap) - new-prefix)))))) - (setf (prefix-key current-prefix) current-key))) - (keymap-add-prefix last-keymap prefix t) - ;; sometimes the suffix will not be set (e.g. prefix-type is :choice). we - ;; initialize it to nil to avoid unbound errors. - (setf (prefix-suffix prefix) nil) - (loop for (key value) on (cddr binding) by 'cddr - do (let ((final-value) - (should-set t)) - (cond - ;; if the suffix is a keymap we need to parse recursively - ((and (listp value) (eq (car value) :keymap)) - (setf final-value (parse-transient (cdr value)))) - ;; variable syncing: set the variable slot on the infix - ;; we need a special case for it since its "infix-variable" and - ;; not "prefix-variable" since its a slot in the infix class. - ;; there's probably a nicer way to go about things but this is - ;; just for 'parse-transient' which is designed as a - ;; convenience anyway. - ((eq key :variable) - (setf (infix-variable prefix) (eval value)) - (setf should-set nil)) - ((eq key :type) - (setf should-set nil)) - (t - (setf final-value value))) - (when should-set - (parse-transient-method prefix - key - final-value - "PREFIX")))))))))) - keymap)) \ No newline at end of file + (define-transient-key keymap (second binding) + (cddr binding)))))) + keymap)) + +(defun define-transient-key (keymap key &optional args) + "add a key binding to an existing transient KEYMAP. +accepts the same keyword args as a (:key ...) entry in `define-transient'." + (let* ((prefix-type (intern (symbol-name (if (getf args :type) + (eval (getf args :type)) + 'prefix)) + :lem/transient)) + (prefix (make-instance prefix-type)) + (last-keymap keymap)) + (let ((parsed-key (parse-keyspec key))) + ;; store the full key string for multi-key bindings + (when (cdr parsed-key) + (setf (prefix-display-key prefix) key)) + ;; we need to create intermediate prefixes if the key is longer than one + (loop + for cell on parsed-key + for i from 0 + for lastp = (null (cdr cell)) + for current-key = (car cell) + do (let ((current-prefix + (if lastp + prefix + ;; reuse existing intermediate prefix with same key, or create new one + (let ((existing (find + current-key + (keymap-prefixes last-keymap) + :test (lambda (k child) + (and (prefix-intermediate-p child) + (equal + k + (prefix-key child))))))) + (if existing + (progn + (setf last-keymap (prefix-suffix existing)) + existing) + (let* ((new-prefix (make-instance 'prefix)) + (new-keymap (make-keymap))) + (keymap-add-prefix last-keymap new-prefix t) + (setf (prefix-suffix new-prefix) new-keymap) + (setf (prefix-intermediate-p new-prefix) t) + (setf (keymap-show-p new-keymap) t) + (setf last-keymap new-keymap) + new-prefix)))))) + (setf (prefix-key current-prefix) current-key))) + (keymap-add-prefix last-keymap prefix t) + ;; sometimes the suffix will not be set (e.g. prefix-type is :choice). we + ;; initialize it to nil to avoid unbound errors. + (setf (prefix-suffix prefix) nil) + (loop for (key value) on args by 'cddr + do (let ((final-value) + (should-set t)) + (cond + ;; if the suffix is a keymap we need to parse recursively + ((and (listp value) (eq (car value) :keymap)) + (setf final-value (parse-transient (cdr value)))) + ;; variable syncing: set the variable slot on the infix + ;; we need a special case for it since its "infix-variable" and + ;; not "prefix-variable" since its a slot in the infix class. + ;; there's probably a nicer way to go about things but this is + ;; just for 'parse-transient' which is designed as a + ;; convenience anyway. + ((eq key :variable) + (setf (infix-variable prefix) (eval value)) + (setf should-set nil)) + ((eq key :type) + (setf should-set nil)) + (t + (setf final-value value))) + (when should-set + (parse-transient-method prefix + key + final-value + "PREFIX"))))))) \ No newline at end of file diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp index 2fff43c77..431db327f 100644 --- a/extensions/transient/transient.lisp +++ b/extensions/transient/transient.lisp @@ -2,6 +2,7 @@ (:use :cl :lem) (:export :define-transient + :define-transient-key :mode-transient-keymap :prefix-value :prefix-render From d811a8bc7ff0b7aafc690abcc96df38aa225ecb4 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Tue, 24 Feb 2026 20:49:11 +0200 Subject: [PATCH 46/63] indentation --- extensions/transient/keymap.lisp | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index bd1a34e95..a11e31155 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -189,8 +189,7 @@ the setter stores directly." (keymap-add-child keymap sub-map t))) ;; key binding (:key ...) ((eq (car binding) :key) - (define-transient-key keymap (second binding) - (cddr binding)))))) + (define-transient-key keymap (second binding) (cddr binding)))))) keymap)) (defun define-transient-key (keymap key &optional args) From 6db325d55bccf4b6988db23507749e24dba974b3 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Mon, 9 Mar 2026 09:24:33 +0200 Subject: [PATCH 47/63] add define-prefix, add post-command hook to update popup --- extensions/transient/keymap.lisp | 57 +++++++++++++++++++++++++++-- extensions/transient/popup.lisp | 15 ++++++-- extensions/transient/transient.lisp | 4 ++ 3 files changed, 68 insertions(+), 8 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index a11e31155..2dc2395d6 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -148,6 +148,9 @@ the setter stores directly." (defmacro define-transient (name &body bindings) `(defparameter ,name (parse-transient ',bindings))) +(defmacro define-prefix (name &body args) + `(defparameter ,name (parse-prefix ',args))) + (defun parse-transient-method (object key val method-name) (let* ((key-string (string key)) (key-method (intern (format nil "~A-~A" method-name key-string) :lem/transient)) @@ -183,6 +186,12 @@ the setter stores directly." (parse-transient-method keymap binding val "KEYMAP") ;; advance another cell because we're already consumed it (second tail) (setf tail (cdr tail)))) + ;; if its a symbol we evaluate it as a variable that might be a prefix + ((and (symbolp binding) (typep (symbol-value binding) 'prefix)) + (keymap-add-prefix keymap (symbol-value binding))) + ;; if its a symbol and evaluates to a keymap, we add it as a child + ((and (symbolp binding) (typep (symbol-value binding) 'keymap)) + (keymap-add-child keymap (symbol-value binding))) ;; direct child keymap (:keymap ...) ((eq (car binding) :keymap) (let ((sub-map (parse-transient (cdr binding)))) @@ -192,6 +201,45 @@ the setter stores directly." (define-transient-key keymap (second binding) (cddr binding)))))) keymap)) +;; since in this function we dont have the context of the parent keymap, it doesnt support +;; multi-key sequences (intermediate prefixes), unlike define-transient-key. +;; TODO: DRY this with `define-transient-key'. +(defun parse-prefix (args) + (let* ((prefix-type + (intern (symbol-name + (if (getf args :type) + (eval (getf args :type)) + 'prefix)) + :lem/transient)) + (key (getf args :key)) + (prefix (make-instance prefix-type)) + (parsed-key (parse-keyspec key))) + (setf (prefix-key prefix) (car parsed-key)) + (setf (prefix-suffix prefix) nil) + (loop for (key value) on args by 'cddr + do (let ((final-value) + (should-set t)) + (cond + ((and (listp value) (eq (car value) :keymap)) + (setf final-value (parse-transient (cdr value)))) + ((eq key :variable) + (setf (infix-variable prefix) (eval value)) + (setf should-set nil)) + ((eq key :type) + (setf should-set nil)) + ;; key has already been handled + ((eq key :key) + (setf should-set nil)) + (t + (setf final-value value))) + (when should-set + (parse-transient-method + prefix + key + final-value + "PREFIX")))) + prefix)) + (defun define-transient-key (keymap key &optional args) "add a key binding to an existing transient KEYMAP. accepts the same keyword args as a (:key ...) entry in `define-transient'." @@ -261,7 +309,8 @@ accepts the same keyword args as a (:key ...) entry in `define-transient'." (t (setf final-value value))) (when should-set - (parse-transient-method prefix - key - final-value - "PREFIX"))))))) \ No newline at end of file + (parse-transient-method + prefix + key + final-value + "PREFIX"))))))) \ No newline at end of file diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 07108418d..02f3248b7 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -90,9 +90,9 @@ return prefix))) (define-minor-mode transient-mode - (:name "transient-mode" - :global t - :keymap *transient-mode-keymap*)) + (:name "transient-mode" + :global t + :keymap *transient-mode-keymap*)) (defstruct layout-separator "a visual separator between items.") @@ -521,4 +521,11 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key (setf *transient-popup-window* nil) (setf *transient-shown-keymap* nil) (transient-mode nil) - (redraw-display))) \ No newline at end of file + (redraw-display))) + +(add-hook *post-command-hook* 'transient-post-command-update) +(defun transient-post-command-update () + ;; its not ideal that we are invoking keymap-activate again on the keymap but until we rewrite + ;; the event handler this is necessary to keep the popup updated depending on the context change + ;; that happens every time a command is executed. + (keymap-activate *transient-shown-keymap*)) \ No newline at end of file diff --git a/extensions/transient/transient.lisp b/extensions/transient/transient.lisp index 431db327f..5600bc852 100644 --- a/extensions/transient/transient.lisp +++ b/extensions/transient/transient.lisp @@ -2,6 +2,8 @@ (:use :cl :lem) (:export :define-transient + :define-prefix + :parse-prefix :define-transient-key :mode-transient-keymap :prefix-value @@ -11,6 +13,8 @@ :make-key-with-highlight :transient-bracket-attribute :transient-value-attribute + :prefix-active-p + :prefix-suffix :transient-mode :*transient-mode-keymap*)) From 46ebbbed242258485493344abb08e935c9a20174 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Mon, 9 Mar 2026 17:52:34 +0200 Subject: [PATCH 48/63] fix issue: self-insert was being invoked when it shouldnt have been --- src/keymap.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/keymap.lisp b/src/keymap.lisp index 183815be7..003fab6e7 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -457,6 +457,8 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (make-prefix :key (car keyseq) :suffix result))))))) (defun insertion-key-p (key) + (when (and (listp key) (cdr key)) + (return-from insertion-key-p nil)) (let* ((key (typecase key (list (first key)) (otherwise key))) From 1a42a5e882324bd7f34e2dc1f69dce83ded0d7dd Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 12 Mar 2026 06:17:19 +0200 Subject: [PATCH 49/63] show maps that have show-p set, regardless of mode --- extensions/transient/keymap.lisp | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 2dc2395d6..7fd8b45e6 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -3,18 +3,21 @@ (defmethod keymap-activate ((keymap keymap)) "called when a keymap is activated by the event scheduler." (let ((active-modes (all-active-modes (current-buffer)))) - (cond ((loop for mode in active-modes - for mode-keymap = (mode-transient-keymap mode) - when mode-keymap - do (show-transient - (if (keymap-contains-p mode-keymap keymap) - keymap - mode-keymap)) - (return t))) - ((or (keymap-show-p keymap) *transient-always-show*) - (show-transient keymap)) - (t - (hide-transient))))) + (cond + ((keymap-show-p keymap) + (show-transient keymap)) + ((loop for mode in active-modes + for mode-keymap = (mode-transient-keymap mode) + when mode-keymap + do (show-transient + (if (keymap-contains-p mode-keymap keymap) + keymap + mode-keymap)) + (return t))) + (*transient-always-show* + (show-transient keymap)) + (t + (hide-transient))))) (defgeneric mode-transient-keymap (mode) (:documentation "returns the keymap to be passed to show-transient.") From b69ae342b4e99707e89cc664a2119a5623a47a0d Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 18 Mar 2026 00:18:50 +0200 Subject: [PATCH 50/63] use defvar instead of defparameter to avoid issues on recomp --- extensions/transient/keymap.lisp | 4 ++-- src/keymap.lisp | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index 7fd8b45e6..e23ea9182 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -149,10 +149,10 @@ the setter stores directly." #'suffix)) (defmacro define-transient (name &body bindings) - `(defparameter ,name (parse-transient ',bindings))) + `(defvar ,name (parse-transient ',bindings))) (defmacro define-prefix (name &body args) - `(defparameter ,name (parse-prefix ',args))) + `(defvar ,name (parse-prefix ',args))) (defun parse-transient-method (object key val method-name) (let* ((key-string (string key)) diff --git a/src/keymap.lisp b/src/keymap.lisp index 003fab6e7..64c67f1e8 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -491,7 +491,7 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (push *special-keymap* keymaps)) (delete-duplicates keymaps :from-end t))) -(defparameter *other-keymaps-root* +(defvar *other-keymaps-root* (make-instance 'keymap :description '*other-keymaps-root*)) ;; this is for some "other" keymaps that i need to inject into the root-keymap (atleast this way for now). From 5bda002a9dbe042d6e1bb35a24d1429d5b3ee46b Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 20 Mar 2026 17:13:00 +0200 Subject: [PATCH 51/63] fix handling of undef-hook handling of undef-hook wasnt right which caused C-n/C-p not to work for prompt completion. undef-hook is a leftover from previous keymap code and i should think of a way to rewrite its functionality that is more ideal. --- src/keymap.lisp | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/src/keymap.lisp b/src/keymap.lisp index 64c67f1e8..6fbaeda09 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -376,7 +376,6 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" str)))))))) (mapcar #'parse (uiop:split-string string :separator " ")))) - (defun find-in-function-table (binding key) "search function-table of keymaps in hierarchy for KEY." (search-with-base @@ -411,20 +410,32 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" when (and (prefix-active-p item) (equal (prefix-key item) (car keyseq))) collect item)) - (found)) + (prefix-found) + (undef-hook-keymap)) ;; search nested keymaps (loop for child in (keymap-children keymap) when (keymap-active-p child) do (let ((r (keymap-find child keyseq))) (when r - (setf found r) + (setf prefix-found r) (return))) - ;; when we find an undef-hook, stop searching further to make find-undef-hook - ;; find the keymap instead - when (and (typep child 'keymap*) - (keymap-undef-hook child)) - do (return)) - (or found + ;; record first undef-hook keymap but continue searching + ;; so that function-table remapping can resolve against the base command + (when (and (not undef-hook-keymap) + (typep child 'keymap*) + (keymap-undef-hook child)) + (setf undef-hook-keymap child))) + ;; if a higher-priority keymap had a undef-hook, apply function-table remapping + ;; or fall back to the undef-hook (priority: remap > undef-hook > base cmd). + (when (and undef-hook-keymap prefix-found) + (let* ((cmd (prefix-suffix prefix-found)) + (remapped (gethash cmd (keymap-function-table undef-hook-keymap)))) + (if remapped + (setf prefix-found (make-prefix :key (prefix-key prefix-found) :suffix remapped)) + (setf prefix-found (make-prefix :suffix (keymap-undef-hook undef-hook-keymap)))))) + (or prefix-found + (when undef-hook-keymap + (make-prefix :suffix (keymap-undef-hook undef-hook-keymap))) ;; try collected prefix matches (loop for match in prefix-matches for suffix = (prefix-suffix match) @@ -502,15 +513,12 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (cons *other-keymaps-root* (slot-value keymap 'children))) -(defun find-undef-hook () - (loop for km in (other-keymaps) - when (and (typep km 'keymap*) (keymap-undef-hook km)) - return (keymap-undef-hook km))) - (defun lookup-keybind (key) (or (keymap-find *root-keymap* key) ;; find undef-hook in hierarchy (e.g. self-insert) - (let ((hook (find-undef-hook))) + (let ((hook (loop for km in (other-keymaps) + when (and (typep km 'keymap*) (keymap-undef-hook km)) + return (keymap-undef-hook km)))) (when hook (make-prefix :suffix hook))))) From 40ab03975ca6b6fce6b823503a270d57bb291f56 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Sat, 21 Mar 2026 20:11:22 +0200 Subject: [PATCH 52/63] set popup max-lines to 10 instead of 15 by default --- extensions/transient/popup.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 02f3248b7..1dae03507 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -8,7 +8,7 @@ "the last keymap passed to show-transient. used to detect same-keymap redraws and preserve scroll position.") (defvar *transient-popup-max-lines* - 15 + 10 "max height of the transient buffer (measured in lines).") (defvar *transient-vertical-scroll-amount* From 1610e48ee5f0d198c4af94f160a2fbdea8cb1b74 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 26 Mar 2026 11:46:41 +0200 Subject: [PATCH 53/63] fix undef-hook/function-table edge case --- src/keymap.lisp | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/src/keymap.lisp b/src/keymap.lisp index 6fbaeda09..12ed5a30a 100644 --- a/src/keymap.lisp +++ b/src/keymap.lisp @@ -398,6 +398,23 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (loop for child in (keymap-children km) thereis (find-in-function-table child key))))))) +;; TODO: this search exists because the old sequential keymap code +;; accumulated `cmd' across keymaps, so function-table remapping (e.g. +;; self-insert -> undefined-key in vi *motion-keymap*) happened naturally. +;; the new tree-based keymap-find doesn't accumulate, so we need this explicit +;; search. ideally function-table remapping should be replaced with a mechanism +;; that fits the new keymap design (e.g. prefix properties or keymap flags). +(defun remap-command-in-keymap (keymap cmd) + "search KEYMAP and its children's function-tables for a remapping of CMD. +used to check if a undef-hook command (e.g. self-insert) is remapped by a +higher-priority keymap (e.g. vi normal mode remaps self-insert to undefined-key)." + (or (when (typep keymap 'keymap*) + (gethash cmd (keymap-function-table keymap))) + (dolist (child (keymap-children keymap)) + (when (keymap-active-p child) + (let ((result (remap-command-in-keymap child cmd))) + (when result (return result))))))) + (defmethod keymap-find ((keymap keymap) key) "finds key sequence in keymap, returns the matched prefix or nil." (let ((keyseq (etypecase key @@ -435,7 +452,9 @@ Example: (undefine-key *paredit-mode-keymap* \"C-k\")" (setf prefix-found (make-prefix :suffix (keymap-undef-hook undef-hook-keymap)))))) (or prefix-found (when undef-hook-keymap - (make-prefix :suffix (keymap-undef-hook undef-hook-keymap))) + (let* ((hook (keymap-undef-hook undef-hook-keymap)) + (remapped (remap-command-in-keymap keymap hook))) + (make-prefix :suffix (or remapped hook)))) ;; try collected prefix matches (loop for match in prefix-matches for suffix = (prefix-suffix match) From 62201d295d2988b83f9a975c58450abbcba43190 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Mon, 30 Mar 2026 00:05:02 +0300 Subject: [PATCH 54/63] fix popup behavior when switching buffers --- extensions/transient/keymap.lisp | 25 +++++++++++++------------ extensions/transient/popup.lisp | 5 ++++- 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/extensions/transient/keymap.lisp b/extensions/transient/keymap.lisp index e23ea9182..fd32a6f21 100644 --- a/extensions/transient/keymap.lisp +++ b/extensions/transient/keymap.lisp @@ -1,23 +1,24 @@ (in-package :lem/transient) -(defmethod keymap-activate ((keymap keymap)) - "called when a keymap is activated by the event scheduler." +(defun resolve-transient-keymap (&optional keymap) (let ((active-modes (all-active-modes (current-buffer)))) (cond - ((keymap-show-p keymap) - (show-transient keymap)) + ((and keymap (keymap-show-p keymap)) + keymap) ((loop for mode in active-modes for mode-keymap = (mode-transient-keymap mode) when mode-keymap - do (show-transient - (if (keymap-contains-p mode-keymap keymap) - keymap - mode-keymap)) - (return t))) + return (if (and keymap (keymap-contains-p mode-keymap keymap)) + keymap + mode-keymap))) (*transient-always-show* - (show-transient keymap)) - (t - (hide-transient))))) + keymap)))) + +(defmethod keymap-activate ((keymap keymap)) + (let ((resolved (resolve-transient-keymap keymap))) + (if resolved + (show-transient resolved) + (hide-transient)))) (defgeneric mode-transient-keymap (mode) (:documentation "returns the keymap to be passed to show-transient.") diff --git a/extensions/transient/popup.lisp b/extensions/transient/popup.lisp index 1dae03507..ee5cb0664 100644 --- a/extensions/transient/popup.lisp +++ b/extensions/transient/popup.lisp @@ -528,4 +528,7 @@ prefixes marked as :intermediate-p are flattened and shown with concatenated key ;; its not ideal that we are invoking keymap-activate again on the keymap but until we rewrite ;; the event handler this is necessary to keep the popup updated depending on the context change ;; that happens every time a command is executed. - (keymap-activate *transient-shown-keymap*)) \ No newline at end of file + (let ((resolved (resolve-transient-keymap))) + (if resolved + (show-transient resolved) + (hide-transient)))) \ No newline at end of file From 812edab6c21e98a114ae3c6990fc03d6f8e192ea Mon Sep 17 00:00:00 2001 From: mahmoodsh36 Date: Wed, 24 Dec 2025 22:18:47 +0200 Subject: [PATCH 55/63] add organ-mode/cltpt as deps --- lem.asd | 2 ++ qlfile | 2 ++ qlfile.lock | 8 ++++++++ 3 files changed, 12 insertions(+) diff --git a/lem.asd b/lem.asd index d00b0d04c..3dcd1c80b 100644 --- a/lem.asd +++ b/lem.asd @@ -33,6 +33,7 @@ "dexador" "cl-mustache" ;; "lem-encodings" + "cltpt" #+sbcl sb-concurrency "lem-mailbox" @@ -296,6 +297,7 @@ "lem-copilot" "lem-claude-code" "lem-bookmark" + "organ-mode" "lem-mcp-server" "lem-transient" #+sbcl diff --git a/qlfile b/qlfile index 35498f370..9ee4fa32b 100644 --- a/qlfile +++ b/qlfile @@ -10,4 +10,6 @@ git cl-sdl2-image https://github.com/lem-project/cl-sdl2-image.git git jsonrpc https://github.com/cxxxr/jsonrpc.git git lem-extension-manager https://github.com/lem-project/lem-extension-manager.git git webview https://github.com/lem-project/webview.git +git cltpt https://github.com/mahmoodsh36/cltpt +git organ-mode https://github.com/mahmoodsh36/organ-mode git tree-sitter-cl https://github.com/lem-project/tree-sitter-cl.git diff --git a/qlfile.lock b/qlfile.lock index 8568cc4c6..7fc94c373 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -50,6 +50,14 @@ (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/webview.git") :version "git-607daff93e9e716a76c5dbd08c48b5233c96b9a3")) +("cltpt" . + (:class qlot/source/git:source-git + :initargs (:remote-url "https://github.com/mahmoodsh36/cltpt") + :version "git-f622fde30464b770f52c74f116f4973009a3f142")) +("organ-mode" . + (:class qlot/source/git:source-git + :initargs (:remote-url "https://github.com/mahmoodsh36/organ-mode") + :version "git-b62d3a101c119e8bc2b8eaae07226898155c8a87")) ("tree-sitter-cl" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/tree-sitter-cl.git") From 6f548f335c47205ff84f58ab5998abac2f08f7d4 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Thu, 12 Feb 2026 20:55:34 +0200 Subject: [PATCH 56/63] update cltpt/organ-mode versions --- qlfile.lock | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qlfile.lock b/qlfile.lock index 7fc94c373..99f0e12f0 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -53,11 +53,11 @@ ("cltpt" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/cltpt") - :version "git-f622fde30464b770f52c74f116f4973009a3f142")) + :version "git-0ed6b5bbe1f52c4a21167d1bf5e888a853d2c656")) ("organ-mode" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/organ-mode") - :version "git-b62d3a101c119e8bc2b8eaae07226898155c8a87")) + :version "git-182b38d9bad90df2460c17d69c2901a07bd6364c")) ("tree-sitter-cl" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/tree-sitter-cl.git") From b979c8d67a1b15d95fb0dadfe957540f6a6a4303 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Tue, 17 Feb 2026 16:50:12 +0200 Subject: [PATCH 57/63] update cltpt/organ-mode versions --- qlfile.lock | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qlfile.lock b/qlfile.lock index 99f0e12f0..bf2821b6e 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -53,11 +53,11 @@ ("cltpt" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/cltpt") - :version "git-0ed6b5bbe1f52c4a21167d1bf5e888a853d2c656")) + :version "git-c63b0aff8a4b6251dd8d0d0bb889dfeae76b3dc4")) ("organ-mode" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/organ-mode") - :version "git-182b38d9bad90df2460c17d69c2901a07bd6364c")) + :version "git-9c7dcc815eb1241445ad188557c4c573353c8987")) ("tree-sitter-cl" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/tree-sitter-cl.git") From 8e373c4ccf72bf8fb9bf6e81869daf4f2ef4cdef Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Wed, 25 Feb 2026 22:35:59 +0200 Subject: [PATCH 58/63] update cltpt/organ-mode versions --- qlfile.lock | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qlfile.lock b/qlfile.lock index bf2821b6e..dff8ca517 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -53,11 +53,11 @@ ("cltpt" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/cltpt") - :version "git-c63b0aff8a4b6251dd8d0d0bb889dfeae76b3dc4")) + :version "git-6f486cbe501fb6013c55e22b5c46d81f31300225")) ("organ-mode" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/organ-mode") - :version "git-9c7dcc815eb1241445ad188557c4c573353c8987")) + :version "git-fe825feb9a201fc9e699d8a2de705c478b8d65ba")) ("tree-sitter-cl" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/tree-sitter-cl.git") From c7e86af42b23676b018c022e0b44b1c3177f1ba2 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 6 Mar 2026 00:04:32 +0200 Subject: [PATCH 59/63] update organ-mode/cltpt versions --- qlfile.lock | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qlfile.lock b/qlfile.lock index dff8ca517..6483544fa 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -53,11 +53,11 @@ ("cltpt" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/cltpt") - :version "git-6f486cbe501fb6013c55e22b5c46d81f31300225")) + :version "git-b87e82b7c8d71650d4de4a7f9ada453bcafbc0e2")) ("organ-mode" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/organ-mode") - :version "git-fe825feb9a201fc9e699d8a2de705c478b8d65ba")) + :version "git-70116210af61e0052edf22b64a11febc4359335d")) ("tree-sitter-cl" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/tree-sitter-cl.git") From 56d107141729b5a606b615e902dc5f1cb3449e68 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Mon, 9 Mar 2026 19:43:15 +0200 Subject: [PATCH 60/63] update organ-mode/cltpt versions --- qlfile.lock | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qlfile.lock b/qlfile.lock index 6483544fa..ae981fbec 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -53,11 +53,11 @@ ("cltpt" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/cltpt") - :version "git-b87e82b7c8d71650d4de4a7f9ada453bcafbc0e2")) + :version "git-ecc6a4ec12866c334479762566d5521385fe9548")) ("organ-mode" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/organ-mode") - :version "git-70116210af61e0052edf22b64a11febc4359335d")) + :version "git-49eea12381f528d83fe7dd67f86423a3806e37a8")) ("tree-sitter-cl" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/tree-sitter-cl.git") From 5e7ec7b50977cbe40dd01172cf2e6a6dae97873d Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Fri, 13 Mar 2026 10:59:33 +0200 Subject: [PATCH 61/63] bump organ-mode/cltpt versions --- qlfile.lock | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/qlfile.lock b/qlfile.lock index ae981fbec..9991c6f99 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -53,11 +53,11 @@ ("cltpt" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/cltpt") - :version "git-ecc6a4ec12866c334479762566d5521385fe9548")) + :version "git-38a3a8b04844087034b53f2f437f312b24ca7ed0")) ("organ-mode" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/organ-mode") - :version "git-49eea12381f528d83fe7dd67f86423a3806e37a8")) + :version "git-62c4da02172ccd9a3ba0f49def1eb0d8dd78690e")) ("tree-sitter-cl" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/tree-sitter-cl.git") From 01728b9fa8e3991aa24b552affbb8f8b9faa7811 Mon Sep 17 00:00:00 2001 From: mahmoodsheikh36 Date: Tue, 17 Mar 2026 01:45:23 +0200 Subject: [PATCH 62/63] bump organ-mode/cltpt versions --- qlfile.lock | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/qlfile.lock b/qlfile.lock index 9991c6f99..d2952095b 100644 --- a/qlfile.lock +++ b/qlfile.lock @@ -57,7 +57,7 @@ ("organ-mode" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/mahmoodsh36/organ-mode") - :version "git-62c4da02172ccd9a3ba0f49def1eb0d8dd78690e")) + :version "git-7ba39adbc7e61d03a61b2a5e64cd862ca11eea57")) ("tree-sitter-cl" . (:class qlot/source/git:source-git :initargs (:remote-url "https://github.com/lem-project/tree-sitter-cl.git") From 83616683182fa67826e2074280ee6f6293909cd3 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" Date: Sun, 29 Mar 2026 21:11:21 +0000 Subject: [PATCH 63/63] update docs/default-keybindings.md --- docs/default-keybindings.md | 58 ++++++++++++++++++------------------- 1 file changed, 29 insertions(+), 29 deletions(-) diff --git a/docs/default-keybindings.md b/docs/default-keybindings.md index c3145a20d..416ef3086 100644 --- a/docs/default-keybindings.md +++ b/docs/default-keybindings.md @@ -1,20 +1,20 @@ ## Move | Command | Key bindings | Documentation | |---------------------------------------------------------------------------------------------------------------|---------------|-------------------------------------------------------| -| [next-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L66) | C-n, Down | Move the cursor to next line. | +| [next-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L66) | Down, C-n | Move the cursor to next line. | | [next-logical-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L73) | | Move the cursor to the next logical line. | -| [previous-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L80) | C-p, Up | Move the cursor to the previous line. | +| [previous-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L80) | Up, C-p | Move the cursor to the previous line. | | [previous-logical-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L84) | | Move the cursor to the previous logical line. | -| [forward-char](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L88) | C-f, Right | Move the cursor to the next character. | -| [backward-char](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L94) | C-b, Left | Move the cursor to the previous character. | -| [move-to-beginning-of-buffer](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L99) | M-<, C-Home | Move the cursor to the beginning of the buffer. | -| [move-to-end-of-buffer](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L104) | M->, C-End | Move the cursor to the end of the buffer. | -| [move-to-beginning-of-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L109) | C-a, Home | Move the cursor to the beginning of the line. | +| [forward-char](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L88) | Right, C-f | Move the cursor to the next character. | +| [backward-char](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L94) | Left, C-b | Move the cursor to the previous character. | +| [move-to-beginning-of-buffer](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L99) | C-Home, M-< | Move the cursor to the beginning of the buffer. | +| [move-to-end-of-buffer](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L104) | C-End, M-> | Move the cursor to the end of the buffer. | +| [move-to-beginning-of-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L109) | Home, C-a | Move the cursor to the beginning of the line. | | [move-to-beginning-of-logical-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L125) | | Move the cursor to the beginning of the logical line. | -| [move-to-end-of-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L129) | C-e, End | Move the cursor to the end of the line. | +| [move-to-end-of-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L129) | End, C-e | Move the cursor to the end of the line. | | [move-to-end-of-logical-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L135) | | Move the cursor to the end of the logical line. | -| [next-page](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L139) | C-v, PageDown | Move the cursor to the next page by one page. | -| [previous-page](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L147) | M-v, PageUp | Move the cursor to the previous page by one page. | +| [next-page](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L139) | PageDown, C-v | Move the cursor to the next page by one page. | +| [previous-page](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L147) | PageUp, M-v | Move the cursor to the previous page by one page. | | [next-page-char](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L155) | C-x ] | Move the cursor to the next page character (^L). | | [previous-page-char](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L165) | C-x [ | Move the cursor to the previous page character (^L). | | [goto-line](https://github.com/lem-project/lem/blob/main/src/commands/move.lisp#L169) | M-g | Move the cursor to the specified line number. | @@ -26,8 +26,8 @@ | [newline](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L100) | Return | Insert a new line. | | [open-line](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L104) | C-o | Insert a new line without moving the cursor position. | | [quoted-insert](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L108) | C-q | Insert the next entered key (including control characters). | -| [delete-next-char](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L123) | C-d, Delete | Delete the next character. | -| [delete-previous-char](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L146) | C-h, Backspace | Delete the previous character. | +| [delete-next-char](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L123) | Delete, C-d | Delete the next character. | +| [delete-previous-char](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L146) | Backspace, C-h | Delete the previous character. | | [copy-region](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L160) | M-w | Copy the text of region. | | [copy-region-to-clipboard](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L166) | | Copy the selected text to the clipboard. | | [kill-region](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L178) | C-w | Kill the text of region. | @@ -49,7 +49,7 @@ current line. | [delete-indentation](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L356) | M-^ | Merge the current line with the previous line. | | [transpose-characters](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L376) | C-t | Swaps the characters before and after the cursor. | | [undo](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L393) | C-\ | Undo. | -| [redo](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L400) | C-_, C-/ | Redo. | +| [redo](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L400) | C-/, C-_ | Redo. | | [delete-trailing-whitespace](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L427) | | Removes all end-of-line and end-of-buffer whitespace from the current buffer. | | [mark-and-forward-char](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L482) | Shift-Right | Sets a mark if none is set, then moves cursor forward by n characters | | [mark-and-backward-char](https://github.com/lem-project/lem/blob/main/src/commands/edit.lisp#L488) | Shift-Left | Sets a mark if none is set, then moves cursor backward by n characters | @@ -59,17 +59,17 @@ current line. ## Mark | Command | Key bindings | Documentation | |--------------------------------------------------------------------------------------------------|--------------|----------------------------------------------------------------| -| [mark-set](https://github.com/lem-project/lem/blob/main/src/commands/mark.lisp#L15) | C-@, C-Space | Sets a mark at the current cursor position. | +| [mark-set](https://github.com/lem-project/lem/blob/main/src/commands/mark.lisp#L15) | C-Space, C-@ | Sets a mark at the current cursor position. | | [exchange-point-mark](https://github.com/lem-project/lem/blob/main/src/commands/mark.lisp#L23) | C-x C-x | Exchange the current cursor position with the marked position. | | [mark-set-whole-buffer](https://github.com/lem-project/lem/blob/main/src/commands/mark.lisp#L31) | C-x h | Select the whole buffer as a region. | ## Word | Command | Key bindings | Documentation | |--------------------------------------------------------------------------------------------------|---------------------------------|-----------------------------------------------------------| -| [forward-word](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L84) | M-f, C-Right | Move to cursor to next word. | -| [previous-word](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L88) | M-b, C-Left | Move to cursor to previous word | -| [delete-word](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L92) | M-d, C-Delete | Delete the next word. | -| [backward-delete-word](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L106) | M-C-h, M-Backspace, C-Backspace | Delete the previous word. | +| [forward-word](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L84) | C-Right, M-f | Move to cursor to next word. | +| [previous-word](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L88) | C-Left, M-b | Move to cursor to previous word | +| [delete-word](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L92) | C-Delete, M-d | Delete the next word. | +| [backward-delete-word](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L106) | C-Backspace, M-Backspace, M-C-h | Delete the previous word. | | [downcase-region](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L137) | C-x C-l | Replaces the selected region with a downcase. | | [uppercase-region](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L141) | C-x C-u | Replaces the selected region with a uppercase. | | [capitalize-word](https://github.com/lem-project/lem/blob/main/src/commands/word.lisp#L162) | M-c | Replace the following word with capital-case. | @@ -89,7 +89,7 @@ current line. | [backward-list](https://github.com/lem-project/lem/blob/main/src/commands/s-expression.lisp#L49) | M-C-p | Move the cursor to the backward list. | | [down-list](https://github.com/lem-project/lem/blob/main/src/commands/s-expression.lisp#L53) | M-C-d | Move the cursor to the inner expression. | | [up-list](https://github.com/lem-project/lem/blob/main/src/commands/s-expression.lisp#L57) | M-C-u | Move the cursor to the outer expression. | -| [mark-sexp](https://github.com/lem-project/lem/blob/main/src/commands/s-expression.lisp#L62) | M-C-@, M-C-Space | Select the forward expression as a region. | +| [mark-sexp](https://github.com/lem-project/lem/blob/main/src/commands/s-expression.lisp#L62) | M-C-Space, M-C-@ | Select the forward expression as a region. | | [kill-sexp](https://github.com/lem-project/lem/blob/main/src/commands/s-expression.lisp#L72) | M-C-k | Kill the forward expression as a region. | | [transpose-sexps](https://github.com/lem-project/lem/blob/main/src/commands/s-expression.lisp#L81) | M-C-t | Swaps the expression before and after the cursor. | @@ -152,7 +152,7 @@ Supported modes include: c-mode with clang-format, go-mode with gofmt, js-mode a | [recenter](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L120) | C-l | Scroll so that the cursor is in the middle. | | [split-active-window-vertically](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L134) | C-x 2 | Split the current window vertically. | | [split-active-window-horizontally](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L140) | C-x 3 | Split the current window horizontally. | -| [next-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L146) | C-x o, M-o | Go to the next window. | +| [next-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L146) | M-o, C-x o | Go to the next window. | | [previous-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L158) | M-O | | | [switch-to-last-focused-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L161) | | Go to the window that was last in focus. | | [window-move-down](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L169) | | Go to the window below. | @@ -160,14 +160,14 @@ Supported modes include: c-mode with clang-format, go-mode with gofmt, js-mode a | [window-move-right](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L179) | | Go to the window on the right. | | [window-move-left](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L184) | | Go to the window on the left. | | [delete-other-windows](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L189) | C-x 1 | Delete all other windows. | -| [delete-active-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L214) | C-x 0, M-q | Delete the active window. | +| [delete-active-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L214) | M-q, C-x 0 | Delete the active window. | | [quit-active-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L222) | | Quit the active window. This is a command for a popped-up window. | | [grow-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L227) | C-x ^ | Grow the window's height. | | [shrink-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L235) | C-x C-z | Shrink the window's height. | | [grow-window-horizontally](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L243) | C-x } | Grow the window's width. | | [shrink-window-horizontally](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L251) | C-x { | Shrink the window's width. | -| [scroll-down](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L262) | C-Down, M-Down | Scroll down. | -| [scroll-up](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L276) | C-Up, M-Up | Scroll up. | +| [scroll-down](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L262) | M-Down, C-Down | Scroll down. | +| [scroll-up](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L276) | M-Up, C-Up | Scroll up. | | [find-file-next-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L288) | C-x 4 f | Open a file in another window. Split the screen vertically if needed. | | [read-file-next-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L289) | C-x 4 r | Read a file in another window. | | [select-buffer-next-window](https://github.com/lem-project/lem/blob/main/src/commands/window.lisp#L290) | C-x 4 b | Select a buffer in another window. | @@ -188,11 +188,11 @@ Supported modes include: c-mode with clang-format, go-mode with gofmt, js-mode a | Command | Key bindings | Documentation | |----------------------------------------------------------------------------------------------|--------------|------------------------------------------------------------------------------| | [describe-key](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L15) | C-x ? | Tell what is the command associated to a keybinding. | -| [describe-bindings](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L44) | | Describe the bindings of the buffer's current major mode. | -| [list-modes](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L66) | | Output all available major and minor modes. | -| [describe-mode](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L87) | | Show information about current major mode and enabled minor modes. | -| [apropos-command](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L113) | | Find all symbols in the running Lisp image whose names match a given string. | -| [lem-version](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L124) | | Display Lem's version. | +| [describe-bindings](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L43) | | Describe the bindings of the buffer's current major mode. | +| [list-modes](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L65) | | Output all available major and minor modes. | +| [describe-mode](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L86) | | Show information about current major mode and enabled minor modes. | +| [apropos-command](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L112) | | Find all symbols in the running Lisp image whose names match a given string. | +| [lem-version](https://github.com/lem-project/lem/blob/main/src/commands/help.lisp#L123) | | Display Lem's version. | ## Font | Command | Key bindings | Documentation | @@ -210,7 +210,7 @@ Supported modes include: c-mode with clang-format, go-mode with gofmt, js-mode a | [exit-lem](https://github.com/lem-project/lem/blob/main/src/commands/other.lisp#L54) | C-x C-c | Ask for modified buffers before exiting lem. | | [quick-exit](https://github.com/lem-project/lem/blob/main/src/commands/other.lisp#L67) | | Exit the lem job and kill it. | | [execute-command](https://github.com/lem-project/lem/blob/main/src/commands/other.lisp#L111) | M-x | Read a command name, then read the ARG and call the command. | -| [show-context-menu](https://github.com/lem-project/lem/blob/main/src/commands/other.lisp#L126) | Shift-F10, M-h | | +| [show-context-menu](https://github.com/lem-project/lem/blob/main/src/commands/other.lisp#L126) | M-h, Shift-F10 | | | [load-library](https://github.com/lem-project/lem/blob/main/src/commands/other.lisp#L132) | | Load the Lisp library named NAME. | ## Frame