mirrors/git
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'for-junio' of git://source.winehq.org/~julliard/git/git

Browse Source 
* 'for-junio' of git://source.winehq.org/~julliard/git/git:
  git.el: Allow to commit even if there are no marked files.
  git.el: Add possibility to mark files directly in git-update-status-files.
  git.el: Add an insert file command.
  git.el: Never clear the status buffer, only update the files.
  git.el: Fix git-amend-commit to support amending an initial commit.
  git.el: Properly handle merge commits in git-amend-commit.
  git.el: Simplify handling of merge heads in the commit log-edit buffer.
  git.el: Remove the env parameter in git-call-process and git-call-process-string.
  git.el: Improve error handling for commits.
This commit is contained in:
Junio C Hamano
2008-11-25 21:52:28 -08:00
parent ef3b38b445 1905a8666a
commit f20706220b
1 changed files with 177 additions and 160 deletions
Download Patch File Download Diff File Expand all files Collapse all files

337
contrib/emacs/git.el
View File

@ -173,7 +173,7 @@ if there is already one that displays the same directory."
(defconst git-log-msg-separator "--- log message follows this line ---") (defconst git-log-msg-separator "--- log message follows this line ---")
(defvar git-log-edit-font-lock-keywords (defvar git-log-edit-font-lock-keywords
`(("^\\(Author:\\|Date:\\|Parent:\\|Signed-off-by:\\)\\(.*\\)$" `(("^\\(Author:\\|Date:\\|Merge:\\|Signed-off-by:\\)\\(.*\\)$"
(1 font-lock-keyword-face) (1 font-lock-keyword-face)
(2 font-lock-function-name-face)) (2 font-lock-function-name-face))
(,(concat "^\\(" (regexp-quote git-log-msg-separator) "\\)$") (,(concat "^\\(" (regexp-quote git-log-msg-separator) "\\)$")
@ -183,11 +183,9 @@ if there is already one that displays the same directory."
"Build a list of NAME=VALUE strings from a list of environment strings." "Build a list of NAME=VALUE strings from a list of environment strings."
(mapcar (lambda (entry) (concat (car entry) "=" (cdr entry))) env)) (mapcar (lambda (entry) (concat (car entry) "=" (cdr entry))) env))
(defun git-call-process-env (buffer env &rest args) (defun git-call-process (buffer &rest args)
"Wrapper for call-process that sets environment strings." "Wrapper for call-process that sets environment strings."
(let ((process-environment (append (git-get-env-strings env) (apply #'call-process "git" nil buffer nil args))
process-environment)))
(apply #'call-process "git" nil buffer nil args)))
(defun git-call-process-display-error (&rest args) (defun git-call-process-display-error (&rest args)
"Wrapper for call-process that displays error messages." "Wrapper for call-process that displays error messages."
@ -197,17 +195,26 @@ if there is already one that displays the same directory."
(let ((default-directory dir) (let ((default-directory dir)
(buffer-read-only nil)) (buffer-read-only nil))
(erase-buffer) (erase-buffer)
(eq 0 (apply 'call-process "git" nil (list buffer t) nil args)))))) (eq 0 (apply #'git-call-process (list buffer t) args))))))
(unless ok (display-message-or-buffer buffer)) (unless ok (display-message-or-buffer buffer))
ok)) ok))
(defun git-call-process-env-string (env &rest args) (defun git-call-process-string (&rest args)
"Wrapper for call-process that sets environment strings, "Wrapper for call-process that returns the process output as a string,
and returns the process output as a string, or nil if the git failed." or nil if the git command failed."
(with-temp-buffer (with-temp-buffer
(and (eq 0 (apply #' git-call-process-env t env args)) (and (eq 0 (apply #'git-call-process t args))
(buffer-string)))) (buffer-string))))
(defun git-call-process-string-display-error (&rest args)
"Wrapper for call-process that displays error message and returns
the process output as a string, or nil if the git command failed."
(with-temp-buffer
(if (eq 0 (apply #'git-call-process (list t t) args))
(buffer-string)
(display-message-or-buffer (current-buffer))
nil)))
(defun git-run-process-region (buffer start end program args) (defun git-run-process-region (buffer start end program args)
"Run a git process with a buffer region as input." "Run a git process with a buffer region as input."
(let ((output-buffer (current-buffer)) (let ((output-buffer (current-buffer))
@ -226,7 +233,7 @@ and returns the process output as a string, or nil if the git failed."
(let ((default-directory dir) (let ((default-directory dir)
(buffer-read-only nil)) (buffer-read-only nil))
(erase-buffer) (erase-buffer)
(apply #'git-call-process-env buffer nil args))) (apply #'git-call-process buffer args)))
(message "Running git %s...done" (car args)) (message "Running git %s...done" (car args))
buffer)) buffer))
@ -327,7 +334,7 @@ and returns the process output as a string, or nil if the git failed."
(let ((cdup (with-output-to-string (let ((cdup (with-output-to-string
(with-current-buffer standard-output (with-current-buffer standard-output
(cd dir) (cd dir)
(unless (eq 0 (call-process "git" nil t nil "rev-parse" "--show-cdup")) (unless (eq 0 (git-call-process t "rev-parse" "--show-cdup"))
(error "cannot find top-level git tree for %s." dir)))))) (error "cannot find top-level git tree for %s." dir))))))
(expand-file-name (concat (file-name-as-directory dir) (expand-file-name (concat (file-name-as-directory dir)
(car (split-string cdup "\n")))))) (car (split-string cdup "\n"))))))
@ -348,8 +355,8 @@ and returns the process output as a string, or nil if the git failed."
(sort-lines nil (point-min) (point-max)) (sort-lines nil (point-min) (point-max))
(save-buffer)) (save-buffer))
(when created (when created
(git-call-process-env nil nil "update-index" "--add" "--" (file-relative-name ignore-name))) (git-call-process nil "update-index" "--add" "--" (file-relative-name ignore-name)))
(git-update-status-files (list (file-relative-name ignore-name)) 'unknown))) (git-update-status-files (list (file-relative-name ignore-name)))))
; propertize definition for XEmacs, stolen from erc-compat ; propertize definition for XEmacs, stolen from erc-compat
(eval-when-compile (eval-when-compile
@ -367,38 +374,41 @@ and returns the process output as a string, or nil if the git failed."
(defun git-rev-parse (rev) (defun git-rev-parse (rev)
"Parse a revision name and return its SHA1." "Parse a revision name and return its SHA1."
(git-get-string-sha1 (git-get-string-sha1
(git-call-process-env-string nil "rev-parse" rev))) (git-call-process-string "rev-parse" rev)))
(defun git-config (key) (defun git-config (key)
"Retrieve the value associated to KEY in the git repository config file." "Retrieve the value associated to KEY in the git repository config file."
(let ((str (git-call-process-env-string nil "config" key))) (let ((str (git-call-process-string "config" key)))
(and str (car (split-string str "\n"))))) (and str (car (split-string str "\n")))))
(defun git-symbolic-ref (ref) (defun git-symbolic-ref (ref)
"Wrapper for the git-symbolic-ref command." "Wrapper for the git-symbolic-ref command."
(let ((str (git-call-process-env-string nil "symbolic-ref" ref))) (let ((str (git-call-process-string "symbolic-ref" ref)))
(and str (car (split-string str "\n"))))) (and str (car (split-string str "\n")))))
(defun git-update-ref (ref newval &optional oldval reason) (defun git-update-ref (ref newval &optional oldval reason)
"Update a reference by calling git-update-ref." "Update a reference by calling git-update-ref."
(let ((args (and oldval (list oldval)))) (let ((args (and oldval (list oldval))))
(push newval args) (when newval (push newval args))
(push ref args) (push ref args)
(when reason (when reason
(push reason args) (push reason args)
(push "-m" args)) (push "-m" args))
(unless newval (push "-d" args))
(apply 'git-call-process-display-error "update-ref" args))) (apply 'git-call-process-display-error "update-ref" args)))
(defun git-read-tree (tree &optional index-file) (defun git-read-tree (tree &optional index-file)
"Read a tree into the index file." "Read a tree into the index file."
(apply #'git-call-process-env nil (let ((process-environment
(if index-file `(("GIT_INDEX_FILE" . ,index-file)) nil) (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file))) process-environment)))
"read-tree" (if tree (list tree)))) (apply 'git-call-process-display-error "read-tree" (if tree (list tree)))))
(defun git-write-tree (&optional index-file) (defun git-write-tree (&optional index-file)
"Call git-write-tree and return the resulting tree SHA1 as a string." "Call git-write-tree and return the resulting tree SHA1 as a string."
(git-get-string-sha1 (let ((process-environment
(git-call-process-env-string (and index-file `(("GIT_INDEX_FILE" . ,index-file))) "write-tree"))) (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file))) process-environment)))
(git-get-string-sha1
(git-call-process-string-display-error "write-tree"))))
(defun git-commit-tree (buffer tree head) (defun git-commit-tree (buffer tree head)
"Call git-commit-tree with buffer as input and return the resulting commit SHA1." "Call git-commit-tree with buffer as input and return the resulting commit SHA1."
@ -424,11 +434,11 @@ and returns the process output as a string, or nil if the git failed."
(when (re-search-forward "^Date: +\\(.*\\)$" nil t) (when (re-search-forward "^Date: +\\(.*\\)$" nil t)
(setq author-date (match-string 1))) (setq author-date (match-string 1)))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "^Parent: +\\([0-9a-f]+\\)" nil t) (when (re-search-forward "^Merge: +\\(.*\\)" nil t)
(unless (string-equal head (match-string 1)) (setq subject "commit (merge): ")
(setq subject "commit (merge): ") (dolist (parent (split-string (match-string 1) " +" t))
(push "-p" args) (push "-p" args)
(push (match-string 1) args)))) (push parent args))))
(setq log-start (point-min))) (setq log-start (point-min)))
(setq log-end (point-max)) (setq log-end (point-max))
(goto-char log-start) (goto-char log-start)
@ -452,7 +462,7 @@ and returns the process output as a string, or nil if the git failed."
(defun git-empty-db-p () (defun git-empty-db-p ()
"Check if the git db is empty (no commit done yet)." "Check if the git db is empty (no commit done yet)."
(not (eq 0 (call-process "git" nil nil nil "rev-parse" "--verify" "HEAD")))) (not (eq 0 (git-call-process nil "rev-parse" "--verify" "HEAD"))))
(defun git-get-merge-heads () (defun git-get-merge-heads ()
"Retrieve the merge heads from the MERGE_HEAD file if present." "Retrieve the merge heads from the MERGE_HEAD file if present."
@ -468,7 +478,7 @@ and returns the process output as a string, or nil if the git failed."
(defun git-get-commit-description (commit) (defun git-get-commit-description (commit)
"Get a one-line description of COMMIT." "Get a one-line description of COMMIT."
(let ((coding-system-for-read (git-get-logoutput-coding-system))) (let ((coding-system-for-read (git-get-logoutput-coding-system)))
(let ((descr (git-call-process-env-string nil "log" "--max-count=1" "--pretty=oneline" commit))) (let ((descr (git-call-process-string "log" "--max-count=1" "--pretty=oneline" commit)))
(if (and descr (string-match "\\`\\([0-9a-f]\\{40\\}\\) *\\(.*\\)$" descr)) (if (and descr (string-match "\\`\\([0-9a-f]\\{40\\}\\) *\\(.*\\)$" descr))
(concat (substring (match-string 1 descr) 0 10) " - " (match-string 2 descr)) (concat (substring (match-string 1 descr) 0 10) " - " (match-string 2 descr))
descr)))) descr))))
@ -487,14 +497,11 @@ and returns the process output as a string, or nil if the git failed."
old-perm new-perm ;; permission flags old-perm new-perm ;; permission flags
rename-state ;; rename or copy state rename-state ;; rename or copy state
orig-name ;; original name for renames or copies orig-name ;; original name for renames or copies
needs-update ;; whether file needs to be updated
needs-refresh) ;; whether file needs to be refreshed needs-refresh) ;; whether file needs to be refreshed
(defvar git-status nil) (defvar git-status nil)
(defun git-clear-status (status)
"Remove everything from the status list."
(ewoc-filter status (lambda (info) nil)))
(defun git-set-fileinfo-state (info state) (defun git-set-fileinfo-state (info state)
"Set the state of a file info." "Set the state of a file info."
(unless (eq (git-fileinfo->state info) state) (unless (eq (git-fileinfo->state info) state)
@ -502,6 +509,7 @@ and returns the process output as a string, or nil if the git failed."
(git-fileinfo->new-perm info) (git-fileinfo->old-perm info) (git-fileinfo->new-perm info) (git-fileinfo->old-perm info)
(git-fileinfo->rename-state info) nil (git-fileinfo->rename-state info) nil
(git-fileinfo->orig-name info) nil (git-fileinfo->orig-name info) nil
(git-fileinfo->needs-update info) nil
(git-fileinfo->needs-refresh info) t))) (git-fileinfo->needs-refresh info) t)))
(defun git-status-filenames-map (status func files &rest args) (defun git-status-filenames-map (status func files &rest args)
@ -511,10 +519,11 @@ and returns the process output as a string, or nil if the git failed."
(let ((file (pop files)) (let ((file (pop files))
(node (ewoc-nth status 0))) (node (ewoc-nth status 0)))
(while (and file node) (while (and file node)
(let ((info (ewoc-data node))) (let* ((info (ewoc-data node))
(if (string-lessp (git-fileinfo->name info) file) (name (git-fileinfo->name info)))
(if (string-lessp name file)
(setq node (ewoc-next status node)) (setq node (ewoc-next status node))
(if (string-equal (git-fileinfo->name info) file) (if (string-equal name file)
(apply func info args)) (apply func info args))
(setq file (pop files)))))))) (setq file (pop files))))))))
@ -612,39 +621,52 @@ and returns the process output as a string, or nil if the git failed."
(git-file-type-as-string old-perm new-perm) (git-file-type-as-string old-perm new-perm)
(git-rename-as-string info))))) (git-rename-as-string info)))))
(defun git-insert-info-list (status infolist) (defun git-update-node-fileinfo (node info)
"Insert a list of file infos in the status buffer, replacing existing ones if any." "Update the fileinfo of the specified node. The names are assumed to match already."
(setq infolist (sort infolist (let ((data (ewoc-data node)))
(lambda (info1 info2) (setf
(string-lessp (git-fileinfo->name info1) ;; preserve the marked flag
(git-fileinfo->name info2))))) (git-fileinfo->marked info) (git-fileinfo->marked data)
(let ((info (pop infolist)) (git-fileinfo->needs-update data) nil)
(node (ewoc-nth status 0))) (when (not (equal info data))
(setf (git-fileinfo->needs-refresh info) t
(ewoc-data node) info))))
(defun git-insert-info-list (status infolist files)
"Insert a sorted list of file infos in the status buffer, replacing existing ones if any."
(let* ((info (pop infolist))
(node (ewoc-nth status 0))
(name (and info (git-fileinfo->name info)))
remaining)
(while info (while info
(cond ((not node) (let ((nodename (and node (git-fileinfo->name (ewoc-data node)))))
(setq node (ewoc-enter-last status info)) (while (and files (string-lessp (car files) name))
(setq info (pop infolist))) (push (pop files) remaining))
((string-lessp (git-fileinfo->name (ewoc-data node)) (when (and files (string-equal (car files) name))
(git-fileinfo->name info)) (setq files (cdr files)))
(setq node (ewoc-next status node))) (cond ((not nodename)
((string-equal (git-fileinfo->name (ewoc-data node)) (setq node (ewoc-enter-last status info))
(git-fileinfo->name info)) (setq info (pop infolist))
;; preserve the marked flag (setq name (and info (git-fileinfo->name info))))
(setf (git-fileinfo->marked info) (git-fileinfo->marked (ewoc-data node))) ((string-lessp nodename name)
(setf (git-fileinfo->needs-refresh info) t) (setq node (ewoc-next status node)))
(setf (ewoc-data node) info) ((string-equal nodename name)
(setq info (pop infolist))) ;; preserve the marked flag
(t (git-update-node-fileinfo node info)
(setq node (ewoc-enter-before status node info)) (setq info (pop infolist))
(setq info (pop infolist))))))) (setq name (and info (git-fileinfo->name info))))
(t
(setq node (ewoc-enter-before status node info))
(setq info (pop infolist))
(setq name (and info (git-fileinfo->name info)))))))
(nconc (nreverse remaining) files)))
(defun git-run-diff-index (status files) (defun git-run-diff-index (status files)
"Run git-diff-index on FILES and parse the results into STATUS. "Run git-diff-index on FILES and parse the results into STATUS.
Return the list of files that haven't been handled." Return the list of files that haven't been handled."
(let ((remaining (copy-sequence files)) (let (infolist)
infolist)
(with-temp-buffer (with-temp-buffer
(apply #'git-call-process-env t nil "diff-index" "-z" "-M" "HEAD" "--" files) (apply #'git-call-process t "diff-index" "-z" "-M" "HEAD" "--" files)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMUT]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0" ":\\([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"
@ -659,11 +681,12 @@ Return the list of files that haven't been handled."
(push (git-create-fileinfo 'added new-name old-perm new-perm 'copy name) infolist) (push (git-create-fileinfo 'added new-name old-perm new-perm 'copy name) infolist)
(push (git-create-fileinfo 'deleted name 0 0 'rename new-name) infolist) (push (git-create-fileinfo 'deleted name 0 0 'rename new-name) infolist)
(push (git-create-fileinfo 'added new-name old-perm new-perm 'rename name) infolist)) (push (git-create-fileinfo 'added new-name old-perm new-perm 'rename name) infolist))
(push (git-create-fileinfo (git-state-code state) name old-perm new-perm) infolist)) (push (git-create-fileinfo (git-state-code state) name old-perm new-perm) infolist)))))
(setq remaining (delete name remaining)) (setq infolist (sort (nreverse infolist)
(when new-name (setq remaining (delete new-name remaining)))))) (lambda (info1 info2)
(git-insert-info-list status infolist) (string-lessp (git-fileinfo->name info1)
remaining)) (git-fileinfo->name info2)))))
(git-insert-info-list status infolist files)))
(defun git-find-status-file (status file) (defun git-find-status-file (status file)
"Find a given file in the status ewoc and return its node." "Find a given file in the status ewoc and return its node."
@ -677,38 +700,35 @@ Return the list of files that haven't been handled."
Return the list of files that haven't been handled." Return the list of files that haven't been handled."
(let (infolist) (let (infolist)
(with-temp-buffer (with-temp-buffer
(apply #'git-call-process-env t nil "ls-files" "-z" (append options (list "--") files)) (apply #'git-call-process t "ls-files" "-z" (append options (list "--") files))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\\([^\0]*?\\)\\(/?\\)\0" nil t 1) (while (re-search-forward "\\([^\0]*?\\)\\(/?\\)\0" nil t 1)
(let ((name (match-string 1))) (let ((name (match-string 1)))
(push (git-create-fileinfo default-state name 0 (push (git-create-fileinfo default-state name 0
(if (string-equal "/" (match-string 2)) (lsh ?\110 9) 0)) (if (string-equal "/" (match-string 2)) (lsh ?\110 9) 0))
infolist) infolist))))
(setq files (delete name files))))) (setq infolist (nreverse infolist)) ;; assume it is sorted already
(git-insert-info-list status infolist) (git-insert-info-list status infolist files)))
files))
(defun git-run-ls-files-cached (status files default-state) (defun git-run-ls-files-cached (status files default-state)
"Run git-ls-files -c on FILES and parse the results into STATUS. "Run git-ls-files -c on FILES and parse the results into STATUS.
Return the list of files that haven't been handled." Return the list of files that haven't been handled."
(let ((remaining (copy-sequence files)) (let (infolist)
infolist)
(with-temp-buffer (with-temp-buffer
(apply #'git-call-process-env t nil "ls-files" "-z" "-s" "-c" "--" files) (apply #'git-call-process t "ls-files" "-z" "-s" "-c" "--" files)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t) (while (re-search-forward "\\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} 0\t\\([^\0]+\\)\0" nil t)
(let* ((new-perm (string-to-number (match-string 1) 8)) (let* ((new-perm (string-to-number (match-string 1) 8))
(old-perm (if (eq default-state 'added) 0 new-perm)) (old-perm (if (eq default-state 'added) 0 new-perm))
(name (match-string 2))) (name (match-string 2)))
(push (git-create-fileinfo default-state name old-perm new-perm) infolist) (push (git-create-fileinfo default-state name old-perm new-perm) infolist))))
(setq remaining (delete name remaining))))) (setq infolist (nreverse infolist)) ;; assume it is sorted already
(git-insert-info-list status infolist) (git-insert-info-list status infolist files)))
remaining))
(defun git-run-ls-unmerged (status files) (defun git-run-ls-unmerged (status files)
"Run git-ls-files -u on FILES and parse the results into STATUS." "Run git-ls-files -u on FILES and parse the results into STATUS."
(with-temp-buffer (with-temp-buffer
(apply #'git-call-process-env t nil "ls-files" "-z" "-u" "--" files) (apply #'git-call-process t "ls-files" "-z" "-u" "--" files)
(goto-char (point-min)) (goto-char (point-min))
(let (unmerged-files) (let (unmerged-files)
(while (re-search-forward "[0-7]\\{6\\} [0-9a-f]\\{40\\} [123]\t\\([^\0]+\\)\0" nil t) (while (re-search-forward "[0-7]\\{6\\} [0-9a-f]\\{40\\} [123]\t\\([^\0]+\\)\0" nil t)
@ -732,11 +752,17 @@ Return the list of files that haven't been handled."
(concat "--exclude-per-directory=" git-per-dir-ignore-file) (concat "--exclude-per-directory=" git-per-dir-ignore-file)
(append options (mapcar (lambda (f) (concat "--exclude-from=" f)) exclude-files))))) (append options (mapcar (lambda (f) (concat "--exclude-from=" f)) exclude-files)))))
(defun git-update-status-files (files &optional default-state) (defun git-update-status-files (&optional files mark-files)
"Update the status of FILES from the index." "Update the status of FILES from the index."
(unless git-status (error "Not in git-status buffer.")) (unless git-status (error "Not in git-status buffer."))
(when (or git-show-uptodate files) ;; set the needs-update flag on existing files
(git-run-ls-files-cached git-status files 'uptodate)) (if (setq files (sort files #'string-lessp))
(git-status-filenames-map
git-status (lambda (info) (setf (git-fileinfo->needs-update info) t)) files)
(ewoc-map (lambda (info) (setf (git-fileinfo->needs-update info) t) nil) git-status)
(git-call-process nil "update-index" "--refresh")
(when git-show-uptodate
(git-run-ls-files-cached git-status nil 'uptodate)))
(let* ((remaining-files (let* ((remaining-files
(if (git-empty-db-p) ; we need some special handling for an empty db (if (git-empty-db-p) ; we need some special handling for an empty db
(git-run-ls-files-cached git-status files 'added) (git-run-ls-files-cached git-status files 'added)
@ -746,13 +772,17 @@ Return the list of files that haven't been handled."
(setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'unknown "-o"))) (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'unknown "-o")))
(when (or remaining-files (and git-show-ignored (not files))) (when (or remaining-files (and git-show-ignored (not files)))
(setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'ignored "-o" "-i"))) (setq remaining-files (git-run-ls-files-with-excludes git-status remaining-files 'ignored "-o" "-i")))
(git-set-filenames-state git-status remaining-files default-state) (unless files
(setq remaining-files (git-get-filenames (ewoc-collect git-status #'git-fileinfo->needs-update))))
(when remaining-files
(setq remaining-files (git-run-ls-files-cached git-status remaining-files 'uptodate)))
(git-set-filenames-state git-status remaining-files nil)
(when mark-files (git-mark-files git-status files))
(git-refresh-files) (git-refresh-files)
(git-refresh-ewoc-hf git-status))) (git-refresh-ewoc-hf git-status)))
(defun git-mark-files (status files) (defun git-mark-files (status files)
"Mark all the specified FILES, and unmark the others." "Mark all the specified FILES, and unmark the others."
(setq files (sort files #'string-lessp))
(let ((file (and files (pop files))) (let ((file (and files (pop files)))
(node (ewoc-nth status 0))) (node (ewoc-nth status 0)))
(while node (while node
@ -824,19 +854,18 @@ Return the list of files that haven't been handled."
(defun git-update-index (index-file files) (defun git-update-index (index-file files)
"Run git-update-index on a list of files." "Run git-update-index on a list of files."
(let ((env (and index-file `(("GIT_INDEX_FILE" . ,index-file)))) (let ((process-environment (append (and index-file (list (concat "GIT_INDEX_FILE=" index-file)))
process-environment))
added deleted modified) added deleted modified)
(dolist (info files) (dolist (info files)
(case (git-fileinfo->state info) (case (git-fileinfo->state info)
('added (push info added)) ('added (push info added))
('deleted (push info deleted)) ('deleted (push info deleted))
('modified (push info modified)))) ('modified (push info modified))))
(when added (and
(apply #'git-call-process-env nil env "update-index" "--add" "--" (git-get-filenames added))) (or (not added) (apply #'git-call-process-display-error "update-index" "--add" "--" (git-get-filenames added)))
(when deleted (or (not deleted) (apply #'git-call-process-display-error "update-index" "--remove" "--" (git-get-filenames deleted)))
(apply #'git-call-process-env nil env "update-index" "--remove" "--" (git-get-filenames deleted))) (or (not modified) (apply #'git-call-process-display-error "update-index" "--" (git-get-filenames modified))))))
(when modified
(apply #'git-call-process-env nil env "update-index" "--" (git-get-filenames modified)))))
(defun git-run-pre-commit-hook () (defun git-run-pre-commit-hook ()
"Run the pre-commit hook if any." "Run the pre-commit hook if any."
@ -862,33 +891,30 @@ Return the list of files that haven't been handled."
(message "You cannot commit unmerged files, resolve them first.") (message "You cannot commit unmerged files, resolve them first.")
(unwind-protect (unwind-protect
(let ((files (git-marked-files-state 'added 'deleted 'modified)) (let ((files (git-marked-files-state 'added 'deleted 'modified))
head head-tree) head tree head-tree)
(unless (git-empty-db-p) (unless (git-empty-db-p)
(setq head (git-rev-parse "HEAD") (setq head (git-rev-parse "HEAD")
head-tree (git-rev-parse "HEAD^{tree}"))) head-tree (git-rev-parse "HEAD^{tree}")))
(if files (message "Running git commit...")
(progn (when
(message "Running git commit...") (and
(git-read-tree head-tree index-file) (git-read-tree head-tree index-file)
(git-update-index nil files) ;update both the default index (git-update-index nil files) ;update both the default index
(git-update-index index-file files) ;and the temporary one (git-update-index index-file files) ;and the temporary one
(let ((tree (git-write-tree index-file))) (setq tree (git-write-tree index-file)))
(if (or (not (string-equal tree head-tree)) (if (or (not (string-equal tree head-tree))
(yes-or-no-p "The tree was not modified, do you really want to perform an empty commit? ")) (yes-or-no-p "The tree was not modified, do you really want to perform an empty commit? "))
(let ((commit (git-commit-tree buffer tree head))) (let ((commit (git-commit-tree buffer tree head)))
(when commit (when commit
(condition-case nil (delete-file ".git/MERGE_HEAD") (error nil)) (condition-case nil (delete-file ".git/MERGE_HEAD") (error nil))
(condition-case nil (delete-file ".git/MERGE_MSG") (error nil)) (condition-case nil (delete-file ".git/MERGE_MSG") (error nil))
(with-current-buffer buffer (erase-buffer)) (with-current-buffer buffer (erase-buffer))
(git-update-status-files (git-get-filenames files) 'uptodate) (git-update-status-files (git-get-filenames files))
(git-call-process-env nil nil "rerere") (git-call-process nil "rerere")
(git-call-process-env nil nil "gc" "--auto") (git-call-process nil "gc" "--auto")
(git-refresh-files) (message "Committed %s." commit)
(git-refresh-ewoc-hf git-status) (git-run-hook "post-commit" nil)))
(message "Committed %s." commit) (message "Commit aborted."))))
(git-run-hook "post-commit" nil)))
(message "Commit aborted."))))
(message "No files to commit.")))
(delete-file index-file)))))) (delete-file index-file))))))
@ -990,6 +1016,11 @@ Return the list of files that haven't been handled."
(setq node (ewoc-prev git-status node))) (setq node (ewoc-prev git-status node)))
(ewoc-goto-node git-status last))) (ewoc-goto-node git-status last)))
(defun git-insert-file (file)
"Insert file(s) into the git-status buffer."
(interactive "fInsert file: ")
(git-update-status-files (list (file-relative-name file))))
(defun git-add-file () (defun git-add-file ()
"Add marked file(s) to the index cache." "Add marked file(s) to the index cache."
(interactive) (interactive)
@ -998,7 +1029,7 @@ Return the list of files that haven't been handled."
(unless files (unless files
(push (file-relative-name (read-file-name "File to add: " nil nil t)) files)) (push (file-relative-name (read-file-name "File to add: " nil nil t)) files))
(when (apply 'git-call-process-display-error "update-index" "--add" "--" files) (when (apply 'git-call-process-display-error "update-index" "--add" "--" files)
(git-update-status-files files 'uptodate) (git-update-status-files files)
(git-success-message "Added" files)))) (git-success-message "Added" files))))
(defun git-ignore-file () (defun git-ignore-file ()
@ -1008,7 +1039,7 @@ Return the list of files that haven't been handled."
(unless files (unless files
(push (file-relative-name (read-file-name "File to ignore: " nil nil t)) files)) (push (file-relative-name (read-file-name "File to ignore: " nil nil t)) files))
(dolist (f files) (git-append-to-ignore f)) (dolist (f files) (git-append-to-ignore f))
(git-update-status-files files 'ignored) (git-update-status-files files)
(git-success-message "Ignored" files))) (git-success-message "Ignored" files)))
(defun git-remove-file () (defun git-remove-file ()
@ -1026,7 +1057,7 @@ Return the list of files that haven't been handled."
(delete-directory name) (delete-directory name)
(delete-file name)))) (delete-file name))))
(when (apply 'git-call-process-display-error "update-index" "--remove" "--" files) (when (apply 'git-call-process-display-error "update-index" "--remove" "--" files)
(git-update-status-files files nil) (git-update-status-files files)
(git-success-message "Removed" files))) (git-success-message "Removed" files)))
(message "Aborting")))) (message "Aborting"))))
@ -1054,7 +1085,7 @@ Return the list of files that haven't been handled."
(apply 'git-call-process-display-error "update-index" "--force-remove" "--" added)) (apply 'git-call-process-display-error "update-index" "--force-remove" "--" added))
(or (not modified) (or (not modified)
(apply 'git-call-process-display-error "checkout" "HEAD" modified))))) (apply 'git-call-process-display-error "checkout" "HEAD" modified)))))
(git-update-status-files (append added modified) 'uptodate) (git-update-status-files (append added modified))
(when ok (when ok
(dolist (file modified) (dolist (file modified)
(let ((buffer (get-file-buffer file))) (let ((buffer (get-file-buffer file)))
@ -1067,7 +1098,7 @@ Return the list of files that haven't been handled."
(let ((files (git-get-filenames (git-marked-files-state 'unmerged)))) (let ((files (git-get-filenames (git-marked-files-state 'unmerged))))
(when files (when files
(when (apply 'git-call-process-display-error "update-index" "--" files) (when (apply 'git-call-process-display-error "update-index" "--" files)
(git-update-status-files files 'uptodate) (git-update-status-files files)
(git-success-message "Resolved" files))))) (git-success-message "Resolved" files)))))
(defun git-remove-handled () (defun git-remove-handled ()
@ -1225,11 +1256,10 @@ Return the list of files that haven't been handled."
(goto-char (point-max)) (goto-char (point-max))
(insert sign-off "\n")))) (insert sign-off "\n"))))
(defun git-setup-log-buffer (buffer &optional author-name author-email subject date msg) (defun git-setup-log-buffer (buffer &optional merge-heads author-name author-email subject date msg)
"Setup the log buffer for a commit." "Setup the log buffer for a commit."
(unless git-status (error "Not in git-status buffer.")) (unless git-status (error "Not in git-status buffer."))
(let ((merge-heads (git-get-merge-heads)) (let ((dir default-directory)
(dir default-directory)
(committer-name (git-get-committer-name)) (committer-name (git-get-committer-name))
(committer-email (git-get-committer-email)) (committer-email (git-get-committer-email))
(sign-off git-append-signed-off-by)) (sign-off git-append-signed-off-by))
@ -1243,9 +1273,8 @@ Return the list of files that haven't been handled."
(or author-email committer-email) (or author-email committer-email)
(if date (format "Date: %s\n" date) "") (if date (format "Date: %s\n" date) "")
(if merge-heads (if merge-heads
(format "Parent: %s\n%s\n" (format "Merge: %s\n"
(git-rev-parse "HEAD") (mapconcat 'identity merge-heads " "))
(mapconcat (lambda (str) (concat "Parent: " str)) merge-heads "\n"))
"")) ""))
'face 'git-header-face) 'face 'git-header-face)
(propertize git-log-msg-separator 'face 'git-separator-face) (propertize git-log-msg-separator 'face 'git-separator-face)
@ -1285,7 +1314,7 @@ Return the list of files that haven't been handled."
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward "^Date: \\(.*\\)$" nil t) (when (re-search-forward "^Date: \\(.*\\)$" nil t)
(setq date (match-string 1))))) (setq date (match-string 1)))))
(git-setup-log-buffer buffer author-name author-email subject date)) (git-setup-log-buffer buffer (git-get-merge-heads) author-name author-email subject date))
(if (boundp 'log-edit-diff-function) (if (boundp 'log-edit-diff-function)
(log-edit 'git-do-commit nil '((log-edit-listfun . git-log-edit-files) (log-edit 'git-do-commit nil '((log-edit-listfun . git-log-edit-files)
(log-edit-diff-function . git-log-edit-diff)) buffer) (log-edit-diff-function . git-log-edit-diff)) buffer)
@ -1296,11 +1325,13 @@ Return the list of files that haven't been handled."
(defun git-setup-commit-buffer (commit) (defun git-setup-commit-buffer (commit)
"Setup the commit buffer with the contents of COMMIT." "Setup the commit buffer with the contents of COMMIT."
(let (author-name author-email subject date msg) (let (parents author-name author-email subject date msg)
(with-temp-buffer (with-temp-buffer
(let ((coding-system (git-get-logoutput-coding-system))) (let ((coding-system (git-get-logoutput-coding-system)))
(git-call-process-env t nil "log" "-1" "--pretty=medium" commit) (git-call-process t "log" "-1" "--pretty=medium" "--abbrev=40" commit)
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward "^Merge: *\\(.*\\)$" nil t)
(setq parents (cdr (split-string (match-string 1) " +"))))
(when (re-search-forward "^Author: *\\(.*\\) <\\(.*\\)>$" nil t) (when (re-search-forward "^Author: *\\(.*\\) <\\(.*\\)>$" nil t)
(setq author-name (match-string 1)) (setq author-name (match-string 1))
(setq author-email (match-string 2))) (setq author-email (match-string 2)))
@ -1312,14 +1343,14 @@ Return the list of files that haven't been handled."
(setq subject (pop msg)) (setq subject (pop msg))
(while (and msg (zerop (length (car msg))) (pop msg))))) (while (and msg (zerop (length (car msg))) (pop msg)))))
(git-setup-log-buffer (get-buffer-create "*git-commit*") (git-setup-log-buffer (get-buffer-create "*git-commit*")
author-name author-email subject date parents author-name author-email subject date
(mapconcat #'identity msg "\n")))) (mapconcat #'identity msg "\n"))))
(defun git-get-commit-files (commit) (defun git-get-commit-files (commit)
"Retrieve the list of files modified by COMMIT." "Retrieve the list of files modified by COMMIT."
(let (files) (let (files)
(with-temp-buffer (with-temp-buffer
(git-call-process-env t nil "diff-tree" "-r" "-z" "--name-only" "--no-commit-id" commit) (git-call-process t "diff-tree" "-m" "-r" "-z" "--name-only" "--no-commit-id" "--root" commit)
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward "\\([^\0]*\\)\0" nil t 1) (while (re-search-forward "\\([^\0]*\\)\0" nil t 1)
(push (match-string 1) files))) (push (match-string 1) files)))
@ -1333,10 +1364,11 @@ amended version of it."
(when (git-empty-db-p) (error "No commit to amend.")) (when (git-empty-db-p) (error "No commit to amend."))
(let* ((commit (git-rev-parse "HEAD")) (let* ((commit (git-rev-parse "HEAD"))
(files (git-get-commit-files commit))) (files (git-get-commit-files commit)))
(when (git-call-process-display-error "reset" "--soft" "HEAD^") (when (if (git-rev-parse "HEAD^")
(git-update-status-files (copy-sequence files) 'uptodate) (git-call-process-display-error "reset" "--soft" "HEAD^")
(git-mark-files git-status files) (and (git-update-ref "ORIG_HEAD" commit)
(git-refresh-files) (git-update-ref "HEAD" nil commit)))
(git-update-status-files files t)
(git-setup-commit-buffer commit) (git-setup-commit-buffer commit)
(git-commit-file)))) (git-commit-file))))
@ -1377,27 +1409,10 @@ amended version of it."
(defun git-refresh-status () (defun git-refresh-status ()
"Refresh the git status buffer." "Refresh the git status buffer."
(interactive) (interactive)
(let* ((status git-status) (unless git-status (error "Not in git-status buffer."))
(pos (ewoc-locate status)) (message "Refreshing git status...")
(marked-files (git-get-filenames (ewoc-collect status (lambda (info) (git-fileinfo->marked info))))) (git-update-status-files)
(cur-name (and pos (git-fileinfo->name (ewoc-data pos))))) (message "Refreshing git status...done"))
(unless status (error "Not in git-status buffer."))
(message "Refreshing git status...")
(git-call-process-env nil nil "update-index" "--refresh")
(git-clear-status status)
(git-update-status-files nil)
; restore file marks
(when marked-files
(git-status-filenames-map status
(lambda (info)
(setf (git-fileinfo->marked info) t)
(setf (git-fileinfo->needs-refresh info) t))
marked-files)
(git-refresh-files))
; move point to the current file name if any
(message "Refreshing git status...done")
(let ((node (and cur-name (git-find-status-file status cur-name))))
(when node (ewoc-goto-node status node)))))
(defun git-status-quit () (defun git-status-quit ()
"Quit git-status mode." "Quit git-status mode."
@ -1434,6 +1449,7 @@ amended version of it."
(define-key map "\r" 'git-find-file) (define-key map "\r" 'git-find-file)
(define-key map "g" 'git-refresh-status) (define-key map "g" 'git-refresh-status)
(define-key map "i" 'git-ignore-file) (define-key map "i" 'git-ignore-file)
(define-key map "I" 'git-insert-file)
(define-key map "l" 'git-log-file) (define-key map "l" 'git-log-file)
(define-key map "m" 'git-mark-file) (define-key map "m" 'git-mark-file)
(define-key map "M" 'git-mark-all) (define-key map "M" 'git-mark-all)
@ -1490,6 +1506,7 @@ amended version of it."
["Revert File" git-revert-file t] ["Revert File" git-revert-file t]
["Ignore File" git-ignore-file t] ["Ignore File" git-ignore-file t]
["Remove File" git-remove-file t] ["Remove File" git-remove-file t]
["Insert File" git-insert-file t]
"--------" "--------"
["Find File" git-find-file t] ["Find File" git-find-file t]
["View File" git-view-file t] ["View File" git-view-file t]
@ -1576,8 +1593,8 @@ Meant to be used in `after-save-hook'."
(let ((filename (file-relative-name file dir))) (let ((filename (file-relative-name file dir)))
; skip files located inside the .git directory ; skip files located inside the .git directory
(unless (string-match "^\\.git/" filename) (unless (string-match "^\\.git/" filename)
(git-call-process-env nil nil "add" "--refresh" "--" filename) (git-call-process nil "add" "--refresh" "--" filename)
(git-update-status-files (list filename) 'uptodate))))))) (git-update-status-files (list filename))))))))
(defun git-help () (defun git-help ()
"Display help for Git mode." "Display help for Git mode."