red: rework command and key handling

userspace/tools/red/runtime/command.lysp

@@ -1,14 +1,51 @@
-;; TODO prelude
-(defun string/join (xs)
-  (let (accumulator "")
-    (while (cons? xs)
-      (if accumulator
-        (setq accumulator (+ accumulator " " (car xs)))
-        (setq accumulator (car xs))
-        )
-      (setq xs (cdr xs))
+(setq _red/command-table (hash/new))
+
+(defun _red/declare-command
+  (command handler)
+  (hash/put! _red/command-table command handler))
+(defmacro declare-command
+  (command args &rest body)
+  (unless (cons? body)
+    (error "No body provided in declare-command"))
+  (unless (list? args)
+    (error "Argument list must either be a NIL or a list"))
+  (let*
+    (
+     args-has-rest (find (lambda (x) (= x '&rest)) args)
+     lambda-args (if args-has-rest
+                   `(,@args)
+                   `(,@args &rest _)
+                   )
+     )
+    `(_red/declare-command ,command (lambda ,lambda-args ,@body))
+    )
+  )
+
+(defun _red/editor-command-hook (command)
+  (when-let
+    (words (filter identity (string/split command)))
+    (let* (command (car words) args (cdr words) entry (hash/get _red/command-table command))
+      (if (nil? entry)
+        (red/message (+ "Unhandled command: :" command))
+        (apply entry args))
+      )))
+(defun _red/shell-command-hook (command)
+  (setq command (string/trim command))
+  (unless command (return))
+  (let (words (filter identity (string/split command)))
+    (apply red/shell-command words)
+    )
+  )
+
+(defun _red/root-command-hook (command)
+  (red/set-top-mode 'normal)
+  (setq command (string/trim command))
+  (unless command (return))
+  (let (shell-command (string/strip-prefix command "!"))
+    (cond
+      ((nil? shell-command) (_red/editor-command-hook command))
+      (shell-command (_red/shell-command-hook shell-command))
       )
-    accumulator
     )
   )
 
@@ -71,7 +108,7 @@
           eval-result (read-eval expression)
           )
     (cond
-      ((result/ok? eval-result) (red/status (+ "ok: " (cadr eval-result))))
+      ((result/ok? eval-result) (red/status (+ "=> " (cadr eval-result))))
       (&otherwise (red/message (+ "error: " (cadr eval-result))))
       )
     )

userspace/tools/red/runtime/core.lysp

@@ -1,77 +1,29 @@
 ;; External API
 
-(defmacro ignore (&rest expressions) nil)
+(import "util.lysp")
 
-(defmacro declare-key (mode seq action-head &rest action-tail)
-  (let (bind-function (symbol (+ "red/bind-" (->string mode) "-hook")))
-    `(,bind-function ,seq (lambda () (progn ,action-head ,@action-tail)))
+(defun _red/key-sequence-string
+  (key-seq)
+  (let (strs (map ->string key-seq))
+    (string/join strs "+")
     )
   )
-
-(defmacro declare-command
-  (command args &rest body)
-  (unless (cons? body)
-    (error "No body provided in declare-command"))
-  (unless (list? args)
-    (error "Argument list must either be a NIL or a list"))
-  (let*
-    (
-     args-has-rest (find (lambda (x) (= x '&rest)) args)
-     lambda-args (if args-has-rest
-                   `(,@args)
-                   `(,@args &rest _)
-                   )
-     )
-    `(setq
-       _red/command-table
-       (cons
-         (list ,command (lambda ,lambda-args ,@body))
-         _red/command-table
-         )
-       )
-    )
-  )
-;; (defmacro declare-command
-;;   (command args body-head &rest body-tail)
-;;   ;; TODO auto-rest?
-;;   `(setq
-;;      _red/command-table
-;;      (cons
-;;        (list ,command (lambda (,@args &rest _) ,body-head ,@body-tail))
-;;        _red/command-table
-;;        )
-;;      )
-;;   )
-
-(defun try-import (path)
-  (when (fs/file? path) (import path) #t))
-
-(setq _red/command-table nil)
-
-;; Hooks for the editor/buffer events
-(defun _red/lookup-command (name)
-  (find (lambda (cmd) (= name (car cmd))) _red/command-table)
-  )
-
-(defun _red/root-command-hook (command &rest args)
-  (let (entry (_red/lookup-command command))
-    (if entry
-      (apply (cadr entry) args)
-      (red/message (+ "Unhandled command: :" command))
+(defun _red/root-post-render-hook (width height)
+  (unless (nil? _red/key-sequence)
+    (let (keys (_red/key-sequence-string _red/key-sequence))
+      (term/set-cursor (- height 1) (- width 10))
+      (term/write keys)
       )
     )
   )
 
-(defun _red/root-post-render-hook (width height)
-  nil
-  )
-
 ;; Bind the hooks
-(red/bind-command-hook _red/root-command-hook)
 (red/bind-post-render-hook _red/root-post-render-hook)
 
 ;; Child modules
 (import "keyboard.lysp")
+(red/bind-key-hook _red/root-key-hook)
+
 (import "command.lysp")
 (import "highlight.lysp")
 

userspace/tools/red/runtime/keyboard.lysp

@@ -1,60 +1,158 @@
-(declare-key normal '(z z)
-             (when (red/buffer/path)
-               (red/buffer/write)
+;; 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")
                )
-             (red/quit)
+             (setq output (cons
+                            `(_red/declare-key (quote ,buffer-mode) ,key-seq (lambda () ,@key-action))
+                            output
+                            ))
              )
-(declare-key normal '(Z Z) (red/quit #t))
-
-(declare-key normal 'a (red/buffer/set-mode 'insert-after))
-(declare-key normal 'i (red/buffer/set-mode 'insert-before))
-(declare-key normal 'I
-             (red/buffer/move 'line-start)
-             (red/buffer/set-mode 'insert-before))
-(declare-key normal 'A
-             (red/buffer/move 'line-end)
-             (red/buffer/set-mode 'insert-after))
-
-(declare-key normal '(g g) (red/buffer/move 'first-line))
-(declare-key normal 'G (red/buffer/move 'last-line))
-
-(declare-key normal 'h (red/buffer/move 'prev-char))
-(declare-key normal 'l (red/buffer/move 'next-char))
-(declare-key normal 'k (red/buffer/move 'prev-line))
-(declare-key normal 'j (red/buffer/move 'next-line))
-(declare-key normal 'J (red/buffer/move 'next-page))
-(declare-key normal 'K (red/buffer/move 'prev-page))
-(declare-key normal 'o
-             (red/buffer/insert-line-after)
-             (red/buffer/move 'next-line)
-             (red/buffer/set-mode 'insert-before))
-(declare-key normal 'O
-             (red/buffer/insert-line-before)
-             (red/buffer/set-mode 'insert-before))
-(declare-key normal '(d d)
-             (red/buffer/kill-line)
-             (red/buffer/move 'prev-line))
-(declare-key normal 'newline
-             (red/buffer/move 'next-line)
-             (red/buffer/move 'line-start))
-
-(declare-key normal 'left (red/buffer/move 'prev-char))
-(declare-key normal 'right (red/buffer/move 'next-char))
-(declare-key normal 'up (red/buffer/move 'prev-line))
-(declare-key normal 'down (red/buffer/move 'next-line))
-(declare-key normal 'home (red/buffer/move 'line-start))
-(declare-key normal 'end (red/buffer/move 'line-end))
-
-(declare-key insert 'left (red/buffer/move 'prev-char))
-(declare-key insert 'right (red/buffer/move 'next-char))
-(declare-key insert 'up (red/buffer/move 'prev-line))
-(declare-key insert 'down (red/buffer/move 'next-line))
-(declare-key insert 'home (red/buffer/move 'line-start))
-(declare-key insert 'end (red/buffer/move 'line-end))
-(declare-key insert 'backspace (red/buffer/erase-backward))
-(declare-key insert 'newline
-             (red/buffer/insert-line-after #t)
-             (red/buffer/move 'next-line)
-             (red/buffer/move 'line-start)
-             (red/buffer/set-mode 'insert-before)
+           )
+          ;; 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")

userspace/tools/red/runtime/keymap/command.lysp

@@ -0,0 +1,31 @@
+(declare-keys
+  command
+  ('escape (red/set-top-mode 'normal))
+  ('backspace
+   (let (command (red/command))
+     (if command
+       (red/set-command (string/pop command))
+       (red/set-top-mode 'normal)
+       )
+     )
+   )
+  ('newline
+   (let (command (red/command))
+     (red/set-command "")
+     (_red/root-command-hook command)
+     )
+   )
+  :fallback
+  (key-seq)
+  (_red/command-mode-handler key-seq)
+  )
+
+(defun _red/command-mode-handler
+  (key-seq)
+  (let (insertable (red/as-insertable-key-seq key-seq))
+    (unless (nil? insertable)
+      (let (command (+ (red/command) insertable))
+        (red/set-command command))
+      )
+    )
+  )

userspace/tools/red/runtime/keymap/insert.lysp

@@ -0,0 +1,25 @@
+(declare-keys
+  insert
+  ('left (red/buffer/move 'prev-char))
+  ('right (red/buffer/move 'next-char))
+  ('up (red/buffer/move 'prev-line))
+  ('down (red/buffer/move 'next-line))
+  ('newline
+   (red/buffer/insert-line-after #T)
+   (red/buffer/move 'next-line)
+   (red/buffer/move 'line-start))
+  ('escape (red/buffer/set-mode 'normal))
+  ('backspace (red/buffer/erase-backward))
+  :fallback
+  (key-seq)
+  (_red/insert-mode-handler key-seq)
+  )
+
+(defun _red/insert-mode-handler
+  (key-seq)
+  (let (insertable (red/as-insertable-key-seq key-seq))
+    (unless (nil? insertable)
+      (red/buffer/write-text insertable)
+      )
+    )
+  )

userspace/tools/red/runtime/keymap/normal.lysp

@@ -0,0 +1,52 @@
+(declare-keys
+  normal
+  (': (red/set-top-mode 'command))
+  ('i (red/buffer/set-mode 'insert-before))
+  ('a (red/buffer/set-mode 'insert-after))
+  ('I
+   (red/buffer/move 'line-start)
+   (red/buffer/set-mode 'insert-before)
+   )
+  ('A
+   (red/buffer/move 'line-end)
+   (red/buffer/set-mode 'insert-after)
+   )
+
+  ('(g g) (red/buffer/move 'first-line))
+  ('G (red/buffer/move 'last-line))
+  ('h (red/buffer/move 'prev-char))
+  ('l (red/buffer/move 'next-char))
+  ('k (red/buffer/move 'prev-line))
+  ('j (red/buffer/move 'next-line))
+  ('K (red/buffer/move 'prev-page))
+  ('J (red/buffer/move 'next-page))
+  ('newline
+   (red/buffer/move 'next-line)
+   (red/buffer/move 'line-start))
+  ('left (red/buffer/move 'prev-char))
+  ('right (red/buffer/move 'next-char))
+  ('up (red/buffer/move 'prev-line))
+  ('down (red/buffer/move 'next-line))
+
+  ('o
+   (red/buffer/insert-line-after)
+   (red/buffer/move 'next-line)
+   (red/buffer/set-mode 'insert-before)
+   )
+  ('O
+   (red/buffer/insert-line-before)
+   (red/buffer/set-mode 'insert-before)
+   )
+
+  ('(d d)
+   (red/buffer/kill-line)
+   (red/buffer/move 'prev-line))
+
+  ('(z z)
+   (when (red/buffer/path)
+     (red/buffer/write)
+     )
+   (red/quit)
+   )
+  ('(Z Z) (red/quit #T))
+  )

userspace/tools/red/runtime/util.lysp

@@ -0,0 +1,20 @@
+;; TODO prelude
+(defun string/join (xs &optional separator)
+  (when (nil? separator)
+    (setq separator " "))
+  (let (accumulator "")
+    (while (cons? xs)
+      (if accumulator
+        (setq accumulator (+ accumulator separator (car xs)))
+        (setq accumulator (car xs))
+        )
+      (setq xs (cdr xs))
+      )
+    accumulator
+    )
+  )
+
+(defmacro ignore (&rest expressions) nil)
+
+(defun try-import (path)
+  (when (fs/file? path) (import path) #t))

userspace/tools/red/src/buffer/mod.rs

@@ -107,14 +107,6 @@ impl View {
         self.cursor_row = 0;
         self.cursor_column = 0;
     }
-
-    // pub fn resize(&mut self, width: usize, height: usize) {
-    //     self.width = width;
-    //     self.height = height;
-
-    //     self.column_offset = 0;
-    //     self.row_offset = 0;
-    // }
 }
 
 impl Buffer {

userspace/tools/red/src/command.rs

@@ -1,20 +0,0 @@
-use lysp::vm::value::convert::AnyFunction;
-
-use crate::{State, error::Error};
-
-pub type CommandFn = fn(&mut State, &[&str]) -> Result<(), Error>;
-
-pub enum Action {
-    Handler(AnyFunction),
-    Command(String),
-    None,
-}
-
-impl From<Option<AnyFunction>> for Action {
-    fn from(value: Option<AnyFunction>) -> Self {
-        match value {
-            Some(handler) => Self::Handler(handler),
-            None => Self::None,
-        }
-    }
-}

userspace/tools/red/src/error.rs

@@ -21,6 +21,10 @@ pub enum Error {
     TerminalError(io::Error),
     #[error("Terminal error: {0:?}")]
     TerminalFmtError(fmt::Error),
+    #[error("Command error: {0}")]
+    Command(io::Error),
+    #[error("Command error: {0:?}")]
+    CommandStatus(Option<i32>),
 
     #[error("Scripting error: {0:?}")]
     Script(#[from] MachineError),

userspace/tools/red/src/keymap/map.rs

@@ -17,7 +17,7 @@ pub enum PrefixNode<K: Prefix, V> {
 
 #[derive(Default)]
 pub struct PrefixMap<K: Prefix, V> {
-    map: HashMap<K, PrefixNode<K, V>>,
+    pub(super) map: HashMap<K, PrefixNode<K, V>>,
 }
 
 impl<K: Prefix, V> PrefixNode<K, V> {
@@ -54,14 +54,28 @@ impl<K: Prefix, V> PrefixMap<K, V> {
     }
 
     pub fn insert(&mut self, key: K, value: V) {
-        if let Some(prefix) = key.prefix() {
-            self.map
-                .entry(prefix)
-                .or_insert_with(PrefixNode::empty_prefix)
-                .add_suffix(key.clone());
+        if let Some(entry) = self.map.get_mut(&key) {
+            match entry {
+                PrefixNode::Prefix(_suffices) => {
+                    todo!("Remove suffices of keys")
+                }
+                PrefixNode::Leaf(leaf) => {
+                    *leaf = value;
+                }
+            }
+
+            return;
+        }
+
+        let mut k = key.clone();
+        while let Some(prefix) = k.prefix() {
+            self.map
+                .entry(prefix.clone())
+                .or_insert_with(PrefixNode::empty_prefix)
+                .add_suffix(k.clone());
+            k = prefix;
         }
 
-        // TODO remove all suffixes of `key`, if those exist
         self.map.insert(key, PrefixNode::Leaf(value));
     }
 

userspace/tools/red/src/keymap/mod.rs

@@ -1,4 +1,11 @@
-use std::{borrow::Borrow, hash::Hash};
+use std::{
+    any::Any,
+    borrow::Borrow,
+    cell::{Ref, RefCell},
+    fmt,
+    hash::Hash,
+    rc::Rc,
+};
 
 use self::map::PrefixMap;
 pub use self::map::PrefixNode;
@@ -7,36 +14,57 @@ mod key;
 mod map;
 
 pub use key::KeySeq;
+use lysp::vm::{
+    Value,
+    value::{NativeObject, convert::AnyFunction},
+};
 
 #[derive(Debug)]
-pub struct KeyMap<T> {
-    map: PrefixMap<KeySeq, T>,
+pub struct LyspKeyMap {
+    map: RefCell<PrefixMap<KeySeq, AnyFunction>>,
 }
 
-impl<T> KeyMap<T> {
-    pub fn new() -> Self {
-        Self {
-            map: PrefixMap::new(),
-        }
+impl LyspKeyMap {
+    pub fn new_value() -> Value {
+        let map: Rc<dyn NativeObject> = Rc::new(Self {
+            map: RefCell::new(PrefixMap::new()),
+        });
+        Value::NativeValue(map.into())
     }
 
-    pub fn set(&mut self, key: KeySeq, value: T) {
-        self.map.insert(key, value);
+    pub fn set(&self, key: KeySeq, value: AnyFunction) {
+        self.map.borrow_mut().insert(key, value);
     }
 
-    pub fn get<N>(&self, key: &N) -> Option<&PrefixNode<KeySeq, T>>
+    pub fn get<N>(&self, key: &N) -> Option<Ref<'_, PrefixNode<KeySeq, AnyFunction>>>
     where
         KeySeq: Borrow<N>,
         N: Eq + Hash + ?Sized,
     {
-        self.map.get(key)
+        Ref::filter_map(self.map.borrow(), |map| map.get(key)).ok()
     }
 }
 
-impl<A> FromIterator<(KeySeq, A)> for KeyMap<A> {
-    fn from_iter<T: IntoIterator<Item = (KeySeq, A)>>(iter: T) -> Self {
-        Self {
-            map: PrefixMap::from_iter(iter),
+impl fmt::Display for LyspKeyMap {
+    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
+        write!(f, "#red/keymap<")?;
+        let mut i = 0;
+        for (seq, entry) in self.map.borrow().map.iter() {
+            let PrefixNode::Leaf(leaf) = entry else {
+                continue;
+            };
+            if i != 0 {
+                write!(f, " ")?;
+            }
+            i += 1;
+            write!(f, "({seq} . {leaf})")?;
         }
+        write!(f, ">")
+    }
+}
+
+impl NativeObject for LyspKeyMap {
+    fn as_any(&self) -> &dyn Any {
+        self
     }
 }

userspace/tools/red/src/main.rs

@@ -1,5 +1,4 @@
-#![feature(rustc_private)]
-// #![cfg_attr(target_os = "yggdrasil", feature(yggdrasil_os))]
+#![feature(rustc_private, if_let_guard)]
 #![allow(clippy::new_without_default)]
 
 use std::{
@@ -12,7 +11,6 @@ use std::{
 
 use libterm::TermKey;
 
-// use config::Config;
 use error::Error;
 use lysp::{
     error::MachineError,
@@ -24,10 +22,9 @@ use lysp::{
     },
 };
 
-use crate::{command::Action, config::EditorConfig, state::State};
+use crate::{config::EditorConfig, script::AsValue, state::State};
 
 pub mod buffer;
-pub mod command;
 pub mod config;
 pub mod error;
 pub mod highlight;
@@ -187,26 +184,25 @@ impl Editor {
                 break;
             }
 
-            let action = self.state.borrow_mut().handle_key(key);
+            let (key_hook, top_mode, buffer_mode) = {
+                let state = self.state.borrow();
+                let (top_mode, buffer_mode) = state.mode();
+                let key_hook = state.key_hook.clone();
 
-            match action {
-                Action::Handler(handler) => {
-                    self.evaluate_callback(&handler, &[]);
-                }
-                Action::Command(command) => {
-                    let hook = self.state.borrow().command_hook.clone();
-                    if let Some(hook) = hook {
-                        let words = command
-                            .split(' ')
-                            .map(Into::into)
-                            .map(Value::String)
-                            .collect::<Vec<_>>();
-
-                        self.evaluate_callback(&hook, &words);
-                    }
-                }
-                Action::None => (),
+                (key_hook, top_mode, buffer_mode)
             };
+
+            if let Some(key_hook) = key_hook {
+                let key = key.as_value();
+                let top_mode = top_mode.as_value();
+                let buffer_mode = buffer_mode.as_value();
+                self.evaluate_callback(
+                    &key_hook,
+                    &[top_mode.into(), buffer_mode.into(), key.into()],
+                );
+            } else {
+                self.state.borrow_mut().set_message("No root key hook set!");
+            }
         }
         Ok(())
     }

userspace/tools/red/src/script/convert.rs

@@ -63,6 +63,17 @@ impl AsValue for TopMode {
     }
 }
 
+impl FromValue for TopMode {
+    fn from_value(value: &Value) -> Result<Self, Error> {
+        let value = IdentifierValue::try_from_value(value)?;
+        match value.as_ref() {
+            "command" => Ok(Self::Command),
+            "normal" => Ok(Self::Normal),
+            _ => Err(Error::NoPath),
+        }
+    }
+}
+
 impl AsValue for Mode {
     fn as_value(&self) -> impl Into<Value> {
         IdentifierValue::from(match self {
@@ -84,21 +95,6 @@ impl FromValue for SetMode {
     }
 }
 
-impl AsValue for TermKey {
-    fn as_value(&self) -> impl Into<Value> {
-        IdentifierValue::from(match self {
-            TermKey::Insert => "insert".to_owned(),
-            TermKey::Up => "up".to_owned(),
-            TermKey::Down => "down".to_owned(),
-            TermKey::Left => "left".to_owned(),
-            TermKey::Right => "right".to_owned(),
-            TermKey::Delete => "delete".to_owned(),
-            TermKey::Char(char) => format!("{char}"),
-            _ => "".to_owned(),
-        })
-    }
-}
-
 impl AsValue for Color {
     fn as_value(&self) -> impl Into<Value> {
         IdentifierValue::from(match self {
@@ -136,6 +132,28 @@ impl FromValue for Color {
     }
 }
 
+impl AsValue for TermKey {
+    fn as_value(&self) -> impl Into<Value> {
+        IdentifierValue::from(match self {
+            TermKey::Insert => "insert".to_owned(),
+            TermKey::Up => "up".to_owned(),
+            TermKey::Down => "down".to_owned(),
+            TermKey::Left => "left".to_owned(),
+            TermKey::Right => "right".to_owned(),
+            TermKey::Delete => "delete".to_owned(),
+            TermKey::Escape => "escape".to_owned(),
+            TermKey::Home => "home".into(),
+            TermKey::End => "end".into(),
+            TermKey::Char('\n') | TermKey::Char('\r') => "newline".to_owned(),
+            TermKey::Char('\t') => "tab".to_owned(),
+            TermKey::Char(' ') => "space".to_owned(),
+            TermKey::Char('\x7F') => "backspace".to_owned(),
+            TermKey::Char(char) if !char.is_ascii() || char.is_ascii_graphic() => format!("{char}"),
+            _ => todo!("Key {self:?}"),
+        })
+    }
+}
+
 impl FromValue for TermKey {
     fn from_value(value: &Value) -> Result<Self, Error> {
         let identifier = IdentifierValue::try_from_value(value)?;
@@ -144,7 +162,7 @@ impl FromValue for TermKey {
             && let Some(char) = identifier.chars().next()
         {
             match char {
-                ch if ch.is_alphanumeric() => return Ok(Self::Char(ch)),
+                ch if !ch.is_ascii() || ch.is_ascii_graphic() => return Ok(Self::Char(ch)),
                 _ => (),
             }
         }
@@ -158,7 +176,12 @@ impl FromValue for TermKey {
             "home" => Ok(Self::Home),
             "newline" => Ok(Self::Char('\r')),
             "backspace" => Ok(Self::Char('\x7F')),
-            _ => Err(Error::NoPath),
+            "tab" => Ok(Self::Char('\t')),
+            "space" => Ok(Self::Char(' ')),
+            "escape" => Ok(Self::Escape),
+            _ => Err(Error::Script(MachineError::Custom(
+                format!("Invalid key: {value}").into(),
+            ))),
         }
     }
 }

userspace/tools/red/src/script/mod.rs

@@ -1,8 +1,11 @@
+use std::process::Command;
+
 use crate::{
-    Editor,
+    Editor, TopMode,
     buffer::SetMode,
+    error::Error,
     highlight::{SyntaxRule, SyntaxStyle},
-    keymap::KeySeq,
+    keymap::{KeySeq, LyspKeyMap, PrefixNode},
 };
 
 pub mod convert;
@@ -20,36 +23,39 @@ use lysp::{
 };
 
 fn editor_api(editor: &mut Editor) {
-    editor.defun("red/bind-normal-hook", |_, _, state, args| {
-        let [seq, handler] = args else {
+    editor.defun("red/shell-command", |_, _, state, args| {
+        let [command, args @ ..] = args else {
             return Err(MachineError::InvalidArgumentCount.into());
         };
-        let seq = KeySeq::from_value(seq)?;
-        let handler = AnyFunction::try_from_value(handler)?;
-
-        let mut state = state.borrow_mut();
-        state.normal_map.set(seq, handler);
-
-        Ok(Value::Nil)
+        let command = StringValue::try_from_value(command)?;
+        let mut command = Command::new(&*command);
+        for arg in args {
+            let arg = StringValue::try_from_value(arg)?;
+            command.arg(&*arg);
+        }
+        let output = command.output();
+        match output {
+            Ok(output) => {
+                if output.status.success() {
+                    if let Ok(text) = std::str::from_utf8(&output.stdout[..]) {
+                        let text = text.trim();
+                        let text = text.rsplit_once('\n').map(|(_, v)| v).unwrap_or(text);
+                        state.borrow_mut().set_status(text);
+                    }
+                    Ok(Value::Nil)
+                } else {
+                    Err(Error::CommandStatus(output.status.code()))
+                }
+            }
+            Err(error) => Err(Error::Command(error)),
+        }
     });
-    editor.defun("red/bind-insert-hook", |_, _, state, args| {
-        let [seq, handler] = args else {
-            return Err(MachineError::InvalidArgumentCount.into());
-        };
-        let seq = KeySeq::from_value(seq)?;
-        let handler = AnyFunction::try_from_value(handler)?;
-
-        let mut state = state.borrow_mut();
-        state.insert_map.set(seq, handler);
-
-        Ok(Value::Nil)
-    });
-    editor.defun("red/bind-command-hook", |_, _, state, args| {
+    editor.defun("red/bind-key-hook", |_, _, state, args| {
         let [hook] = args else {
             return Err(MachineError::InvalidArgumentCount.into());
         };
         let hook = AnyFunction::try_from_value(hook)?;
-        state.borrow_mut().command_hook = Some(hook);
+        state.borrow_mut().key_hook = Some(hook);
         Ok(Value::Nil)
     });
     editor.defun("red/bind-post-render-hook", |_, _, state, args| {
@@ -61,6 +67,14 @@ fn editor_api(editor: &mut Editor) {
         Ok(Value::Nil)
     });
 
+    editor.defun("red/set-top-mode", |_, _, state, args| {
+        let [mode] = args else {
+            return Err(MachineError::InvalidArgumentCount.into());
+        };
+        let mode = TopMode::from_value(mode)?;
+        state.borrow_mut().set_top_mode(mode);
+        Ok(Value::Nil)
+    });
     editor.defun("red/quit", |_, _, state, args| {
         let force = match args {
             [] => false,
@@ -69,13 +83,32 @@ fn editor_api(editor: &mut Editor) {
         state.borrow_mut().exit(force);
         Ok(Value::Nil)
     });
+    editor.defun("red/command", |_, _, state, _| {
+        let command = state.borrow().command.clone();
+        Ok(StringValue::from(command).into())
+    });
+    editor.defun("red/set-command", |_, _, state, args| {
+        let [command] = args else {
+            return Err(MachineError::InvalidArgumentCount.into());
+        };
+        let command = StringValue::try_from_value(command)?;
+        state.borrow_mut().command = (*command).to_owned();
+        Ok(Value::Nil)
+    });
     editor.defun("red/message", |_, _, state, args| {
         let mut message = String::new();
         for (i, arg) in args.iter().enumerate() {
             if i != 0 {
                 message.push(' ');
             }
-            message.push_str(&format!("{arg}"));
+            match arg {
+                Value::String(value) => {
+                    message.push_str(value.as_ref());
+                }
+                _ => {
+                    message.push_str(&format!("{arg}"));
+                }
+            }
         }
         state.borrow_mut().set_message(message);
         Ok(Value::Nil)
@@ -86,13 +119,54 @@ fn editor_api(editor: &mut Editor) {
             if i != 0 {
                 message.push(' ');
             }
-            message.push_str(&format!("{arg}"));
+            match arg {
+                Value::String(value) => {
+                    message.push_str(value.as_ref());
+                }
+                _ => {
+                    message.push_str(&format!("{arg}"));
+                }
+            }
         }
         state.borrow_mut().set_status(message);
         Ok(Value::Nil)
     });
 }
 
+fn keymap_api(editor: &mut Editor) {
+    editor.defun("red/keymap/new", |_, _, _, _| Ok(LyspKeyMap::new_value()));
+    editor.defun("red/keymap/put!", |_, _, _, args| {
+        let [keymap, keyseq, action] = args else {
+            return Err(MachineError::InvalidArgumentCount.into());
+        };
+        let keymap = keymap.as_native_ref::<LyspKeyMap>()?;
+        let keyseq = KeySeq::from_value(keyseq)?;
+        let action = AnyFunction::try_from_value(action)?;
+        keymap.set(keyseq, action);
+        Ok(Value::Nil)
+    });
+    editor.defun("red/keymap/get", |_, _, _, args| {
+        let [keymap, keyseq] = args else {
+            return Err(MachineError::InvalidArgumentCount.into());
+        };
+        let keymap = keymap.as_native_ref::<LyspKeyMap>()?;
+        let keyseq = KeySeq::from_value(keyseq)?;
+        let entry = keymap.get(&keyseq);
+        match entry {
+            Some(entry) => match &*entry {
+                PrefixNode::Leaf(leaf) => Ok(Value::list_or_nil([
+                    Value::Identifier("leaf".into()),
+                    leaf.clone().into(),
+                ])),
+                PrefixNode::Prefix(_) => {
+                    Ok(Value::list_or_nil([Value::Identifier("prefix".into())]))
+                }
+            },
+            None => Ok(Value::Nil),
+        }
+    });
+}
+
 fn syntax_api(editor: &mut Editor) {
     editor.defun("red/syntax/define-regex-rule", |_, _, state, args| {
         // ( <SYNTAX> <STATE> <PATTERN> <CATEGORY> &optional <NEXT-STATE> )
@@ -261,6 +335,15 @@ fn buffer_api(editor: &mut Editor) {
         state.move_cursor(movement);
         Ok(Value::Nil)
     });
+    editor.defun("red/buffer/write-text", |_, _, state, args| {
+        let [text] = args else {
+            return Err(MachineError::InvalidArgumentCount.into());
+        };
+        let text = StringValue::try_from_value(text)?;
+        let mut state = state.borrow_mut();
+        state.write_text(text.as_ref());
+        Ok(Value::Nil)
+    });
     editor.defun("red/buffer/insert-line-before", |_, _, state, _| {
         let mut state = state.borrow_mut();
         state.buffer_mut().newline_before();
@@ -319,7 +402,14 @@ fn term_api(editor: &mut Editor) {
             return Err(MachineError::InvalidArgumentCount.into());
         };
         let mut state = state.borrow_mut();
-        write!(state.term, "{message}").ok();
+        match message {
+            Value::String(value) => {
+                write!(state.term, "{}", &**value).ok();
+            }
+            _ => {
+                write!(state.term, "{message}").ok();
+            }
+        }
         Ok(Value::Nil)
     });
     editor.defun("term/set-cursor", |_, _, state, args| {
@@ -339,6 +429,7 @@ pub fn setup_env(editor: &mut Editor) {
 
     editor_api(editor);
     buffer_api(editor);
+    keymap_api(editor);
     term_api(editor);
     syntax_api(editor);
 }

userspace/tools/red/src/state.rs

@@ -1,4 +1,4 @@
-use std::{cell::RefCell, fmt::Write as FmtWrite, mem, path::Path, rc::Rc};
+use std::{cell::RefCell, fmt::Write as FmtWrite, path::Path, rc::Rc};
 
 use libterm::{Clear, Color, Term, TermKey};
 use lysp::vm::value::convert::AnyFunction;
@@ -6,32 +6,26 @@ use lysp::vm::value::convert::AnyFunction;
 use crate::{
     TopMode,
     buffer::{Buffer, Mode, SetMode},
-    command::Action,
     config::EditorConfig,
     error::Error,
     highlight::Highlighter,
-    keymap::{KeyMap, KeySeq, PrefixNode},
     script::Movement,
 };
 
 pub struct State {
     pub(super) term: Term,
     buffer: Buffer,
-    command: String,
+    pub(super) command: String,
     message: Option<String>,
     status: Option<String>,
-    key_seq: KeySeq,
     top_mode: TopMode,
     config: Rc<RefCell<EditorConfig>>,
-    // config: Config,
     running: bool,
     number_width: usize,
     pub(super) highlight: Highlighter,
 
     // Scripting hooks
-    pub(super) normal_map: KeyMap<AnyFunction>,
-    pub(super) insert_map: KeyMap<AnyFunction>,
-    pub(super) command_hook: Option<AnyFunction>,
+    pub(super) key_hook: Option<AnyFunction>,
     pub(super) post_render_hook: Option<AnyFunction>,
 }
 
@@ -52,16 +46,13 @@ impl State {
             message: None,
             status: None,
             command: String::new(),
-            key_seq: KeySeq::empty(),
             running: true,
             buffer,
             term,
             config,
             highlight: Highlighter::default(),
 
-            normal_map: KeyMap::new(),
-            insert_map: KeyMap::new(),
-            command_hook: None,
+            key_hook: None,
             post_render_hook: None,
         })
     }
@@ -198,14 +189,6 @@ impl State {
         self.term
             .clear(Clear::LineToEnd)
             .map_err(Error::TerminalError)?;
-        self.term
-            .set_cursor_position(self.buffer.height(), self.buffer.width() - 10)
-            .map_err(Error::TerminalError)?;
-        self.term
-            .set_foreground(Color::White)
-            .map_err(Error::TerminalError)?;
-        write!(self.term, "{} {}", self.buffer.filetype(), self.key_seq)
-            .map_err(Error::TerminalFmtError)?;
 
         self.term.reset_style().map_err(Error::TerminalError)?;
 
@@ -285,100 +268,24 @@ impl State {
     pub fn set_mode(&mut self, target: SetMode) {
         self.top_mode = TopMode::Normal;
         self.message = None;
-        self.key_seq.clear();
         self.buffer.set_mode(&self.config.borrow(), target);
     }
 
-    fn key_seq(&self, mode: Mode) -> Option<&PrefixNode<KeySeq, AnyFunction>> {
-        match mode {
-            Mode::Normal => self.normal_map.get(&self.key_seq),
-            Mode::Insert => self.insert_map.get(&self.key_seq),
+    pub fn set_top_mode(&mut self, target: TopMode) {
+        if self.top_mode == target {
+            return;
         }
+
+        self.top_mode = target;
+        self.message = None;
+        self.command.clear();
+        self.buffer.set_mode(&self.config.borrow(), SetMode::Normal);
     }
 
-    fn handle_mode_key(&mut self, mode: Mode, key: TermKey) -> Option<AnyFunction> {
-        self.key_seq.push(key);
-        match self.key_seq(mode) {
-            Some(PrefixNode::Leaf(action)) => {
-                let action = action.clone();
-                self.key_seq.clear();
-                return Some(action);
-            }
-            Some(PrefixNode::Prefix(_)) => {}
-            None => self.key_seq.clear(),
-        }
-        None
-    }
-
-    fn handle_normal_key(&mut self, key: TermKey) -> Option<AnyFunction> {
-        match key {
-            TermKey::Escape => {
-                self.key_seq.clear();
-                self.buffer.set_mode(&self.config.borrow(), SetMode::Normal);
-                None
-            }
-            TermKey::Char(':') => {
-                self.key_seq.clear();
-                self.command.clear();
-                self.status = None;
-                self.top_mode = TopMode::Command;
-                None
-            }
-            _ => self.handle_mode_key(Mode::Normal, key),
-        }
-    }
-
-    fn handle_insert_key(&mut self, key: TermKey) -> Option<AnyFunction> {
-        match key {
-            TermKey::Escape => {
-                self.buffer.set_mode(&self.config.borrow(), SetMode::Normal);
-                None
-            }
-            TermKey::Char(key)
-                if !key.is_ascii() || key == ' ' || key == '\t' || key.is_ascii_graphic() =>
-            {
-                self.buffer.insert(&self.config.borrow(), key);
-                None
-            }
-            _ => self.handle_mode_key(Mode::Insert, key),
-        }
-    }
-
-    fn handle_command_key(&mut self, key: TermKey) -> Action {
-        match key {
-            TermKey::Char('\n') | TermKey::Char('\x0D') => {
-                self.top_mode = TopMode::Normal;
-                let command = mem::take(&mut self.command);
-                return Action::Command(command);
-            }
-            TermKey::Char('\x7F') => {
-                if self.command.is_empty() {
-                    self.top_mode = TopMode::Normal;
-                } else {
-                    self.command.pop();
-                }
-            }
-            TermKey::Escape => {
-                self.top_mode = TopMode::Normal;
-            }
-            TermKey::Char(c) if c.is_ascii_graphic() || c == ' ' => self.command.push(c),
-            _ => (),
-        }
-        Action::None
-    }
-
-    pub fn handle_key(&mut self, key: TermKey) -> Action {
-        if self.message.is_some() {
-            self.message = None;
-            if key != TermKey::Char(':') {
-                return Action::None;
-            }
-        }
-
-        match (self.top_mode, self.buffer.mode()) {
-            (TopMode::Normal, Mode::Normal) => self.handle_normal_key(key).into(),
-            (TopMode::Normal, Mode::Insert) => self.handle_insert_key(key).into(),
-            (TopMode::Command, _) => self.handle_command_key(key),
+    pub fn write_text(&mut self, text: &str) {
+        let config = self.config.borrow();
+        for char in text.chars() {
+            self.buffer.insert(&config, char);
         }
     }