500 lines
20 KiB
EmacsLisp
500 lines
20 KiB
EmacsLisp
;;; 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
|