radium-git.el

;;; radium-git.el, suckless git via vc + cfg.rp push templates -*- lexical-binding: t; -*-
;;
;; vc is already pinned to git (radium-vc-dired.el), so this is the
;; whole git ui: vc-dir for status/commit, vc-diff/log/annotate, and
;; C-c v p pushing through the named command templates in cfg.rp's
;; [push] section:
;;
;;   [push]
;;   remote = origin
;;   branch = trunk
;;   deploy = git push {remote} {branch} && ssh box 'do-deploy'
;;
;; picking a template name runs its command ({remote}/{branch} get
;; substituted), typing anything else pushes that branch, empty RET
;; pushes the configured default.
 
(require 'vc)
(require 'vc-dir)
(require 'radium-conf)
(require 'cl-lib) ;; cl-remove-if - already autoloaded in stock emacs
                  ;; regardless, but no reason to lean on that
 
(defvar radium-git-push-history nil
  "history of what i typed at the C-c v p prompt.")
 
(defun radium-git-current-branch ()
  "the current git branch name, or nil."
  (when (executable-find "git")
    (let ((out (shell-command-to-string
                "git symbolic-ref --short -q HEAD 2>/dev/null")))
      (and (not (string-empty-p out)) (string-trim out)))))
 
(defun radium-git-push-templates ()
  "the named push templates from cfg.rp's [push] section, as
\(name . command) string alist - the remote/branch keys themselves
excluded."
  (let* ((root (radium-conf-root))
         (file (and root (expand-file-name radium-conf-file root))))
    (when file
      (let ((sec (assq 'push (radium-conf-parse file))))
        (mapcar (lambda (pair)
                  (cons (symbol-name (car pair)) (cdr pair)))
                (cl-remove-if (lambda (pair) (memq (car pair) '(remote branch)))
                              (cdr sec)))))))
 
(defun radium-git-push-command (choice remote branch templates)
  "the git push command CHOICE resolves to, given REMOTE and BRANCH and
the named TEMPLATES: empty means the plain default, a template name
runs its command, anything else is treated as a branch name."
  (cond
   ((string-empty-p choice) (format "git push %s %s" remote branch))
   ((assoc choice templates)
    ;; literal=t on both: without it, a remote/branch containing "\&"
    ;; or "\N" gets misread as a replace-regexp-in-string backreference
    ;; (re-inserting the whole match, or a nonexistent capture group)
    ;; instead of standing for itself.
    (replace-regexp-in-string
     (regexp-quote "{branch}") branch
     (replace-regexp-in-string
      (regexp-quote "{remote}") remote (cdr (assoc choice templates)) nil t)
     nil t))
   (t (format "git push %s %s" remote choice))))
 
(defun radium-git-push ()
  "push this project (C-c v p): cfg.rp [push] templates show up
in the completion list, a bare branch name pushes that branch, empty
RET pushes remote/branch as configured. the command runs in a
compilation buffer like a build, so failures are clickable."
  (interactive)
  (let* ((root (or (radium-conf-root) (radium-build-root)))
         (remote (or (radium-conf 'push 'remote) "origin"))
         (branch (or (radium-conf 'push 'branch)
                     (radium-git-current-branch)
                     "trunk"))
         (templates (radium-git-push-templates))
         (choice (completing-read
                  (format "push (%s %s): " remote branch)
                  (mapcar #'car templates)
                  nil nil nil 'radium-git-push-history)))
    (let ((default-directory root))
      (compile (radium-git-push-command choice remote branch templates)))))
 
(defun radium-git-status ()
  "open vc-dir on this project's git root (C-c v s) - status, staging,
committing, everything right there."
  (interactive)
  (vc-dir (or (vc-root-dir) (radium-build-root))))
 
(global-set-key (kbd "C-c v s") #'radium-git-status)
(global-set-key (kbd "C-c v d") #'vc-diff)
(global-set-key (kbd "C-c v l") #'vc-print-log)
(global-set-key (kbd "C-c v a") #'vc-annotate)
(global-set-key (kbd "C-c v p") #'radium-git-push)
(global-set-key (kbd "C-c v c") #'vc-next-action)
 
(provide 'radium-git)