X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=sy-git.el;h=68f52f2274ee8652dd5a60089370bbf2728f8b95;hb=3143a32960dc58c2d4c5e77805abe83eb4ea980f;hp=b0b9a6afb5f67f69f7089406e25359c64ba967e9;hpb=e72fddf68dff0456809d196e0324a8791ea91fa3;p=slh diff --git a/sy-git.el b/sy-git.el index b0b9a6a..68f52f2 100644 --- a/sy-git.el +++ b/sy-git.el @@ -5,7 +5,7 @@ ;; Author: Steve Youngs ;; Maintainer: Steve Youngs ;; Created: <2015-07-05> -;; Time-stamp: +;; Time-stamp: ;; Homepage: http://git.sxemacs.org/slh ;; Keywords: git, tools, convenience @@ -66,6 +66,54 @@ (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.") @@ -95,6 +143,7 @@ them.") (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." @@ -112,6 +161,7 @@ them.") (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. @@ -135,7 +185,9 @@ By \"usable\" we mean for `sy-git-add-log-entry'." (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." @@ -147,8 +199,140 @@ By \"usable\" we mean for `sy-git-add-log-entry'." (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." @@ -158,52 +342,32 @@ 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. @@ -229,14 +393,15 @@ supplies." 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))) @@ -281,16 +446,16 @@ Example post-commit: " (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")