-;;; vc-git.el --- VC backend for the git version control system
+;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*-
;; Copyright (C) 2006-2012 Free Software Foundation, Inc.
;; To install: put this file on the load-path and add Git to the list
;; of supported backends in `vc-handled-backends'; the following line,
-;; placed in your ~/.emacs, will accomplish this:
+;; placed in your init file, will accomplish this:
;;
;; (add-to-list 'vc-handled-backends 'Git)
;; - find-file-hook () NOT NEEDED
(eval-when-compile
- (require 'cl)
+ (require 'cl-lib)
(require 'vc)
(require 'vc-dir)
(require 'grep))
;;; BACKEND PROPERTIES
(defun vc-git-revision-granularity () 'repository)
-(defun vc-git-checkout-model (files) 'implicit)
+(defun vc-git-checkout-model (_files) 'implicit)
;;; STATE-QUERYING FUNCTIONS
(let ((dir (vc-git-root file)))
(when dir
(with-temp-buffer
- (let* (process-file-side-effects
- ;; Do not use the `file-name-directory' here: git-ls-files
- ;; sometimes fails to return the correct status for relative
- ;; path specs.
- ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
- (name (file-relative-name file dir))
- (str (ignore-errors
- (cd dir)
- (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
- ;; If result is empty, use ls-tree to check for deleted
- ;; file.
- (when (eq (point-min) (point-max))
- (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
- "--" name))
- (buffer-string))))
- (and str
- (> (length str) (length name))
- (string= (substring str 0 (1+ (length name)))
- (concat name "\0"))))))))
+ (let* (process-file-side-effects
+ ;; Do not use the `file-name-directory' here: git-ls-files
+ ;; sometimes fails to return the correct status for relative
+ ;; path specs.
+ ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
+ (name (file-relative-name file dir))
+ (str (ignore-errors
+ (cd dir)
+ (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
+ ;; If result is empty, use ls-tree to check for deleted
+ ;; file.
+ (when (eq (point-min) (point-max))
+ (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
+ "--" name))
+ (buffer-string))))
+ (and str
+ (> (length str) (length name))
+ (string= (substring str 0 (1+ (length name)))
+ (concat name "\0"))))))))
(defun vc-git--state-code (code)
"Convert from a string to a added/deleted/modified state."
- (case (string-to-char code)
+ (pcase (string-to-char code)
(?M 'edited)
(?A 'added)
(?D 'removed)
;; is direct ancestor of corresponding upstream branch, and the file
;; was modified upstream. But we can't check that without a network
;; operation.
- (if (not (vc-git-registered file))
- 'unregistered
- (vc-git--call nil "add" "--refresh" "--" (file-relative-name file))
- (let ((diff (vc-git--run-command-string
- file "diff-index" "-z" "HEAD" "--")))
- (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0"
- diff))
- (vc-git--state-code (match-string 1 diff))
- (if (vc-git--empty-db-p) 'added 'up-to-date)))))
-
-(defun vc-git-working-revision (file)
+ ;; This assumes that status is known to be not `unregistered' because
+ ;; we've been successfully dispatched here from `vc-state', that
+ ;; means `vc-git-registered' returned t earlier once. Bug#11757
+ (let ((diff (vc-git--run-command-string
+ file "diff-index" "-p" "--raw" "-z" "HEAD" "--")))
+ (if (and diff
+ (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0\\(.*\n.\\)?"
+ diff))
+ (let ((diff-letter (match-string 1 diff)))
+ (if (not (match-beginning 2))
+ ;; Empty diff: file contents is the same as the HEAD
+ ;; revision, but timestamps are different (eg, file
+ ;; was "touch"ed). Update timestamp in index:
+ (prog1 'up-to-date
+ (vc-git--call nil "add" "--refresh" "--"
+ (file-relative-name file)))
+ (vc-git--state-code diff-letter)))
+ (if (vc-git--empty-db-p) 'added 'up-to-date))))
+
+(defun vc-git-working-revision (_file)
"Git-specific version of `vc-working-revision'."
(let* (process-file-side-effects
(str (with-output-to-string
(eq 'up-to-date (vc-git-state file)))
(defun vc-git-mode-line-string (file)
- "Return string for placement into the modeline for FILE."
- (let* ((branch (vc-git-working-revision file))
+ "Return a string for `vc-mode-line' to put in the mode line for FILE."
+ (let* ((branch (vc-working-revision file))
(def-ml (vc-default-mode-line-string 'Git file))
(help-echo (get-text-property 0 'help-echo def-ml)))
(if (zerop (length branch))
(propertize def-ml
'help-echo (concat help-echo "\nCurrent branch: " branch)))))
-(defstruct (vc-git-extra-fileinfo
+(cl-defstruct (vc-git-extra-fileinfo
(:copier nil)
(:constructor vc-git-create-extra-fileinfo
(old-perm new-perm &optional rename-state orig-name))
(if (string-match "[\n\t\"\\]" name)
(concat "\""
(mapconcat (lambda (c)
- (case c
+ (pcase c
(?\n "\\n")
(?\t "\\t")
(?\\ "\\\\")
(?\" "\\\"")
- (t (char-to-string c))))
+ (_ (char-to-string c))))
name "")
"\"")
name))
"Return a string describing the file type based on its permissions."
(let* ((old-type (lsh (or old-perm 0) -9))
(new-type (lsh (or new-perm 0) -9))
- (str (case new-type
+ (str (pcase new-type
(?\100 ;; File.
- (case old-type
+ (pcase old-type
(?\100 nil)
(?\120 " (type change symlink -> file)")
(?\160 " (type change subproject -> file)")))
(?\120 ;; Symlink.
- (case old-type
+ (pcase old-type
(?\100 " (type change file -> symlink)")
(?\160 " (type change subproject -> symlink)")
(t " (symlink)")))
(?\160 ;; Subproject.
- (case old-type
+ (pcase old-type
(?\100 " (type change file -> subproject)")
(?\120 " (type change symlink -> subproject)")
(t " (subproject)")))
(?\110 nil) ;; Directory (internal, not a real git state).
(?\000 ;; Deleted or unknown.
- (case old-type
+ (pcase old-type
(?\120 " (symlink)")
(?\160 " (subproject)")))
- (t (format " (unknown type %o)" new-type)))))
+ (_ (format " (unknown type %o)" new-type)))))
(cond (str (propertize str 'face 'font-lock-comment-face))
((eq new-type ?\110) "/")
(t ""))))
"Process sentinel for the various dir-status stages."
(let (next-stage result)
(goto-char (point-min))
- (case stage
- (update-index
+ (pcase stage
+ (`update-index
(setq next-stage (if (vc-git--empty-db-p) 'ls-files-added
(if files 'ls-files-up-to-date 'diff-index))))
- (ls-files-added
+ (`ls-files-added
(setq next-stage 'ls-files-unknown)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
(let ((new-perm (string-to-number (match-string 1) 8))
(name (match-string 2)))
(push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm))
result))))
- (ls-files-up-to-date
+ (`ls-files-up-to-date
(setq next-stage 'diff-index)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
(let ((perm (string-to-number (match-string 1) 8))
(push (list name 'up-to-date
(vc-git-create-extra-fileinfo perm perm))
result))))
- (ls-files-unknown
+ (`ls-files-unknown
(when files (setq next-stage 'ls-files-ignored))
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(push (list (match-string 1) 'unregistered
(vc-git-create-extra-fileinfo 0 0))
result)))
- (ls-files-ignored
+ (`ls-files-ignored
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(push (list (match-string 1) 'ignored
(vc-git-create-extra-fileinfo 0 0))
result)))
- (diff-index
+ (`diff-index
(setq next-stage 'ls-files-unknown)
(while (re-search-forward
":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0"
(defun vc-git-dir-status-goto-stage (stage files update-function)
(erase-buffer)
- (case stage
- (update-index
+ (pcase stage
+ (`update-index
(if files
(vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
(vc-git-command (current-buffer) 'async nil
"update-index" "--refresh")))
- (ls-files-added
+ (`ls-files-added
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
- (ls-files-up-to-date
+ (`ls-files-up-to-date
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--"))
- (ls-files-unknown
+ (`ls-files-unknown
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
- (ls-files-ignored
+ (`ls-files-ignored
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "-i" "--directory"
"--no-empty-directory" "--exclude-standard" "--"))
;; --relative added in Git 1.5.5.
- (diff-index
+ (`diff-index
(vc-git-command (current-buffer) 'async files
"diff-index" "--relative" "-z" "-M" "HEAD" "--")))
(vc-exec-after
`(vc-git-after-dir-status-stage ',stage ',files ',update-function)))
-(defun vc-git-dir-status (dir update-function)
+(defun vc-git-dir-status (_dir update-function)
"Return a list of (FILE STATE EXTRA) entries for DIR."
;; Further things that would have to be fixed later:
;; - how to handle unregistered directories
;; - how to support vc-dir on a subdir of the project tree
(vc-git-dir-status-goto-stage 'update-index nil update-function))
-(defun vc-git-dir-status-files (dir files default-state update-function)
+(defun vc-git-dir-status-files (_dir files _default-state update-function)
"Return a list of (FILE STATE EXTRA) entries for FILES in DIR."
(vc-git-dir-status-goto-stage 'update-index files update-function))
:help "Show the contents of the current stash"))
map))
-(defun vc-git-dir-extra-headers (dir)
+(defun vc-git-dir-extra-headers (_dir)
(let ((str (with-output-to-string
(with-current-buffer standard-output
(vc-git--out-ok "symbolic-ref" "HEAD"))))
"Return the existing branches, as a list of strings.
The car of the list is the current branch."
(with-temp-buffer
- (call-process vc-git-program nil t nil "branch")
+ (vc-git--call t "branch")
(goto-char (point-min))
(let (current-branch branches)
(while (not (eobp))
"Create a new Git repository."
(vc-git-command nil 0 nil "init"))
-(defun vc-git-register (files &optional rev comment)
+(defun vc-git-register (files &optional _rev _comment)
"Register FILES into the git version-control system."
(let (flist dlist)
(dolist (crt files)
(defun vc-git-unregister (file)
(vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
+(declare-function log-edit-mode "log-edit" ())
+(declare-function log-edit-toggle-header "log-edit" (header value))
(declare-function log-edit-extract-headers "log-edit" (headers string))
-(defun vc-git-checkin (files rev comment)
+(defun vc-git-log-edit-toggle-signoff ()
+ "Toggle whether to add the \"Signed-off-by\" line at the end of
+the commit message."
+ (interactive)
+ (log-edit-toggle-header "Sign-Off" "yes"))
+
+(defun vc-git-log-edit-toggle-amend ()
+ "Toggle whether this will amend the previous commit.
+If toggling on, also insert its message into the buffer."
+ (interactive)
+ (when (log-edit-toggle-header "Amend" "yes")
+ (goto-char (point-max))
+ (unless (bolp) (insert "\n"))
+ (insert (with-output-to-string
+ (vc-git-command
+ standard-output 1 nil
+ "log" "--max-count=1" "--pretty=format:%B" "HEAD")))))
+
+(defvar vc-git-log-edit-mode-map
+ (let ((map (make-sparse-keymap "Git-Log-Edit")))
+ (define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff)
+ (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend)
+ map))
+
+(define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git"
+ "Major mode for editing Git log messages.
+It is based on `log-edit-mode', and has Git-specific extensions.")
+
+(defun vc-git-checkin (files _rev comment)
(let ((coding-system-for-write vc-git-commits-coding-system))
- (apply 'vc-git-command nil 0 files
- (nconc (list "commit" "-m")
- (log-edit-extract-headers '(("Author" . "--author")
- ("Date" . "--date"))
- comment)
- (list "--only" "--")))))
+ (cl-flet ((boolean-arg-fn
+ (argument)
+ (lambda (value) (when (equal value "yes") (list argument)))))
+ (apply 'vc-git-command nil 0 files
+ (nconc (list "commit" "-m")
+ (log-edit-extract-headers
+ `(("Author" . "--author")
+ ("Date" . "--date")
+ ("Amend" . ,(boolean-arg-fn "--amend"))
+ ("Sign-Off" . ,(boolean-arg-fn "--signoff")))
+ comment)
+ (list "--only" "--"))))))
(defun vc-git-find-revision (file rev buffer)
(let* (process-file-side-effects
nil
"cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
-(defun vc-git-checkout (file &optional editable rev)
+(defun vc-git-checkout (file &optional _editable rev)
(vc-git-command nil 0 file "checkout" (or rev "HEAD")))
(defun vc-git-revert (file &optional contents-done)
(vc-git-command nil 0 file "reset" "-q" "--")
(vc-git-command nil nil file "checkout" "-q" "--")))
+(defvar vc-git-error-regexp-alist
+ '(("^ \\(.+\\) |" 1 nil nil 0))
+ "Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
+
(defun vc-git-pull (prompt)
"Pull changes into the current Git branch.
Normally, this runs \"git pull\". If PROMPT is non-nil, prompt
command (cadr args)
args (cddr args)))
(apply 'vc-do-async-command buffer root git-program command args)
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
(defun vc-git-merge-branch ()
nil t)))
(apply 'vc-do-async-command buffer root vc-git-program "merge"
(list merge-source))
+ (with-current-buffer buffer (vc-exec-after '(vc-compilation-mode 'git)))
(vc-set-async-update buffer)))
;;; HISTORY FUNCTIONS
(list (cons (nth 1 vc-git-root-log-format)
(nth 2 vc-git-root-log-format)))
(append
- `((,log-view-message-re (1 'change-log-acknowledgement)))
+ `((,log-view-message-re (1 'change-log-acknowledgment)))
;; Handle the case:
;; user: foo@bar
'(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
(1 'change-log-name)
(2 'change-log-email))
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
- (1 'change-log-acknowledgement)
- (2 'change-log-acknowledgement))
+ (1 'change-log-acknowledgment)
+ (2 'change-log-acknowledgment))
("^Date: \\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
(append (vc-switches 'git 'diff)
(list "-p" (or rev1 "HEAD") rev2 "--")))))
-(defun vc-git-revision-table (files)
+(defun vc-git-revision-table (_files)
;; What about `files'?!? --Stef
(let (process-file-side-effects
(table (list "HEAD")))
table))
(defun vc-git-revision-completion-table (files)
- (lexical-let ((files files)
- table)
- (setq table (lazy-completion-table
- table (lambda () (vc-git-revision-table files))))
+ (letrec ((table (lazy-completion-table
+ table (lambda () (vc-git-revision-table files)))))
table))
(defun vc-git-annotate-command (file buf &optional rev)
(vc-git-command nil 0 nil "checkout" "-b" name)
(vc-git-command nil 0 nil "tag" name)))))
-(defun vc-git-retrieve-tag (dir name update)
+(defun vc-git-retrieve-tag (dir name _update)
(let ((default-directory dir))
(vc-git-command nil 0 nil "checkout" name)
;; FIXME: update buffers if `update' is true
(defun vc-git-extra-status-menu () vc-git-extra-menu-map)
(defun vc-git-root (file)
- (vc-find-root file ".git"))
+ (or (vc-file-getprop file 'git-root)
+ (vc-file-setprop file 'git-root (vc-find-root file ".git"))))
;; Derived from `lgrep'.
(defun vc-git-grep (regexp &optional files dir)
The difference to vc-do-command is that this function always invokes
`vc-git-program'."
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
- file-or-list flags))
+ file-or-list (cons "--no-pager" flags)))
(defun vc-git--empty-db-p ()
"Check if the git db is empty (no commit done yet)."