masscollaborationlabs/emacs
2
0
Fork 0
mirror of https://github.com/masscollaborationlabs/emacs.git synced 2025-07-04 19:29:37 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fix vc-git with old Git over Tramp and cygwin-mount.el

Browse source 
* lisp/vc/vc-git.el (vc-git-use-literal-pathspecs): New variable.
(vc-git-command, vc-git--call): Use it to determine whether to set
GIT_LITERAL_PATHSPECS=1 (bug#51497).
(vc-git--literal-pathspec, vc-git--literal-pathspecs): Remove.
Update all callers.  This reverts the previous solution for bug#39452.

* lisp/progmodes/project.el (project--vc-list-files):
Use the new variable.
This commit is contained in:
Dmitry Gutov 2022-01-05 04:08:10 +02:00
parent c0cfbca311
commit e7aa3ece52
3 changed files with 44 additions and 39 deletions
Download patch file Download diff file Expand all files Collapse all files

7
etc/NEWS
View file

@ -1949,6 +1949,13 @@ String or list of strings specifying switches for Git log under VC.
If you are still using it with any regularity, please file a bug If you are still using it with any regularity, please file a bug
report with some details. report with some details.
---
*** New variable 'vc-git-use-literal-pathspecs'.
The Git backend's function now treat all file names "literally", where
some of them previously could interpret file names (pathspecs) as
globs when they contain appropriate characters. Functions can bind
the aforementioned variable to nil locally to avoid this.
** Gnus ** Gnus
+++ +++

2
lisp/progmodes/project.el
View file

@ -494,10 +494,12 @@ backend implementation of `project-external-roots'.")
(declare-function vc-hg-command "vc-hg") (declare-function vc-hg-command "vc-hg")
(defun project--vc-list-files (dir backend extra-ignores) (defun project--vc-list-files (dir backend extra-ignores)
(defvar vc-git-use-literal-pathspecs)
(pcase backend (pcase backend
(`Git (`Git
(let ((default-directory (expand-file-name (file-name-as-directory dir))) (let ((default-directory (expand-file-name (file-name-as-directory dir)))
(args '("-z")) (args '("-z"))
(vc-git-use-literal-pathspecs nil)
files) files)
;; Include unregistered. ;; Include unregistered.
(setq args (append args '("-c" "-o" "--exclude-standard"))) (setq args (append args '("-c" "-o" "--exclude-standard")))

74
lisp/vc/vc-git.el
View file

@ -223,6 +223,12 @@ included in the completions."
;; History of Git commands. ;; History of Git commands.
(defvar vc-git-history nil) (defvar vc-git-history nil)
;; Default to t because commands which don't support literal pathspecs
;; ignore the environment variable silently.
(defvar vc-git-use-literal-pathspecs t
"Non-nil to treat pathspecs in commands literally.
Good example of file name that needs this: \"test[56].xx\".")
;; Clear up the cache to force vc-call to check again and discover ;; Clear up the cache to force vc-call to check again and discover
;; new functions when we reload this file. ;; new functions when we reload this file.
(put 'Git 'vc-functions nil) (put 'Git 'vc-functions nil)
@ -242,20 +248,6 @@ included in the completions."
;;;###autoload (load "vc-git" nil t) ;;;###autoload (load "vc-git" nil t)
;;;###autoload (vc-git-registered file)))) ;;;###autoload (vc-git-registered file))))
;; Good example of file name that needs this: "test[56].xx".
(defun vc-git--literal-pathspec (file)
"Prepend :(literal) path magic to FILE."
(when file
;; Expand abbreviated file names.
(when (file-name-absolute-p file)
(setq file (expand-file-name file)))
(concat ":(literal)" (file-local-name file))))
(defun vc-git--literal-pathspecs (files)
"Prepend :(literal) path magic to FILES."
(unless (vc-git--file-list-is-rootdir files)
(mapcar #'vc-git--literal-pathspec files)))
(defun vc-git-registered (file) (defun vc-git-registered (file)
"Check whether FILE is registered with git." "Check whether FILE is registered with git."
(let ((dir (vc-git-root file))) (let ((dir (vc-git-root file)))
@ -269,12 +261,12 @@ included in the completions."
(name (file-relative-name file dir)) (name (file-relative-name file dir))
(str (with-demoted-errors "Error: %S" (str (with-demoted-errors "Error: %S"
(cd dir) (cd dir)
(vc-git--out-ok "ls-files" "-c" "-z" "--" (vc-git--literal-pathspec name)) (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
;; If result is empty, use ls-tree to check for deleted ;; If result is empty, use ls-tree to check for deleted
;; file. ;; file.
(when (eq (point-min) (point-max)) (when (eq (point-min) (point-max))
(vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD" (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
"--" (vc-git--literal-pathspec name))) "--" name))
(buffer-string)))) (buffer-string))))
(and str (and str
(> (length str) (length name)) (> (length str) (length name))
@ -356,7 +348,7 @@ in the order given by `git status'."
,@(when (version<= "1.7.6.3" (vc-git--program-version)) ,@(when (version<= "1.7.6.3" (vc-git--program-version))
'("--ignored")) '("--ignored"))
"--")) "--"))
(status (apply #'vc-git--run-command-string (vc-git--literal-pathspec file) args))) (status (apply #'vc-git--run-command-string file args)))
(if (null status) (if (null status)
;; If status is nil, there was an error calling git, likely because ;; If status is nil, there was an error calling git, likely because
;; the file is not in a git repo. ;; the file is not in a git repo.
@ -634,28 +626,28 @@ or an empty string if none."
(pcase (vc-git-dir-status-state->stage git-state) (pcase (vc-git-dir-status-state->stage git-state)
('update-index ('update-index
(if files (if files
(vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) "add" "--refresh" "--") (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
(vc-git-command (current-buffer) 'async nil (vc-git-command (current-buffer) 'async nil
"update-index" "--refresh"))) "update-index" "--refresh")))
('ls-files-added ('ls-files-added
(vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) (vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--")) "ls-files" "-z" "-c" "-s" "--"))
('ls-files-up-to-date ('ls-files-up-to-date
(vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) (vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-c" "-s" "--")) "ls-files" "-z" "-c" "-s" "--"))
('ls-files-conflict ('ls-files-conflict
(vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) (vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-u" "--")) "ls-files" "-z" "-u" "--"))
('ls-files-unknown ('ls-files-unknown
(vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) (vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "--exclude-standard" "--")) "ls-files" "-z" "-o" "--exclude-standard" "--"))
('ls-files-ignored ('ls-files-ignored
(vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) (vc-git-command (current-buffer) 'async files
"ls-files" "-z" "-o" "-i" "--directory" "ls-files" "-z" "-o" "-i" "--directory"
"--no-empty-directory" "--exclude-standard" "--")) "--no-empty-directory" "--exclude-standard" "--"))
;; --relative added in Git 1.5.5. ;; --relative added in Git 1.5.5.
('diff-index ('diff-index
(vc-git-command (current-buffer) 'async (vc-git--literal-pathspecs files) (vc-git-command (current-buffer) 'async files
"diff-index" "--relative" "-z" "-M" "HEAD" "--"))) "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
(vc-run-delayed (vc-run-delayed
(vc-git-after-dir-status-stage git-state)))) (vc-git-after-dir-status-stage git-state))))
@ -883,12 +875,12 @@ The car of the list is the current branch."
(when flist (when flist
(vc-git-command nil 0 flist "update-index" "--add" "--")) (vc-git-command nil 0 flist "update-index" "--add" "--"))
(when dlist (when dlist
(vc-git-command nil 0 (vc-git--literal-pathspecs dlist) "add")))) (vc-git-command nil 0 dlist "add"))))
(defalias 'vc-git-responsible-p #'vc-git-root) (defalias 'vc-git-responsible-p #'vc-git-root)
(defun vc-git-unregister (file) (defun vc-git-unregister (file)
(vc-git-command nil 0 (vc-git--literal-pathspec file) "rm" "-f" "--cached" "--")) (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
(declare-function log-edit-mode "log-edit" ()) (declare-function log-edit-mode "log-edit" ())
(declare-function log-edit-toggle-header "log-edit" (header value)) (declare-function log-edit-toggle-header "log-edit" (header value))
@ -954,7 +946,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
(lambda (value) (when (equal value "yes") (list argument))))) (lambda (value) (when (equal value "yes") (list argument)))))
;; When operating on the whole tree, better pass "-a" than ".", since "." ;; When operating on the whole tree, better pass "-a" than ".", since "."
;; fails when we're committing a merge. ;; fails when we're committing a merge.
(apply #'vc-git-command nil 0 (if only (vc-git--literal-pathspecs files)) (apply #'vc-git-command nil 0 (if only files)
(nconc (if msg-file (list "commit" "-F" (nconc (if msg-file (list "commit" "-F"
(file-local-name msg-file)) (file-local-name msg-file))
(list "commit" "-m")) (list "commit" "-m"))
@ -981,7 +973,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
(coding-system-for-write 'binary) (coding-system-for-write 'binary)
(fullname (fullname
(let ((fn (vc-git--run-command-string (let ((fn (vc-git--run-command-string
(vc-git--literal-pathspec file) "ls-files" "-z" "--full-name" "--"))) file "ls-files" "-z" "--full-name" "--")))
;; ls-files does not return anything when looking for a ;; ls-files does not return anything when looking for a
;; revision of a file that has been renamed or removed. ;; revision of a file that has been renamed or removed.
(if (string= fn "") (if (string= fn "")
@ -998,14 +990,14 @@ It is based on `log-edit-mode', and has Git-specific extensions.")
(vc-git-root file))) (vc-git-root file)))
(defun vc-git-checkout (file &optional rev) (defun vc-git-checkout (file &optional rev)
(vc-git-command nil 0 (vc-git--literal-pathspec file) "checkout" (or rev "HEAD"))) (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
(defun vc-git-revert (file &optional contents-done) (defun vc-git-revert (file &optional contents-done)
"Revert FILE to the version stored in the git repository." "Revert FILE to the version stored in the git repository."
(if contents-done (if contents-done
(vc-git-command nil 0 file "update-index" "--") (vc-git-command nil 0 file "update-index" "--")
(vc-git-command nil 0 (vc-git--literal-pathspec file) "reset" "-q" "--") (vc-git-command nil 0 file "reset" "-q" "--")
(vc-git-command nil nil (vc-git--literal-pathspec file) "checkout" "-q" "--"))) (vc-git-command nil nil file "checkout" "-q" "--")))
(defvar vc-git-error-regexp-alist (defvar vc-git-error-regexp-alist
'(("^ \\(.+\\)\\> *|" 1 nil nil 0)) '(("^ \\(.+\\)\\> *|" 1 nil nil 0))
@ -1089,7 +1081,7 @@ This prompts for a branch to merge from."
(defun vc-git-conflicted-files (directory) (defun vc-git-conflicted-files (directory)
"Return the list of files with conflicts in DIRECTORY." "Return the list of files with conflicts in DIRECTORY."
(let* ((status (let* ((status
(vc-git--run-command-string (vc-git--literal-pathspec directory) "status" "--porcelain" "--")) (vc-git--run-command-string directory "status" "--porcelain" "--"))
(lines (when status (split-string status "\n" 'omit-nulls))) (lines (when status (split-string status "\n" 'omit-nulls)))
files) files)
(dolist (line lines files) (dolist (line lines files)
@ -1178,7 +1170,7 @@ If LIMIT is a revision string, use it as an end-revision."
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(with-current-buffer buffer (with-current-buffer buffer
(apply #'vc-git-command buffer (apply #'vc-git-command buffer
'async (vc-git--literal-pathspecs files) 'async files
(append (append
'("log" "--no-color") '("log" "--no-color")
(when (and vc-git-print-log-follow (when (and vc-git-print-log-follow
@ -1432,7 +1424,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(if vc-git-diff-switches (if vc-git-diff-switches
(apply #'vc-git-command (or buffer "*vc-diff*") (apply #'vc-git-command (or buffer "*vc-diff*")
1 ; bug#21969 1 ; bug#21969
(vc-git--literal-pathspecs files) files
command command
"--exit-code" "--exit-code"
(append (vc-switches 'git 'diff) (append (vc-switches 'git 'diff)
@ -1517,7 +1509,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(let* ((fname (file-relative-name file)) (let* ((fname (file-relative-name file))
(prev-rev (with-temp-buffer (prev-rev (with-temp-buffer
(and (and
(vc-git--out-ok "rev-list" "-2" rev "--" (vc-git--literal-pathspec fname)) (vc-git--out-ok "rev-list" "-2" rev "--" fname)
(goto-char (point-max)) (goto-char (point-max))
(bolp) (bolp)
(zerop (forward-line -1)) (zerop (forward-line -1))
@ -1545,7 +1537,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(current-rev (current-rev
(with-temp-buffer (with-temp-buffer
(and (and
(vc-git--out-ok "rev-list" "-1" rev "--" (vc-git--literal-pathspec file)) (vc-git--out-ok "rev-list" "-1" rev "--" file)
(goto-char (point-max)) (goto-char (point-max))
(bolp) (bolp)
(zerop (forward-line -1)) (zerop (forward-line -1))
@ -1557,7 +1549,7 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(and current-rev (and current-rev
(with-temp-buffer (with-temp-buffer
(and (and
(vc-git--out-ok "rev-list" "HEAD" "--" (vc-git--literal-pathspec file)) (vc-git--out-ok "rev-list" "HEAD" "--" file)
(goto-char (point-min)) (goto-char (point-min))
(search-forward current-rev nil t) (search-forward current-rev nil t)
(zerop (forward-line -1)) (zerop (forward-line -1))
@ -1567,13 +1559,13 @@ This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
(or (vc-git-symbolic-commit next-rev) next-rev))) (or (vc-git-symbolic-commit next-rev) next-rev)))
(defun vc-git-delete-file (file) (defun vc-git-delete-file (file)
(vc-git-command nil 0 (vc-git--literal-pathspec file) "rm" "-f" "--")) (vc-git-command nil 0 file "rm" "-f" "--"))
(defun vc-git-rename-file (old new) (defun vc-git-rename-file (old new)
(vc-git-command nil 0 (list old new) "mv" "-f" "--")) (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
(defun vc-git-mark-resolved (files) (defun vc-git-mark-resolved (files)
(vc-git-command nil 0 (vc-git--literal-pathspecs files) "add")) (vc-git-command nil 0 files "add"))
(defvar vc-git-extra-menu-map (defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
@ -1796,6 +1788,8 @@ The difference to vc-do-command is that this function always invokes
(process-environment (process-environment
(append (append
`("GIT_DIR" `("GIT_DIR"
,@(when vc-git-use-literal-pathspecs
'("GIT_LITERAL_PATHSPECS=1"))
;; Avoid repository locking during background operations ;; Avoid repository locking during background operations
;; (bug#21559). ;; (bug#21559).
,@(when revert-buffer-in-progress-p ,@(when revert-buffer-in-progress-p
@ -1833,6 +1827,8 @@ The difference to vc-do-command is that this function always invokes
(process-environment (process-environment
(append (append
`("GIT_DIR" `("GIT_DIR"
,@(when vc-git-use-literal-pathspecs
'("GIT_LITERAL_PATHSPECS=1"))
;; Avoid repository locking during background operations ;; Avoid repository locking during background operations
;; (bug#21559). ;; (bug#21559).
,@(when revert-buffer-in-progress-p ,@(when revert-buffer-in-progress-p