C-h f 能显示函数的 Advice,如
...
(shell-command COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER)
:around advice: `shell-command--shell-command-with-editor-mode'
:after advice: `shell-command@exchange-point-and-mark'
...
在旁边加个删除该 Advice 的按钮 Remove
,点击它就能 advice-remove
,省去写 Elisp
(shell-command COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER)
:around advice: `shell-command--shell-command-with-editor-mode' » Remove
:after advice: `shell-command@exchange-point-and-mark' » Remove
实现:
(defun chunyang-advice-remove-button (function)
"Add a button to remove advice."
(when (get-buffer "*Help*")
(with-current-buffer "*Help*"
(save-excursion
(goto-char (point-min))
;; :around advice: ‘shell-command--shell-command-with-editor-mode’
(while (re-search-forward "^:[-a-z]+ advice: [‘'`]\\(.+\\)[’'']$" nil t)
(let ((advice (intern-soft (match-string 1))))
(when (and advice (fboundp advice))
(let ((inhibit-read-only t))
(insert " » ")
(insert-text-button
"Remove"
'action
;; In case lexical-binding is off
`(lambda (_)
(message "Removing %s of advice from %s" ',function ',advice)
(advice-remove ',function #',advice)
(revert-buffer nil t))
'follow-link t)))))))))
(advice-add 'describe-function-1 :after #'chunyang-advice-remove-button)
7 个赞
加入 Emacs 估计可能性不大,一个不足是不支持没有名字的函数(即 lambda
)。提议 helpful.el
加入这个功能应该比较现实。
那么advice advice-add
等函数,把remove函数存在symbol property里面如何?
我做了一点修改,使 lambda 也可以删除:
(defun advice-functions (symbol)
"Return SYMBOL's advice functions."
(let ((function-def (advice--symbol-function symbol))
(ad-functions '()))
(while (advice--p function-def)
(setq ad-functions (append `(,(advice--car function-def)) ad-functions))
(setq function-def (advice--cdr function-def)))
ad-functions))
(define-advice describe-function-1 (:after (function) advice-remove-button)
"Add a button to remove advice."
(when (get-buffer "*Help*")
(with-current-buffer "*Help*"
(save-excursion
(goto-char (point-min))
(let ((ad-index 0)
(ad-functions (reverse (advice-functions function))))
(while (re-search-forward "^:[-a-z]+ advice: \\(.+\\)$" nil t)
(let* ((name (string-trim (match-string 1) "'" "'"))
(advice (or (intern-soft name) (nth ad-index ad-functions))))
(when (and advice (functionp advice))
(let ((inhibit-read-only t))
(insert " » ")
(insert-text-button
"Remove"
'action
;; In case lexical-binding is off
`(lambda (_)
(message "Removing %s of advice from %s" ',function ',advice)
(advice-remove ',function ',advice)
(revert-buffer nil t))
'follow-link t))))
(setq ad-index (1+ ad-index))))))))
但是由于 lambda 没有任何信息,如果存在多个,可能会删错。这要怪 advice--make-docstring
偷懒了,如果它把 lambda 代码附上去(并折叠成一行,不占太多空间),删除起来心里就有底了。
另一个比较可靠的做法是,把 advice 函数列出来,输出到 helm / avy,通过列表选单来删除:
+-----------------------+ +--------------------+
| Advice functions | | Actions |
M-x +-----------------------+ +--------------------+
helm-list-ad-functions --> | foo@before | --> TAP --> | [f1] Delete advice | --> ENTER
| foo@after | | |
| (closure (t) nil ...) | | |
| ... | | |
+-----------------------+ +--------------------+
删除按钮其实最好是在 advice--make-docstring
内部添加,但是找不到合适的地方加 advice 修改它,除非 :override 重写覆盖。
1 个赞
现在不会删错了:
- GUI 下用 help-echo 显示 lambda 定义
- 终端下使用 cursor-sensor-functions (25+,相当于早期的版本的 point-entered)
(add-hook 'help-mode-hook 'cursor-sensor-mode)
(defun function-advices (function)
"Return FUNCTION's advices."
(let ((function-def (advice--symbol-function function))
(ad-functions '()))
(while (advice--p function-def)
(setq ad-functions (append `(,(advice--car function-def)) ad-functions))
(setq function-def (advice--cdr function-def)))
ad-functions))
(define-advice describe-function-1 (:after (function) advice-remove-button)
"Add a button to remove advice."
(when (get-buffer "*Help*")
(with-current-buffer "*Help*"
(save-excursion
(goto-char (point-min))
(let ((ad-index 0)
(ad-list (reverse (function-advices function))))
(while (re-search-forward "^:[-a-z]+ advice: \\(.+\\)$" nil t)
(let* ((name (string-trim (match-string 1) "'" "'"))
(advice (or (intern-soft name) (nth ad-index ad-list))))
(when (and advice (functionp advice))
(let ((inhibit-read-only t))
(insert " » ")
(insert-text-button
"Remove"
'cursor-sensor-functions `((lambda (&rest _) (message "%s" ',advice)))
'help-echo (format "%s" advice)
'action
;; In case lexical-binding is off
`(lambda (_)
(when (yes-or-no-p (format "Remove %s ? " ',advice))
(message "Removing %s of advice from %s" ',function ',advice)
(advice-remove ',function ',advice)
(revert-buffer nil t)))
'follow-link t))))
(setq ad-index (1+ ad-index))))))))
UPDATE:
- 增加删除确认
symbol-functions
该名为 function-advices
3 个赞
添加了 helm-advice-remove
函数。
用法跟 describe-function
差不多。先选函数,再选择 advice 进行删除,lamba 也一目了然。对键盘用户比较友好,不必再在 *help*
缓冲里移动光标到 remove
按钮上。缺点就是又多了一个函数(或快捷键)需要记住。
(defun helm-advice-remove (function)
"Remove advice from FUNCTION."
(interactive (let* ((fn (function-called-at-point))
(enable-recursive-minibuffers t)
(val (completing-read
(if fn
(format "Function (default %s): " fn)
"Function: ")
#'help--symbol-completion-table
(lambda (f) (or (fboundp f) (get f 'function-documentation)))
t nil nil
(and fn (symbol-name fn)))))
(unless (equal val "")
(setq fn (intern val)))
(unless (and fn (symbolp fn))
(user-error "You didn't specify a function symbol"))
(unless (or (fboundp fn) (get fn 'function-documentation))
(user-error "Symbol's function definition is void: %s" fn))
(list fn)))
(let* ((ad-alist (mapcar (lambda (ad) (cons (format "%S" ad) ad)) (function-advices function)))
(default-candidates (mapcar (lambda (ad) (car ad)) ad-alist)))
(helm :sources
(helm-build-sync-source "Advices"
:candidates default-candidates
:action
`(("Remove" . (lambda (_)
(let ((items (helm-marked-candidates)))
(when (yes-or-no-p (format "Remove %s ? " (if (cdr items) items (car items))))
(mapc (lambda (item)
(let ((ad (alist-get item ',ad-alist nil nil 'string=)))
(message "Removing %s of advice from %s" ',function ad)
(advice-remove ',function ad)))
items))))))))))
UPDATE:
增加了多选删除
2 个赞
这种用的少的倒不用担心,M-x就好了,绑定了快捷键也记不住
这个功能很实用啊,尤其开发过程中经常会用到。考虑加入 Centaur 中,赞一个!!!
也可以用来删除 hook。
在 *help*
实现删除可能需要改的比较多,但是参考上边的例子写一个 helm-hook-remove
函数应该是比较容易的。
UPDATE:
在 *help*
实现删除不一定要添加 Remove 按钮,写一个 remove-hook-at-point
就好了:
(defun remove-hook-at-point ()
(interactive)
(let ((current-hook ...)
(symbol-or-lambda-at-point ...))
(remove-hook current-hook symbol-or-lambda-at-point)))
(defun remove-hook-at-point ()
(interactive)
(unless (or (eq major-mode 'help-mode)
(string= (buffer-name) "*Help*"))
(error "Only for help-mode"))
(let ((orig-point (point)))
(save-excursion
(when-let* ((hook (progn (goto-char (point-min)) (symbol-at-point)))
(function-at-point
(when (and (re-search-forward
(format "s value is[\s\n]" hook) nil t)
(sexp-at-point))
(end-of-sexp)
(backward-char 1)
(catch 'break
(while t
(condition-case err
(backward-sexp)
(scan-error (throw 'break nil)))
(let ((bounds (bounds-of-thing-at-point 'sexp)))
(when (< (car bounds) orig-point (cdr bounds))
(throw 'break (sexp-at-point)))))))))
(when (yes-or-no-p (format "Remove %s ? " function-at-point))
(message "Removing from the value of %s the function %s." hook function-at-point)
(remove-hook hook function-at-point)
(revert-buffer nil t))))))
2 个赞
今天偶然发现helpful
自带设置hook的功能,实现更暴力,直接让你在minibuffer编辑已经存在的hook。
1 个赞
For Emacs 27+:
-- (while (re-search-forward "^:[-a-z]+ advice: [‘'`]\\(.+\\)[’'']$" nil t)
++ (while (re-search-forward "^\\(?:This function has \\)?:[-a-z]+ advice: [‘'`]\\(.+\\)[’'']\\.?$" nil t)
2 个赞
昨天试着把匿名函数加上去了。
我认为删除匿名函数没问题,只需保证两项一致就可以了:
一致项 |
匿名函数 |
具名函数 |
删除按钮的 help-echo |
|
|
实际要删除的函数 |
|
|
删除按钮前的函数名 |
|
|
对匿名函数来说 help-echo
是唯一的参考,所以顺序也没关系。虽说如此,但只要按 advice--make-docstring
的顺序来获取 advices,就可以保持删除按钮跟 docstring 字面一致:
(defun function-advices (function)
"Return FUNCTION's advices."
(let ((flist (indirect-function function)) advices)
(while (advice--p flist)
(setq advices `(,@advices ,(advice--car flist)))
(setq flist (advice--cdr flist)))
advices))
;; Modified from the original function written by @xuchunyang (https://emacs-china.org/t/advice/7566/)
(define-advice describe-function-1 (:after (function) advice-remove-button)
"Add a button to remove advice."
(when (get-buffer "*Help*")
(with-current-buffer "*Help*"
(save-excursion
(goto-char (point-min))
(let ((ad-list (function-advices function)))
(while (re-search-forward "^\\(?:This function has \\)?:[-a-z]+ advice: \\(.+\\)\\.?$" nil t)
(let* ((name (string-trim (match-string 1) "[‘'`]" "[’']"))
(symbol (intern-soft name))
(advice (or symbol (car ad-list))))
(when advice
(when symbol
(cl-assert (eq symbol (car ad-list))))
(let ((inhibit-read-only t))
(insert " » ")
(insert-text-button
"Remove"
'cursor-sensor-functions `((lambda (&rest _) (message "%s" ',advice)))
'help-echo (format "%s" advice)
'action
;; In case lexical-binding is off
`(lambda (_)
(when (yes-or-no-p (format "Remove %s ? " ',advice))
(message "Removing %s of advice from %s" ',function ',advice)
(advice-remove ',function ',advice)
(revert-buffer nil t)))
'follow-link t))))
(setq ad-list (cdr ad-list))))))))
3 个赞