Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Provide an option to use Emacs advice system #63

Merged
merged 7 commits into from
Feb 26, 2023
Merged

Provide an option to use Emacs advice system #63

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
d8e1ad9
Provide an option to use Emacs advice system
haji-ali Jan 24, 2023
1354440
Use a boolean for advising and :classify to restrict to functions
haji-ali Feb 5, 2023
83ff6b4
Implemented advice's as variants
haji-ali Feb 7, 2023
e567f9b
Correct documentation
haji-ali Feb 26, 2023
a713f62
Better documentation for el-patch-advice
haji-ali Feb 26, 2023
e482d5a
Improve documentation and issue warning on wrong type for el-patch-va…
haji-ali Feb 26, 2023
0e6027d
Add documentation to Readme
haji-ali Feb 26, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -627,6 +627,12 @@ that takes effect, but `el-patch` retains a record of both patches,
meaning they can be inspected and validated individually. See
[#29](https://github.com/radian-software/el-patch/issues/29).

You may also define patches of functions as `:override` advices
instead of overriding the original definition. This is done by setting
`el-patch-use-advice` to a non-nil value (either dynamically around a
patch or globally). The patched function must have the same name and
number of arguments as the original function.

## Usage with byte-compiled init-file

`el-patch` does not need to be loaded at runtime just to define
Expand Down
157 changes: 118 additions & 39 deletions el-patch.el
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -151,6 +151,18 @@ loaded. You can toggle the `use-package' integration later using
"Non-nil means to validate patches when byte-compiling."
:type 'boolean)

(defcustom el-patch-use-advice nil
"Non-nil causes el-patch to use Emacs' advice system for patching functions.
This can be set globally or bound dynamically around a patch.

An advice is used if the patched function has the same name and
the same number of arguments as the original.

An advice takes precedence over subsequent non-advice patches.
You may need to un-advice or un-patch a function to apply a new
patch."
:type 'boolean)

;;;; Internal variables

(defvar el-patch-variant nil
Expand Down Expand Up @@ -222,6 +234,13 @@ This function lives halfway between `copy-sequence' and
(cons (car tree) (el-patch--copy-semitree (cdr tree)))
tree))

(defun el-patch--advice-name (name variant-name)
"Return advice name for a given NAME and VARIANT-NAME."
(intern
(format "%S@%s@el-patch--advice"
name
(if variant-name (format "%S" el-patch-variant) ""))))

