198 lines
7 KiB
EmacsLisp
198 lines
7 KiB
EmacsLisp
|
;;; dune-watch.el --- provides integration with dune watch -*- lexical-binding: t; -*-
|
||
|
|
|
||
|
|
;; Copyright (C) 2021 Kiran Gopinathan
|
||
|
|
;; Author: Kiran Gopinathan <kirang@comp.nus.edu.sg>
|
||
|
|
;; Keywords:
|
||
|
|
|
||
|
|
;; This file is not part of GNU Emacs.
|
||
|
|
|
||
|
|
;;; Commentary:
|
||
|
|
|
||
|
|
;; This package complements dune mode with integration with --watch
|
||
|
|
;; tasks.
|
||
|
|
|
||
|
|
;; Permission to use, copy, modify, and distribute this software for
|
||
|
|
;; any purpose with or without fee is hereby granted, provided that
|
||
|
|
;; the above copyright notice and this permission notice appear in
|
||
|
|
;; all copies.
|
||
|
|
;;
|
||
|
|
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
|
||
|
|
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
|
||
|
|
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
|
||
|
|
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
|
||
|
|
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
|
||
|
|
;; LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
||
|
|
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
||
|
|
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||
|
|
|
||
|
|
;;; Code:
|
||
|
|
(require 'subr-x)
|
||
|
|
|
||
|
|
;;;; Customisation
|
||
|
|
(defgroup dune-watch nil
|
||
|
|
"Customisation group for dune-watch-minor-mode."
|
||
|
|
:prefix "dune-watch-mode-"
|
||
|
|
:group 'applications)
|
||
|
|
;;;;; Command configuration
|
||
|
|
|
||
|
|
(defcustom dune-watch-default-command "build"
|
||
|
|
"Default command for dune-watch."
|
||
|
|
:type 'string
|
||
|
|
:group 'dune-watch)
|
||
|
|
|
||
|
|
(defcustom dune-watch-command-format
|
||
|
|
"opam exec -- dune %s --watch"
|
||
|
|
"Format of command to run to invoke dune watch mode."
|
||
|
|
:type 'string
|
||
|
|
:group 'dune-watch)
|
||
|
|
|
||
|
|
(defcustom dune-watch-delete-buffer-on-termination t
|
||
|
|
"Whether to delete the dune watch buffer when the dune watch process terminates."
|
||
|
|
:type 'bool
|
||
|
|
:group 'dune-watch)
|
||
|
|
|
||
|
|
(defcustom dune-watch-popup-function #'display-buffer-pop-up-window
|
||
|
|
"Function passed to `display-buffer' to present compilation output to user."
|
||
|
|
:type 'function
|
||
|
|
:group 'dune-watch)
|
||
|
|
|
||
|
|
(defcustom dune-watch-read-command t
|
||
|
|
"Whether the user should be prompted to select a build task."
|
||
|
|
:type 'bool
|
||
|
|
:group 'dune-watch)
|
||
|
|
|
||
|
|
;;;; Constants
|
||
|
|
|
||
|
|
(defconst dune-watch-buffer-name "*dune-watch*"
|
||
|
|
"Name of buffer used to track buffer outputs.")
|
||
|
|
|
||
|
|
(defconst dune-watch-process-name "*dune-watch-process*"
|
||
|
|
"Name of process used to run dune watch.")
|
||
|
|
|
||
|
|
(defconst dune-watch-header "********** NEW BUILD"
|
||
|
|
"Prefix of the header of dune watch output.")
|
||
|
|
|
||
|
|
(defconst dune-watch-read-prompt "dune task (default: %s): "
|
||
|
|
"Prompt displayed to the user to dune task.")
|
||
|
|
|
||
|
|
(defconst dune-watch-supported-commands '("build" "test")
|
||
|
|
"List of dune build tasks supported by dune-watch.")
|
||
|
|
|
||
|
|
;;;; Global variables
|
||
|
|
|
||
|
|
(defvar dune-watch-task-history nil
|
||
|
|
"Variable used to track history of dune build tasks.")
|
||
|
|
|
||
|
|
;;;; Local variables
|
||
|
|
(defvar-local dune-watch-buffer nil
|
||
|
|
"Buffer corresponding to dune watch for current program")
|
||
|
|
|
||
|
|
(defvar-local dune-watch-process nil
|
||
|
|
"Process corresponding to dune watch for current program")
|
||
|
|
|
||
|
|
(defvar-local dune-watch-header-start nil
|
||
|
|
"Start of the header of the most recent dune watch output.")
|
||
|
|
|
||
|
|
;;;; Implementation
|
||
|
|
|
||
|
|
(defun dune-watch-generate-new-buffer ()
|
||
|
|
"Return a new buffer to be used by dune watch."
|
||
|
|
(let ((buffer (generate-new-buffer dune-watch-buffer-name)))
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(compilation-mode)
|
||
|
|
(setq dune-watch-buffer buffer)
|
||
|
|
(setq dune-watch-process nil)
|
||
|
|
(setq dune-watch-header-start nil))
|
||
|
|
buffer))
|
||
|
|
|
||
|
|
(defun dune-watch-sentinel-function (watch-buffer process event)
|
||
|
|
"Process sentinel used by dune-watch-minor-mode.
|
||
|
|
|
||
|
|
WATCH-BUFFER is the buffer used by dune watch.
|
||
|
|
PROCESS is the dune-watch process name
|
||
|
|
EVENT is the text output by the sentinel."
|
||
|
|
(when (and dune-watch-delete-buffer-on-termination (buffer-live-p watch-buffer))
|
||
|
|
(kill-buffer watch-buffer))
|
||
|
|
(message "Dune watch process %s terminated with message \"%s\"" process (string-trim event)))
|
||
|
|
|
||
|
|
(defun dune-watch-update-header-start ()
|
||
|
|
"Update the position of the header of the most recent dune watch output."
|
||
|
|
(save-excursion
|
||
|
|
(goto-char (point-max))
|
||
|
|
(setq dune-watch-header-start
|
||
|
|
(search-backward dune-watch-header nil t))))
|
||
|
|
|
||
|
|
(defun dune-watch-beautify-buffer ()
|
||
|
|
"Cleans dune watch buffer by removing all but the last build output."
|
||
|
|
(let ((inhibit-read-only t)
|
||
|
|
(buffer-start (point-min)))
|
||
|
|
(when (and dune-watch-header-start buffer-start)
|
||
|
|
(delete-region buffer-start dune-watch-header-start)
|
||
|
|
(setq dune-watch-header-start buffer-start))))
|
||
|
|
|
||
|
|
(defun dune-watch-contains-errors ()
|
||
|
|
"Determines whether the dune watch buffer output contain any errors."
|
||
|
|
(save-excursion
|
||
|
|
(when dune-watch-header-start
|
||
|
|
(goto-char dune-watch-header-start)
|
||
|
|
(search-forward "File" nil t))))
|
||
|
|
|
||
|
|
(defun dune-watch-popup-buffer ()
|
||
|
|
"Pops up compilation output to user."
|
||
|
|
(when dune-watch-buffer
|
||
|
|
(display-buffer dune-watch-buffer dune-watch-popup-function)))
|
||
|
|
|
||
|
|
(defun dune-watch-filter-function (watch-buffer process event)
|
||
|
|
"Process filter function used by dune watch.
|
||
|
|
|
||
|
|
WATCH-BUFFER is the buffer corresponding to the process.
|
||
|
|
PROCESS is the name of the process.
|
||
|
|
EVENT is the string returned by the dune watch."
|
||
|
|
(when (and watch-buffer (buffer-live-p watch-buffer))
|
||
|
|
(with-current-buffer watch-buffer
|
||
|
|
(let ((inhibit-read-only t)
|
||
|
|
(buffer-end (point-max)))
|
||
|
|
(goto-char buffer-end)
|
||
|
|
(insert event)
|
||
|
|
(dune-watch-update-header-start)
|
||
|
|
(dune-watch-beautify-buffer)
|
||
|
|
|
||
|
|
(when (dune-watch-contains-errors)
|
||
|
|
(dune-watch-popup-buffer))))))
|
||
|
|
|
||
|
|
(defun dune-watch-on-kill-buffer ()
|
||
|
|
"Kill dune-watch process when main buffer is killed."
|
||
|
|
(when (and dune-watch-minor-mode dune-watch-process (process-live-p dune-watch-process))
|
||
|
|
(kill-process dune-watch-process)))
|
||
|
|
|
||
|
|
(defun start-dune-watch (command)
|
||
|
|
"Start a subprocess to run the dune COMMAND using the --watch flag."
|
||
|
|
(message "starting process to watch %s task..." command)
|
||
|
|
(let* ((buffer (dune-watch-generate-new-buffer))
|
||
|
|
(filter-process (apply-partially #'dune-watch-filter-function buffer))
|
||
|
|
(sentinel-process (apply-partially #'dune-watch-sentinel-function buffer))
|
||
|
|
(command (format dune-watch-command-format command)))
|
||
|
|
(setq dune-watch-buffer buffer)
|
||
|
|
(setq dune-watch-process (make-process
|
||
|
|
:name dune-watch-process-name
|
||
|
|
:buffer buffer
|
||
|
|
:command (split-string command)
|
||
|
|
:filter filter-process
|
||
|
|
:sentinel sentinel-process))
|
||
|
|
(add-hook 'kill-buffer-hook #'dune-watch-on-kill-buffer)))
|
||
|
|
|
||
|
|
(define-minor-mode dune-watch-minor-mode "A minor mode to run dune commands"
|
||
|
|
:group 'dune-watch
|
||
|
|
:init-value nil
|
||
|
|
(let ((command dune-watch-default-command))
|
||
|
|
(when dune-watch-read-command
|
||
|
|
(setq command (or (completing-read
|
||
|
|
(format dune-watch-read-prompt dune-watch-default-command)
|
||
|
|
dune-watch-supported-commands
|
||
|
|
nil nil dune-watch-default-command 'dune-watch-task-history)
|
||
|
|
command)))
|
||
|
|
(start-dune-watch command)))
|
||
|
|
|
||
|
|
(provide 'dune-watch)
|
||
|
|
;;; dune-watch.el ends here
|