;; 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")
