0 这篇帖子干了什么
用 eww 加载并用 org-babel-execute-buffer 执行此页面后，你将得到一个 link-open-conf 函数. 下面的 elisp 代码可用于测试我们实现的功能：
(funcall
(link-open-conf #'org-link-open-from-string)
"[[https://orgmode.org/manual/Using-Header-Arguments.html::named-block]]")
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 的代码块链接的：
#+begin_src emacs-lisp :eval no
(funcall
#'org-link-open-from-string
"[[https://orgmode.org/manual/Using-Header-Arguments.html::named-block]]")
#+end_src
但我们可以通过临时修改某些配置变量实现这一点：
#+begin_src emacs-lisp :eval no
(with-conf a-special-conf
(org-link-open-from-string
"[[https://orgmode.org/manual/Using-Header-Arguments.html::named-block]]"))
#+end_src
或，不依赖任何 with-conf 提供的语义，只使用“函数”这个概念：
#+begin_src emacs-lisp :eval no
(funcall
(a-special-conf #'org-link-open-from-string)
"[[https://orgmode.org/manual/Using-Header-Arguments.html::named-block]]")
#+end_src
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-execute-file-search-functions 以及 url-retrieve-synchronously 的 advice 动态改变 org-link-open-from-string 的行为：
(defun locate (link)
(let ((browse-url-browser-function eww-browse-url)
(org-execute-file-search-functions
`(,drawer-search
,@org-execute-file-search-functions)))
(advice-add 'url-retrieve-synchronously :around urs-advice)
(unwind-protect
(org-link-open-from-string link t)
(advice-remove 'url-retrieve-synchronously urs-advice))))
但这些配置是局部，可变 且 共享 的。
以上述 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]更合适的方法？
注1: locate 是一个局部函数，不期望被 advice-add.
注2：不直接设置 org-execute-file-search-functions 等配置变量是因为代码本身是 package，无改变用户配置的能力。
4 一次尝试
顺着方法[2]的思路，我们提供如下的配置，以实现前文提到的：
(funcall
(a-special-conf #'org-link-open-from-string)
"[[https://orgmode.org/manual/Using-Header-Arguments.html::named-block]]")
待实现的功能：用 org-link-open 1)打开 Link 时，支持根据 drawer name 定位 drawer; 2)打开 HTTP Link 时，支持从缓存访问。
关于测试：用 eww 加载并用 org-babel-execute-buffer 执行此页面后，你将得到 link-open-conf 函数. 下面的 elisp 代码可用于测试我们实现的功能：
(funcall
(link-open-conf #'org-link-open-from-string)
"[[https://orgmode.org/manual/Using-Header-Arguments.html::named-block]]")
实现方法：配置 browse-url-browser-function 及 org-execute-file-search-functions.
4.1 一个返回配置后的函数的函数
基于上文的描述，我们要实现一个函数，这个函数以函数为输入，以函数为输出。输出的函数调用时应具有和输入的函数相同的入参，它们的区别在于：输出的函数带上了我们的配置。
这里，我们直接用 apply (因为 help-function-arglist 返回的参数列表可能含有未知符号），尽管返回的函数的入参签名与输入的不一致，但因为只在内部使用，无所谓签名。
#+name: 2025-08-02-11-10
#+begin_src emacs-lisp :eval no
(lambda (f)
(eval
`(lambda (&rest args)
(let ((org-execute-file-search-functions
`(,drawer-search
,@org-execute-file-search-functions))
(browse-url-browser-function
browse-url))
(apply f args)))
`((drawer-search . ,drawer-search)
(browse-url . ,browse-url)
(f . ,f))))
#+end_src
上面的配置代码只配置了两个变量: browse-url-browser-function, org-execute-file-search-functions. 下面我们挨个说明。
4.2 页面缓存
首先是对 browse-url-browser-function 的配置。
当被要求在 Emacs 中访问 HTTP链接 时，org-link-open-from-string 会使用使用 browse-url 获取页面资源。此时，我们可以通过配置 browse-url-browser-function 拦截控制流。下面的 browse-url 实现做了两件事：advice 默认的 url-retrieve-synchronously, 以便优化体验；访问 HTTP资源 时使用缓存。
#+name: 2025-08-02-11-16
#+begin_src emacs-lisp :eval no
(lambda (url &rest args)
(ursa t)
(unwind-protect
(let ((file (cache-http-link url)))
(unless file
(error "Resource not found: %s" url))
(org-link-open-from-string file t)
(org-mode))
(ursa nil)))
#+end_src
url-retrieve-synchronously advice 的实现，如可能，使用 curl.
#+name: 2025-08-02-10-58
#+begin_src emacs-lisp :eval no
(!let ((qurs 'url-retrieve-synchronously) post adv)
(!def adv
(lambda (&optional urs url silent u timeout)
(cond
((ignore
(when (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))
(t
(!let* ((inhibit-message silent) B P wait
(opt `("-is" "--ssl-no-revoke" ,url)))
(with-current-buffer
(generate-new-buffer (format " *%s*" url))
(set-buffer-multibyte nil)
(setq B (current-buffer)))
(setq P (apply #'start-process
"curl" B "curl" opt))
(!def wait
(lambda ()
(while (process-live-p P) (sit-for 1))))
(message "Retrieving %s..." url)
(if (null timeout) (wait)
(with-timeout
(timeout
(message "Retrieving %s timeout." url)
(delete-process P) (kill-buffer B))
(wait)))
(when (eq (process-status P) 'exit)
(message "Retrieving %s done." url)
(with-current-buffer B (post) B)))))))
(!def post
(lambda ()
(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))))
(lambda (arg)
(if (null arg) (advice-remove qurs adv)
(advice-add qurs :around adv))))
#+end_src
缓存的实现，使用 org-persist, org-persist → url-copy-file → url-retrieve-synchronously.
#+name: 2025-08-02-10-59
#+begin_src emacs-lisp :eval no
(lambda (link)
;; 用 `org-persist' 将 `link' 指向的资源存为纯文本。
;; 移除缓存: (org-persist-unregister 'url url)
(log "try locate %s..." link)
(let* ((url (string-trim-right
link "::[:]?[^:]*[:]?"))
(option
(if (length< url (length link))
(string-trim-left
link (concat url "::"))
""))
;; `org-persist' 的缓存文件后缀无法修改，导
;; 致访`.nil' 文件时被迫使用操作系统接口，
;; 在此规避。
;; (org-file-apps
;; (cons '(t . emacs) org-file-apps))
(org-resource-download-policy t)
(file (org-persist-read 'url url)))
(unless file
;; cache and render
(log "try cache %s..." url)
(let* ((f (org-persist-register
'url url :write-immediately t))
(buf (find-file-noselect f))
(shr-inhibit-images t)
(shr-bullet "- "))
(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 (save-buffer))
(log "cache to %s" f))
(setq file f)))
(when file
(if (length> option 0)
(setq option (concat "::" option)))
(concat "file:///" file option))))
#+end_src
4.3 LINK::DRAWERNAME 语义
其次是对 org-execute-file-search-functions 的配置。
扩展 Org Search Option, 支持 LINK::DRAWERNAME 语义。
#+name: 2025-08-02-11-00
#+begin_src emacs-lisp :eval no
(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)))))))
#+end_src
综上，两个配置的说明至此结束。
4.4 其他
配置代码的整体结构：
#+name: 2025-08-02-11-28
#+begin_src emacs-lisp :eval no :noweb yes
;;; link-open-conf -*- lexical-binding: t; -*-
(!def 'link-open-conf
(!let (link-open-conf log
(browse-url (make-symbol "browse-url"))
(ursa (make-symbol "ursa"))
(cache-http-link
(make-symbol "cache-http-link"))
(drawer-search
(make-symbol "drawer-search")))
(!def link-open-conf
<<2025-08-02-11-10>>)
(!def browse-url
<<2025-08-02-11-16>>)
;; url-retrieve-synchronously advice
(!let ((message log))
(!def ursa
<<2025-08-02-10-58>>))
(!def cache-http-link
<<2025-08-02-10-59>>)
(!def drawer-search
<<2025-08-02-11-00>>)
(!def log
<<2025-08-02-11-01>>)
(!def log (log " log:link-open-conf"))
link-open-conf))
#+end_src
Eval 入口
#+name: 2025-08-02-11-29
#+begin_src emacs-lisp :eval yes :noweb yes :lexical t :results silent
<<2025-08-02-11-33>>
<<2025-08-02-11-32>>
<<2025-08-02-11-28>>
#+end_src
调试用
#+name: 2025-08-02-11-01
#+begin_src emacs-lisp :eval no
(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)))))
#+end_src
4.A 附
#+name: 2025-08-02-11-33
#+begin_src emacs-lisp :eval no
(defmacro !let (bindings &rest body)
(declare
(indent
(lambda (p s)
(save-excursion
(goto-char (car (last (nth 9 s))))
(1+ (current-column))))))
(cond
((null bindings) `(progn ,@body))
(t
(let (vars vals)
(mapc
(lambda (binding)
(push (or (car-safe binding) binding) vars)
(push (car (cdr-safe binding)) vals))
bindings)
(setq vars (nreverse vars))
(setq vals (nreverse vals))
`(funcall
(lambda (,@vars)
(cl-macrolet
,(mapcar
(lambda (s)
`(,s (&rest args)
`(funcall
;;,',s
(or (and (functionp ,',s) ,',s)
(function ,',s))
,@args)))
vars)
,@body))
,@vals)))))
#+end_src
#+name: 2025-08-02-11-32
#+begin_src emacs-lisp :eval no
(defmacro !let* (bindings &rest body)
(declare
(indent
(lambda (p s)
(save-excursion
(goto-char (car (last (nth 9 s))))
(1+ (current-column))))))
(if (null bindings) `(progn ,@body)
(setq bindings (reverse bindings))
(while bindings
(setq body (list `(!let (,(pop bindings))
,@body))))
(car body)))
(defmacro !def (sym val)
(declare
(indent
(lambda (p s)
(save-excursion
(goto-char (car (last (nth 9 s))))
(1+ (current-column))))))
`(!let ((val ,val))
(if (ignore-errors
(and ,sym (symbolp ,sym) (functionp val)))
(defalias ,sym val)
(setq ,sym val))))
#+end_src