Merge pull request #35 from johannes-mueller/custom-actions

Dynamic custom commands

Author: johannes-mueller

README.md

@@ -130,6 +130,13 @@ the last tested module resp. last tested function are tested.  If there are no
 last tests, an error message is thrown.
 
 
+### Custom test or build actions
+
+There are two functions `test-cockpit-add-custom-action` and
+`test-cockpit-add-dynamic-custom-action` that allow you to register custom
+actions for a project type.
+
+
 ## Dape support
 
 There are stubs to make use of the [Dape](https://github.com/svaante/dape/)

test-cockpit-cask.el

@@ -40,7 +40,7 @@
 (cl-defmethod test-cockpit--engine-current-function-string ((_obj test-cockpit-cask-engine))
   "Implement test-cockpit--engine-current-function-string."
   (when-let ((fn (buffer-file-name)))
-    (when (string-suffix-p ".el-test.el" fn)
+    (when (string-suffix-p "test.el" fn)
       (which-function))))
 
 

test-cockpit.el

@@ -80,6 +80,10 @@ Usually there is one such engine per project that has been
 visited during the current session.  An engine is an instance of
 a derived class of `test-cockpit--engine'.")
 
+
+(defvar test-cockpit--project-type-custom-actions '()
+  "Custom actions that can be registered on a project type level.")
+
 (defclass test-cockpit--engine ()
   ((last-command :initarg :last-command
                  :initform nil)
@@ -389,6 +393,31 @@ and thus can be repeated using `test-cockpit-repeat-test'."
   (oset (test-cockpit--retrieve-engine) last-custom-command compile-command)
   (oset (test-cockpit--retrieve-engine) last-command compile-command))
 
+(defun test-cockpit--process-custom-command (command regex replacement)
+  "Replace REGEX in COMMAND with REPLACEMENT only if the first character of the match is not '%'"
+  (let ((replace-closure
+         (lambda (match)
+           (let ((marker (substring match 0 1))
+                 (old-text (substring match 1)))
+             (if (equal marker "%")
+                 old-text
+               (concat marker replacement))))))
+    (replace-regexp-in-string regex replace-closure command t)))
+
+;;;###autoload
+(defun test-cockpit-dynamic-custom-test-command (command)
+  "Run `compile' command for a custom test command.
+The command run is determined by COMMAND where
+* %P is replaced with the absolute current procject root path
+* %F is replaced with the absolute current buffer file path
+* %f is replaced with the current buffer file path relative to project root"
+  (let* ((case-fold-search nil)
+         (relative-file-path (substring (buffer-file-name) (length (projectile-project-root))))
+         (command (test-cockpit--process-custom-command command "\\(.\\)%P" (projectile-project-root)))
+         (command (test-cockpit--process-custom-command command "\\(.\\)%F" (buffer-file-name)))
+         (command (test-cockpit--process-custom-command command "\\(.\\)%f" relative-file-path)))
+    (test-cockpit--run-test command)))
+
 ;;;###autoload
 (defun test-cockpit-repeat-test (&optional _args)
   "Repeat the last test if the current project had last test.
@@ -472,8 +501,51 @@ in order to call the last test action with modified ARGS."
       (test-cockpit--launch-dape config)
     (user-error "No recent test-action has been performed or no Dape support for backend")))
 
