X-Git-Url: https://git.tokkee.org/?a=blobdiff_plain;f=contrib%2Femacs%2Fgit.el;h=f6102fc344a62982b2ed489e0c077852b8b6ccca;hb=55d1932bce99d83fa0d891331fe3f3562d33af2e;hp=5f22dec5f71bfe2cb983dd9eabbb1b848b252eba;hpb=b08bbae7e1676e5a47fa9054e268ff14ee819a3a;p=git.git diff --git a/contrib/emacs/git.el b/contrib/emacs/git.el index 5f22dec5f..f6102fc34 100644 --- a/contrib/emacs/git.el +++ b/contrib/emacs/git.el @@ -263,6 +263,16 @@ and returns the process output as a string." (locale-charset-to-coding-system repo-config)) 'utf-8))) +(defun git-get-logoutput-coding-system () + "Return the coding system used for git-log output." + (let ((repo-config (or (git-config "i18n.logoutputencoding") + (git-config "i18n.commitencoding")))) + (or git-commits-coding-system + (and repo-config + (fboundp 'locale-charset-to-coding-system) + (locale-charset-to-coding-system repo-config)) + 'utf-8))) + (defun git-escape-file-name (name) "Escape a file name if necessary." (if (string-match "[\n\t\"\\]" name) @@ -304,8 +314,8 @@ and returns the process output as a string." (sort-lines nil (point-min) (point-max)) (save-buffer)) (when created - (git-run-command nil nil "update-index" "--info-only" "--add" "--" (file-relative-name ignore-name))) - (git-add-status-file (if created 'added 'modified) (file-relative-name ignore-name)))) + (git-run-command nil nil "update-index" "--add" "--" (file-relative-name ignore-name))) + (git-update-status-files (list (file-relative-name ignore-name)) 'unknown))) ; propertize definition for XEmacs, stolen from erc-compat (eval-when-compile @@ -335,9 +345,15 @@ and returns the process output as a string." (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) +(defun git-update-ref (ref newval &optional oldval reason) "Update a reference by calling git-update-ref." - (apply #'git-call-process-env nil nil "update-ref" ref val (if oldval (list oldval)))) + (let ((args (and oldval (list oldval)))) + (push newval args) + (push ref args) + (when reason + (push reason args) + (push "-m" args)) + (eq 0 (apply #'git-call-process-env nil nil "update-ref" args)))) (defun git-read-tree (tree &optional index-file) "Read a tree into the index file." @@ -354,8 +370,10 @@ and returns the process output as a string." "Call git-commit-tree with buffer as input and return the resulting commit SHA1." (let ((author-name (git-get-committer-name)) (author-email (git-get-committer-email)) + (subject "commit (initial): ") author-date log-start log-end args coding-system-for-write) (when head + (setq subject "commit: ") (push "-p" args) (push head args)) (with-current-buffer buffer @@ -374,22 +392,29 @@ and returns the process output as a string." (goto-char (point-min)) (while (re-search-forward "^Parent: +\\([0-9a-f]+\\)" nil t) (unless (string-equal head (match-string 1)) + (setq subject "commit (merge): ") (push "-p" args) (push (match-string 1) args)))) (setq log-start (point-min))) (setq log-end (point-max)) + (goto-char log-start) + (when (re-search-forward ".*$" nil t) + (setq subject (concat subject (match-string 0)))) (setq coding-system-for-write buffer-file-coding-system)) - (git-get-string-sha1 - (with-output-to-string - (with-current-buffer standard-output - (let ((env `(("GIT_AUTHOR_NAME" . ,author-name) - ("GIT_AUTHOR_EMAIL" . ,author-email) - ("GIT_COMMITTER_NAME" . ,(git-get-committer-name)) - ("GIT_COMMITTER_EMAIL" . ,(git-get-committer-email))))) - (when author-date (push `("GIT_AUTHOR_DATE" . ,author-date) env)) - (apply #'git-run-command-region - buffer log-start log-end env - "commit-tree" tree (nreverse args)))))))) + (let ((commit + (git-get-string-sha1 + (with-output-to-string + (with-current-buffer standard-output + (let ((env `(("GIT_AUTHOR_NAME" . ,author-name) + ("GIT_AUTHOR_EMAIL" . ,author-email) + ("GIT_COMMITTER_NAME" . ,(git-get-committer-name)) + ("GIT_COMMITTER_EMAIL" . ,(git-get-committer-email))))) + (when author-date (push `("GIT_AUTHOR_DATE" . ,author-date) env)) + (apply #'git-run-command-region + buffer log-start log-end env + "commit-tree" tree (nreverse args)))))))) + (and (git-update-ref "HEAD" commit head subject) + commit)))) (defun git-empty-db-p () "Check if the git db is empty (no commit done yet)." @@ -406,6 +431,14 @@ and returns the process output as a string." (push (match-string 0) heads)))) (nreverse heads))) +(defun git-get-commit-description (commit) + "Get a one-line description of COMMIT." + (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))) + (if (and descr (string-match "\\`\\([0-9a-f]\\{40\\}\\) *\\(.*\\)$" descr)) + (concat (substring (match-string 1 descr) 0 10) " - " (match-string 2 descr)) + descr)))) + ;;;; File info structure ;;;; ------------------------------------------------------------ @@ -490,23 +523,39 @@ and returns the process output as a string." " " (git-escape-file-name (git-fileinfo->name info)) (git-rename-as-string info)))) -(defun git-parse-status (status) - "Parse the output of git-diff-index in the current buffer." - (goto-char (point-min)) - (while (re-search-forward - ":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMU]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0" - nil t 1) - (let ((old-perm (string-to-number (match-string 1) 8)) - (new-perm (string-to-number (match-string 2) 8)) - (state (or (match-string 4) (match-string 6))) - (name (or (match-string 5) (match-string 7))) - (new-name (match-string 8))) - (if new-name ; copy or rename - (if (eq ?C (string-to-char state)) - (ewoc-enter-last status (git-create-fileinfo 'added new-name old-perm new-perm 'copy name)) - (ewoc-enter-last status (git-create-fileinfo 'deleted name 0 0 'rename new-name)) - (ewoc-enter-last status (git-create-fileinfo 'added new-name old-perm new-perm 'rename name))) - (ewoc-enter-last status (git-create-fileinfo (git-state-code state) name old-perm new-perm)))))) +(defun git-insert-fileinfo (status info &optional refresh) + "Insert INFO in the status buffer, optionally refreshing an existing one." + (let ((node (and refresh + (git-find-status-file status (git-fileinfo->name info))))) + (setf (git-fileinfo->needs-refresh info) t) + (when node ;preserve the marked flag + (setf (git-fileinfo->marked info) (git-fileinfo->marked (ewoc-data node)))) + (if node (setf (ewoc-data node) info) (ewoc-enter-last status info)))) + +(defun git-run-diff-index (status files) + "Run git-diff-index on FILES and parse the results into STATUS. +Return the list of files that haven't been handled." + (let ((refresh files)) + (with-temp-buffer + (apply #'git-run-command t nil "diff-index" "-z" "-M" "HEAD" "--" files) + (goto-char (point-min)) + (while (re-search-forward + ":\\([0-7]\\{6\\}\\) \\([0-7]\\{6\\}\\) [0-9a-f]\\{40\\} [0-9a-f]\\{40\\} \\(\\([ADMU]\\)\0\\([^\0]+\\)\\|\\([CR]\\)[0-9]*\0\\([^\0]+\\)\0\\([^\0]+\\)\\)\0" + nil t 1) + (let ((old-perm (string-to-number (match-string 1) 8)) + (new-perm (string-to-number (match-string 2) 8)) + (state (or (match-string 4) (match-string 6))) + (name (or (match-string 5) (match-string 7))) + (new-name (match-string 8))) + (if new-name ; copy or rename + (if (eq ?C (string-to-char state)) + (git-insert-fileinfo status (git-create-fileinfo 'added new-name old-perm new-perm 'copy name) refresh) + (git-insert-fileinfo status (git-create-fileinfo 'deleted name 0 0 'rename new-name) refresh) + (git-insert-fileinfo status (git-create-fileinfo 'added new-name old-perm new-perm 'rename name)) refresh) + (git-insert-fileinfo status (git-create-fileinfo (git-state-code state) name old-perm new-perm) refresh)) + (setq files (delete name files)) + (when new-name (setq files (delete new-name files))))))) + files) (defun git-find-status-file (status file) "Find a given file in the status ewoc and return its node." @@ -515,32 +564,69 @@ and returns the process output as a string." (setq node (ewoc-next status node))) node)) -(defun git-parse-ls-files (status default-state &optional skip-existing) - "Parse the output of git-ls-files in the current buffer." - (goto-char (point-min)) - (let (infolist) - (while (re-search-forward "\\([HMRCK?]\\) \\([^\0]*\\)\0" nil t 1) - (let ((state (match-string 1)) - (name (match-string 2))) - (unless (and skip-existing (git-find-status-file status name)) - (push (git-create-fileinfo (or (git-state-code state) default-state) name) infolist)))) - (dolist (info (nreverse infolist)) - (ewoc-enter-last status info)))) - -(defun git-parse-ls-unmerged (status) - "Parse the output of git-ls-files -u in the current buffer." - (goto-char (point-min)) - (let (files) - (while (re-search-forward "[0-7]\\{6\\} [0-9a-f]\\{40\\} [123]\t\\([^\0]+\\)\0" nil t) - (let ((node (git-find-status-file status (match-string 1)))) - (when node (push (ewoc-data node) files)))) - (git-set-files-state files 'unmerged))) - -(defun git-add-status-file (state name) - "Add a new file to the status list (if not existing already) and return its node." +(defun git-run-ls-files (status files default-state &rest options) + "Run git-ls-files on FILES and parse the results into STATUS. +Return the list of files that haven't been handled." + (let ((refresh files)) + (with-temp-buffer + (apply #'git-run-command t nil "ls-files" "-z" "-t" (append options (list "--") files)) + (goto-char (point-min)) + (while (re-search-forward "\\([HMRCK?]\\) \\([^\0]*\\)\0" nil t 1) + (let ((state (match-string 1)) + (name (match-string 2))) + (git-insert-fileinfo status (git-create-fileinfo (or (git-state-code state) default-state) name) refresh) + (setq files (delete name files)))))) + files) + +(defun git-run-ls-unmerged (status files) + "Run git-ls-files -u on FILES and parse the results into STATUS." + (with-temp-buffer + (apply #'git-run-command t nil "ls-files" "-z" "-u" "--" files) + (goto-char (point-min)) + (let (unmerged-files) + (while (re-search-forward "[0-7]\\{6\\} [0-9a-f]\\{40\\} [123]\t\\([^\0]+\\)\0" nil t) + (let ((node (git-find-status-file status (match-string 1)))) + (when node (push (ewoc-data node) unmerged-files)))) + (git-set-files-state unmerged-files 'unmerged)))) + +(defun git-get-exclude-files () + "Get the list of exclude files to pass to git-ls-files." + (let (files + (config (git-config "core.excludesfile"))) + (when (file-readable-p ".git/info/exclude") + (push ".git/info/exclude" files)) + (when (and config (file-readable-p config)) + (push config files)) + files)) + +(defun git-update-status-files (files &optional default-state) + "Update the status of FILES from the index." (unless git-status (error "Not in git-status buffer.")) - (or (git-find-status-file git-status name) - (ewoc-enter-last git-status (git-create-fileinfo state name)))) + (let* ((status git-status) + (remaining-files + (if (git-empty-db-p) ; we need some special handling for an empty db + (git-run-ls-files status files 'added "-c") + (git-run-diff-index status files)))) + (git-run-ls-unmerged status files) + (when (or (not files) remaining-files) + (let ((exclude-files (git-get-exclude-files))) + (setq remaining-files (apply #'git-run-ls-files status remaining-files 'unknown "-o" + (concat "--exclude-per-directory=" git-per-dir-ignore-file) + (mapcar (lambda (f) (concat "--exclude-from=" f)) exclude-files))))) + ; mark remaining files with the default state (or remove them if nil) + (when remaining-files + (if default-state + (ewoc-map (lambda (info) + (when (member (git-fileinfo->name info) remaining-files) + (git-set-files-state (list info) default-state)) + nil) + status) + (ewoc-filter status + (lambda (info files) + (not (member (git-fileinfo->name info) files))) + remaining-files))) + (git-refresh-files) + (git-refresh-ewoc-hf status))) (defun git-marked-files () "Return a list of all marked files, or if none a list containing just the file at cursor position." @@ -573,7 +659,7 @@ and returns the process output as a string." "Refresh the ewoc header and footer." (let ((branch (git-symbolic-ref "HEAD")) (head (if (git-empty-db-p) "Nothing committed yet" - (substring (git-rev-parse "HEAD") 0 10))) + (git-get-commit-description "HEAD"))) (merge-heads (git-get-merge-heads))) (ewoc-set-hf status (format "Directory: %s\nBranch: %s\nHead: %s%s\n" @@ -584,7 +670,7 @@ and returns the process output as a string." head (if merge-heads (concat "\nMerging: " - (mapconcat (lambda (str) (substring str 0 10)) merge-heads " ")) + (mapconcat (lambda (str) (git-get-commit-description str)) merge-heads "\n ")) "")) (if (ewoc-nth status 0) "" " No changes.")))) @@ -644,13 +730,11 @@ and returns the process output as a string." (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? ")) (let ((commit (git-commit-tree buffer tree head))) - (git-update-ref "HEAD" commit head) (condition-case nil (delete-file ".git/MERGE_HEAD") (error nil)) (condition-case nil (delete-file ".git/MERGE_MSG") (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-run-command nil nil "rerere") (git-refresh-files) (git-refresh-ewoc-hf git-status) (message "Committed %s." commit) @@ -758,54 +842,34 @@ and returns the process output as a string." (defun git-add-file () "Add marked file(s) to the index cache." (interactive) - (let ((files (git-marked-files-state 'unknown))) + (let ((files (git-get-filenames (git-marked-files-state 'unknown)))) (unless files - (push (ewoc-data - (git-add-status-file 'added (file-relative-name - (read-file-name "File to add: " nil nil t)))) - files)) - (apply #'git-run-command nil nil "update-index" "--info-only" "--add" "--" (git-get-filenames files)) - (git-set-files-state files 'added) - (git-refresh-files))) + (push (file-relative-name (read-file-name "File to add: " nil nil t)) files)) + (apply #'git-run-command nil nil "update-index" "--add" "--" files) + (git-update-status-files files 'uptodate))) (defun git-ignore-file () "Add marked file(s) to the ignore list." (interactive) - (let ((files (git-marked-files-state 'unknown))) + (let ((files (git-get-filenames (git-marked-files-state 'unknown)))) (unless files - (push (ewoc-data - (git-add-status-file 'unknown (file-relative-name - (read-file-name "File to ignore: " nil nil t)))) - files)) - (dolist (info files) (git-append-to-ignore (git-fileinfo->name info))) - (git-set-files-state files 'ignored) - (git-refresh-files))) + (push (file-relative-name (read-file-name "File to ignore: " nil nil t)) files)) + (dolist (f files) (git-append-to-ignore f)) + (git-update-status-files files 'ignored))) (defun git-remove-file () "Remove the marked file(s)." (interactive) - (let ((files (git-marked-files-state 'added 'modified 'unknown 'uptodate))) + (let ((files (git-get-filenames (git-marked-files-state 'added 'modified 'unknown 'uptodate)))) (unless files - (push (ewoc-data - (git-add-status-file 'unknown (file-relative-name - (read-file-name "File to remove: " nil nil t)))) - files)) + (push (file-relative-name (read-file-name "File to remove: " nil nil t)) files)) (if (yes-or-no-p (format "Remove %d file%s? " (length files) (if (> (length files) 1) "s" ""))) (progn - (dolist (info files) - (let ((name (git-fileinfo->name info))) - (when (file-exists-p name) (delete-file name)))) - (apply #'git-run-command nil nil "update-index" "--info-only" "--remove" "--" (git-get-filenames files)) - ; remove unknown files from the list, set the others to deleted - (ewoc-filter git-status - (lambda (info files) - (not (and (memq info files) (eq (git-fileinfo->state info) 'unknown)))) - files) - (git-set-files-state files 'deleted) - (git-refresh-files) - (unless (ewoc-nth git-status 0) ; refresh header if list is empty - (git-refresh-ewoc-hf git-status))) + (dolist (name files) + (when (file-exists-p name) (delete-file name))) + (apply #'git-run-command nil nil "update-index" "--remove" "--" files) + (git-update-status-files files nil)) (message "Aborting")))) (defun git-revert-file () @@ -818,26 +882,23 @@ and returns the process output as a string." (format "Revert %d file%s? " (length files) (if (> (length files) 1) "s" "")))) (dolist (info files) (case (git-fileinfo->state info) - ('added (push info added)) - ('deleted (push info modified)) - ('unmerged (push info modified)) - ('modified (push info modified)))) + ('added (push (git-fileinfo->name info) added)) + ('deleted (push (git-fileinfo->name info) modified)) + ('unmerged (push (git-fileinfo->name info) modified)) + ('modified (push (git-fileinfo->name info) modified)))) (when added - (apply #'git-run-command nil nil "update-index" "--force-remove" "--" (git-get-filenames added)) - (git-set-files-state added 'unknown)) + (apply #'git-run-command nil nil "update-index" "--force-remove" "--" added)) (when modified - (apply #'git-run-command nil nil "checkout" "HEAD" (git-get-filenames modified)) - (git-set-files-state modified 'uptodate)) - (git-refresh-files)))) + (apply #'git-run-command nil nil "checkout" "HEAD" modified)) + (git-update-status-files (append added modified) 'uptodate)))) (defun git-resolve-file () "Resolve conflicts in marked file(s)." (interactive) - (let ((files (git-marked-files-state 'unmerged))) + (let ((files (git-get-filenames (git-marked-files-state 'unmerged)))) (when files - (apply #'git-run-command nil nil "update-index" "--" (git-get-filenames files)) - (git-set-files-state files 'modified) - (git-refresh-files)))) + (apply #'git-run-command nil nil "update-index" "--" files) + (git-update-status-files files 'uptodate)))) (defun git-remove-handled () "Remove handled files from the status list." @@ -1007,7 +1068,7 @@ and returns the process output as a string." (let ((info (ewoc-data (ewoc-locate git-status)))) (find-file (git-fileinfo->name info)) (when (eq 'unmerged (git-fileinfo->state info)) - (smerge-mode)))) + (smerge-mode 1)))) (defun git-find-file-other-window () "Visit the current file in its own buffer in another window." @@ -1040,27 +1101,9 @@ and returns the process output as a string." (pos (ewoc-locate status)) (cur-name (and pos (git-fileinfo->name (ewoc-data pos))))) (unless status (error "Not in git-status buffer.")) + (git-run-command nil nil "update-index" "--refresh") (git-clear-status status) - (git-run-command nil nil "update-index" "--info-only" "--refresh") - (if (git-empty-db-p) - ; we need some special handling for an empty db - (with-temp-buffer - (git-run-command t nil "ls-files" "-z" "-t" "-c") - (git-parse-ls-files status 'added)) - (with-temp-buffer - (git-run-command t nil "diff-index" "-z" "-M" "HEAD") - (git-parse-status status))) - (with-temp-buffer - (git-run-command t nil "ls-files" "-z" "-u") - (git-parse-ls-unmerged status)) - (when (file-readable-p ".git/info/exclude") - (with-temp-buffer - (git-run-command t nil "ls-files" "-z" "-t" "-o" - "--exclude-from=.git/info/exclude" - (concat "--exclude-per-directory=" git-per-dir-ignore-file)) - (git-parse-ls-files status 'unknown))) - (git-refresh-files) - (git-refresh-ewoc-hf status) + (git-update-status-files nil) ; move point to the current file name if any (let ((node (and cur-name (git-find-status-file status cur-name)))) (when node (ewoc-goto-node status node)))))