159 lines
4.0 KiB
Plaintext
159 lines
4.0 KiB
Plaintext
;; Key sequence handling
|
|
(setq _red/key-sequence nil)
|
|
|
|
(defun _red/push-key-seq
|
|
(key)
|
|
(setq _red/key-sequence (append _red/key-sequence (list key))))
|
|
(defun _red/reset-key-seq
|
|
()
|
|
(setq _red/key-sequence nil))
|
|
|
|
;; Key map handling
|
|
(setq _red/keymaps (hash/new))
|
|
(setq _red/key-fallbacks (hash/new))
|
|
(hash/put! _red/keymaps 'normal (red/keymap/new))
|
|
(hash/put! _red/keymaps 'insert (red/keymap/new))
|
|
(hash/put! _red/keymaps 'command (red/keymap/new))
|
|
|
|
(defun _red/declare-key
|
|
(mode seq action)
|
|
(when (not (hash/has? _red/keymaps mode))
|
|
(hash/put! _red/keymaps mode (red/keymap/new))
|
|
)
|
|
(hash/update!
|
|
(lambda (kmap)
|
|
(red/keymap/put! kmap seq action)
|
|
kmap)
|
|
_red/keymaps
|
|
mode
|
|
)
|
|
)
|
|
(defun _red/declare-key-fallback
|
|
(mode fallback)
|
|
(hash/put! _red/key-fallbacks mode fallback)
|
|
)
|
|
|
|
(defun _red/lookup-key
|
|
(mode seq)
|
|
(let (kmap (hash/get _red/keymaps mode))
|
|
(if (not (nil? kmap))
|
|
(red/keymap/get kmap seq)
|
|
)
|
|
)
|
|
)
|
|
|
|
(defmacro declare-keys
|
|
(buffer-mode &rest clauses)
|
|
;; (declare-keys
|
|
;; normal
|
|
;; ('k ...)
|
|
;; ('h ...)
|
|
;; :fallback
|
|
;; (keyseq)
|
|
;; ...
|
|
;; )
|
|
(let (output nil)
|
|
(while (not (nil? clauses))
|
|
(let (clause (car clauses))
|
|
(cond
|
|
((cons? clause)
|
|
(let (key-seq (car clause) key-action (cdr clause))
|
|
(when (nil? key-action)
|
|
(error "Expected at least one expression after the key sequence")
|
|
)
|
|
(setq output (cons
|
|
`(_red/declare-key (quote ,buffer-mode) ,key-seq (lambda () ,@key-action))
|
|
output
|
|
))
|
|
)
|
|
)
|
|
;; Rest of clauses are fallback args + body
|
|
((= clause ':fallback)
|
|
(progn
|
|
(setq
|
|
output
|
|
(cons
|
|
`(_red/declare-key-fallback (quote ,buffer-mode) (lambda ,@(cdr clauses)))
|
|
output)
|
|
)
|
|
(break)
|
|
)
|
|
)
|
|
(&otherwise (error "Unexpected clause:" clause))
|
|
)
|
|
)
|
|
(setq clauses (cdr clauses))
|
|
)
|
|
(when (nil? output)
|
|
(error "No key sequence and no fallback action defined in the declare-keys invocation")
|
|
)
|
|
(cons 'progn output)
|
|
)
|
|
)
|
|
|
|
;; Key input handling
|
|
|
|
(defun _red/root-mapped-key-hook
|
|
(mode key)
|
|
;; 1. Push key into current sequence
|
|
;; 2. Lookup current sequence in relevant key map
|
|
;; 3.1. If present and leaf, reset current sequence and invoke the handler
|
|
;; 3.2. If present and non-leaf, continue collecting the sequence
|
|
;; 3.3. If non-present, reset the sequence
|
|
(_red/push-key-seq key)
|
|
(let (node (_red/lookup-key mode _red/key-sequence))
|
|
(cond
|
|
;; TODO invoke general fallback handler for the buffer-mode
|
|
((nil? node)
|
|
(progn
|
|
(let (fallback (hash/get _red/key-fallbacks mode))
|
|
(unless (nil? fallback)
|
|
(fallback _red/key-sequence))
|
|
)
|
|
(_red/reset-key-seq)
|
|
))
|
|
((= (car node) 'prefix) nil)
|
|
((= (car node) 'leaf)
|
|
(progn
|
|
(_red/reset-key-seq)
|
|
((cadr node))
|
|
))
|
|
)
|
|
)
|
|
)
|
|
|
|
(defun _red/root-key-hook
|
|
(top-mode buffer-mode key)
|
|
(cond
|
|
((= top-mode 'command) (_red/root-mapped-key-hook 'command key))
|
|
((= top-mode 'normal) (_red/root-mapped-key-hook buffer-mode key))
|
|
(&otherwise (eprint "Unhandled" (list '_red/root-key-hook top-mode buffer-mode key)))
|
|
)
|
|
)
|
|
|
|
;; Helpers
|
|
(defun red/as-insertable-key-seq
|
|
(key-seq)
|
|
(if (nil? (cdr key-seq))
|
|
(let* (key (car key-seq) key-str (->string key))
|
|
(cond
|
|
((= key 'space) " ")
|
|
((= key 'tab) "\t")
|
|
((and
|
|
(= (string/length key-str) 1)
|
|
(or
|
|
(not (string/ascii? key-str))
|
|
(string/ascii-graphic? key-str)
|
|
)
|
|
)
|
|
key-str
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(import "keymap/command.lysp")
|
|
(import "keymap/insert.lysp")
|
|
(import "keymap/normal.lysp")
|