summaryrefslogtreecommitdiffhomepage
path: root/lib/prog
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2021-02-02 05:16:17 +0000
committerjao <jao@gnu.org>2021-02-02 05:16:17 +0000
commit771abb84830678455de4625ac7f082d8100f0ea0 (patch)
tree0d303c2cb0861b949ca73a9705954f6a69c4f877 /lib/prog
parent81eceb5507aa0659e9f0c9761e54e9102085c4ac (diff)
downloadelibs-771abb84830678455de4625ac7f082d8100f0ea0.tar.gz
elibs-771abb84830678455de4625ac7f082d8100f0ea0.tar.bz2
libs -> lib/
Diffstat (limited to 'lib/prog')
-rw-r--r--lib/prog/jao-compilation.el118
-rw-r--r--lib/prog/jao-sloc.el33
-rw-r--r--lib/prog/jao-vterm-repl.el130
3 files changed, 281 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
diff --git a/lib/prog/jao-sloc.el b/lib/prog/jao-sloc.el
new file mode 100644
index 0000000..1f0e9ab
--- /dev/null
+++ b/lib/prog/jao-sloc.el
@@ -0,0 +1,33 @@
+;; sloc.el -- LOC utilities
+
+;;;###autoload
+(defun count-sloc-region (beg end kind)
+ "Count source lines of code in region (or (narrowed part of)
+ the buffer when no region is active). SLOC means that empty
+ lines and comment-only lines are not taken into consideration.
+
+ (function by Stefan Monnier).
+ "
+ (interactive
+ (if (use-region-p)
+ (list (region-beginning) (region-end) 'region)
+ (list (point-min) (point-max) 'buffer)))
+ (save-excursion
+ (goto-char beg)
+ (let ((count 0))
+ (while (< (point) end)
+ (cond
+ ((nth 4 (syntax-ppss)) ;; BOL is already inside a comment.
+ (let ((pos (point)))
+ (goto-char (nth 8 (syntax-ppss)))
+ (forward-comment (point-max))
+ (if (< (point) pos) (goto-char pos)))) ;; Just paranoia
+ (t (forward-comment (point-max))))
+ (setq count (1+ count))
+ (forward-line))
+ (when kind
+ (message "SLOC in %s: %s." kind count)))))
+
+
+(provide 'jao-sloc)
+;;; sloc.el ends here
diff --git a/lib/prog/jao-vterm-repl.el b/lib/prog/jao-vterm-repl.el
new file mode 100644
index 0000000..699ff39
--- /dev/null
+++ b/lib/prog/jao-vterm-repl.el
@@ -0,0 +1,130 @@
+;;; jao-vterm-repl.el --- vterm-based repls -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020, 2021 jao
+
+;; Author: jao <mail@jao.io>
+;; Keywords: terminals
+
+;; 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:
+
+;; Helpers to launch reply things such as erlang shells inside a vterm.
+;; For instance, to declare an erl repl for rebar projects, one would call:
+;;
+;; (jao-vterm-repl-register "rebar.config" "rebar3 shell" "^[0-9]+> ")
+
+;;; Code:
+
+(require 'jao-compilation)
+
+(declare-function 'vterm-copy-mode "vterm")
+(declare-function 'vterm-send-string "vterm")
+(declare-function 'vterm-send-return "vterm")
+
+(defun jao-vterm-repl--buffer-name (&optional dir)
+ (format "*vterm -- repl - %s*" (or dir (jao-compilation-root))))
+
+(defvar jao-vterm-repl-repls nil)
+(defvar jao-vterm-repl-prompts nil)
+(defvar-local jao-vterm-repl--name nil)
+(defvar-local jao-vterm-repl--last-buffer nil)
+(defvar-local jao-vterm-repl--prompt-rx "^[0-9]+> ")
+
+(setq vterm-buffer-name-string nil)
+
+(defun jao-vterm-repl--exec (cmd &optional name)
+ (vterm name)
+ (when name
+ (vterm-send-string "unset PROMPT_COMMAND\n\n"))
+ (vterm-send-string cmd)
+ (vterm-send-return)
+ (when name (rename-buffer name t)))
+
+;;;###autoload
+(defun jao-vterm-repl-previous-prompt ()
+ (interactive)
+ (when (derived-mode-p 'vterm-mode)
+ (vterm-copy-mode 1)
+ (forward-line 0)
+ (when (re-search-backward jao-vterm-repl--prompt-rx nil t)
+ (goto-char (match-end 0)))))
+
+;;;###autoload
+(defun jao-vterm-repl-next-prompt ()
+ (interactive)
+ (when (derived-mode-p 'vterm-mode)
+ (vterm-copy-mode 1)
+ (or (re-search-forward jao-vterm-repl--prompt-rx nil t)
+ (vterm-copy-mode -1))
+ (unless (save-excursion
+ (re-search-forward jao-vterm-repl--prompt-rx nil t))
+ (vterm-copy-mode -1))))
+
+;;;###autoload
+(define-minor-mode jao-vterm-repl-mode "repl-aware vterm" nil nil
+ '(("\C-c\C-p" . jao-vterm-repl-previous-prompt)
+ ("\C-c\C-n" . jao-vterm-repl-next-prompt)
+ ("\C-c\C-z" . jao-vterm-repl-pop-to-src)))
+
+;;;###autoload
+(defun jao-vterm-repl ()
+ (let* ((dir (jao-compilation-root))
+ (vname (jao-vterm-repl--buffer-name dir))
+ (root-name (jao-compilation-root-file))
+ (buffer (seq-find `(lambda (b)
+ (string=
+ (buffer-local-value 'jao-vterm-repl--name
+ b)
+ ,vname))
+ (buffer-list))))
+ (or buffer
+ (let ((default-directory dir)
+ (prompt (cdr (assoc root-name jao-vterm-repl-prompts)))
+ (cmd (or (cdr (assoc root-name jao-vterm-repl-repls))
+ (read-string "REPL command: ")))
+ (bname (format "* vrepl - %s/%s *"
+ (file-name-base (string-remove-suffix "/" dir))
+ root-name)))
+ (jao-vterm-repl--exec cmd bname)
+ (jao-vterm-repl-mode)
+ (setq-local jao-vterm-repl--name vname)
+ (when prompt (setq-local jao-vterm-repl--prompt-rx prompt))
+ (current-buffer)))))
+
+;;;###autoload
+(defun jao-vterm-repl-register (build-file repl-cmd prompt-rx)
+ (jao-compilation-add-dominating build-file)
+ (add-to-list 'jao-vterm-repl-repls (cons build-file repl-cmd))
+ (add-to-list 'jao-vterm-repl-prompts (cons build-file prompt-rx)))
+
+;;;###autoload
+(defun jao-vterm-repl-pop-to-repl ()
+ (interactive)
+ (let ((bn (current-buffer)))
+ (pop-to-buffer (jao-vterm-repl))
+ (setq-local jao-vterm-repl--last-buffer bn)))
+
+;;;###autoload
+(defun jao-vterm-repl-pop-to-src ()
+ (interactive)
+ (when (buffer-live-p jao-vterm-repl--last-buffer)
+ (pop-to-buffer jao-vterm-repl--last-buffer)))
+
+;;;###autoload
+(defun jao-vterm-repl-send (cmd)
+ (with-current-buffer (jao-vterm-repl) (vterm-send-string cmd)))
+
+(provide 'jao-vterm-repl)
+;;; jao-vterm-repl.el ends here