Merge branch 'jc/pack'
[gitweb.git] / contrib / emacs / git.el
index 5135e361be46af0b4ffce03fc8582a7a6ad25970..68de9be0c7cca8645275a042900766b6ea2712c7 100644 (file)
 ;;;; ------------------------------------------------------------
 
 (defgroup git nil
-  "Git user interface")
+  "A user interface for the git versioning system."
+  :group 'tools)
 
 (defcustom git-committer-name nil
   "User name to use for commits.
-The default is to fall back to `add-log-full-name' and then `user-full-name'."
+The default is to fall back to the repository config,
+then to `add-log-full-name' and then to `user-full-name'."
   :group 'git
   :type '(choice (const :tag "Default" nil)
                  (string :tag "Name")))
 
 (defcustom git-committer-email nil
   "Email address to use for commits.
-The default is to fall back to `add-log-mailing-address' and then `user-mail-address'."
+The default is to fall back to the git repository config,
+then to `add-log-mailing-address' and then to `user-mail-address'."
   :group 'git
   :type '(choice (const :tag "Default" nil)
                  (string :tag "Email")))
@@ -81,11 +84,18 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
   :group 'git
   :type 'boolean)
 
+(defcustom git-reuse-status-buffer t
+  "Whether `git-status' should try to reuse an existing buffer
+if there is already one that displays the same directory."
+  :group 'git
+  :type 'boolean)
+
 (defcustom git-per-dir-ignore-file ".gitignore"
   "Name of the per-directory ignore file."
   :group 'git
   :type 'string)
 
+
 (defface git-status-face
   '((((class color) (background light)) (:foreground "purple")))
   "Git mode face used to highlight added and modified files."
@@ -148,6 +158,13 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
              (append (git-get-env-strings env) (list "git") args))
     (apply #'call-process "git" nil buffer nil args)))
 
+(defun git-call-process-env-string (env &rest args)
+  "Wrapper for call-process that sets environment strings,
+and returns the process output as a string."
+  (with-temp-buffer
+    (and (eq 0 (apply #' git-call-process-env t env args))
+         (buffer-string))))
+
 (defun git-run-process-region (buffer start end program args)
   "Run a git process with a buffer region as input."
   (let ((output-buffer (current-buffer))
@@ -189,13 +206,15 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
 
 (defun git-get-string-sha1 (string)
   "Read a SHA1 from the specified string."
-  (let ((pos (string-match "[0-9a-f]\\{40\\}" string)))
-    (and pos (substring string pos (match-end 0)))))
+  (and string
+       (string-match "[0-9a-f]\\{40\\}" string)
+       (match-string 0 string)))
 
 (defun git-get-committer-name ()
   "Return the name to use as GIT_COMMITTER_NAME."
   ; copied from log-edit
   (or git-committer-name
+      (git-repo-config "user.name")
       (and (boundp 'add-log-full-name) add-log-full-name)
       (and (fboundp 'user-full-name) (user-full-name))
       (and (boundp 'user-full-name) user-full-name)))
@@ -204,6 +223,7 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
   "Return the email address to use as GIT_COMMITTER_EMAIL."
   ; copied from log-edit
   (or git-committer-email
+      (git-repo-config "user.email")
       (and (boundp 'add-log-mailing-address) add-log-mailing-address)
       (and (fboundp 'user-mail-address) (user-mail-address))
       (and (boundp 'user-mail-address) user-mail-address)))
@@ -245,7 +265,7 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
     (set-buffer (find-file-noselect ignore-name))
     (goto-char (point-max))
     (unless (zerop (current-column)) (insert "\n"))
-    (insert name "\n")
+    (insert "/" name "\n")
     (sort-lines nil (point-min) (point-max))
     (save-buffer))
   (when created
@@ -259,18 +279,17 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
 (defun git-rev-parse (rev)
   "Parse a revision name and return its SHA1."
   (git-get-string-sha1
-   (with-output-to-string
-     (with-current-buffer standard-output
-       (git-call-process-env t nil "rev-parse" rev)))))
+   (git-call-process-env-string nil "rev-parse" rev)))
+
+(defun git-repo-config (key)
+  "Retrieve the value associated to KEY in the git repository config file."
+  (let ((str (git-call-process-env-string nil "repo-config" key)))
+    (and str (car (split-string str "\n")))))
 
 (defun git-symbolic-ref (ref)
   "Wrapper for the git-symbolic-ref command."
-  (car
-   (split-string
-    (with-output-to-string
-      (with-current-buffer standard-output
-        (git-call-process-env t nil "symbolic-ref" ref)))
-    "\n")))
+  (let ((str (git-call-process-env-string nil "symbolic-ref" ref)))
+    (and str (car (split-string str "\n")))))
 
 (defun git-update-ref (ref val &optional oldval)
   "Update a reference by calling git-update-ref."
@@ -285,11 +304,7 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
 (defun git-write-tree (&optional index-file)
   "Call git-write-tree and return the resulting tree SHA1 as a string."
   (git-get-string-sha1
-   (with-output-to-string
-     (with-current-buffer standard-output
-       (git-call-process-env t
-        (if index-file `(("GIT_INDEX_FILE" . ,index-file)) nil)
-        "write-tree")))))
+   (git-call-process-env-string (and index-file `(("GIT_INDEX_FILE" . ,index-file))) "write-tree")))
 
 (defun git-commit-tree (buffer tree head)
   "Call git-commit-tree with buffer as input and return the resulting commit SHA1."
@@ -576,6 +591,8 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
                             (condition-case nil (delete-file ".git/MERGE_HEAD") (error nil))
                             (with-current-buffer buffer (erase-buffer))
                             (git-set-files-state files 'uptodate)
+                            (when (file-directory-p ".git/rr-cache")
+                              (git-run-command nil nil "rerere"))
                             (git-refresh-files)
                             (git-refresh-ewoc-hf git-status)
                             (message "Committed %s." commit))
@@ -763,6 +780,16 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
     (git-setup-diff-buffer
      (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M" "HEAD" "--" (git-get-filenames files)))))
 
+(defun git-diff-file-merge-head (arg)
+  "Diff the marked file(s) against the first merge head (or the nth one with a numeric prefix)."
+  (interactive "p")
+  (let ((files (git-marked-files))
+        (merge-heads (git-get-merge-heads)))
+    (unless merge-heads (error "No merge in progress"))
+    (git-setup-diff-buffer
+     (apply #'git-run-command-buffer "*git-diff*" "diff-index" "-p" "-M"
+            (or (nth (1- arg) merge-heads) "HEAD") "--" (git-get-filenames files)))))
+
 (defun git-diff-unmerged-file (stage)
   "Diff the marked unmerged file(s) against the specified stage."
   (let ((files (git-marked-files)))
@@ -925,6 +952,8 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
   (let ((map (make-keymap))
         (diff-map (make-sparse-keymap)))
     (suppress-keymap map)
+    (define-key map "?"   'git-help)
+    (define-key map "h"   'git-help)
     (define-key map " "   'git-next-file)
     (define-key map "a"   'git-add-file)
     (define-key map "c"   'git-commit-file)
@@ -955,6 +984,7 @@ The default is to fall back to `add-log-mailing-address' and then `user-mail-add
     (define-key diff-map "=" 'git-diff-file)
     (define-key diff-map "e" 'git-diff-file-idiff)
     (define-key diff-map "E" 'git-find-file-imerge)
+    (define-key diff-map "h" 'git-diff-file-merge-head)
     (define-key diff-map "m" 'git-diff-file-mine)
     (define-key diff-map "o" 'git-diff-file-other)
     (setq git-status-mode-map map)))
@@ -980,12 +1010,28 @@ Commands:
   (set (make-local-variable 'list-buffers-directory) default-directory)
   (run-hooks 'git-status-mode-hook)))
 
+(defun git-find-status-buffer (dir)
+  "Find the git status buffer handling a specified directory."
+  (let ((list (buffer-list))
+        (fulldir (expand-file-name dir))
+        found)
+    (while (and list (not found))
+      (let ((buffer (car list)))
+        (with-current-buffer buffer
+          (when (and list-buffers-directory
+                     (string-equal fulldir (expand-file-name list-buffers-directory))
+                     (string-match "\\*git-status\\*$" (buffer-name buffer)))
+            (setq found buffer))))
+      (setq list (cdr list)))
+    found))
+
 (defun git-status (dir)
   "Entry point into git-status mode."
   (interactive "DSelect directory: ")
   (setq dir (git-get-top-dir dir))
   (if (file-directory-p (concat (file-name-as-directory dir) ".git"))
-      (let ((buffer (create-file-buffer (expand-file-name "*git-status*" dir))))
+      (let ((buffer (or (and git-reuse-status-buffer (git-find-status-buffer dir))
+                        (create-file-buffer (expand-file-name "*git-status*" dir)))))
         (switch-to-buffer buffer)
         (cd dir)
         (git-status-mode)
@@ -993,5 +1039,10 @@ Commands:
         (goto-char (point-min)))
     (message "%s is not a git working tree." dir)))
 
+(defun git-help ()
+  "Display help for Git mode."
+  (interactive)
+  (describe-function 'git-status-mode))
+
 (provide 'git)
 ;;; git.el ends here