;; Author: Steve Youngs <steve@sxemacs.org>
;; Maintainer: Steve Youngs <steve@sxemacs.org>
;; Created: <2015-07-05>
-;; Time-stamp: <Sunday Oct 22, 2017 16:12:19 steve>
+;; Time-stamp: <Friday Oct 27, 2017 11:41:15 steve>
;; Homepage: http://git.sxemacs.org/slh
;; Keywords: git, tools, convenience
(require 'ediff)
(require 'diff-mode)
+;;; Eyecandy
+(eval-and-compile
+ (condition-case nil
+ (require 'working)
+ (error
+ (progn
+ (defmacro working-status-forms (message donestr &rest forms)
+ "Contain a block of code during which a working status is shown."
+ (list 'let (list (list 'msg message) (list 'dstr donestr)
+ '(ref1 0))
+ (cons 'progn forms)))
+
+ (defun working-status (&optional percent &rest args)
+ "Called within the macro `working-status-forms', show the status."
+ (message "%s%s" (apply 'format msg args)
+ (if (eq percent t) (concat "... " dstr)
+ (format "... %3d%%"
+ (or percent
+ (floor (* 100.0 (/ (float (point))
+ (point-max)))))))))
+ (put 'working-status-forms 'lisp-indent-function 2)))))
+
+(defvar sy-git-log-font-lock-keywords
+ '(;;
+ ;; Headers
+ ("^commit .*$"
+ (0 font-lock-warning-face))
+ (#r"^\(Author\(Date\)?:\|Commit\(Date\)?:\|Date:\|Merge:\)"
+ (1 gnus-header-content))
+ ;; date
+ (#r"Date:\(.*$\)"
+ (1 change-log-date-face))
+ ;; name/email
+ (#r":\s-+\(.*\)\s-+<\(.*\)>"
+ (1 change-log-name-face)
+ (2 change-log-email-face))
+ ;; file name
+ (#r"^\s-+\* \([^ ,:(]+\)"
+ (1 change-log-file-face))
+ ;; Function or variable names.
+ ("(\\([^) ,:\n]+\\)"
+ (1 change-log-list-face)
+ ("\\=, *\\([^) ,:\n]+\\)" nil nil
+ (1 change-log-list-face)))
+ ;; Signed-off
+ (#r"\(Signed-off\|Reviewed\|Reported\|Acked\)-by:\|Cc:"
+ (0 gnus-header-content))))
+
;;; Globals
(defvar sy-gitbin (executable-find "git")
"The git binary.")
(setq args (and (push subcmd args)
(append gitopts args)))
(apply #'call-process git nil buffer nil args)))
+(put 'sy-git-run-buffer 'lisp-indent-function 1)
(defun sy-git-run-string (subcmd &rest args)
"Return a string from output of git SUBCMD ARGS."
(setq cmdline (mapconcat #'identity cmdline " "))
;; run it
(shell-command-to-string cmdline)))
+(put 'sy-git-run-string 'lisp-indent-function 1)
(defun sy-git-check-hook (hook)
"Return non-nil when HOOK script exists and is usable.
(defun sy-git-diff ()
"Show a diff of the current file against HEAD."
(interactive)
- (vc-diff nil))
+ (progn
+ (vc-diff nil)
+ (local-set-key [(control x) G a] #'sy-git-add-log-entry)))
(defun sy-git-ediff ()
"Run ediff-buffers on the working file and the HEAD version."
(ediff-buffers bufferA bufferB))))
;;; blame
+(defun sy-git-blame-log (&optional extent)
+ "*Display the log of the git commit who's sha is stored in EXTENT.
+
+This command should only ever be called from within a Git Blame
+buffer."
+ (interactive)
+ (unless (string-match "GIT Blame" (buffer-name))
+ (error 'invalid-operation this-command
+ "Can only be called from the Blame buffer"))
+ (let* ((extent (or extent
+ (extent-at (point) nil 'blame)))
+ (revstr (extent-property extent 'brev))
+ (showbuf (format "*GIT Show::%s*" revstr))
+ (gitcmd "show")
+ (args (split-string (format "--name-only %s" revstr)))
+ (cb (current-buffer)))
+ (window-configuration-to-register ?l)
+ (with-current-buffer (get-buffer-create showbuf)
+ (erase-buffer)
+ (set (make-local-variable 'font-lock-defaults)
+ '(sy-git-log-font-lock-keywords t t))
+ (sy-git-run-buffer showbuf gitcmd args)
+ (goto-char (point-min))
+ (view-mode cb #'(lambda (showbuf)
+ (kill-buffer showbuf)
+ (jump-to-register ?l)
+ (clear-register ?l))))
+ (pop-to-buffer showbuf)
+ (shrink-window-if-larger-than-buffer)))
+
+(defun sy-git-blame-log-mouse (e)
+ (interactive "e")
+ (let ((extent (extent-at-event e 'blame)))
+ (sy-git-blame-log extent)))
+
+(defun sy-git-blame-show (&optional extent)
+ "*Display git commit who's sha is stored in EXTENT.
+
+This command should only ever be called from within a Git Blame
+buffer."
+ (interactive)
+ (unless (string-match "GIT Blame" (buffer-name))
+ (error 'invalid-operation this-command
+ "Can only be called from the Blame buffer"))
+ (let* ((extent (or extent
+ (extent-at (point) nil 'blame)))
+ (revstr (extent-property extent 'brev))
+ (showbuf (format "*GIT Show::%s*" revstr))
+ (gitcmd "show")
+ (cb (current-buffer)))
+ (window-configuration-to-register ?s)
+ (with-current-buffer (get-buffer-create showbuf)
+ (erase-buffer)
+ (sy-git-run-buffer showbuf gitcmd revstr)
+ (goto-char (point-min))
+ (view-mode cb #'(lambda (showbuf)
+ (kill-buffer showbuf)
+ (jump-to-register ?s)
+ (clear-register ?s))))
+ (pop-to-buffer showbuf)
+ (shrink-window-if-larger-than-buffer)))
+
+(defun sy-git-blame-show-mouse (e)
+ (interactive "e")
+ (let ((extent (extent-at-event e 'blame)))
+ (sy-git-blame-show extent)))
+
+(defvar sy-git-blame-map
+ (let ((map (make-sparse-keymap 'sy-git-blame-map)))
+ (define-key map [s] #'sy-git-blame-show)
+ (define-key map [l] #'sy-git-blame-log)
+ (define-key map [button1] #'sy-git-blame-show-mouse)
+ (define-key map [button2] #'sy-git-blame-log-mouse)
+ map)
+ "Keymap for blame extents.")
+
+(defun sy-git-process-blame-buffer ()
+ "Processes the content of the blame BUFFER.
+Adds margin, extents, keymaps, etc."
+ (let ((regex #r"\(^[a-f0-9]+\)\s-+[0-9]+) ")
+ (hash (make-hash-table :size 1024 :test #'equal)))
+ (set-specifier left-margin-width 9 (current-buffer))
+ (goto-char (point-min))
+ (save-excursion
+ (working-status-forms "Blaming %s" "done"
+ (while (re-search-forward regex nil t)
+ (working-status nil (substring (buffer-name) 12 -1))
+ (let ((blamerev (match-string 1))
+ (buf (get-buffer-create "*sy-git-extents*"))
+ bhelp khelp ext)
+ (delete-region (match-beginning 0) (match-end 0))
+ ;; skip uncommitted and blank lines
+ (unless (or (string= blamerev "00000000")
+ (zerop (length
+ (buffer-substring
+ (point-at-bol) (point-at-eol)))))
+ (if (not (gethash blamerev hash))
+ ;; A new rev, set up extent
+ (progn
+ (puthash blamerev (point) hash)
+ (with-current-buffer buf
+ (erase-buffer)
+ (insert
+ (sy-git-run-string "show"
+ (split-string
+ (concat "--format=\"[Keys:s,l,b1,b2] [%h] %an "
+ "%ai%ncommit: %H%nAuthor: %an <%ae>%n"
+ "Date: %>(33)%ad%n%n %s\" --summary "
+ blamerev " |head -n8"))))
+ (goto-char (point-min))
+ (setq khelp (buffer-substring
+ (point-at-bol) (point-at-eol)))
+ (delete-region (point-at-bol) (point-at-eol))
+ (setq bhelp (buffer-string)))
+ (kill-buffer buf)
+ (setq ext (make-extent
+ (point-at-bol) (point-at-eol)))
+ (set-extent-properties
+ ext
+ `(mouse-face highlight keymap ,sy-git-blame-map
+ help-echo ,khelp balloon-help ,bhelp
+ blame t brev ,blamerev))
+ (set-extent-begin-glyph
+ ext
+ (make-glyph blamerev) 'outside-margin))
+ ;; A previous rev, just set extent parent
+ (setq ext (make-extent (point-at-bol) (point-at-eol)))
+ (set-extent-parent
+ ext (extent-at
+ (gethash blamerev hash) nil 'blame))))))
+ (working-status t (substring (buffer-name) 12 -1))))))
+
(defun sy-git-blame ()
- "Display git blame for the current file.
+ "*Display git blame for the current file.
If the region is active the output will be for just the lines of the
file within the region."
(gb (format "*GIT Blame::%s*"
(file-basename (buffer-file-name))))
(args (list (file-basename (buffer-file-name))))
+ (cmm major-mode)
beg end)
(when (region-active-p)
(setq beg (line-number (region-beginning))
end (line-number (region-end))))
(and beg end
(push (format "-L%d,%d" beg end) args))
+ ;; We want -s for nicer, less verbose output and --root for
+ ;; boundary commits
+ (setq args (append '("-s" "--root") args))
(sy-git-run-buffer gb gitcmd args)
- (push-window-configuration)
+ (window-configuration-to-register ?G)
(with-current-buffer gb
(setq truncate-lines t)
- (goto-char (point-min))
+ (funcall cmm)
+ (sy-git-process-blame-buffer)
(view-mode cb #'(lambda (gb)
- (kill-buffer gb)
- (pop-window-configuration))))
+ (kill-buffer gb)
+ (jump-to-register ?G)
+ (clear-register ?G))))
(pop-to-buffer gb)
(shrink-window-if-larger-than-buffer)))
;;; log
-(defvar sy-git-log-font-lock-keywords
- '(;;
- ;; Headers
- ("^commit .*$"
- (0 font-lock-warning-face))
- (#r"^\(Author\(Date\)?:\|Commit\(Date\)?:\|Date:\|Merge:\)"
- (1 gnus-header-content))
- ;; date
- (#r"Date:\(.*$\)"
- (1 change-log-date-face))
- ;; name/email
- (#r":\s-+\(.*\)\s-+<\(.*\)>"
- (1 change-log-name-face)
- (2 change-log-email-face))
- ;; file name
- (#r"^\s-+\* \([^ ,:(]+\)"
- (1 change-log-file-face))
- ;; Function or variable names.
- ("(\\([^) ,:\n]+\\)"
- (1 change-log-list-face)
- ("\\=, *\\([^) ,:\n]+\\)" nil nil
- (1 change-log-list-face)))
- ;; Signed-off
- (#r"\(Signed-off\|Reviewed\|Reported\|Acked\)-by:\|Cc:"
- (0 gnus-header-content))))
-
(defun sy-git-log (opts)
- "Display git log of current file.
+ "*Display git log of current file.
With one prefix arg, OPTS, display the log for the entire repo.
With two prefix args, prompt for options to pass to git-log.
gb (format gb (file-basename
(buffer-file-name))))))
(sy-git-run-buffer gb gitcmd args)
- (push-window-configuration)
+ (window-configuration-to-register ?L)
(with-current-buffer gb
(set (make-local-variable 'font-lock-defaults)
'(sy-git-log-font-lock-keywords t t))
(goto-char (point-min))
(view-mode cb #'(lambda (gb)
(kill-buffer gb)
- (pop-window-configuration))))
+ (jump-to-register ?L)
+ (clear-register ?L))))
(pop-to-buffer gb)
(shrink-window-if-larger-than-buffer)))
"
(interactive "p")
- (let* ((topd (substring (sy-git-run-string
- "rev-parse" "--show-toplevel") 0 -1))
+ (let* ((topd (substring (sy-git-run-string "rev-parse"
+ "--show-toplevel") 0 -1))
(logfile (expand-file-name "++log" topd))
(hookd (paths-construct-path `(,topd ".git" "hooks")))
(msg-hook (expand-file-name "commit-msg" hookd))
(commit-hook (expand-file-name "post-commit" hookd))
- (add-log-full-name (substring (sy-git-run-string
- "config" "user.name") 0 -1))
- (add-log-mailing-address (substring (sy-git-run-string
- "config" "user.email") 0 -1))
+ (add-log-full-name (substring (sy-git-run-string "config"
+ "user.name") 0 -1))
+ (add-log-mailing-address (substring (sy-git-run-string "config"
+ "user.email") 0 -1))
(add-log-keep-changes-together t)
(header (concat
(format-time-string "%Y-%m-%d")
projects / slh / blobdiff