From d8e1ad993721a187160f5fbc49a08309b701caa4 Mon Sep 17 00:00:00 2001 From: Al Haji-Ali Date: Tue, 24 Jan 2023 15:12:31 +0000 Subject: [PATCH 1/7] Provide an option to use Emacs advice system --- el-patch.el | 49 ++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 42 insertions(+), 7 deletions(-) diff --git a/el-patch.el b/el-patch.el index 9cff914..fcb458e 100644 --- a/el-patch.el +++ b/el-patch.el @@ -151,6 +151,11 @@ 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 + "Types for which el-patch should use Emacs' advice system for patching. +Typically should be \\='(`defun' `cl-defun')." + :type 'list) + ;;;; Internal variables (defvar el-patch-variant nil @@ -565,9 +570,31 @@ PATCH-DEFINITION is an unquoted list starting with `defun', ;; wrong). ,register-patch ;; Now we actually overwrite the current definition. - (el-patch--stealthy-eval - ,definition - "This function was patched by `el-patch'.")))))) + ,(if (and (member type el-patch-use-advice) + (eq + ;; Get original name + (cadr (el-patch--resolve-definition + (cl-subseq patch-definition 0 2) + nil)) + name)) + ;; Use advice system + (let ((advice-name (intern (format "%S@el-patch--advice" + name)))) + `(progn + (el-patch--stealthy-eval + ,(append + (list (car definition) ;; Same type + advice-name) ;; Different name + ;; Rest is the same + (cddr definition)) + ,(format + "This advice was defined by `el-patch' for `%S'." + name)) + (advice-add (quote ,name) + :override (quote ,advice-name)))) + `(el-patch--stealthy-eval + ,definition + "This function was patched by `el-patch'."))))))) ;;;;; Removing patches @@ -579,10 +606,18 @@ 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 (and (member (car patch-definition) el-patch-use-advice) + (eq (cadr (el-patch--resolve-definition + (cl-subseq patch-definition 0 2) + t)) + name)) + (advice-remove name + (intern (format "%S@el-patch--advice" name))) + (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 From 1354440b285c796fcef895c872202d16be79344e Mon Sep 17 00:00:00 2001 From: Al Haji-Ali Date: Sun, 5 Feb 2023 19:15:58 +0000 Subject: [PATCH 2/7] Use a boolean for advising and :classify to restrict to functions --- el-patch.el | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/el-patch.el b/el-patch.el index fcb458e..35b7841 100644 --- a/el-patch.el +++ b/el-patch.el @@ -152,8 +152,7 @@ loaded. You can toggle the `use-package' integration later using :type 'boolean) (defcustom el-patch-use-advice nil - "Types for which el-patch should use Emacs' advice system for patching. -Typically should be \\='(`defun' `cl-defun')." + "Non-nil causes el-patch to use Emacs' advice system for patching." :type 'list) ;;;; Internal variables @@ -570,13 +569,21 @@ PATCH-DEFINITION is an unquoted list starting with `defun', ;; wrong). ,register-patch ;; Now we actually overwrite the current definition. - ,(if (and (member type el-patch-use-advice) - (eq - ;; Get original name - (cadr (el-patch--resolve-definition - (cl-subseq patch-definition 0 2) - nil)) - name)) + ,(if (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 + (car (funcall classifier definition)) + 'function))) + (let ((orig-def (el-patch--resolve-definition + (cl-subseq patch-definition 0 3) + nil))) + ;; Same name and same argument count + (and (equal name (nth orig-def 1)) + (equal (length (nth definition 2)) + (length (nth orig-def 2)))))) ;; Use advice system (let ((advice-name (intern (format "%S@el-patch--advice" name)))) @@ -606,7 +613,7 @@ 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))) - (if (and (member (car patch-definition) el-patch-use-advice) + (if (and el-patch-use-advice (eq (cadr (el-patch--resolve-definition (cl-subseq patch-definition 0 2) t)) From 83ff6b4bdc4d5adae36399e83804cdfa40a7e14f Mon Sep 17 00:00:00 2001 From: Al Haji-Ali Date: Tue, 7 Feb 2023 21:21:28 +0000 Subject: [PATCH 3/7] Implemented advice's as variants --- el-patch.el | 137 +++++++++++++++++++++++++++++++--------------------- 1 file changed, 81 insertions(+), 56 deletions(-) diff --git a/el-patch.el b/el-patch.el index 35b7841..46c5de7 100644 --- a/el-patch.el +++ b/el-patch.el @@ -226,6 +226,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) + "Return advice name for a given NAME, TYPE and VARIANT." + (intern + (format "%S@%s@el-patch--advice" + name + (if variant (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 @@ -540,28 +547,50 @@ 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 + (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)) + 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))) `(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 @@ -569,24 +598,10 @@ PATCH-DEFINITION is an unquoted list starting with `defun', ;; wrong). ,register-patch ;; Now we actually overwrite the current definition. - ,(if (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 - (car (funcall classifier definition)) - 'function))) - (let ((orig-def (el-patch--resolve-definition - (cl-subseq patch-definition 0 3) - nil))) - ;; Same name and same argument count - (and (equal name (nth orig-def 1)) - (equal (length (nth definition 2)) - (length (nth orig-def 2)))))) + ,(if advise ;; Use advice system - (let ((advice-name (intern (format "%S@el-patch--advice" - name)))) + (let ((advice-name (el-patch--advice-name name + el-patch-variant))) `(progn (el-patch--stealthy-eval ,(append @@ -595,7 +610,9 @@ PATCH-DEFINITION is an unquoted list starting with `defun', ;; Rest is the same (cddr definition)) ,(format - "This advice was defined by `el-patch' for `%S'." + ;; 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)))) @@ -613,13 +630,11 @@ 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))) - (if (and el-patch-use-advice - (eq (cadr (el-patch--resolve-definition - (cl-subseq patch-definition 0 2) - t)) - name)) + (if (car variant) + ;; an advice, remove it (advice-remove name - (intern (format "%S@el-patch--advice" name))) + (el-patch--advice-name name (cdr variant))) + ;; Otherwise just re-evaluate original definition (eval `(el-patch--stealthy-eval ,(el-patch--resolve-definition @@ -975,9 +990,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)))))))) (cond ((zerop patch-count) (user-error "No patches defined")) @@ -1061,17 +1076,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) From e567f9bb8a8167c1ea0c3b93d80c6beb68f10e7c Mon Sep 17 00:00:00 2001 From: Abdul-Lateef Haji-Ali Date: Sun, 26 Feb 2023 18:19:21 +0000 Subject: [PATCH 4/7] Correct documentation Co-authored-by: Radon Rosborough --- el-patch.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/el-patch.el b/el-patch.el index 46c5de7..fad79ab 100644 --- a/el-patch.el +++ b/el-patch.el @@ -618,7 +618,7 @@ PATCH-DEFINITION is an unquoted list starting with `defun', :override (quote ,advice-name)))) `(el-patch--stealthy-eval ,definition - "This function was patched by `el-patch'."))))))) + "This definition was patched by `el-patch'."))))))) ;;;;; Removing patches From a713f62437a12df5b82790073ddd18a20c48f585 Mon Sep 17 00:00:00 2001 From: Abdul-Lateef Haji-Ali Date: Sun, 26 Feb 2023 18:20:22 +0000 Subject: [PATCH 5/7] Better documentation for el-patch-advice Co-authored-by: Radon Rosborough --- el-patch.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/el-patch.el b/el-patch.el index fad79ab..0c15dbe 100644 --- a/el-patch.el +++ b/el-patch.el @@ -152,7 +152,8 @@ loaded. You can toggle the `use-package' integration later using :type 'boolean) (defcustom el-patch-use-advice nil - "Non-nil causes el-patch to use Emacs' advice system for patching." + "Non-nil causes el-patch to use Emacs' advice system for patching. +This can be set globally or bound dynamically around a patch." :type 'list) ;;;; Internal variables From e482d5ae92b81c503d28b3b77bd7db6491786bc4 Mon Sep 17 00:00:00 2001 From: Al Haji-Ali Date: Sun, 26 Feb 2023 18:40:03 +0000 Subject: [PATCH 6/7] Improve documentation and issue warning on wrong type for el-patch-variant. --- el-patch.el | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/el-patch.el b/el-patch.el index 0c15dbe..6c7f819 100644 --- a/el-patch.el +++ b/el-patch.el @@ -152,9 +152,16 @@ loaded. You can toggle the `use-package' integration later using :type 'boolean) (defcustom el-patch-use-advice nil - "Non-nil causes el-patch to use Emacs' advice system for patching. -This can be set globally or bound dynamically around a patch." - :type 'list) + "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 @@ -227,12 +234,12 @@ 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) - "Return advice name for a given NAME, TYPE and VARIANT." +(defun el-patch--advice-name (name variant-name) + "Return advice name for a given NAME, TYPE and VARIANT-NAME." (intern (format "%S@%s@el-patch--advice" name - (if variant (format "%S" el-patch-variant) "")))) + (if variant-name (format "%S" el-patch-variant) "")))) (defun el-patch--resolve (form new &optional table) "Resolve a patch FORM. @@ -592,6 +599,10 @@ PATCH-DEFINITION is an unquoted list starting with `defun', (eval register-patch t) (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 From 0e6027d011c0047a7ce6c6491eb7120496b8b6a8 Mon Sep 17 00:00:00 2001 From: Al Haji-Ali Date: Sun, 26 Feb 2023 18:48:16 +0000 Subject: [PATCH 7/7] Add documentation to Readme --- README.md | 6 ++++++ el-patch.el | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 93efd2a..e5447f1 100644 --- a/README.md +++ b/README.md @@ -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 diff --git a/el-patch.el b/el-patch.el index 6c7f819..f10048c 100644 --- a/el-patch.el +++ b/el-patch.el @@ -235,7 +235,7 @@ This function lives halfway between `copy-sequence' and tree)) (defun el-patch--advice-name (name variant-name) - "Return advice name for a given NAME, TYPE and VARIANT-NAME." + "Return advice name for a given NAME and VARIANT-NAME." (intern (format "%S@%s@el-patch--advice" name