Shallowly override functions within a target function

Question

I'm exploring options for monkey-patching and I'm wondering if the following is within reason.

I would like to override a particular function within some target function so that calls within the target function are overridden, but functions called directly by the target function are unaffected. Whether the overridden function inherits the override isn't particularly important.

(require 'noflet)

(defun my-message (msg)
  (message (concat "**" msg "**")))

(defun unaffected-fn ()
  (my-message "Goodbye!"))

(defun target-fn ()
  (my-message "Hello!")
  (unaffected-fn))

(noflet ((my-message (msg) (message (concat "@@" msg "@@"))))
  (target-fn))

The output of this code is:

@@Hello!@@
@@Goodbye!@@

I would like to avoid unaffected-fn inheriting this local override. The output for the desired behavior would be:

@@Hello!@@
**Goodbye!**

Suggestions for clearer wording of this question are welcome.

Answer 1

Maybe you did not indicate the full problem you want to solve. But based only on your description, there are simpler ways to handle it. Two obvious ones come to mind (see below). You might want to specify your problem further, indicating why, for example, these obvious approaches might not be appropriate/sufficient.

Use an optional argument:

(defun my-message (msg &optional vanillap)
  (message (if vanillap msg (concat "**" msg "**"))))

(defun unaffected-fn ()
  (my-message "Goodbye!" t))

(defun target-fn ()
  (my-message "Hello!")
  (unaffected-fn))

Use a variable:

This is why Emacs Lisp has dynamic binding (in addition to lexical binding).

(defvar my-msg-wrap "**")

(defun my-message (msg)
  (message (concat my-msg-wrap msg my-msg-wrap)))

(defun unaffected-fn ()
  (let ((my-msg-wrap  ""))
    (my-message "Goodbye!")))

(defun target-fn ()
  (my-message "Hello!")
  (unaffected-fn))

Answer 2

I don't know how to deal with this problem in generality, but if you know the identity of unaffected-fn you can "poke holes" in your override like this:

(noflet
  ((my-message (msg) (message (concat "@@" msg "@@")))
   (unaffected-fn () (noflet ((my-message (msg) (message (concat "**" msg "**"))))
                       (funcall this-fn))))
  (target-fn))

If you don't want to explicitly repeat the definition of my-message here, you could do this instead for the same effect:

(let ((my-message-orig    (symbol-function 'my-message))
      (unaffected-fn-orig (symbol-function 'unaffected-fn)))
    (cl-letf
        (((symbol-function 'my-message)
          (lambda (msg) (message (concat "@@" msg "@@"))))

         ((symbol-function 'unaffected-fn)
          (lambda ()
            (cl-letf (((symbol-function 'my-message) my-message-orig))
              (funcall unaffected-fn-orig)))))
      (target-fn)))

Unfortunately, if you don't know exactly which functions are going to call my-message, you might have to use something like this answer to actually inspect the call stack.