130 lines
3.3 KiB
Plaintext
130 lines
3.3 KiB
Plaintext
(setq _red/command-table (hash/new))
|
|
|
|
;; Command text manipulation
|
|
(setq _red/current-command nil)
|
|
|
|
(defun red/command/append! (text)
|
|
(setq _red/current-command (+ (if _red/current-command _red/current-command "") text)))
|
|
(defun red/command/erase-backward! ()
|
|
(when _red/current-command
|
|
(setq _red/current-command (string/pop _red/current-command))))
|
|
(defun red/command/clear! () (setq _red/current-command nil))
|
|
|
|
;; Command macros
|
|
(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))
|
|
)
|
|
)
|
|
|
|
;; Command handlers
|
|
(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)
|
|
)
|
|
)
|
|
|
|
;; Root command handler
|
|
(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))
|
|
)
|
|
)
|
|
)
|
|
|
|
;; Command definitions
|
|
(declare-command "q" () (red/quit))
|
|
(declare-command "q!" () (red/quit #t))
|
|
(declare-command
|
|
"w" (&optional filename)
|
|
(if filename
|
|
(red/buffer/write filename)
|
|
(red/buffer/write)
|
|
)
|
|
)
|
|
(declare-command
|
|
"wq" ()
|
|
(red/buffer/write)
|
|
(red/quit)
|
|
)
|
|
(declare-command
|
|
"e" (&optional filename)
|
|
(if filename
|
|
(red/buffer/open filename)
|
|
)
|
|
)
|
|
(declare-command
|
|
"e!" (&optional filename)
|
|
(if filename
|
|
(red/buffer/open filename #t)
|
|
)
|
|
)
|
|
(declare-command
|
|
"source" (filename)
|
|
(import filename)
|
|
)
|
|
|
|
;; TODO only allow some keys to be set
|
|
;; TODO at least check that the key is defined
|
|
(declare-command
|
|
"set" (key &rest value)
|
|
(let* (
|
|
key-symbol (symbol (+ "red/" key))
|
|
expression (string/join value)
|
|
eval-result (if (nil? value) '(ok #t) (read-eval expression))
|
|
)
|
|
(cond
|
|
((result/ok? eval-result) (set key-symbol (cadr eval-result)))
|
|
(&otherwise (red/message (+ "error: " (cadr eval-result))))
|
|
)
|
|
)
|
|
)
|
|
(declare-command
|
|
"unset" (key)
|
|
(let (key-symbol (symbol (+ "red/" key)))
|
|
(set key-symbol nil)
|
|
)
|
|
)
|
|
(declare-command
|
|
"eval" (&rest expressions)
|
|
(let* (
|
|
expression (string/join expressions)
|
|
eval-result (read-eval expression)
|
|
)
|
|
(cond
|
|
((result/ok? eval-result) (red/status (+ "=> " (cadr eval-result))))
|
|
(&otherwise (red/message (+ "error: " (cadr eval-result))))
|
|
)
|
|
)
|
|
)
|