+ (defun test-cockpit-add-custom-action (project-type shortcut description action)
+  "Add a custom ACTION to a test-cockpit of PROJECT-TYPE.
+
+The PROJECT-TYPE must be a registered project type.  ACTION can be either a function
+or a string.  A string is passed as is to the `compile' function.
+
+SHORTCUT is the transient shortcut and DESCRIPTION is the transient description for
+the action."
+  (let ((action (if (stringp action)
+                    `(lambda () (interactive) (test-cockpit--run-test ,action))
+                  action)))
+    (test-cockpit--add-custom-action-function project-type shortcut description action)))
+
+(defun test-cockpit-add-dynamic-custom-action (project-type shortcut description command-template)
+  "Add a dynamic custom ACTION to a test-cockpit of PROJECT-TYPE.
+
+The PROJECT-TYPE must be a registered project type.  COMMAND-TEMPLATE is a
+string that is used to determine the compile command
+* %P is replaced with the absolute current procject root path
+* %F is replaced with the absolute current buffer file path
+* %f is replaced with the current buffer file path relative to project root
+
+SHORTCUT is the transient shortcut and DESCRIPTION is the transient
+description for the action."
+  (test-cockpit--add-custom-action-function project-type shortcut description
+   `(lambda () (interactive) (test-cockpit-dynamic-custom-test-command ,command-template))))
+
+(defun test-cockpit--add-custom-action-function (project-type shortcut description action)
+  "Register a custom action consisting of SHORTCUT, DESCRIPTION and ACTION to PROJECT-TYPE."
+  (let ((action-list (alist-get project-type test-cockpit--project-type-custom-actions))
+        (action-set `(,shortcut ,description ,action)))
+    (if action-list
+        (setcdr (assoc project-type test-cockpit--project-type-custom-actions)
+                (append action-list `(,action-set)))
+      (push `(,project-type . (,action-set))
+            test-cockpit--project-type-custom-actions))))
+
+(defun test-cockpit--custom-actions ()
+  "Make the transient suffix for the custom actions."
+  (when-let ((custom-actions
+              (alist-get (projectile-project-type) test-cockpit--project-type-custom-actions)))
+    (vconcat ["Custom actions"] (vconcat custom-actions))))
+
 (defun test-cockpit--launch-dape (config)
-  "Launch the dape debug session and memorize that last test was a dape session."
+  "Launch the dape debug session with CONFIG and memorize that last test was a dape session."
   (dape config)
   (oset (test-cockpit--retrieve-engine) last-command 'test-cockpit--last-command-was-dape))
 
@@ -547,12 +619,13 @@ repetition."
   "Get the dape configuration for the last test."
   (test-cockpit--engine-dape-last-test-config (test-cockpit--retrieve-engine)))
 
+
 (transient-define-prefix test-cockpit-prefix ()
   "Test the project."
   :value 'test-cockpit--last-switches
   [])
 
-(defun test-cockpit--main-suffix ()
+(defun test-cockpit--test-action-suffix ()
   "Setup the main menu common for all projects for testing."
   (let ((module-string (or (test-cockpit--current-module-string) (test-cockpit--last-module-string)))
         (function-string (or (test-cockpit--current-function-string) (test-cockpit--last-function-string)))
@@ -574,6 +647,12 @@ repetition."
                                    ,(if last-cmd
                                         `("r" "repeat" test-cockpit--repeat-interactive-test))))))))
 
+(defun test-cockpit--main-suffix ()
+  "Setup the main menu common for all projects for testing and actions."
+  (if-let ((custom-actions-suffix (test-cockpit--custom-actions)))
+      `[,(test-cockpit--test-action-suffix) ,custom-actions-suffix]
+    (test-cockpit--test-action-suffix)))
+
 (defun test-cockpit--strip-project-root (path)
   "Strip the project root path from a given PATH."
   (string-remove-prefix (file-name-as-directory (projectile-project-root)) path))

test/test-cockpit.el-test.el

@@ -24,6 +24,8 @@
 
 (defun tc--register-foo-project (test-string)
   (setq test-cockpit--project-engines nil)
+  (setq test-cockpit--project-type-custom-actions
+        (assoc-delete-all 'foo-project-type test-cockpit--project-type-custom-actions))
   (test-cockpit-register-project-type 'foo-project-type 'test-cockpit--foo-engine)
   (mocker-let ((projectile-project-type () ((:output 'foo-project-type :min-occur 0)))
                (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "foo-project" :min-occur 0))))
@@ -413,6 +415,72 @@
     (test-cockpit-repeat-test)))
 
 
+(ert-deftest test-custom-action-simple ()
+  (mocker-let ((projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "/path/to/project")))
+               (buffer-file-name () ((:output "/path/to/project/some/file.el")))
+               (compile (command) ((:input '("custom test command") :output 'success))))
+    (test-cockpit-dynamic-custom-test-command "custom test command")))
+
+
+(ert-deftest test-custom-action-repeat ()
+  (tc--register-foo-project "foo")
+  (mocker-let (;(projectile-project-type () ((:output 'foo-project-type)))
+               (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "foo-project")))
+               (buffer-file-name () ((:output "/path/to/project/some/file.el")))
+               (compile (command) ((:input '("other custom test action") :output 'success :occur 2))))
+    (test-cockpit-dynamic-custom-test-command "other custom test action")
+    (test-cockpit-repeat-test)))
+
+
+(ert-deftest test-custom-action-replace-project-root ()
+  (tc--register-foo-project "foo")
+  (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))
+               (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "/path/to/project")))
+               (buffer-file-name () ((:output "/path/to/project/some/file.el")))
+               (compile (command) ((:input '("command /path/to/project") :output 'success :occur 2))))
+    (test-cockpit-dynamic-custom-test-command "command %P")
+    (test-cockpit-repeat-test)))
+
+(ert-deftest test-custom-action-no-replace-project-root ()
+  (tc--register-foo-project "foo")
+  (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))
+               (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "/path/to/project")))
+               (buffer-file-name () ((:output "/path/to/project/some/file.el")))
+               (compile (command) ((:input '("command %Project") :output 'success :occur 2))))
+    (test-cockpit-dynamic-custom-test-command "command %%Project")
+    (test-cockpit-repeat-test)))
+
+
+(ert-deftest test-custom-action-replace-absolute-file ()
+  (tc--register-foo-project "foo")
+  (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))
+               (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "/path/to/project/")))
+               (buffer-file-name () ((:output "/path/to/project/some/file.el")))
+               (compile (command) ((:input '("command /path/to/project/some/file.el") :output 'success :occur 2))))
+    (test-cockpit-dynamic-custom-test-command "command %F")
+    (test-cockpit-repeat-test)))
+
+
+(ert-deftest test-custom-action-no-replace-absolute-file ()
+  (tc--register-foo-project "foo")
+  (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))
+               (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "/path/to/project/")))
+               (buffer-file-name () ((:output "/path/to/project/some/file.el")))
+               (compile (command) ((:input '("command %Foo") :output 'success :occur 2))))
+    (test-cockpit-dynamic-custom-test-command "command %%Foo")
+    (test-cockpit-repeat-test)))
+
+
+(ert-deftest test-custom-action-replace-relative-file ()
+  (tc--register-foo-project "foo")
+  (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))
+               (projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "/path/to/project/")))
+               (buffer-file-name () ((:output "/path/to/project/some/file.el")))
+               (compile (command) ((:input '("command some/file.el") :output 'success :occur 2))))
+    (test-cockpit-dynamic-custom-test-command "command %f")
+    (test-cockpit-repeat-test)))
+
+
 (ert-deftest test-main-suffix--all-nil ()
   (tc--register-foo-project "foo")
   (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))
