From 52b43f8d93354e373b607b74ab2dda8530f51bd8 Mon Sep 17 00:00:00 2001
From: Encryptoid <encryptoidgalactic@gmail.com>
Date: Wed, 1 Jan 2025 13:44:23 +0000
Subject: [PATCH] Add (undefine-key) functionality

---
 src/internal-packages.lisp |  2 ++
 src/keymap.lisp            | 34 ++++++++++++++++++++++++++++++++++
 2 files changed, 36 insertions(+)

diff --git a/src/internal-packages.lisp b/src/internal-packages.lisp
index b1927dbe7..676213a52 100644
--- a/src/internal-packages.lisp
+++ b/src/internal-packages.lisp
@@ -459,6 +459,8 @@
    :*global-keymap*
    :define-key
    :define-keys
+   :undefine-key
+   :undefine-keys
    :keyseq-to-string
    :find-keybind
    :insertion-key-p
diff --git a/src/keymap.lisp b/src/keymap.lisp
index e60707f0b..b4e63b86b 100644
--- a/src/keymap.lisp
+++ b/src/keymap.lisp
@@ -76,6 +76,40 @@ Example: (define-key *global-keymap* \"C-'\" 'list-modes)"
                            (setf (gethash k table) new-table)
                            (setf table new-table))))))))
 
+(defun undefine-key (keymap keyspec)
+  "Remove a binding for a KEYSPEC in a KEYMAP.
+
+If KEYSPEC argument is a `string', valid prefixes are:
+H (Hyper), S (Super), M (Meta), C (Ctrl), Shift
+
+Example: (undefine-key *paredit-mode-keymap* \"C-k\")"
+  (check-type keyspec (or symbol string))
+  (typecase keyspec
+    (symbol
+     (remhash keyspec (keymap-function-table keymap)))
+    (string
+     (let ((keys (parse-keyspec keyspec)))
+       (undefine-key-internal keymap keys))))
+  (values))
+
+(defmacro undefine-keys (keymap &body bindings)
+  `(progn ,@(mapcar
+             (lambda (binding)
+               `(undefine-key ,keymap
+                              ,(first binding)))
+             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)))))))
+
 (defun parse-keyspec (string)
   (labels ((fail ()
              (editor-error "parse error: ~A" string))