(defun el-patch--resolve (form new &optional table)
"Resolve a patch FORM.
Return a list of forms to be spliced into the surrounding
Expand Down Expand Up @@ -536,38 +555,82 @@ PATCH-DEFINITION is an unquoted list starting with `defun',
(let ((definition (el-patch--resolve-definition patch-definition t)))
;; Then we parse out the definition type and symbol name.
(cl-destructuring-bind (type name . body) definition
(let ((register-patch
`(let ((table (or (bound-and-true-p el-patch--patches)
(make-hash-table :test #'eq))))
(setq el-patch--patches table)
(setq table
(puthash ',name
(gethash
',name table
(make-hash-table :test #'eq))
table))
(setq table
(puthash ',type
(gethash
',type table
(make-hash-table :test #'eq))
table))
(puthash el-patch-variant ',patch-definition table))))
(let* ((advise (and el-patch-use-advice
;; Only advice functions
(let* ((props (alist-get type
el-patch-deftype-alist))
(classifier (plist-get props :classify)))
(and classifier
(equal
(caar (funcall classifier definition))
'function)))
;; Patches must have the same name and
;; same number of arguments
Comment on lines +567 to +568
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

One issue is that there's no way to tell the use that this patch was not made into an advice despite having non-nil el-patch-use-advice. I thought about showing a warning, but we would need a way to silence those warnings in init-files.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think it's okay to have it be silent at least for now. We can add a way to communicate the information later, if people report confusion.

(let ((orig-def (el-patch--resolve-definition
(cl-subseq patch-definition 0 3)
nil)))
;; Same name and same argument count
(and (equal name (nth 1 orig-def))
(equal (length (nth 2 definition))
(length (nth 2 orig-def)))))
'advice))
(register-patch
`(let ((table (or (bound-and-true-p el-patch--patches)
(make-hash-table :test #'eq))))
(setq el-patch--patches table)
(setq table
(puthash ',name
(gethash
',name table
(make-hash-table :test #'eq))
table))
(setq table
(puthash ',type
(gethash
',type table
(make-hash-table :test #'equal))
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I had to change the test function for the variant hashtable. Nevertheless, we should check that el-patch-variant is not a cons or a string.

table))
(puthash (cons ,(when advise `(quote ,advise))
el-patch-variant)
',patch-definition table))))
;; If we need to validate the patch, then we also need to
;; register it at compile-time, not just at runtime.
(when (and el-patch-validate-during-compile byte-compile-current-file)
(eval register-patch t)
(el-patch-validate name type 'nomsg nil el-patch-variant))
(el-patch-validate name type 'nomsg nil
(cons advise el-patch-variant)))
;; Check that `el-patch-variant' is not a cons or a string
(when (or (consp el-patch-variant)
(stringp el-patch-variant))
(error "`el-patch-variant' cannot be a string or a cons"))
`(progn
;; Register the patch in our hash. We want to do this right
;; away so that if there is an error then at least the user
;; can undo the patch (as long as it is not too terribly
;; wrong).
,register-patch
;; Now we actually overwrite the current definition.
(el-patch--stealthy-eval
,definition
"This function was patched by `el-patch'."))))))
,(if advise
;; Use advice system
(let ((advice-name (el-patch--advice-name name
el-patch-variant)))
`(progn
(el-patch--stealthy-eval
,(append
(list (car definition) ;; Same type
advice-name) ;; Different name
;; Rest is the same
(cddr definition))
,(format
;; The new line before the name is to avoid
;; long doc strings
"This advice was defined by `el-patch' for\n`%S'."
name))
(advice-add (quote ,name)
:override (quote ,advice-name))))
`(el-patch--stealthy-eval
,definition
"This definition was patched by `el-patch'.")))))))

;;;;; Removing patches

Expand All @@ -579,10 +642,16 @@ patched. NAME, TYPE, and VARIANT are as returned by
`el-patch-get'."
(interactive (el-patch--select-patch))
(if-let ((patch-definition (el-patch-get name type variant)))
(eval `(el-patch--stealthy-eval
,(el-patch--resolve-definition
patch-definition nil)
"This function was patched and then unpatched by `el-patch'."))
(if (car variant)
;; an advice, remove it
(advice-remove name
(el-patch--advice-name name (cdr variant)))
Comment on lines +647 to +648
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note that an advice takes precedence regardless, even if a patch was applied after it. It must be manually removed or un-patched.

;; Otherwise just re-evaluate original definition
(eval
`(el-patch--stealthy-eval
,(el-patch--resolve-definition
patch-definition nil)
"This function was patched and then unpatched by `el-patch'.")))
(error "There is no patch for %S %S" type name)))

;;;; Defining patch types
Expand Down Expand Up @@ -933,9 +1002,9 @@ See `el-patch-validate'."
(let ((type-hash (gethash type patch-hash)))
(dolist (variant (hash-table-keys type-hash))
(setq patch-count (1+ patch-count))
(let ((el-patch-variant variant))
(unless (el-patch-validate name type 'nomsg)
(setq warning-count (1+ warning-count)))))))))
(unless (el-patch-validate name type 'nomsg nil
variant)
(setq warning-count (1+ warning-count))))))))
Comment on lines -936 to +1007
Copy link
Contributor Author

@haji-ali haji-ali Feb 7, 2023 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I might be mistaken, but I think this was a bug. Setting el-patch-variant does not change the behavior of el-patch-validate. Instead the variant should be passed as an argument.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oops. Thanks for fixing that.

(cond
((zerop patch-count)
(user-error "No patches defined"))
Expand Down Expand Up @@ -1019,17 +1088,27 @@ nil; see `el-patch-variant')."
nil
'require-match)))))
(type-hash (gethash type patch-hash))
(options (mapcar #'symbol-name
(hash-table-keys type-hash)))
(variant (intern
(pcase (length options)
(0 (error "Internal `el-patch' error"))
(1 (car options))
(_ (completing-read
"Which variant? "
options
nil
'require-match))))))
(options (hash-table-keys type-hash))
(variant (pcase (length options)
(0 (error "Internal `el-patch' error"))
(1 (car options))
(_ (let ((completing-options
(mapcar (lambda (x)
(cons (format "%s%S"
(or (and (car x)
"Advice: ")
"")
(cdr x))
x))
(hash-table-keys type-hash))))
(alist-get
(completing-read
"Which variant? "
completing-options
nil
'require-match)
completing-options
nil nil 'equal))))))
(list name type variant)))

(defun el-patch--ediff-forms (name1 form1 name2 form2)
Expand Down