[WIP] add libvterm support

configure.ac

@@ -3772,6 +3772,17 @@ fi
 AC_SUBST(LIBXML2_LIBS)
 AC_SUBST(LIBXML2_CFLAGS)
 
+HAVE_LIBVTERM=no
+AC_DEFINE(HAVE_LIBVTERM, 1, [do I need this])
+LIBVTERM_LIBS="-lvterm"
+
+AC_SUBST(LIBVTERM_LIBS)
+AC_SUBST(LIBVTERM_CFLAGS)
+
+
+
+
+
 BLESSMAIL_TARGET=
 LIBS_MAIL=
 if test ! "$with_mailutils"; then

lisp/vterm.el

@@ -0,0 +1,234 @@
+(require 'subr-x)
+(require 'cl-lib)
+(require 'color)
+
+(defface vterm
+  '((t :inherit default))
+  "Default face to use in Term mode."
+  :group 'vterm)
+
+(defface vterm-color-black
+  '((t :foreground "black" :background "black"))
+  "Face used to render black color code."
+  :group 'vterm)
+
+(defface vterm-color-red
+  '((t :foreground "red3" :background "red3"))
+  "Face used to render red color code."
+  :group 'vterm)
+
+(defface vterm-color-green
+  '((t :foreground "green3" :background "green3"))
+  "Face used to render green color code."
+  :group 'vterm)
+
+(defface vterm-color-yellow
+  '((t :foreground "yellow3" :background "yellow3"))
+  "Face used to render yellow color code."
+  :group 'vterm)
+
+(defface vterm-color-blue
+  '((t :foreground "blue2" :background "blue2"))
+  "Face used to render blue color code."
+  :group 'vterm)
+
+(defface vterm-color-magenta
+  '((t :foreground "magenta3" :background "magenta3"))
+  "Face used to render magenta color code."
+  :group 'vterm)
+
+(defface vterm-color-cyan
+  '((t :foreground "cyan3" :background "cyan3"))
+  "Face used to render cyan color code."
+  :group 'vterm)
+
+(defface vterm-color-white
+  '((t :foreground "white" :background "white"))
+  "Face used to render white color code."
+  :group 'vterm)
+
+(defcustom vterm-shell (getenv "SHELL")
+  "The shell that gets run in the vterm."
+  :type 'string
+  :group 'vterm)
+
+(defcustom vterm-display-method 'switch-to-buffer
+  "Default display method."
+  :type '(choice (const :tag "Display buffer." 'switch-to-buffer)
+                 (const :tag "Pop to buffer." 'pop-to-buffer))
+  :group 'vterm)
+
+(defcustom vterm-max-scrollback 1000
+  "Maximum 'scrollback' value."
+  :type 'number
+  :group 'vterm)
+
+(defcustom vterm-keymap-exceptions '("C-c" "C-x" "C-u" "C-g" "C-h" "M-x" "M-o" "C-v" "M-v" "C-y")
+  "Exceptions for vterm-keymap.
+
+  If you use a keybinding with a prefix-key, add that prefix-key to
+  this list. Note that after doing so that prefix-key cannot be sent
+  to the terminal anymore."
+  :type '(repeat string)
+  :group 'vterm)
+
+(defcustom vterm-set-title-hook nil
+  "Shell set title hook.
+
+  those functions are called one by one, with 1 arguments.
+  `vterm-set-title-hook' should be a symbol, a hook variable.
+  The value of HOOK may be nil, a function, or a list of functions.
+  for example
+  (defun vterm--rename-buffer-as-title (title)
+    (rename-buffer (format \"vterm %s\" title)))
+  (add-hook 'vterm-set-title-hook 'vterm--rename-buffer-as-title)
+
+  see http://tldp.org/HOWTO/Xterm-Title-4.html about how to set terminal title
+  for different shell. "
+  :type 'hook
+  :group 'vterm)
+
+(defvar vterm--term nil
+  "Pointer to Term.")
+(make-variable-buffer-local 'vterm--term)
+
+(defvar vterm-buffer-name "*vterm*"
+  "Buffer name for vterm buffers.")
+
+(defvar vterm-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [tab]                       #'vterm--self-insert)
+    (define-key map [backspace]                 #'vterm--self-insert)
+    (define-key map [M-backspace]               #'vterm--self-insert)
+    (define-key map [return]                    #'vterm--self-insert)
+    (define-key map [left]                      #'vterm--self-insert)
+    (define-key map [right]                     #'vterm--self-insert)
+    (define-key map [up]                        #'vterm--self-insert)
+    (define-key map [down]                      #'vterm--self-insert)
+    (define-key map [home]                      #'vterm--self-insert)
+    (define-key map [end]                       #'vterm--self-insert)
+    (define-key map [escape]                    #'vterm--self-insert)
+    (define-key map [remap self-insert-command] #'vterm--self-insert)
+    (define-key map [remap yank]                #'vterm-yank)
+    (define-key map (kbd "C-c C-y")             #'vterm--self-insert)
+    (define-key map (kbd "C-c C-c")             #'vterm-send-ctrl-c)
+    map)
+  "Keymap for `vterm-mode'.")
+
+;; Function keys and most of C-  and M- bindings
+(mapcar (lambda (key)
+          (define-key vterm-mode-map (kbd key) #'vterm--self-insert))
+        (append (cl-loop for number from 1 to 12
+                         collect (format "<f%i>" number))
+                (cl-loop for prefix in '("C-" "M-")
+                         append (cl-loop for char from ?a to ?z
+                                         for key = (format "%s%c" prefix char)
+                                         unless (member key vterm-keymap-exceptions)
+                                         collect key))))
+
+(define-derived-mode vterm-mode fundamental-mode "VTerm"
+  "Major mode for vterm buffer."
+  (buffer-disable-undo)
+  (setq vterm--term (vterm-new (window-body-height)
+                               (window-body-width)
+                               (vterm-make-process)
+                                    ;; vterm-max-scrollback
+                               ))
+  (setq buffer-read-only t)
+  (setq-local scroll-conservatively 101)
+  (setq-local scroll-margin 0)
+
+  (add-hook 'window-size-change-functions #'vterm-resize-window t t))
+
+(defun vterm-make-process ()
+  (let ((process-environment (append '("TERM=xterm") process-environment)))
+    (setq vterm--process
+          (make-process
+           :name "vterm"
+           :buffer (current-buffer)
+           :command `("/bin/sh" "-c"
+                      ,(format "stty -nl sane iutf8 rows %d columns %d >/dev/null && exec %s"
+                               (window-body-height)
+                               (window-body-width)
+                               vterm-shell))
+           :coding 'no-conversion
+           :connection-type 'pty
+           :filter #'vterm-filter
+           :sentinel #'vterm-sentinel))))
+
+(defun vterm-filter (process output)
+  "I/O Event. Feeds PROCESS's OUTPUT to the virtual terminal.
+
+Then triggers a redraw from the module."
+  (let ((inhibit-redisplay t)
+        (inhibit-read-only t))
+    (with-current-buffer (process-buffer process)
+      (vterm-write-input vterm--term output)
+      (vterm-update vterm--term))))
+
+(defun vterm-sentinel (process string)
+  (let ((buf (process-buffer proc)))
+    (when (buffer-live-p buf)
+      (kill-buffer buf))))
+
+(defun vterm-resize-window (frame)
+  (let (bufs)
+    (dolist (win (window-list frame))
+      (let ((buf (window-buffer win)))
+        (with-current-buffer buf
+          (when (and (eq major-mode 'vterm-mode)
+                     (not (member buf bufs)))
+            (with-selected-window win
+              (push buf bufs)
+              (let ((height (window-body-height))
+                    (width (window-body-width))
+                    (inhibit-read-only t))
+                (set-process-window-size (get-buffer-process buf) height width)
+                (vterm-set-size vterm--term height width)))))))))
+
+(defun vterm--self-insert ()
+  "Sends invoking key to libvterm."
+  (interactive)
+    (let* ((modifiers (event-modifiers last-input-event))
+           (shift (memq 'shift modifiers))
+           (meta (memq 'meta modifiers))
+           (ctrl (memq 'control modifiers)))
+      (when-let ((key (key-description (vector (event-basic-type last-input-event)))))
+        (vterm-send-key key shift meta ctrl))))
+
+(defun vterm-send-key (key &optional shift meta ctrl)
+  "Sends KEY to libvterm with optional modifiers SHIFT, META and CTRL."
+    (let ((inhibit-redisplay t)
+          (inhibit-read-only t))
+      (when (and shift (not meta) (not ctrl))
+        (setq key (upcase key)))
+      (vterm-update vterm--term key shift meta ctrl)))
+
+(defun vterm--face-color-hex (face attr)
+  "Return the color of the FACE's ATTR as a hex string."
+  (apply #'color-rgb-to-hex (append (color-name-to-rgb (face-attribute face attr nil 'default)) '(2))))
+
+(defun vterm-yank ()
+  "Implementation of `yank' (paste) in vterm."
+  (interactive)
+  (vterm-send-string (current-kill 0)))
+
+(defun vterm-send-string (string)
+  "Send the string STRING to vterm."
+  (when vterm--term
+    (dolist (char (string-to-list string))
+      (vterm-update vterm--term (char-to-string char) nil nil nil))))
+
+;;;###autoload
+(defun vterm (&optional arg)
+  "Display vterminal. If called with prefix arg open new terminal."
+  (interactive "P")
+  (let ((buffer (if arg
+                    (generate-new-buffer vterm-buffer-name)
+                  (get-buffer-create vterm-buffer-name))))
+    (when (or arg (not (get-buffer-process buffer)))
+      (with-current-buffer buffer
+        (vterm-mode)))
+    (funcall vterm-display-method buffer)))
+
+(provide 'vterm)

rust_src/build.rs

@@ -731,7 +731,8 @@ fn run_bindgen() {
                 .rustified_enum("output_method")
                 .rustified_enum("pvec_type")
                 .rustified_enum("symbol_redirect")
-                .rustified_enum("syntaxcode");
+                .rustified_enum("syntaxcode")
+                .rustified_enum("VTermProp");
 
             if cfg!(target_os = "windows") {
                 builder = builder

rust_src/src/editfns.rs

@@ -184,16 +184,20 @@ pub fn goto_char(position: LispObject) -> LispObject {
     if position.is_marker() {
         set_point_from_marker(position);
     } else if let Some(num) = position.as_fixnum() {
-        let mut cur_buf = ThreadState::current_buffer();
-        let pos = clip_to_bounds(cur_buf.begv, num, cur_buf.zv);
-        let bytepos = unsafe { buf_charpos_to_bytepos(cur_buf.as_mut(), pos) };
-        unsafe { set_point_both(pos, bytepos) };
+        goto_pos(num);
     } else {
         wrong_type!(Qinteger_or_marker_p, position)
     };
     position
 }
 
+pub fn goto_pos(pos: EmacsInt) {
+    let mut cur_buf = ThreadState::current_buffer();
+    let p = clip_to_bounds(cur_buf.begv, pos, cur_buf.zv);
+    let bytepos = unsafe { buf_charpos_to_bytepos(cur_buf.as_mut(), p) };
+    unsafe { set_point_both(p, bytepos) };
+}
+
 /// Return the byte position for character position POSITION.
 /// If POSITION is out of range, the value is nil.
 #[lisp_fn]

rust_src/src/lib.rs

@@ -119,6 +119,7 @@ mod threads;
 mod time;
 mod util;
 mod vectors;
+mod vterm;
 mod window_configuration;
 mod windows;
 mod xml;

rust_src/src/remacs_sys.rs

@@ -102,7 +102,7 @@ extern "C" {
     ) -> Lisp_Object;
     pub static minibuf_prompt: LispObject;
     pub fn add_process_read_fd(fd: libc::c_int);
-    pub fn allocate_misc(t: Lisp_Misc_Type) -> LispObject;
+    // pub fn allocate_misc(t: Lisp_Misc_Type) -> LispObject;
     #[cfg(windows)]
     pub fn file_attributes_c(filename: LispObject, id_format: LispObject) -> LispObject;
     pub fn getloadaverage(loadavg: *mut libc::c_double, nelem: libc::c_int) -> libc::c_int;