LCOV - code coverage report
Current view: top level - lisp/vc - vc-git.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 67 776 8.6 %
Date: 2017-08-30 10:12:24 Functions: 15 95 15.8 %

          Line data    Source code
       1             : ;;; vc-git.el --- VC backend for the git version control system -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 2006-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Alexandre Julliard <julliard@winehq.org>
       6             : ;; Keywords: vc tools
       7             : ;; Package: vc
       8             : 
       9             : ;; This file is part of GNU Emacs.
      10             : 
      11             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      12             : ;; it under the terms of the GNU General Public License as published by
      13             : ;; the Free Software Foundation, either version 3 of the License, or
      14             : ;; (at your option) any later version.
      15             : 
      16             : ;; GNU Emacs is distributed in the hope that it will be useful,
      17             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      18             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      19             : ;; GNU General Public License for more details.
      20             : 
      21             : ;; You should have received a copy of the GNU General Public License
      22             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      23             : 
      24             : ;;; Commentary:
      25             : 
      26             : ;; This file contains a VC backend for the git version control
      27             : ;; system.
      28             : ;;
      29             : 
      30             : ;;; Installation:
      31             : 
      32             : ;; To install: put this file on the load-path and add Git to the list
      33             : ;; of supported backends in `vc-handled-backends'; the following line,
      34             : ;; placed in your init file, will accomplish this:
      35             : ;;
      36             : ;;     (add-to-list 'vc-handled-backends 'Git)
      37             : 
      38             : ;;; Todo:
      39             : ;;  - check if more functions could use vc-git-command instead
      40             : ;;     of start-process.
      41             : ;;  - changelog generation
      42             : 
      43             : ;; Implement the rest of the vc interface. See the comment at the
      44             : ;; beginning of vc.el. The current status is:
      45             : ;; ("??" means: "figure out what to do about it")
      46             : ;;
      47             : ;; FUNCTION NAME                                   STATUS
      48             : ;; BACKEND PROPERTIES
      49             : ;; * revision-granularity                          OK
      50             : ;; STATE-QUERYING FUNCTIONS
      51             : ;; * registered (file)                             OK
      52             : ;; * state (file)                                  OK
      53             : ;; - dir-status-files (dir files uf)               OK
      54             : ;; * working-revision (file)                       OK
      55             : ;; * checkout-model (files)                        OK
      56             : ;; - mode-line-string (file)                       OK
      57             : ;; STATE-CHANGING FUNCTIONS
      58             : ;; * create-repo ()                                OK
      59             : ;; * register (files &optional rev comment)        OK
      60             : ;; - responsible-p (file)                          OK
      61             : ;; - receive-file (file rev)                       NOT NEEDED
      62             : ;; - unregister (file)                             OK
      63             : ;; * checkin (files rev comment)                   OK
      64             : ;; * find-revision (file rev buffer)               OK
      65             : ;; * checkout (file &optional rev)                 OK
      66             : ;; * revert (file &optional contents-done)         OK
      67             : ;; - merge-file (file rev1 rev2)            It would be possible to merge
      68             : ;;                                          changes into a single file, but
      69             : ;;                                          when committing they wouldn't
      70             : ;;                                          be identified as a merge
      71             : ;;                                          by git, so it's probably
      72             : ;;                                          not a good idea.
      73             : ;; - merge-news (file)                      see `merge-file'
      74             : ;; - steal-lock (file &optional revision)          NOT NEEDED
      75             : ;; HISTORY FUNCTIONS
      76             : ;; * print-log (files buffer &optional shortlog start-revision limit)   OK
      77             : ;; - log-view-mode ()                              OK
      78             : ;; - show-log-entry (revision)                     OK
      79             : ;; - comment-history (file)                        ??
      80             : ;; - update-changelog (files)                      COULD BE SUPPORTED
      81             : ;; * diff (file &optional rev1 rev2 buffer async)  OK
      82             : ;; - revision-completion-table (files)             OK
      83             : ;; - annotate-command (file buf &optional rev)     OK
      84             : ;; - annotate-time ()                              OK
      85             : ;; - annotate-current-time ()                      NOT NEEDED
      86             : ;; - annotate-extract-revision-at-line ()          OK
      87             : ;; TAG SYSTEM
      88             : ;; - create-tag (dir name branchp)                 OK
      89             : ;; - retrieve-tag (dir name update)                OK
      90             : ;; MISCELLANEOUS
      91             : ;; - make-version-backups-p (file)                 NOT NEEDED
      92             : ;; - previous-revision (file rev)                  OK
      93             : ;; - next-revision (file rev)                      OK
      94             : ;; - check-headers ()                              COULD BE SUPPORTED
      95             : ;; - delete-file (file)                            OK
      96             : ;; - rename-file (old new)                         OK
      97             : ;; - find-file-hook ()                             OK
      98             : ;; - conflicted-files                              OK
      99             : 
     100             : ;;; Code:
     101             : 
     102             : (eval-when-compile
     103             :   (require 'cl-lib)
     104             :   (require 'vc)
     105             :   (require 'vc-dir)
     106             :   (require 'grep))
     107             : 
     108             : (defgroup vc-git nil
     109             :   "VC Git backend."
     110             :   :version "24.1"
     111             :   :group 'vc)
     112             : 
     113             : (defcustom vc-git-diff-switches t
     114             :   "String or list of strings specifying switches for Git diff under VC.
     115             : If nil, use the value of `vc-diff-switches'.  If t, use no switches."
     116             :   :type '(choice (const :tag "Unspecified" nil)
     117             :                  (const :tag "None" t)
     118             :                  (string :tag "Argument String")
     119             :                  (repeat :tag "Argument List" :value ("") string))
     120             :   :version "23.1")
     121             : 
     122             : (defcustom vc-git-annotate-switches nil
     123             :   "String or list of strings specifying switches for Git blame under VC.
     124             : If nil, use the value of `vc-annotate-switches'.  If t, use no switches."
     125             :   :type '(choice (const :tag "Unspecified" nil)
     126             :                  (const :tag "None" t)
     127             :                  (string :tag "Argument String")
     128             :                  (repeat :tag "Argument List" :value ("") string))
     129             :   :version "25.1")
     130             : 
     131             : (defcustom vc-git-resolve-conflicts t
     132             :   "When non-nil, mark conflicted file as resolved upon saving.
     133             : That is performed after all conflict markers in it have been
     134             : removed.  If the value is `unstage-maybe', and no merge is in
     135             : progress, then after the last conflict is resolved, also clear
     136             : the staging area."
     137             :   :type '(choice (const :tag "Don't resolve" nil)
     138             :                  (const :tag "Resolve" t)
     139             :                  (const :tag "Resolve and maybe unstage all files"
     140             :                         unstage-maybe))
     141             :   :version "25.1")
     142             : 
     143             : (defcustom vc-git-program "git"
     144             :   "Name of the Git executable (excluding any arguments)."
     145             :   :version "24.1"
     146             :   :type 'string)
     147             : 
     148             : (defcustom vc-git-root-log-format
     149             :   '("%d%h..: %an %ad %s"
     150             :     ;; The first shy group matches the characters drawn by --graph.
     151             :     ;; We use numbered groups because `log-view-message-re' wants the
     152             :     ;; revision number to be group 1.
     153             :     "^\\(?:[*/\\| ]+ \\)?\\(?2: ([^)]+)\\)?\\(?1:[0-9a-z]+\\)..: \
     154             : \\(?3:.*?\\)[ \t]+\\(?4:[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)"
     155             :     ((1 'log-view-message)
     156             :      (2 'change-log-list nil lax)
     157             :      (3 'change-log-name)
     158             :      (4 'change-log-date)))
     159             :   "Git log format for `vc-print-root-log'.
     160             : This should be a list (FORMAT REGEXP KEYWORDS), where FORMAT is a
     161             : format string (which is passed to \"git log\" via the argument
     162             : \"--pretty=tformat:FORMAT\"), REGEXP is a regular expression
     163             : matching the resulting Git log output, and KEYWORDS is a list of
     164             : `font-lock-keywords' for highlighting the Log View buffer."
     165             :   :type '(list string string (repeat sexp))
     166             :   :version "24.1")
     167             : 
     168             : (defcustom vc-git-commits-coding-system 'utf-8
     169             :   "Default coding system for sending commit log messages to Git.
     170             : 
     171             : Should be consistent with the Git config value i18n.commitEncoding,
     172             : and should also be consistent with `locale-coding-system'."
     173             :   :type '(coding-system :tag "Coding system to encode Git commit logs")
     174             :   :version "25.1")
     175             : 
     176             : (defcustom vc-git-log-output-coding-system 'utf-8
     177             :   "Default coding system for receiving log output from Git.
     178             : 
     179             : Should be consistent with the Git config value i18n.logOutputEncoding."
     180             :   :type '(coding-system :tag "Coding system to decode Git log output")
     181             :   :version "25.1")
     182             : 
     183             : ;; History of Git commands.
     184             : (defvar vc-git-history nil)
     185             : 
     186             : ;;; BACKEND PROPERTIES
     187             : 
     188             : (defun vc-git-revision-granularity () 'repository)
     189             : (defun vc-git-checkout-model (_files) 'implicit)
     190             : 
     191             : ;;; STATE-QUERYING FUNCTIONS
     192             : 
     193             : ;;;###autoload (defun vc-git-registered (file)
     194             : ;;;###autoload   "Return non-nil if FILE is registered with git."
     195             : ;;;###autoload   (if (vc-find-root file ".git")       ; Short cut.
     196             : ;;;###autoload       (progn
     197             : ;;;###autoload         (load "vc-git" nil t)
     198             : ;;;###autoload         (vc-git-registered file))))
     199             : 
     200             : (defun vc-git-registered (file)
     201             :   "Check whether FILE is registered with git."
     202             :   (let ((dir (vc-git-root file)))
     203             :     (when dir
     204             :       (with-temp-buffer
     205             :         (let* (process-file-side-effects
     206             :                ;; Do not use the `file-name-directory' here: git-ls-files
     207             :                ;; sometimes fails to return the correct status for relative
     208             :                ;; path specs.
     209             :                ;; See also: http://marc.info/?l=git&m=125787684318129&w=2
     210             :                (name (file-relative-name file dir))
     211             :                (str (ignore-errors
     212             :                       (cd dir)
     213             :                       (vc-git--out-ok "ls-files" "-c" "-z" "--" name)
     214             :                       ;; If result is empty, use ls-tree to check for deleted
     215             :                       ;; file.
     216             :                       (when (eq (point-min) (point-max))
     217             :                         (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD"
     218             :                                         "--" name))
     219             :                       (buffer-string))))
     220             :           (and str
     221             :                (> (length str) (length name))
     222             :                (string= (substring str 0 (1+ (length name)))
     223             :                         (concat name "\0"))))))))
     224             : 
     225             : (defun vc-git--state-code (code)
     226             :   "Convert from a string to a added/deleted/modified state."
     227           0 :   (pcase (string-to-char code)
     228             :     (?M 'edited)
     229             :     (?A 'added)
     230             :     (?D 'removed)
     231             :     (?U 'edited)     ;; FIXME
     232           0 :     (?T 'edited)))   ;; FIXME
     233             : 
     234             : (defvar vc-git--program-version nil)
     235             : 
     236             : (defun vc-git--program-version ()
     237          40 :   (or vc-git--program-version
     238           0 :       (let ((version-string
     239           0 :              (vc-git--run-command-string nil "version")))
     240           0 :         (setq vc-git--program-version
     241           0 :               (if (and version-string
     242           0 :                        (string-match "git version \\([0-9.]+\\)$"
     243           0 :                                      version-string))
     244           0 :                   (match-string 1 version-string)
     245          40 :                 "0")))))
     246             : 
     247             : (defun vc-git--git-status-to-vc-state (code-list)
     248             :   "Convert CODE-LIST to a VC status.
     249             : 
     250             : Each element of CODE-LIST comes from the first two characters of
     251             : a line returned by 'git status --porcelain' and should be passed
     252             : in the order given by 'git status'."
     253             :   ;; It is necessary to allow CODE-LIST to be a list because sometimes git
     254             :   ;; status returns multiple lines, e.g. for a file that is removed from
     255             :   ;; the index but is present in the HEAD and working tree.
     256          40 :   (pcase code-list
     257             :     ('nil 'up-to-date)
     258             :     (`(,code)
     259           0 :      (pcase code
     260             :        ("!!" 'ignored)
     261             :        ("??" 'unregistered)
     262             :        ;; I have only seen this with a file that is only present in the
     263             :        ;; index.  Let us call this `removed'.
     264             :        ("AD" 'removed)
     265           0 :        (_ (cond
     266           0 :            ((string-match-p "^[ RD]+$" code) 'removed)
     267           0 :            ((string-match-p "^[ M]+$" code) 'edited)
     268           0 :            ((string-match-p "^[ A]+$" code) 'added)
     269           0 :            ((string-match-p "^[ U]+$" code) 'conflict)
     270           0 :            (t 'edited)))))
     271             :     ;;  I know of two cases when git state returns more than one element,
     272             :     ;;  in both cases returning '("D " "??")':
     273             :     ;;  1. When a file is removed from the index but present in the
     274             :     ;;     HEAD and working tree.
     275             :     ;;  2. When a file A is renamed to B in the index and then back to A
     276             :     ;;     in the working tree.
     277             :     ;;  In both of these instances, `unregistered' is a reasonable response.
     278             :     (`("D " "??") 'unregistered)
     279             :     ;;  In other cases, let us return `edited'.
     280          40 :     (_ 'edited)))
     281             : 
     282             : (defun vc-git-state (file)
     283             :   "Git-specific version of `vc-state'."
     284             :   ;; It can't set `needs-update' or `needs-merge'. The rough
     285             :   ;; equivalent would be that upstream branch for current branch is in
     286             :   ;; fast-forward state i.e. current branch is direct ancestor of
     287             :   ;; corresponding upstream branch, and the file was modified
     288             :   ;; upstream.  We'd need to check against the upstream tracking
     289             :   ;; branch for that (an extra process call or two).
     290          40 :   (let* ((args
     291          40 :           `("status" "--porcelain" "-z"
     292             :             ;; Just to be explicit, it's the default anyway.
     293             :             "--untracked-files"
     294          40 :             ,@(when (version<= "1.7.6.3" (vc-git--program-version))
     295          40 :                 '("--ignored"))
     296          40 :             "--"))
     297          40 :         (status (apply #'vc-git--run-command-string file args)))
     298             :     ;; Alternatively, the `ignored' state could be detected with 'git
     299             :     ;; ls-files -i -o --exclude-standard', but that's an extra process
     300             :     ;; call, and the `ignored' state is rarely needed.
     301          40 :     (if (null status)
     302             :         ;; If status is nil, there was an error calling git, likely because
     303             :         ;; the file is not in a git repo.
     304             :         'unregistered
     305             :       ;; If this code is adapted to parse 'git status' for a directory,
     306             :       ;; note that a renamed file takes up two null values and needs to be
     307             :       ;; treated slightly more carefully.
     308          40 :       (vc-git--git-status-to-vc-state
     309          40 :        (mapcar (lambda (s)
     310           0 :                  (substring s 0 2))
     311          40 :                (split-string status "\0" t))))))
     312             : 
     313             : (defun vc-git-working-revision (_file)
     314             :   "Git-specific version of `vc-working-revision'."
     315          40 :   (let (process-file-side-effects)
     316          40 :     (vc-git--rev-parse "HEAD")))
     317             : 
     318             : (defun vc-git--symbolic-ref (file)
     319          40 :   (or
     320          40 :    (vc-file-getprop file 'vc-git-symbolic-ref)
     321          40 :    (let* (process-file-side-effects
     322          40 :           (str (vc-git--run-command-string nil "symbolic-ref" "HEAD")))
     323          40 :      (vc-file-setprop file 'vc-git-symbolic-ref
     324          40 :                       (if str
     325          40 :                           (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
     326          40 :                               (match-string 2 str)
     327          40 :                             str))))))
     328             : 
     329             : (defun vc-git-mode-line-string (file)
     330             :   "Return a string for `vc-mode-line' to put in the mode line for FILE."
     331          40 :   (let* ((rev (vc-working-revision file 'Git))
     332          40 :          (disp-rev (or (vc-git--symbolic-ref file)
     333          40 :                        (substring rev 0 7)))
     334          40 :          (def-ml (vc-default-mode-line-string 'Git file))
     335          40 :          (help-echo (get-text-property 0 'help-echo def-ml))
     336          40 :          (face   (get-text-property 0 'face def-ml)))
     337          40 :     (propertize (concat (substring def-ml 0 4) disp-rev)
     338          40 :                 'face face
     339          40 :                 'help-echo (concat help-echo "\nCurrent revision: " rev))))
     340             : 
     341             : (cl-defstruct (vc-git-extra-fileinfo
     342             :             (:copier nil)
     343             :             (:constructor vc-git-create-extra-fileinfo
     344             :                           (old-perm new-perm &optional rename-state orig-name))
     345             :             (:conc-name vc-git-extra-fileinfo->))
     346             :   old-perm new-perm   ;; Permission flags.
     347             :   rename-state        ;; Rename or copy state.
     348             :   orig-name)          ;; Original name for renames or copies.
     349             : 
     350             : (defun vc-git-escape-file-name (name)
     351             :   "Escape a file name if necessary."
     352           0 :   (if (string-match "[\n\t\"\\]" name)
     353           0 :       (concat "\""
     354           0 :               (mapconcat (lambda (c)
     355           0 :                    (pcase c
     356             :                      (?\n "\\n")
     357             :                      (?\t "\\t")
     358             :                      (?\\ "\\\\")
     359             :                      (?\" "\\\"")
     360           0 :                      (_ (char-to-string c))))
     361           0 :                  name "")
     362           0 :               "\"")
     363           0 :     name))
     364             : 
     365             : (defun vc-git-file-type-as-string (old-perm new-perm)
     366             :   "Return a string describing the file type based on its permissions."
     367           0 :   (let* ((old-type (lsh (or old-perm 0) -9))
     368           0 :          (new-type (lsh (or new-perm 0) -9))
     369           0 :          (str (pcase new-type
     370             :                 (?\100  ;; File.
     371           0 :                  (pcase old-type
     372             :                    (?\100 nil)
     373             :                    (?\120 "   (type change symlink -> file)")
     374           0 :                    (?\160 "   (type change subproject -> file)")))
     375             :                  (?\120  ;; Symlink.
     376           0 :                   (pcase old-type
     377             :                     (?\100 "   (type change file -> symlink)")
     378             :                     (?\160 "   (type change subproject -> symlink)")
     379           0 :                     (_ "   (symlink)")))
     380             :                   (?\160  ;; Subproject.
     381           0 :                    (pcase old-type
     382             :                      (?\100 "   (type change file -> subproject)")
     383             :                      (?\120 "   (type change symlink -> subproject)")
     384           0 :                      (_ "   (subproject)")))
     385             :                   (?\110 nil)  ;; Directory (internal, not a real git state).
     386             :                   (?\000  ;; Deleted or unknown.
     387           0 :                    (pcase old-type
     388             :                      (?\120 "   (symlink)")
     389           0 :                      (?\160 "   (subproject)")))
     390           0 :                   (_ (format "   (unknown type %o)" new-type)))))
     391           0 :     (cond (str (propertize str 'face 'font-lock-comment-face))
     392           0 :           ((eq new-type ?\110) "/")
     393           0 :           (t ""))))
     394             : 
     395             : (defun vc-git-rename-as-string (state extra)
     396             :   "Return a string describing the copy or rename associated with INFO,
     397             : or an empty string if none."
     398           0 :   (let ((rename-state (when extra
     399           0 :                         (vc-git-extra-fileinfo->rename-state extra))))
     400           0 :     (if rename-state
     401           0 :         (propertize
     402           0 :          (concat "   ("
     403           0 :                  (if (eq rename-state 'copy) "copied from "
     404           0 :                    (if (eq state 'added) "renamed from "
     405           0 :                      "renamed to "))
     406           0 :                  (vc-git-escape-file-name
     407           0 :                   (vc-git-extra-fileinfo->orig-name extra))
     408           0 :                  ")")
     409           0 :          'face 'font-lock-comment-face)
     410           0 :       "")))
     411             : 
     412             : (defun vc-git-permissions-as-string (old-perm new-perm)
     413             :   "Format a permission change as string."
     414           0 :   (propertize
     415           0 :    (if (or (not old-perm)
     416           0 :            (not new-perm)
     417           0 :            (eq 0 (logand ?\111 (logxor old-perm new-perm))))
     418             :        "  "
     419           0 :      (if (eq 0 (logand ?\111 old-perm)) "+x" "-x"))
     420           0 :   'face 'font-lock-type-face))
     421             : 
     422             : (defun vc-git-dir-printer (info)
     423             :   "Pretty-printer for the vc-dir-fileinfo structure."
     424           0 :   (let* ((isdir (vc-dir-fileinfo->directory info))
     425           0 :          (state (if isdir "" (vc-dir-fileinfo->state info)))
     426           0 :          (extra (vc-dir-fileinfo->extra info))
     427           0 :          (old-perm (when extra (vc-git-extra-fileinfo->old-perm extra)))
     428           0 :          (new-perm (when extra (vc-git-extra-fileinfo->new-perm extra))))
     429           0 :     (insert
     430             :      "  "
     431           0 :      (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? ))
     432           0 :                  'face 'font-lock-type-face)
     433             :      "  "
     434           0 :      (propertize
     435           0 :       (format "%-12s" state)
     436           0 :       'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face)
     437           0 :                   ((eq state 'missing) 'font-lock-warning-face)
     438           0 :                   (t 'font-lock-variable-name-face))
     439           0 :       'mouse-face 'highlight)
     440           0 :      "  " (vc-git-permissions-as-string old-perm new-perm)
     441             :      "    "
     442           0 :      (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info))
     443           0 :                  'face (if isdir 'font-lock-comment-delimiter-face
     444           0 :                          'font-lock-function-name-face)
     445             :                  'help-echo
     446           0 :                  (if isdir
     447             :                      "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu"
     448           0 :                    "File\nmouse-3: Pop-up menu")
     449           0 :                  'keymap vc-dir-filename-mouse-map
     450           0 :                  'mouse-face 'highlight)
     451           0 :      (vc-git-file-type-as-string old-perm new-perm)
     452           0 :      (vc-git-rename-as-string state extra))))
     453             : 
     454             : (cl-defstruct (vc-git-dir-status-state
     455             :                (:copier nil)
     456             :                (:conc-name vc-git-dir-status-state->))
     457             :   ;; Current stage.
     458             :   stage
     459             :   ;; List of files still to be processed.
     460             :   files
     461             :   ;; Update function to be called at the end.
     462             :   update-function
     463             :   ;; Hash table of entries for files we've computed so far.
     464           0 :   (hash (make-hash-table :test 'equal)))
     465             : 
     466             : (defsubst vc-git-dir-status-update-file (state filename file-state file-info)
     467           0 :   (puthash filename (list file-state file-info)
     468           0 :            (vc-git-dir-status-state->hash state))
     469           0 :   (setf (vc-git-dir-status-state->files state)
     470           0 :         (delete filename (vc-git-dir-status-state->files state))))
     471             : 
     472             : (defun vc-git-after-dir-status-stage (git-state)
     473             :   "Process sentinel for the various dir-status stages."
     474           0 :   (let (next-stage
     475           0 :         (files (vc-git-dir-status-state->files git-state)))
     476           0 :     (goto-char (point-min))
     477           0 :     (pcase (vc-git-dir-status-state->stage git-state)
     478             :       (`update-index
     479           0 :        (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added 'diff-index)))
     480             :       (`ls-files-added
     481           0 :        (setq next-stage 'ls-files-unknown)
     482           0 :        (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
     483           0 :          (let ((new-perm (string-to-number (match-string 1) 8))
     484           0 :                (name (match-string 2)))
     485           0 :            (vc-git-dir-status-update-file
     486           0 :             git-state name 'added
     487           0 :             (vc-git-create-extra-fileinfo 0 new-perm)))))
     488             :       (`ls-files-up-to-date
     489           0 :        (setq next-stage 'ls-files-unknown)
     490           0 :        (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} \\([0-3]\\)\t\\([^\0]+\\)\0" nil t)
     491           0 :          (let ((perm (string-to-number (match-string 1) 8))
     492           0 :                (state (match-string 2))
     493           0 :                (name (match-string 3)))
     494           0 :            (vc-git-dir-status-update-file
     495           0 :             git-state name (if (equal state "0")
     496             :                                'up-to-date
     497           0 :                              'conflict)
     498           0 :             (vc-git-create-extra-fileinfo perm perm)))))
     499             :       (`ls-files-conflict
     500           0 :        (setq next-stage 'ls-files-unknown)
     501             :        ;; It's enough to look for "3" to notice a conflict.
     502           0 :        (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 3\t\\([^\0]+\\)\0" nil t)
     503           0 :          (let ((perm (string-to-number (match-string 1) 8))
     504           0 :                (name (match-string 2)))
     505           0 :            (vc-git-dir-status-update-file
     506           0 :             git-state name 'conflict
     507           0 :             (vc-git-create-extra-fileinfo perm perm)))))
     508             :       (`ls-files-unknown
     509           0 :        (when files (setq next-stage 'ls-files-ignored))
     510           0 :        (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
     511           0 :          (vc-git-dir-status-update-file git-state (match-string 1) 'unregistered
     512           0 :                                         (vc-git-create-extra-fileinfo 0 0))))
     513             :       (`ls-files-ignored
     514           0 :        (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1)
     515           0 :          (vc-git-dir-status-update-file git-state (match-string 1) 'ignored
     516           0 :                                         (vc-git-create-extra-fileinfo 0 0))))
     517             :       (`diff-index
     518           0 :        (setq next-stage (if files 'ls-files-up-to-date 'ls-files-conflict))
     519           0 :        (while (re-search-forward
     520             :                ":\\([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"
     521           0 :                nil t 1)
     522           0 :          (let ((old-perm (string-to-number (match-string 1) 8))
     523           0 :                (new-perm (string-to-number (match-string 2) 8))
     524           0 :                (state (or (match-string 4) (match-string 6)))
     525           0 :                (name (or (match-string 5) (match-string 7)))
     526           0 :                (new-name (match-string 8)))
     527           0 :            (if new-name  ; Copy or rename.
     528           0 :                (if (eq ?C (string-to-char state))
     529           0 :                    (vc-git-dir-status-update-file
     530           0 :                     git-state new-name 'added
     531           0 :                     (vc-git-create-extra-fileinfo old-perm new-perm
     532           0 :                                                   'copy name))
     533           0 :                  (vc-git-dir-status-update-file
     534           0 :                   git-state name 'removed
     535           0 :                   (vc-git-create-extra-fileinfo 0 0 'rename new-name))
     536           0 :                  (vc-git-dir-status-update-file
     537           0 :                   git-state new-name 'added
     538           0 :                   (vc-git-create-extra-fileinfo old-perm new-perm
     539           0 :                                                 'rename name)))
     540           0 :              (vc-git-dir-status-update-file
     541           0 :               git-state name (vc-git--state-code state)
     542           0 :               (vc-git-create-extra-fileinfo old-perm new-perm)))))))
     543             :     ;; If we had files but now we don't, it's time to stop.
     544           0 :     (when (and files (not (vc-git-dir-status-state->files git-state)))
     545           0 :       (setq next-stage nil))
     546           0 :     (setf (vc-git-dir-status-state->stage git-state) next-stage)
     547           0 :     (setf (vc-git-dir-status-state->files git-state) files)
     548           0 :     (if next-stage
     549           0 :         (vc-git-dir-status-goto-stage git-state)
     550           0 :       (funcall (vc-git-dir-status-state->update-function git-state)
     551           0 :                (let ((result nil))
     552           0 :                  (maphash (lambda (key value)
     553           0 :                             (push (cons key value) result))
     554           0 :                           (vc-git-dir-status-state->hash git-state))
     555           0 :                  result)
     556           0 :                nil))))
     557             : 
     558             : ;; Follows vc-git-command (or vc-do-async-command), which uses vc-do-command
     559             : ;; from vc-dispatcher.
     560             : (declare-function vc-exec-after "vc-dispatcher" (code))
     561             : ;; Follows vc-exec-after.
     562             : (declare-function vc-set-async-update "vc-dispatcher" (process-buffer))
     563             : 
     564             : (defun vc-git-dir-status-goto-stage (git-state)
     565           0 :   (let ((files (vc-git-dir-status-state->files git-state)))
     566           0 :     (erase-buffer)
     567           0 :     (pcase (vc-git-dir-status-state->stage git-state)
     568             :       (`update-index
     569           0 :        (if files
     570           0 :            (vc-git-command (current-buffer) 'async files "add" "--refresh" "--")
     571           0 :          (vc-git-command (current-buffer) 'async nil
     572           0 :                          "update-index" "--refresh")))
     573             :       (`ls-files-added
     574           0 :        (vc-git-command (current-buffer) 'async files
     575           0 :                        "ls-files" "-z" "-c" "-s" "--"))
     576             :       (`ls-files-up-to-date
     577           0 :        (vc-git-command (current-buffer) 'async files
     578           0 :                        "ls-files" "-z" "-c" "-s" "--"))
     579             :       (`ls-files-conflict
     580           0 :        (vc-git-command (current-buffer) 'async files
     581           0 :                        "ls-files" "-z" "-c" "-s" "--"))
     582             :       (`ls-files-unknown
     583           0 :        (vc-git-command (current-buffer) 'async files
     584             :                        "ls-files" "-z" "-o" "--directory"
     585           0 :                        "--no-empty-directory" "--exclude-standard" "--"))
     586             :       (`ls-files-ignored
     587           0 :        (vc-git-command (current-buffer) 'async files
     588             :                        "ls-files" "-z" "-o" "-i" "--directory"
     589           0 :                        "--no-empty-directory" "--exclude-standard" "--"))
     590             :       ;; --relative added in Git 1.5.5.
     591             :       (`diff-index
     592           0 :        (vc-git-command (current-buffer) 'async files
     593           0 :                        "diff-index" "--relative" "-z" "-M" "HEAD" "--")))
     594           0 :     (vc-run-delayed
     595           0 :       (vc-git-after-dir-status-stage git-state))))
     596             : 
     597             : (defun vc-git-dir-status-files (_dir files update-function)
     598             :   "Return a list of (FILE STATE EXTRA) entries for DIR."
     599             :   ;; Further things that would have to be fixed later:
     600             :   ;; - how to handle unregistered directories
     601             :   ;; - how to support vc-dir on a subdir of the project tree
     602           0 :   (vc-git-dir-status-goto-stage
     603           0 :    (make-vc-git-dir-status-state :stage 'update-index
     604           0 :                                  :files files
     605           0 :                                  :update-function update-function)))
     606             : 
     607             : (defvar vc-git-stash-map
     608             :   (let ((map (make-sparse-keymap)))
     609             :     ;; Turn off vc-dir marking
     610             :     (define-key map [mouse-2] 'ignore)
     611             : 
     612             :     (define-key map [down-mouse-3] 'vc-git-stash-menu)
     613             :     (define-key map "\C-k" 'vc-git-stash-delete-at-point)
     614             :     (define-key map "=" 'vc-git-stash-show-at-point)
     615             :     (define-key map "\C-m" 'vc-git-stash-show-at-point)
     616             :     (define-key map "A" 'vc-git-stash-apply-at-point)
     617             :     (define-key map "P" 'vc-git-stash-pop-at-point)
     618             :     (define-key map "S" 'vc-git-stash-snapshot)
     619             :     map))
     620             : 
     621             : (defvar vc-git-stash-menu-map
     622             :   (let ((map (make-sparse-keymap "Git Stash")))
     623             :     (define-key map [de]
     624             :       '(menu-item "Delete Stash" vc-git-stash-delete-at-point
     625             :                   :help "Delete the current stash"))
     626             :     (define-key map [ap]
     627             :       '(menu-item "Apply Stash" vc-git-stash-apply-at-point
     628             :                   :help "Apply the current stash and keep it in the stash list"))
     629             :     (define-key map [po]
     630             :       '(menu-item "Apply and Remove Stash (Pop)" vc-git-stash-pop-at-point
     631             :                   :help "Apply the current stash and remove it"))
     632             :     (define-key map [sh]
     633             :       '(menu-item "Show Stash" vc-git-stash-show-at-point
     634             :                   :help "Show the contents of the current stash"))
     635             :     map))
     636             : 
     637             : (defun vc-git-dir-extra-headers (dir)
     638           0 :   (let ((str (with-output-to-string
     639           0 :                (with-current-buffer standard-output
     640           0 :                  (vc-git--out-ok "symbolic-ref" "HEAD"))))
     641           0 :         (stash (vc-git-stash-list))
     642             :         (stash-help-echo "Use M-x vc-git-stash to create stashes.")
     643             :         branch remote remote-url)
     644           0 :     (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
     645           0 :         (progn
     646           0 :           (setq branch (match-string 2 str))
     647           0 :           (setq remote
     648           0 :                 (with-output-to-string
     649           0 :                   (with-current-buffer standard-output
     650           0 :                     (vc-git--out-ok "config"
     651           0 :                                     (concat "branch." branch ".remote")))))
     652           0 :           (when (string-match "\\([^\n]+\\)" remote)
     653           0 :             (setq remote (match-string 1 remote)))
     654           0 :           (when remote
     655           0 :             (setq remote-url
     656           0 :                   (with-output-to-string
     657           0 :                     (with-current-buffer standard-output
     658           0 :                       (vc-git--out-ok "config"
     659           0 :                                       (concat "remote." remote ".url"))))))
     660           0 :           (when (string-match "\\([^\n]+\\)" remote-url)
     661           0 :             (setq remote-url (match-string 1 remote-url))))
     662           0 :       (setq branch "not (detached HEAD)"))
     663             :     ;; FIXME: maybe use a different face when nothing is stashed.
     664           0 :     (concat
     665           0 :      (propertize "Branch     : " 'face 'font-lock-type-face)
     666           0 :      (propertize branch
     667           0 :                  'face 'font-lock-variable-name-face)
     668           0 :      (when remote
     669           0 :        (concat
     670             :         "\n"
     671           0 :         (propertize "Remote     : " 'face 'font-lock-type-face)
     672           0 :         (propertize remote-url
     673           0 :                     'face 'font-lock-variable-name-face)))
     674             :      "\n"
     675             :      ;; For now just a heading, key bindings can be added later for various bisect actions
     676           0 :      (when (file-exists-p (expand-file-name ".git/BISECT_START" (vc-git-root dir)))
     677           0 :        (propertize  "Bisect     : in progress\n" 'face 'font-lock-warning-face))
     678           0 :      (when (file-exists-p (expand-file-name ".git/rebase-apply" (vc-git-root dir)))
     679           0 :        (propertize  "Rebase     : in progress\n" 'face 'font-lock-warning-face))
     680           0 :      (if stash
     681           0 :        (concat
     682           0 :         (propertize "Stash      :\n" 'face 'font-lock-type-face
     683           0 :                     'help-echo stash-help-echo)
     684           0 :         (mapconcat
     685             :          (lambda (x)
     686           0 :            (propertize x
     687             :                        'face 'font-lock-variable-name-face
     688             :                        'mouse-face 'highlight
     689             :                        'help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash"
     690           0 :                        'keymap vc-git-stash-map))
     691           0 :          stash "\n"))
     692           0 :        (concat
     693           0 :         (propertize "Stash      : " 'face 'font-lock-type-face
     694           0 :                     'help-echo stash-help-echo)
     695           0 :         (propertize "Nothing stashed"
     696           0 :                     'help-echo stash-help-echo
     697           0 :                     'face 'font-lock-variable-name-face))))))
     698             : 
     699             : (defun vc-git-branches ()
     700             :   "Return the existing branches, as a list of strings.
     701             : The car of the list is the current branch."
     702           0 :   (with-temp-buffer
     703           0 :     (vc-git--call t "branch")
     704           0 :     (goto-char (point-min))
     705           0 :     (let (current-branch branches)
     706           0 :       (while (not (eobp))
     707           0 :         (when (looking-at "^\\([ *]\\) \\(.+\\)$")
     708           0 :           (if (string-equal (match-string 1) "*")
     709           0 :               (setq current-branch (match-string 2))
     710           0 :             (push (match-string 2) branches)))
     711           0 :         (forward-line 1))
     712           0 :       (cons current-branch (nreverse branches)))))
     713             : 
     714             : ;;; STATE-CHANGING FUNCTIONS
     715             : 
     716             : (defun vc-git-create-repo ()
     717             :   "Create a new Git repository."
     718           0 :   (vc-git-command nil 0 nil "init"))
     719             : 
     720             : (defun vc-git-register (files &optional _comment)
     721             :   "Register FILES into the git version-control system."
     722           0 :   (let (flist dlist)
     723           0 :     (dolist (crt files)
     724           0 :       (if (file-directory-p crt)
     725           0 :           (push crt dlist)
     726           0 :         (push crt flist)))
     727           0 :     (when flist
     728           0 :       (vc-git-command nil 0 flist "update-index" "--add" "--"))
     729           0 :     (when dlist
     730           0 :       (vc-git-command nil 0 dlist "add"))))
     731             : 
     732             : (defalias 'vc-git-responsible-p 'vc-git-root)
     733             : 
     734             : (defun vc-git-unregister (file)
     735           0 :   (vc-git-command nil 0 file "rm" "-f" "--cached" "--"))
     736             : 
     737             : (declare-function log-edit-mode "log-edit" ())
     738             : (declare-function log-edit-toggle-header "log-edit" (header value))
     739             : (declare-function log-edit-extract-headers "log-edit" (headers string))
     740             : (declare-function log-edit-set-header "log-edit" (header value &optional toggle))
     741             : 
     742             : (defun vc-git-log-edit-toggle-signoff ()
     743             :   "Toggle whether to add the \"Signed-off-by\" line at the end of
     744             : the commit message."
     745             :   (interactive)
     746           0 :   (log-edit-toggle-header "Sign-Off" "yes"))
     747             : 
     748             : (defun vc-git-log-edit-toggle-amend ()
     749             :   "Toggle whether this will amend the previous commit.
     750             : If toggling on, also insert its message into the buffer."
     751             :   (interactive)
     752           0 :   (when (log-edit-toggle-header "Amend" "yes")
     753           0 :     (goto-char (point-max))
     754           0 :     (unless (bolp) (insert "\n"))
     755           0 :     (insert (with-output-to-string
     756           0 :               (vc-git-command
     757           0 :                standard-output 1 nil
     758           0 :                "log" "--max-count=1" "--pretty=format:%B" "HEAD")))
     759           0 :     (save-excursion
     760           0 :       (rfc822-goto-eoh)
     761           0 :       (forward-line 1)
     762           0 :       (let ((pt (point)))
     763           0 :         (and (zerop (forward-line 1))
     764           0 :              (looking-at "\n\\|\\'")
     765           0 :              (let ((summary (buffer-substring-no-properties pt (1- (point)))))
     766           0 :                (skip-chars-forward " \n")
     767           0 :                (delete-region pt (point))
     768           0 :                (log-edit-set-header "Summary" summary)))))))
     769             : 
     770             : (defvar vc-git-log-edit-mode-map
     771             :   (let ((map (make-sparse-keymap "Git-Log-Edit")))
     772             :     (define-key map "\C-c\C-s" 'vc-git-log-edit-toggle-signoff)
     773             :     (define-key map "\C-c\C-e" 'vc-git-log-edit-toggle-amend)
     774             :     map))
     775             : 
     776             : (define-derived-mode vc-git-log-edit-mode log-edit-mode "Log-Edit/git"
     777             :   "Major mode for editing Git log messages.
     778             : It is based on `log-edit-mode', and has Git-specific extensions.")
     779             : 
     780             : (defun vc-git-checkin (files comment &optional _rev)
     781           0 :   (let* ((file1 (or (car files) default-directory))
     782           0 :          (root (vc-git-root file1))
     783           0 :          (default-directory (expand-file-name root))
     784           0 :          (only (or (cdr files)
     785           0 :                    (not (equal root (abbreviate-file-name file1)))))
     786           0 :          (pcsw coding-system-for-write)
     787             :          (coding-system-for-write
     788             :           ;; On MS-Windows, we must encode command-line arguments in
     789             :           ;; the system codepage.
     790           0 :           (if (eq system-type 'windows-nt)
     791           0 :               locale-coding-system
     792           0 :             (or coding-system-for-write vc-git-commits-coding-system)))
     793             :          (msg-file
     794             :           ;; On MS-Windows, pass the commit log message through a
     795             :           ;; file, to work around the limitation that command-line
     796             :           ;; arguments must be in the system codepage, and therefore
     797             :           ;; might not support the non-ASCII characters in the log
     798             :           ;; message.  Handle also remote files.
     799           0 :           (if (eq system-type 'windows-nt)
     800           0 :               (let ((default-directory (file-name-directory file1)))
     801           0 :                 (make-nearby-temp-file "git-msg")))))
     802           0 :     (cl-flet ((boolean-arg-fn
     803             :                (argument)
     804           0 :                (lambda (value) (when (equal value "yes") (list argument)))))
     805             :       ;; When operating on the whole tree, better pass "-a" than ".", since "."
     806             :       ;; fails when we're committing a merge.
     807           0 :       (apply 'vc-git-command nil 0 (if only files)
     808           0 :              (nconc (if msg-file (list "commit" "-F"
     809           0 :                                        (file-local-name msg-file))
     810           0 :                       (list "commit" "-m"))
     811           0 :                     (let ((args
     812           0 :                            (log-edit-extract-headers
     813           0 :                             `(("Author" . "--author")
     814             :                               ("Date" . "--date")
     815           0 :                               ("Amend" . ,(boolean-arg-fn "--amend"))
     816           0 :                               ("Sign-Off" . ,(boolean-arg-fn "--signoff")))
     817           0 :                             comment)))
     818           0 :                       (when msg-file
     819           0 :                         (let ((coding-system-for-write
     820           0 :                                (or pcsw vc-git-commits-coding-system)))
     821           0 :                           (write-region (car args) nil msg-file))
     822           0 :                         (setq args (cdr args)))
     823           0 :                       args)
     824           0 :                     (if only (list "--only" "--") '("-a")))))
     825           0 :     (if (and msg-file (file-exists-p msg-file)) (delete-file msg-file))))
     826             : 
     827             : (defun vc-git-find-revision (file rev buffer)
     828           0 :   (let* (process-file-side-effects
     829             :          (coding-system-for-read 'binary)
     830             :          (coding-system-for-write 'binary)
     831             :          (fullname
     832           0 :           (let ((fn (vc-git--run-command-string
     833           0 :                      file "ls-files" "-z" "--full-name" "--")))
     834             :             ;; ls-files does not return anything when looking for a
     835             :             ;; revision of a file that has been renamed or removed.
     836           0 :             (if (string= fn "")
     837           0 :                 (file-relative-name file (vc-git-root default-directory))
     838           0 :               (substring fn 0 -1)))))
     839           0 :     (vc-git-command
     840           0 :      buffer 0
     841             :      nil
     842           0 :      "cat-file" "blob" (concat (if rev rev "HEAD") ":" fullname))))
     843             : 
     844             : (defun vc-git-find-ignore-file (file)
     845             :   "Return the git ignore file that controls FILE."
     846           0 :   (expand-file-name ".gitignore"
     847           0 :                     (vc-git-root file)))
     848             : 
     849             : (defun vc-git-checkout (file &optional rev)
     850           0 :   (vc-git-command nil 0 file "checkout" (or rev "HEAD")))
     851             : 
     852             : (defun vc-git-revert (file &optional contents-done)
     853             :   "Revert FILE to the version stored in the git repository."
     854           0 :   (if contents-done
     855           0 :       (vc-git-command nil 0 file "update-index" "--")
     856           0 :     (vc-git-command nil 0 file "reset" "-q" "--")
     857           0 :     (vc-git-command nil nil file "checkout" "-q" "--")))
     858             : 
     859             : (defvar vc-git-error-regexp-alist
     860             :   '(("^ \\(.+\\) |" 1 nil nil 0))
     861             :   "Value of `compilation-error-regexp-alist' in *vc-git* buffers.")
     862             : 
     863             : ;; To be called via vc-pull from vc.el, which requires vc-dispatcher.
     864             : (declare-function vc-compilation-mode "vc-dispatcher" (backend))
     865             : 
     866             : (defun vc-git--pushpull (command prompt)
     867             :   "Run COMMAND (a string; either push or pull) on the current Git branch.
     868             : If PROMPT is non-nil, prompt for the Git command to run."
     869           0 :   (let* ((root (vc-git-root default-directory))
     870           0 :          (buffer (format "*vc-git : %s*" (expand-file-name root)))
     871           0 :          (git-program vc-git-program)
     872             :          args)
     873             :     ;; If necessary, prompt for the exact command.
     874             :     ;; TODO if pushing, prompt if no default push location - cf bzr.
     875           0 :     (when prompt
     876           0 :       (setq args (split-string
     877           0 :                   (read-shell-command
     878           0 :                    (format "Git %s command: " command)
     879           0 :                    (format "%s %s" git-program command)
     880           0 :                    'vc-git-history)
     881           0 :                   " " t))
     882           0 :       (setq git-program (car  args)
     883           0 :             command     (cadr args)
     884           0 :             args        (cddr args)))
     885           0 :     (require 'vc-dispatcher)
     886           0 :     (apply 'vc-do-async-command buffer root git-program command args)
     887           0 :     (with-current-buffer buffer
     888           0 :       (vc-run-delayed
     889           0 :         (vc-compilation-mode 'git)
     890           0 :         (setq-local compile-command
     891           0 :                     (concat git-program " " command " "
     892           0 :                             (if args (mapconcat 'identity args " ") "")))
     893           0 :         (setq-local compilation-directory root)
     894             :         ;; Either set `compilation-buffer-name-function' locally to nil
     895             :         ;; or use `compilation-arguments' to set `name-function'.
     896             :         ;; See `compilation-buffer-name'.
     897           0 :         (setq-local compilation-arguments
     898           0 :                     (list compile-command nil
     899           0 :                           (lambda (_name-of-mode) buffer)
     900           0 :                           nil))))
     901           0 :     (vc-set-async-update buffer)))
     902             : 
     903             : (defun vc-git-pull (prompt)
     904             :   "Pull changes into the current Git branch.
     905             : Normally, this runs \"git pull\".  If PROMPT is non-nil, prompt
     906             : for the Git command to run."
     907           0 :   (vc-git--pushpull "pull" prompt))
     908             : 
     909             : (defun vc-git-push (prompt)
     910             :   "Push changes from the current Git branch.
     911             : Normally, this runs \"git push\".  If PROMPT is non-nil, prompt
     912             : for the Git command to run."
     913           0 :   (vc-git--pushpull "push" prompt))
     914             : 
     915             : (defun vc-git-merge-branch ()
     916             :   "Merge changes into the current Git branch.
     917             : This prompts for a branch to merge from."
     918           0 :   (let* ((root (vc-git-root default-directory))
     919           0 :          (buffer (format "*vc-git : %s*" (expand-file-name root)))
     920           0 :          (branches (cdr (vc-git-branches)))
     921             :          (merge-source
     922           0 :           (completing-read "Merge from branch: "
     923           0 :                            (if (or (member "FETCH_HEAD" branches)
     924           0 :                                    (not (file-readable-p
     925           0 :                                          (expand-file-name ".git/FETCH_HEAD"
     926           0 :                                                            root))))
     927           0 :                                branches
     928           0 :                              (cons "FETCH_HEAD" branches))
     929           0 :                            nil t)))
     930           0 :     (apply 'vc-do-async-command buffer root vc-git-program "merge"
     931           0 :            (list merge-source))
     932           0 :     (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'git)))
     933           0 :     (vc-set-async-update buffer)))
     934             : 
     935             : (defun vc-git-conflicted-files (directory)
     936             :   "Return the list of files with conflicts in DIRECTORY."
     937          40 :   (let* ((status
     938          40 :           (vc-git--run-command-string directory "status" "--porcelain" "--"))
     939          40 :          (lines (when status (split-string status "\n" 'omit-nulls)))
     940             :          files)
     941             :     ;; TODO: Look into reimplementing `vc-git-state', as well as
     942             :     ;; `vc-git-dir-status-files', based on this output, thus making the
     943             :     ;; extra process call in `vc-git-find-file-hook' unnecessary.
     944          40 :     (dolist (line lines files)
     945           0 :       (when (string-match "\\([ MADRCU?!][ MADRCU?!]\\) \\(.+\\)\\(?: -> \\(.+\\)\\)?"
     946           0 :                           line)
     947           0 :         (let ((state (match-string 1 line))
     948           0 :               (file (match-string 2 line)))
     949             :           ;; See git-status(1).
     950           0 :           (when (member state '("AU" "UD" "UA" ;; "DD"
     951           0 :                                 "DU" "AA" "UU"))
     952          40 :             (push (expand-file-name file directory) files)))))))
     953             : 
     954             : (defun vc-git-resolve-when-done ()
     955             :   "Call \"git add\" if the conflict markers have been removed."
     956           0 :   (save-excursion
     957           0 :     (goto-char (point-min))
     958           0 :     (unless (re-search-forward "^<<<<<<< " nil t)
     959           0 :       (vc-git-command nil 0 buffer-file-name "add")
     960           0 :       (unless (or
     961           0 :                (not (eq vc-git-resolve-conflicts 'unstage-maybe))
     962             :                ;; Doing a merge, so bug#20292 doesn't apply.
     963           0 :                (file-exists-p (expand-file-name ".git/MERGE_HEAD"
     964           0 :                                                 (vc-git-root buffer-file-name)))
     965           0 :                (vc-git-conflicted-files (vc-git-root buffer-file-name)))
     966           0 :         (vc-git-command nil 0 nil "reset"))
     967             :       ;; Remove the hook so that it is not called multiple times.
     968           0 :       (remove-hook 'after-save-hook 'vc-git-resolve-when-done t))))
     969             : 
     970             : (defun vc-git-find-file-hook ()
     971             :   "Activate `smerge-mode' if there is a conflict."
     972          40 :   (when (and buffer-file-name
     973             :              ;; FIXME
     974             :              ;; 1) the net result is to call git twice per file.
     975             :              ;; 2) v-g-c-f is documented to take a directory.
     976             :              ;; http://lists.gnu.org/archive/html/emacs-devel/2014-01/msg01126.html
     977          40 :              (vc-git-conflicted-files buffer-file-name)
     978           0 :              (save-excursion
     979           0 :                (goto-char (point-min))
     980          40 :                (re-search-forward "^<<<<<<< " nil 'noerror)))
     981           0 :     (vc-file-setprop buffer-file-name 'vc-state 'conflict)
     982           0 :     (smerge-start-session)
     983           0 :     (when vc-git-resolve-conflicts
     984           0 :       (add-hook 'after-save-hook 'vc-git-resolve-when-done nil 'local))
     985          40 :     (vc-message-unresolved-conflicts buffer-file-name)))
     986             : 
     987             : ;;; HISTORY FUNCTIONS
     988             : 
     989             : (autoload 'vc-setup-buffer "vc-dispatcher")
     990             : 
     991             : (defcustom vc-git-print-log-follow nil
     992             :   "If true, follow renames in Git logs for files."
     993             :   :type 'boolean
     994             :   :version "26.1")
     995             : 
     996             : (defun vc-git-print-log (files buffer &optional shortlog start-revision limit)
     997             :   "Print commit log associated with FILES into specified BUFFER.
     998             : If SHORTLOG is non-nil, use a short format based on `vc-git-root-log-format'.
     999             : \(This requires at least Git version 1.5.6, for the --graph option.)
    1000             : If START-REVISION is non-nil, it is the newest revision to show.
    1001             : If LIMIT is non-nil, show no more than this many entries."
    1002           0 :   (let ((coding-system-for-read
    1003           0 :          (or coding-system-for-read vc-git-log-output-coding-system)))
    1004             :     ;; `vc-do-command' creates the buffer, but we need it before running
    1005             :     ;; the command.
    1006           0 :     (vc-setup-buffer buffer)
    1007             :     ;; If the buffer exists from a previous invocation it might be
    1008             :     ;; read-only.
    1009           0 :     (let ((inhibit-read-only t))
    1010           0 :       (with-current-buffer
    1011           0 :           buffer
    1012           0 :         (apply 'vc-git-command buffer
    1013           0 :                'async files
    1014           0 :                (append
    1015             :                 '("log" "--no-color")
    1016           0 :                 (when (and vc-git-print-log-follow
    1017           0 :                            (not (cl-some #'file-directory-p files)))
    1018             :                   ;; "--follow" on directories is broken
    1019             :                   ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=8756
    1020             :                   ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=16422
    1021           0 :                   (list "--follow"))
    1022           0 :                 (when shortlog
    1023           0 :                   `("--graph" "--decorate" "--date=short"
    1024           0 :                     ,(format "--pretty=tformat:%s"
    1025           0 :                              (car vc-git-root-log-format))
    1026           0 :                     "--abbrev-commit"))
    1027           0 :                 (when limit (list "-n" (format "%s" limit)))
    1028           0 :                 (when start-revision (list start-revision))
    1029           0 :                 '("--")))))))
    1030             : 
    1031             : (defun vc-git-log-outgoing (buffer remote-location)
    1032             :   (interactive)
    1033           0 :   (vc-git-command
    1034           0 :    buffer 'async nil
    1035             :    "log"
    1036             :    "--no-color" "--graph" "--decorate" "--date=short"
    1037           0 :    (format "--pretty=tformat:%s" (car vc-git-root-log-format))
    1038             :    "--abbrev-commit"
    1039           0 :    (concat (if (string= remote-location "")
    1040             :                "@{upstream}"
    1041           0 :              remote-location)
    1042           0 :            "..HEAD")))
    1043             : 
    1044             : (defun vc-git-log-incoming (buffer remote-location)
    1045             :   (interactive)
    1046           0 :   (vc-git-command nil 0 nil "fetch")
    1047           0 :   (vc-git-command
    1048           0 :    buffer 'async nil
    1049             :    "log"
    1050             :    "--no-color" "--graph" "--decorate" "--date=short"
    1051           0 :    (format "--pretty=tformat:%s" (car vc-git-root-log-format))
    1052             :    "--abbrev-commit"
    1053           0 :    (concat "HEAD.." (if (string= remote-location "")
    1054             :                         "@{upstream}"
    1055           0 :                       remote-location))))
    1056             : 
    1057             : (defvar log-view-message-re)
    1058             : (defvar log-view-file-re)
    1059             : (defvar log-view-font-lock-keywords)
    1060             : (defvar log-view-per-file-logs)
    1061             : (defvar log-view-expanded-log-entry-function)
    1062             : 
    1063             : (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View"
    1064           0 :   (require 'add-log) ;; We need the faces add-log.
    1065             :   ;; Don't have file markers, so use impossible regexp.
    1066           0 :   (set (make-local-variable 'log-view-file-re) "\\`a\\`")
    1067           0 :   (set (make-local-variable 'log-view-per-file-logs) nil)
    1068           0 :   (set (make-local-variable 'log-view-message-re)
    1069           0 :        (if (not (eq vc-log-view-type 'long))
    1070           0 :            (cadr vc-git-root-log-format)
    1071           0 :          "^commit *\\([0-9a-z]+\\)"))
    1072             :   ;; Allow expanding short log entries.
    1073           0 :   (when (memq vc-log-view-type '(short log-outgoing log-incoming))
    1074           0 :     (setq truncate-lines t)
    1075           0 :     (set (make-local-variable 'log-view-expanded-log-entry-function)
    1076           0 :          'vc-git-expanded-log-entry))
    1077           0 :   (set (make-local-variable 'log-view-font-lock-keywords)
    1078           0 :        (if (not (eq vc-log-view-type 'long))
    1079           0 :            (list (cons (nth 1 vc-git-root-log-format)
    1080           0 :                        (nth 2 vc-git-root-log-format)))
    1081           0 :          (append
    1082           0 :           `((,log-view-message-re (1 'change-log-acknowledgment)))
    1083             :           ;; Handle the case:
    1084             :           ;; user: foo@bar
    1085             :           '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
    1086             :              (1 'change-log-email))
    1087             :             ;; Handle the case:
    1088             :             ;; user: FirstName LastName <foo@bar>
    1089             :             ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
    1090             :              (1 'change-log-name)
    1091             :              (2 'change-log-email))
    1092             :             ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)"
    1093             :              (1 'change-log-name))
    1094             :             ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]"
    1095             :              (1 'change-log-name)
    1096             :              (2 'change-log-email))
    1097             :             ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)"
    1098             :              (1 'change-log-acknowledgment)
    1099             :              (2 'change-log-acknowledgment))
    1100             :             ("^Date:   \\(.+\\)" (1 'change-log-date))
    1101           0 :             ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message)))))))
    1102             : 
    1103             : 
    1104             : (defun vc-git-show-log-entry (revision)
    1105             :   "Move to the log entry for REVISION.
    1106             : REVISION may have the form BRANCH, BRANCH~N,
    1107             : or BRANCH^ (where \"^\" can be repeated)."
    1108           0 :   (goto-char (point-min))
    1109           0 :   (prog1
    1110           0 :       (when revision
    1111           0 :         (search-forward
    1112           0 :          (format "\ncommit %s" revision) nil t
    1113           0 :          (cond ((string-match "~\\([0-9]\\)\\'" revision)
    1114           0 :                 (1+ (string-to-number (match-string 1 revision))))
    1115           0 :                ((string-match "\\^+\\'" revision)
    1116           0 :                 (1+ (length (match-string 0 revision))))
    1117           0 :                (t nil))))
    1118           0 :     (beginning-of-line)))
    1119             : 
    1120             : (defun vc-git-expanded-log-entry (revision)
    1121           0 :   (with-temp-buffer
    1122           0 :     (apply 'vc-git-command t nil nil (list "log" revision "-1" "--"))
    1123           0 :     (goto-char (point-min))
    1124           0 :     (unless (eobp)
    1125             :       ;; Indent the expanded log entry.
    1126           0 :       (while (re-search-forward "^  " nil t)
    1127           0 :         (replace-match "")
    1128           0 :         (forward-line))
    1129           0 :       (buffer-string))))
    1130             : 
    1131             : (defun vc-git-region-history (file buffer lfrom lto)
    1132             :   "Insert into BUFFER the history of FILE for lines LFROM to LTO.
    1133             : This requires git 1.8.4 or later, for the \"-L\" option of \"git log\"."
    1134             :   ;; The "git log" command below interprets the line numbers as applying
    1135             :   ;; to the HEAD version of the file, not to the current state of the file.
    1136             :   ;; So we need to look at all the local changes and adjust lfrom/lto
    1137             :   ;; accordingly.
    1138             :   ;; FIXME: Maybe this should be done in vc.el (i.e. for all backends), but
    1139             :   ;; since Git is the only backend to support this operation so far, it's hard
    1140             :   ;; to tell.
    1141           0 :   (with-temp-buffer
    1142           0 :     (vc-call-backend 'git 'diff file "HEAD" nil (current-buffer))
    1143           0 :     (goto-char (point-min))
    1144           0 :     (let ((last-offset 0)
    1145             :           (from-offset nil)
    1146             :           (to-offset nil))
    1147           0 :       (while (re-search-forward
    1148           0 :               "^@@ -\\([0-9]+\\),\\([0-9]+\\) \\+\\([0-9]+\\),\\([0-9]+\\) @@" nil t)
    1149           0 :         (let ((headno (string-to-number (match-string 1)))
    1150           0 :               (headcnt (string-to-number (match-string 2)))
    1151           0 :               (curno (string-to-number (match-string 3)))
    1152           0 :               (curcnt (string-to-number (match-string 4))))
    1153           0 :           (cl-assert (equal (- curno headno) last-offset))
    1154           0 :           (and (null from-offset) (> curno lfrom)
    1155           0 :                (setq from-offset last-offset))
    1156           0 :           (and (null to-offset) (> curno lto)
    1157           0 :                (setq to-offset last-offset))
    1158           0 :           (setq last-offset
    1159           0 :                 (- (+ curno curcnt) (+ headno headcnt)))))
    1160           0 :       (setq lto (- lto (or to-offset last-offset)))
    1161           0 :       (setq lfrom (- lfrom (or to-offset last-offset)))))
    1162           0 :   (vc-git-command buffer 'async nil "log" "-p" ;"--follow" ;FIXME: not supported?
    1163           0 :                   (format "-L%d,%d:%s" lfrom lto (file-relative-name file))))
    1164             : 
    1165             : (require 'diff-mode)
    1166             : 
    1167             : (defvar vc-git-region-history-mode-map
    1168             :   (let ((map (make-composed-keymap
    1169             :               nil (make-composed-keymap
    1170             :                    (list diff-mode-map vc-git-log-view-mode-map)))))
    1171             :     map))
    1172             : 
    1173             : (defvar vc-git--log-view-long-font-lock-keywords nil)
    1174             : (defvar font-lock-keywords)
    1175             : (defvar vc-git-region-history-font-lock-keywords
    1176             :   `((vc-git-region-history-font-lock)))
    1177             : 
    1178             : (defun vc-git-region-history-font-lock (limit)
    1179           0 :   (let ((in-diff (save-excursion
    1180           0 :                    (beginning-of-line)
    1181           0 :                    (or (looking-at "^\\(?:diff\\|commit\\)\\>")
    1182           0 :                        (re-search-backward "^\\(?:diff\\|commit\\)\\>" nil t))
    1183           0 :                    (eq ?d (char-after (match-beginning 0))))))
    1184           0 :     (while
    1185           0 :         (let ((end (save-excursion
    1186           0 :                      (if (re-search-forward "\n\\(diff\\|commit\\)\\>"
    1187           0 :                                             limit t)
    1188           0 :                          (match-beginning 1)
    1189           0 :                        limit))))
    1190           0 :           (let ((font-lock-keywords (if in-diff diff-font-lock-keywords
    1191           0 :                                       vc-git--log-view-long-font-lock-keywords)))
    1192           0 :             (font-lock-fontify-keywords-region (point) end))
    1193           0 :           (goto-char end)
    1194           0 :           (prog1 (< (point) limit)
    1195           0 :             (setq in-diff (eq ?d (char-after))))))
    1196           0 :     nil))
    1197             : 
    1198             : (define-derived-mode vc-git-region-history-mode
    1199             :     vc-git-log-view-mode "Git-Region-History"
    1200             :   "Major mode to browse Git's \"log -p\" output."
    1201           0 :   (setq-local vc-git--log-view-long-font-lock-keywords
    1202           0 :               log-view-font-lock-keywords)
    1203           0 :   (setq-local font-lock-defaults
    1204           0 :               (cons 'vc-git-region-history-font-lock-keywords
    1205           0 :                     (cdr font-lock-defaults))))
    1206             : 
    1207             : (defun vc-git--asciify-coding-system ()
    1208             :   ;; Try to reconcile the content encoding with the encoding of Git's
    1209             :   ;; auxiliary output (which is ASCII or ASCII-compatible), bug#23595.
    1210           0 :   (unless (let ((samp "Binary files differ"))
    1211           0 :             (string-equal samp (decode-coding-string
    1212           0 :                                 samp coding-system-for-read t)))
    1213           0 :     (setq coding-system-for-read 'undecided)))
    1214             : 
    1215             : (autoload 'vc-switches "vc")
    1216             : 
    1217             : (defun vc-git-diff (files &optional rev1 rev2 buffer _async)
    1218             :   "Get a difference report using Git between two revisions of FILES."
    1219           0 :   (let (process-file-side-effects
    1220             :         (command "diff-tree"))
    1221           0 :     (vc-git--asciify-coding-system)
    1222           0 :     (if rev2
    1223             :         ;; Diffing against the empty tree.
    1224           0 :         (unless rev1 (setq rev1 "4b825dc642cb6eb9a060e54bf8d69288fbee4904"))
    1225           0 :       (setq command "diff-index")
    1226           0 :       (unless rev1 (setq rev1 "HEAD")))
    1227           0 :     (if vc-git-diff-switches
    1228           0 :         (apply #'vc-git-command (or buffer "*vc-diff*")
    1229             :                1 ; bug#21969
    1230           0 :                files
    1231           0 :                command
    1232             :                "--exit-code"
    1233           0 :                (append (vc-switches 'git 'diff)
    1234           0 :                        (list "-p" (or rev1 "HEAD") rev2 "--")))
    1235           0 :       (vc-git-command (or buffer "*vc-diff*") 1 files
    1236             :                       "difftool" "--exit-code" "--no-prompt" "-x"
    1237           0 :                       (concat "diff "
    1238           0 :                               (mapconcat 'identity
    1239           0 :                                          (vc-switches nil 'diff) " "))
    1240           0 :                       rev1 rev2 "--"))))
    1241             : 
    1242             : (defun vc-git-revision-table (_files)
    1243             :   ;; What about `files'?!?  --Stef
    1244           0 :   (let (process-file-side-effects
    1245           0 :         (table (list "HEAD")))
    1246           0 :     (with-temp-buffer
    1247           0 :       (vc-git-command t nil nil "for-each-ref" "--format=%(refname)")
    1248           0 :       (goto-char (point-min))
    1249           0 :       (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$"
    1250           0 :                                 nil t)
    1251           0 :         (push (match-string 2) table)))
    1252           0 :     table))
    1253             : 
    1254             : (defun vc-git-revision-completion-table (files)
    1255           0 :   (letrec ((table (lazy-completion-table
    1256           0 :                    table (lambda () (vc-git-revision-table files)))))
    1257           0 :     table))
    1258             : 
    1259             : (defun vc-git-annotate-command (file buf &optional rev)
    1260           0 :   (vc-git--asciify-coding-system)
    1261           0 :   (let ((name (file-relative-name file)))
    1262           0 :     (apply #'vc-git-command buf 'async nil "blame" "--date=short"
    1263           0 :            (append (vc-switches 'git 'annotate)
    1264           0 :                    (list rev "--" name)))))
    1265             : 
    1266             : (declare-function vc-annotate-convert-time "vc-annotate" (&optional time))
    1267             : 
    1268             : (defun vc-git-annotate-time ()
    1269           0 :   (and (re-search-forward "^[0-9a-f^]+[^()]+(.*?\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\) \\(:?\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) \\([-+0-9]+\\)\\)? *[0-9]+) " nil t)
    1270           0 :        (vc-annotate-convert-time
    1271           0 :         (apply #'encode-time (mapcar (lambda (match)
    1272           0 :                                        (if (match-beginning match)
    1273           0 :                                            (string-to-number (match-string match))
    1274           0 :                                          0))
    1275           0 :                                      '(6 5 4 3 2 1 7))))))
    1276             : 
    1277             : (defun vc-git-annotate-extract-revision-at-line ()
    1278           0 :   (save-excursion
    1279           0 :     (beginning-of-line)
    1280           0 :     (when (looking-at "\\^?\\([0-9a-f]+\\) \\(\\([^(]+\\) \\)?")
    1281           0 :       (let ((revision (match-string-no-properties 1)))
    1282           0 :         (if (match-beginning 2)
    1283           0 :             (let ((fname (match-string-no-properties 3)))
    1284             :               ;; Remove trailing whitespace from the file name.
    1285           0 :               (when (string-match " +\\'" fname)
    1286           0 :                 (setq fname (substring fname 0 (match-beginning 0))))
    1287           0 :               (cons revision
    1288           0 :                     (expand-file-name fname (vc-git-root default-directory))))
    1289           0 :           revision)))))
    1290             : 
    1291             : ;;; TAG SYSTEM
    1292             : 
    1293             : (defun vc-git-create-tag (dir name branchp)
    1294           0 :   (let ((default-directory dir))
    1295           0 :     (and (vc-git-command nil 0 nil "update-index" "--refresh")
    1296           0 :          (if branchp
    1297           0 :              (vc-git-command nil 0 nil "checkout" "-b" name)
    1298           0 :            (vc-git-command nil 0 nil "tag" name)))))
    1299             : 
    1300             : (defun vc-git-retrieve-tag (dir name _update)
    1301           0 :   (let ((default-directory dir))
    1302           0 :     (vc-git-command nil 0 nil "checkout" name)))
    1303             : 
    1304             : 
    1305             : ;;; MISCELLANEOUS
    1306             : 
    1307             : (defun vc-git-previous-revision (file rev)
    1308             :   "Git-specific version of `vc-previous-revision'."
    1309           0 :   (if file
    1310           0 :       (let* ((fname (file-relative-name file))
    1311           0 :              (prev-rev (with-temp-buffer
    1312           0 :                          (and
    1313           0 :                           (vc-git--out-ok "rev-list" "-2" rev "--" fname)
    1314           0 :                           (goto-char (point-max))
    1315           0 :                           (bolp)
    1316           0 :                           (zerop (forward-line -1))
    1317           0 :                           (not (bobp))
    1318           0 :                           (buffer-substring-no-properties
    1319           0 :                            (point)
    1320           0 :                            (1- (point-max)))))))
    1321           0 :         (or (vc-git-symbolic-commit prev-rev) prev-rev))
    1322             :     ;; We used to use "^" here, but that fails on MS-Windows if git is
    1323             :     ;; invoked via a batch file, in which case cmd.exe strips the "^"
    1324             :     ;; because it is a special character for cmd which process-file
    1325             :     ;; does not (and cannot) quote.
    1326           0 :     (vc-git--rev-parse (concat rev "~1"))))
    1327             : 
    1328             : (defun vc-git--rev-parse (rev)
    1329          40 :   (with-temp-buffer
    1330          40 :     (and
    1331          40 :      (vc-git--out-ok "rev-parse" rev)
    1332          40 :      (buffer-substring-no-properties (point-min) (+ (point-min) 40)))))
    1333             : 
    1334             : (defun vc-git-next-revision (file rev)
    1335             :   "Git-specific version of `vc-next-revision'."
    1336           0 :   (let* ((default-directory (vc-git-root file))
    1337           0 :          (file (file-relative-name file))
    1338             :          (current-rev
    1339           0 :           (with-temp-buffer
    1340           0 :             (and
    1341           0 :              (vc-git--out-ok "rev-list" "-1" rev "--" file)
    1342           0 :              (goto-char (point-max))
    1343           0 :              (bolp)
    1344           0 :              (zerop (forward-line -1))
    1345           0 :              (bobp)
    1346           0 :              (buffer-substring-no-properties
    1347           0 :               (point)
    1348           0 :               (1- (point-max))))))
    1349             :          (next-rev
    1350           0 :           (and current-rev
    1351           0 :                (with-temp-buffer
    1352           0 :                  (and
    1353           0 :                   (vc-git--out-ok "rev-list" "HEAD" "--" file)
    1354           0 :                   (goto-char (point-min))
    1355           0 :                   (search-forward current-rev nil t)
    1356           0 :                   (zerop (forward-line -1))
    1357           0 :                   (buffer-substring-no-properties
    1358           0 :                    (point)
    1359           0 :                    (progn (forward-line 1) (1- (point)))))))))
    1360           0 :     (or (vc-git-symbolic-commit next-rev) next-rev)))
    1361             : 
    1362             : (defun vc-git-delete-file (file)
    1363           0 :   (vc-git-command nil 0 file "rm" "-f" "--"))
    1364             : 
    1365             : (defun vc-git-rename-file (old new)
    1366           0 :   (vc-git-command nil 0 (list old new) "mv" "-f" "--"))
    1367             : 
    1368             : (defvar vc-git-extra-menu-map
    1369             :   (let ((map (make-sparse-keymap)))
    1370             :     (define-key map [git-grep]
    1371             :       '(menu-item "Git grep..." vc-git-grep
    1372             :                   :help "Run the `git grep' command"))
    1373             :     (define-key map [git-sn]
    1374             :       '(menu-item "Stash a Snapshot" vc-git-stash-snapshot
    1375             :                   :help "Stash the current state of the tree and keep the current state"))
    1376             :     (define-key map [git-st]
    1377             :       '(menu-item "Create Stash..." vc-git-stash
    1378             :                   :help "Stash away changes"))
    1379             :     (define-key map [git-ss]
    1380             :       '(menu-item "Show Stash..." vc-git-stash-show
    1381             :                   :help "Show stash contents"))
    1382             :     map))
    1383             : 
    1384           1 : (defun vc-git-extra-menu () vc-git-extra-menu-map)
    1385             : 
    1386           0 : (defun vc-git-extra-status-menu () vc-git-extra-menu-map)
    1387             : 
    1388             : (defun vc-git-root (file)
    1389          42 :   (or (vc-file-getprop file 'git-root)
    1390          42 :       (vc-file-setprop file 'git-root (vc-find-root file ".git"))))
    1391             : 
    1392             : ;; grep-compute-defaults autoloads grep.
    1393             : (declare-function grep-read-regexp "grep" ())
    1394             : (declare-function grep-read-files "grep" (regexp))
    1395             : (declare-function grep-expand-template "grep"
    1396             :                  (template &optional regexp files dir excl))
    1397             : 
    1398             : ;; Derived from `lgrep'.
    1399             : (defun vc-git-grep (regexp &optional files dir)
    1400             :   "Run git grep, searching for REGEXP in FILES in directory DIR.
    1401             : The search is limited to file names matching shell pattern FILES.
    1402             : FILES may use abbreviations defined in `grep-files-aliases', e.g.
    1403             : entering `ch' is equivalent to `*.[ch]'.
    1404             : 
    1405             : With \\[universal-argument] prefix, you can edit the constructed shell command line
    1406             : before it is executed.
    1407             : With two \\[universal-argument] prefixes, directly edit and run `grep-command'.
    1408             : 
    1409             : Collect output in a buffer.  While git grep runs asynchronously, you
    1410             : can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \
    1411             : in the grep output buffer,
    1412             : to go to the lines where grep found matches.
    1413             : 
    1414             : This command shares argument histories with \\[rgrep] and \\[grep]."
    1415             :   (interactive
    1416           0 :    (progn
    1417           0 :      (grep-compute-defaults)
    1418           0 :      (cond
    1419           0 :       ((equal current-prefix-arg '(16))
    1420           0 :        (list (read-from-minibuffer "Run: " "git grep"
    1421           0 :                                    nil nil 'grep-history)
    1422           0 :              nil))
    1423           0 :       (t (let* ((regexp (grep-read-regexp))
    1424           0 :                 (files (grep-read-files regexp))
    1425           0 :                 (dir (read-directory-name "In directory: "
    1426           0 :                                           nil default-directory t)))
    1427           0 :            (list regexp files dir))))))
    1428           0 :   (require 'grep)
    1429           0 :   (when (and (stringp regexp) (> (length regexp) 0))
    1430           0 :     (let ((command regexp))
    1431           0 :       (if (null files)
    1432           0 :           (if (string= command "git grep")
    1433           0 :               (setq command nil))
    1434           0 :         (setq dir (file-name-as-directory (expand-file-name dir)))
    1435           0 :         (setq command
    1436           0 :               (grep-expand-template "git --no-pager grep -n -e <R> -- <F>"
    1437           0 :                                     regexp files))
    1438           0 :         (when command
    1439           0 :           (if (equal current-prefix-arg '(4))
    1440           0 :               (setq command
    1441           0 :                     (read-from-minibuffer "Confirm: "
    1442           0 :                                           command nil nil 'grep-history))
    1443           0 :             (add-to-history 'grep-history command))))
    1444           0 :       (when command
    1445           0 :         (let ((default-directory dir)
    1446           0 :               (compilation-environment (cons "PAGER=" compilation-environment)))
    1447             :           ;; Setting process-setup-function makes exit-message-function work
    1448             :           ;; even when async processes aren't supported.
    1449           0 :           (compilation-start command 'grep-mode))
    1450           0 :         (if (eq next-error-last-buffer (current-buffer))
    1451           0 :             (setq default-directory dir))))))
    1452             : 
    1453             : ;; Everywhere but here, follows vc-git-command, which uses vc-do-command
    1454             : ;; from vc-dispatcher.
    1455             : (autoload 'vc-resynch-buffer "vc-dispatcher")
    1456             : 
    1457             : (defun vc-git-stash (name)
    1458             :   "Create a stash."
    1459             :   (interactive "sStash name: ")
    1460           0 :   (let ((root (vc-git-root default-directory)))
    1461           0 :     (when root
    1462           0 :       (vc-git--call nil "stash" "save" name)
    1463           0 :       (vc-resynch-buffer root t t))))
    1464             : 
    1465             : (defun vc-git-stash-show (name)
    1466             :   "Show the contents of stash NAME."
    1467             :   (interactive "sStash name: ")
    1468           0 :   (vc-setup-buffer "*vc-git-stash*")
    1469           0 :   (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
    1470           0 :   (set-buffer "*vc-git-stash*")
    1471           0 :   (diff-mode)
    1472           0 :   (setq buffer-read-only t)
    1473           0 :   (pop-to-buffer (current-buffer)))
    1474             : 
    1475             : (defun vc-git-stash-apply (name)
    1476             :   "Apply stash NAME."
    1477             :   (interactive "sApply stash: ")
    1478           0 :   (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name)
    1479           0 :   (vc-resynch-buffer (vc-git-root default-directory) t t))
    1480             : 
    1481             : (defun vc-git-stash-pop (name)
    1482             :   "Pop stash NAME."
    1483             :   (interactive "sPop stash: ")
    1484           0 :   (vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name)
    1485           0 :   (vc-resynch-buffer (vc-git-root default-directory) t t))
    1486             : 
    1487             : (defun vc-git-stash-snapshot ()
    1488             :   "Create a stash with the current tree state."
    1489             :   (interactive)
    1490           0 :   (vc-git--call nil "stash" "save"
    1491           0 :                 (let ((ct (current-time)))
    1492           0 :                   (concat
    1493           0 :                    (format-time-string "Snapshot on %Y-%m-%d" ct)
    1494           0 :                    (format-time-string " at %H:%M" ct))))
    1495           0 :   (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}")
    1496           0 :   (vc-resynch-buffer (vc-git-root default-directory) t t))
    1497             : 
    1498             : (defun vc-git-stash-list ()
    1499           0 :   (delete
    1500             :    ""
    1501           0 :    (split-string
    1502           0 :     (replace-regexp-in-string
    1503           0 :      "^stash@" "             " (vc-git--run-command-string nil "stash" "list"))
    1504           0 :     "\n")))
    1505             : 
    1506             : (defun vc-git-stash-get-at-point (point)
    1507           0 :   (save-excursion
    1508           0 :     (goto-char point)
    1509           0 :     (beginning-of-line)
    1510           0 :     (if (looking-at "^ +\\({[0-9]+}\\):")
    1511           0 :         (match-string 1)
    1512           0 :       (error "Cannot find stash at point"))))
    1513             : 
    1514             : ;; vc-git-stash-delete-at-point must be called from a vc-dir buffer.
    1515             : (declare-function vc-dir-refresh "vc-dir" ())
    1516             : 
    1517             : (defun vc-git-stash-delete-at-point ()
    1518             :   (interactive)
    1519           0 :   (let ((stash (vc-git-stash-get-at-point (point))))
    1520           0 :     (when (y-or-n-p (format "Remove stash %s ? " stash))
    1521           0 :       (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash))
    1522           0 :       (vc-dir-refresh))))
    1523             : 
    1524             : (defun vc-git-stash-show-at-point ()
    1525             :   (interactive)
    1526           0 :   (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point)))))
    1527             : 
    1528             : (defun vc-git-stash-apply-at-point ()
    1529             :   (interactive)
    1530           0 :   (let (vc-dir-buffers) ; Small optimization.
    1531           0 :     (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point)))))
    1532           0 :   (vc-dir-refresh))
    1533             : 
    1534             : (defun vc-git-stash-pop-at-point ()
    1535             :   (interactive)
    1536           0 :   (let (vc-dir-buffers) ; Likewise.
    1537           0 :     (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point)))))
    1538           0 :   (vc-dir-refresh))
    1539             : 
    1540             : (defun vc-git-stash-menu (e)
    1541             :   (interactive "e")
    1542           0 :   (vc-dir-at-event e (popup-menu vc-git-stash-menu-map e)))
    1543             : 
    1544             : 
    1545             : ;;; Internal commands
    1546             : 
    1547             : (defun vc-git-command (buffer okstatus file-or-list &rest flags)
    1548             :   "A wrapper around `vc-do-command' for use in vc-git.el.
    1549             : The difference to vc-do-command is that this function always invokes
    1550             : `vc-git-program'."
    1551           0 :   (let ((coding-system-for-read
    1552           0 :          (or coding-system-for-read vc-git-log-output-coding-system))
    1553             :         (coding-system-for-write
    1554           0 :          (or coding-system-for-write vc-git-commits-coding-system))
    1555           0 :         (process-environment (cons "GIT_DIR" process-environment)))
    1556           0 :     (apply 'vc-do-command (or buffer "*vc*") okstatus vc-git-program
    1557             :            ;; http://debbugs.gnu.org/16897
    1558           0 :            (unless (and (not (cdr-safe file-or-list))
    1559           0 :                         (let ((file (or (car-safe file-or-list)
    1560           0 :                                         file-or-list)))
    1561           0 :                           (and file
    1562           0 :                                (eq ?/ (aref file (1- (length file))))
    1563           0 :                                (equal file (vc-git-root file)))))
    1564           0 :              file-or-list)
    1565           0 :            (cons "--no-pager" flags))))
    1566             : 
    1567             : (defun vc-git--empty-db-p ()
    1568             :   "Check if the git db is empty (no commit done yet)."
    1569           0 :   (let (process-file-side-effects)
    1570           0 :     (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD")))))
    1571             : 
    1572             : (defun vc-git--call (buffer command &rest args)
    1573             :   ;; We don't need to care the arguments.  If there is a file name, it
    1574             :   ;; is always a relative one.  This works also for remote
    1575             :   ;; directories.  We enable `inhibit-null-byte-detection', otherwise
    1576             :   ;; Tramp's eol conversion might be confused.
    1577         204 :   (let ((inhibit-null-byte-detection t)
    1578             :         (coding-system-for-read
    1579         204 :          (or coding-system-for-read vc-git-log-output-coding-system))
    1580             :         (coding-system-for-write
    1581         204 :          (or coding-system-for-write vc-git-commits-coding-system))
    1582         204 :         (process-environment (cons "PAGER=" process-environment)))
    1583         408 :     (push "GIT_DIR" process-environment)
    1584         204 :     (apply 'process-file vc-git-program nil buffer nil command args)))
    1585             : 
    1586             : (defun vc-git--out-ok (command &rest args)
    1587         204 :   (zerop (apply 'vc-git--call '(t nil) command args)))
    1588             : 
    1589             : (defun vc-git--run-command-string (file &rest args)
    1590             :   "Run a git command on FILE and return its output as string.
    1591             : FILE can be nil."
    1592         120 :   (let* ((ok t)
    1593         120 :          (str (with-output-to-string
    1594         120 :                 (with-current-buffer standard-output
    1595         120 :                   (unless (apply 'vc-git--out-ok
    1596         120 :                                  (if file
    1597          80 :                                      (append args (list (file-relative-name
    1598          80 :                                                          file)))
    1599         120 :                                    args))
    1600         120 :                     (setq ok nil))))))
    1601         120 :     (and ok str)))
    1602             : 
    1603             : (defun vc-git-symbolic-commit (commit)
    1604             :   "Translate COMMIT string into symbolic form.
    1605             : Returns nil if not possible."
    1606           0 :   (and commit
    1607           0 :        (let ((name (with-temp-buffer
    1608           0 :                      (and
    1609           0 :                       (vc-git--out-ok "name-rev" "--name-only" commit)
    1610           0 :                       (goto-char (point-min))
    1611           0 :                       (= (forward-line 2) 1)
    1612           0 :                       (bolp)
    1613           0 :                       (buffer-substring-no-properties (point-min)
    1614           0 :                                                       (1- (point-max)))))))
    1615           0 :          (and name (not (string= name "undefined")) name))))
    1616             : 
    1617             : (provide 'vc-git)
    1618             : 
    1619             : ;;; vc-git.el ends here

Generated by: LCOV version 1.12