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.el117
1 files changed, 87 insertions, 30 deletions
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index ad806b38545..f3174005307 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -102,8 +102,7 @@
(eval-when-compile
(require 'cl-lib)
(require 'vc)
- (require 'vc-dir)
- (require 'grep))
+ (require 'vc-dir))
(defgroup vc-git nil
"VC Git backend."
@@ -180,9 +179,21 @@ Should be consistent with the Git config value i18n.logOutputEncoding."
:type '(coding-system :tag "Coding system to decode Git log output")
:version "25.1")
+(defcustom vc-git-grep-template "git --no-pager grep -n -e <R> -- <F>"
+ "The default command to run for \\[vc-git-grep].
+The following place holders should be present in the string:
+ <F> - file names and wildcards to search.
+ <R> - the regular expression searched for."
+ :type 'string
+ :version "27.1")
+
;; History of Git commands.
(defvar vc-git-history nil)
+;; Clear up the cache to force vc-call to check again and discover
+;; new functions when we reload this file.
+(put 'Git 'vc-functions nil)
+
;;; BACKEND PROPERTIES
(defun vc-git-revision-granularity () 'repository)
@@ -278,7 +289,7 @@ in the order given by 'git status'."
;; 2. When a file A is renamed to B in the index and then back to A
;; in the working tree.
;; In both of these instances, `unregistered' is a reasonable response.
- (`("D " "??") 'unregistered)
+ ('("D " "??") 'unregistered)
;; In other cases, let us return `edited'.
(_ 'edited)))
@@ -364,8 +375,8 @@ in the order given by 'git status'."
(defun vc-git-file-type-as-string (old-perm new-perm)
"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))
+ (let* ((old-type (ash (or old-perm 0) -9))
+ (new-type (ash (or new-perm 0) -9))
(str (pcase new-type
(?\100 ;; File.
(pcase old-type
@@ -475,9 +486,9 @@ or an empty string if none."
(files (vc-git-dir-status-state->files git-state)))
(goto-char (point-min))
(pcase (vc-git-dir-status-state->stage git-state)
- (`update-index
+ ('update-index
(setq next-stage (if (vc-git--empty-db-p) 'ls-files-added '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))
@@ -485,7 +496,7 @@ or an empty string if none."
(vc-git-dir-status-update-file
git-state name 'added
(vc-git-create-extra-fileinfo 0 new-perm)))))
- (`ls-files-up-to-date
+ ('ls-files-up-to-date
(setq next-stage 'ls-files-unknown)
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} \\([0-3]\\)\t\\([^\0]+\\)\0" nil t)
(let ((perm (string-to-number (match-string 1) 8))
@@ -496,7 +507,7 @@ or an empty string if none."
'up-to-date
'conflict)
(vc-git-create-extra-fileinfo perm perm)))))
- (`ls-files-conflict
+ ('ls-files-conflict
(setq next-stage 'ls-files-unknown)
;; It's enough to look for "3" to notice a conflict.
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 3\t\\([^\0]+\\)\0" nil t)
@@ -505,16 +516,16 @@ or an empty string if none."
(vc-git-dir-status-update-file
git-state name 'conflict
(vc-git-create-extra-fileinfo perm perm)))))
- (`ls-files-unknown
+ ('ls-files-unknown
(when files (setq next-stage 'ls-files-ignored))
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(vc-git-dir-status-update-file git-state (match-string 1) 'unregistered
(vc-git-create-extra-fileinfo 0 0))))
- (`ls-files-ignored
+ ('ls-files-ignored
(while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
(vc-git-dir-status-update-file git-state (match-string 1) 'ignored
(vc-git-create-extra-fileinfo 0 0))))
- (`diff-index
+ ('diff-index
(setq next-stage (if files 'ls-files-up-to-date 'ls-files-conflict))
(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"
@@ -566,30 +577,30 @@ or an empty string if none."
(let ((files (vc-git-dir-status-state->files git-state)))
(erase-buffer)
(pcase (vc-git-dir-status-state->stage git-state)
- (`update-index
+ ('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-conflict
+ ('ls-files-conflict
(vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-u" "--"))
- (`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-run-delayed
@@ -863,6 +874,8 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
(declare-function vc-compilation-mode "vc-dispatcher" (backend))
+(defvar compilation-directory)
+(defvar compilation-arguments)
(defun vc-git--pushpull (command prompt extra-args)
"Run COMMAND (a string; either push or pull) on the current Git branch.
@@ -1176,7 +1189,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(defvar vc-git--log-view-long-font-lock-keywords nil)
(defvar font-lock-keywords)
(defvar vc-git-region-history-font-lock-keywords
- `((vc-git-region-history-font-lock)))
+ '((vc-git-region-history-font-lock)))
(defun vc-git-region-history-font-lock (limit)
(let ((in-diff (save-excursion
@@ -1373,6 +1386,9 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(define-key map [git-grep]
'(menu-item "Git grep..." vc-git-grep
:help "Run the `git grep' command"))
+ (define-key map [git-ds]
+ '(menu-item "Delete Stash..." vc-git-stash-delete
+ :help "Delete a stash"))
(define-key map [git-sn]
'(menu-item "Stash a Snapshot" vc-git-stash-snapshot
:help "Stash the current state of the tree and keep the current state"))
@@ -1397,6 +1413,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(declare-function grep-read-files "grep" (regexp))
(declare-function grep-expand-template "grep"
(template &optional regexp files dir excl))
+(defvar compilation-environment)
;; Derived from `lgrep'.
(defun vc-git-grep (regexp &optional files dir)
@@ -1423,8 +1440,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(cond
((equal current-prefix-arg '(16))
(list (read-from-minibuffer "Run: " "git grep"
- nil nil 'grep-history)
- nil))
+ nil nil 'grep-history)))
(t (let* ((regexp (grep-read-regexp))
(files
(mapconcat #'shell-quote-argument
@@ -1434,13 +1450,15 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(list regexp files dir))))))
(require 'grep)
(when (and (stringp regexp) (> (length regexp) 0))
+ (unless (and dir (file-accessible-directory-p dir))
+ (setq dir default-directory))
(let ((command regexp))
(if (null files)
(if (string= command "git grep")
(setq command nil))
(setq dir (file-name-as-directory (expand-file-name dir)))
(setq command
- (grep-expand-template "git --no-pager grep -n -e <R> -- <F>"
+ (grep-expand-template vc-git-grep-template
regexp files))
(when command
(if (equal current-prefix-arg '(4))
@@ -1457,17 +1475,36 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(if (eq next-error-last-buffer (current-buffer))
(setq default-directory dir))))))
+(autoload 'vc-dir-marked-files "vc-dir")
+
(defun vc-git-stash (name)
"Create a stash."
(interactive "sStash name: ")
(let ((root (vc-git-root default-directory)))
(when root
- (vc-git--call nil "stash" "save" name)
+ (apply #'vc-git--call nil "stash" "push" "-m" name
+ (when (derived-mode-p 'vc-dir-mode)
+ (vc-dir-marked-files)))
(vc-resynch-buffer root t t))))
+(defvar vc-git-stash-read-history nil
+ "History for `vc-git-stash-read'.")
+
+(defun vc-git-stash-read (prompt)
+ "Read a Git stash. PROMPT is a string to prompt with."
+ (let ((stash (completing-read
+ prompt
+ (split-string
+ (or (vc-git--run-command-string nil "stash" "list") "") "\n")
+ nil :require-match nil 'vc-git-stash-read-history)))
+ (if (string-equal stash "")
+ (user-error "Not a stash")
+ (string-match "^stash@{[[:digit:]]+}" stash)
+ (match-string 0 stash))))
+
(defun vc-git-stash-show (name)
"Show the contents of stash NAME."
- (interactive "sStash name: ")
+ (interactive (list (vc-git-stash-read "Show stash: ")))
(vc-setup-buffer "*vc-git-stash*")
(vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
(set-buffer "*vc-git-stash*")
@@ -1477,16 +1514,22 @@ This command shares argument histories with \\[rgrep] and \\[grep]."
(defun vc-git-stash-apply (name)
"Apply stash NAME."
- (interactive "sApply stash: ")
+ (interactive (list (vc-git-stash-read "Apply stash: ")))
(vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
(vc-resynch-buffer (vc-git-root default-directory) t t))
(defun vc-git-stash-pop (name)
"Pop stash NAME."
- (interactive "sPop stash: ")
+ (interactive (list (vc-git-stash-read "Pop stash: ")))
(vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
(vc-resynch-buffer (vc-git-root default-directory) t t))
+(defun vc-git-stash-delete (name)
+ "Delete stash NAME."
+ (interactive (list (vc-git-stash-read "Delete stash: ")))
+ (vc-git-command "*vc-git-stash*" 0 nil "stash" "drop" "-q" name)
+ (vc-resynch-buffer (vc-git-root default-directory) t t))
+
(defun vc-git-stash-snapshot ()
"Create a stash with the current tree state."
(interactive)
@@ -1555,7 +1598,14 @@ The difference to vc-do-command is that this function always invokes
(or coding-system-for-read vc-git-log-output-coding-system))
(coding-system-for-write
(or coding-system-for-write vc-git-commits-coding-system))
- (process-environment (cons "GIT_DIR" process-environment)))
+ (process-environment
+ (append
+ `("GIT_DIR"
+ ;; Avoid repository locking during background operations
+ ;; (bug#21559).
+ ,@(when revert-buffer-in-progress-p
+ '("GIT_OPTIONAL_LOCKS=0")))
+ process-environment)))
(apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
;; https://debbugs.gnu.org/16897
(unless (and (not (cdr-safe file-or-list))
@@ -1582,8 +1632,15 @@ The difference to vc-do-command is that this function always invokes
(or coding-system-for-read vc-git-log-output-coding-system))
(coding-system-for-write
(or coding-system-for-write vc-git-commits-coding-system))
- (process-environment (cons "PAGER=" process-environment)))
- (push "GIT_DIR" process-environment)
+ (process-environment
+ (append
+ `("GIT_DIR"
+ "PAGER="
+ ;; Avoid repository locking during background operations
+ ;; (bug#21559).
+ ,@(when revert-buffer-in-progress-p
+ '("GIT_OPTIONAL_LOCKS=0")))
+ process-environment)))
(apply 'process-file vc-git-program nil buffer nil command args)))
(defun vc-git--out-ok (command &rest args)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-22 16:35:39 +0000