diff options
Diffstat (limited to 'lisp/vc/vc-git.el')
| -rw-r--r-- | lisp/vc/vc-git.el | 217 |
1 files changed, 153 insertions, 64 deletions
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 610cbde7a49..9715aea1fdc 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -74,6 +74,9 @@ ;; - steal-lock (file &optional revision) NOT NEEDED ;; HISTORY FUNCTIONS ;; * print-log (files buffer &optional shortlog start-revision limit) OK +;; * log-outgoing (buffer remote-location) OK +;; * log-incoming (buffer remote-location) OK +;; - log-search (buffer pattern) OK ;; - log-view-mode () OK ;; - show-log-entry (revision) OK ;; - comment-history (file) ?? @@ -101,9 +104,9 @@ (eval-when-compile (require 'cl-lib) + (require 'subr-x) ; for string-trim-right (require 'vc) - (require 'vc-dir) - (require 'grep)) + (require 'vc-dir)) (defgroup vc-git nil "VC Git backend." @@ -180,9 +183,22 @@ 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 <C> -e <R> -- <F>" + "The default command to run for \\[vc-git-grep]. +The following place holders should be present in the string: + <C> - place to put the options like -i. + <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) @@ -242,7 +258,7 @@ Should be consistent with the Git config value i18n.logOutputEncoding." ;; Git for Windows appends ".windows.N" to the ;; numerical version reported by Git. (string-match - "git version \\([0-9.]+\\)\\(\.windows.[0-9]+\\)?$" + "git version \\([0-9.]+\\)\\(\\.windows\\.[0-9]+\\)?$" version-string)) (match-string 1 version-string) "0"))))) @@ -278,7 +294,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 +380,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 +491,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 +501,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 +512,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 +521,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 +582,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 @@ -738,7 +754,7 @@ The car of the list is the current branch." (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)) -(declare-function log-edit-set-header "log-edit" (header value &optional toggle)) +(declare-function log-edit--toggle-amend "log-edit" (last-msg-fn)) (defun vc-git-log-edit-toggle-signoff () "Toggle whether to add the \"Signed-off-by\" line at the end of @@ -746,31 +762,26 @@ the commit message." (interactive) (log-edit-toggle-header "Sign-Off" "yes")) +(defun vc-git-log-edit-toggle-no-verify () + "Toggle whether to bypass the pre-commit and commit-msg hooks." + (interactive) + (log-edit-toggle-header "No-Verify" "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"))) - (save-excursion - (rfc822-goto-eoh) - (forward-line 1) - (let ((pt (point))) - (and (zerop (forward-line 1)) - (looking-at "\n\\|\\'") - (let ((summary (buffer-substring-no-properties pt (1- (point))))) - (skip-chars-forward " \n") - (delete-region pt (point)) - (log-edit-set-header "Summary" summary))))))) + (log-edit--toggle-amend + (lambda () + (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-n" 'vc-git-log-edit-toggle-no-verify) (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend) map)) @@ -814,6 +825,7 @@ It is based on `log-edit-mode', and has Git-specific extensions.") `(("Author" . "--author") ("Date" . "--date") ("Amend" . ,(boolean-arg-fn "--amend")) + ("No-Verify" . ,(boolean-arg-fn "--no-verify")) ("Sign-Off" . ,(boolean-arg-fn "--signoff"))) comment))) (when msg-file @@ -863,6 +875,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. @@ -997,7 +1011,8 @@ This prompts for a branch to merge from." If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'. \(This requires at least Git version 1.5.6, for the --graph option.) If START-REVISION is non-nil, it is the newest revision to show. -If LIMIT is non-nil, show no more than this many entries." +If LIMIT is a number, show no more than this many entries. +If LIMIT is a revision string, use it as an end-revision." (let ((coding-system-for-read (or coding-system-for-read vc-git-log-output-coding-system))) ;; `vc-do-command' creates the buffer, but we need it before running @@ -1025,12 +1040,17 @@ If LIMIT is non-nil, show no more than this many entries." ,(format "--pretty=tformat:%s" (car vc-git-root-log-format)) "--abbrev-commit")) - (when limit (list "-n" (format "%s" limit))) - (when start-revision (list start-revision)) + (when (numberp limit) + (list "-n" (format "%s" limit))) + (when start-revision + (if (and limit (not (numberp limit))) + (list (concat start-revision ".." (if (equal limit "") + "HEAD" + limit))) + (list start-revision))) '("--"))))))) (defun vc-git-log-outgoing (buffer remote-location) - (interactive) (vc-setup-buffer buffer) (vc-git-command buffer 'async nil @@ -1044,7 +1064,6 @@ If LIMIT is non-nil, show no more than this many entries." "..HEAD"))) (defun vc-git-log-incoming (buffer remote-location) - (interactive) (vc-setup-buffer buffer) (vc-git-command nil 0 nil "fetch") (vc-git-command @@ -1057,6 +1076,31 @@ If LIMIT is non-nil, show no more than this many entries." "@{upstream}" remote-location)))) +(defun vc-git-log-search (buffer pattern) + "Search the log of changes for PATTERN and output results into BUFFER. + +PATTERN is a basic regular expression by default in Git. + +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" + ,(format "--grep=%s" (or pattern ""))))) + (when current-prefix-arg + (setq args (cdr (split-string + (read-shell-command + "Search log with command: " + (format "%s %s" vc-git-program + (mapconcat 'identity args " ")) + 'vc-git-history) + " " t)))) + (vc-setup-buffer buffer) + (apply 'vc-git-command buffer 'async nil args))) + +(defun vc-git-mergebase (rev1 &optional rev2) + (unless rev2 (setq rev2 "HEAD")) + (string-trim-right (vc-git--run-command-string nil "merge-base" rev1 rev2))) + (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) @@ -1066,19 +1110,19 @@ If LIMIT is non-nil, show no more than this many entries." (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View" (require 'add-log) ;; We need the faces add-log. ;; Don't have file markers, so use impossible regexp. - (set (make-local-variable 'log-view-file-re) "\\`a\\`") + (set (make-local-variable 'log-view-file-re) regexp-unmatchable) (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) - (if (not (eq vc-log-view-type 'long)) + (if (not (memq vc-log-view-type '(long log-search))) (cadr vc-git-root-log-format) "^commit *\\([0-9a-z]+\\)")) ;; Allow expanding short log entries. - (when (memq vc-log-view-type '(short log-outgoing log-incoming)) + (when (memq vc-log-view-type '(short log-outgoing log-incoming mergebase)) (setq truncate-lines t) (set (make-local-variable 'log-view-expanded-log-entry-function) 'vc-git-expanded-log-entry)) (set (make-local-variable 'log-view-font-lock-keywords) - (if (not (eq vc-log-view-type 'long)) + (if (not (memq vc-log-view-type '(long log-search))) (list (cons (nth 1 vc-git-root-log-format) (nth 2 vc-git-root-log-format))) (append @@ -1176,7 +1220,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 +1417,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 +1444,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 +1471,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 +1481,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 +1506,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,24 +1545,27 @@ 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) (vc-git--call nil "stash" "save" - (let ((ct (current-time))) - (concat - (format-time-string "Snapshot on %Y-%m-%d" ct) - (format-time-string " at %H:%M" ct)))) + (format-time-string "Snapshot on %Y-%m-%d at %H:%M")) (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}") (vc-resynch-buffer (vc-git-root default-directory) t t)) @@ -1518,6 +1589,7 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (declare-function vc-dir-refresh "vc-dir" ()) (defun vc-git-stash-delete-at-point () + "Delete the stash at point." (interactive) (let ((stash (vc-git-stash-get-at-point (point)))) (when (y-or-n-p (format "Remove stash %s ? " stash)) @@ -1525,16 +1597,19 @@ This command shares argument histories with \\[rgrep] and \\[grep]." (vc-dir-refresh)))) (defun vc-git-stash-show-at-point () + "Show the stash at point." (interactive) (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point))))) (defun vc-git-stash-apply-at-point () + "Apply the stash at point." (interactive) (let (vc-dir-buffers) ; Small optimization. (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point))))) (vc-dir-refresh)) (defun vc-git-stash-pop-at-point () + "Pop the stash at point." (interactive) (let (vc-dir-buffers) ; Likewise. (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point))))) @@ -1555,7 +1630,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)) @@ -1575,15 +1657,22 @@ The difference to vc-do-command is that this function always invokes (defun vc-git--call (buffer command &rest args) ;; We don't need to care the arguments. If there is a file name, it ;; is always a relative one. This works also for remote - ;; directories. We enable `inhibit-null-byte-detection', otherwise + ;; directories. We enable `inhibit-nul-byte-detection', otherwise ;; Tramp's eol conversion might be confused. - (let ((inhibit-null-byte-detection t) + (let ((inhibit-nul-byte-detection t) (coding-system-for-read (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) |