diff options
Diffstat (limited to 'lisp/vc/vc-git.el')
| -rw-r--r-- | lisp/vc/vc-git.el | 174 |
1 files changed, 90 insertions, 84 deletions
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 9aa2ee72b5..b48ea1afd9 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1,4 +1,4 @@ -;;; 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. @@ -104,7 +104,7 @@ ;; - find-file-hook () NOT NEEDED (eval-when-compile - (require 'cl) + (require 'cl-lib) (require 'vc) (require 'vc-dir) (require 'grep)) @@ -160,7 +160,7 @@ matching the resulting Git log output, and KEYWORDS is a list of ;;; 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 @@ -176,29 +176,29 @@ matching the resulting Git log output, and KEYWORDS is a list of (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) @@ -215,25 +215,26 @@ matching the resulting Git log output, and KEYWORDS is a list of ;; 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 - (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) + ;; 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 @@ -247,8 +248,8 @@ matching the resulting Git log output, and KEYWORDS is a list of (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)) @@ -258,7 +259,7 @@ matching the resulting Git log output, and KEYWORDS is a list of (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)) @@ -272,12 +273,12 @@ matching the resulting Git log output, and KEYWORDS is a list of (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)) @@ -286,28 +287,28 @@ matching the resulting Git log output, and KEYWORDS is a list of "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 "")))) @@ -375,18 +376,18 @@ or an empty string if none." "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)) @@ -394,18 +395,18 @@ or an empty string if none." (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" @@ -444,41 +445,41 @@ or an empty string if none." (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)) @@ -512,7 +513,7 @@ or an empty string if none." :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")))) @@ -573,7 +574,7 @@ or an empty string if none." "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)) @@ -590,7 +591,7 @@ The car of the list is the current branch." "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) @@ -609,7 +610,7 @@ The car of the list is the current branch." (declare-function log-edit-extract-headers "log-edit" (headers string)) -(defun vc-git-checkin (files rev comment) +(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") @@ -635,7 +636,7 @@ The car of the list is the current branch." 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) @@ -645,6 +646,10 @@ The car of the list is the current branch." (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 @@ -665,6 +670,7 @@ for the Git command to run." 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 () @@ -684,6 +690,7 @@ This prompts for a branch to merge from." 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 @@ -765,7 +772,7 @@ for the --graph option." (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_.-]+\\)" @@ -781,8 +788,8 @@ for the --graph option." (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))))))) @@ -821,7 +828,7 @@ or BRANCH^ (where \"^\" can be repeated)." (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"))) @@ -834,10 +841,8 @@ or BRANCH^ (where \"^\" can be repeated)." 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) @@ -876,7 +881,7 @@ or BRANCH^ (where \"^\" can be repeated)." (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 @@ -961,7 +966,8 @@ or BRANCH^ (where \"^\" can be repeated)." (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) |