@@ -426,6 +494,60 @@
                     ("c" "custom" test-cockpit-custom-test-command)]))))
 
 
+(ert-deftest test-main-suffix--one-custom-actions-added ()
+  (tc--register-foo-project "foo")
+  (test-cockpit-add-custom-action
+   'foo-project-type "C" "some custom action" "some_custom_action --foo")
+  (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))
+               (test-cockpit--current-module-string () ((:output nil)))
+               (test-cockpit--current-function-string () ((:output nil)))
+               (test-cockpit--last-module-string () ((:output nil)))
+               (test-cockpit--last-function-string () ((:output nil))))
+    (should (equal (test-cockpit--main-suffix)
+                   [["Run tests"
+                     ("p" "project" test-cockpit-test-project)
+                     ("c" "custom" test-cockpit-custom-test-command)]
+                    ["Custom actions"
+                     ("C" "some custom action" (lambda () (interactive) (test-cockpit--run-test "some_custom_action --foo")))]]))))
+
+
+(ert-deftest test-main-suffix--two-custom-actions-added ()
+  (tc--register-foo-project "foo")
+  (test-cockpit-add-custom-action
+   'foo-project-type "C" "some strange action" "some_strange_action --foo")
+  (test-cockpit-add-custom-action
+   'foo-project-type "O" "another custom action" #'some-action-function)
+  (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))
+               (test-cockpit--current-module-string () ((:output nil)))
+               (test-cockpit--current-function-string () ((:output nil)))
+               (test-cockpit--last-module-string () ((:output nil)))
+               (test-cockpit--last-function-string () ((:output nil))))
+    (should (equal (test-cockpit--main-suffix)
+                   [["Run tests"
+                     ("p" "project" test-cockpit-test-project)
+                     ("c" "custom" test-cockpit-custom-test-command)]
+                    ["Custom actions"
+                     ("C" "some strange action" (lambda () (interactive) (test-cockpit--run-test "some_strange_action --foo")))
+                     ("O" "another custom action" some-action-function)]]))))
+
+
+(ert-deftest test-main-suffix--dynamic-custom-actions-added ()
+  (tc--register-foo-project "foo")
+  (test-cockpit-add-dynamic-custom-action
+   'foo-project-type "C" "some custom action" "some_custom_action %f --foo")
+  (mocker-let ((projectile-project-type () ((:output 'foo-project-type)))
+               (test-cockpit--current-module-string () ((:output nil)))
+               (test-cockpit--current-function-string () ((:output nil)))
+               (test-cockpit--last-module-string () ((:output nil)))
+               (test-cockpit--last-function-string () ((:output nil))))
+    (should (equal (test-cockpit--main-suffix)
+                   [["Run tests"
+                     ("p" "project" test-cockpit-test-project)
+                     ("c" "custom" test-cockpit-custom-test-command)]
+                    ["Custom actions"
+                     ("C" "some custom action" (lambda () (interactive) (test-cockpit-dynamic-custom-test-command "some_custom_action %f --foo")))]]))))
+
+
 (ert-deftest test-main-suffix--current-module ()
   (tc--register-foo-project "foo")
   (mocker-let ((projectile-project-root (&optional _dir) ((:input-matcher (lambda (_) t) :output "foo-project")))
@@ -739,6 +861,7 @@
                 (should (equal default-directory "foo-project")))))
       (test-cockpit-custom-test-command))))
 
+
 (ert-deftest test-set-infix ()
   (tc--register-foo-project "foo")
   (mocker-let ((projectile-project-type () ((:output 'foo-project-type))))