1 files changed, 118 insertions, 0 deletions
diff --git a/lib/prog/jao-compilation.el b/lib/prog/jao-compilation.el
new file mode 100644
index 0000000..ef303ea
--- /dev/null
+++ b/lib/prog/jao-compilation.el
@@ -0,0 +1,118 @@
+;;; jao-compilation.el --- utilities to lauch compilations  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020, 2021  jao
+
+;; Author: jao <mail@jao.io>
+;; Keywords: convenience
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Utilities to launch compilation processes from adequate root directories
+
+;;; Code:
+
+(defvar jao-compilation-dominating-files nil)
+(defvar jao-compilation-dominating-file-rxs '(".+\\.cabal"))
+(defvar jao-compilation-environment ())
+(defvar jao-compilation-dominating-rx "")
+
+(defun jao-compilation--environment ()
+  (let (result)
+    (dolist (v jao-compilation-environment result)
+      (let ((vv (getenv v)))
+        (when vv (add-to-list 'result (format "%s=%s" v vv)))))))
+
+;;;###autoload
+(defun jao-compilation-add-dominating (&rest fs)
+  (dolist (f fs) (add-to-list 'jao-compilation-dominating-files f))
+  (setq jao-compilation-dominating-rx
+        (concat "\\("
+                (regexp-opt jao-compilation-dominating-files)
+                "\\|"
+                (mapconcat 'identity
+                           jao-compilation-dominating-file-rxs
+                           "\\|")
+                "\\)$")))
+
+;;;###autoload
+(defun jao-path-relative-to (path base)
+  (let* ((path (file-name-directory path))
+         (base (file-name-directory base))
+         (blen (length base)))
+    (if (<= (length path) blen)
+        path
+      (if (string-equal base (substring path 0 blen))
+          (substring path blen)
+        path))))
+
+;;;###autoload
+(defun jao-compilation-find-root (file doms)
+  (when file
+    (locate-dominating-file file `(lambda (d)
+                                    (when (file-directory-p d)
+                                      (directory-files d nil ,doms))))))
+
+;;;###autoload
+(defun jao-compilation-root (&optional dir)
+  (when-let ((rfn (jao-compilation-find-root (or dir (buffer-file-name))
+                                             jao-compilation-dominating-rx)))
+    (let* ((default-directory (expand-file-name rfn))
+           (dir (file-name-directory rfn))
+           (rel-path (jao-path-relative-to dir default-directory)))
+      (if (and (file-directory-p "build")
+               (not (file-exists-p "build.xml"))
+               (not (file-exists-p "setup.py")))
+          (expand-file-name rel-path (expand-file-name "build/"))
+        default-directory))))
+
+;;;###autoload
+(defun jao-compilation-root-file ()
+  (when-let ((dir (jao-compilation-root)))
+    (car (directory-files dir nil jao-compilation-dominating-rx))))
+
+;;;###autoload
+(defun jao-find-compilation-root (dir)
+  (when (and (stringp dir) (file-exists-p dir))
+    (when-let ((root (jao-compilation-root dir)))
+      (cons 'transient root))))
+
+;;;###autoload
+(defun jao-compilation-env (v)
+  "Add new environment variables to the compilation environment
+        used by `jao-compile'"
+  (add-to-list 'jao-compilation-environment v))
+
+;;;###autoload
+(defun jao-compile ()
+  "Find the root of current file's project and issue a
+        compilation command"
+  (interactive)
+  (let ((default-directory (jao-compilation-root))
+        (compilation-environment (jao-compilation--environment))
+        (compilation-read-command 'compilation-read-command))
+    (call-interactively 'compile)))
+
+;;;###autoload
+(defun jao-compilation-setup ()
+  (jao-compilation-add-dominating
+   "Makefile" "makefile" "configure.ac" "bootstrap.sh" "aclocal.m4"
+   "project.clj" "build.xml" "pom.xml" "setup.py" "stack.yaml")
+  (with-eval-after-load "project"
+    (add-to-list 'project-find-functions #'jao-find-compilation-root)))
+
+
+(provide 'jao-compilation)
+;;; jao-compilation.el ends here