;; - hook into file save (after-save-hook)
;; - diff against other branch
;; - renaming files from the status buffer
-;; - support for appending signed-off-by
;; - creating tags
;; - fetch/pull
;; - switching branches
;; - revlist browser
;; - git-show-branch browser
-;; - customize support
;; - menus
;;
(require 'ewoc)
-;;;; Faces
+;;;; Customizations
;;;; ------------------------------------------------------------
+(defgroup git nil
+ "Git user interface")
+
+(defcustom git-committer-name nil
+ "User name to use for commits.
+The default is to fall back to the repository config, then to `add-log-full-name' and then to `user-full-name'."
+ :group 'git
+ :type '(choice (const :tag "Default" nil)
+ (string :tag "Name")))
+
+(defcustom git-committer-email nil
+ "Email address to use for commits.
+The default is to fall back to the git repository config, then to `add-log-mailing-address' and then to `user-mail-address'."
+ :group 'git
+ :type '(choice (const :tag "Default" nil)
+ (string :tag "Email")))
+
+(defcustom git-commits-coding-system 'utf-8
+ "Default coding system for the log message of git commits."
+ :group 'git
+ :type 'coding-system)
+
+(defcustom git-append-signed-off-by nil
+ "Whether to append a Signed-off-by line to the commit message before editing."
+ :group 'git
+ :type 'boolean)
+
+(defcustom git-per-dir-ignore-file ".gitignore"
+ "Name of the per-directory ignore file."
+ :group 'git
+ :type 'string)
+
(defface git-status-face
'((((class color) (background light)) (:foreground "purple")))
- "Git mode face used to highlight added and modified files.")
+ "Git mode face used to highlight added and modified files."
+ :group 'git)
(defface git-unmerged-face
'((((class color) (background light)) (:foreground "red" :bold t)))
- "Git mode face used to highlight unmerged files.")
+ "Git mode face used to highlight unmerged files."
+ :group 'git)
(defface git-unknown-face
'((((class color) (background light)) (:foreground "goldenrod" :bold t)))
- "Git mode face used to highlight unknown files.")
+ "Git mode face used to highlight unknown files."
+ :group 'git)
(defface git-uptodate-face
'((((class color) (background light)) (:foreground "grey60")))
- "Git mode face used to highlight up-to-date files.")
+ "Git mode face used to highlight up-to-date files."
+ :group 'git)
(defface git-ignored-face
'((((class color) (background light)) (:foreground "grey60")))
- "Git mode face used to highlight ignored files.")
+ "Git mode face used to highlight ignored files."
+ :group 'git)
(defface git-mark-face
'((((class color) (background light)) (:foreground "red" :bold t)))
- "Git mode face used for the file marks.")
+ "Git mode face used for the file marks."
+ :group 'git)
(defface git-header-face
'((((class color) (background light)) (:foreground "blue")))
- "Git mode face used for commit headers.")
+ "Git mode face used for commit headers."
+ :group 'git)
(defface git-separator-face
'((((class color) (background light)) (:foreground "brown")))
- "Git mode face used for commit separator.")
+ "Git mode face used for commit separator."
+ :group 'git)
(defface git-permission-face
'((((class color) (background light)) (:foreground "green" :bold t)))
- "Git mode face used for permission changes.")
-
-(defvar git-committer-name nil
- "*User name to use for commits.
-If not set, fall back to `add-log-full-name' and then `user-full-name'.")
-
-(defvar git-committer-email nil
- "*Email address to use for commits.
-If not set, fall back to `add-log-mailing-address' and then `user-mail-address'.")
-
-(defvar git-commits-coding-system 'utf-8
- "Default coding system for git commits.")
-
-(defconst git-log-msg-separator "--- log message follows this line ---")
-
-(defconst git-per-dir-ignore-file ".gitignore"
- "Name of the per-directory ignore file.")
+ "Git mode face used for permission changes."
+ :group 'git)
;;;; Utilities
;;;; ------------------------------------------------------------
+(defconst git-log-msg-separator "--- log message follows this line ---")
+
(defun git-get-env-strings (env)
"Build a list of NAME=VALUE strings from a list of environment strings."
(mapcar (lambda (entry) (concat (car entry) "=" (cdr entry))) env))
(append (git-get-env-strings env) (list "git") args))
(apply #'call-process "git" nil buffer nil args)))
+(defun git-call-process-env-string (env &rest args)
+ "Wrapper for call-process that sets environment strings, and returns the process output as a string."
+ (with-temp-buffer
+ (and (eq 0 (apply #' git-call-process-env t env args))
+ (buffer-string))))
+
(defun git-run-process-region (buffer start end program args)
"Run a git process with a buffer region as input."
(let ((output-buffer (current-buffer))
(defun git-get-string-sha1 (string)
"Read a SHA1 from the specified string."
- (let ((pos (string-match "[0-9a-f]\\{40\\}" string)))
- (and pos (substring string pos (match-end 0)))))
+ (and string
+ (string-match "[0-9a-f]\\{40\\}" string)
+ (match-string 0 string)))
(defun git-get-committer-name ()
"Return the name to use as GIT_COMMITTER_NAME."
; copied from log-edit
(or git-committer-name
+ (git-repo-config "user.name")
(and (boundp 'add-log-full-name) add-log-full-name)
(and (fboundp 'user-full-name) (user-full-name))
(and (boundp 'user-full-name) user-full-name)))
"Return the email address to use as GIT_COMMITTER_EMAIL."
; copied from log-edit
(or git-committer-email
+ (git-repo-config "user.email")
(and (boundp 'add-log-mailing-address) add-log-mailing-address)
(and (fboundp 'user-mail-address) (user-mail-address))
(and (boundp 'user-mail-address) user-mail-address)))
"Add a file name to the ignore file in its directory."
(let* ((fullname (expand-file-name file))
(dir (file-name-directory fullname))
- (name (file-name-nondirectory fullname)))
+ (name (file-name-nondirectory fullname))
+ (ignore-name (expand-file-name git-per-dir-ignore-file dir))
+ (created (not (file-exists-p ignore-name))))
(save-window-excursion
- (set-buffer (find-file-noselect (expand-file-name git-per-dir-ignore-file dir)))
+ (set-buffer (find-file-noselect ignore-name))
(goto-char (point-max))
(unless (zerop (current-column)) (insert "\n"))
(insert name "\n")
(sort-lines nil (point-min) (point-max))
- (save-buffer))))
+ (save-buffer))
+ (when created
+ (git-run-command nil nil "update-index" "--info-only" "--add" "--" (file-relative-name ignore-name)))
+ (git-add-status-file (if created 'added 'modified) (file-relative-name ignore-name))))
;;;; Wrappers for basic git commands
(defun git-rev-parse (rev)
"Parse a revision name and return its SHA1."
(git-get-string-sha1
- (with-output-to-string
- (with-current-buffer standard-output
- (git-call-process-env t nil "rev-parse" rev)))))
+ (git-call-process-env-string nil "rev-parse" rev)))
+
+(defun git-repo-config (key)
+ "Retrieve the value associated to KEY in the git repository config file."
+ (let ((str (git-call-process-env-string nil "repo-config" key)))
+ (and str (car (split-string str "\n")))))
(defun git-symbolic-ref (ref)
"Wrapper for the git-symbolic-ref command."
- (car
- (split-string
- (with-output-to-string
- (with-current-buffer standard-output
- (git-call-process-env t nil "symbolic-ref" ref)))
- "\n")))
+ (let ((str (git-call-process-env-string nil "symbolic-ref" ref)))
+ (and str (car (split-string str "\n")))))
(defun git-update-ref (ref val &optional oldval)
"Update a reference by calling git-update-ref."
(defun git-write-tree (&optional index-file)
"Call git-write-tree and return the resulting tree SHA1 as a string."
(git-get-string-sha1
- (with-output-to-string
- (with-current-buffer standard-output
- (git-call-process-env t
- (if index-file `(("GIT_INDEX_FILE" . ,index-file)) nil)
- "write-tree")))))
+ (git-call-process-env-string (and index-file `(("GIT_INDEX_FILE" . ,index-file))) "write-tree")))
(defun git-commit-tree (buffer tree head)
"Call git-commit-tree with buffer as input and return the resulting commit SHA1."
(with-current-buffer buffer
(goto-char (point-min))
(if
- (setq log-start (re-search-forward (concat "^" git-log-msg-separator "\n") nil t))
+ (setq log-start (re-search-forward (concat "^" (regexp-quote git-log-msg-separator) "\n") nil t))
(save-restriction
(narrow-to-region (point-min) log-start)
(goto-char (point-min))
(propertize
(if (or (not old-perm)
(not new-perm)
- (eq 0 (logand #O111 (logxor old-perm new-perm))))
+ (eq 0 (logand ?\111 (logxor old-perm new-perm))))
" "
- (if (eq 0 (logand #O111 old-perm)) "+x" "-x"))
+ (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
'face 'git-permission-face))
(defun git-fileinfo-prettyprint (info)
(git-setup-diff-buffer
(apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M" "HEAD" "--" (git-get-filenames files)))))
+(defun git-diff-file-merge-head (arg)
+ "Diff the marked file(s) against the first merge head (or the nth one with a numeric prefix)."
+ (interactive "p")
+ (let ((files (git-marked-files))
+ (merge-heads (git-get-merge-heads)))
+ (unless merge-heads (error "No merge in progress"))
+ (git-setup-diff-buffer
+ (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M"
+ (or (nth (1- arg) merge-heads) "HEAD") "--" (git-get-filenames files)))))
+
(defun git-diff-unmerged-file (stage)
"Diff the marked unmerged file(s) against the specified stage."
(let ((files (git-marked-files)))
(unless git-status (error "Not in git-status buffer."))
(let ((buffer (get-buffer-create "*git-commit*"))
(merge-heads (git-get-merge-heads))
- (dir default-directory))
+ (dir default-directory)
+ (sign-off git-append-signed-off-by))
(with-current-buffer buffer
(when (eq 0 (buffer-size))
(cd dir)
'face 'git-header-face)
(propertize git-log-msg-separator 'face 'git-separator-face)
"\n")
- (when (and merge-heads (file-readable-p ".git/MERGE_MSG"))
- (insert-file-contents ".git/MERGE_MSG"))))
- (log-edit #'git-do-commit nil #'git-log-edit-files buffer)))
+ (cond ((and merge-heads (file-readable-p ".git/MERGE_MSG"))
+ (insert-file-contents ".git/MERGE_MSG"))
+ (sign-off
+ (insert (format "\n\nSigned-off-by: %s <%s>\n"
+ (git-get-committer-name) (git-get-committer-email)))))))
+ (let ((log-edit-font-lock-keywords
+ `(("^\\(Author:\\|Date:\\|Parent:\\|Signed-off-by:\\)\\(.*\\)"
+ (1 font-lock-keyword-face)
+ (2 font-lock-function-name-face))
+ (,(concat "^\\(" (regexp-quote git-log-msg-separator) "\\)$")
+ (1 font-lock-comment-face)))))
+ (log-edit #'git-do-commit nil #'git-log-edit-files buffer))))
(defun git-find-file ()
"Visit the current file in its own buffer."
(define-key map "d" diff-map)
(define-key map "=" 'git-diff-file)
(define-key map "f" 'git-find-file)
- (define-key map [RET] 'git-find-file)
+ (define-key map "\r" 'git-find-file)
(define-key map "g" 'git-refresh-status)
(define-key map "i" 'git-ignore-file)
(define-key map "l" 'git-log-file)
(define-key diff-map "=" 'git-diff-file)
(define-key diff-map "e" 'git-diff-file-idiff)
(define-key diff-map "E" 'git-find-file-imerge)
+ (define-key diff-map "h" 'git-diff-file-merge-head)
(define-key diff-map "m" 'git-diff-file-mine)
(define-key diff-map "o" 'git-diff-file-other)
(setq git-status-mode-map map)))
(erase-buffer)
(let ((status (ewoc-create 'git-fileinfo-prettyprint "" "")))
(set (make-local-variable 'git-status) status))
+ (set (make-local-variable 'list-buffers-directory) default-directory)
(run-hooks 'git-status-mode-hook)))
(defun git-status (dir)
(if (file-directory-p (concat (file-name-as-directory dir) ".git"))
(let ((buffer (create-file-buffer (expand-file-name "*git-status*" dir))))
(switch-to-buffer buffer)
- (git-status-mode)
(cd dir)
+ (git-status-mode)
(git-refresh-status)
(goto-char (point-min)))
(message "%s is not a git working tree." dir)))