Add support for commit debouncing.
This patch prevents frequent saves from making an excessively large number of commits. With gac-debounce-interval (a buffer-specific variable) set to a number representing seconds, buffers with git-auto-commit-mode active will only make Git commits at the end of the given interval after a save. So with gac-debounce-interval set to 300, a buffer will commit changes accumulated over 5 minutes, rather than at every save. It will also commit if the buffer is killed. This mode of operation can be made default with, e.g.: (setq-default gac-debounce-interval 300)
This commit is contained in:
parent
2c8197e5d7
commit
074739d78f
1 changed files with 65 additions and 17 deletions
|
@ -29,8 +29,15 @@
|
||||||
;; When `gac-automatically-push-p' is non-nil, it also tries to push
|
;; When `gac-automatically-push-p' is non-nil, it also tries to push
|
||||||
;; to the current upstream.
|
;; to the current upstream.
|
||||||
|
|
||||||
|
;; When `gac-debounce-interval' is non-nil and set to a number
|
||||||
|
;; representing seconds, it will only perform Git actions at that
|
||||||
|
;; interval. That way, repeatedly saving a file will not hammer the
|
||||||
|
;; Git repository.
|
||||||
|
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'cl)
|
||||||
|
|
||||||
(defgroup git-auto-commit-mode nil
|
(defgroup git-auto-commit-mode nil
|
||||||
"Customization options for `git-auto-commit-mode'."
|
"Customization options for `git-auto-commit-mode'."
|
||||||
:group 'external)
|
:group 'external)
|
||||||
|
@ -58,6 +65,15 @@ If non-nil a git push will be executed after each commit."
|
||||||
:group 'git-auto-commit-mode
|
:group 'git-auto-commit-mode
|
||||||
:type 'string)
|
:type 'string)
|
||||||
|
|
||||||
|
(defcustom gac-debounce-interval nil
|
||||||
|
"Debounce automatic commits to avoid hammering Git.
|
||||||
|
|
||||||
|
If non-nil a commit will be scheduled to occur that many seconds in the future. Note that this uses Emacs timer functionality, and is subject to its limitations."
|
||||||
|
:tag "Debounce to only make one commit this many seconds."
|
||||||
|
:group 'git-auto-commit-mode
|
||||||
|
:type 'fixnum)
|
||||||
|
(make-variable-buffer-local 'gac-debounce-interval)
|
||||||
|
|
||||||
(defun gac-relative-file-name (filename)
|
(defun gac-relative-file-name (filename)
|
||||||
"Find the path to FILENAME relative to the git directory."
|
"Find the path to FILENAME relative to the git directory."
|
||||||
(let* ((git-dir
|
(let* ((git-dir
|
||||||
|
@ -109,34 +125,66 @@ Default to FILENAME."
|
||||||
relative-filename
|
relative-filename
|
||||||
(read-string "Summary: " nil nil relative-filename))))
|
(read-string "Summary: " nil nil relative-filename))))
|
||||||
|
|
||||||
(defun gac-commit ()
|
(defun gac-commit (actual-buffer)
|
||||||
"Commit the current buffer's file to git."
|
"Commit the current buffer's file to git."
|
||||||
(let* ((buffer-file (buffer-file-name))
|
(with-current-buffer (or actual-buffer (current-buffer))
|
||||||
(filename (convert-standard-filename
|
(let* ((buffer-file (buffer-file-name))
|
||||||
(file-name-nondirectory buffer-file)))
|
(filename (convert-standard-filename
|
||||||
(commit-msg (gac--commit-msg buffer-file))
|
(file-name-nondirectory buffer-file)))
|
||||||
(default-directory (file-name-directory buffer-file)))
|
(commit-msg (gac--commit-msg buffer-file))
|
||||||
(shell-command
|
(default-directory (file-name-directory buffer-file)))
|
||||||
(concat "git add " (shell-quote-argument filename)
|
(shell-command
|
||||||
gac-shell-and
|
(concat "git add " (shell-quote-argument filename)
|
||||||
"git commit -m " (shell-quote-argument commit-msg)))))
|
" && git commit -m " (shell-quote-argument commit-msg))))))
|
||||||
|
|
||||||
(defun gac-push ()
|
(defun gac-push (actual-buffer)
|
||||||
"Push commits to the current upstream.
|
"Push commits to the current upstream.
|
||||||
|
|
||||||
This doesn't check or ask for a remote, so the correct remote
|
This doesn't check or ask for a remote, so the correct remote
|
||||||
should already have been set up."
|
should already have been set up."
|
||||||
(let ((proc (start-process "git" "*git-auto-push*" "git" "push")))
|
(with-current-buffer (or actual-buffer (current-buffer))
|
||||||
(set-process-sentinel proc 'gac-process-sentinel)
|
(let ((proc (start-process "git" "*git-auto-push*" "git" "push")))
|
||||||
(set-process-filter proc 'gac-process-filter)))
|
(set-process-sentinel proc 'gac-process-sentinel)
|
||||||
|
(set-process-filter proc 'gac-process-filter))))
|
||||||
|
|
||||||
|
(setq gac--debounce-timers (make-hash-table :test #'equal))
|
||||||
|
|
||||||
|
(defun gac--debounced-save ()
|
||||||
|
(lexical-let* ((actual-buffer (current-buffer))
|
||||||
|
(current-buffer-debounce-timer (gethash actual-buffer gac--debounce-timers)))
|
||||||
|
(unless current-buffer-debounce-timer
|
||||||
|
(puthash actual-buffer
|
||||||
|
(run-at-time gac-debounce-interval nil
|
||||||
|
(lambda (actual-buffer)
|
||||||
|
(gac--after-save actual-buffer))
|
||||||
|
actual-buffer)
|
||||||
|
gac--debounce-timers))))
|
||||||
|
|
||||||
|
(defun gac--after-save (&optional actual-buffer)
|
||||||
|
(let ((actual-buffer (or actual-buffer (current-buffer))))
|
||||||
|
(unwind-protect
|
||||||
|
(when (buffer-live-p actual-buffer)
|
||||||
|
(gac-commit actual-buffer)
|
||||||
|
(when gac-automatically-push-p
|
||||||
|
(gac-push actual-buffer)))
|
||||||
|
(remhash actual-buffer gac--debounce-timers))))
|
||||||
|
|
||||||
|
(defun gac-kill-buffer-hook ()
|
||||||
|
(when (and gac-debounce-interval
|
||||||
|
gac--debounce-timers
|
||||||
|
(gethash (current-buffer) gac--debounce-timers))
|
||||||
|
(gac--after-save)))
|
||||||
|
|
||||||
|
(add-hook 'kill-buffer-hook #'gac-kill-buffer-hook)
|
||||||
|
|
||||||
(defun gac-after-save-func ()
|
(defun gac-after-save-func ()
|
||||||
"Commit the current file.
|
"Commit the current file.
|
||||||
|
|
||||||
When `gac-automatically-push-p' is non-nil also push."
|
When `gac-automatically-push-p' is non-nil also push."
|
||||||
(gac-commit)
|
|
||||||
(when gac-automatically-push-p
|
(if gac-debounce-interval
|
||||||
(gac-push)))
|
(gac--debounced-save)
|
||||||
|
(gac--after-save)))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(define-minor-mode git-auto-commit-mode
|
(define-minor-mode git-auto-commit-mode
|
||||||
|
|
Loading…
Reference in a new issue