1 背景
尽管 Org Tangle 扩展提供了通过 HTTP-LINK::Option 抓取 HTML 文本块的手段，但 HTTP-LINK 指向的资源（通常）不可变更，当其指向的文本块需要更新时往往导致引用该HTTP-LINK 的文本块不得不跟着更新。
具体而言：
考虑某发布至网络的文本块 A, 其通过 HTTP-LINK 引用其他文本块 B, C, …,
A 的内容因而包含多条 HTTP 链接：
<<http-to-B>> <<http-to-C>> ...
当 http-to-X 指向的文本块有变更——通过新文本块发布至公共网络中——时，该新文本块将对应生成一条新 HTTP 链接: http-to-new-X, 而 A 却仍旧引用旧链接 http-to-X. 为了将 A 升至新版本——引用 http-to-new-X, 我们不得不同时更新 A 的内容。
并且这个更新过程将持续进行至根节点，以致牵一发动全身。
于是，为了尽可能降低更新量，我们考虑将 A 中的 http-to-X 重映射/定向至 http-to-new-X, 以此避免更新 A 的内容。如此，每当有更新时，除了选择重新发布 A 外，我们还可选择更新映射表，以实现更轻量的更新。
:document:
Org ID Remap
在 `org-link-open' 等打开链接的上下文中将 Org ID 链
接重映射为其他链接。
1. 特性
- 支持 ID 到 ID, ID 到 HTTP 的映射。
- ID 到 HTTP 的映射支持 Org 链接缩写特性。
- 基于 `org-persist' 的 HTTP 纯文本缓存。
- 支持 Org Link Search Option.
2. 使用
唯一入口: `org-id-remap'.
零参时, toggle org-id-remap.
单参时：
(org-id-remap 'reset) 重置重映射；
(org-id-remap 'enable?) 查询使能情况；
(org-id-remap nil) 禁用重映射；
其他使能重映射。
其他情况时，建立映射，调用形式见下：
ID 到 ID 的映射: [[id:drawer1]] -> [[id:drawer]]
(org-id-remap "drawer1" "id:drawer")
ID 到 HTTP 的映射: [[id:drawer]] -> http-link
(org-id-remap
"drawer"
(concat
"https://orgmode.org/manual/Drawers.html"
":::DRAWERNAME:"))
与 Org Link Abbreviations 配合：
:end:
#+name: example
#+begin_src emacs-lisp :eval no
(setf (alist-get "emacs-china"
org-link-abbrev-alist
nil nil #'equal)
"https://emacs-china.org/t/%s")
(org-id-remap 'reset)
(org-id-remap
;; [[id:drawer1]] -> [[id:drawer]]
"drawer1" "id:drawer"
;; [[id:drawer]] -> http-link
"drawer"
(concat
"https://orgmode.org/manual/Drawers.html"
":::DRAWERNAME:")
;; [[id:!let]]
"!let"
(concat
"emacs-china:pp-fill-lisp/29712/2"
"::2025-06-29-17-24"))
(org-id-remap t)
#+end_src
2 实现
整体结构：
#+name: org-id-remap
#+begin_src emacs-lisp :eval no :noweb yes
;;; org-id-remap
(!def 'org-id-remap
(!let* (_
;;; 内部变量
<<private>>
;;; 命令集（内部）
<<cmd-set>>)
;;; `org-id-remap' 命令入口
(!def cmd-entry
<<cmd-entry>>)
;;; 重映射函数
;; 整个重映射逻辑的入口，实现基于
;; `org-link-abbrev-alist'.
(!def remap
<<remap>>)
;;; 链接有效性检测
;; 判断 `link' 是否有效地指向目标。
;; 输入: `link', 待映射的链接。
;; 输出: `link', 映射后的链接；或 nil, 无效映射。
(!def link-verify
<<link-verify>>)
;;; HTTP链接文本缓存
;; 缓存 HTTP 页面文本。
;; 输入: `link', HTTP 链接。
;; 输出: `link', 指向缓存文件的链接；或 nil；或异常。
(!def cache-http-link
<<cache-http-link>>)
;;; 命令实现
<<cmd-impl>>
;;; Org扩展
;; Org Link Search Option 扩展。
;; 支持 LINK:::DRAWERNAME: 语义。
(!def search
<<drawer-search>>)
;; Org File Link 扩展。
;; 拦截无配置后缀文件链接访问。
(!def open-file-link
<<open-file-link>>)
;;; 调试日志
(!def log
<<log>>)
(!def log (log " *log:org-id-remap*"))
;;; org-id-remap End
(when (fboundp 'org-id-remap)
(org-id-remap nil))
cmd-entry))
#+end_src
命令入口：
#+name: cmd-entry
#+begin_src emacs-lisp :eval no
(lambda (&rest args)
"Org ID 重映射。
将 Org ID 链接重映射为其他链接。
重映射仅在“打开链接”的上下文中有效。
零参时, toggle org-id-remap.
单参时:
'reset 重置重映射；
'enable? 查询使能情况；
nil 禁用重映射；其他使能。
其他情况时，建立 id 映射，调用形式如下：
(org-id-remap
\"id1\" \"id:real-target1\"
\"id2\" \"id:real-target2\"
...)"
(interactive)
(declare (indent 0))
(cond
((length= args 0)
(if (enable?) (disable) (enable)))
((length= args 1)
(setq args (car args))
(cond
((eq 'enable? args) (enable?))
((eq 'reset args) (reset))
((eq 'get-mapping args) (get-mapping))
((null args) (disable))
(t (enable))))
(t (set-mapping args))))
#+end_src
重映射入口：
#+name: remap
#+begin_src emacs-lisp :eval no
(lambda (&optional id)
(cond
((and
;; Org Link 缩写特性可能会在非 打开链接 的上下
;; 文中使用，这里我们只处理 打开链接 时的情况。
(catch 'break
(mapbacktrace
(lambda (&rest f)
(when (memq (cadr f)
'(org-open-at-point
org-link-open-from-string
org-link-open))
(log "try remap %s..." id)
(throw 'break t)))))
;; 从 mapping 中寻找一个有效目标。
(let ((links (gethash id mapping))
id-links other-links new-id-links
id-links-without-remap)
;; 分类处理 links, 递归处理 id-links.
(while links
(setq new-id-links nil)
(mapcar
(lambda (link)
;; 我们在这里移除 link 中可能存在的方括号，
;; 以免 link 再次被
;; `org-element-link-parser' 用
;; `org-link-expand-abbrev' 展开，造成递
;; 归。
(setq link (string-trim
link "\\[\\[" "\\]\\]"))
(cond
((and (string-prefix-p "id:" link t)
(not (member link id-links)))
(push link new-id-links)
(push link id-links))
(t (unless (member link other-links)
(push link other-links)))))
links)
(setq links
(flatten-list
(mapcar
(lambda (link)
(gethash
(string-trim link "id:")
mapping))
new-id-links))))
;; links 优先级调整。
;; 优化：启发式优先级。
(setq new-id-links id-links)
(setq id-links nil)
(mapcar
(let ((id-links-with-remap
(hash-table-keys mapping)))
(lambda (link)
(if (member (string-trim link "id:")
id-links-with-remap)
(push link id-links)
(push link id-links-without-remap))))
new-id-links)
(setq links `(,@id-links
,@(nreverse other-links)
,@id-links-without-remap))
;; 遍历 links, 直至我们找到一个可用的目标。
(log "pick from %S links" (length links))
(catch 'break
(dolist (link links)
(when (setq link (link-verify link))
(log "remap id:%s to %s\n" id link)
(throw 'break link)))
nil))))
;; 找不到 id 的 mapping, 返回其自身。
((ignore (log "not found")))
((concat "id:" id))))
#+end_src
#+name: link-verify
#+begin_src emacs-lisp :eval no
(lambda (link)
;; 对于 id-link, 我们直接尝试 open 它，
;; 如无错误，则该链接有效，`link' 被原样返回；
;;
;; 对于 http-link, 我们将 `link' 指向的资源缓存为
;; 纯文本，并尝试跳转到目标，如无错误，则该链接有
;; 效，返回缓存文件的链接。
;;
;; 依赖: log, cache-http-link
(log "valid? %s..." link)
(let ((inhibit-message t)
(message-log-max nil)
(org-link-search-must-match-exact-headline t))
(ignore-errors
;; 如果 link 非 id-link, 我们预期它将被 expand
;; 为 http-link.
(unless (string-prefix-p "id:" link t)
(setq link (org-link-expand-abbrev link))
(unless (string-match-p "^http[s]:" link)
(error
"Expect HTTP/S link, but %s was given."
link))
(setq link (cache-http-link link))
(log "cache: %s" link)
;; 这里，为了使用我们自定义的 :DRAWERNAME:
;; search option, 我们不得不给 link 加上方括
;; 号，因为 `org-element-link-parser' 对下面
;; 两种链接解析的结果不一致：
;;
;; file:///~/a.org:::drawer:
;; => file:///~/a.org:::drawer
;;
;; [[file:///~/a.org:::drawer:]]
;; => file:///~/a.org:::drawer:
(setq link (concat "[[" link "]]")))
;; 预期 `org-link-open-from-string' 在找不到目
;; 标时抛出异常；如果 `link' 可以正常打开，则
;; `link' 是我们的目标。
(log "verify %s..." link)
(save-window-excursion
(org-link-open-from-string link))
(string-trim link "\\[\\[" "\\]\\]"))))
#+end_src
#+name: cache-http-link
#+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 (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
(concat "file:///" file "::" option))))
#+end_src
#+name: drawer-search
#+begin_src emacs-lisp :eval no
(lambda (option)
(when (string-match-p org-drawer-regexp
option)
(goto-char (point-min))
(catch 'found
(while (re-search-forward
option nil t)
(when (org-element-type-p
(org-element-context)
'drawer)
(throw 'found 'drawer))))))
#+end_src
#+name: open-file-link
#+begin_src emacs-lisp :eval no
(lambda (f l)
;; `org-persist' 的缓存文件后缀无法配置，导被缓存为
;; `*.nil' 的文件访问时被迫使用操作系统接口，为此，
;; 我们提供一个默认打开文件的函数，配合
;; `org-file-apps' 使用。
(let* ((s (string-trim l f))
(s (string-trim s "::")))
(find-file-other-window f)
(org-mode)
(org-link-search s)))
#+end_src
命令实现：
#+name: cmd-set
#+begin_src emacs-lisp :eval no
(enable? nil) (enable nil) (disable nil)
(reset nil) (set-mapping nil)
(get-mapping nil)
#+end_src
#+name: cmd-impl
#+begin_src emacs-lisp :eval no
(!def enable?
(lambda ()
(get remap 'org-link-abbrev-safe)))
(!def enable
(lambda ()
(put remap 'org-link-abbrev-safe t)
(setf (alist-get
"id" org-link-abbrev-alist
nil nil #'equal)
remap)
(push `(t . ,open-file-link)
org-file-apps)
(add-hook
'org-execute-file-search-functions
search)
(message "Org ID remap enable.")))
(!def disable
(lambda ()
(put remap 'org-link-abbrev-safe nil)
(setq org-link-abbrev-alist
(assoc-delete-all
"id" org-link-abbrev-alist
#'equal))
(setq org-file-apps
(seq-filter
(lambda (it)
(not
(equal
it `(t . ,open-file-link))))
org-file-apps))
(remove-hook
'org-execute-file-search-functions
search)
(message "Org ID remap disable.")))
(!def reset
(lambda ()
(clrhash mapping)
(message "Org ID mapping reset.")))
(!def set-mapping
(lambda (mappings)
(mapcar
(lambda (kv)
(let ((k (car kv)) (v (cadr kv)))
(unless
(member v (gethash k mapping))
(push v (gethash k mapping)))))
(seq-partition mappings 2))))
(!def get-mapping
(lambda ()
(!let (r)
(maphash
(lambda (k vs)
(mapc
(lambda (v) (push (list k v) r)) vs))
mapping)
(flatten-list r))))
#+end_src
调试及其他：
#+name: log
#+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
#+name: private
#+begin_src emacs-lisp :eval no
(mapping (make-hash-table :test #'equal))
(cmd-entry nil) (log nil)
(link-verify nil) (cache-http-link nil)
;; `org-link-abbrev-alist' 的元素 (key . val)
;; 中, val 可以是指向 function 的 symbol. 效
;; 果和 "%(sym-of-func)" 类似，但文档中未注明。
(remap (make-symbol "org-id-remap"))
;; 用于打开某些特殊后缀文件。
(open-file-link
(make-symbol "org-id-remap-open-file"))
;; Org Link Search Option 扩展。
(search (make-symbol "org-id-remap-search"))
#+end_src
3 附录
let改：
#+name: !let
#+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)
`(funcall
(lambda (,@(nreverse vars))
(cl-macrolet
,(mapcar
(lambda (s)
`(,s (&rest args)
`(funcall
;;,',s
(or (and (functionp ,',s) ,',s)
(function ,',s))
,@args)))
(nreverse vars))
,@body))
,@(nreverse vals))))))
#+end_src
#+name: !let*
#+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)))
#+end_src
#+name: !def
#+begin_src emacs-lisp :eval no
(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
加载用：
#+begin_src emacs-lisp :results silent :lexical t :eval yes :noweb no-export
<<!let>>
<<!let*>>
<<!def>>
<<org-id-remap>>
#+end_src