terminal emulator

README.md

@@ -10,8 +10,12 @@ is a usable Lisp IDE and keyboard-driven browser.
 
 Prebuilt binary for x64 Linux: https://github.com/neomacs-project/neomacs/releases/
 
+Documentation: `M-x manual`. There is also an online version at https://neomacs-project.github.io/doc/toc.html
+
 To build locally, make sure you have SBCL, quicklisp, and the Ultralisp dist (if you haven't done so, `(ql-dist:install-dist "http://dist.ultralisp.org/" :prompt nil)`). Clone this repo and `https://github.com/ceramic/ceramic` under `~/quicklisp/local-projects/`. Then `(ql:quickload "neomacs")` and `(neomacs:start)`.
 
+To build the terminal emulator (currently Linux only), clone `https://github.com/neomacs-project/3bst` under `~/quicklisp/local-projects/` then `(ql:quickload "neomacs/term")`.
+
 Neomacs relies on Electron which has known permission issues on some Linux distros. Try the following workaround:
 
 1. `sudo sysctl -w kernel.apparmor_restrict_unprivileged_userns=0`

doc/intro.html

@@ -1 +1 @@
-<h1 operator="">Introduction</h1><p>Welcome to Neomacs, the structural Lisp system!</p><p>Run command by name: <code>execute-command (M-x)</code>. Quit Neomacs: <code>kill-neomacs (C-x C-c)</code>. Show index of manual: <code>M-x manual</code>. Describe key: <code>M-x describe-key</code>.</p><h2>Managing windows and buffers</h2><p>Buffer commands: <code>switch-to-buffer (C-x b)</code>, <code>delete-buffer (C-x k)</code></p><p>Window commands: <code>other-window (C-x o)</code>, <code>split-window-below (C-x 2)</code>, <code>split-window-right (C-x 3)</code>, <code>close-window (C-x 0)</code>, <code>delete-other-windows (C-x 1)</code></p><p>See <a href="window-management.html#window-management-commands">window management commands</a> and <a href="buffers.html#buffer-management-commands">buffer management commands</a> for more details.</p><p>Switch to <code>*scratch*</code> buffer to play with some Lisp!</p><h2>Editing files</h2><dl><dt operator="" class=" comma-expr"><div class="list" operator=""><span class="symbol" operator="">fundoc</span><span class="symbol">'find-file</span></div></dt></dl><p>To get started, see   <a href="motion.html">motion</a>,  <a href="edit.html#editing-commands">editing commands</a>, <a href="undo.html#undo-commands">undo commands</a> and <a href="edit.html#clipboard-commands">clipboard commands</a>.</p><p>Motion: <code>forward-node (C-f)</code>, <code>backward-node (C-b)</code>, <code>forward-word (M-f)</code>, <code>backward-word (M-b)</code>, <code>forward-element-end (C-M-f)</code>, <code>backward-element (C-M-b)</code>, <code>next-line (C-n)</code>, <code>previous-line (C-p)</code>, <code>scroll-down-command (C-v)</code>, <code>scroll-up-command (M-v)</code>.</p><p>Search: <code>search-forward (C-s)</code>, <code>search-backward (C-r)</code>.</p><p>Undo: <code>undo-history (C-x u)</code>. Once undo history view is active, use <code>undo-command (p)</code>, <code>redo-command (n)</code>, <code>previous-branch (b)</code>, <code>next-branch (f)</code> to time travel.</p><p>Clipboard: <code>cut-element (C-w)</code>, <code>copy-element (M-w)</code>, <code>paste (C-y)</code>, <code>paste-pop (M-y)</code>, <code>set-selection (C-space)</code>.</p><h2>Hacking Lisp</h2><p>Inside <code>lisp-mode</code> buffers (e.g. the <code>*scratch*</code> buffer): <code>eval-last-expression (C-x C-e)</code>, <code>eval-print-last-expression (C-c C-p)</code>. Unprintable objects are printed as <i>presentations</i>, which looks like this: <u>#&lt;OBJECT ...&gt;</u>. Pressing <code>enter</code> on presentations opens the inspector.</p><p>Compile top-level form or file: <code>compile-defun (C-c C-c)</code>, <code>lisp-compile-file (C-c C-k)</code>.</p><p>Lookup definition of focused symbol: <code>goto-definition (M-.)</code>.</p><p>Enable Neomacs debugger: <code>M-x toggle-debug-on-error</code>. Inside the debugger, press <code>a</code> to abort, <code>press c</code> to continue, press <code>v</code> on a stack frame to view its function definition.</p><h2>Browsing Web</h2><dl><dt operator="" class=" comma-expr"><div class="list" operator=""><span class="symbol" operator="">fundoc</span><span class="symbol">'find-url</span></div></dt></dl><p>Open links: <code>add-hint (M-g)</code>, <code>add-hint-ctrl (M-G)</code>.</p><p>History navigation: <code>web-go-backward (C-c b)</code>, <code>web-go-forward (C-c f)</code>. There is also a global history accessible via <code>list-web-history</code> and is used for <code>find-url</code> completion.</p><h2>Configuration</h2><p>Neomacs loads the config file <code>(uiop:xdg-config-home &quot;neomacs&quot; &quot;init.lisp&quot;)</code> (usually located at <code>~/.config/neomacs/init.lisp</code> on Unix-like systems) on startup if it exists. You can put Lisp code in the config file to customize Neomacs. You can also evaluate Lisp expressions in the <code>*scratch*</code> buffer to try out customization, which takes effect immediately and throughout the current Neomacs session.</p><p>Example of customizing style: <code>(set-style 'default '(:color &quot;#f00&quot;))</code>. To revert this change, evaluate <code>(apply-theme :default)</code>. See <a href="styles.html">Styles</a> for more details.</p><p>Turning off funny sound effects: <code>(setq *error-hook* 'do-nothing *quit-hook* 'do-nothing)</code></p><p>Example of adding key binds: <code>(define-keys :global &quot;s-o&quot; 'find-file)</code>. See <a href="keymaps.html#defining-keys">Defining keys</a> for more details.</p>
+<h1 operator="">Introduction</h1><p>Welcome to Neomacs, the structural Lisp system!</p><p>Run command by name: <code>execute-command (M-x)</code>. Quit Neomacs: <code>kill-neomacs (C-x C-c)</code>. Show index of manual: <code>M-x manual</code>. Describe key: <code>M-x describe-key</code>.</p><h2>Managing windows and buffers</h2><p>Buffer commands: <code>switch-to-buffer (C-x b)</code>, <code>delete-buffer (C-x k)</code></p><p>Window commands: <code>other-window (C-x o)</code>, <code>split-window-below (C-x 2)</code>, <code>split-window-right (C-x 3)</code>, <code>close-window (C-x 0)</code>, <code>delete-other-windows (C-x 1)</code></p><p>See <a href="window-management.html#window-management-commands">window management commands</a> and <a href="buffers.html#buffer-management-commands">buffer management commands</a> for more details.</p><p>Switch to <code>*scratch*</code> buffer to play with some Lisp!</p><h2>Editing files</h2><dl><dt operator="" class=" comma-expr"><div class="list" operator=""><span class="symbol" operator="">fundoc</span><span class="symbol">'find-file</span></div></dt></dl><p>To get started, see   <a href="motion.html">motion</a>,  <a href="edit.html#editing-commands">editing commands</a>, <a href="undo.html#undo-commands">undo commands</a> and <a href="edit.html#clipboard-commands">clipboard commands</a>.</p><p>Motion: <code>forward-node (C-f)</code>, <code>backward-node (C-b)</code>, <code>forward-word (M-f)</code>, <code>backward-word (M-b)</code>, <code>forward-element-end (C-M-f)</code>, <code>backward-element (C-M-b)</code>, <code>next-line (C-n)</code>, <code>previous-line (C-p)</code>, <code>scroll-down-command (C-v)</code>, <code>scroll-up-command (M-v)</code>.</p><p>Search: <code>search-forward (C-s)</code>, <code>search-backward (C-r)</code>.</p><p>Undo: <code>undo-history (C-x u)</code>. Once undo history view is active, use <code>undo-command (p)</code>, <code>redo-command (n)</code>, <code>previous-branch (b)</code>, <code>next-branch (f)</code> to time travel.</p><p>Clipboard: <code>cut-element (C-w)</code>, <code>copy-element (M-w)</code>, <code>paste (C-y)</code>, <code>paste-pop (M-y)</code>, <code>set-selection (C-space)</code>.</p><h2>Hacking Lisp</h2><p>Inside <code>lisp-mode</code> buffers (e.g. the <code>*scratch*</code> buffer): <code>eval-last-expression (C-x C-e)</code>, <code>eval-print-last-expression (C-c C-p)</code>. Unprintable objects are printed as <i>presentations</i>, which looks like this: <u>#&lt;OBJECT ...&gt;</u>. Pressing <code>enter</code> on presentations opens the inspector.</p><p>Compile top-level form or file: <code>compile-defun (C-c C-c)</code>, <code>lisp-compile-file (C-c C-k)</code>.</p><p>Lookup definition of focused symbol: <code>goto-definition (M-.)</code>.</p><p>Enable Neomacs debugger: <code>M-x toggle-debug-on-error</code>. Inside the debugger, press <code>a</code> to abort, <code>press c</code> to continue, press <code>v</code> on a stack frame to view its function definition.</p><h2>Use the terminal (Linux)</h2><p><code operator="">M-x term</code> to open the terminal emulator. The terminal opens in insert mode by default, which sends most key strokes to the terminal and synchronize the cursor with the terminal. A few key strokes (e.g. <code>C-x</code> and <code>C-c</code>) are not sent to the terminal, to send them, use <code>term-quote-send-key (C-q)</code>. To scroll back and copy contents, press <code>C-c C-j</code> to turn off <code>terminal-insert-mode</code>. Once you are done, press <code>C-c C-k</code> to enable <code>terminal-insert-mode</code> again.</p><h2>Browsing Web</h2><dl><dt operator="" class=" comma-expr"><div class="list" operator=""><span class="symbol" operator="">fundoc</span><span class="symbol">'find-url</span></div></dt></dl><p>Open links: <code>add-hint (M-g)</code>, <code>add-hint-ctrl (M-G)</code>.</p><p>History navigation: <code>web-go-backward (C-c b)</code>, <code>web-go-forward (C-c f)</code>. There is also a global history accessible via <code>list-web-history</code> and is used for <code>find-url</code> completion.</p><h2>Configuration</h2><p>Neomacs loads the config file <code>(uiop:xdg-config-home &quot;neomacs&quot; &quot;init.lisp&quot;)</code> (usually located at <code>~/.config/neomacs/init.lisp</code> on Unix-like systems) on startup if it exists. You can put Lisp code in the config file to customize Neomacs. You can also evaluate Lisp expressions in the <code>*scratch*</code> buffer to try out customization, which takes effect immediately and throughout the current Neomacs session.</p><p>Example of customizing style: <code>(set-style 'default '(:color &quot;#f00&quot;))</code>. To revert this change, evaluate <code>(apply-theme :default)</code>. See <a href="styles.html">Styles</a> for more details.</p><p>Turning off funny sound effects: <code>(setq *error-hook* 'do-nothing *quit-hook* 'do-nothing)</code></p><p>Example of adding key binds: <code>(define-keys :global &quot;s-o&quot; 'find-file)</code>. See <a href="keymaps.html#defining-keys">Defining keys</a> for more details.</p>

neomacs.asd

@@ -72,3 +72,15 @@
   :serial t
   :components ((:file "asdf-bundler")
                (:file "deploy")))
+
+(asdf:defsystem neomacs/term
+  :defsystem-depends-on (:cffi-toolchain)
+  :license "GPLv3+"
+  :components
+  ((:module "term"
+    :serial t
+    :components
+    ((:file "package")
+     (:file "term")
+     (:c-file "term-helper"))))
+  :depends-on (:neomacs :3bst))

term/package.lisp

@@ -0,0 +1,2 @@
+(defpackage #:neomacs/term
+  (:use #:cl #:iterate #:neomacs #:named-closure))

term/term-helper.c

@@ -0,0 +1,24 @@
+#include <stdlib.h>
+#include <unistd.h>
+#include <assert.h>
+
+#ifdef __APPLE__
+#include <util.h>
+#include <sys/ioctl.h>
+#else
+#include <pty.h>
+#endif
+
+__asm__(".symver forkpty,forkpty@GLIBC_2.2.5");
+
+void run_shell(int rows, int cols, const char *program, char* const argv[],
+               const char *term_env, pid_t* pid, int* fd)
+{
+  struct winsize win = { rows, cols, 0, 0 };
+  *pid = forkpty(fd, NULL, NULL, &win);
+  assert(*pid >= 0);
+  if (*pid == 0) {
+    setenv("TERM", term_env, 1);
+    assert(execvp(program, argv) >= 0);
+  }
+}

term/term.lisp

@@ -0,0 +1,222 @@
+(in-package #:3bst)
+
+;; Patch 3bst to support scrollback
+
+(defun tscrollup (orig n &key (term *term*))
+  (let* ((bottom (bottom term)) (n (limit n 0 (1+ (- bottom orig))))
+         (screen (screen term)))
+    (neomacs/term::insert-scrollback (aref screen orig))
+    (tclearregion 0 orig (1- (columns term)) (1- (+ orig n)) :term term)
+    (tsetdirt (+ orig n) bottom :term term)
+    (loop for i from orig to (- bottom n)
+          do (rotatef (aref screen i)
+                      (aref screen (+ i n))))))
+
+(in-package #:neomacs/term)
+
+(define-mode term-mode (read-only-mode doc-mode)
+  ((for-term
+    :initform (make-instance
+               '3bst:term
+               :rows 24
+               :columns 80))
+   (pid :initarg :pid)
+   (pty :initarg :pty)
+   (thread)
+   (line-starts)
+   (scrollback-lines :initform nil)))
+
+(defmethod enable-aux ((mode-name (eql 'term-mode)))
+  (let* ((buffer (current-buffer))
+         (3bst:*term* (for-term buffer)))
+    (3bst::tresize (3bst:columns 3bst:*term*) (3bst:rows 3bst:*term*))
+    (3bst::treset)
+    (setf (line-starts buffer)
+          (let ((*inhibit-read-only* t))
+            (iter (for i below (3bst:rows 3bst:*term*))
+              (for node = (neomacs::make-new-line-node))
+              (insert-nodes (end-pos (document-root buffer)) node)
+              (collect node)))
+          (thread buffer)
+          (bt2:make-thread
+           (lambda ()
+             (let (*print-readably*)
+               (handler-case
+                   (iter (for c = (read-char-no-hang (pty buffer)
+                                                     nil 'eof))
+                     (until (eql c 'eof))
+                     (if c
+                         (let ((3bst:*term* (for-term buffer))
+                               (neomacs::*current-buffer* buffer))
+                           (3bst:handle-input (string c)))
+                         (progn
+                           (when (typep buffer 'term-insert-mode)
+                             (with-current-buffer buffer
+                               (when (buffer-alive-p buffer)
+                                 (when (find-if #'plusp
+                                                (3bst:dirty (for-term buffer)))
+                                   (redisplay-term (for-term buffer) buffer))
+                                 (redisplay-focus (for-term buffer) buffer))))
+                           (sleep 0.05))))
+                 (stream-error ()))
+               (with-current-buffer buffer
+                 (when (buffer-alive-p buffer)
+                   (delete-buffer buffer)))))
+           :name "Terminal listener"))))
+
+(defmethod selectable-p-aux ((buffer term-mode) pos)
+  (and (or (text-pos-p pos) (new-line-node-p pos))
+       (call-next-method)))
+
+(defmethod on-delete-buffer progn ((buffer term-mode))
+  (sb-posix:close (pty buffer))
+  (sb-posix:kill (pid buffer) sb-unix:sighup)
+  (sb-posix:waitpid (pid buffer) 0))
+
+(defun render-line (line)
+  (let ((stream (make-string-output-stream))
+        last-color)
+    (flet ((emit ()
+             (let ((output (get-output-stream-string stream)))
+               (when (plusp (length output))
+                 (list (neomacs::make-element
+                        "span"
+                        :style (format nil "color:#~{~2,'0x~};"
+                                       (mapcar
+                                        (lambda (c)
+                                          (floor
+                                           (* c 255)))
+                                        last-color))
+                        :children (list output)))))))
+      (nconc
+       (iter (for c in-vector line)
+         (for color = (3bst:color-rgb (3bst:fg c)))
+         (unless (or (not last-color) (equal color last-color))
+           (nconcing (emit)))
+         (write-char (3bst:c c) stream)
+         (setq last-color color))
+       (emit)))))
+
+(defun redisplay-term (term buffer)
+  (let ((*inhibit-read-only* t))
+    (iter (for line in (nreverse (scrollback-lines buffer)))
+      (apply #'insert-nodes (car (line-starts buffer))
+             (make-new-line-node) line))
+    (setf (scrollback-lines buffer) nil)
+    (iter (with dirty = (3bst:dirty term))
+      (for row below (3bst:rows term))
+      (for (beg end) on (line-starts buffer))
+      (when (plusp (aref dirty row))
+        (delete-nodes (pos-right beg) end)
+        (apply #'insert-nodes
+         (pos-right beg)
+         (render-line (aref (3bst::screen term) row)))
+        (setf (aref dirty row) 0)))))
+
+(defun redisplay-focus (term buffer)
+  (let* ((cursor (3bst::cursor term))
+         (x (3bst::x cursor))
+         (y (3bst::y cursor))
+         (pos (pos-right (nth y (line-starts buffer)))))
+    (iter (for _ to x)
+      (setf pos (or (npos-next-until pos #'text-pos-p) pos)))
+    (setf (pos (focus buffer)) pos)))
+
+(defun insert-scrollback (line)
+  (push (render-line line) (scrollback-lines neomacs::*current-buffer*)))
+
+(cffi:defcfun ("run_shell" %run-shell) :void
+  (rows :int) (cols :int) (program :string) (argv :pointer) (term-env :string)
+  (pid :pointer) (fd :pointer))
+
+(defun run-shell (rows cols cmd args term-env)
+  (let* ((string-pointers (mapcar #'cffi:foreign-string-alloc args))
+         (argv-pointer (cffi:foreign-alloc
+                        :pointer :null-terminated-p t
+                        :initial-contents string-pointers)))
+    (unwind-protect
+         (cffi:with-foreign-objects
+             ((pid-pointer :int)
+              (fd-pointer :int))
+           (setf (cffi:mem-ref pid-pointer :int) 0
+                 (cffi:mem-ref fd-pointer :int) 0)
+           (%run-shell rows cols cmd argv-pointer term-env
+                       pid-pointer fd-pointer)
+           (values (cffi:mem-ref pid-pointer :int)
+                   (cffi:mem-ref fd-pointer :int)))
+      (mapc #'cffi:foreign-string-free string-pointers)
+      (cffi:foreign-free argv-pointer))))
+
+(define-mode term-insert-mode () ()
+  (:lighter "Insert")
+  (:toggler t)
+  (:documentation "Forward most keys to terminal."))
+
+(define-command term ()
+  "Start terminal emulator."
+  (multiple-value-bind (pid fd)
+      (run-shell 25 80 "/bin/bash" nil "st-256color")
+    (switch-to-buffer
+     (make-buffer
+      "*term*" :mode '(term-insert-mode term-mode) :pid pid
+      :pty (sb-sys:make-fd-stream fd :input t :output t
+                                     :dual-channel-p t)))))
+
+(defnclo term-send-seq-command (string) ()
+  (term-send-seq string))
+
+(define-keys term-mode
+  "C-c C-k" 'term-insert-mode)
+
+(define-keys term-insert-mode
+  'self-insert-command 'term-forward-key
+  'backward-delete (make-term-send-seq-command "")
+  'backward-delete-word (make-term-send-seq-command "")
+  "enter" 'term-forward-key
+  "tab" 'term-forward-key
+  "escape" (make-term-send-seq-command "")
+  "C-q" 'term-quote-send-key
+  "C-c C-j" 'term-insert-mode)
+
+(iter (for i from (char-code #\a) to (char-code #\z))
+  (for char = (code-char i))
+  (unless (member char '(#\x #\c #\q))
+    (set-key (find-keymap 'term-insert-mode)
+             (format nil "C-~a" char) 'term-forward-key)
+    (set-key (find-keymap 'term-insert-mode)
+             (format nil "M-~a" char) 'term-forward-key)))
+
+(defun term-send-seq (string)
+  (let* ((buffer (current-buffer))
+         (3bst:*term* (for-term buffer))
+         (3bst::*write-to-child-hook*
+           (lambda (term string)
+             (declare (ignore term))
+             (write-string string (pty buffer))
+             (finish-output (pty buffer)))))
+    (3bst::tty-send string)))
+
+(defun term-send-key (key)
+  (let ((seq (key-sym key)))
+    (when (equal seq "Space") (setf seq " "))
+    (when (equal seq "Enter") (setf seq "
+"))
+    (when (equal seq "Tab") (setf seq "	"))
+    (when (key-ctrl key)
+      (setf seq (string (code-char (1+ (- (char-code (aref seq 0))
+                                          (char-code #\a)))))))
+    (when (key-meta key)
+      (setf seq (str:concat "" seq)))
+    (term-send-seq seq)))
+
+(define-command term-forward-key
+  :mode term-mode ()
+  "Send this key to terminal."
+  (term-send-key (car (last *this-command-keys*))))
+
+(define-command term-quote-send-key
+  :mode term-mode ()
+  "Send the next key to terminal."
+  (term-send-key (read-key "Send to terminal: ")))
+
+(defsheet term-mode `(("body" :font-family "monospace")))