1 背景
如果将 Org-mode 类比为一种极为灵活且扩展性极强的平台无关文件系统，那 Org链接 就是这个文件系统用于定位的文件的“文件名”。当前, org-noweb-expand-link (似cat但具备文学编程特性), org-id-remap (仿symlink), org-exec (仿操作系统的exec) 无不基于此思路。
为了扩展这个文件系统，我们常常需要配置 Emacs 和 Org 为我们提供的配置变量。
比如，我们可以配置 browse-url-browser-function 使得 org-link-open 将某个远程资源打开于本地的 Emacs buffer 中；再比如，我们可以配置 org-execute-file-search-functions, 以便扩展“文件名”的定义；又如，因为 Window 上的 url-retrieve-synchronously 使用体验很差，我们可以借助 Emacs 的 advice 机制改写其实现，以便依赖它的上层功能也能够在 Window 上具有良好的体验。
举例来说，正常情况下, org-link-open-from-string 是无法打开如下定位到名为 named-block 的代码块链接的：
(funcall
#'org-link-open-from-string
"[[https://orgmode.org/manual/Using-Header-Arguments.html::named-block]]")
但我们可以通过临时修改某些配置变量实现这一点：
(with-conf a-special-conf
(org-link-open-from-string
"[[https://orgmode.org/manual/Using-Header-Arguments.html::named-block]]"))
或，不依赖任何 `with-conf` 提供的语义，只使用“函数”这个概念：
(funcall
(a-special-conf #'org-link-open-from-string)
"[[https://orgmode.org/manual/Using-Header-Arguments.html::named-block]]")
a-special-conf 函数以 org-link-open-from-string 为输入，返回一个具备某种特殊配置的 open-from-string.
2 配置的相关性质
通常情况下，我们（作为 Emacs 的用户）会在 Emacs 的配置文件 (如 init.el) 中直接改写这些配置变量——以一种影响全局的方式。但某些情况下 (如某些依赖这些配置实现其功能的 package), 为了不影响用户配置，我们（作为 Package 的开发者）希望以一种临时且局部的方式改变这些配置。
在 elisp 中，我们常常会借助 let 绑定，动态配置某个接口的行为。
比如，下面的 locate 函数通过配置 browse-url-browser-function 动态改变 org-link-open-from-string 的行为：
(let ((ursa (make-symbol "ursa"))
(chl (make-symbol "chl")))
(defalias 'locate
(lambda (link &optional signal-errors)
(let ((inhibit-message t)
(message-log-max nil)
(org-link-search-must-match-exact-headline t)
(org-link-frame-setup
`((file . find-file-other-window)
,@org-link-frame-setup))
(browse-url-browser-function
<<2025-08-02-11-16>>))
(condition-case msg
(save-window-excursion
(org-with-wide-buffer
(if (not (stringp link))
(org-link-open link t)
(org-link-open-from-string link t))
(set-marker (make-marker) (point))))
(error (when signal-errors
(signal (car msg) (cdr msg))))))))
(defalias ursa
<<2026-02-25-08-33>>)
(defalias chl
<<2026-02-25-08-26>>))
这些配置是局部，可变 且 共享 的。
以上述 locate 为例，
局部 表现为：这些配置只在使用了 locate 的 package 中有效，不应影响 Emacs 的用户配置。
可变 表现为：某天 package 的开发者也许想要给 org search option 添加新语法，即：变更 org-execute-file-search-functions 的配置。
共享 体现为：有多个包同时依赖相同的配置。
如果把这些 临时 配置相关的代码固定在 locate 中，一旦配置发生 改变 ，locate 也会被迫改变，更严重的是，由于多个 package 均 共享 这些配置，改变配置将导致多个 package 的代码不得不跟着变更。
3 问题及可能的应对方法
现在的问题[1]是：如何处理以便更好地复用代码及对抗代码变化。
我当前想到的一个方法[2]是：将这些配置抽象为某个函数，这个函数以待配置的函数为输入，将输入的函数裹上其定义的配置代码，效果类似 advice-add :around，但没 advice-add 那么笨重。
具体来说，我希望下面的 X-conf 以 locate 为输入，返回一个函数签名和 locate 一致的函数，且将 locate 包裹在其配置中：
(defvar X-conf)
(defun pkg-A-do-something
...
(funcall (X-conf locate) link)
...)
X-conf 同时是一个变量——因为配置可变,可由外部改变；且, X-conf 同时共享与多个模块。
实现为：
(def X-conf
(lambda (f)
(eval
;; 为了得到和 f 一致的签名，我们用 help-function-arglist.
`(lambda ,(help-function-arglist f t)
(let ((org-execute-file-search-functions
`(,drawer-search
,@org-execute-file-search-functions))
(browse-url-browser-function
eww-browse-url))
(funcall
f
;; 这里用 f 原来的参数调用它，但未能处理
;; 因其他未知关键字，比如 &key, 的存在而
;; 引发的问题。有多少关键字呢？
,@(seq-filter
(lambda (a)
(not (memq a '(&optional &rest))))
(help-function-arglist f t)))))
`((drawer-search . ,drawer-search)
(f . ,f)))))
这里，为了得到和待配置函数 f 一致的函数签名, X-conf 使用了 help-function-arglist 并于调用时滤掉了 &optional, &rest 等符号（显然，特殊关键字不止这些）。
问题：为解决问题[1]，有没有比方法[2]更合适的方法？
4 一次尝试
我们（作为 Package 开发者）要实现的功能：
用 org-link-open 1)打开 Link 时，支持根据 drawer name 定位 drawer; 2)打开 HTTP Link 时，支持从缓存访问。
实现的方法：修改 browse-url-browser-function 及 org-execute-file-search-functions.
基于上文的描述，我们要实现一个函数，这个函数以函数为输入，以函数为输出。输出的函数调用时应具有和输入的函数相同的入参，它们的区别在于：输出的函数带上了我们的配置。
这里，我们直接用 apply (因为 help-function-arglist 可能无法满足我们的需要), 尽管返回的函数的入参签名与输入的不一致。
;; depends: org-link-open-adv, browse-url,
;; drawer-search.
(lambda (&optional f &rest a)
(interactive)
(cond*
((bind* (enable? (advice-member-p
org-link-open-adv
#'org-link-open))
(ext org-execute-file-search-functions)))
((functionp f)
(lambda (&rest args)
(let ((org-execute-file-search-functions
`(,drawer-search ,@ext))
(browse-url-browser-function
browse-url))
(apply f args))))
((eq f 'wrap)
(!let ((f (car a)))
(!def f (link-open-conf (symbol-function f)))))
((eq f 'unwrap)
(!let* ((f (car a))
(F (symbol-function f)))
(!def f (alist-get 'f (aref F 2)))))
(enable?
(advice-remove
'org-link-open org-link-open-adv)
(message "Link open conf disable"))
(t
(advice-add
'org-link-open :around org-link-open-adv)
(message "Link open conf enable"))))
上面的配置只配置了两个变量: browse-url-browser-function, org-execute-file-search-functions. 下面我们挨个说明。
首先是对 browse-url-browser-function 的配置。
当被要求在 Emacs 中访问 HTTP链接 时，org-link-open-from-string 会使用使用 browse-url 获取资源。此时，我们可以通过配置 browse-url-browser-function 拦截控制流。下面 browse-url 实现，做了两件事：advice 默认的 url-retrieve-synchronously, 以便优化体验；使用缓存。
(lambda (url &rest args)
(funcall ursa t)
(unwind-protect
(let ((file (funcall chl url)))
(unless file
(error "Resource not found: %s" url))
(org-link-open-from-string file t)
(org-mode))
(funcall ursa nil)))
url-retrieve-synchronously advice 的实现，如可能，使用 curl.
(let ((urs 'url-retrieve-synchronously)
(wait (make-symbol "wait"))
(adv (make-symbol "adv")))
(defalias wait
(lambda (P)
(while (process-live-p P) (sleep-for .1))))
(defalias adv
(lambda (&optional urs url silent u timeout)
(cond*
((bind* (_ (url-p url)))
(setq url (url-recreate-url url)))
((or (not (executable-find "curl"))
(not (string-match-p "^http[s]?:" url)))
(funcall urs url silent u timeout))
((bind* (cmd "curl") (inhibit-message silent)
(opt `("-is" "--ssl-no-revoke" ,url))
(B (format " *%s*" url)) P
(B (generate-new-buffer B)))
(with-current-buffer B
(set-buffer-multibyte nil))
(setq P (apply 'start-process cmd B cmd opt))
(message "Retrieving %s..." url)
(if (null timeout) (funcall wait P)
(with-timeout
(timeout (message "Timeout: %s." url)
(delete-process P)
(kill-buffer B))
(funcall wait P))))
((eq (process-status P) 'exit)
(message "Retrieving %s done." url)
(with-current-buffer B
(save-excursion
(goto-char (point-min))
(save-match-data
(when (re-search-forward "^\r$" nil t)
(delete-region
(match-beginning 0) (match-end 0))))
(goto-char (point-max))
(forward-line -1) (delete-line))
B)))))
(lambda (on)
(if on (advice-add urs :around adv)
(advice-remove urs adv))))
缓存的实现，使用 org-persist, org-persist -> url-copy-file -> url-retrieve-synchronously.
(lambda (link)
(cond*
((bind* (url (string-trim-right link "::[^:]*"))
(option (string-trim
link (regexp-quote url)))
(option (string-trim option "::"))
(org-resource-download-policy t)
(file (org-persist-read 'url url))))
((bind* (_ (null file)) (inhibit-read-only t) buf
(shr-inhibit-images t) (shr-bullet "- ")
(file (org-persist-register
'url url :write-immediately t
:expiry 'never))
(buf (find-file-noselect file)))
(with-temp-buffer
(shr-insert-document
(with-current-buffer buf
(libxml-parse-html-region
(point-min) (point-max))))
(goto-char (point-min))
(replace-regexp "^[*]" "# *")
(buffer-swap-text buf))
(with-current-buffer buf
(ignore-errors (xb)) (save-buffer)))
((bind* (_ (length> option 0)))
(setq option (concat "::" option)))
(file (concat "file:///" file option))))
其次是对 org-execute-file-search-functions 的配置。
扩展 Org Search Option, 支持 LINK::DRAWERNAME 语义。
(lambda (option)
(setq option (format ":%s:" option))
(when (string-match-p org-drawer-regexp
option)
(unless (derived-mode-p 'org-mode)
(org-mode))
(goto-char (point-min))
(catch 'found
(save-match-data
(while (re-search-forward
option nil t)
(when (org-element-type-p
(org-element-context)
'drawer)
(forward-line 0)
(throw 'found 'drawer)))))))
日志
(lambda (log-target)
(lambda (fmt &rest args)
(when debug-on-error
(let* ((ts (format-time-string
"[%Y-%m-%d %H:%M:%S.%3N]"))
(fmt (concat ts fmt "\n"))
(buf (get-buffer-create
log-target)))
(with-current-buffer buf
(goto-char (point-max)))
(princ (apply #'format fmt args)
buf)))))
TARGET
;;; link-open-conf -*- lexical-binding: t; -*-
(!let (link-open-conf
(browse-url (make-symbol "browse-url"))
(ursa (make-symbol "ursa"))
(chl (make-symbol "cache-http-link"))
(drawer-search
(make-symbol "drawer-search"))
(org-link-open-adv
(make-symbol "org-link-open-adv"))
log)
(!def link-open-conf
<<@([[id:link-open-conf]])>>)
(!def org-link-open-adv
(lambda (fn &rest a)
(apply (link-open-conf fn) a)))
(!def browse-url
<<@([[id:browse-url]])>>)
(!def ursa
<<@([[id:url-retrieve-synchronously-advice]])>>)
(!def chl
<<@([[id:cache-http-link]])>>)
(!def drawer-search
<<@([[id:drawer-search]])>>)
(!def log
<<@([[id:log]])>>)
(!def log (log " log:link-open-conf"))
(!def 'link-open-conf link-open-conf))
