From 953a31902219090ed971b6cc0447d71b01b3d02f Mon Sep 17 00:00:00 2001 From: Milo Davis Date: Fri, 4 Aug 2017 16:10:24 +0200 Subject: [PATCH] Michelson-mode: async, cache, and refactorings --- emacs/README.md | 56 +++++++++ emacs/michelson-mode.el | 246 ++++++++++++++++++++++++++++++---------- 2 files changed, 245 insertions(+), 57 deletions(-) create mode 100644 emacs/README.md diff --git a/emacs/README.md b/emacs/README.md new file mode 100644 index 000000000..37913a483 --- /dev/null +++ b/emacs/README.md @@ -0,0 +1,56 @@ +# Michelson Emacs mode +This mode is a work in progress. +Please contact us with bugs and feature requests. +All of the options mentioned below are also accessible via the customize menu. + +## Required Configuration +To use the mode, you must load the `michelson-mode.el` file into Emacs. +Add the following to your `.emacs` file. +```elisp +(load "~/tezos/tezos/emacs/michelson-mode.el" nil t) +``` + +Before using the Emacs mode, you must configure the `michelson-client-command`. +If you have compiled the Tezos Git repository, +set this to be the path to the `tezos-client` binary on your system. +Make sure you have an up to date version of the client compiled. +You must also start a tezos node to enable typechecking features. +This option is recommended because it is faster than operating through +the docker container. + +If you wish to run the Emacs mode with the alphanet script, +use the path of the `alphanet.sh` script, plus the word `client`. +You must also set the `michelson-alphanet` variable to be `t`. +If you do not set this option, the mode will not work with the alphanet. + +Here are examples of the client configuration: +### Without the alphanet +```elisp +(setq michelson-client-command "~/tezos/tezos/tezos-client") +(setq michelson-alphanet nil) +``` +### With the alphanet +```elisp +(setq michelson-client-command "~/tezos/alphanet/alphanet.sh client") +(setq michelson-alphanet t) +``` + +## Additional Options +There are various feature of the Emacs mode you may wish to configure. + +### Error display +When writing a contract, you may wish to disable error display in order to +avoid the "wrong stack type at end of body" error that is often present. +This can be done by changing the +`michelson-print-errors` and `michelson-highlight-errors` options. +Both of these options also have interactive toggles for easy access. + +### Live printing +You can disable live printing using the `michelson-live-editing` option. +If this option is disabled, both type and error printing are supressed. +No background command will be run, limiting the mode to syntax highlighting. +This command can also be toggled interactively using the +`michelson-toggle-live-editing` command. + +### Faces +The highlighting colors used can be configured. See the customize menu for details. diff --git a/emacs/michelson-mode.el b/emacs/michelson-mode.el index 62496ea9e..1299056d9 100644 --- a/emacs/michelson-mode.el +++ b/emacs/michelson-mode.el @@ -1,5 +1,7 @@ ;; Major mode for editing Michelson smart contracts. +(require 'cl) + (defvar michelson-mode-hook nil) (defgroup michelson nil @@ -12,7 +14,7 @@ :prefix "michelson-" :group 'michelson) -(defcustom michelson-mode-client-command "tezos-client" +(defcustom michelson-client-command "tezos-client" "Path to the `tezos-client' binary." :type 'string :group 'michelson-options) @@ -28,6 +30,21 @@ :group 'michelson :group 'faces) +(defcustom michelson-live-editing t + "Toggles live types and error printing. +Overrides `michelson-print-errors' and `michelson-highlight-errors'" + :group 'michelson-options) + +(defcustom michelson-print-errors t + "Print the errors in the output buffer." + :type 'boolean + :group 'michelson-options) + +(defcustom michelson-highlight-errors t + "Highlight errors in the source buffer." + :type 'boolean + :group 'michelson-options) + (defvar michelson-face-instruction 'michelson-face-instruction "Face name for Michelson instructions.") @@ -47,6 +64,7 @@ (defvar michelson-face-constant 'michelson-face-constant "Face name for Michelson constants.") + (defface michelson-face-constant '((t (:inherit 'font-lock-constant-face))) "Face for Michelson constants." @@ -68,9 +86,19 @@ "Face for Michelson comments." :group 'michelson-faces) +(defvar michelson-face-declaration + 'michelson-face-declaration + "Face name for Michelson declarations.") + +(defface michelson-face-declaration + '((t (:inherit 'font-lock-keyword-face))) + "Face for Michelson constants." + :group 'michelson-faces) + (defvar michelson-face-error 'michelson-face-error "Face name for Michelson comments.") + (defface michelson-face-error '(( ((class color) (background light)) (:background "MistyRose") ) ( ((class color) (background dark)) (:background "DarkRed") )) @@ -87,6 +115,14 @@ (interactive) (customize-group-other-window `michelson-faces)) +(defun michelson-toggle-print-errors () + (interactive) + (setq michelson-print-errors (not michelson-print-errors))) + +(defun michelson-highlight-errors () + (interactive) + (setq michelson-highlight-errors (not michelson-highlight-errors))) + (defconst michelson-mode-map (let ((michelson-mode-map (make-sparse-keymap))) ;; menu @@ -125,6 +161,8 @@ '("\\<[A-Z][a-z_0-9]+\\>" . michelson-face-constant) '("\\<[A-Z][A-Z_0-9]*\\>" . michelson-face-instruction) '("\\<\$[A-Za-z-_0-9]*\\>" . michelson-face-annotation) + ;; This will have problems if users have whitespace in front of the declarations + '("^parameter\\|^return\\|^storage\\|^code" . michelson-face-declaration) '("\\<[a-z][a-z_0-9]*\\>" . michelson-face-type)) nil nil nil nil '(font-lock-syntactic-face-function . michelson-font-lock-syntactic-face-function))) @@ -296,68 +334,157 @@ (michelson-goto-previous-token))))) (display-message-or-buffer message "*Michelson*"))) -(defun michelson-type-at-point () - "Display the type of the expression under the cursor." - (interactive) - (let ((tmp-file (make-temp-file (buffer-name)))) +(cl-defstruct cache + "Cache for types. Invalid entries are removed" + types + errors) + +(defvar michelson-cached-buffer-info (make-cache :types '() :errors '())) + +(defvar michelson-process-output-buffer "*Michelson-process*") + +(defun michelson-erase-process-buffer () + "Remove all text from process buffer." + (get-buffer-create michelson-process-output-buffer) + (with-current-buffer michelson-process-output-buffer + (erase-buffer))) + +(defun michelson-async-command-to-string (command callback) + "Asynchronously execute `COMMAND' and call the `CALLBACK' on the resulting string." + (lexical-let ((callback-fun callback)) + (michelson-erase-process-buffer) + (set-process-sentinel + (start-process-shell-command + "michelson-shell-process" + michelson-process-output-buffer + command) + (lambda (process signal) + (let ((output + (with-current-buffer michelson-process-output-buffer + (buffer-string)))) + (funcall callback-fun output)))))) + +(defun michelson-clean-cache () + "Clean the buffer's program info cache." + (let ((types (cache-types michelson-cached-buffer-info)) + (errors (cache-errors michelson-cached-buffer-info)) + (clean-cache-entry + (lambda (alist) + (remove-if (lambda (entry) + (let ((tok-end (cadr entry))) + (> tok-end (point)))) + alist)))) + (setq michelson-cached-buffer-info + (make-cache :types (funcall clean-cache-entry types) + :errors (funcall clean-cache-entry errors))))) + +(defun michelson-get-info (buffer-name) + "Refresh the info about the program in `BUFFER-NAME' from the command." + (lexical-let ((tmp-file (make-temp-file buffer-name))) (write-region (point-min) (point-max) tmp-file nil 'no-message) - (let* ((command (concat - (if michelson-alphanet "ALPHANET_EMACS=true " "") - michelson-mode-client-command - " typecheck program " - (if michelson-alphanet - (concat "container:" buffer-file-name) - buffer-file-name) - " -details -emacs")) - (stdout - (shell-command-to-string command)) - (record - (car (read-from-string stdout))) - (errors - (cdr (assoc 'errors record))) - (types - (cdr (assoc 'types record))) - (message "")) - (delete-file tmp-file) - (remove-overlays) - (setq message "") - (dolist (elt types) - (if (and (<= (car elt) (point)) (<= (point) (cadr elt)) - (equal (get-text-property (point) 'face) - 'michelson-face-instruction)) - (setq message (cadr (cdr elt))))) + (let ((command (concat + "ALPHANET_EMACS=true " + "TEZOS_ALPHANET_DO_NOT_PULL=yes " + michelson-client-command + " typecheck program " + (let ((file-name + (make-temp-file (buffer-name)))) + (write-region (point-min) (point-max) file-name nil 'no-message) + (if michelson-alphanet + (concat "container:" file-name) + file-name)) + " -details -emacs"))) + (michelson-async-command-to-string + command + (lambda (output) + (condition-case err + (let* + ((record (car (read-from-string output))) + (errors (cdr (assoc 'errors record))) + (types (cdr (assoc 'types record)))) + (setq michelson-cached-buffer-info (make-cache :types types :errors errors))) + ((error err) + (let ((inhibit-message t)) + (message output))))))))) + +(defvar michelson-output-buffer-name + "*Michelson*") + +(defun michelson-write-output-buffer (data) + "Write the given `DATA' to the output buffer." + (lexical-let* + ((buffer (get-buffer-create michelson-output-buffer-name)) + (message-window + (if (get-buffer-window buffer) + (get-buffer-window buffer) + (display-buffer-below-selected buffer nil))) + (lines 0)) + (when (get-buffer-window buffer) + (set-window-dedicated-p (get-buffer-window buffer) t)) + (save-excursion + (set-buffer michelson-output-buffer-name) + (read-only-mode -1) + (erase-buffer) + (insert data) + (read-only-mode 1) + (goto-char (point-min)) + (while (not (eobp)) + (vertical-motion 1) + (setq lines (+ 1 lines))) + (window-resize + message-window + (min (- (window-total-height) 5) + (+ (- (max 4 lines) + (window-size message-window)) + 2)))))) + +(defun michelson-show-program-info (types errors) + "Show the program's `TYPES' and `ERRORS'." + (interactive) + (remove-overlays) + (lexical-let ((types-info nil) + (errors-info nil)) + (dolist (elt types) + (if (and (<= (car elt) (point)) (<= (point) (cadr elt)) + (equal (get-text-property (point) 'face) + 'michelson-face-instruction)) + (setq types-info (cadr (cdr elt))))) + (when michelson-highlight-errors (dolist (elt errors) (overlay-put (make-overlay (car elt) (cadr elt)) 'face 'michelson-face-error) (if (and (<= (car elt) (point)) (<= (point) (cadr elt))) (progn - (if (string= "" message) - nil - (setq message (concat message "\n"))) - (setq message (concat message (cadr (cdr elt))))))) - (if (string= message "") - (setq message "\n No instruction at point.")) - (let - ((message-window - (display-buffer-below-selected - (get-buffer-create "*Michelson*") nil)) - (lines 0)) - (save-excursion - (set-buffer "*Michelson*") - (toggle-read-only nil) - (erase-buffer) - (insert message) - (toggle-read-only t) - (beginning-of-buffer) - (while (not (eobp)) - (vertical-motion 1) - (setq lines (+ 1 lines))) - (window-resize - message-window - (+ (- (max 4 lines) - (window-size message-window)) 1))))))) + (when michelson-print-errors + (unless errors-info + (setq errors-info (concat errors-info "\n"))) + (setq errors-info (concat errors-info (cadr (cdr elt))))))))) + (michelson-write-output-buffer + (cond ((not (or types-info types-info)) "\n No instruction at point.\n") + ((and errors-info (not types-info)) errors-info) + (t (concat types-info "\n\n" errors-info)))))) + +(defun michelson-type-at-point () + "Display the type of the expression under the cursor." + (interactive) + (michelson-get-info (buffer-name)) + (let ((types (cache-types michelson-cached-buffer-info)) + (errors (cache-errors michelson-cached-buffer-info))) + (michelson-show-program-info types errors))) + +(defun michelson-toggle-live-editing () + "Toggle `michelson-live-editing'. +Enables or disables stack and error display." + (interactive) + (when (and michelson-live-editing + (get-buffer michelson-output-buffer-name)) + (save-excursion + (set-buffer michelson-output-buffer-name) + (kill-buffer-and-window))) + (setq michelson-live-editing (not michelson-live-editing))) (defun michelson-update-minibuffer-info () - (when (nth 2 michelson-state) (cancel-timer (nth 2 michelson-state))) + (when (nth 2 michelson-state) + (cancel-timer (nth 2 michelson-state))) (setf (nth 2 michelson-state) (run-at-time @@ -365,7 +492,8 @@ (lambda (buffer) (with-current-buffer buffer (setf (nth 2 michelson-state) nil) - (when (not (= (nth 0 michelson-state) (point))) + (when (and (not (= (nth 0 michelson-state) (point))) + michelson-live-editing) (setf (nth 0 michelson-state) (point)) (michelson-type-at-point)))) (current-buffer)))) @@ -388,12 +516,16 @@ (set (make-local-variable 'michelson-state) (list 0 0 nil)) + (set (make-local-variable 'michelson-cached-buffer-info) + (make-cache :types nil + :errors nil)) (add-to-list (make-local-variable 'pre-command-hook) 'michelson-update-minibuffer-info) (add-to-list (make-local-variable 'focus-in-hook) 'michelson-update-minibuffer-info) + (add-hook 'post-self-insert-hook 'michelson-clean-cache) (setq major-mode 'michelson-mode) (setq mode-name "Michelson") (setq indent-tabs-mode nil)