summaryrefslogtreecommitdiff
path: root/lisp/vc/vc-git.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/vc/vc-git.el')
-rw-r--r--lisp/vc/vc-git.el228
1 files changed, 177 insertions, 51 deletions
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index afaaa44e908..918a210cee9 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -136,12 +136,19 @@ If nil, use the value of `vc-annotate-switches'. If t, use no switches."
;;;###autoload(put 'vc-git-annotate-switches 'safe-local-variable (lambda (switches) (equal switches "-w")))
(defcustom vc-git-log-switches nil
- "String or list of strings specifying switches for Git log under VC."
+ "String or list of strings giving Git log switches for non-shortlogs."
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:version "28.1")
+(defcustom vc-git-shortlog-switches nil
+ "String or list of strings giving Git log switches for shortlogs."
+ :type '(choice (const :tag "None" nil)
+ (string :tag "Argument String")
+ (repeat :tag "Argument List" :value ("") string))
+ :version "30.1")
+
(defcustom vc-git-resolve-conflicts t
"When non-nil, mark conflicted file as resolved upon saving.
That is performed after all conflict markers in it have been
@@ -308,6 +315,23 @@ Good example of file name that needs this: \"test[56].xx\".")
(string-trim-right (match-string 1 version-string) "\\.")
"0")))))
+(defun vc-git--git-path (&optional path)
+ "Resolve .git/PATH for the current working tree.
+In particular, handle the case where this is a linked working
+tree, such that .git is a plain file.
+
+See the --git-dir and --git-path options to git-rev-parse(1)."
+ (if (and path (not (string-empty-p path)))
+ ;; Canonicalize in this branch because --git-dir always returns
+ ;; an absolute file name.
+ (expand-file-name
+ (string-trim-right
+ (vc-git--run-command-string nil "rev-parse"
+ "--git-path" path)))
+ (concat (string-trim-right
+ (vc-git--run-command-string nil "rev-parse" "--git-dir"))
+ "/")))
+
(defun vc-git--git-status-to-vc-state (code-list)
"Convert CODE-LIST to a VC status.
@@ -752,12 +776,32 @@ or an empty string if none."
:help "Show the contents of the current stash"))
map))
+(defun vc-git--cmds-in-progress ()
+ "Return a list of Git commands in progress in this worktree."
+ (let ((gitdir (vc-git--git-path))
+ cmds)
+ ;; See contrib/completion/git-prompt.sh in git.git.
+ (when (or (file-directory-p
+ (expand-file-name "rebase-merge" gitdir))
+ (file-exists-p
+ (expand-file-name "rebase-apply/rebasing" gitdir)))
+ (push 'rebase cmds))
+ (when (file-exists-p
+ (expand-file-name "rebase-apply/applying" gitdir))
+ (push 'am cmds))
+ (when (file-exists-p (expand-file-name "MERGE_HEAD" gitdir))
+ (push 'merge cmds))
+ (when (file-exists-p (expand-file-name "BISECT_START" gitdir))
+ (push 'bisect cmds))
+ cmds))
+
(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"))))
(stash-list (vc-git-stash-list))
(default-directory dir)
+ (in-progress (vc-git--cmds-in-progress))
branch remote remote-url stash-button stash-string)
(if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
@@ -832,9 +876,9 @@ or an empty string if none."
(propertize remote-url
'face 'vc-dir-header-value)))
;; For now just a heading, key bindings can be added later for various bisect actions
- (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir)))
+ (when (memq 'bisect in-progress)
(propertize "\nBisect : in progress" 'face 'vc-dir-status-warning))
- (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir)))
+ (when (memq 'rebase in-progress)
(propertize "\nRebase : in progress" 'face 'vc-dir-status-warning))
(if stash-list
(concat
@@ -1013,33 +1057,58 @@ It is based on `log-edit-mode', and has Git-specific extensions."
;; message. Handle also remote files.
(if (eq system-type 'windows-nt)
(let ((default-directory (file-name-directory file1)))
- (make-nearby-temp-file "git-msg")))))
+ (make-nearby-temp-file "git-msg"))))
+ to-stash)
(when vc-git-patch-string
(unless (zerop (vc-git-command nil t nil "diff" "--cached" "--quiet"))
- ;; Check that all staged changes also exist in the patch.
- ;; This is needed to allow adding/removing files that are
- ;; currently staged to the index. So remove the whole file diff
- ;; from the patch because commit will take it from the index.
+ ;; Check that what's already staged is compatible with what
+ ;; we want to commit (bug#60126).
+ ;;
+ ;; 1. If the changes to a file in the index are identical to
+ ;; the changes to that file we want to commit, remove the
+ ;; changes from our patch, and let the commit take them
+ ;; from the index. This is necessary for adding and
+ ;; removing files to work.
+ ;;
+ ;; 2. If the changes to a file in the index are different to
+ ;; changes to that file we want to commit, then we have to
+ ;; unstage the changes or abort.
+ ;;
+ ;; 3. If there are changes to a file in the index but we don't
+ ;; want to commit any changes to that file, we need to
+ ;; stash those changes before committing.
(with-temp-buffer
(vc-git-command (current-buffer) t nil "diff" "--cached")
(goto-char (point-min))
- (let ((pos (point)) file-diff file-beg)
+ (let ((pos (point)) file-name file-header file-diff file-beg)
(while (not (eobp))
+ (when (and (looking-at "^diff --git a/\\(.+\\) b/\\(.+\\)")
+ (string= (match-string 1) (match-string 2)))
+ (setq file-name (match-string 1)))
(forward-line 1) ; skip current "diff --git" line
+ (setq file-header (buffer-substring pos (point)))
(search-forward "diff --git" nil 'move)
(move-beginning-of-line 1)
(setq file-diff (buffer-substring pos (point)))
- (if (and (setq file-beg (string-search
- file-diff vc-git-patch-string))
- ;; Check that file diff ends with an empty string
- ;; or the beginning of the next file diff.
- (string-match-p "\\`\\'\\|\\`diff --git"
- (substring
- vc-git-patch-string
- (+ file-beg (length file-diff)))))
- (setq vc-git-patch-string
- (string-replace file-diff "" vc-git-patch-string))
- (user-error "Index not empty"))
+ (cond ((and (setq file-beg (string-search
+ file-diff vc-git-patch-string))
+ ;; Check that file diff ends with an empty string
+ ;; or the beginning of the next file diff.
+ (string-match-p "\\`\\'\\|\\`diff --git"
+ (substring
+ vc-git-patch-string
+ (+ file-beg (length file-diff)))))
+ (setq vc-git-patch-string
+ (string-replace file-diff "" vc-git-patch-string)))
+ ((string-match (format "^%s" (regexp-quote file-header))
+ vc-git-patch-string)
+ (if (and file-name
+ (yes-or-no-p
+ (format "Unstage already-staged changes to %s?"
+ file-name)))
+ (vc-git-command nil 0 file-name "reset" "-q" "--")
+ (user-error "Index not empty")))
+ (t (push file-name to-stash)))
(setq pos (point))))))
(unless (string-empty-p vc-git-patch-string)
(let ((patch-file (make-nearby-temp-file "git-patch")))
@@ -1047,7 +1116,8 @@ It is based on `log-edit-mode', and has Git-specific extensions."
(insert vc-git-patch-string))
(unwind-protect
(vc-git-command nil 0 patch-file "apply" "--cached")
- (delete-file patch-file)))))
+ (delete-file patch-file))))
+ (when to-stash (vc-git--stash-staged-changes files)))
(cl-flet ((boolean-arg-fn
(argument)
(lambda (value) (when (equal value "yes") (list argument)))))
@@ -1073,7 +1143,58 @@ It is based on `log-edit-mode', and has Git-specific extensions."
args)
(unless vc-git-patch-string
(if only (list "--only" "--") '("-a"))))))
- (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))))
+ (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))
+ (when to-stash
+ (let ((cached (make-nearby-temp-file "git-cached")))
+ (unwind-protect
+ (progn (with-temp-file cached
+ (vc-git-command t 0 nil "stash" "show" "-p"))
+ (vc-git-command nil 0 cached "apply" "--cached"))
+ (delete-file cached))
+ (vc-git-command nil 0 nil "stash" "drop")))))
+
+(defun vc-git--stash-staged-changes (files)
+ "Stash only the staged changes to FILES."
+ ;; This is necessary because even if you pass a list of file names
+ ;; to 'git stash push', it will stash any and all staged changes.
+ (unless (zerop
+ (vc-git-command nil t files "diff" "--cached" "--quiet"))
+ (cl-flet
+ ((git-string (&rest args)
+ (string-trim-right
+ (with-output-to-string
+ (apply #'vc-git-command standard-output 0 nil args)))))
+ (let ((cached (make-nearby-temp-file "git-cached"))
+ (message "Previously staged changes")
+ tree)
+ ;; Use a temporary index to create a tree object corresponding
+ ;; to the staged changes to FILES.
+ (unwind-protect
+ (progn
+ (with-temp-file cached
+ (vc-git-command t 0 files "diff" "--cached" "--"))
+ (let* ((index (make-nearby-temp-file "git-index"))
+ (process-environment
+ (cons (format "GIT_INDEX_FILE=%s" index)
+ process-environment)))
+ (unwind-protect
+ (progn
+ (vc-git-command nil 0 nil "read-tree" "HEAD")
+ (vc-git-command nil 0 cached "apply" "--cached")
+ (setq tree (git-string "write-tree")))
+ (delete-file index))))
+ (delete-file cached))
+ ;; Prepare stash commit object, which has a special structure.
+ (let* ((tree-commit (git-string "commit-tree" "-m" message
+ "-p" "HEAD" tree))
+ (stash-commit (git-string "commit-tree" "-m" message
+ "-p" "HEAD" "-p" tree-commit
+ tree)))
+ ;; Push the new stash entry.
+ (vc-git-command nil 0 nil "update-ref" "--create-reflog"
+ "-m" message "refs/stash" stash-commit)
+ ;; Unstage the changes we've now stashed.
+ (vc-git-command nil 0 files "reset" "--"))))))
(defun vc-git-find-revision (file rev buffer)
(let* (process-file-side-effects
@@ -1202,8 +1323,7 @@ This prompts for a branch to merge from."
(completing-read "Merge from branch: "
(if (or (member "FETCH_HEAD" branches)
(not (file-readable-p
- (expand-file-name ".git/FETCH_HEAD"
- root))))
+ (vc-git--git-path "FETCH_HEAD"))))
branches
(cons "FETCH_HEAD" branches))
nil t)))
@@ -1248,8 +1368,7 @@ This prompts for a branch to merge from."
(unless (or
(not (eq vc-git-resolve-conflicts 'unstage-maybe))
;; Doing a merge, so bug#20292 doesn't apply.
- (file-exists-p (expand-file-name ".git/MERGE_HEAD"
- (vc-git-root buffer-file-name)))
+ (file-exists-p (vc-git--git-path "MERGE_HEAD"))
(vc-git-conflicted-files (vc-git-root buffer-file-name)))
(vc-git-command nil 0 nil "reset"))
(vc-resynch-buffer buffer-file-name t t)
@@ -1326,7 +1445,8 @@ If LIMIT is a revision string, use it as an end-revision."
,(format "--pretty=tformat:%s"
(car vc-git-root-log-format))
"--abbrev-commit"))
- (ensure-list vc-git-log-switches)
+ (ensure-list
+ (if shortlog vc-git-shortlog-switches vc-git-log-switches))
(when (numberp limit)
(list "-n" (format "%s" limit)))
(when start-revision
@@ -1341,16 +1461,16 @@ If LIMIT is a revision string, use it as an end-revision."
(defun vc-git-log-outgoing (buffer remote-location)
(vc-setup-buffer buffer)
- (vc-git-command
- buffer 'async nil
- "log"
- "--no-color" "--graph" "--decorate" "--date=short"
- (format "--pretty=tformat:%s" (car vc-git-root-log-format))
- "--abbrev-commit"
- (concat (if (string= remote-location "")
- "@{upstream}"
- remote-location)
- "..HEAD")))
+ (apply #'vc-git-command buffer 'async nil
+ `("log"
+ "--no-color" "--graph" "--decorate" "--date=short"
+ ,(format "--pretty=tformat:%s" (car vc-git-root-log-format))
+ "--abbrev-commit"
+ ,@(ensure-list vc-git-shortlog-switches)
+ ,(concat (if (string= remote-location "")
+ "@{upstream}"
+ remote-location)
+ "..HEAD"))))
(defun vc-git-log-incoming (buffer remote-location)
(vc-setup-buffer buffer)
@@ -1360,15 +1480,15 @@ If LIMIT is a revision string, use it as an end-revision."
;; so remove everything except a repository name.
(replace-regexp-in-string
"/.*" "" remote-location)))
- (vc-git-command
- buffer 'async nil
- "log"
- "--no-color" "--graph" "--decorate" "--date=short"
- (format "--pretty=tformat:%s" (car vc-git-root-log-format))
- "--abbrev-commit"
- (concat "HEAD.." (if (string= remote-location "")
- "@{upstream}"
- remote-location))))
+ (apply #'vc-git-command buffer 'async nil
+ `("log"
+ "--no-color" "--graph" "--decorate" "--date=short"
+ ,(format "--pretty=tformat:%s" (car vc-git-root-log-format))
+ "--abbrev-commit"
+ ,@(ensure-list vc-git-shortlog-switches)
+ ,(concat "HEAD.." (if (string= remote-location "")
+ "@{upstream}"
+ remote-location)))))
(defun vc-git-log-search (buffer pattern)
"Search the log of changes for PATTERN and output results into BUFFER.
@@ -1379,6 +1499,7 @@ Display all entries that match log messages in long format.
With a prefix argument, ask for a command to run that will output
log entries."
(let ((args `("log" "--no-color" "-i"
+ ,@(ensure-list vc-git-log-switches)
,(format "--grep=%s" (or pattern "")))))
(when current-prefix-arg
(setq args (cdr (split-string
@@ -1426,11 +1547,11 @@ log entries."
`((,log-view-message-re (1 'change-log-acknowledgment)))
;; Handle the case:
;; user: foo@bar
- '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
+ '(("^\\(?:Author\\|Commit\\):[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
(1 'change-log-email))
;; Handle the case:
;; user: FirstName LastName <foo@bar>
- ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
+ ("^\\(?:Author\\|Commit\\):[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
(1 'change-log-name)
(2 'change-log-email))
("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
@@ -1441,7 +1562,7 @@ log entries."
("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
(1 'change-log-acknowledgment)
(2 'change-log-acknowledgment))
- ("^\\(?:Date: \\|AuthorDate: \\)\\(.+\\)" (1 'change-log-date))
+ ("^\\(?:Date: \\|AuthorDate: \\|CommitDate: \\)\\(.+\\)" (1 'change-log-date))
("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
@@ -1463,7 +1584,11 @@ or BRANCH^ (where \"^\" can be repeated)."
(defun vc-git-expanded-log-entry (revision)
(with-temp-buffer
- (apply #'vc-git-command t nil nil (list "log" revision "-1" "--no-color" "--"))
+ (apply #'vc-git-command t nil nil
+ `("log"
+ ,revision
+ "-1" "--no-color" ,@(ensure-list vc-git-log-switches)
+ "--"))
(goto-char (point-min))
(unless (eobp)
;; Indent the expanded log entry.
@@ -1662,7 +1787,8 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(if branchp "branch" "tag"))))
(if branchp
(vc-git-command nil 0 nil "checkout" "-b" name
- (when (and start-point (not (eq start-point "")))
+ (when (and start-point
+ (not (equal start-point "")))
start-point))
(vc-git-command nil 0 nil "tag" name)))))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-24 01:12:45 +0000