Modifying the behavior of suffix commands with subclasses

[aurtzy]

Hello!

I've been playing around with alternative implementations of a feature for my project that involves modifying the transient-suffix command slot, but I appear to have hit a blocker with figuring out how to actually replace it. I'm wondering now if there is a better path to what I'm trying to do, or maybe if this should be a feature request instead.

Background

The intention in this case is to essentially be able to add advice or wrap the command such that behaviors may be changed depending on the suffix class used. For example, I'd like to define a class that - when used - always has the command run in a designated default-directory, or manages the compilation buffer associated with the command.

In addition to some code deduplication, this would be useful for per-project suffixes. I have an existing implementation that implements management of variables like the ones mentioned, but it relies on a bespoke syntax that expands into something that transient-parse-suffixes can read, and necessarily restricts the user to what I've implemented in the syntax (not to mention the overhead of users having to learn an extra DSL). Preferably, this could be done with just Transient syntax.

Problem with attempted solutions

Here's a (buggy) proof of concept for what I'm trying to accomplish, simplified from what I've implemented in my suffix-classes branch (here; specific commit that adds the classes here):

;;; -*- lexical-binding: t; -*-

(require 'eieio)
(require 'transient)

(defclass test-suffix (transient-suffix) ())

(cl-defmethod initialize-instance :before ((obj test-suffix) &optional slots)
  "Do additional initialization for OBJ before everything else.

Wrap the command in SLOTS with wrappers from `test-suffix-wrappers'."
  ;; We should avoid adding advice directly to the initial command, since the
  ;; command values may reference commands used in other cases where advice
  ;; shouldn't be run.
  (let* ((sym (plist-get slots :command))
         (old-command (symbol-function sym))
         (new-command (seq-reduce (lambda (command wrapper)
                                    (lambda (&rest _r) (interactive)
                                      (funcall wrapper command)))
                                  (test-suffix-wrappers obj)
                                  old-command)))
    ;; This may produce incorrect results.  If a new prefix is defined that uses
    ;; this suffix with another class, for example, this can affect the suffix's
    ;; behavior in other prefixes.
    (advice-remove sym 'test-suffix)
    (advice-add sym :override new-command '((name . test-suffix)))))


;; (The following commented method is for the next demonstration.)

;; (cl-defmethod initialize-instance :before ((obj test-suffix) &optional slots)
;;   "Do additional initialization for OBJ before everything else.

;; Wrap the command in SLOTS with wrappers from `test-suffix-wrappers'."
;;   ;; We should avoid adding advice directly to the initial command, since the
;;   ;; command values may reference commands used in other cases where advice
;;   ;; shouldn't be run.
;;   (let* ((old-sym (plist-get slots :command))
;;          (new-sym (intern
;;                    (format "test:%s:%d"
;;                            (eieio-object-class-name obj)
;;                            (prog1 gensym-counter (cl-incf gensym-counter)))))
;;          (old-command (symbol-function old-sym))
;;          (new-command (seq-reduce (lambda (command wrapper)
;;                                     (lambda (&rest _r) (interactive)
;;                                       (funcall wrapper command)))
;;                                   (test-suffix-wrappers obj)
;;                                   old-command)))
;;     ;; Remove the old advice from the previous snippet so we don't need to
;;     ;; restart Emacs for this demonstration.
;;     (advice-remove old-sym 'test-suffix)
;;     (plist-put slots :command (defalias new-sym new-command))))

(cl-defmethod test-suffix-wrappers ((_obj test-suffix))
  "Return a list of functions to wrap the initial suffix command.

The functions should take as argument a 0-arity interactive
command to wrap, calling interactively where appropriate.  The
first function in the list will be the innermost wrapper."
  (list (lambda (command)
          ;; For demonstration purposes, set `default-directory' to system root
          ;; directory.
          (let ((default-directory "/"))
            (call-interactively command)))))

(transient-define-suffix test-message ()
  :class test-suffix
  (interactive)
  (message "Running from: %s" default-directory))

(transient-define-prefix test-prefix ()
  ["Commands"
   ("d" "Send message from defined suffix" test-message)
   ;; Below works, but applies to /all/ `find-file' invocations.
   ;; ("f" "Find file" find-file :class test-suffix)
   ]
  ["Other commands"
   :class transient-column
   :setup-children
   (lambda (&rest _r)
     (transient-parse-suffixes
      'test-prefix
      ;; This value can come from another source, like dir-locals of a project.
      '(("s" "Send message from a \"per-project\" suffix"
         (lambda () (interactive)
           (message "Hi!  Running from: %s" default-directory))
         :class test-suffix))))])

This mostly works, but as noted in one of the comments, one of its problems is that the advice will affect unrelated calls as well if a command like find-file is inserted.

I had some other iterations where I tried replacing the value of the command slot with another function, but for some reason unclear to me the new command would not be not used. If we replace initialize-instance with the commented version and re-evaluate, for instance, none of the suffix commands are run in the expected directory when called from the prefix or with a direct call to test-message. Completing a test:* command via eval-expression, however, gives the expected correct result.

[tarsius]

Answering that will require that I do some experimentation and since I am focused on wrapping things up, you'll have to wait for that until next year.

Merry Christmas and Happy New year 🎆

[tarsius]

FWIW, my initial reaction was "Transient is all about flexibility, but this might be taking it too far".

[aurtzy]

Revisiting this, I've made some progress since last, and have come up with a working implementation that doesn't require changes in Transient.

The alternative solution mentioned before is also expanded on at the end (which avoids using advice), but I think there is some kind of bug causing it to not fully work.

Here's what the current solution looks like, with an additional subclass example to better illustrate usage:

;;; -*- lexical-binding: t; -*-

(require 'cl-macs)
(require 'eieio)
(require 'transient)

(defclass test-suffix (transient-suffix) ())

(defun test-wrapped-function (func)
  "Wrap FUNC with wrapper functions from `test-suffix-wrappers'.

The wrappers that are used depend on the current suffix's (as
returned by `transient-suffix-object') class, since
`test-suffix-wrappers' may be extended by subclasses.  If a
current suffix is available and its class is a subclass of
`test-suffix', the wrappers from its class will be used;
otherwise, this function returns FUNC as-is."
  (if-let* ((suffix (transient-suffix-object))
            ( (cl-typep suffix test-suffix)))
      (seq-reduce (lambda (oldfun wrapper)
                    (lambda (&rest r) (apply wrapper oldfun r)))
                  (test-suffix-wrappers suffix)
                  func)
    func))

(defun test-suffix-command-advice (func &rest r)
  "Advise FUNC with `test-suffix' wrappers when available.

See `test-wrapped-function'.

FUNC and R are as defined in the `advice-add' :around format."
  (interactive
   (lambda (spec)
     (funcall (test-wrapped-function
               (lambda ()
                 (advice-eval-interactive-spec spec))))))
  (apply (test-wrapped-function func) r))

(cl-defmethod initialize-instance :after ((obj test-suffix) &optional _slots)
  "Do additional initialization for OBJ.

Add advice to the suffix object's command."
  (let* ((sym (oref obj command)))
    (advice-add sym :around #'test-suffix-command-advice)))

(cl-defmethod test-suffix-wrappers ((_obj test-suffix))
  "Return a list of functions to wrap the suffix command.

Each function should follow the :around `advice-add' format,
expecting to be called like so:
  (lambda (&rest r) (apply WRAPPER OLDFUN r))

The first function in the list will be the innermost wrapper."
  (list (lambda (func &rest r)
          ;; For demonstration purposes, set `default-directory' to system root
          ;; directory.
          (let ((default-directory "/"))
            (apply func r)))))

(defclass test-suffix-window (test-suffix) ())

(cl-defmethod test-suffix-wrappers ((_obj test-suffix-window))
  "Return a list of functions to wrap the suffix command."
  (cons (lambda (func &rest r)
          (let ((display-buffer-overriding-action
                 '(display-buffer-use-some-window (inhibit-same-window t))))
            (apply func r)))
        (cl-call-next-method)))

(transient-define-suffix test-message ()
  :class test-suffix
  (interactive)
  (message "Running from: %s" default-directory))

(transient-define-prefix test-prefix ()
  ["Commands"
   ("d" "Send message from defined suffix" test-message :class test-suffix)
   ("f" "Find file" find-file :class test-suffix)
   ("F" "Find file (other window)" find-file :class test-suffix-window)]
  ["Other commands"
   :class transient-column
   :setup-children
   (lambda (&rest _r)
     (transient-parse-suffixes
      'test-prefix
      ;; This value can come from another source, like dir-locals of a project.
      '(("s" "Send message from a \"per-project\" suffix"
         (lambda () (interactive)
           (message "Hi!  Running from: %s" default-directory))
         :class test-suffix))))])

This makes use of advice that selectively wraps commands depending on the return value of transient-suffix-object.

---

The other lead with modifying the command slot value itself seems preferable, but digging deeper revealed that the command fails to be "updated" specifically when a suffix is defined with its command-modifying class in transient-define-suffix.

Here's a demonstration of the issue:

;;; -*- lexical-binding: t; -*-

(require 'eieio)
(require 'transient)

(defclass test2-suffix (transient-suffix) ())

(cl-defmethod initialize-instance :after ((obj test2-suffix) &optional _slots)
  ;; All commands using this class should not be able to be called in the menu.
  (oset obj command nil))

(transient-define-suffix test2-message ()
  :class test2-suffix
  (interactive)
  (message "Running from: %s" default-directory))

(transient-define-prefix test2-prefix ()
  ["Commands"
   ("a" "Message from defined suffix" test2-message)
   ("b" "Find file with `test2-suffix' class" find-file :class test2-suffix)]
  ["Other commands"
   :class transient-column
   :setup-children
   (lambda (&rest _r)
     (transient-parse-suffixes
      'test2-prefix
      ;; This value can come from another source, like dir-locals of a project.
      '(("c" "Send message from an ad-hoc suffix"
         (lambda () (interactive)
           (message "Hi!  Running from: %s" default-directory))
         :class test2-suffix))))])

Evaluating this and executing test2-prefix shows that the suffix defined with transient-define-suffix does not respect the changed command slot value, while the other commands do.

[tarsius]

I think it help to reformulate the essence of the feature, without overloading that by also describing a possible implementation strategy:

Allow advising individual suffix bindings.

Once I understood that this is what you want, it became much easier to reason about it. We can break down the problem into two distinct tasks.

1. How to specify the advice.
2. How to activate the advice.

You chose to tie the advice to a class. That is unnecessary and pretty much the opposite of what we need. Classes allow specifying common behavior for a new set of commands, but we want to attach different behavior to individual ¹ existing commands, individual command bindings even! Using classes works, as you have demonstrated, but only for commands that do not already have a class. If you take a command that was defined using transient-define-suffix and transplant a new type, then that will break.

All we need instead is a new suffix slot. To allow any command (including those that have a type assigned to them), that slot has to be added in transient-suffix itself.

As for how to activate the advice; while a transient is active, we already advice this-command, to control the transient-ness of the suffix. We can extend the function that does that to also add this additional arbitrary advice.

This requires few changes in transient.el: 386a853.

Using it in a prefix definition is very easy and takes very little code:

(defun demo-default-directory (arg)
  (interactive (list default-directory))
  (message "arg: %s -- value: %s" arg default-directory))

(defun demo-in-/tmp (fn &rest args)
  (let ((default-directory "/tmp/"))
    (apply fn args)))

(transient-define-prefix demo ()
  :transient-suffix t
  [("h" "here"           demo-default-directory)
   ("m" "in /tmp"        demo-default-directory :advice  demo-in-/tmp)
   ("b" "in /tmp (both)" demo-default-directory :advice* demo-in-/tmp)])

Note that I added two slots; one is used for the body only, the other for the interactive form as well.

I don't think this should support using multiple advises. If you need multiple things, then define an advice that does multiple things. If you want to compose multiple advises, using seq-compose or what not, then you can do that, you just have to do it yourself, beforehand.

Here is a modified example, that demonstrates that this just works with :setup-children as well, and that let-binding default-directory around read-file-name is not good enough. But these things don't really have anything to do with "advising a suffix" per se; the former is just done to demonstrate a non-issue and the latter addresses the issue of one particular task an advise might want to perform.

(defun demo-default-directory (arg)
  (interactive (list (read-file-name ": ")))
  (message "arg: %s -- value: %s" arg default-directory))

(defun demo-in-/tmp (fn &rest args)
  (let ((default-directory "/tmp/")
        ;; This affects the value returned by `read-file-name-default'
        ;; if the user exits with the initial minibuf contents intact.
        ;; In other cases binding this variable as well would be wrong.
        ;; There is no silver bullet.
        (buffer-file-name "/tmp"))
    (apply fn args)))

(transient-define-prefix demo ()
  [("h" "here"           demo-default-directory)
   ("m" "in /tmp"        demo-default-directory :advice  demo-in-/tmp)
   ("b" "in /tmp (both)" demo-default-directory :advice* demo-in-/tmp)]
  [:class transient-column
   :setup-children
   (lambda (&rest _)
     (transient-parse-suffixes
      'test2-prefix
      '(("a" "\"anonymous\""
         (lambda (arg)
           (interactive (list default-directory))
           (message "arg: %s -- value: %s -- cmd: %s"
                    arg default-directory this-command))
         :advice* demo-in-/tmp))))])

I will probably add the new slots to Transient, but want to let it simmer a bit before pushing to main.

(I actually did something similar recently in 05c011b (documentation added in fe5fd39), so I recognize the need to allow this sort of thing, but it's advanced, "complicated" behavior, so I want to be a bit careful. Most menu authors won't need it and there is a risk of overwhelming them with even more functionality.

Footnotes

1. Sure it may be a group of several individuals, but we want to assign to them new behavior individually ², and specifically not to every binding for a given command. ↩

2. Actually, a possible improvement would be to allow specifying the advice to be used for all suffixes in a particular group (i.e., a transient-group instance), by also adding the advice and advice* slots to transient-group as well, and having bound suffix inherit those, if they don't define their own. ↩

[aurtzy]

Thanks a bunch!

My suffix-classes branch has been updated to use the current implementation in advice. I plan to iterate on it further, but it seems to work well with some brief testing. Branch here; suffix classes added in commit here; refactored to use classes in commits notably here and here.

I originally imagined it would be useful to have advice also apply to standalone suffixes when not executed from a transient (e.g. to always add a process sentinel to a buffer associated with suffix object after command execution), but I'm now thinking that is probably abusing the feature for unintended purposes. I've satisfied those use cases that would have needed it with alternative means.

Group-wide inheriting was a feature I had considered making a request for as well, although I wonder if it would be feasible to inherit classes and their slots/methods…

[tarsius]

Unfortunately I have to deal with emergencies and once more won't have the time to give you quick feedback.

[tarsius]

I've added support for adding the advice at the group level.

This is still considered experimental, but I've now merged it.

(Still haven't looked at your code in detail.)