添加个删除 Advice 函数的按钮

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

加入 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)

emacs--help-mode--advice-remove-button

(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))))))))))

emacs--helm-remove-advice--1

emacs--helm-remove-advice--2


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))))))

emacs--help-mode--remove-hook-at-point

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 :heavy_check_mark: :heavy_check_mark:
实际要删除的函数 :heavy_check_mark: :heavy_check_mark:
删除按钮前的函数名 :heavy_check_mark:

对匿名函数来说 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))))))))

Screenshot_2020-03-06_at_1.26.27_AM

3 个赞

更新:

  • 增加了对 macro 的支持

放到 Gist 方便获取: https://gist.github.com/twlz0ne/f93debe098e0e39ebce5476b62c8ebbb

1 个赞