cgit.sxemacs.org Git - slh/blob - sy-git.el

   1 ;; sy-git.el --- A couple of nice git tools   -*- Emacs-Lisp -*-
   2
   3 ;; Copyright (C) 2015 - 2017 Steve Youngs
   4
   5 ;; Author:     Steve Youngs <steve@sxemacs.org>
   6 ;; Maintainer: Steve Youngs <steve@sxemacs.org>
   7 ;; Created:    <2015-07-05>
   8 ;; Time-stamp: <Friday Oct 20, 2017 12:14:13 steve>
   9 ;; Homepage:   http://git.sxemacs.org/slh
  10 ;; Keywords:   git, tools, convenience
  11
  12 ;; This file is part of SLH (Steve's Lisp Hacks).
  13
  14 ;; Redistribution and use in source and binary forms, with or without
  15 ;; modification, are permitted provided that the following conditions
  16 ;; are met:
  17 ;;
  18 ;; 1. Redistributions of source code must retain the above copyright
  19 ;;    notice, this list of conditions and the following disclaimer.
  20 ;;
  21 ;; 2. Redistributions in binary form must reproduce the above copyright
  22 ;;    notice, this list of conditions and the following disclaimer in the
  23 ;;    documentation and/or other materials provided with the distribution.
  24 ;;
  25 ;; 3. Neither the name of the author nor the names of any contributors
  26 ;;    may be used to endorse or promote products derived from this
  27 ;;    software without specific prior written permission.
  28 ;;
  29 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  30 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  31 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  32 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  33 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  34 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  35 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  36 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  37 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  38 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  39 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  40
  41 ;;; Commentary:
  42 ;;
  43 ;;   This is the beginnings of some convenience tools to use with git
  44 ;;   from within SXEmacs.
  45 ;;
  46 ;;   Presently, all that is here is a 'add-log' function that
  47 ;;   lets you write commit logs in a similar format to that of
  48 ;;   `add-change-log-entry'.  It is globally bound to `C-x G a'.
  49 ;;   See: `sy-git-add-log-entry'.
  50 ;;
  51 ;;   [2017-10-16 08:59]: Added rudimentary support for git-diff,
  52 ;;   git-blame, and git-log.  For examining changes you can use
  53 ;;   either plain `diff-mode' with `sy-git-diff', or Ediff with
  54 ;;   `sy-git-ediff'.
  55
  56 ;;; Todo:
  57 ;;
  58 ;;     o Implement a variation of `patch-to-change-log'.
  59 ;;        [2017-10-15 15:09]: Turns out that this isn't really needed
  60 ;;        as you can invoke `sy-git-add-log-entry' directly from a diff.
  61
  62 ;;; Code:
  63 ;; Need VC, ediff, and diff-mode
  64 (vc-load-vc-hooks)
  65 (add-to-list 'vc-handled-backends 'GIT)
  66 (require 'ediff)
  67 (require 'diff-mode)
  68
  69
  70 (defun sy-git-check-hook (hook)
  71   "Return non-nil when HOOK script exists and is usable.
  72
  73 By \"usable\" we mean for `sy-git-add-log-entry'."
  74   (let ((hookname (file-basename hook)))
  75     (when (file-exists-p hook)
  76       (with-temp-buffer
  77         (insert-file-contents-literally hook)
  78         (goto-char (point-min))
  79         (cond
  80          ((equal hookname "commit-msg")
  81           (re-search-forward (regexp-quote "sed -i '/^#/d'") nil t))
  82          ((equal hookname "post-commit")
  83           (re-search-forward (regexp-quote "rm -f ${LOG}") nil t))
  84          (t nil))))))
  85
  86 ;;; diff
  87 ;; FIXME: might be nice to be able to diff against other revisions
  88 ;; aside from HEAD.
  89 (defun sy-git-diff ()
  90   "Show a diff of the current file against HEAD."
  91   (interactive)
  92   (vc-diff nil))
  93
  94 (defun sy-git-ediff ()
  95   "Run ediff-buffers on the working file and the HEAD version."
  96   (interactive)
  97   (let* ((bufferA (file-basename (buffer-file-name)))
  98          (bufferB (concat bufferA ".~HEAD~")))
  99     (progn
 100       (vc-version-other-window "HEAD")
 101       (ediff-buffers bufferA bufferB))))
 102
 103 ;;; blame
 104 (defun sy-git-blame ()
 105   "Display git blame for the current file.
 106
 107 If the region is active the output will be for just the lines of the
 108 file within the region."
 109   (interactive)
 110   (let ((gitcmd "git blame ")
 111         (cb (current-buffer))
 112         (gb (format "*GIT Blame::%s*"
 113                     (file-basename (buffer-file-name))))
 114         beg end)
 115     (when (region-active-p)
 116       (setq beg (line-number (region-beginning))
 117             end (line-number (region-end))))
 118     (and beg end
 119          (setq gitcmd (concat gitcmd (format "-L%d,%d " beg end))))
 120     (setq gitcmd (concat gitcmd (file-basename (buffer-file-name))))
 121     (push-window-configuration)
 122     (with-current-buffer (get-buffer-create gb)
 123       (erase-buffer)
 124       (setq truncate-lines t)
 125       (insert (shell-command-to-string gitcmd))
 126       (goto-char (point-min))
 127       (view-mode cb #'(lambda (gb)
 128                       (kill-buffer gb)
 129                       (pop-window-configuration))))
 130     (pop-to-buffer gb)
 131     (shrink-window-if-larger-than-buffer)))
 132
 133 ;;; log
 134 (defvar sy-git-log-font-lock-keywords
 135   '(;;
 136     ;; Headers
 137     ("^commit .*$"
 138      (0 font-lock-warning-face))
 139     (#r"^\(Author\(Date\)?:\|Commit\(Date\)?:\|Date:\|Merge:\)"
 140        (1 gnus-header-content))
 141     ;; date
 142     (#r"Date:\(.*$\)"
 143        (1 change-log-date-face))
 144     ;; name/email
 145     (#r":\s-+\(.*\)\s-+<\(.*\)>"
 146        (1 change-log-name-face)
 147        (2 change-log-email-face))
 148     ;; file name
 149     (#r"^\s-+\* \([^ ,:(]+\)"
 150        (1 change-log-file-face))
 151     ;; Function or variable names.
 152     ("(\\([^) ,:\n]+\\)"
 153      (1 change-log-list-face)
 154      ("\\=, *\\([^) ,:\n]+\\)" nil nil
 155       (1 change-log-list-face)))
 156     ;; Signed-off
 157     (#r"\(Signed-off\|Reviewed\|Reported\|Acked\)-by:\|Cc:"
 158        (0 gnus-header-content))))
 159
 160 (defun sy-git-log (opts)
 161   "Display git log of current file.
 162
 163 With one prefix arg, OPTS, display the log for the entire repo.
 164 With two prefix args, prompt for options to pass to git-log.
 165
 166 The default options used are: `--shortstat', except when two prefix
 167 args are used and then the only options used are those the user
 168 supplies."
 169   (interactive "P")
 170   (let ((cb (current-buffer))
 171         (gb "*GIT Log::%s*")
 172         (gitcmd "git log"))
 173     (case (car opts)
 174       ;; 1 prefix arg, log for whole repo
 175       (4 (setq gitcmd (concat gitcmd " --shortstat")
 176                gb (format gb "Whole Repo")))
 177       ;; 2 prefix args, prompt for options
 178       (16 (setq gitcmd (concat gitcmd " "
 179                                (read-string "Git Log options: "))
 180                 gb (format gb "Custom")))
 181       ;; default, show log of current file
 182       (otherwise (setq gitcmd (concat gitcmd
 183                                       " --shortstat "
 184                                       (file-basename (buffer-file-name)))
 185                        gb (format gb (file-basename (buffer-file-name))))))
 186     (push-window-configuration)
 187     (with-current-buffer (get-buffer-create gb)
 188       (erase-buffer)
 189       (set (make-local-variable 'font-lock-defaults)
 190            '(sy-git-log-font-lock-keywords t t))
 191       (insert (shell-command-to-string gitcmd))
 192       (goto-char (point-min))
 193       (view-mode cb #'(lambda (gb)
 194                        (kill-buffer gb)
 195                        (pop-window-configuration))))
 196     (pop-to-buffer gb)
 197     (shrink-window-if-larger-than-buffer)))
 198
 199 ;;; add-log
 200 (defun sy-git-add-log-entry (&optional newlog)
 201   "*A wrapper for `add-change-log-entry'.
 202
 203 Optional prefix argument, NEWLOG, forces a new log file to be
 204 created. Use this if you need to start over.
 205
 206 To commit your changes with the log that this function creates use:
 207
 208   git commit -F ++log
 209
 210 This function allows you to create git commit logs in a similar format
 211 to that used by `add-change-log-entry'.  Some commented instructions
 212 are added to the top of the log which you should either delete yourself
 213 prior to committing, or have a hook do it automatically \(preferred\).
 214
 215 Hooks:
 216 2 hooks will make using this function a lot simpler and automatic.
 217 A 'commit-msg' hook, and a 'post-commit' hook.  They reside in
 218 '$repo/.git/hooks/'.
 219
 220 Example commit-msg:
 221
 222   #!/bin/sh
 223   # Delete lines beginning with '#'.
 224   sed -i '/^#/d' \"$1\" || {
 225       echo >&2 Commit aborted by commit-msg hook
 226       exit 1
 227   }
 228   # End commit-msg
 229
 230 Example post-commit:
 231
 232   #!/bin/sh
 233   # Delete log file after successful commit.
 234   LOG=$(git rev-parse --show-toplevel)/++log
 235   [ -f ${LOG} ] && rm -f ${LOG}
 236   # End post-commit
 237
 238 "
 239   (interactive "p")
 240   (let* ((topd (substring (shell-command-to-string
 241                            "git rev-parse --show-toplevel") 0 -1))
 242          (logfile (expand-file-name "++log" topd))
 243          (hookd (paths-construct-path `(,topd ".git" "hooks")))
 244          (msg-hook (expand-file-name "commit-msg" hookd))
 245          (commit-hook (expand-file-name "post-commit" hookd))
 246          (add-log-full-name (substring (shell-command-to-string
 247                                         "git config user.name") 0 -1))
 248          (add-log-mailing-address (substring (shell-command-to-string
 249                                               "git config user.email") 0 -1))
 250          (add-log-keep-changes-together t)
 251          (header (concat
 252                   (format-time-string "%Y-%m-%d")
 253                   "  "
 254                   add-log-full-name "  <"
 255                   add-log-mailing-address ">\n"))
 256          (newhead
 257           (concat
 258            "# Copyright -- to fool `add-change-log-entry'
 259 ### Instructions:
 260 #
 261 # Put your short one-line summary on the first blank line after these.
 262 # Make sure that there is a blank line between your summary and the rest
 263 # of your changes log.
 264 #
 265 ###"
 266            (if (sy-git-check-hook msg-hook)
 267                "\n# Lines beginning with '#' will be automatically deleted."
 268              "\n# You MUST delete these lines before committing.")
 269            (unless (sy-git-check-hook commit-hook)
 270              "\n# No post-commit hook. Manually delete this log after you commit.")
 271            "\n###"))
 272          )
 273     (and current-prefix-arg             ; User wants to start over
 274          (file-exists-p logfile)
 275          (ignore-errors
 276            (delete-file logfile)))
 277     ;; It is possible that the logfile is gone but the buffer is still
 278     ;; active
 279     (and (not (file-exists-p logfile))
 280          (buffer-live-p (find-buffer-visiting logfile))
 281          (kill-buffer (find-buffer-visiting logfile)))
 282     (with-current-buffer (find-file-noselect logfile)
 283       (save-excursion
 284         (goto-char (point-min))
 285         (when (re-search-forward "^# Copyright" (point-at-eol) t)
 286           (replace-match "Copyright"))))
 287     (add-change-log-entry nil logfile t nil)
 288     (save-excursion
 289       (goto-char (point-min))
 290       (delete-matching-lines (regexp-quote header))
 291       (when (re-search-forward "^Copyright" (point-at-eol) t)
 292         (replace-match "# Copyright"))
 293       (goto-char (point-min))
 294       (unless (search-forward newhead nil t)
 295         (insert newhead "\n\n\n")))))
 296
 297 ;;; keymap/mode/hook stuffs
 298 (defvar sy-git-mode-map
 299   (let ((map (make-sparse-keymap)))
 300     (set-keymap-name map 'sy-git-mode-map)
 301     (define-key map [(control ?x) ?G ?a] #'sy-git-add-log-entry)
 302     (define-key map [(control ?x) ?G ?=] #'sy-git-diff)
 303     (define-key map [(control ?x) ?G ?d] #'sy-git-diff)
 304     (define-key map [(control ?x) ?G ?e] #'sy-git-ediff)
 305     (define-key map [(control ?x) ?G ?l] #'sy-git-log)
 306     (define-key map [(control ?x) ?G ?b] #'sy-git-blame)
 307     map)
 308   "Keys for use in sy-git-mode.")
 309
 310 (define-minor-mode sy-git-mode
 311   "A minor mode to pretty much do nothing but hold keymap.
 312 \\{sy-git-mode-map}."
 313   :lighter " SY/Git"
 314   :keymap 'sy-git-mode-map)
 315
 316 (defun sy-git-activate-maybe ()
 317   "Maybe turn on `sy-git-mode'."
 318   (and (eq (vc-file-getprop (buffer-file-name) 'vc-backend) 'GIT)
 319        (sy-git-mode)))
 320
 321 (add-hook 'find-file-hooks #'sy-git-activate-maybe 'append)
 322
 323 (provide 'sy-git)
 324 ;;; sy-git.el ends here