Skip to content

Commit

Permalink
Implemented advice's as variants
Browse files Browse the repository at this point in the history
  • Loading branch information
@haji-ali
haji-ali committed Feb 7, 2023
1 parent 9c795d8 commit 352045e
Show file tree
Hide file tree
Showing 2 changed files with 82 additions and 57 deletions.
2 changes: 1 addition & 1 deletion el-patch-template.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -373,7 +373,7 @@ remaining unmatched forms."
(cons match template)
template)
remainder-form)
('no-match
(no-match
;; Ultimately, the matching did not
;; work, so undo the symbol resolution
(puthash template old-entry table)
Expand Down
137 changes: 81 additions & 56 deletions el-patch.el
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -540,53 +547,61 @@ 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
;; can undo the patch (as long as it is not too terribly
;; 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
Expand All @@ -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))))
Expand All @@ -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
Expand Down Expand Up @@ -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"))
Expand Down Expand Up @@ -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)
Expand Down

0 comments on commit 352045e

Please sign in to comment.