unikernel/duniverse/dune_/editor-integration/emacs/dune-watch.el

@@ -0,0 +1,197 @@
+;;; 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