Mercurial > emacs
comparison lisp/vc/vc-git.el @ 109404:e93288477c43
Merge from mainline.
| author | Katsumi Yamaoka <yamaoka@jpl.org> |
|---|---|
| date | Sun, 13 Jun 2010 22:57:55 +0000 |
| parents | lisp/vc-git.el@c05344a913c8 lisp/vc-git.el@d928a6a7c3f2 |
| children | a9586dc942d5 |
comparison
equal
deleted
inserted
replaced
| 109403:681cd08dc0f7 | 109404:e93288477c43 |
|---|---|
| 1 ;;; vc-git.el --- VC backend for the git version control system | |
| 2 | |
| 3 ;; Copyright (C) 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: Alexandre Julliard <julliard@winehq.org> | |
| 6 ;; Keywords: vc tools | |
| 7 | |
| 8 ;; This file is part of GNU Emacs. | |
| 9 | |
| 10 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
| 11 ;; it under the terms of the GNU General Public License as published by | |
| 12 ;; the Free Software Foundation, either version 3 of the License, or | |
| 13 ;; (at your option) any later version. | |
| 14 | |
| 15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
| 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 18 ;; GNU General Public License for more details. | |
| 19 | |
| 20 ;; You should have received a copy of the GNU General Public License | |
| 21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
| 22 | |
| 23 ;;; Commentary: | |
| 24 | |
| 25 ;; This file contains a VC backend for the git version control | |
| 26 ;; system. | |
| 27 ;; | |
| 28 | |
| 29 ;;; Installation: | |
| 30 | |
| 31 ;; To install: put this file on the load-path and add Git to the list | |
| 32 ;; of supported backends in `vc-handled-backends'; the following line, | |
| 33 ;; placed in your ~/.emacs, will accomplish this: | |
| 34 ;; | |
| 35 ;; (add-to-list 'vc-handled-backends 'Git) | |
| 36 | |
| 37 ;;; Todo: | |
| 38 ;; - check if more functions could use vc-git-command instead | |
| 39 ;; of start-process. | |
| 40 ;; - changelog generation | |
| 41 | |
| 42 ;; Implement the rest of the vc interface. See the comment at the | |
| 43 ;; beginning of vc.el. The current status is: | |
| 44 ;; ("??" means: "figure out what to do about it") | |
| 45 ;; | |
| 46 ;; FUNCTION NAME STATUS | |
| 47 ;; BACKEND PROPERTIES | |
| 48 ;; * revision-granularity OK | |
| 49 ;; STATE-QUERYING FUNCTIONS | |
| 50 ;; * registered (file) OK | |
| 51 ;; * state (file) OK | |
| 52 ;; - state-heuristic (file) NOT NEEDED | |
| 53 ;; * working-revision (file) OK | |
| 54 ;; - latest-on-branch-p (file) NOT NEEDED | |
| 55 ;; * checkout-model (files) OK | |
| 56 ;; - workfile-unchanged-p (file) OK | |
| 57 ;; - mode-line-string (file) OK | |
| 58 ;; STATE-CHANGING FUNCTIONS | |
| 59 ;; * create-repo () OK | |
| 60 ;; * register (files &optional rev comment) OK | |
| 61 ;; - init-revision (file) NOT NEEDED | |
| 62 ;; - responsible-p (file) OK | |
| 63 ;; - could-register (file) NOT NEEDED, DEFAULT IS GOOD | |
| 64 ;; - receive-file (file rev) NOT NEEDED | |
| 65 ;; - unregister (file) OK | |
| 66 ;; * checkin (files rev comment) OK | |
| 67 ;; * find-revision (file rev buffer) OK | |
| 68 ;; * checkout (file &optional editable rev) OK | |
| 69 ;; * revert (file &optional contents-done) OK | |
| 70 ;; - rollback (files) COULD BE SUPPORTED | |
| 71 ;; - merge (file rev1 rev2) It would be possible to merge | |
| 72 ;; changes into a single file, but | |
| 73 ;; when committing they wouldn't | |
| 74 ;; be identified as a merge | |
| 75 ;; by git, so it's probably | |
| 76 ;; not a good idea. | |
| 77 ;; - merge-news (file) see `merge' | |
| 78 ;; - steal-lock (file &optional revision) NOT NEEDED | |
| 79 ;; HISTORY FUNCTIONS | |
| 80 ;; * print-log (files buffer &optional shortlog start-revision limit) OK | |
| 81 ;; - log-view-mode () OK | |
| 82 ;; - show-log-entry (revision) OK | |
| 83 ;; - comment-history (file) ?? | |
| 84 ;; - update-changelog (files) COULD BE SUPPORTED | |
| 85 ;; * diff (file &optional rev1 rev2 buffer) OK | |
| 86 ;; - revision-completion-table (files) OK | |
| 87 ;; - annotate-command (file buf &optional rev) OK | |
| 88 ;; - annotate-time () OK | |
| 89 ;; - annotate-current-time () NOT NEEDED | |
| 90 ;; - annotate-extract-revision-at-line () OK | |
| 91 ;; TAG SYSTEM | |
| 92 ;; - create-tag (dir name branchp) OK | |
| 93 ;; - retrieve-tag (dir name update) OK | |
| 94 ;; MISCELLANEOUS | |
| 95 ;; - make-version-backups-p (file) NOT NEEDED | |
| 96 ;; - repository-hostname (dirname) NOT NEEDED | |
| 97 ;; - previous-revision (file rev) OK | |
| 98 ;; - next-revision (file rev) OK | |
| 99 ;; - check-headers () COULD BE SUPPORTED | |
| 100 ;; - clear-headers () NOT NEEDED | |
| 101 ;; - delete-file (file) OK | |
| 102 ;; - rename-file (old new) OK | |
| 103 ;; - find-file-hook () NOT NEEDED | |
| 104 | |
| 105 (eval-when-compile | |
| 106 (require 'cl) | |
| 107 (require 'vc) | |
| 108 (require 'vc-dir) | |
| 109 (require 'grep)) | |
| 110 | |
| 111 (defcustom vc-git-diff-switches t | |
| 112 "String or list of strings specifying switches for Git diff under VC. | |
| 113 If nil, use the value of `vc-diff-switches'. If t, use no switches." | |
| 114 :type '(choice (const :tag "Unspecified" nil) | |
| 115 (const :tag "None" t) | |
| 116 (string :tag "Argument String") | |
| 117 (repeat :tag "Argument List" :value ("") string)) | |
| 118 :version "23.1" | |
| 119 :group 'vc) | |
| 120 | |
| 121 (defvar vc-git-commits-coding-system 'utf-8 | |
| 122 "Default coding system for git commits.") | |
| 123 | |
| 124 ;;; BACKEND PROPERTIES | |
| 125 | |
| 126 (defun vc-git-revision-granularity () 'repository) | |
| 127 (defun vc-git-checkout-model (files) 'implicit) | |
| 128 | |
| 129 ;;; STATE-QUERYING FUNCTIONS | |
| 130 | |
| 131 ;;;###autoload (defun vc-git-registered (file) | |
| 132 ;;;###autoload "Return non-nil if FILE is registered with git." | |
| 133 ;;;###autoload (if (vc-find-root file ".git") ; Short cut. | |
| 134 ;;;###autoload (progn | |
| 135 ;;;###autoload (load "vc-git") | |
| 136 ;;;###autoload (vc-git-registered file)))) | |
| 137 | |
| 138 (defun vc-git-registered (file) | |
| 139 "Check whether FILE is registered with git." | |
| 140 (let ((dir (vc-git-root file))) | |
| 141 (when dir | |
| 142 (with-temp-buffer | |
| 143 (let* (process-file-side-effects | |
| 144 ;; Do not use the `file-name-directory' here: git-ls-files | |
| 145 ;; sometimes fails to return the correct status for relative | |
| 146 ;; path specs. | |
| 147 ;; See also: http://marc.info/?l=git&m=125787684318129&w=2 | |
| 148 (name (file-relative-name file dir)) | |
| 149 (str (ignore-errors | |
| 150 (cd dir) | |
| 151 (vc-git--out-ok "ls-files" "-c" "-z" "--" name) | |
| 152 ;; If result is empty, use ls-tree to check for deleted | |
| 153 ;; file. | |
| 154 (when (eq (point-min) (point-max)) | |
| 155 (vc-git--out-ok "ls-tree" "--name-only" "-z" "HEAD" | |
| 156 "--" name)) | |
| 157 (buffer-string)))) | |
| 158 (and str | |
| 159 (> (length str) (length name)) | |
| 160 (string= (substring str 0 (1+ (length name))) | |
| 161 (concat name "\0")))))))) | |
| 162 | |
| 163 (defun vc-git--state-code (code) | |
| 164 "Convert from a string to a added/deleted/modified state." | |
| 165 (case (string-to-char code) | |
| 166 (?M 'edited) | |
| 167 (?A 'added) | |
| 168 (?D 'removed) | |
| 169 (?U 'edited) ;; FIXME | |
| 170 (?T 'edited))) ;; FIXME | |
| 171 | |
| 172 (defun vc-git-state (file) | |
| 173 "Git-specific version of `vc-state'." | |
| 174 ;; FIXME: This can't set 'ignored or 'conflict yet | |
| 175 ;; The 'ignored state could be detected with `git ls-files -i -o | |
| 176 ;; --exclude-standard` It also can't set 'needs-update or | |
| 177 ;; 'needs-merge. The rough equivalent would be that upstream branch | |
| 178 ;; for current branch is in fast-forward state i.e. current branch | |
| 179 ;; is direct ancestor of corresponding upstream branch, and the file | |
| 180 ;; was modified upstream. But we can't check that without a network | |
| 181 ;; operation. | |
| 182 (if (not (vc-git-registered file)) | |
| 183 'unregistered | |
| 184 (vc-git--call nil "add" "--refresh" "--" (file-relative-name file)) | |
| 185 (let ((diff (vc-git--run-command-string | |
| 186 file "diff-index" "-z" "HEAD" "--"))) | |
| 187 (if (and diff (string-match ":[0-7]\\{6\\} [0-7]\\{6\\} [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\([ADMUT]\\)\0[^\0]+\0" | |
| 188 diff)) | |
| 189 (vc-git--state-code (match-string 1 diff)) | |
| 190 (if (vc-git--empty-db-p) 'added 'up-to-date))))) | |
| 191 | |
| 192 (defun vc-git-working-revision (file) | |
| 193 "Git-specific version of `vc-working-revision'." | |
| 194 (let* (process-file-side-effects | |
| 195 (str (with-output-to-string | |
| 196 (with-current-buffer standard-output | |
| 197 (vc-git--out-ok "symbolic-ref" "HEAD"))))) | |
| 198 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) | |
| 199 (match-string 2 str) | |
| 200 str))) | |
| 201 | |
| 202 (defun vc-git-workfile-unchanged-p (file) | |
| 203 (eq 'up-to-date (vc-git-state file))) | |
| 204 | |
| 205 (defun vc-git-mode-line-string (file) | |
| 206 "Return string for placement into the modeline for FILE." | |
| 207 (let* ((branch (vc-git-working-revision file)) | |
| 208 (def-ml (vc-default-mode-line-string 'Git file)) | |
| 209 (help-echo (get-text-property 0 'help-echo def-ml))) | |
| 210 (if (zerop (length branch)) | |
| 211 (propertize | |
| 212 (concat def-ml "!") | |
| 213 'help-echo (concat help-echo "\nNo current branch (detached HEAD)")) | |
| 214 (propertize def-ml | |
| 215 'help-echo (concat help-echo "\nCurrent branch: " branch))))) | |
| 216 | |
| 217 (defstruct (vc-git-extra-fileinfo | |
| 218 (:copier nil) | |
| 219 (:constructor vc-git-create-extra-fileinfo | |
| 220 (old-perm new-perm &optional rename-state orig-name)) | |
| 221 (:conc-name vc-git-extra-fileinfo->)) | |
| 222 old-perm new-perm ;; Permission flags. | |
| 223 rename-state ;; Rename or copy state. | |
| 224 orig-name) ;; Original name for renames or copies. | |
| 225 | |
| 226 (defun vc-git-escape-file-name (name) | |
| 227 "Escape a file name if necessary." | |
| 228 (if (string-match "[\n\t\"\\]" name) | |
| 229 (concat "\"" | |
| 230 (mapconcat (lambda (c) | |
| 231 (case c | |
| 232 (?\n "\\n") | |
| 233 (?\t "\\t") | |
| 234 (?\\ "\\\\") | |
| 235 (?\" "\\\"") | |
| 236 (t (char-to-string c)))) | |
| 237 name "") | |
| 238 "\"") | |
| 239 name)) | |
| 240 | |
| 241 (defun vc-git-file-type-as-string (old-perm new-perm) | |
| 242 "Return a string describing the file type based on its permissions." | |
| 243 (let* ((old-type (lsh (or old-perm 0) -9)) | |
| 244 (new-type (lsh (or new-perm 0) -9)) | |
| 245 (str (case new-type | |
| 246 (?\100 ;; File. | |
| 247 (case old-type | |
| 248 (?\100 nil) | |
| 249 (?\120 " (type change symlink -> file)") | |
| 250 (?\160 " (type change subproject -> file)"))) | |
| 251 (?\120 ;; Symlink. | |
| 252 (case old-type | |
| 253 (?\100 " (type change file -> symlink)") | |
| 254 (?\160 " (type change subproject -> symlink)") | |
| 255 (t " (symlink)"))) | |
| 256 (?\160 ;; Subproject. | |
| 257 (case old-type | |
| 258 (?\100 " (type change file -> subproject)") | |
| 259 (?\120 " (type change symlink -> subproject)") | |
| 260 (t " (subproject)"))) | |
| 261 (?\110 nil) ;; Directory (internal, not a real git state). | |
| 262 (?\000 ;; Deleted or unknown. | |
| 263 (case old-type | |
| 264 (?\120 " (symlink)") | |
| 265 (?\160 " (subproject)"))) | |
| 266 (t (format " (unknown type %o)" new-type))))) | |
| 267 (cond (str (propertize str 'face 'font-lock-comment-face)) | |
| 268 ((eq new-type ?\110) "/") | |
| 269 (t "")))) | |
| 270 | |
| 271 (defun vc-git-rename-as-string (state extra) | |
| 272 "Return a string describing the copy or rename associated with INFO, | |
| 273 or an empty string if none." | |
| 274 (let ((rename-state (when extra | |
| 275 (vc-git-extra-fileinfo->rename-state extra)))) | |
| 276 (if rename-state | |
| 277 (propertize | |
| 278 (concat " (" | |
| 279 (if (eq rename-state 'copy) "copied from " | |
| 280 (if (eq state 'added) "renamed from " | |
| 281 "renamed to ")) | |
| 282 (vc-git-escape-file-name | |
| 283 (vc-git-extra-fileinfo->orig-name extra)) | |
| 284 ")") | |
| 285 'face 'font-lock-comment-face) | |
| 286 ""))) | |
| 287 | |
| 288 (defun vc-git-permissions-as-string (old-perm new-perm) | |
| 289 "Format a permission change as string." | |
| 290 (propertize | |
| 291 (if (or (not old-perm) | |
| 292 (not new-perm) | |
| 293 (eq 0 (logand ?\111 (logxor old-perm new-perm)))) | |
| 294 " " | |
| 295 (if (eq 0 (logand ?\111 old-perm)) "+x" "-x")) | |
| 296 'face 'font-lock-type-face)) | |
| 297 | |
| 298 (defun vc-git-dir-printer (info) | |
| 299 "Pretty-printer for the vc-dir-fileinfo structure." | |
| 300 (let* ((isdir (vc-dir-fileinfo->directory info)) | |
| 301 (state (if isdir "" (vc-dir-fileinfo->state info))) | |
| 302 (extra (vc-dir-fileinfo->extra info)) | |
| 303 (old-perm (when extra (vc-git-extra-fileinfo->old-perm extra))) | |
| 304 (new-perm (when extra (vc-git-extra-fileinfo->new-perm extra)))) | |
| 305 (insert | |
| 306 " " | |
| 307 (propertize (format "%c" (if (vc-dir-fileinfo->marked info) ?* ? )) | |
| 308 'face 'font-lock-type-face) | |
| 309 " " | |
| 310 (propertize | |
| 311 (format "%-12s" state) | |
| 312 'face (cond ((eq state 'up-to-date) 'font-lock-builtin-face) | |
| 313 ((eq state 'missing) 'font-lock-warning-face) | |
| 314 (t 'font-lock-variable-name-face)) | |
| 315 'mouse-face 'highlight) | |
| 316 " " (vc-git-permissions-as-string old-perm new-perm) | |
| 317 " " | |
| 318 (propertize (vc-git-escape-file-name (vc-dir-fileinfo->name info)) | |
| 319 'face (if isdir 'font-lock-comment-delimiter-face | |
| 320 'font-lock-function-name-face) | |
| 321 'help-echo | |
| 322 (if isdir | |
| 323 "Directory\nVC operations can be applied to it\nmouse-3: Pop-up menu" | |
| 324 "File\nmouse-3: Pop-up menu") | |
| 325 'keymap vc-dir-filename-mouse-map | |
| 326 'mouse-face 'highlight) | |
| 327 (vc-git-file-type-as-string old-perm new-perm) | |
| 328 (vc-git-rename-as-string state extra)))) | |
| 329 | |
| 330 (defun vc-git-after-dir-status-stage (stage files update-function) | |
| 331 "Process sentinel for the various dir-status stages." | |
| 332 (let (next-stage result) | |
| 333 (goto-char (point-min)) | |
| 334 (case stage | |
| 335 (update-index | |
| 336 (setq next-stage (if (vc-git--empty-db-p) 'ls-files-added | |
| 337 (if files 'ls-files-up-to-date 'diff-index)))) | |
| 338 (ls-files-added | |
| 339 (setq next-stage 'ls-files-unknown) | |
| 340 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t) | |
| 341 (let ((new-perm (string-to-number (match-string 1) 8)) | |
| 342 (name (match-string 2))) | |
| 343 (push (list name 'added (vc-git-create-extra-fileinfo 0 new-perm)) | |
| 344 result)))) | |
| 345 (ls-files-up-to-date | |
| 346 (setq next-stage 'diff-index) | |
| 347 (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t) | |
| 348 (let ((perm (string-to-number (match-string 1) 8)) | |
| 349 (name (match-string 2))) | |
| 350 (push (list name 'up-to-date | |
| 351 (vc-git-create-extra-fileinfo perm perm)) | |
| 352 result)))) | |
| 353 (ls-files-unknown | |
| 354 (when files (setq next-stage 'ls-files-ignored)) | |
| 355 (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1) | |
| 356 (push (list (match-string 1) 'unregistered | |
| 357 (vc-git-create-extra-fileinfo 0 0)) | |
| 358 result))) | |
| 359 (ls-files-ignored | |
| 360 (while (re-search-forward "\\([^\0]*?\\)\0" nil t 1) | |
| 361 (push (list (match-string 1) 'ignored | |
| 362 (vc-git-create-extra-fileinfo 0 0)) | |
| 363 result))) | |
| 364 (diff-index | |
| 365 (setq next-stage 'ls-files-unknown) | |
| 366 (while (re-search-forward | |
| 367 ":\\([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" | |
| 368 nil t 1) | |
| 369 (let ((old-perm (string-to-number (match-string 1) 8)) | |
| 370 (new-perm (string-to-number (match-string 2) 8)) | |
| 371 (state (or (match-string 4) (match-string 6))) | |
| 372 (name (or (match-string 5) (match-string 7))) | |
| 373 (new-name (match-string 8))) | |
| 374 (if new-name ; Copy or rename. | |
| 375 (if (eq ?C (string-to-char state)) | |
| 376 (push (list new-name 'added | |
| 377 (vc-git-create-extra-fileinfo old-perm new-perm | |
| 378 'copy name)) | |
| 379 result) | |
| 380 (push (list name 'removed | |
| 381 (vc-git-create-extra-fileinfo 0 0 | |
| 382 'rename new-name)) | |
| 383 result) | |
| 384 (push (list new-name 'added | |
| 385 (vc-git-create-extra-fileinfo old-perm new-perm | |
| 386 'rename name)) | |
| 387 result)) | |
| 388 (push (list name (vc-git--state-code state) | |
| 389 (vc-git-create-extra-fileinfo old-perm new-perm)) | |
| 390 result)))))) | |
| 391 (when result | |
| 392 (setq result (nreverse result)) | |
| 393 (when files | |
| 394 (dolist (entry result) (setq files (delete (car entry) files))) | |
| 395 (unless files (setq next-stage nil)))) | |
| 396 (when (or result (not next-stage)) | |
| 397 (funcall update-function result next-stage)) | |
| 398 (when next-stage | |
| 399 (vc-git-dir-status-goto-stage next-stage files update-function)))) | |
| 400 | |
| 401 (defun vc-git-dir-status-goto-stage (stage files update-function) | |
| 402 (erase-buffer) | |
| 403 (case stage | |
| 404 (update-index | |
| 405 (if files | |
| 406 (vc-git-command (current-buffer) 'async files "add" "--refresh" "--") | |
| 407 (vc-git-command (current-buffer) 'async nil | |
| 408 "update-index" "--refresh"))) | |
| 409 (ls-files-added | |
| 410 (vc-git-command (current-buffer) 'async files | |
| 411 "ls-files" "-z" "-c" "-s" "--")) | |
| 412 (ls-files-up-to-date | |
| 413 (vc-git-command (current-buffer) 'async files | |
| 414 "ls-files" "-z" "-c" "-s" "--")) | |
| 415 (ls-files-unknown | |
| 416 (vc-git-command (current-buffer) 'async files | |
| 417 "ls-files" "-z" "-o" "--directory" | |
| 418 "--no-empty-directory" "--exclude-standard" "--")) | |
| 419 (ls-files-ignored | |
| 420 (vc-git-command (current-buffer) 'async files | |
| 421 "ls-files" "-z" "-o" "-i" "--directory" | |
| 422 "--no-empty-directory" "--exclude-standard" "--")) | |
| 423 ;; --relative added in Git 1.5.5. | |
| 424 (diff-index | |
| 425 (vc-git-command (current-buffer) 'async files | |
| 426 "diff-index" "--relative" "-z" "-M" "HEAD" "--"))) | |
| 427 (vc-exec-after | |
| 428 `(vc-git-after-dir-status-stage ',stage ',files ',update-function))) | |
| 429 | |
| 430 (defun vc-git-dir-status (dir update-function) | |
| 431 "Return a list of (FILE STATE EXTRA) entries for DIR." | |
| 432 ;; Further things that would have to be fixed later: | |
| 433 ;; - how to handle unregistered directories | |
| 434 ;; - how to support vc-dir on a subdir of the project tree | |
| 435 (vc-git-dir-status-goto-stage 'update-index nil update-function)) | |
| 436 | |
| 437 (defun vc-git-dir-status-files (dir files default-state update-function) | |
| 438 "Return a list of (FILE STATE EXTRA) entries for FILES in DIR." | |
| 439 (vc-git-dir-status-goto-stage 'update-index files update-function)) | |
| 440 | |
| 441 (defvar vc-git-stash-map | |
| 442 (let ((map (make-sparse-keymap))) | |
| 443 ;; Turn off vc-dir marking | |
| 444 (define-key map [mouse-2] 'ignore) | |
| 445 | |
| 446 (define-key map [down-mouse-3] 'vc-git-stash-menu) | |
| 447 (define-key map "\C-k" 'vc-git-stash-delete-at-point) | |
| 448 (define-key map "=" 'vc-git-stash-show-at-point) | |
| 449 (define-key map "\C-m" 'vc-git-stash-show-at-point) | |
| 450 (define-key map "A" 'vc-git-stash-apply-at-point) | |
| 451 (define-key map "P" 'vc-git-stash-pop-at-point) | |
| 452 (define-key map "S" 'vc-git-stash-snapshot) | |
| 453 map)) | |
| 454 | |
| 455 (defvar vc-git-stash-menu-map | |
| 456 (let ((map (make-sparse-keymap "Git Stash"))) | |
| 457 (define-key map [de] | |
| 458 '(menu-item "Delete stash" vc-git-stash-delete-at-point | |
| 459 :help "Delete the current stash")) | |
| 460 (define-key map [ap] | |
| 461 '(menu-item "Apply stash" vc-git-stash-apply-at-point | |
| 462 :help "Apply the current stash and keep it in the stash list")) | |
| 463 (define-key map [po] | |
| 464 '(menu-item "Apply and remove stash (pop)" vc-git-stash-pop-at-point | |
| 465 :help "Apply the current stash and remove it")) | |
| 466 (define-key map [sh] | |
| 467 '(menu-item "Show stash" vc-git-stash-show-at-point | |
| 468 :help "Show the contents of the current stash")) | |
| 469 map)) | |
| 470 | |
| 471 (defun vc-git-dir-extra-headers (dir) | |
| 472 (let ((str (with-output-to-string | |
| 473 (with-current-buffer standard-output | |
| 474 (vc-git--out-ok "symbolic-ref" "HEAD")))) | |
| 475 (stash (vc-git-stash-list)) | |
| 476 (stash-help-echo "Use M-x vc-git-stash to create stashes.") | |
| 477 branch remote remote-url) | |
| 478 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) | |
| 479 (progn | |
| 480 (setq branch (match-string 2 str)) | |
| 481 (setq remote | |
| 482 (with-output-to-string | |
| 483 (with-current-buffer standard-output | |
| 484 (vc-git--out-ok "config" | |
| 485 (concat "branch." branch ".remote"))))) | |
| 486 (when (string-match "\\([^\n]+\\)" remote) | |
| 487 (setq remote (match-string 1 remote))) | |
| 488 (when remote | |
| 489 (setq remote-url | |
| 490 (with-output-to-string | |
| 491 (with-current-buffer standard-output | |
| 492 (vc-git--out-ok "config" | |
| 493 (concat "remote." remote ".url")))))) | |
| 494 (when (string-match "\\([^\n]+\\)" remote-url) | |
| 495 (setq remote-url (match-string 1 remote-url)))) | |
| 496 (setq branch "not (detached HEAD)")) | |
| 497 ;; FIXME: maybe use a different face when nothing is stashed. | |
| 498 (concat | |
| 499 (propertize "Branch : " 'face 'font-lock-type-face) | |
| 500 (propertize branch | |
| 501 'face 'font-lock-variable-name-face) | |
| 502 (when remote | |
| 503 (concat | |
| 504 "\n" | |
| 505 (propertize "Remote : " 'face 'font-lock-type-face) | |
| 506 (propertize remote-url | |
| 507 'face 'font-lock-variable-name-face))) | |
| 508 "\n" | |
| 509 (if stash | |
| 510 (concat | |
| 511 (propertize "Stash :\n" 'face 'font-lock-type-face | |
| 512 'help-echo stash-help-echo) | |
| 513 (mapconcat | |
| 514 (lambda (x) | |
| 515 (propertize x | |
| 516 'face 'font-lock-variable-name-face | |
| 517 'mouse-face 'highlight | |
| 518 'help-echo "mouse-3: Show stash menu\nRET: Show stash\nA: Apply stash\nP: Apply and remove stash (pop)\nC-k: Delete stash" | |
| 519 'keymap vc-git-stash-map)) | |
| 520 stash "\n")) | |
| 521 (concat | |
| 522 (propertize "Stash : " 'face 'font-lock-type-face | |
| 523 'help-echo stash-help-echo) | |
| 524 (propertize "Nothing stashed" | |
| 525 'help-echo stash-help-echo | |
| 526 'face 'font-lock-variable-name-face)))))) | |
| 527 | |
| 528 ;;; STATE-CHANGING FUNCTIONS | |
| 529 | |
| 530 (defun vc-git-create-repo () | |
| 531 "Create a new Git repository." | |
| 532 (vc-git-command nil 0 nil "init")) | |
| 533 | |
| 534 (defun vc-git-register (files &optional rev comment) | |
| 535 "Register FILES into the git version-control system." | |
| 536 (let (flist dlist) | |
| 537 (dolist (crt files) | |
| 538 (if (file-directory-p crt) | |
| 539 (push crt dlist) | |
| 540 (push crt flist))) | |
| 541 (when flist | |
| 542 (vc-git-command nil 0 flist "update-index" "--add" "--")) | |
| 543 (when dlist | |
| 544 (vc-git-command nil 0 dlist "add")))) | |
| 545 | |
| 546 (defalias 'vc-git-responsible-p 'vc-git-root) | |
| 547 | |
| 548 (defun vc-git-unregister (file) | |
| 549 (vc-git-command nil 0 file "rm" "-f" "--cached" "--")) | |
| 550 | |
| 551 (declare-function log-edit-extract-headers "log-edit" (headers string)) | |
| 552 | |
| 553 (defun vc-git-checkin (files rev comment) | |
| 554 (let ((coding-system-for-write vc-git-commits-coding-system)) | |
| 555 (apply 'vc-git-command nil 0 files | |
| 556 (nconc (list "commit" "-m") | |
| 557 (log-edit-extract-headers '(("Author" . "--author") | |
| 558 ("Date" . "--date")) | |
| 559 comment) | |
| 560 (list "--only" "--"))))) | |
| 561 | |
| 562 (defun vc-git-find-revision (file rev buffer) | |
| 563 (let* (process-file-side-effects | |
| 564 (coding-system-for-read 'binary) | |
| 565 (coding-system-for-write 'binary) | |
| 566 (fullname (substring | |
| 567 (vc-git--run-command-string | |
| 568 file "ls-files" "-z" "--full-name" "--") | |
| 569 0 -1))) | |
| 570 (vc-git-command | |
| 571 buffer 0 | |
| 572 (concat (if rev rev "HEAD") ":" fullname) "cat-file" "blob"))) | |
| 573 | |
| 574 (defun vc-git-checkout (file &optional editable rev) | |
| 575 (vc-git-command nil 0 file "checkout" (or rev "HEAD"))) | |
| 576 | |
| 577 (defun vc-git-revert (file &optional contents-done) | |
| 578 "Revert FILE to the version stored in the git repository." | |
| 579 (if contents-done | |
| 580 (vc-git-command nil 0 file "update-index" "--") | |
| 581 (vc-git-command nil 0 file "reset" "-q" "--") | |
| 582 (vc-git-command nil nil file "checkout" "-q" "--"))) | |
| 583 | |
| 584 ;;; HISTORY FUNCTIONS | |
| 585 | |
| 586 (defun vc-git-print-log (files buffer &optional shortlog start-revision limit) | |
| 587 "Get change log associated with FILES. | |
| 588 Note that using SHORTLOG requires at least Git version 1.5.6, | |
| 589 for the --graph option." | |
| 590 (let ((coding-system-for-read vc-git-commits-coding-system)) | |
| 591 ;; `vc-do-command' creates the buffer, but we need it before running | |
| 592 ;; the command. | |
| 593 (vc-setup-buffer buffer) | |
| 594 ;; If the buffer exists from a previous invocation it might be | |
| 595 ;; read-only. | |
| 596 (let ((inhibit-read-only t)) | |
| 597 (with-current-buffer | |
| 598 buffer | |
| 599 (apply 'vc-git-command buffer | |
| 600 'async files | |
| 601 (append | |
| 602 '("log" "--no-color") | |
| 603 (when shortlog | |
| 604 '("--graph" "--decorate" "--date=short" | |
| 605 "--pretty=tformat:%d%h %ad %s" "--abbrev-commit")) | |
| 606 (when limit (list "-n" (format "%s" limit))) | |
| 607 (when start-revision (list start-revision)) | |
| 608 '("--"))))))) | |
| 609 | |
| 610 (defun vc-git-log-outgoing (buffer remote-location) | |
| 611 (interactive) | |
| 612 (vc-git-command | |
| 613 buffer 0 nil | |
| 614 "log" | |
| 615 "--no-color" "--graph" "--decorate" "--date=short" | |
| 616 "--pretty=tformat:%d%h %ad %s" "--abbrev-commit" | |
| 617 (concat (if (string= remote-location "") | |
| 618 "@{upstream}" | |
| 619 remote-location) | |
| 620 "..HEAD"))) | |
| 621 | |
| 622 (defun vc-git-log-incoming (buffer remote-location) | |
| 623 (interactive) | |
| 624 (vc-git-command nil 0 nil "fetch") | |
| 625 (vc-git-command | |
| 626 buffer 0 nil | |
| 627 "log" | |
| 628 "--no-color" "--graph" "--decorate" "--date=short" | |
| 629 "--pretty=tformat:%d%h %ad %s" "--abbrev-commit" | |
| 630 (concat "HEAD.." (if (string= remote-location "") | |
| 631 "@{upstream}" | |
| 632 remote-location)))) | |
| 633 | |
| 634 (defvar log-view-message-re) | |
| 635 (defvar log-view-file-re) | |
| 636 (defvar log-view-font-lock-keywords) | |
| 637 (defvar log-view-per-file-logs) | |
| 638 | |
| 639 (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View" | |
| 640 (require 'add-log) ;; We need the faces add-log. | |
| 641 ;; Don't have file markers, so use impossible regexp. | |
| 642 (set (make-local-variable 'log-view-file-re) "\\`a\\`") | |
| 643 (set (make-local-variable 'log-view-per-file-logs) nil) | |
| 644 (set (make-local-variable 'log-view-message-re) | |
| 645 (if (not (eq vc-log-view-type 'long)) | |
| 646 "^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)" | |
| 647 "^commit *\\([0-9a-z]+\\)")) | |
| 648 (set (make-local-variable 'log-view-font-lock-keywords) | |
| 649 (if (not (eq vc-log-view-type 'long)) | |
| 650 '( | |
| 651 ;; Same as log-view-message-re, except that we don't | |
| 652 ;; want the shy group for the tag name. | |
| 653 ("^\\(?:[*/\\| ]+ \\)?\\( ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)" | |
| 654 (1 'highlight nil lax) | |
| 655 (2 'change-log-acknowledgement) | |
| 656 (3 'change-log-date))) | |
| 657 (append | |
| 658 `((,log-view-message-re (1 'change-log-acknowledgement))) | |
| 659 ;; Handle the case: | |
| 660 ;; user: foo@bar | |
| 661 '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" | |
| 662 (1 'change-log-email)) | |
| 663 ;; Handle the case: | |
| 664 ;; user: FirstName LastName <foo@bar> | |
| 665 ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" | |
| 666 (1 'change-log-name) | |
| 667 (2 'change-log-email)) | |
| 668 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" | |
| 669 (1 'change-log-name)) | |
| 670 ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" | |
| 671 (1 'change-log-name) | |
| 672 (2 'change-log-email)) | |
| 673 ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)" | |
| 674 (1 'change-log-acknowledgement) | |
| 675 (2 'change-log-acknowledgement)) | |
| 676 ("^Date: \\(.+\\)" (1 'change-log-date)) | |
| 677 ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) | |
| 678 | |
| 679 | |
| 680 (defun vc-git-show-log-entry (revision) | |
| 681 "Move to the log entry for REVISION. | |
| 682 REVISION may have the form BRANCH, BRANCH~N, | |
| 683 or BRANCH^ (where \"^\" can be repeated)." | |
| 684 (goto-char (point-min)) | |
| 685 (prog1 | |
| 686 (when revision | |
| 687 (search-forward | |
| 688 (format "\ncommit %s" revision) nil t | |
| 689 (cond ((string-match "~\\([0-9]\\)\\'" revision) | |
| 690 (1+ (string-to-number (match-string 1 revision)))) | |
| 691 ((string-match "\\^+\\'" revision) | |
| 692 (1+ (length (match-string 0 revision)))) | |
| 693 (t nil)))) | |
| 694 (beginning-of-line))) | |
| 695 | |
| 696 (defun vc-git-diff (files &optional rev1 rev2 buffer) | |
| 697 "Get a difference report using Git between two revisions of FILES." | |
| 698 (let (process-file-side-effects) | |
| 699 (apply #'vc-git-command (or buffer "*vc-diff*") 1 files | |
| 700 (if (and rev1 rev2) "diff-tree" "diff-index") | |
| 701 "--exit-code" | |
| 702 (append (vc-switches 'git 'diff) | |
| 703 (list "-p" (or rev1 "HEAD") rev2 "--"))))) | |
| 704 | |
| 705 (defun vc-git-revision-table (files) | |
| 706 ;; What about `files'?!? --Stef | |
| 707 (let (process-file-side-effects | |
| 708 (table (list "HEAD"))) | |
| 709 (with-temp-buffer | |
| 710 (vc-git-command t nil nil "for-each-ref" "--format=%(refname)") | |
| 711 (goto-char (point-min)) | |
| 712 (while (re-search-forward "^refs/\\(heads\\|tags\\|remotes\\)/\\(.*\\)$" | |
| 713 nil t) | |
| 714 (push (match-string 2) table))) | |
| 715 table)) | |
| 716 | |
| 717 (defun vc-git-revision-completion-table (files) | |
| 718 (lexical-let ((files files) | |
| 719 table) | |
| 720 (setq table (lazy-completion-table | |
| 721 table (lambda () (vc-git-revision-table files)))) | |
| 722 table)) | |
| 723 | |
| 724 (defun vc-git-annotate-command (file buf &optional rev) | |
| 725 (let ((name (file-relative-name file))) | |
| 726 (vc-git-command buf 'async name "blame" "--date=iso" "-C" "-C" rev))) | |
| 727 | |
| 728 (declare-function vc-annotate-convert-time "vc-annotate" (time)) | |
| 729 | |
| 730 (defun vc-git-annotate-time () | |
| 731 (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) | |
| 732 (vc-annotate-convert-time | |
| 733 (apply #'encode-time (mapcar (lambda (match) | |
| 734 (string-to-number (match-string match))) | |
| 735 '(6 5 4 3 2 1 7)))))) | |
| 736 | |
| 737 (defun vc-git-annotate-extract-revision-at-line () | |
| 738 (save-excursion | |
| 739 (move-beginning-of-line 1) | |
| 740 (when (looking-at "\\([0-9a-f^][0-9a-f]+\\) \\(\\([^(]+\\) \\)?") | |
| 741 (let ((revision (match-string-no-properties 1))) | |
| 742 (if (match-beginning 2) | |
| 743 (cons revision (expand-file-name (match-string-no-properties 3) | |
| 744 (vc-git-root default-directory))) | |
| 745 revision))))) | |
| 746 | |
| 747 ;;; TAG SYSTEM | |
| 748 | |
| 749 (defun vc-git-create-tag (dir name branchp) | |
| 750 (let ((default-directory dir)) | |
| 751 (and (vc-git-command nil 0 nil "update-index" "--refresh") | |
| 752 (if branchp | |
| 753 (vc-git-command nil 0 nil "checkout" "-b" name) | |
| 754 (vc-git-command nil 0 nil "tag" name))))) | |
| 755 | |
| 756 (defun vc-git-retrieve-tag (dir name update) | |
| 757 (let ((default-directory dir)) | |
| 758 (vc-git-command nil 0 nil "checkout" name) | |
| 759 ;; FIXME: update buffers if `update' is true | |
| 760 )) | |
| 761 | |
| 762 | |
| 763 ;;; MISCELLANEOUS | |
| 764 | |
| 765 (defun vc-git-previous-revision (file rev) | |
| 766 "Git-specific version of `vc-previous-revision'." | |
| 767 (if file | |
| 768 (let* ((default-directory (file-name-directory (expand-file-name file))) | |
| 769 (file (file-name-nondirectory file)) | |
| 770 (prev-rev (with-temp-buffer | |
| 771 (and | |
| 772 (vc-git--out-ok "rev-list" "-2" rev "--" file) | |
| 773 (goto-char (point-max)) | |
| 774 (bolp) | |
| 775 (zerop (forward-line -1)) | |
| 776 (not (bobp)) | |
| 777 (buffer-substring-no-properties | |
| 778 (point) | |
| 779 (1- (point-max))))))) | |
| 780 (or (vc-git-symbolic-commit prev-rev) prev-rev)) | |
| 781 (with-temp-buffer | |
| 782 (and | |
| 783 (vc-git--out-ok "rev-parse" (concat rev "^")) | |
| 784 (buffer-substring-no-properties (point-min) (+ (point-min) 40)))))) | |
| 785 | |
| 786 (defun vc-git-next-revision (file rev) | |
| 787 "Git-specific version of `vc-next-revision'." | |
| 788 (let* ((default-directory (file-name-directory | |
| 789 (expand-file-name file))) | |
| 790 (file (file-name-nondirectory file)) | |
| 791 (current-rev | |
| 792 (with-temp-buffer | |
| 793 (and | |
| 794 (vc-git--out-ok "rev-list" "-1" rev "--" file) | |
| 795 (goto-char (point-max)) | |
| 796 (bolp) | |
| 797 (zerop (forward-line -1)) | |
| 798 (bobp) | |
| 799 (buffer-substring-no-properties | |
| 800 (point) | |
| 801 (1- (point-max)))))) | |
| 802 (next-rev | |
| 803 (and current-rev | |
| 804 (with-temp-buffer | |
| 805 (and | |
| 806 (vc-git--out-ok "rev-list" "HEAD" "--" file) | |
| 807 (goto-char (point-min)) | |
| 808 (search-forward current-rev nil t) | |
| 809 (zerop (forward-line -1)) | |
| 810 (buffer-substring-no-properties | |
| 811 (point) | |
| 812 (progn (forward-line 1) (1- (point))))))))) | |
| 813 (or (vc-git-symbolic-commit next-rev) next-rev))) | |
| 814 | |
| 815 (defun vc-git-delete-file (file) | |
| 816 (vc-git-command nil 0 file "rm" "-f" "--")) | |
| 817 | |
| 818 (defun vc-git-rename-file (old new) | |
| 819 (vc-git-command nil 0 (list old new) "mv" "-f" "--")) | |
| 820 | |
| 821 (defvar vc-git-extra-menu-map | |
| 822 (let ((map (make-sparse-keymap))) | |
| 823 (define-key map [git-grep] | |
| 824 '(menu-item "Git grep..." vc-git-grep | |
| 825 :help "Run the `git grep' command")) | |
| 826 (define-key map [git-sn] | |
| 827 '(menu-item "Stash a snapshot" vc-git-stash-snapshot | |
| 828 :help "Stash the current state of the tree and keep the current state")) | |
| 829 (define-key map [git-st] | |
| 830 '(menu-item "Create Stash..." vc-git-stash | |
| 831 :help "Stash away changes")) | |
| 832 (define-key map [git-ss] | |
| 833 '(menu-item "Show Stash..." vc-git-stash-show | |
| 834 :help "Show stash contents")) | |
| 835 map)) | |
| 836 | |
| 837 (defun vc-git-extra-menu () vc-git-extra-menu-map) | |
| 838 | |
| 839 (defun vc-git-extra-status-menu () vc-git-extra-menu-map) | |
| 840 | |
| 841 (defun vc-git-root (file) | |
| 842 (vc-find-root file ".git")) | |
| 843 | |
| 844 ;; Derived from `lgrep'. | |
| 845 (defun vc-git-grep (regexp &optional files dir) | |
| 846 "Run git grep, searching for REGEXP in FILES in directory DIR. | |
| 847 The search is limited to file names matching shell pattern FILES. | |
| 848 FILES may use abbreviations defined in `grep-files-aliases', e.g. | |
| 849 entering `ch' is equivalent to `*.[ch]'. | |
| 850 | |
| 851 With \\[universal-argument] prefix, you can edit the constructed shell command line | |
| 852 before it is executed. | |
| 853 With two \\[universal-argument] prefixes, directly edit and run `grep-command'. | |
| 854 | |
| 855 Collect output in a buffer. While git grep runs asynchronously, you | |
| 856 can use \\[next-error] (M-x next-error), or \\<grep-mode-map>\\[compile-goto-error] \ | |
| 857 in the grep output buffer, | |
| 858 to go to the lines where grep found matches. | |
| 859 | |
| 860 This command shares argument histories with \\[rgrep] and \\[grep]." | |
| 861 (interactive | |
| 862 (progn | |
| 863 (grep-compute-defaults) | |
| 864 (cond | |
| 865 ((equal current-prefix-arg '(16)) | |
| 866 (list (read-from-minibuffer "Run: " "git grep" | |
| 867 nil nil 'grep-history) | |
| 868 nil)) | |
| 869 (t (let* ((regexp (grep-read-regexp)) | |
| 870 (files (grep-read-files regexp)) | |
| 871 (dir (read-directory-name "In directory: " | |
| 872 nil default-directory t))) | |
| 873 (list regexp files dir)))))) | |
| 874 (require 'grep) | |
| 875 (when (and (stringp regexp) (> (length regexp) 0)) | |
| 876 (let ((command regexp)) | |
| 877 (if (null files) | |
| 878 (if (string= command "git grep") | |
| 879 (setq command nil)) | |
| 880 (setq dir (file-name-as-directory (expand-file-name dir))) | |
| 881 (setq command | |
| 882 (grep-expand-template "git grep -n -e <R> -- <F>" regexp files)) | |
| 883 (when command | |
| 884 (if (equal current-prefix-arg '(4)) | |
| 885 (setq command | |
| 886 (read-from-minibuffer "Confirm: " | |
| 887 command nil nil 'grep-history)) | |
| 888 (add-to-history 'grep-history command)))) | |
| 889 (when command | |
| 890 (let ((default-directory dir) | |
| 891 (compilation-environment '("PAGER="))) | |
| 892 ;; Setting process-setup-function makes exit-message-function work | |
| 893 ;; even when async processes aren't supported. | |
| 894 (compilation-start command 'grep-mode)) | |
| 895 (if (eq next-error-last-buffer (current-buffer)) | |
| 896 (setq default-directory dir)))))) | |
| 897 | |
| 898 (defun vc-git-stash (name) | |
| 899 "Create a stash." | |
| 900 (interactive "sStash name: ") | |
| 901 (let ((root (vc-git-root default-directory))) | |
| 902 (when root | |
| 903 (vc-git--call nil "stash" "save" name) | |
| 904 (vc-resynch-buffer root t t)))) | |
| 905 | |
| 906 (defun vc-git-stash-show (name) | |
| 907 "Show the contents of stash NAME." | |
| 908 (interactive "sStash name: ") | |
| 909 (vc-setup-buffer "*vc-git-stash*") | |
| 910 (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name) | |
| 911 (set-buffer "*vc-git-stash*") | |
| 912 (diff-mode) | |
| 913 (setq buffer-read-only t) | |
| 914 (pop-to-buffer (current-buffer))) | |
| 915 | |
| 916 (defun vc-git-stash-apply (name) | |
| 917 "Apply stash NAME." | |
| 918 (interactive "sApply stash: ") | |
| 919 (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" name) | |
| 920 (vc-resynch-buffer (vc-git-root default-directory) t t)) | |
| 921 | |
| 922 (defun vc-git-stash-pop (name) | |
| 923 "Pop stash NAME." | |
| 924 (interactive "sPop stash: ") | |
| 925 (vc-git-command "*vc-git-stash*" 0 nil "stash" "pop" "-q" name) | |
| 926 (vc-resynch-buffer (vc-git-root default-directory) t t)) | |
| 927 | |
| 928 (defun vc-git-stash-snapshot () | |
| 929 "Create a stash with the current tree state." | |
| 930 (interactive) | |
| 931 (vc-git--call nil "stash" "save" | |
| 932 (let ((ct (current-time))) | |
| 933 (concat | |
| 934 (format-time-string "Snapshot on %Y-%m-%d" ct) | |
| 935 (format-time-string " at %H:%M" ct)))) | |
| 936 (vc-git-command "*vc-git-stash*" 0 nil "stash" "apply" "-q" "stash@{0}") | |
| 937 (vc-resynch-buffer (vc-git-root default-directory) t t)) | |
| 938 | |
| 939 (defun vc-git-stash-list () | |
| 940 (delete | |
| 941 "" | |
| 942 (split-string | |
| 943 (replace-regexp-in-string | |
| 944 "^stash@" " " (vc-git--run-command-string nil "stash" "list")) | |
| 945 "\n"))) | |
| 946 | |
| 947 (defun vc-git-stash-get-at-point (point) | |
| 948 (save-excursion | |
| 949 (goto-char point) | |
| 950 (beginning-of-line) | |
| 951 (if (looking-at "^ +\\({[0-9]+}\\):") | |
| 952 (match-string 1) | |
| 953 (error "Cannot find stash at point")))) | |
| 954 | |
| 955 (defun vc-git-stash-delete-at-point () | |
| 956 (interactive) | |
| 957 (let ((stash (vc-git-stash-get-at-point (point)))) | |
| 958 (when (y-or-n-p (format "Remove stash %s ? " stash)) | |
| 959 (vc-git--run-command-string nil "stash" "drop" (format "stash@%s" stash)) | |
| 960 (vc-dir-refresh)))) | |
| 961 | |
| 962 (defun vc-git-stash-show-at-point () | |
| 963 (interactive) | |
| 964 (vc-git-stash-show (format "stash@%s" (vc-git-stash-get-at-point (point))))) | |
| 965 | |
| 966 (defun vc-git-stash-apply-at-point () | |
| 967 (interactive) | |
| 968 (vc-git-stash-apply (format "stash@%s" (vc-git-stash-get-at-point (point))))) | |
| 969 | |
| 970 (defun vc-git-stash-pop-at-point () | |
| 971 (interactive) | |
| 972 (vc-git-stash-pop (format "stash@%s" (vc-git-stash-get-at-point (point))))) | |
| 973 | |
| 974 (defun vc-git-stash-menu (e) | |
| 975 (interactive "e") | |
| 976 (vc-dir-at-event e (popup-menu vc-git-stash-menu-map e))) | |
| 977 | |
| 978 | |
| 979 ;;; Internal commands | |
| 980 | |
| 981 (defun vc-git-command (buffer okstatus file-or-list &rest flags) | |
| 982 "A wrapper around `vc-do-command' for use in vc-git.el. | |
| 983 The difference to vc-do-command is that this function always invokes `git'." | |
| 984 (apply 'vc-do-command (or buffer "*vc*") okstatus "git" file-or-list flags)) | |
| 985 | |
| 986 (defun vc-git--empty-db-p () | |
| 987 "Check if the git db is empty (no commit done yet)." | |
| 988 (let (process-file-side-effects) | |
| 989 (not (eq 0 (vc-git--call nil "rev-parse" "--verify" "HEAD"))))) | |
| 990 | |
| 991 (defun vc-git--call (buffer command &rest args) | |
| 992 ;; We don't need to care the arguments. If there is a file name, it | |
| 993 ;; is always a relative one. This works also for remote | |
| 994 ;; directories. | |
| 995 (apply 'process-file "git" nil buffer nil command args)) | |
| 996 | |
| 997 (defun vc-git--out-ok (command &rest args) | |
| 998 (zerop (apply 'vc-git--call '(t nil) command args))) | |
| 999 | |
| 1000 (defun vc-git--run-command-string (file &rest args) | |
| 1001 "Run a git command on FILE and return its output as string. | |
| 1002 FILE can be nil." | |
| 1003 (let* ((ok t) | |
| 1004 (str (with-output-to-string | |
| 1005 (with-current-buffer standard-output | |
| 1006 (unless (apply 'vc-git--out-ok | |
| 1007 (if file | |
| 1008 (append args (list (file-relative-name | |
| 1009 file))) | |
| 1010 args)) | |
| 1011 (setq ok nil)))))) | |
| 1012 (and ok str))) | |
| 1013 | |
| 1014 (defun vc-git-symbolic-commit (commit) | |
| 1015 "Translate COMMIT string into symbolic form. | |
| 1016 Returns nil if not possible." | |
| 1017 (and commit | |
| 1018 (let ((name (with-temp-buffer | |
| 1019 (and | |
| 1020 (vc-git--out-ok "name-rev" "--name-only" commit) | |
| 1021 (goto-char (point-min)) | |
| 1022 (= (forward-line 2) 1) | |
| 1023 (bolp) | |
| 1024 (buffer-substring-no-properties (point-min) | |
| 1025 (1- (point-max))))))) | |
| 1026 (and name (not (string= name "undefined")) name)))) | |
| 1027 | |
| 1028 (provide 'vc-git) | |
| 1029 | |
| 1030 ;; arch-tag: bd10664a-0e5b-48f5-a877-6c17b135be12 | |
| 1031 ;;; vc-git.el ends here |