Initial commit
This commit is contained in:
commit
52224382bc
1 changed files with 181 additions and 0 deletions
181
git-graph.el
Normal file
181
git-graph.el
Normal file
|
|
@ -0,0 +1,181 @@
|
|||
;;; git-graph.el --- Generate git-style graphs using graphviz -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (c) 2015 Correl Roush <correl@gmail.com>
|
||||
|
||||
;;; License:
|
||||
|
||||
;; 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, 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 GNU Emacs; see the file COPYING. If not, write to the
|
||||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
;; Boston, MA 02110-1301, USA.
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'dash)
|
||||
|
||||
(defun git-graph/make-node (id &optional parents options)
|
||||
(list id parents options))
|
||||
|
||||
(defun git-graph/node-id (node)
|
||||
(nth 0 node))
|
||||
|
||||
(defun git-graph/node-parents (node)
|
||||
(nth 1 node))
|
||||
|
||||
(defun git-graph/node-group (node)
|
||||
(cdr (assoc 'group (nth 2 node))))
|
||||
|
||||
(defun git-graph/node-label (node)
|
||||
(cdr (assoc 'label (nth 2 node))))
|
||||
|
||||
(defun git-graph/+ (a b)
|
||||
(append a
|
||||
(-remove (lambda (node)
|
||||
(assoc (git-graph/node-id node) a))
|
||||
b)))
|
||||
|
||||
(defun git-graph/to-graphviz (id nodes)
|
||||
(string-join
|
||||
(list
|
||||
(concat "digraph " id " {")
|
||||
"bgcolor=\"transparent\";"
|
||||
"rankdir=\"LR\";"
|
||||
"node[width=0.15,height=0.15,shape=point,fontsize=8.0];"
|
||||
"edge[weight=2,arrowhead=none];"
|
||||
(string-join
|
||||
(-map #'git-graph/to-graphviz-node nodes)
|
||||
"\n")
|
||||
(string-join
|
||||
(-uniq (-flatten (-map #'git-graph/to-graphviz-edges nodes)))
|
||||
"\n")
|
||||
"}")
|
||||
"\n"))
|
||||
|
||||
(defun git-graph/to-graphviz-pretty (id nodes)
|
||||
(with-temp-buffer
|
||||
(graphviz-dot-mode)
|
||||
(insert (git-graph/to-graphviz id nodes))
|
||||
(indent-region (point-min) (point-max))
|
||||
(buffer-string)))
|
||||
|
||||
(defun git-graph/to-graphviz-node-id (id)
|
||||
(format "\"%s\"" id))
|
||||
|
||||
(defun git-graph/to-graphviz-node (node)
|
||||
(let ((node-id (git-graph/to-graphviz-node-id (git-graph/node-id node))))
|
||||
(concat node-id
|
||||
(git-graph/to-graphviz-node--attributes node)
|
||||
";")))
|
||||
|
||||
(defun git-graph/to-graphviz-node--attributes (node)
|
||||
(let ((attributes (git-graph/to-graphviz-node--compute-attributes node)))
|
||||
(and attributes
|
||||
(concat "["
|
||||
(mapconcat (lambda (pair)
|
||||
(format "%s=\"%s\""
|
||||
(car pair) (cdr pair)))
|
||||
attributes
|
||||
", ")
|
||||
"]"))))
|
||||
|
||||
(defun git-graph/to-graphviz-node--compute-attributes (node)
|
||||
(-filter #'identity
|
||||
(append (and (git-graph/node-group node)
|
||||
(list (cons 'group (git-graph/node-group node))))
|
||||
(and (git-graph/node-label node)
|
||||
(list (cons 'shape 'box)
|
||||
(cons 'label (git-graph/node-label node)))))))
|
||||
|
||||
(defun git-graph/to-graphviz-edges (node)
|
||||
(let ((node-id (git-graph/node-id node))
|
||||
(parents (git-graph/node-parents node)))
|
||||
(-map (lambda (parent)
|
||||
(git-graph/to-graphviz-edge node-id parent))
|
||||
parents)))
|
||||
|
||||
(defun git-graph/to-graphviz-edge (from to)
|
||||
(concat
|
||||
(git-graph/to-graphviz-node-id to)
|
||||
" -> "
|
||||
(git-graph/to-graphviz-node-id from)
|
||||
";"))
|
||||
|
||||
(defun git-graph/group-topo (nodelist)
|
||||
(reverse
|
||||
(car
|
||||
(-reduce-from
|
||||
(lambda (acc node)
|
||||
(let* ((grouped-nodes (car acc))
|
||||
(group-stack (cdr acc))
|
||||
(node-id (git-graph/node-id node))
|
||||
(group-from-stack (--if-let (assoc node-id group-stack)
|
||||
(cdr it)))
|
||||
(group (or group-from-stack node-id))
|
||||
(parents (git-graph/node-parents node))
|
||||
(first-parent (first parents)))
|
||||
(if group-from-stack
|
||||
(pop group-stack))
|
||||
(if (and first-parent (not (assoc first-parent group-stack)))
|
||||
(push (cons first-parent group) group-stack))
|
||||
(cons (cons (git-graph/make-node node-id
|
||||
parents
|
||||
`((group . ,group)
|
||||
(label . ,(git-graph/node-label node))))
|
||||
grouped-nodes)
|
||||
group-stack)))
|
||||
nil
|
||||
nodelist))))
|
||||
|
||||
(defun git-graph/git-execute (repo-url command &rest args)
|
||||
(with-temp-buffer
|
||||
(shell-command (format "git -C \"%s\" %s"
|
||||
repo-url
|
||||
(string-join (cons command args)
|
||||
" "))
|
||||
t)
|
||||
(buffer-string)))
|
||||
|
||||
(defun git-graph/git-rev-list (repo-url head)
|
||||
(-map (lambda (line) (split-string line))
|
||||
(split-string (git-graph/git-execute
|
||||
repo-url
|
||||
"rev-list" "--topo-order" "--parents" head)
|
||||
"\n" t)))
|
||||
|
||||
(defun git-graph/git-label (repo-url rev)
|
||||
(let ((name (string-trim
|
||||
(git-graph/git-execute repo-url
|
||||
"name-rev" "--name-only" rev))))
|
||||
(unless (s-contains? "~" name)
|
||||
name)))
|
||||
|
||||
(defun git-graph/git-graph-head (repo-url head)
|
||||
(git-graph/group-topo
|
||||
(-map (lambda (rev-with-parents)
|
||||
(let* ((rev (car rev-with-parents))
|
||||
(parents (cdr rev-with-parents))
|
||||
(label (git-graph/git-label repo-url rev)))
|
||||
(git-graph/make-node rev parents
|
||||
`((label . ,label)))))
|
||||
(git-graph/git-rev-list repo-url head))))
|
||||
|
||||
(defun git-graph/git-load (repo-url heads)
|
||||
(-reduce #'git-graph/+
|
||||
(-map (lambda (head)
|
||||
(git-graph/git-graph-head repo-url head))
|
||||
heads)))
|
||||
|
||||
(provide 'git-graph)
|
||||
;;; git-graph.el ends here
|
||||
Loading…
Reference in a new issue