(Hopefully) fix elisp/inferior-cc.el
This commit is contained in:
499
elisp/inferior-cc.el
Normal file
499
elisp/inferior-cc.el
Normal file
@ -0,0 +1,499 @@
|
||||
;;; inferior-cc.el --- Run interpreters for cc-mode languages -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
(require 'comint)
|
||||
(require 'cl-lib)
|
||||
(require 'cc-mode)
|
||||
(require 'treesit)
|
||||
(require 'shell)
|
||||
(eval-when-compile (require 'rx))
|
||||
|
||||
(defgroup inferior-cc ()
|
||||
"Run interpreters for `cc-mode' languages."
|
||||
:group 'comint)
|
||||
|
||||
(defclass inferior-cc-interpreter ()
|
||||
((name :type string
|
||||
:initarg :name
|
||||
:accessor inf-cc-name
|
||||
:doc "The name of this interpreter.")
|
||||
(command :type string
|
||||
:initarg :command
|
||||
:accessor inf-cc-command
|
||||
:doc "The command (program) for this interpreter.")
|
||||
(args :type (list-of string)
|
||||
:initarg :args
|
||||
:accessor inf-cc-args
|
||||
:initform nil
|
||||
:doc "Command-line arguments to pass to the interpreter.")
|
||||
(font-lock-mode :type (or null function)
|
||||
:initarg :font-lock-mode
|
||||
:accessor inf-cc-font-lock-mode
|
||||
:initform nil
|
||||
:doc "Major mode to use for font locking of the interpreter's
|
||||
input. A value of nil means don't do font locking.")
|
||||
(modes :type (list-of function)
|
||||
:initarg :modes
|
||||
:accessor inf-cc-modes
|
||||
:initform nil
|
||||
:doc "The major modes that this interpreter corresponds to.")
|
||||
(exp-at-point-func :type (or function null)
|
||||
:initarg :exp-at-point-func
|
||||
:accessor inf-cc-exp-at-point-func
|
||||
:initform nil
|
||||
:doc "Function to retrieve the expression at point for
|
||||
languages supported by this interpreter."))
|
||||
(:documentation "An interpreter for a `cc-mode'-like language."))
|
||||
|
||||
(define-widget 'inferior-cc-interpreter 'lazy
|
||||
"Interpreter for `cc-mode'-like languages."
|
||||
:offset 4
|
||||
:tag "Interpreter"
|
||||
:type '(list (string :tag "Name")
|
||||
(repeat :tag "Command line" (string :tag "Argument"))
|
||||
(choice :tag "Font lock mode"
|
||||
(function :tag "Major mode")
|
||||
(const :tag "None" nil))
|
||||
(repeat :tag "Major modes" (function :tag "Major mode"))
|
||||
(choice :tag "Expression at point function"
|
||||
(function :tag "Function")
|
||||
(const :tag "None" nil))))
|
||||
|
||||
(defun inf-cc--interpreter-list-to-obj (list)
|
||||
"Return LIST as a proper `inferior-cc-interpreter' object."
|
||||
(cl-destructuring-bind (name (command &rest args) font-lock-mode modes
|
||||
exp-at-point-func)
|
||||
list
|
||||
(inferior-cc-interpreter :name name :command command
|
||||
:args args :font-lock-mode font-lock-mode
|
||||
:modes modes :exp-at-point-func exp-at-point-func)))
|
||||
|
||||
(defun inf-cc--interpreter-obj-to-list (obj)
|
||||
"Return OBJ, a proper `inferior-cc-interpreter', object as a list."
|
||||
(with-slots (name command args font-lock-mode modes exp-at-point-func) obj
|
||||
(list name (cons command args) font-lock-mode modes exp-at-point-func)))
|
||||
|
||||
(defun inf-cc--remove-trailing-semicolon (str)
|
||||
"Remove a trailing semicolon and whitespace from STR."
|
||||
(if (string-match (rx (* (syntax whitespace))
|
||||
";"
|
||||
(* (syntax whitespace)) eos)
|
||||
str)
|
||||
(substring str 0 (match-beginning 0))
|
||||
str))
|
||||
|
||||
(defun inf-cc--remove-surrounding-parens (str)
|
||||
"Remove surrounding parenthesis from STR."
|
||||
(if (string-match (rx bos (* (syntax whitespace)) "("
|
||||
(group (* any))
|
||||
")" (* (syntax whitespace)) eos)
|
||||
str)
|
||||
(match-string 1 str)
|
||||
str))
|
||||
|
||||
(defun inf-cc--c-c++-ts-exp-at-point ()
|
||||
"Return the expression at point in `c-ts-mode' and `c++-ts-mode' buffers."
|
||||
(unless (or (derived-mode-p 'c-ts-mode 'c++-ts-mode))
|
||||
(user-error "Major mode does not support find expressions: %s" major-mode))
|
||||
(save-excursion
|
||||
(let ((start (point)))
|
||||
(back-to-indentation)
|
||||
(unless (> (point) start)
|
||||
(goto-char start)))
|
||||
(when-let ((thing (treesit-thing-at-point "_" 'nested)))
|
||||
(inf-cc--remove-trailing-semicolon (treesit-node-text thing)))))
|
||||
|
||||
(defun inf-cc--java-ts-exp-at-point ()
|
||||
"Return the expression at point in `java-ts-mode' buffers."
|
||||
(unless (or (derived-mode-p 'java-ts-mode))
|
||||
(user-error "Major mode does not support find expressions: %s" major-mode))
|
||||
(save-excursion
|
||||
(let ((start (point)))
|
||||
(back-to-indentation)
|
||||
(unless (> (point) start)
|
||||
(goto-char start)))
|
||||
(let ((root (treesit-buffer-root-node)))
|
||||
(let ((node (car (or (treesit-query-range
|
||||
root '([(expression_statement)
|
||||
(field_declaration)
|
||||
(local_variable_declaration)
|
||||
(import_declaration)]
|
||||
@exp)
|
||||
(point) (1+ (point)))
|
||||
(treesit-query-range
|
||||
root '([(parenthesized_expression)
|
||||
(binary_expression)
|
||||
(update_expression)
|
||||
(unary_expression)]
|
||||
@exp)
|
||||
(point) (1+ (point)))))))
|
||||
(inf-cc--remove-surrounding-parens
|
||||
(inf-cc--remove-trailing-semicolon
|
||||
(buffer-substring-no-properties (car node) (cdr node))))))))
|
||||
|
||||
(defcustom inferior-cc-interpreters
|
||||
(list (inferior-cc-interpreter :name "jshell"
|
||||
:command "jshell"
|
||||
:font-lock-mode 'java-mode
|
||||
:modes '(java-mode java-ts-mode)
|
||||
:exp-at-point-func
|
||||
'inf-cc--java-ts-exp-at-point)
|
||||
(inferior-cc-interpreter :name "root"
|
||||
:command "root"
|
||||
:font-lock-mode 'c++-mode
|
||||
:modes '(c-mode c-ts-mode c++-mode c++-ts-mode)
|
||||
:exp-at-point-func
|
||||
'inf-cc--c-c++-ts-exp-at-point))
|
||||
"List of inferior-cc interpreters."
|
||||
:type '(repeat inferior-cc-interpreter)
|
||||
:get (lambda (sym)
|
||||
(mapcar 'inf-cc--interpreter-obj-to-list (default-toplevel-value sym)))
|
||||
:set (lambda (sym newval)
|
||||
(set-default-toplevel-value
|
||||
sym (mapcar #'(lambda (elt)
|
||||
(if (inferior-cc-interpreter-p elt)
|
||||
elt
|
||||
(inf-cc--interpreter-list-to-obj elt)))
|
||||
newval)))
|
||||
:group 'inferior-cc)
|
||||
|
||||
(defvar-local inf-cc--obj nil
|
||||
"The current buffer's interpreter object.")
|
||||
(put 'inf-cc--obj 'permanent-local t)
|
||||
|
||||
(defvar-local inf-cc--fontification-buffer nil
|
||||
"The fontification buffer for the current buffer.")
|
||||
|
||||
(defvar-local inf-cc--skip-next-lines 0
|
||||
"Number of lines of output to skip.")
|
||||
|
||||
(defun inf-cc--preoutput-filter-function (output)
|
||||
"Preoutput filter function for inferior cc buffers.
|
||||
OUTPUT is the new text to be inserted."
|
||||
(if (<= inf-cc--skip-next-lines 0)
|
||||
output
|
||||
(let* ((lines (string-lines output))
|
||||
(cnt (length lines)))
|
||||
(if (> cnt inf-cc--skip-next-lines)
|
||||
(prog1
|
||||
(string-join (nthcdr inf-cc--skip-next-lines lines) "\n")
|
||||
(setq inf-cc--skip-next-lines 0))
|
||||
(cl-decf inf-cc--skip-next-lines cnt)
|
||||
(when (and (not (string-empty-p output))
|
||||
(/= ?\n (elt output (1- (length output)))))
|
||||
(cl-incf inf-cc--skip-next-lines))
|
||||
""))))
|
||||
|
||||
(defun inf-cc--get-fontification-buffer ()
|
||||
"Return or create the current buffer's fontification buffer."
|
||||
(if (buffer-live-p inf-cc--fontification-buffer)
|
||||
inf-cc--fontification-buffer
|
||||
(let ((buffer (generate-new-buffer
|
||||
(format " %s-fontification-buffer" (buffer-name))))
|
||||
(obj inf-cc--obj))
|
||||
(with-current-buffer buffer
|
||||
(setq-local inf-cc--obj obj)
|
||||
(unless (and (inf-cc-font-lock-mode inf-cc--obj)
|
||||
(derived-mode-p (inf-cc-font-lock-mode inf-cc--obj)))
|
||||
(let ((delayed-mode-hooks nil))
|
||||
(delay-mode-hooks
|
||||
(funcall (inf-cc-font-lock-mode inf-cc--obj)))))
|
||||
(when (eq c-basic-offset 'set-from-style)
|
||||
(setq-local c-basic-offset standard-indent))
|
||||
(let ((inhibit-message t))
|
||||
(indent-tabs-mode -1))
|
||||
(unless font-lock-mode
|
||||
(font-lock-mode 1)))
|
||||
(setq-local inf-cc--fontification-buffer buffer))))
|
||||
|
||||
(defmacro inf-cc--with-font-lock-buffer (&rest body)
|
||||
"Execute BODY in the current buffer's fortification buffer.
|
||||
Note that this erases the buffer before doing anything."
|
||||
`(with-current-buffer (inf-cc--get-fontification-buffer)
|
||||
(erase-buffer)
|
||||
,@body))
|
||||
|
||||
(defun inf-cc--fontify-current-input ()
|
||||
"Function called from `post-command-hook' to fontify the current input."
|
||||
(when-let (((inf-cc-font-lock-mode inf-cc--obj))
|
||||
(proc (get-buffer-process (current-buffer)))
|
||||
(start (process-mark proc))
|
||||
(end (point-max))
|
||||
(input (buffer-substring-no-properties start end))
|
||||
(fontified (inf-cc--with-font-lock-buffer
|
||||
(insert input)
|
||||
(font-lock-ensure)
|
||||
(buffer-string)))
|
||||
(len (length fontified))
|
||||
(i 0))
|
||||
;; mostly from:
|
||||
;; `python-shell-font-lock-post-command-hook'
|
||||
(while (not (= i len))
|
||||
(let* ((props (text-properties-at i fontified))
|
||||
(change-i (or (next-property-change i fontified)
|
||||
len)))
|
||||
(when-let ((face (plist-get props 'face)))
|
||||
(setf (plist-get props 'face) nil
|
||||
(plist-get props 'font-lock-face) face))
|
||||
(set-text-properties (+ start i) (+ start change-i) props)
|
||||
(setq i change-i)))))
|
||||
|
||||
(defun inf-cc--bounds-of-last-prompt ()
|
||||
"Return the bounds of the last prompt.
|
||||
This returns a cons."
|
||||
(save-excursion
|
||||
(let ((end (process-mark (get-buffer-process (current-buffer)))))
|
||||
(goto-char end)
|
||||
(cons (pos-bol) end))))
|
||||
|
||||
(defun inf-cc--remove-extra-indentation (count)
|
||||
"Remove COUNT spaces from the start of each line."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(back-to-indentation)
|
||||
(let ((indent (- (point) (pos-bol))))
|
||||
(when (> indent count)
|
||||
(delete-char (- count))))
|
||||
(forward-line))))
|
||||
|
||||
(defun inf-cc--indent-line-function ()
|
||||
"`indent-line-function' for inferior cc comint buffers."
|
||||
(when (inf-cc-font-lock-mode inf-cc--obj)
|
||||
(let* ((start (process-mark (get-buffer-process (current-buffer)))))
|
||||
;; don't indent the first line
|
||||
(unless (= (pos-bol) (save-excursion (goto-char start) (pos-bol)))
|
||||
(let* ((input (buffer-substring-no-properties start (pos-eol)))
|
||||
(prompt-size (let ((bound (inf-cc--bounds-of-last-prompt)))
|
||||
(- (cdr bound) (car bound))))
|
||||
(col (inf-cc--with-font-lock-buffer
|
||||
(insert input)
|
||||
(inf-cc--remove-extra-indentation prompt-size)
|
||||
(c-indent-line nil t)
|
||||
(back-to-indentation)
|
||||
(- (point) (pos-bol)))))
|
||||
(save-excursion
|
||||
(indent-line-to (+ prompt-size col)))
|
||||
(skip-syntax-forward "-"))))))
|
||||
|
||||
(defun inferior-cc-send-input ()
|
||||
"Like `comint-send-input', but with some extra stuff for inferior cc."
|
||||
(interactive)
|
||||
(let ((pmark (process-mark (get-buffer-process (current-buffer))))
|
||||
(end (if comint-eol-on-send (pos-eol) (point))))
|
||||
(with-restriction pmark end
|
||||
(let ((res (syntax-ppss (point-max))))
|
||||
(without-restriction
|
||||
(cond
|
||||
;; open string
|
||||
((cl-fourth res)
|
||||
(message "Unterminated string"))
|
||||
;; unmatched blocks or comment
|
||||
((or (numberp (cl-fifth res))
|
||||
(not (zerop (cl-first res)))
|
||||
;; trailing . character
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(skip-syntax-backward "-")
|
||||
(eql (char-before) ?.)))
|
||||
(newline-and-indent))
|
||||
(t
|
||||
;; ignore the interpreter echoing back our lines
|
||||
(setq-local inf-cc--skip-next-lines (count-lines pmark end))
|
||||
(when (= pmark end)
|
||||
(cl-incf inf-cc--skip-next-lines))
|
||||
;; also, methods add a bunch of extra newlines
|
||||
(when (>= inf-cc--skip-next-lines 2)
|
||||
(cl-incf inf-cc--skip-next-lines (- inf-cc--skip-next-lines 2)))
|
||||
(comint-send-input))))))))
|
||||
|
||||
(defvar-keymap inferior-cc-shell-mode-map
|
||||
:doc "Keymap for `inferior-cc-shell-mode'."
|
||||
:parent comint-mode-map
|
||||
"RET" #'inferior-cc-send-input)
|
||||
|
||||
(defun inf-cc--kill-fontification-buffer ()
|
||||
"Kill the current `inf-cc--fontification-buffer'."
|
||||
(ignore-errors
|
||||
(kill-buffer inf-cc--fontification-buffer)))
|
||||
|
||||
(define-derived-mode inferior-cc-shell-mode comint-mode ""
|
||||
"Major mode for buffers running inferior cc interpreters.
|
||||
You MUST set `inf-cc--obj' before activating this major mode."
|
||||
:interactive nil
|
||||
:group 'inferior-jshell
|
||||
:syntax-table nil
|
||||
(with-slots (name font-lock-mode) inf-cc--obj
|
||||
(setq-local comint-highlight-input nil
|
||||
indent-line-function #'inf-cc--indent-line-function
|
||||
electric-indent-chars '(?\n ?})
|
||||
mode-name (concat "Inferior " (upcase-initials name)))
|
||||
(when-let ((font-lock-mode)
|
||||
(sym (intern-soft (format "%s-syntax-table" font-lock-mode)))
|
||||
(syntax-table (symbol-value sym)))
|
||||
(set-syntax-table syntax-table)))
|
||||
(add-hook 'comint-preoutput-filter-functions
|
||||
#'inf-cc--preoutput-filter-function
|
||||
nil t)
|
||||
(add-hook 'post-command-hook
|
||||
#'inf-cc--fontify-current-input
|
||||
nil t)
|
||||
(add-hook 'kill-buffer-hook
|
||||
#'inf-cc--kill-fontification-buffer
|
||||
nil t))
|
||||
|
||||
(cl-defun inf-cc--find-buffer ()
|
||||
"Find and return a live inferior cc buffer for the current major mode."
|
||||
(let ((target-mode major-mode))
|
||||
(dolist (buffer (buffer-list))
|
||||
(with-current-buffer buffer
|
||||
(when (and (process-live-p (get-buffer-process buffer))
|
||||
inf-cc--obj
|
||||
(member target-mode (inf-cc-modes inf-cc--obj)))
|
||||
(cl-return-from inf-cc--find-buffer buffer))))))
|
||||
|
||||
(defun inferior-cc-eval (code)
|
||||
"Evaluate CODE in a live inferior cc buffer."
|
||||
(interactive "sEval: " inferior-cc-shell-mode)
|
||||
(let ((buffer (inf-cc--find-buffer)))
|
||||
(unless buffer
|
||||
(user-error "No live inferior cc buffer found"))
|
||||
(with-current-buffer buffer
|
||||
(let* ((start (process-mark (get-buffer-process buffer)))
|
||||
(end (point-max))
|
||||
(old (buffer-substring-no-properties start end)))
|
||||
(delete-region start end)
|
||||
(goto-char (point-max))
|
||||
(insert code)
|
||||
(goto-char (point-max))
|
||||
;; don't save history
|
||||
(let ((comint-input-filter #'ignore))
|
||||
(inferior-cc-send-input))
|
||||
(goto-char (point-max))
|
||||
(insert old)
|
||||
(goto-char (point-max))))))
|
||||
|
||||
(defun inferior-cc-eval-region (start end)
|
||||
"Evaluate the current buffer from START to END in a live inferior cc buffer.
|
||||
START and END default to the current region."
|
||||
(interactive "r" inferior-cc-shell-mode)
|
||||
(inferior-cc-eval (buffer-substring-no-properties start end))
|
||||
(message "Evaluated %s lines" (count-lines start end)))
|
||||
|
||||
(defun inferior-cc-eval-buffer ()
|
||||
"Send the current buffer to a live inferior cc buffer."
|
||||
(interactive nil inferior-cc-shell-mode)
|
||||
(inferior-cc-eval-region (point-min) (point-max))
|
||||
(message "Evaluated buffer %s" (current-buffer)))
|
||||
|
||||
(defun inferior-cc-eval-defun ()
|
||||
"Send the defun under point to a live inferior cc buffer."
|
||||
(interactive nil inferior-cc-shell-mode)
|
||||
(let ((bounds (bounds-of-thing-at-point 'defun)))
|
||||
(unless bounds
|
||||
(user-error "No defun under point"))
|
||||
(inferior-cc-eval-region (car bounds) (cdr bounds))
|
||||
(message "Evaluated defun (%s lines)" (count-lines (car bounds)
|
||||
(cdr bounds)))))
|
||||
|
||||
(defun inferior-cc-eval-line ()
|
||||
"Send the line under point to a live inferior cc buffer."
|
||||
(interactive nil inferior-cc-shell-mode)
|
||||
(inferior-cc-eval-region (pos-bol) (pos-eol))
|
||||
(message "Evaluated %s" (buffer-substring (pos-bol) (pos-eol))))
|
||||
|
||||
(defun inferior-cc-eval-expression ()
|
||||
"Evaluate the expression under point in a live inferior cc buffer.
|
||||
This only works in modes that have defined an \\=:exp-at-point-func."
|
||||
(interactive nil inferior-cc-shell-mode)
|
||||
(let ((obj (inf-cc--find-interpreter-for-mode)))
|
||||
(unless obj
|
||||
(user-error "Cannot get expression for major mode: %s" major-mode))
|
||||
(with-slots ((func exp-at-point-func)) obj
|
||||
(unless func
|
||||
(user-error "Cannot get expression for major mode: %s" major-mode))
|
||||
(let ((code (funcall func)))
|
||||
(unless code
|
||||
(user-error "No expression under point"))
|
||||
(inferior-cc-eval code)
|
||||
(message "Evaluated expression (%s lines)"
|
||||
(1+ (cl-count ?\n code)))))))
|
||||
|
||||
(defun inf-cc--find-interpreter-for-mode (&optional mode)
|
||||
"Find a suitable interpreter for MODE, defaulting to `major-mode'."
|
||||
(unless mode (setq mode major-mode))
|
||||
(cl-find-if (lambda (elt)
|
||||
(with-slots (modes) elt
|
||||
(member mode modes)))
|
||||
inferior-cc-interpreters))
|
||||
|
||||
(defun inf-cc--interpreter-by-name (name)
|
||||
"Find the interpreter named NAME."
|
||||
(cl-find-if (lambda (elt)
|
||||
(equal (inf-cc-name elt) name))
|
||||
inferior-cc-interpreters))
|
||||
|
||||
(defun inf-cc--prompt-for-interpreter ()
|
||||
"Prompt for an inferior cc interpreter."
|
||||
(inf-cc--interpreter-by-name
|
||||
(completing-read "Interpreter: "
|
||||
(mapcar 'inf-cc-name inferior-cc-interpreters) nil t)))
|
||||
|
||||
(defun inf-cc--prompt-for-command (int)
|
||||
"Prompt for a command line for INT."
|
||||
(with-slots (command args) int
|
||||
(let* ((def-cmd (string-join (mapcar 'shell-quote-argument
|
||||
(cons command args))
|
||||
" "))
|
||||
(choice (read-shell-command "Command: " def-cmd)))
|
||||
(split-string-shell-command choice))))
|
||||
|
||||
(defun run-cc-interpreter (int &optional command)
|
||||
"Run the `cc-mode'-like interpreter INT.
|
||||
Interactively, INT will be an interpreter suitable for the current
|
||||
`major-mode'. With a prefix argument, prompt for an interpreter.
|
||||
|
||||
If COMMAND is non-nil, it should be a list with the first element being the
|
||||
program to execute and the rest of the elements being the arguments to pass to
|
||||
the interpreter. This overrides the default settings in INT. Interactively,
|
||||
prompt for COMMAND with two prefix arguments."
|
||||
(interactive (let ((int (if current-prefix-arg
|
||||
(inf-cc--prompt-for-interpreter)
|
||||
(or (inf-cc--find-interpreter-for-mode)
|
||||
(inf-cc--prompt-for-interpreter)))))
|
||||
(list int
|
||||
(when (>= (prefix-numeric-value current-prefix-arg) 16)
|
||||
(inf-cc--prompt-for-command int)))))
|
||||
(with-slots (name (def-cmd command) args) int
|
||||
(unless command
|
||||
(setq command (cons def-cmd args)))
|
||||
(pop-to-buffer
|
||||
(with-current-buffer (get-buffer-create (format "*%s*" name))
|
||||
(prog1 (current-buffer)
|
||||
(unless (process-live-p (get-buffer-process (current-buffer)))
|
||||
(setq-local inf-cc--obj int)
|
||||
(inferior-cc-shell-mode)
|
||||
(comint-exec (current-buffer)
|
||||
(format "Inferior %s" (upcase-initials name))
|
||||
(car command) nil (cdr command))))))))
|
||||
|
||||
(defun run-jshell (command)
|
||||
"Run JShell in a comint buffer.
|
||||
COMMAND is the same as for `run-cc-interpreter', except that any prefix arg
|
||||
causes the user to be prompted."
|
||||
(interactive (list (when current-prefix-arg
|
||||
(inf-cc--prompt-for-command
|
||||
(inf-cc--interpreter-by-name "jshell")))))
|
||||
(run-cc-interpreter (inf-cc--interpreter-by-name "jshell") command))
|
||||
|
||||
(defun run-root (command)
|
||||
"Run CERN root in a comint buffer.
|
||||
COMMAND is the same as for `run-cc-interpreter', except that any prefix arg
|
||||
causes the user to be prompted."
|
||||
(interactive (list (when current-prefix-arg
|
||||
(inf-cc--prompt-for-command
|
||||
(inf-cc--interpreter-by-name "root")))))
|
||||
(run-cc-interpreter (inf-cc--interpreter-by-name "root") command))
|
||||
|
||||
(provide 'inferior-cc)
|
||||
;;; inferior-cc.el ends here
|
||||
@ -1,294 +0,0 @@
|
||||
;;; inferior-jshell.el --- Run JShell in a comint buffer -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
(require 'comint)
|
||||
(require 'cl-lib)
|
||||
(require 'cc-mode)
|
||||
(require 'treesit)
|
||||
(eval-when-compile (require 'rx))
|
||||
|
||||
(defgroup inferior-jshell ()
|
||||
"Run JShell in a comint buffer."
|
||||
:group 'comint)
|
||||
|
||||
(defvar jshell-buffer-name "*jshell*"
|
||||
"Name to use for inferior jshell process buffer.")
|
||||
|
||||
(defvar jshell-program "jshell"
|
||||
"The program to default to for `run-jshell'.")
|
||||
|
||||
(defvar jshell-switches ()
|
||||
"List of arguments to pass to jshell in `run-jshell'.")
|
||||
|
||||
(defvar-local jshell--fontification-buffer nil
|
||||
"The fontification buffer for the current jshell buffer.")
|
||||
|
||||
(defvar-local jshell--skip-next-lines 0
|
||||
"Number of lines of output to skip.")
|
||||
|
||||
(defun jshell--preoutput-filter-function (output)
|
||||
"Preoutput filter function for jshell.
|
||||
OUTPUT is the new text to be inserted."
|
||||
(if (<= jshell--skip-next-lines 0)
|
||||
output
|
||||
(let* ((lines (string-lines output))
|
||||
(cnt (length lines)))
|
||||
(if (> cnt jshell--skip-next-lines)
|
||||
(prog1
|
||||
(string-join (nthcdr jshell--skip-next-lines lines) "\n")
|
||||
(setq jshell--skip-next-lines 0))
|
||||
(cl-decf jshell--skip-next-lines cnt)
|
||||
(when (and (not (string-empty-p output))
|
||||
(/= ?\n (elt output (1- (length output)))))
|
||||
(cl-incf jshell--skip-next-lines))
|
||||
""))))
|
||||
|
||||
(defun jshell--get-fontification-buffer ()
|
||||
"Return the jshell fontification buffer."
|
||||
(if (buffer-live-p jshell--fontification-buffer)
|
||||
jshell--fontification-buffer
|
||||
(let ((buffer (generate-new-buffer
|
||||
(format " %s-fontification-buffer" (buffer-name)))))
|
||||
(with-current-buffer buffer
|
||||
(unless (derived-mode-p 'c++-mode)
|
||||
(let ((delayed-mode-hooks nil))
|
||||
(delay-mode-hooks
|
||||
(java-mode))))
|
||||
(when (eq c-basic-offset 'set-from-style)
|
||||
(setq-local c-basic-offset standard-indent))
|
||||
(let ((inhibit-message t))
|
||||
(indent-tabs-mode -1))
|
||||
(unless font-lock-mode
|
||||
(font-lock-mode 1)))
|
||||
(setq-local jshell--fontification-buffer buffer))))
|
||||
|
||||
(defmacro jshell--with-font-lock-buffer (&rest body)
|
||||
"Execute BODY in the jshell indirect buffer.
|
||||
Note that this erases the buffer before doing anything."
|
||||
`(with-current-buffer (jshell--get-fontification-buffer)
|
||||
(erase-buffer)
|
||||
,@body))
|
||||
|
||||
(defun jshell--fontify-current-input ()
|
||||
"Function called from `post-command-hook' to fontify the current input."
|
||||
(when-let ((proc (get-buffer-process (current-buffer)))
|
||||
(start (process-mark proc))
|
||||
(end (point-max))
|
||||
(input (buffer-substring-no-properties start end))
|
||||
(fontified (jshell--with-font-lock-buffer
|
||||
(insert input)
|
||||
(font-lock-ensure)
|
||||
(buffer-string)))
|
||||
(len (length fontified))
|
||||
(i 0))
|
||||
;; mostly from:
|
||||
;; `python-shell-font-lock-post-command-hook'
|
||||
(while (not (= i len))
|
||||
(let* ((props (text-properties-at i fontified))
|
||||
(change-i (or (next-property-change i fontified)
|
||||
len)))
|
||||
(when-let ((face (plist-get props 'face)))
|
||||
(setf (plist-get props 'face) nil
|
||||
(plist-get props 'font-lock-face) face))
|
||||
(set-text-properties (+ start i) (+ start change-i) props)
|
||||
(setq i change-i)))))
|
||||
|
||||
(defun jshell--bounds-of-last-prompt ()
|
||||
"Return the bounds of the last jshell prompt.
|
||||
This returns a cons."
|
||||
(save-excursion
|
||||
(let ((end (process-mark (get-buffer-process (current-buffer)))))
|
||||
(goto-char end)
|
||||
(cons (pos-bol) end))))
|
||||
|
||||
(defun jshell--remove-extra-indentation (count)
|
||||
"Remove COUNT spaces from the start of each line."
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (not (eobp))
|
||||
(back-to-indentation)
|
||||
(let ((indent (- (point) (pos-bol))))
|
||||
(when (> indent count)
|
||||
(delete-char (- count))))
|
||||
(forward-line))))
|
||||
|
||||
(defun jshell--indent-line-function ()
|
||||
"`indent-line-function' for jshell comint buffers."
|
||||
(let* ((start (process-mark (get-buffer-process (current-buffer)))))
|
||||
;; don't indent the first line
|
||||
(unless (= (pos-bol) (save-excursion (goto-char start) (pos-bol)))
|
||||
(let* ((input (buffer-substring-no-properties start (pos-eol)))
|
||||
(prompt-size (let ((bound (jshell--bounds-of-last-prompt)))
|
||||
(- (cdr bound) (car bound))))
|
||||
(col (jshell--with-font-lock-buffer
|
||||
(insert input)
|
||||
(jshell--remove-extra-indentation prompt-size)
|
||||
(c-indent-line nil t)
|
||||
(back-to-indentation)
|
||||
(- (point) (pos-bol)))))
|
||||
(save-excursion
|
||||
(indent-line-to (+ prompt-size col)))
|
||||
(skip-syntax-forward "-")))))
|
||||
|
||||
(defun jshell-send-input ()
|
||||
"Like `comint-send-input', but with some extra stuff for jshell."
|
||||
(interactive)
|
||||
(let ((pmark (process-mark (get-buffer-process (current-buffer))))
|
||||
(end (if comint-eol-on-send (pos-eol) (point))))
|
||||
(with-restriction pmark end
|
||||
(let ((res (syntax-ppss (point-max))))
|
||||
(without-restriction
|
||||
(cond
|
||||
;; open string
|
||||
((cl-fourth res)
|
||||
(message "Unterminated string"))
|
||||
;; unmatched blocks or comment
|
||||
((or (numberp (cl-fifth res))
|
||||
(not (zerop (cl-first res)))
|
||||
;; trailing . character
|
||||
(save-excursion
|
||||
(end-of-line)
|
||||
(skip-syntax-backward "-")
|
||||
(eql (char-before) ?.)))
|
||||
(newline-and-indent))
|
||||
(t
|
||||
;; jshell will echo out each line we send it, ignore all of them
|
||||
(setq-local jshell--skip-next-lines (count-lines pmark end))
|
||||
(when (= pmark end)
|
||||
(cl-incf jshell--skip-next-lines))
|
||||
;; also, methods add a bunch of extra newlines
|
||||
(when (>= jshell--skip-next-lines 2)
|
||||
(cl-incf jshell--skip-next-lines (- jshell--skip-next-lines 2)))
|
||||
(comint-send-input))))))))
|
||||
|
||||
(defvar-keymap inferior-jshell-mode-map
|
||||
:doc "Keymap for `inferior-jshell-mode'."
|
||||
:parent comint-mode-map
|
||||
"RET" #'jshell-send-input)
|
||||
|
||||
(defvar inferior-jshell-mode-syntax-table (copy-syntax-table java-mode-syntax-table)
|
||||
"Syntax table for `inferior-jshell-mode'.")
|
||||
|
||||
(defun jshell--kill-fontification-buffer ()
|
||||
"Kill the current `jshell--fontification-buffer'."
|
||||
(kill-buffer jshell--fontification-buffer))
|
||||
|
||||
(define-derived-mode inferior-jshell-mode comint-mode "Inferior Jshell"
|
||||
"Major mode for buffers running inferior CERN jshell processes."
|
||||
:group 'inferior-jshell
|
||||
:syntax-table inferior-jshell-mode-syntax-table
|
||||
(setq-local comint-highlight-input nil
|
||||
indent-line-function #'jshell--indent-line-function
|
||||
electric-indent-chars '(?\n ?}))
|
||||
(add-hook 'comint-preoutput-filter-functions
|
||||
#'jshell--preoutput-filter-function
|
||||
nil t)
|
||||
(add-hook 'post-command-hook
|
||||
#'jshell--fontify-current-input
|
||||
nil t)
|
||||
(add-hook 'kill-buffer-hook
|
||||
#'jshell--kill-fontification-buffer
|
||||
nil t))
|
||||
|
||||
(cl-defun run-jshell (&optional (cmd jshell-program) (switches jshell-switches))
|
||||
"Run CERN jshell in a comint buffer.
|
||||
CMD is the shell command to run. It defaults to `jshell-program'. SWITCHES are
|
||||
the arguments to pass. They default to `jshell-switches'."
|
||||
(interactive)
|
||||
(pop-to-buffer
|
||||
(with-current-buffer (get-buffer-create jshell-buffer-name)
|
||||
(prog1 (current-buffer)
|
||||
(unless (process-live-p (get-buffer-process (current-buffer)))
|
||||
(inferior-jshell-mode)
|
||||
(comint-exec (current-buffer) "Inferior Jshell" cmd nil switches))))))
|
||||
|
||||
(cl-defun jshell--find-buffer ()
|
||||
"Find and return a live jshell buffer."
|
||||
(dolist (buffer (buffer-list))
|
||||
(with-current-buffer buffer
|
||||
(when (and (derived-mode-p 'inferior-jshell-mode)
|
||||
(process-live-p (get-buffer-process buffer)))
|
||||
(cl-return-from jshell--find-buffer buffer)))))
|
||||
|
||||
(defun jshell-eval (code)
|
||||
"Evaluate CODE in a live JShell buffer."
|
||||
(interactive "sEval: ")
|
||||
(let ((buffer (jshell--find-buffer)))
|
||||
(unless buffer
|
||||
(user-error "No live JShell buffer found"))
|
||||
(with-current-buffer buffer
|
||||
(let* ((start (process-mark (get-buffer-process buffer)))
|
||||
(end (point-max))
|
||||
(old (buffer-substring-no-properties start end)))
|
||||
(delete-region start end)
|
||||
(goto-char (point-max))
|
||||
(insert code)
|
||||
(goto-char (point-max))
|
||||
;; don't save history
|
||||
(let ((comint-input-filter #'ignore))
|
||||
(jshell-send-input))
|
||||
(goto-char (point-max))
|
||||
(insert old)
|
||||
(goto-char (point-max))))))
|
||||
|
||||
(defun jshell-eval-region (start end)
|
||||
"Evaluate the current buffer from START to END in a live JShell buffer.
|
||||
START and END default to the current region."
|
||||
(interactive "r")
|
||||
(jshell-eval (buffer-substring-no-properties start end)))
|
||||
|
||||
(defun jshell-eval-buffer ()
|
||||
"Send the current buffer to a live JShell buffer."
|
||||
(interactive)
|
||||
(jshell-eval-region (point-min) (point-max)))
|
||||
|
||||
(defun jshell-eval-defun ()
|
||||
"Send the defun under point to a live JShell buffer."
|
||||
(interactive)
|
||||
(let ((bounds (bounds-of-thing-at-point 'defun)))
|
||||
(unless bounds
|
||||
(user-error "No defun under point"))
|
||||
(jshell-eval-region (car bounds) (cdr bounds))))
|
||||
|
||||
(defun jshell-eval-expression ()
|
||||
"Send the Java expression under point to a live JShell buffer.
|
||||
This only works in `java-ts-mode'."
|
||||
(interactive)
|
||||
(save-excursion
|
||||
(let ((start (point)))
|
||||
(back-to-indentation)
|
||||
(unless (> (point) start)
|
||||
(goto-char start)))
|
||||
(let ((root (treesit-buffer-root-node)))
|
||||
(let ((node (car (or (treesit-query-range
|
||||
root '([(expression_statement)
|
||||
(field_declaration)
|
||||
(local_variable_declaration)
|
||||
(import_declaration)]
|
||||
@exp)
|
||||
(point) (1+ (point)))
|
||||
(treesit-query-range
|
||||
root '([(parenthesized_expression)
|
||||
(binary_expression)
|
||||
(update_expression)
|
||||
(unary_expression)]
|
||||
@exp)
|
||||
(point) (1+ (point)))))))
|
||||
(unless node
|
||||
(user-error "No expression found under point"))
|
||||
(let ((text (buffer-substring-no-properties (car node) (cdr node))))
|
||||
(when (string-match (rx (* (syntax whitespace))
|
||||
";"
|
||||
(* (syntax whitespace)) eos)
|
||||
text)
|
||||
(setq text (substring text 0 (match-beginning 0))))
|
||||
(when (string-match (rx bos (* (syntax whitespace)) "("
|
||||
(group (* any))
|
||||
")" (* (syntax whitespace)) eos)
|
||||
text)
|
||||
(setq text (match-string 1 text)))
|
||||
(jshell-eval text))))))
|
||||
|
||||
|
||||
(provide 'inferior-jshell)
|
||||
;;; inferior-jshell.el ends here
|
||||
65
init.el
65
init.el
@ -61,7 +61,7 @@
|
||||
((text-mode tex-mode prog-mode) . my/-enable-show-trailing-whitespace))
|
||||
:init
|
||||
(with-eval-after-load 'find-func
|
||||
(when (file-directory-p "~/src/emacs/src/")
|
||||
(when (and (file-directory-p "~/src/emacs/src/"))
|
||||
(setq find-function-C-source-directory "~/src/emacs/src/")))
|
||||
|
||||
(defun my/-enable-show-trailing-whitespace ()
|
||||
@ -936,8 +936,8 @@ visual states."
|
||||
;; read-extended-command-predicate #'command-completion-default-include-p
|
||||
read-extended-command-predicate nil
|
||||
minibuffer-prompt-properties '(read-only t ;; noindent 3
|
||||
cursor-intangible t
|
||||
face minibuffer-prompt))
|
||||
cursor-intangible t
|
||||
face minibuffer-prompt))
|
||||
(vertico-mode 1)
|
||||
;; for jinx
|
||||
(require 'vertico-multiform)
|
||||
@ -1765,16 +1765,10 @@ otherwise, call `bibtex-find-text'."
|
||||
;; My dev environment for ROS2
|
||||
(require 'arch-ros2)
|
||||
|
||||
(require 'inferior-jshell)
|
||||
;; java-ts-mode
|
||||
(use-package java-ts-mode
|
||||
:hook ((java-ts-mode . trusted-files-eglot-ensure-if-safe)
|
||||
(java-ts-mode . my/-setup-java-ts-mode))
|
||||
:bind (:map java-ts-mode-map
|
||||
("C-x C-e" . jshell-eval-expression)
|
||||
("C-M-x" . jshell-eval-defun)
|
||||
("C-c C-r" . jshell-eval-region)
|
||||
("C-c C-b" . jshell-eval-buffer))
|
||||
:config
|
||||
(defun my/-setup-java-ts-mode ()
|
||||
(let ((rules (car treesit-simple-indent-rules)))
|
||||
@ -2090,6 +2084,19 @@ Note that this erases the buffer before doing anything."
|
||||
nil t))
|
||||
(add-hook 'sly-mrepl-mode-hook #'my/-sly-mrepl-enable-fontification))
|
||||
|
||||
;; inferior cc
|
||||
(require 'inferior-cc)
|
||||
(with-eval-after-load 'c-ts-mode
|
||||
(keymap-set c-ts-base-mode-map "C-x C-e" #'inferior-cc-eval-expression)
|
||||
(keymap-set c-ts-base-mode-map "C-c C-r" #'inferior-cc-eval-region)
|
||||
(keymap-set c-ts-base-mode-map "C-c C-b" #'inferior-cc-eval-buffer)
|
||||
(keymap-set c-ts-base-mode-map "C-M-x" #'inferior-cc-eval-defun))
|
||||
(with-eval-after-load 'java-ts-mode
|
||||
(keymap-set java-ts-mode-map "C-x C-e" #'inferior-cc-eval-expression)
|
||||
(keymap-set java-ts-mode-map "C-c C-r" #'inferior-cc-eval-region)
|
||||
(keymap-set java-ts-mode-map "C-c C-b" #'inferior-cc-eval-buffer)
|
||||
(keymap-set java-ts-mode-map "C-M-x" #'inferior-cc-eval-defun))
|
||||
|
||||
;; jupyter
|
||||
(use-package jupyter
|
||||
:hook (jupyter-repl-mode . my/-setup-jupyter-mode)
|
||||
@ -2210,32 +2217,6 @@ current buffer is a Jupyter buffer, just use that."
|
||||
(point-min) (point-max)))
|
||||
(message "Evaluated buffer"))
|
||||
|
||||
(defun my/c++-jupyter-eval-region (start end)
|
||||
"Send the current buffer between START and END to a Jupyter repl."
|
||||
(interactive "r")
|
||||
(let ((code (buffer-substring-no-properties start end)))
|
||||
(when (string-suffix-p ";" code)
|
||||
(setq code (substring code 0 (1- (length code)))))
|
||||
(my/jupyter-eval-in-proper-buffer code)
|
||||
(message "Evaluated region")))
|
||||
|
||||
(defun my/c++-ts-jupyter-eval-expression ()
|
||||
"Eval the expression under point by sending it to a Jupyter repl."
|
||||
(interactive nil c-ts-mode c++-ts-mode)
|
||||
(save-excursion
|
||||
(let ((start (point)))
|
||||
(back-to-indentation)
|
||||
(unless (> (point) start)
|
||||
(goto-char start)))
|
||||
(if-let ((thing (treesit-thing-at-point "_" 'nested))
|
||||
(code (treesit-node-text thing)))
|
||||
(progn
|
||||
(when (string-suffix-p ";" code)
|
||||
(setq code (substring code 0 (1- (length code)))))
|
||||
(my/jupyter-eval-in-proper-buffer code)
|
||||
(message "Evaluated: %s" code))
|
||||
(user-error "Nothing to evaluate under point"))))
|
||||
|
||||
(defun my/rust-jupyter-eval-region (start end)
|
||||
"Send the current buffer between START and END to a Jupyter repl."
|
||||
(interactive "r")
|
||||
@ -2258,16 +2239,6 @@ current buffer is a Jupyter buffer, just use that."
|
||||
(message "Evaluated: %s" code))
|
||||
(user-error "Nothing to evaluate under point"))))
|
||||
|
||||
(with-eval-after-load 'c-ts-mode
|
||||
(keymap-set c-ts-base-mode-map
|
||||
"C-M-x" #'my/jupyter-eval-defun)
|
||||
(keymap-set c-ts-base-mode-map
|
||||
"C-x C-e" #'my/c++-ts-jupyter-eval-expression)
|
||||
(keymap-set c-ts-base-mode-map
|
||||
"C-c C-r" #'my/c++-jupyter-eval-region)
|
||||
(keymap-set c-ts-base-mode-map
|
||||
"C-c C-b" #'my/jupyter-eval-buffer))
|
||||
|
||||
(with-eval-after-load 'rust-ts-mode
|
||||
(keymap-set rust-ts-mode-map
|
||||
"C-M-x" #'my/jupyter-eval-defun)
|
||||
@ -2739,6 +2710,10 @@ functions (only eshell uses it at the time of writing)."
|
||||
"--group-directories-first" ,file))))
|
||||
(add-to-list 'dirvish-preview-dispatchers 'eza))
|
||||
|
||||
;; trashed
|
||||
(use-package trashed
|
||||
:bind ("C-c h" . trashed))
|
||||
|
||||
;; ibuffer
|
||||
(use-package ibuffer
|
||||
:bind ("C-x C-b" . ibuffer))
|
||||
|
||||
Reference in New Issue
Block a user