仅当从某个其他函数调用时才触发对函数的建议

Question

我正在尝试解决不能在当前目录和父目录. 和.. 上调用dired-do-shell-command（绑定到!）的限制。堆栈跟踪粘贴在底部。

我可以定义如下的建议来绕过这个错误：

(defadvice dired-get-filename (before h-no-error-if-not-filep activate)
  (ad-set-arg 1 t))

但这会影响对dired-get-filename 的所有调用。我希望它仅在堆栈为dired-do-shell-command -> dired-get-marked-files -> dired-get-filename 时触发。

我能想到的唯一方法如下

• 在建议定义中搜索 (with-output-to-string (backtrace)) 中的匹配项
• 将周围的建议添加到其他方法以设置一些可以在建议定义中测试的变量。

有更好的方法吗？我想我正在寻找对当前堆栈跟踪的访问作为数据结构而不是来自(backtrace)的字符串

Debugger entered--Lisp error: (error "Cannot operate on `.' or `..'")
  signal(error ("Cannot operate on `.' or `..'"))
  error("Cannot operate on `.' or `..'")
  dired-get-filename(t)
  dired-get-marked-files(t nil)
  (let ((files (dired-get-marked-files t current-prefix-arg))) (list (dired-read-shell-command (concat "! on " "%s: ") current-prefix-arg files) current-prefix-arg files))
  call-interactively(dired-do-shell-command nil nil)

Why can dired-do-shell-command not operate on '.' or '..'?

Answer 1

您可以通过backtrace-frame 一次访问一层堆栈跟踪。但这确实在推动黑客攻击。我还建议您 M-x report-emacs-bug 请求 ! 处理 . 和 ..。

Answer 2

我宁愿将dired-do-shell-command 复制到my:dired-do-shell-command 并从那里调用my:dired-get-marked-files，后者将使用第三个参数t 调用dired-get-filename。

这样我复制/粘贴了两个函数，但我最大限度地减少了建议常用函数的副作用。

Answer 3

将堆栈作为列表访问会很棒，但不幸的是，这似乎无法从 elisp 访问。 （编辑：啊，我是盲人；backtrace-frame 提供了这个，我什至没有看它。谢谢 Stefan。）

与您的第二个选项（使用额外建议和标记变量）类似的方法是仅根据外部建议启用或禁用内部建议。这是一个例子：

emacs follow-mode across frames

Answer 4

使用this-command 变量：

(defadvice dired-get-filename (before h-no-error-if-not-filep activate)
  (when (equal this-command 'dired-do-shell-command)
    (ad-set-arg 1 t)))

Answer 5

明确提出功能请求。

但是你可以自己制作my:dired-do-shell-command “复制任何代码”通过使用flet 重新绑定dired-get-filename 仅在 你的功能。这接近@oleg 的解决方案。

也在这个question讨论过：

这段代码未经测试，但你明白了。

(eval-when-compile (require 'cl))
(defun my:dired-do-shell-command (&rest args)
  (interactive)
  (let ((old-func (symbol-function 'dired-get-filename)))
    (flet ((dired-get-filename (&rest args)
                               (let ((file (funcall old-func 'verbatim)))
                                 (if (memberq file '("." ".."))
                                     (if (car args)
                                         file
                                       (expand-file-name file default-directory))
                                   (apply old-func args)))))
      (apply 'dired-do-shell-command args))))

Emacs 黑客滥用defadvice 太多了。它可怕地混淆了事情 并且只能作为最后的解决方案保留。