diff --git a/emacs/coalton-mode.el b/emacs/coalton-mode.el index 1db9738d5..aff718ebd 100644 --- a/emacs/coalton-mode.el +++ b/emacs/coalton-mode.el @@ -8,7 +8,7 @@ ;; This file contains functions for in-Emacs structural operations on ;; Coalton code, including syntax highlighting, indentation and ;; navigation, and command integration with the in-CL operations -;; defined in `inferior-coalton.el'. +;; defined in `slime-coalton.el'. (require 'treesit) (require 'lisp-mnt) @@ -140,6 +140,19 @@ ((coalton--symbol-p node) (coalton--symbol-name node)))))) + +;; Easy menu + +(defvar coalton-easy-menu + (let ((C '(coalton-available-p))) + `("Coalton" + ("Debug" + [ "Show AST" slime-coalton--ast ,C ]) + ("Compile" + [ "Compile File" slime-coalton--compile-file ,C ])))) + +(easy-menu-define menubar-coalton coalton-mode-map "Coalton" coalton-easy-menu) + ;; Imenu @@ -172,11 +185,11 @@ (defun coalton--load-grammar () "Install grammar." - (let ((grammars `((coalton ,coalton-ts-repo "main")))) - (dolist (grammar grammars) - (unless (treesit-language-available-p (car grammar) nil) - (let ((treesit-language-source-alist grammars)) - (treesit-install-language-grammar (car grammar))))))) + (let ((treesit-language-source-alist + `((coalton ,coalton-ts-repo "main")))) + (unless (treesit-language-available-p 'coalton nil) + (when (yes-or-no-p "treesitter-coalton is not installed. Clone, build and install it?") + (treesit-install-language-grammar 'coalton))))) (defun coalton-mode-variables () "Initialize buffer-local vars." @@ -240,12 +253,9 @@ (string-equal "program" (treesit-node-type (treesit-node-parent node))))) -(defun coalton--node-at-point () - (treesit-node-at (point))) - (defun coalton-toplevel-form () "Return the text of the toplevel form at point." - (when-let ((node (coalton--find-parent (coalton--node-at-point) + (when-let ((node (coalton--find-parent (treesit-node-at (point)) #'coalton--toplevel-form-p))) (treesit-node-text node t))) diff --git a/emacs/inferior-coalton.el b/emacs/inferior-coalton.el deleted file mode 100644 index d83d72cb0..000000000 --- a/emacs/inferior-coalton.el +++ /dev/null @@ -1,37 +0,0 @@ -;;; inferior-coalton.el --- coalton-mode lisp integration -*- lexical-binding: t; -*- -;; -;; Slime extension via `define-slime-contrib' for interactive with a -;; Coalton instance running in a Slime/Swank-managed Lisp subprocess. - -(require 'slime) - -(defun slime-coalton-mode-hook () - (slime-mode 1)) - -(defun slime-coalton-indentation-update (symbol indent packages) - ;; Does the symbol have an indentation value that we set? - (when (equal (get symbol 'coalton-indent-function) - (get symbol 'slime-coalton-indent)) - (put symbol 'slime-coalton-indent indent) - (put symbol 'coalton-indent-function indent))) - - -;;; Initialization - -(defun slime-coalton-init () - (add-hook 'coalton-mode-hook 'slime-coalton-mode-hook) - (add-to-list 'slime-lisp-modes 'coalton-mode)) - -(defun slime-coalton-unload () - (remove-hook 'coalton-mode-hook 'slime-coalton-mode-hook) - (setq slime-lisp-modes (remove 'coalton-mode slime-lisp-modes))) - -(define-slime-contrib slime-coalton - "Support Coalton language" - (:authors "Jesse Bouwman ") - (:slime-dependencies slime-coalton) - (:swank-dependencies swank-coalton) - (:on-load - (slime-coalton-init))) - -(provide 'coalton) diff --git a/emacs/slime-coalton.el b/emacs/slime-coalton.el new file mode 100644 index 000000000..6779e4eed --- /dev/null +++ b/emacs/slime-coalton.el @@ -0,0 +1,68 @@ +;;; slime-coalton.el --- coalton-mode lisp integration -*- lexical-binding: t; -*- +;; +;; Slime extension via `define-slime-contrib' for interaction with a +;; Coalton instance running in a Slime-managed Lisp subprocess. + +(require 'slime) + +(defun coalton-available-p () + (and (not (null slime-net-processes)) + (fboundp 'xxx))) + +(cl-defmacro slime-coalton--show ((name) &body body) + (declare (indent 1)) + `(with-current-buffer (get-buffer-create ,name) + (erase-buffer) + ,@body + (display-buffer (current-buffer)) + (current-buffer))) + +(defun slime-coalton--buffer-name (type) + (format "*coalton-%s*" (symbol-name type))) + +(defun slime-coalton--popup-buffer (type) + (let ((name (slime-coalton--buffer-name type))) + (slime-coalton--show (name) + (current-buffer)))) + +(defun slime-coalton--popup (type value) + (pop-to-buffer (slime-coalton--popup-buffer type)) + (erase-buffer) + (insert value) + (goto-char (point-min))) + +(defun slime-coalton--eval (sexp cont) + (declare (indent 1)) + (slime-rex (cont) + (sexp "swank") + ((:ok result) + (when cont + (funcall cont result))) + ((:abort condition) + (message "Evaluation aborted on %s." condition)))) + +(defun slime-coalton--ast () + "Display the AST of the definition at point." + (interactive) + (let ((form (coalton-definition-at-point)) + (package (coalton-package))) + (slime-coalton--eval `(swank:swank-coalton-ast `,form `,package) + (lambda (result) + (slime-coalton--popup 'ast result))))) + + +;;; Initialization + +(defun slime-coalton-init () + (message "slime-coalton.el: slime-coalton-init")) + +(define-slime-contrib slime-coalton + "Support Coalton language" + (:authors "Jesse Bouwman ") + (:swank-dependencies swank-coalton)) + +(defun coalton () + (interactive) + (message "slime-coalton.el: coalton")) + +(provide 'slime-coalton) diff --git a/emacs/swank-coalton.lisp b/emacs/swank-coalton.lisp new file mode 100644 index 000000000..50a6eea0a --- /dev/null +++ b/emacs/swank-coalton.lisp @@ -0,0 +1,39 @@ +;;; swank-coalton.lisp + +(in-package :swank) + +(defun system-loaded-p (system-designator) + (find system-designator (asdf:already-loaded-systems) + :test #'string=)) + +(defun system-available-p (system-designator) + (asdf:find-system system-designator)) + +(defun system-status (system-designator) + (cond ((system-loaded-p system-designator) + :loaded) + ((system-available-p system-designator) + :available) + (t + :unavailable))) + + +(defslimefun swank-coalton-status () + (system-status "coalton")) + +(defslimefun swank-coalton-init () + (asdf:load-system "coalton")) + + +(defslimefun swank-coalton--ast (form package) + :xyz) + +(provide :swank-coalton) + + + +(swank-coalton--ast "(define (symbol-name sym) + (match sym + ((Symbol s) s)))" + "(package diff-example)") +