From 898077894ef84cb5a3da2140f5104208e82e78ef Mon Sep 17 00:00:00 2001 From: Qiantan Hong Date: Sat, 23 Nov 2024 18:37:43 +0800 Subject: [PATCH] terminal emulator --- README.md | 4 + doc/intro.html | 2 +- neomacs.asd | 12 +++ term/package.lisp | 2 + term/term-helper.c | 24 +++++ term/term.lisp | 222 +++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 265 insertions(+), 1 deletion(-) create mode 100644 term/package.lisp create mode 100644 term/term-helper.c create mode 100644 term/term.lisp diff --git a/README.md b/README.md index b52eb42..2060493 100644 --- a/README.md +++ b/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` diff --git a/doc/intro.html b/doc/intro.html index b65e8a8..8233f80 100644 --- a/doc/intro.html +++ b/doc/intro.html @@ -1 +1 @@ -

Introduction

Welcome to Neomacs, the structural Lisp system!

Run command by name: execute-command (M-x). Quit Neomacs: kill-neomacs (C-x C-c). Show index of manual: M-x manual. Describe key: M-x describe-key.

Managing windows and buffers

Buffer commands: switch-to-buffer (C-x b), delete-buffer (C-x k)

Window commands: other-window (C-x o), split-window-below (C-x 2), split-window-right (C-x 3), close-window (C-x 0), delete-other-windows (C-x 1)

See window management commands and buffer management commands for more details.

Switch to *scratch* buffer to play with some Lisp!

Editing files

fundoc'find-file

To get started, see motion, editing commands, undo commands and clipboard commands.

Motion: forward-node (C-f), backward-node (C-b), forward-word (M-f), backward-word (M-b), forward-element-end (C-M-f), backward-element (C-M-b), next-line (C-n), previous-line (C-p), scroll-down-command (C-v), scroll-up-command (M-v).

Search: search-forward (C-s), search-backward (C-r).

Undo: undo-history (C-x u). Once undo history view is active, use undo-command (p), redo-command (n), previous-branch (b), next-branch (f) to time travel.

Clipboard: cut-element (C-w), copy-element (M-w), paste (C-y), paste-pop (M-y), set-selection (C-space).

Hacking Lisp

Inside lisp-mode buffers (e.g. the *scratch* buffer): eval-last-expression (C-x C-e), eval-print-last-expression (C-c C-p). Unprintable objects are printed as presentations, which looks like this: #<OBJECT ...>. Pressing enter on presentations opens the inspector.

Compile top-level form or file: compile-defun (C-c C-c), lisp-compile-file (C-c C-k).

Lookup definition of focused symbol: goto-definition (M-.).

Enable Neomacs debugger: M-x toggle-debug-on-error. Inside the debugger, press a to abort, press c to continue, press v on a stack frame to view its function definition.

Browsing Web

fundoc'find-url

Open links: add-hint (M-g), add-hint-ctrl (M-G).

History navigation: web-go-backward (C-c b), web-go-forward (C-c f). There is also a global history accessible via list-web-history and is used for find-url completion.

Configuration

Neomacs loads the config file (uiop:xdg-config-home "neomacs" "init.lisp") (usually located at ~/.config/neomacs/init.lisp 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 *scratch* buffer to try out customization, which takes effect immediately and throughout the current Neomacs session.

Example of customizing style: (set-style 'default '(:color "#f00")). To revert this change, evaluate (apply-theme :default). See Styles for more details.

Turning off funny sound effects: (setq *error-hook* 'do-nothing *quit-hook* 'do-nothing)

Example of adding key binds: (define-keys :global "s-o" 'find-file). See Defining keys for more details.

\ No newline at end of file +

Introduction

Welcome to Neomacs, the structural Lisp system!

Run command by name: execute-command (M-x). Quit Neomacs: kill-neomacs (C-x C-c). Show index of manual: M-x manual. Describe key: M-x describe-key.

Managing windows and buffers

Buffer commands: switch-to-buffer (C-x b), delete-buffer (C-x k)

Window commands: other-window (C-x o), split-window-below (C-x 2), split-window-right (C-x 3), close-window (C-x 0), delete-other-windows (C-x 1)

See window management commands and buffer management commands for more details.

Switch to *scratch* buffer to play with some Lisp!

Editing files

fundoc'find-file

To get started, see motion, editing commands, undo commands and clipboard commands.

Motion: forward-node (C-f), backward-node (C-b), forward-word (M-f), backward-word (M-b), forward-element-end (C-M-f), backward-element (C-M-b), next-line (C-n), previous-line (C-p), scroll-down-command (C-v), scroll-up-command (M-v).

Search: search-forward (C-s), search-backward (C-r).

Undo: undo-history (C-x u). Once undo history view is active, use undo-command (p), redo-command (n), previous-branch (b), next-branch (f) to time travel.

Clipboard: cut-element (C-w), copy-element (M-w), paste (C-y), paste-pop (M-y), set-selection (C-space).

Hacking Lisp

Inside lisp-mode buffers (e.g. the *scratch* buffer): eval-last-expression (C-x C-e), eval-print-last-expression (C-c C-p). Unprintable objects are printed as presentations, which looks like this: #<OBJECT ...>. Pressing enter on presentations opens the inspector.

Compile top-level form or file: compile-defun (C-c C-c), lisp-compile-file (C-c C-k).

Lookup definition of focused symbol: goto-definition (M-.).

Enable Neomacs debugger: M-x toggle-debug-on-error. Inside the debugger, press a to abort, press c to continue, press v on a stack frame to view its function definition.

Use the terminal (Linux)

M-x term 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. C-x and C-c) are not sent to the terminal, to send them, use term-quote-send-key (C-q). To scroll back and copy contents, press C-c C-j to turn off terminal-insert-mode. Once you are done, press C-c C-k to enable terminal-insert-mode again.

Browsing Web

fundoc'find-url

Open links: add-hint (M-g), add-hint-ctrl (M-G).

History navigation: web-go-backward (C-c b), web-go-forward (C-c f). There is also a global history accessible via list-web-history and is used for find-url completion.

Configuration

Neomacs loads the config file (uiop:xdg-config-home "neomacs" "init.lisp") (usually located at ~/.config/neomacs/init.lisp 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 *scratch* buffer to try out customization, which takes effect immediately and throughout the current Neomacs session.

Example of customizing style: (set-style 'default '(:color "#f00")). To revert this change, evaluate (apply-theme :default). See Styles for more details.

Turning off funny sound effects: (setq *error-hook* 'do-nothing *quit-hook* 'do-nothing)

Example of adding key binds: (define-keys :global "s-o" 'find-file). See Defining keys for more details.

\ No newline at end of file diff --git a/neomacs.asd b/neomacs.asd index 2b25d9c..5f90864 100644 --- a/neomacs.asd +++ b/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)) diff --git a/term/package.lisp b/term/package.lisp new file mode 100644 index 0000000..fff0d99 --- /dev/null +++ b/term/package.lisp @@ -0,0 +1,2 @@ +(defpackage #:neomacs/term + (:use #:cl #:iterate #:neomacs #:named-closure)) diff --git a/term/term-helper.c b/term/term-helper.c new file mode 100644 index 0000000..40dbb7c --- /dev/null +++ b/term/term-helper.c @@ -0,0 +1,24 @@ +#include +#include +#include + +#ifdef __APPLE__ +#include +#include +#else +#include +#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); + } +} diff --git a/term/term.lisp b/term/term.lisp new file mode 100644 index 0000000..4607ca1 --- /dev/null +++ b/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")))