Skip to content

Instantly share code, notes, and snippets.

@jaidetree
Last active August 8, 2021 06:46
Show Gist options
  • Save jaidetree/ffc23d04880d3cf7566cb9a109efe7de to your computer and use it in GitHub Desktop.
Save jaidetree/ffc23d04880d3cf7566cb9a109efe7de to your computer and use it in GitHub Desktop.

Emacs Advice Test

Implementing an advising system for fennel-lang for use in the OS X Spacehammer configuration framework.

Original function definition

(defun some-fun (&rest args)
  (message "original some-fun called %s" (string-join args " "))
  (string-join (cons "original" args) " "))

Advice

Before 3

(defadvice! advtest-before-3 (&rest args)
  "Before test 3"
  :before #'some-fun
  (message "before-3 args: %s" (string-join args " ")))

Before 1

(defadvice! advtest-before-1 (&rest args)
  "Before test 1"
  :before #'some-fun
  (message "before-1 args: %s" (string-join args " ")))

Before-While 1

(defadvice! advtest-before-while-1 (&rest args)
  "Before-while test 1"
  :before-while #'some-fun
  (message "before-while-1 args: %s" (string-join args " "))
  t)

After 1

(defadvice! advtest-after-1 (&rest args)
  "After test 1"
  :after #'some-fun
  (message "after-1 args: %s" (string-join args " ")))

Override

(defadvice! advtest-override-1 (&rest args)
  "Override test 1"
  :override #'some-fun
  (message "override-1 args: %s" (string-join args " ")))

Around

(defadvice! advtest-around-1 (orig &rest args)
  "Around test 1"
  :around #'some-fun
  (message "around-1 args: %s" (string-join args " "))
  (pp orig)
  (apply orig args)
  )

Before 2

(defadvice! advtest-before-2 (&rest args)
  "Before test 2"
  :before #'some-fun
  (message "before-2 args: %s" (string-join args " ")))

Test Advice

(some-fun "one" "two")

Debugging & Reset

(describe-function #'some-fun)
(defun advice-unadvice (sym)
  "Remove all advices from symbol SYM."
  (interactive "aFunction symbol: ")
  (advice-mapc (lambda (advice _props) (advice-remove sym advice)) sym))
(advice-unadvice #'some-fun)

Results

  1. Advice is additive, supports multiple of same type
  2. Advice fires last-added-runs-first
  3. Types of advice processed at specific times: before and before-while are processed together before calling the original function
  4. In the case of before-while, the before and after advice that added after the before-while advice did run. The before advice added earlier will not run if before-while returns nil.

    a. Does this mean that if before-while returns false it short-circuits the remaining advice defined before it, which would run after before-while?

  5. Seems like before advice is prepended to the stack where as after advice is appended
  6. How does it handle override and around?

    a. Around advice is also prepended to the stack similar to a before type

    b. Around will receive not so much the original function but the previous in the stack

    c. I wonder if it’s done like a typical compose middleware solution? Where each middleware receives the next one and can operate either before calling the next one or after similar to Clojure Ring Middleware

Around Example with printing of orig function

Around is receiving a composition of all the middleware in the order they were added. This suggests it’s not prepending befores and appending afters, but composing them like Clojure Ring Middleware.

before-2 args: one two
around-1 args: one two
[128 "\300\301^B\"\207"
      [apply advtest-override-1
             [128 "\300\302^B\"\300\301^C\"\210\207"
                   [apply advtest-after-1
                          [128 "\300\301^B\"\205^K^@\300\302^B\"\207"
                                [apply advtest-before-while-1
                                       [128 "\300\301^B\"\210\300\302^B\"\207"
                                             [apply advtest-before-1
                                                    [128 "\300\301^B\"\210\300\302^B\"\207"
                                                          [apply advtest-before-3
                                                                 (lambda
                                                                   (&rest args)
                                                                   (message "original some-fun called %s"
                                                                            (string-join args " "))
                                                                   (string-join
                                                                    (cons "original" args)
                                                                    " "))
                                                                 nil]
                                                          4 nil]
                                                    nil]
                                             4 nil]
                                       nil]
                                4 nil]
                          nil]
                   5 nil]
             nil]
      4 nil]

Override Example

Override is also prepended to the stack similar to before but will drop any advice added before it was added.

before-2 args: one two
around-1 args: one two
override-1 args: one two
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment