emacsrepl++

emacsrepl.el

;; https://github.com/antirez/linenoise
;; console_codes(4)

(defvar column-start "\e[0G")
(defvar delete-to-end "\e[0K")
(defvar retreat-cursor "\e[%sD")
(defvar advance-cursor "\e[%sC")
(defvar clear-screen "\e[H\e[2J")

(defun read-byte ()
  (string-to-number (read-from-minibuffer "") 16))

(defun read-sequence ()
  ;; TODO test out `locale charmap` and `iconv -t UTF-32 -`
  ;; NOTE how would one convert from utf-32 to utf-8 though?
  (let ((state 'start)
        char output)
    (while (not (eq state 'end))
      (setq char (read-byte))
      (push char output)
      (cond
       ((eq state 'start)
        (if (= char ?\e)
            (setq state 'escape)
          (setq state 'end)))
       ((eq state 'escape)
        (if (= char ?\[)
            (setq state 'csi)
          (setq state 'end)))
       ((eq state 'csi)
        (if (and (>= char ?0) (<= char ?9))
            (setq state 'csi)
          (setq state 'end)))))
    (concat (nreverse output))))

(defun char-unprintable-p (char)
  (or (< char ?\s) (>= char ?\C-?)))

(defun printed-representation (chars)
  (mapconcat
   (lambda (char)
     (if (char-unprintable-p char)
         (cond
          ((< char ?\s)
           (format "^%c" (logior char 64)))
          ((= char ?\C-?)
           "^?")
          ((> char ?\C-?)
           (format "\\%o" char)))
       (format "%c" char)))
   chars ""))

(define-error 'readline-cancel "Input cancelled")

(defun read-line (prompt)
  (with-temp-buffer
    (princ prompt)
    (let (eol return)
      (while (not (or eol return))
        (let* ((chars (read-sequence)))
          (cond
           ((equal chars "\C-l")
            (princ clear-screen)
            (princ prompt)
            (princ (buffer-string)))
           ((or (equal chars "\C-b")
                (equal chars "\e[D")) ; <left>
            (when (not (bobp))
              (princ (format retreat-cursor 1))
              (forward-char -1)))
           ((or (equal chars "\C-f")
                (equal chars "\e[C")) ; <right>
            (when (not (eobp))
              (princ (format advance-cursor 1))
              (forward-char 1)))
           ((equal chars "\C-a")
            (when (not (bobp))
              (princ column-start)
              (princ (format advance-cursor (length prompt)))
              (goto-char (point-min))))
           ((equal chars "\C-e")
            (when (not (eobp))
              (princ (format advance-cursor (- (point-max) (point))))
              (goto-char (point-max))))
           ((or (equal chars "\C-h")
                (equal chars "\C-?"))
            (when (not (bobp))
              (princ (format retreat-cursor 1))
              (princ delete-to-end)
              (when (not (eobp))
                (princ (buffer-substring (point) (point-max)))
                (princ (format retreat-cursor (- (point-max) (point)))))
              (delete-char -1)))
           ((equal chars "\C-d")
            (if (zerop (buffer-size)) ; empty prompt
                (setq eol t)
              (when (not (eobp))
                (princ delete-to-end)
                (when (> (- (point-max) (point)) 1)
                  (princ (buffer-substring (1+ (point)) (point-max)))
                  (princ (format retreat-cursor (- (point-max) (1+ (point))))))
                (delete-char 1))))
           ((equal chars "\e[3~") ; DEL
            (when (not (eobp))
              (princ delete-to-end)
              (when (> (- (point-max) (point)) 1)
                (princ (buffer-substring (1+ (point)) (point-max)))
                (princ (format retreat-cursor (- (point-max) (1+ (point))))))
              (delete-char 1)))
           ((or (equal chars "\C-j")
                (equal chars "\C-m"))
            (princ "\n")
            (setq return t))
           ((equal chars "\C-c")
            (princ "\n")
            (signal 'readline-cancel nil))
           (t
            (let ((representation (printed-representation chars)))
              (princ representation)
              (when (> (- (point-max) (point)) 1)
                (princ delete-to-end)
                (princ (buffer-substring (point) (point-max)))
                (princ (format retreat-cursor (- (point-max) (point)))))
              (insert representation))))))
        (if return
            (buffer-string)
          nil))))


(defun rep (input)
  (let ((form (read input)))
    (prin1-to-string (eval form))))

(defun repl ()
  (let (eof)
    (while (not eof)
      (condition-case err
          (let ((line (read-line "EMACS> ")))
            (if line
                (princ (format "%s\n" (rep line)))
              (princ "\n")
              (setq eof t)))
        (readline-cancel) ; proceed with new prompt
        (error
         (princ (format "%s\n" (error-message-string err))))))))

(repl)

emacsrepl.sh

#!/bin/bash

OLD=$(stty -g)
stty raw -echo opost
trap 'stty "$OLD"' EXIT

SCRIPT="$(dirname $0)/emacsrepl.el"
run_repl () {
  emacs -Q --batch --load "$SCRIPT"
  pkill -P $$ -x od
}

stdbuf -oL od -w1 -An -tx1 -v | sed -u -e 's/^ //' | run_repl