branch: elpa/magit
commit e2c25e79eb9c17643d23d45809934a12d84414ef
Author: Jonas Bernoulli <[email protected]>
Commit: Jonas Bernoulli <[email protected]>
Add support for triggering lisp hooks from git hooks
---
CHANGELOG | 2 +
git-hooks/applypatch-msg | 1 +
git-hooks/commit-msg | 1 +
git-hooks/fallthrough | 8 ++++
git-hooks/fsmonitor-watchman | 1 +
git-hooks/p4-changelist | 1 +
git-hooks/p4-post-changelist | 1 +
git-hooks/p4-pre-submit | 1 +
git-hooks/p4-prepare-changelist | 1 +
git-hooks/post-applypatch | 1 +
git-hooks/post-checkout | 1 +
git-hooks/post-commit | 1 +
git-hooks/post-index-change | 1 +
git-hooks/post-merge | 1 +
git-hooks/post-receive | 1 +
git-hooks/post-rewrite | 1 +
git-hooks/post-update | 1 +
git-hooks/pre-applypatch | 1 +
git-hooks/pre-auto-gc | 1 +
git-hooks/pre-commit | 1 +
git-hooks/pre-merge-commit | 1 +
git-hooks/pre-push | 1 +
git-hooks/pre-rebase | 1 +
git-hooks/pre-receive | 1 +
git-hooks/prepare-commit-msg | 1 +
git-hooks/proc-receive | 1 +
git-hooks/push-to-checkout | 1 +
git-hooks/reference-transaction | 1 +
git-hooks/sendemail-validate | 1 +
git-hooks/update | 1 +
lisp/magit-git.el | 91 ++++++++++++++++++++++++++++++++++++++++-
lisp/magit-process.el | 26 +++++++++---
32 files changed, 147 insertions(+), 8 deletions(-)
diff --git a/CHANGELOG b/CHANGELOG
index ea6a19f8c8d..19c96358058 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -13,6 +13,8 @@
by ~magit-wip-mode~) and using the new ~magit-before-change-functions~
and ~magit-after-apply-functions~ hooks. 98ef107037..fa629ad5b5
+- Added experimental support for calling Lisp hooks from Git hooks.
+
- Replaced option ~magit-section-visibility-indicator~ (singluar) with
new option ~magit-section-visibility-indicators~ (plurarl) to better
support emacs sessions that have both terminal and gui frames.
diff --git a/git-hooks/applypatch-msg b/git-hooks/applypatch-msg
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/applypatch-msg
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/commit-msg b/git-hooks/commit-msg
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/commit-msg
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/fallthrough b/git-hooks/fallthrough
new file mode 100755
index 00000000000..51928e7f3d4
--- /dev/null
+++ b/git-hooks/fallthrough
@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+
+hook="$SHADOWED_GITHOOK_DIRECTORY/$(basename $0)"
+
+if [[ -x "$hook" ]]
+then
+ "$hook" "$@"
+fi
diff --git a/git-hooks/fsmonitor-watchman b/git-hooks/fsmonitor-watchman
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/fsmonitor-watchman
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/p4-changelist b/git-hooks/p4-changelist
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/p4-changelist
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/p4-post-changelist b/git-hooks/p4-post-changelist
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/p4-post-changelist
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/p4-pre-submit b/git-hooks/p4-pre-submit
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/p4-pre-submit
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/p4-prepare-changelist b/git-hooks/p4-prepare-changelist
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/p4-prepare-changelist
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/post-applypatch b/git-hooks/post-applypatch
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/post-applypatch
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/post-checkout b/git-hooks/post-checkout
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/post-checkout
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/post-commit b/git-hooks/post-commit
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/post-commit
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/post-index-change b/git-hooks/post-index-change
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/post-index-change
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/post-merge b/git-hooks/post-merge
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/post-merge
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/post-receive b/git-hooks/post-receive
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/post-receive
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/post-rewrite b/git-hooks/post-rewrite
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/post-rewrite
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/post-update b/git-hooks/post-update
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/post-update
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/pre-applypatch b/git-hooks/pre-applypatch
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/pre-applypatch
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/pre-auto-gc b/git-hooks/pre-auto-gc
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/pre-auto-gc
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/pre-commit b/git-hooks/pre-commit
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/pre-commit
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/pre-merge-commit b/git-hooks/pre-merge-commit
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/pre-merge-commit
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/pre-push b/git-hooks/pre-push
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/pre-push
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/pre-rebase b/git-hooks/pre-rebase
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/pre-rebase
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/pre-receive b/git-hooks/pre-receive
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/pre-receive
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/prepare-commit-msg b/git-hooks/prepare-commit-msg
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/prepare-commit-msg
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/proc-receive b/git-hooks/proc-receive
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/proc-receive
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/push-to-checkout b/git-hooks/push-to-checkout
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/push-to-checkout
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/reference-transaction b/git-hooks/reference-transaction
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/reference-transaction
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/sendemail-validate b/git-hooks/sendemail-validate
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/sendemail-validate
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/git-hooks/update b/git-hooks/update
new file mode 120000
index 00000000000..833950e79b1
--- /dev/null
+++ b/git-hooks/update
@@ -0,0 +1 @@
+fallthrough
\ No newline at end of file
diff --git a/lisp/magit-git.el b/lisp/magit-git.el
index e774bd48891..a2a5204bd4b 100644
--- a/lisp/magit-git.el
+++ b/lisp/magit-git.el
@@ -29,6 +29,7 @@
(require 'magit-base)
(require 'format-spec)
+(require 'server)
;; From `magit-branch'.
(defvar magit-branch-prefer-remote-upstream)
@@ -153,6 +154,42 @@ option."
:group 'magit-process
:type 'string)
+(defvar magit--overriding-githook-directory nil)
+
+(defcustom magit-overriding-githook-directory nil
+ "Directory containing the Git hook scripts used by Magit.
+
+No Magit-specific Git hook scripts are used if this is nil, which it
+is the default. This feature is still experimental.
+
+Git does not allow overriding just an individual hook. It is only
+possible to point Git at an alternative directory containing hook
+scripts, using the Git variable `core.hooksPath'. When doing that,
+the hooks located in `$GIT_DIR/hooks' are ignored.
+
+If `magit', use the directory containing Git hook scripts distributed
+with Magit. To counteract Git's limited granularity, Magit provides a
+script for every Git hook, most of which only run the respective script
+located in `$GIT_DIR/hooks', provided it exists and is executable.
+
+A few Git hooks additionally run Lisp hooks: TODO
+
+If you want to teach additional Git hooks to run Lisp hooks, you have to
+copy Magit's hook script directory elsewhere, modify the hook scripts in
+question, and point this variable at the used directory.
+
+Magit only sets `core.hooksPath' when calling Git asynchronously. Doing
+the same when calling Git synchronously would cause Git and Magit to wait
+on one another."
+ :package-version '(magit . "4.5.0")
+ :group 'magit-process
+ :set (lambda (symbol value)
+ (set-default-toplevel-value symbol value)
+ (setq magit--overriding-githook-directory nil))
+ :type '(choice (const :tag "Do not shadow Git's hook directory" nil)
+ (const :tag "Use Magit's hook directory" magit)
+ (directory :tag "Custom directory")))
+
(defcustom magit-git-global-arguments
`("--no-pager" "--literal-pathspecs"
"-c" "core.preloadIndex=true"
@@ -336,7 +373,11 @@ is remote."
magit-remote-git-executable
magit-git-executable))
-(defun magit-process-git-arguments (args)
+(defun magit-process-git-arguments--length ()
+ (+ (length magit-git-global-arguments)
+ (if magit--overriding-githook-directory 2 0)))
+
+(defun magit-process-git-arguments (args &optional async)
"Prepare ARGS for a function that invokes Git.
Magit has many specialized functions for running Git; they all
@@ -344,9 +385,27 @@ pass arguments through this function before handing them
to Git,
to do the following.
* Prepend `magit-git-global-arguments' to ARGS.
+* If ASYNC is non-nil and `magit-overriding-githook-directory' is non-nil
+ and valid, set `core.hooksPath' by adding additional aguments to ARGS.
* Flatten ARGS, removing nil arguments.
* If `system-type' is `windows-nt', encode ARGS to `w32-ansi-code-page'."
- (setq args (append magit-git-global-arguments (flatten-tree args)))
+ (cond ((not async))
+ (magit--overriding-githook-directory)
+ ((eq magit-overriding-githook-directory 'magit)
+ (setq magit--overriding-githook-directory
+ (expand-file-name "git-hooks"
+ (locate-dominating-file
+ (locate-library "magit.el") "git-hooks"))))
+ ((and magit-overriding-githook-directory
+ (file-directory-p magit-overriding-githook-directory))
+ (setq magit--overriding-githook-directory
+ magit-overriding-githook-directory)))
+ (setq args
+ (append magit-git-global-arguments
+ (and magit--overriding-githook-directory
+ (list "-c" (format "core.hooksPath=%s"
+ magit--overriding-githook-directory)))
+ (flatten-tree args)))
(if (and (eq system-type 'windows-nt) (boundp 'w32-ansi-code-page))
;; On w32, the process arguments *must* be encoded in the
;; current code-page (see #3250).
@@ -2898,6 +2957,34 @@ out. Only existing branches can be selected."
(magit-confirm t nil (format "%s %%d modules" verb) nil modules)
(list (magit-read-module-path (format "%s module" verb) predicate)))))
+;;; Git Hooks
+
+(defun magit-run-git-hook (githook &rest args)
+ (dolist (githook (ensure-list githook))
+ (let* ((githook (symbol-name githook))
+ (hook (save-match-data
+ (if (string-match "\\`common-" githook)
+ (intern (format "magit-common-git-%s-functions"
+ (substring githook (match-end 0))))
+ (intern (format "magit-git-%s-functions" githook))))))
+ (when (and (boundp hook)
+ (symbol-value hook))
+ (magit--client-message "Running %s..." hook)
+ (apply #'run-hook-with-args hook args)
+ (magit--client-message "Running %s...done" hook))))
+ ;; Emacsclient prints the returned value to stdout. We cannot prevent
+ ;; that, but we can use something that looks like we actually *wanted*
+ ;; to print (which we don't).
+ '---)
+
+(defun magit--client-message (format-string &rest args)
+ ;; See `server-process-filter'.
+ (let ((msg (format "-print %s\n"
+ (server-quote-arg
+ (apply #'format-message format-string args)))))
+ (dolist (client server-clients)
+ (server-send-string client msg))))
+
;;; _
(provide 'magit-git)
;; Local Variables:
diff --git a/lisp/magit-process.el b/lisp/magit-process.el
index 093ee838df7..b47237ee21a 100644
--- a/lisp/magit-process.el
+++ b/lisp/magit-process.el
@@ -524,12 +524,26 @@ eol conversion."
(default-process-coding-system (magit--process-coding-system)))
(apply #'process-file process infile buffer display args)))
+(defvar magit--shadowed-githook-directory nil)
+
+(defun magit--shadowed-githook-directory ()
+ (or magit--shadowed-githook-directory
+ (setq magit--shadowed-githook-directory
+ (let ((magit-git-global-arguments nil))
+ (cl-letf (((symbol-function 'magit-process-environment)
+ (lambda () process-environment)))
+ (or (magit-get "core.hooksPath")
+ (expand-file-name "hooks" (magit-gitdir))))))))
+
(defun magit-process-environment ()
;; The various w32 hacks are only applicable when running on the local
;; machine. A local binding of process-environment different from the
;; top-level value affects the environment used by Tramp.
(let ((local (not (file-remote-p default-directory))))
(append magit-git-environment
+ (and magit-overriding-githook-directory
+ (list (concat "SHADOWED_GITHOOK_DIRECTORY="
+ (magit--shadowed-githook-directory))))
(and local
(cdr (assoc magit-git-executable magit-git-w32-path-hack)))
(and local magit-need-cygwin-noglob
@@ -569,7 +583,7 @@ flattened before use."
(run-hooks 'magit-pre-call-git-hook)
(pcase-let* ((process-environment (magit-process-environment))
(default-process-coding-system (magit--process-coding-system))
- (flat-args (magit-process-git-arguments args))
+ (flat-args (magit-process-git-arguments args t))
(`(,process-buf . ,section)
(magit-process-setup (magit-git-executable) flat-args))
(inhibit-read-only t))
@@ -652,7 +666,7 @@ See `magit-start-process' for more information."
(run-hooks 'magit-pre-start-git-hook)
(let ((default-process-coding-system (magit--process-coding-system)))
(apply #'magit-start-process (magit-git-executable) input
- (magit-process-git-arguments args))))
+ (magit-process-git-arguments args t))))
(defun magit-start-process (program &optional input &rest args)
"Start PROGRAM, prepare for refresh, and return the process object.
@@ -725,7 +739,7 @@ Magit status buffer."
process))
(defun magit-parse-git-async (&rest args)
- (setq args (magit-process-git-arguments args))
+ (setq args (magit-process-git-arguments args t))
(let ((command-buf (current-buffer))
(stdout-buf (generate-new-buffer " *git-stdout*"))
(stderr-buf (generate-new-buffer " *git-stderr*"))
@@ -792,7 +806,7 @@ Magit status buffer."
(defun magit-process--format-arguments (program args)
(cond
((and args (equal program (magit-git-executable)))
- (let ((global (length magit-git-global-arguments)))
+ (let ((global (magit-process-git-arguments--length)))
(concat
(propertize (file-name-nondirectory program)
'font-lock-face 'magit-section-heading)
@@ -864,7 +878,7 @@ Magit status buffer."
`((commit . ,(magit-rev-parse "HEAD"))
(,(pcase (car (seq-drop
(process-command process)
- (1+ (length
magit-git-global-arguments))))
+ (1+
(magit-process-git-arguments--length))))
((or "rebase" "am") 'rebase-sequence)
((or "cherry-pick" "revert") 'sequence)))
(status)))))
@@ -1101,7 +1115,7 @@ as argument."
(defun magit-process-set-mode-line (program args)
"Display the git command (sans arguments) in the mode line."
(when (equal program (magit-git-executable))
- (setq args (nthcdr (length magit-git-global-arguments) args)))
+ (setq args (nthcdr (magit-process-git-arguments--length) args)))
(let ((str (concat " " (propertize
(concat (file-name-nondirectory program)
(and args (concat " " (car args))))
