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".