diff options
Diffstat (limited to 'contrib/emacs')
| -rw-r--r-- | contrib/emacs/git.el | 142 |
1 files changed, 89 insertions, 53 deletions
diff --git a/contrib/emacs/git.el b/contrib/emacs/git.el index 2d77fd4..4286d16 100644 --- a/contrib/emacs/git.el +++ b/contrib/emacs/git.el @@ -36,7 +36,6 @@ ;; TODO ;; - portability to XEmacs ;; - better handling of subprocess errors -;; - hook into file save (after-save-hook) ;; - diff against other branch ;; - renaming files from the status buffer ;; - creating tags @@ -220,22 +219,15 @@ and returns the process output as a string." (message "Running git %s...done" (car args)) buffer)) -(defun git-run-command (buffer env &rest args) - (message "Running git %s..." (car args)) - (apply #'git-call-process-env buffer env args) - (message "Running git %s...done" (car args))) - (defun git-run-command-region (buffer start end env &rest args) "Run a git command with specified buffer region as input." - (message "Running git %s..." (car args)) (unless (eq 0 (if env (git-run-process-region buffer start end "env" (append (git-get-env-strings env) (list "git") args)) (git-run-process-region buffer start end "git" args))) - (error "Failed to run \"git %s\":\n%s" (mapconcat (lambda (x) x) args " ") (buffer-string))) - (message "Running git %s...done" (car args))) + (error "Failed to run \"git %s\":\n%s" (mapconcat (lambda (x) x) args " ") (buffer-string)))) (defun git-run-hook (hook env &rest args) "Run a git hook and display its output if any." @@ -312,6 +304,13 @@ and returns the process output as a string." "\"") name)) +(defun git-success-message (text files) + "Print a success message after having handled FILES." + (let ((n (length files))) + (if (equal n 1) + (message "%s %s" text (car files)) + (message "%s %d files" text n)))) + (defun git-get-top-dir (dir) "Retrieve the top-level directory of a git tree." (let ((cdup (with-output-to-string @@ -338,7 +337,7 @@ 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" "--add" "--" (file-relative-name ignore-name))) + (git-call-process-env 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 @@ -485,33 +484,34 @@ and returns the process output as a string." "Remove everything from the status list." (ewoc-filter status (lambda (info) nil))) -(defun git-set-files-state (files state) - "Set the state of a list of files." - (dolist (info files) - (unless (eq (git-fileinfo->state info) state) - (setf (git-fileinfo->state info) state) - (setf (git-fileinfo->rename-state info) nil) - (setf (git-fileinfo->orig-name info) nil) - (setf (git-fileinfo->needs-refresh info) t)))) - -(defun git-set-filenames-state (status files state) - "Set the state of a list of named files." +(defun git-set-fileinfo-state (info state) + "Set the state of a file info." + (unless (eq (git-fileinfo->state info) state) + (setf (git-fileinfo->state info) state + (git-fileinfo->old-perm info) 0 + (git-fileinfo->new-perm info) 0 + (git-fileinfo->rename-state info) nil + (git-fileinfo->orig-name info) nil + (git-fileinfo->needs-refresh info) t))) + +(defun git-status-filenames-map (status func files &rest args) + "Apply FUNC to the status files names in the FILES list." (when files (setq files (sort files #'string-lessp)) (let ((file (pop files)) (node (ewoc-nth status 0))) (while (and file node) (let ((info (ewoc-data node))) - (cond ((string-lessp (git-fileinfo->name info) file) - (setq node (ewoc-next status node))) - ((string-equal (git-fileinfo->name info) file) - (unless (eq (git-fileinfo->state info) state) - (setf (git-fileinfo->state info) state) - (setf (git-fileinfo->rename-state info) nil) - (setf (git-fileinfo->orig-name info) nil) - (setf (git-fileinfo->needs-refresh info) t)) - (setq file (pop files))) - (t (setq file (pop files))))))) + (if (string-lessp (git-fileinfo->name info) file) + (setq node (ewoc-next status node)) + (if (string-equal (git-fileinfo->name info) file) + (apply func info args)) + (setq file (pop files)))))))) + +(defun git-set-filenames-state (status files state) + "Set the state of a list of named files." + (when files + (git-status-filenames-map status #'git-set-fileinfo-state files state) (unless state ;; delete files whose state has been set to nil (ewoc-filter status (lambda (info) (git-fileinfo->state info)))))) @@ -599,7 +599,7 @@ and returns the process output as a string." Return the list of files that haven't been handled." (let (infolist) (with-temp-buffer - (apply #'git-run-command t nil "diff-index" "-z" "-M" "HEAD" "--" files) + (apply #'git-call-process-env 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" @@ -632,7 +632,7 @@ Return the list of files that haven't been handled." Return the list of files that haven't been handled." (let (infolist) (with-temp-buffer - (apply #'git-run-command t nil "ls-files" "-z" (append options (list "--") files)) + (apply #'git-call-process-env t nil "ls-files" "-z" (append options (list "--") files)) (goto-char (point-min)) (while (re-search-forward "\\([^\0]*\\)\0" nil t 1) (let ((name (match-string 1))) @@ -644,7 +644,7 @@ Return the list of files that haven't been handled." (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) + (apply #'git-call-process-env 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) @@ -747,11 +747,11 @@ Return the list of files that haven't been handled." ('deleted (push info deleted)) ('modified (push info modified)))) (when added - (apply #'git-run-command nil env "update-index" "--add" "--" (git-get-filenames added))) + (apply #'git-call-process-env nil env "update-index" "--add" "--" (git-get-filenames added))) (when deleted - (apply #'git-run-command nil env "update-index" "--remove" "--" (git-get-filenames deleted))) + (apply #'git-call-process-env nil env "update-index" "--remove" "--" (git-get-filenames deleted))) (when modified - (apply #'git-run-command nil env "update-index" "--" (git-get-filenames modified))))) + (apply #'git-call-process-env nil env "update-index" "--" (git-get-filenames modified))))) (defun git-run-pre-commit-hook () "Run the pre-commit hook if any." @@ -783,6 +783,7 @@ Return the list of files that haven't been handled." head-tree (git-rev-parse "HEAD^{tree}"))) (if files (progn + (message "Running git commit...") (git-read-tree head-tree index-file) (git-update-index nil files) ;update both the default index (git-update-index index-file files) ;and the temporary one @@ -793,8 +794,8 @@ Return the list of files that haven't been handled." (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) - (git-run-command nil nil "rerere") + (dolist (info files) (git-set-fileinfo-state info 'uptodate)) + (git-call-process-env nil nil "rerere") (git-refresh-files) (git-refresh-ewoc-hf git-status) (message "Committed %s." commit) @@ -905,8 +906,9 @@ Return the list of files that haven't been handled." (let ((files (git-get-filenames (git-marked-files-state 'unknown 'ignored)))) (unless 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))) + (apply #'git-call-process-env nil nil "update-index" "--add" "--" files) + (git-update-status-files files 'uptodate) + (git-success-message "Added" files))) (defun git-ignore-file () "Add marked file(s) to the ignore list." @@ -915,7 +917,8 @@ Return the list of files that haven't been handled." (unless 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))) + (git-update-status-files files 'ignored) + (git-success-message "Ignored" files))) (defun git-remove-file () "Remove the marked file(s)." @@ -928,8 +931,9 @@ Return the list of files that haven't been handled." (progn (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)) + (apply #'git-call-process-env nil nil "update-index" "--remove" "--" files) + (git-update-status-files files nil) + (git-success-message "Removed" files)) (message "Aborting")))) (defun git-revert-file () @@ -947,18 +951,20 @@ Return the list of files that haven't been handled." ('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" "--" added)) + (apply #'git-call-process-env nil nil "update-index" "--force-remove" "--" added)) (when modified - (apply #'git-run-command nil nil "checkout" "HEAD" modified)) - (git-update-status-files (append added modified) 'uptodate)))) + (apply #'git-call-process-env nil nil "checkout" "HEAD" modified)) + (git-update-status-files (append added modified) 'uptodate) + (git-success-message "Reverted" files)))) (defun git-resolve-file () "Resolve conflicts in marked file(s)." (interactive) (let ((files (git-get-filenames (git-marked-files-state 'unmerged)))) (when files - (apply #'git-run-command nil nil "update-index" "--" files) - (git-update-status-files files 'uptodate)))) + (apply #'git-call-process-env nil nil "update-index" "--" files) + (git-update-status-files files 'uptodate) + (git-success-message "Resolved" files)))) (defun git-remove-handled () "Remove handled files from the status list." @@ -985,9 +991,11 @@ Return the list of files that haven't been handled." (interactive) (if (setq git-show-ignored (not git-show-ignored)) (progn + (message "Inserting ignored files...") (git-run-ls-files-with-excludes git-status nil 'ignored "-o" "-i") (git-refresh-files) - (git-refresh-ewoc-hf git-status)) + (git-refresh-ewoc-hf git-status) + (message "Inserting ignored files...done")) (git-remove-handled))) (defun git-toggle-show-unknown () @@ -995,9 +1003,11 @@ Return the list of files that haven't been handled." (interactive) (if (setq git-show-unknown (not git-show-unknown)) (progn + (message "Inserting unknown files...") (git-run-ls-files-with-excludes git-status nil 'unknown "-o") (git-refresh-files) - (git-refresh-ewoc-hf git-status)) + (git-refresh-ewoc-hf git-status) + (message "Inserting unknown files...done")) (git-remove-handled))) (defun git-setup-diff-buffer (buffer) @@ -1197,12 +1207,23 @@ Return the list of files that haven't been handled." (interactive) (let* ((status git-status) (pos (ewoc-locate status)) + (marked-files (git-get-filenames (ewoc-collect status (lambda (info) (git-fileinfo->marked info))))) (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") + (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))))) @@ -1324,9 +1345,24 @@ Commands: (cd dir) (git-status-mode) (git-refresh-status) - (goto-char (point-min))) + (goto-char (point-min)) + (add-hook 'after-save-hook 'git-update-saved-file)) (message "%s is not a git working tree." dir))) +(defun git-update-saved-file () + "Update the corresponding git-status buffer when a file is saved. +Meant to be used in `after-save-hook'." + (let* ((file (expand-file-name buffer-file-name)) + (dir (condition-case nil (git-get-top-dir (file-name-directory file)))) + (buffer (and dir (git-find-status-buffer dir)))) + (when buffer + (with-current-buffer buffer + (let ((filename (file-relative-name file dir))) + ; skip files located inside the .git directory + (unless (string-match "^\\.git/" filename) + (git-call-process-env nil nil "add" "--refresh" "--" filename) + (git-update-status-files (list filename) 'uptodate))))))) + (defun git-help () "Display help for Git mode." (interactive) |