<commit_before>(in-package :lem)

(export '(*keymaps*
          keymap
          make-keymap
          *global-keymap*
          undefined-key
          define-key
          keyseq-to-string
          find-keybind
          insertion-key-p
          lookup-keybind))

(defvar *keymaps* nil)

(defstruct (keymap (:constructor %make-keymap) (:print-function %print-keymap))
  undef-hook
  insertion-hook
  parent
  table
  name)

(defun %print-keymap (object stream depth)
  (declare (ignorable depth))
  (print-unreadable-object (object stream :identity t :type t)
    (when (keymap-name object)
      (format stream "~A" (keymap-name object)))))

(defun make-keymap (&key undef-hook insertion-hook parent name)
  (let ((keymap (%make-keymap
                 :undef-hook undef-hook
                 :insertion-hook insertion-hook
                 :parent parent
                 :table (make-hash-table :test 'equalp)
                 :name name)))
    (push keymap *keymaps*)
    keymap))

(defun define-key (keymap keyspec symbol)
  (check-type symbol symbol)
  (let ((keys (typecase keyspec
                (symbol (loop :for (key1 . keymap1) :in (get keyspec 'keybind)
                              :do (define-key keymap key1 symbol))
                        (return-from define-key))
                (string (parse-keyspec keyspec)))))
    (pushnew (cons keyspec keymap) (get symbol 'keybind) :test 'equal)
    (define-key-internal keymap keys symbol)))

(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 next
                         (setf table next)
                         (let ((new-table (make-hash-table :test 'equalp)))
                           (setf (gethash k table) new-table)
                           (setf table new-table))))))))

(defun parse-keyspec (string)
  (labels ((parse (str)
             (loop :with ctrl :and meta :and super :and hypher
                   :do (cond
                         ((ppcre:scan "^[cmshCMSH]-" str)
                          (ecase (char-downcase (char str 0))
                            ((#\c) (setf ctrl t))
                            ((#\m) (setf meta t))
                            ((#\s) (setf super t))
                            ((#\h) (setf hypher t)))
                          (setf str (subseq str 2)))
                         ((string= str "")
                          (editor-error "parse error: ~A" string))
                         (t
                          (return (make-key :ctrl ctrl
                                            :meta meta
                                            :super super
                                            :hypher hypher
                                            :sym str)))))))
    (mapcar #'parse (uiop:split-string string :separator " "))))

(defun keyseq-to-string (kseq)
  (with-output-to-string (out)
    (loop :for key* :on kseq
          :for key := (first key*)
          :do (with-slots (ctrl meta super hypher sym) key
                (when hypher (write-string "H-" out))
                (when super (write-string "S-" out))
                (when meta (write-string "M-" out))
                (when ctrl (write-string "C-" out))
                (write-string sym out)
                (when (rest key*)
                  (write-char #\space out))))))

(defun keymap-find-keybind (keymap key)
  (let ((table (keymap-table keymap)))
    (labels ((f (k)
               (let ((cmd (gethash k table)))
                 (if (hash-table-p cmd)
                     (setf table cmd)
                     cmd))))
      (or (etypecase key
            (key
             (f key))
            (list
             (let (cmd)
               (dolist (k key)<commit_msg>add key-sym-table<commit_after>(in-package :lem)

(export '(*keymaps*
          keymap
          make-keymap
          *global-keymap*
          undefined-key
          define-key
          keyseq-to-string
          find-keybind
          insertion-key-p
          lookup-keybind))

(defvar *keymaps* nil)

(defstruct (keymap (:constructor %make-keymap) (:print-function %print-keymap))
  undef-hook
  insertion-hook
  parent
  table
  name)

(defun %print-keymap (object stream depth)
  (declare (ignorable depth))
  (print-unreadable-object (object stream :identity t :type t)
    (when (keymap-name object)
      (format stream "~A" (keymap-name object)))))

(defun make-keymap (&key undef-hook insertion-hook parent name)
  (let ((keymap (%make-keymap
                 :undef-hook undef-hook
                 :insertion-hook insertion-hook
                 :parent parent
                 :table (make-hash-table :test 'equalp)
                 :name name)))
    (push keymap *keymaps*)
    keymap))

(defun define-key (keymap keyspec symbol)
  (check-type symbol symbol)
  (let ((keys (typecase keyspec
                (symbol (loop :for (key1 . keymap1) :in (get keyspec 'keybind)
                              :do (define-key keymap key1 symbol))
                        (return-from define-key))
                (string (parse-keyspec keyspec)))))
    (pushnew (cons keyspec keymap) (get symbol 'keybind) :test 'equal)
    (define-key-internal keymap keys symbol)))

(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 next
                         (setf table next)
                         (let ((new-table (make-hash-table :test 'equalp)))
                           (setf (gethash k table) new-table)
                           (setf table new-table))))))))


(defvar *key-sym-table* (make-hash-table :test 'equal))

(defun set-key-sym (name &optional (value name))
  (setf (gethash name *key-sym-table*) value))

(set-key-sym "Tab")
(set-key-sym "Return")
(set-key-sym "Escape")
(set-key-sym "Delete")
(set-key-sym "Down")
(set-key-sym "Up")
(set-key-sym "Left")
(set-key-sym "Right")
(set-key-sym "Backspace")
(set-key-sym "F0")
(set-key-sym "F1")
(set-key-sym "F2")
(set-key-sym "F3")
(set-key-sym "F4")
(set-key-sym "F5")
(set-key-sym "F6")
(set-key-sym "F7")
(set-key-sym "F8")
(set-key-sym "F9")
(set-key-sym "F10")
(set-key-sym "F11")
(set-key-sym "F12")
(set-key-sym "Home")
(set-key-sym "PageDown")
(set-key-sym "PageUp")
(set-key-sym "End")
(set-key-sym "Space" " ")

(defun parse-keyspec (string)
  (labels ((fail ()
             (editor-error "parse error: ~A" string))
           (parse (str)
             (loop :with ctrl :and meta :and super :and hypher
                   :do (cond
                         ((ppcre:scan "^[cmshCMSH]-" str)
                          (ecase (char-downcase (char str 0))
                            ((#\c) (setf ctrl t))
                            ((#\m) (setf meta t))
                            ((#\s) (setf super t))
                            ((#\h) (setf hypher t)))
                          (setf str (subseq str 2)))
                         ((string= str "")
                          (fail))
                         ((and (< 1 (length str))
                               (not (gethash str *key-sym-table*)))
                          (fail))
                         (t
                          (return (make-key :ctrl ctrl
                                            :meta meta
                                            :super super
                                            :hypher hypher
                                            :sym (or (gethash str *key-sym-table*)
                                                     str))))))))
    (mapcar #'parse (uiop:split-string string :separator " "))))

(defun keyseq-to-string (kseq)
  (with-output-to-string (out)
    (loop :for key* :on kseq
          :for key := (first key*)
          :do (with-slots (ctrl meta super hypher sym) key
                (when hypher (write-string "H-" out))
                (when super (write-string "S-" out))
                (when meta (write-string "M-" out))
                (when ctrl (write-string "C-" out))
                (write-string sym out)
                (when (rest key*)
                  (write-char #\space out))))))

(defun keymap-find-keybind (keymap key)
  (let ((table (keymap-table keymap)))
    (labels ((f (k)
               (let ((cmd (gethash k table)))
                 (if (hash-table-p cmd)
                     (setf table cmd)
                     cmd))))
      (or (etypecase key
            (key
             (f key))
            (list
             (let (cmd)
               (dolist (k key)
{'fraction_non_alphanumeric': 0.13204186150077935, 'fraction_numerical': 0.003006012024048096, 'mean_word_length': 1.365192206424434, 'pattern_counts': {'":': 0, '<': 4, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 20, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7618620', 'n_tokens_mistral': 2753, 'n_tokens_neox': 2667, 'n_words': 745}