;;; arf.el --- Lightweight modal editing -*- lexical-binding: t; -*-

;;; Configuration

(defvar arf-default-state 'read
  "State that buffers start in by default.")

(defvar arf-mode-default-states '()
  "Alist of (MAJOR-MODE . STATE) overriding `arf-default-state'
for specific major modes.")

(defvar arf-state-definitions '()
  "Alist of (STATE . PLIST) defining each modal state.
Each plist supports the following properties:
  :tag                  String displayed in the mode line.
  :face                 Face used for the mode-line tag.
  :suppress-self-insert  When non-nil, remap `self-insert-command' to `ignore'.")

(defvar arf-default-keymaps '()
  "Alist of (STATE . KEYMAP) holding the default keymap for each state.
These are merged with major-mode-specific keymaps when composing
the active keymap for a state.")

(defvar arf-mode-keymaps '()
  "Alist of (STATE . ((MAJOR-MODE . KEYMAP) ...)).
Per-major-mode keymaps that are merged with the default keymap
for each state.")

(defvar arf-default-keytrees '()
  "Alist of (STATE . KEYTREE) holding the original keytree for each state's default bindings.")

(defvar arf-mode-keytrees '()
  "Alist of (STATE . ((MAJOR-MODE . KEYTREE) ...)).
Original keytrees for per-major-mode bindings.")

;;; State

(defvar-local arf-state 'read
  "Current modal state.")

(defvar-local arf-active nil
  "Non-nil when arf's emulation keymap should be active.")
(put 'arf-active 'permanent-local t)


;;; Keymaps

(defvar arf-suppress-self-insert-commands
  '(self-insert-command vterm--self-insert)
  "Commands to remap to `ignore' when a state has :suppress-self-insert.")

(defvar-local arf--emulation-alist '((arf-active))
  "Buffer-local alist for `emulation-mode-map-alists'.
The keymap is rebuilt when the state or major mode changes.")
(put 'arf--emulation-alist 'permanent-local t)

;;; Keymap composition

(defun arf--update-emulation-alist ()
  "Rebuild the emulation alist entry for the current buffer."
  (let* ((def (alist-get arf-state arf-state-definitions))
         (default-map (alist-get arf-state arf-default-keymaps))
         (mode-maps (alist-get arf-state arf-mode-keymaps))
         (mode-map (alist-get major-mode mode-maps))
         (suppress-map (when (plist-get def :suppress-self-insert)
                         (let ((map (make-sparse-keymap)))
                           (dolist (cmd arf-suppress-self-insert-commands)
                             (define-key map (vector 'remap cmd) #'ignore))
                           map)))
         (maps (delq nil (list mode-map default-map suppress-map))))
    (setq arf--emulation-alist
          `((arf-active
             . ,(when maps
                  (make-composed-keymap maps)))))))

;;; State switching

(defun arf-enter-state (state)
  "Switch the current buffer to STATE."
  (unless (minibufferp)
    (setq arf-state state)
    (setq arf-active t)
    (arf--update-emulation-alist)
    (force-mode-line-update)))

;;; Default state per major mode

(defun arf--set-default-state ()
  "Set the default state for the current buffer based on major mode."
  (arf-enter-state (or (alist-get major-mode arf-mode-default-states)
                       arf-default-state)))

;;; Bindings API

(defun arf-set-bindings (state mode keytree)
  "Set keybindings for STATE.
If MODE is nil, update the default keymap for STATE.
If MODE is a major-mode symbol, update the mode-specific keymap.
KEYTREE is a nested list in `circ/keytree-to-keymap' format."
  (let ((map (circ/keytree-to-keymap keytree (symbol-name state) t)))
    (if mode
        (progn
          (let ((state-entry (assq state arf-mode-keymaps)))
            (if state-entry
                (if-let ((cell (assq mode (cdr state-entry))))
                    (setcdr cell map)
                  (push (cons mode map) (cdr state-entry)))
              (push (cons state (list (cons mode map))) arf-mode-keymaps)))
          (let ((state-entry (assq state arf-mode-keytrees)))
            (if state-entry
                (if-let ((cell (assq mode (cdr state-entry))))
                    (setcdr cell keytree)
                  (push (cons mode keytree) (cdr state-entry)))
              (push (cons state (list (cons mode keytree))) arf-mode-keytrees))))
      (if-let ((cell (assq state arf-default-keymaps)))
          (setcdr cell map)
        (push (cons state map) arf-default-keymaps))
      (if-let ((cell (assq state arf-default-keytrees)))
          (setcdr cell keytree)
        (push (cons state keytree) arf-default-keytrees)))))

;;; Keybinding display

(defun arf--format-keytree (keytree &optional prefix)
  "Format KEYTREE into a list of \"key — command\" strings.
PREFIX is prepended to nested keys."
  (let (lines)
    (dolist (entry keytree)
      (let ((key (car entry))
            (value (cadr entry)))
        (when key
          (let ((full-key (if prefix (concat prefix " " key) key)))
            (cond
             ((and (listp value) (listp (car value)))
              (setq lines (append lines (arf--format-keytree value full-key))))
             (t
              (push (format "  %-10s %s" full-key value) lines)))))))
    (nreverse lines)))

(defun arf--render-keybindings (buf source-mode)
  "Render arf keybindings into BUF for SOURCE-MODE."
  (with-current-buffer buf
    (let ((inhibit-read-only t)
          (pos (point)))
      (erase-buffer)
      (dolist (state-def arf-state-definitions)
        (let* ((state (car state-def))
               (state-name (upcase (symbol-name state)))
               (default-keytree (alist-get state arf-default-keytrees))
               (mode-keytrees (alist-get state arf-mode-keytrees))
               (mode-keytree (alist-get source-mode mode-keytrees)))
          (insert (format "── %s " state-name)
                  (make-string (max 0 (- 50 (length state-name) 4)) ?─)
                  "\n\n")
          (when default-keytree
            (dolist (line (arf--format-keytree default-keytree))
              (insert line "\n")))
          (when mode-keytree
            (insert (format "\n  [%s]\n" source-mode))
            (dolist (line (arf--format-keytree mode-keytree))
              (insert line "\n")))
          (insert "\n")))
      (goto-char (min pos (point-max))))))

(defun arf-show-keybindings ()
  "Display arf keybindings in a dedicated buffer.
Shows bindings for all states, including mode-specific bindings
for the major mode of the buffer where this was invoked."
  (interactive)
  (let ((buf (get-buffer-create "*arf-keybindings*")))
    (arf--render-keybindings buf major-mode)
    (with-current-buffer buf (special-mode))
    (display-buffer buf)))

(defun arf--refresh-keybindings ()
  "Refresh the keybindings buffer if it is visible."
  (let ((buf (get-buffer "*arf-keybindings*")))
    (when (and buf (get-buffer-window buf))
      (arf--render-keybindings buf major-mode))))

;;; Mode line

(defun arf-mode-line-tag ()
  "Return a propertized mode-line tag for the current modal state."
  (let ((def (alist-get arf-state arf-state-definitions)))
    (propertize (or (plist-get def :tag) (symbol-name arf-state))
                'face (plist-get def :face))))

;;; Global minor mode

(define-minor-mode arf-mode
  "Lightweight modal editing with user-defined states."
  :global t
  :init-value nil
  (if arf-mode
      (progn
        (add-to-list 'emulation-mode-map-alists 'arf--emulation-alist)
        (add-hook 'after-change-major-mode-hook #'arf--set-default-state)
        (dolist (buf (buffer-list))
          (with-current-buffer buf
            (arf--set-default-state))))
    (setq emulation-mode-map-alists
          (delq 'arf--emulation-alist emulation-mode-map-alists))
    (remove-hook 'after-change-major-mode-hook #'arf--set-default-state)
    (dolist (buf (buffer-list))
      (with-current-buffer buf
        (setq arf-active nil)))))

(provide 'arf)
;;; arf.el ends here
