comparison lisp/vc-git.el @ 104043:772f278e1024

(vc-git--run-command-string): Accept a nil FILE argument. (vc-git-stash-list): New function. (vc-git-dir-extra-headers): Use it.
author Dan Nicolaescu <dann@ics.uci.edu>
date Thu, 23 Jul 2009 06:42:50 +0000
parents 1416a5bb9353
children 67098a669a4c
comparison
equal deleted inserted replaced
104042:47d49939ab41 104043:772f278e1024
398 (vc-git-dir-status-goto-stage 'update-index files update-function)) 398 (vc-git-dir-status-goto-stage 'update-index files update-function))
399 399
400 (defun vc-git-dir-extra-headers (dir) 400 (defun vc-git-dir-extra-headers (dir)
401 (let ((str (with-output-to-string 401 (let ((str (with-output-to-string
402 (with-current-buffer standard-output 402 (with-current-buffer standard-output
403 (vc-git--out-ok "symbolic-ref" "HEAD"))))) 403 (vc-git--out-ok "symbolic-ref" "HEAD"))))
404 (stash (vc-git-stash-list)))
405 ;; FIXME: maybe use a different face when nothing is stashed.
406 (when (string= stash "") (setq stash "Nothing stashed"))
404 (concat 407 (concat
405 (propertize "Branch : " 'face 'font-lock-type-face) 408 (propertize "Branch : " 'face 'font-lock-type-face)
406 (propertize 409 (propertize
407 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str) 410 (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
408 (match-string 2 str) 411 (match-string 2 str)
409 "not (detached HEAD)") 412 "not (detached HEAD)")
413 'face 'font-lock-variable-name-face)
414 "\n"
415 (propertize "Stash : " 'face 'font-lock-type-face)
416 (propertize
417 stash
410 'face 'font-lock-variable-name-face)))) 418 'face 'font-lock-variable-name-face))))
411 419
412 ;;; STATE-CHANGING FUNCTIONS 420 ;;; STATE-CHANGING FUNCTIONS
413 421
414 (defun vc-git-create-repo () 422 (defun vc-git-create-repo ()
706 ;; Setting process-setup-function makes exit-message-function work 714 ;; Setting process-setup-function makes exit-message-function work
707 ;; even when async processes aren't supported. 715 ;; even when async processes aren't supported.
708 (compilation-start command 'grep-mode)) 716 (compilation-start command 'grep-mode))
709 (if (eq next-error-last-buffer (current-buffer)) 717 (if (eq next-error-last-buffer (current-buffer))
710 (setq default-directory dir)))))) 718 (setq default-directory dir))))))
719
720 (defun vc-git-stash-list ()
721 (replace-regexp-in-string
722 "\n" "\n "
723 (replace-regexp-in-string
724 "^stash@" "" (vc-git--run-command-string nil "stash" "list"))))
725
711 726
712 ;;; Internal commands 727 ;;; Internal commands
713 728
714 (defun vc-git-root (file) 729 (defun vc-git-root (file)
715 (vc-find-root file ".git")) 730 (vc-find-root file ".git"))
731 746
732 (defun vc-git--out-ok (command &rest args) 747 (defun vc-git--out-ok (command &rest args)
733 (zerop (apply 'vc-git--call '(t nil) command args))) 748 (zerop (apply 'vc-git--call '(t nil) command args)))
734 749
735 (defun vc-git--run-command-string (file &rest args) 750 (defun vc-git--run-command-string (file &rest args)
736 "Run a git command on FILE and return its output as string." 751 "Run a git command on FILE and return its output as string.
752 FILE can be nil."
737 (let* ((ok t) 753 (let* ((ok t)
738 (str (with-output-to-string 754 (str (with-output-to-string
739 (with-current-buffer standard-output 755 (with-current-buffer standard-output
740 (unless (apply 'vc-git--out-ok 756 (unless (apply 'vc-git--out-ok
741 (append args (list (file-relative-name 757 (if file
742 file)))) 758 (append args (list (file-relative-name
759 file)))
760 args))
743 (setq ok nil)))))) 761 (setq ok nil))))))
744 (and ok str))) 762 (and ok str)))
745 763
746 (defun vc-git-symbolic-commit (commit) 764 (defun vc-git-symbolic-commit (commit)
747 "Translate COMMIT string into symbolic form. 765 "Translate COMMIT string into symbolic form.