Org ID 重映射
Org ID Remap
在 org-link-open 等打开链接的上下文中将 Org ID 链 接重映射为其他链接。支持 ID 到 ID, ID 到 HTTP 的映射。
注：与 excl, !def, !let 相比，这是一篇纯粹从历史角度编写的博文，故只有一系列版本号（时间线）。如此编排是为研究以此种方式撰文的优缺点。
1.1
整体结构：
org-id-remap
;;; org-id-remap
(!def 'org-id-remap
(!let* (_
;;; 内部变量
<<2025-07-20-16-06>>
;;; 命令集（内部）
<<2025-07-20-15-55>>)
;;; `org-id-remap' 命令入口
(!def cmd-entry
<<2025-07-20-15-53>>)
;;; 重映射函数
;; 整个重映射逻辑的入口，实现基于
;; `org-link-abbrev-alist'.
(!def remap
<<2025-07-20-15-57>>)
;;; 链接有效性检测
;; 判断 `link' 是否有效地指向目标。
;; 输入: `link', 待映射的链接。
;; 输出: `link', 映射后的链接；或 nil, 无效映射。
(!def link-verify
<<2025-07-20-15-51>>)
;;; HTTP链接文本缓存
;; 缓存 HTTP 页面文本。
;; 输入: `link', HTTP 链接。
;; 输出: `link', 指向缓存文件的链接；或 nil；或异常。
(!def cache-http-link
<<2025-07-28-22-14>>)
;;; 命令实现
<<2025-07-20-20-30>>
;;; Org扩展
;; Org Link Search Option 扩展。
;; 支持 LINK:::DRAWERNAME: 语义。
(!def search
<<2025-07-20-15-47>>)
;; Org File Link 扩展。
;; 拦截无配置后缀文件链接访问。
(!def open-file-link
<<2025-07-20-16-18>>)
;;; 调试日志
(!def log
<<2025-07-20-15-52>>)
(!def log (log " log:org-id-remap"))
;;; org-id-remap End
(when (fboundp 'org-id-remap)
(ignore-errors
(org-id-remap nil)))
cmd-entry))
命令入口：
cmd-entry
(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))))
重映射入口：
remap
(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
,@id-links-without-remap
,@(nreverse other-links)))
;; 遍历 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))))
link-verify
(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 "\\[\\[" "\\]\\]"))))
cache-http-link
(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))
(substring
link (length (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
:expiry 'never))
(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
(when (fboundp 'zw)
(zw 'decode-region
(point-min) (point-max)))
(save-buffer))
(log "cache to %s" f))
(setq file f)))
(when file
(if (length> option 0)
(setq option (concat "::" option)))
(concat "file:///" file option))))
drawer search
(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))))))
open-file-link
(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)))
命令实现：
cmd-set
(enable? nil) (enable nil) (disable nil)
(reset nil) (set-mapping nil)
(get-mapping nil)
cmd-impl
(!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))))
调试及其他：
log
(lambda (log-target)
(lambda (fmt &rest args)
(when debug-on-error
(let* ((ts (format-time-string
"[%Y-%m-%d %H:%M:%S.%3N]"))
(buf (get-buffer-create
log-target)))
(with-current-buffer buf
(goto-char (point-max)))
(princ
(concat
(mapconcat
(lambda (line) (concat ts line))
(string-split
(apply #'format fmt args) "\n")
"\n")
"\n")
buf)))))
private
(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"))
1.2
.2 版本，含 <<@(org-link)>> 的版本。
TARGET
<<@([[id:org-id-remap::org-id-remap]])>>
org-id-remap
;;; org-id-remap -*- lexical-binding: t; -*-
(!def 'org-id-remap
(!let* (_
;;; 内部变量
<<@([[id:org-id-remap::private]])>>
;;; 命令集（内部）
<<@([[id:org-id-remap::cmd-set]])>>)
;;; `org-id-remap' 命令入口
(!def cmd-entry
<<@([[id:org-id-remap::cmd-entry]])>>)
;;; 重映射函数
;; 整个重映射逻辑的入口，实现基于
;; `org-link-abbrev-alist'.
(!def remap
<<@([[id:org-id-remap::remap]])>>)
;;; 链接有效性检测
;; 判断 `link' 是否有效地指向目标。
;; 输入: `link', 待映射的链接。
;; 输出: `link', 映射后的链接；或 nil, 无效映射。
(!def link-verify
<<@([[id:org-id-remap::link-verify]])>>)
;;; HTTP链接文本缓存
;; 缓存 HTTP 页面文本。
;; 输入: `link', HTTP 链接。
;; 输出: `link', 指向缓存文件的链接；或 nil；或异常。
(!def cache-http-link
<<@([[id:org-id-remap::cache-http-link]])>>)
;;; 命令实现
<<@([[id:org-id-remap::cmd-impl]])>>
;;; Org扩展
;; Org Link Search Option 扩展。
;; 支持 LINK:::DRAWERNAME: 语义。
(!def search
<<@([[id:org-id-remap::drawer-search]])>>)
;; Org File Link 扩展。
;; 拦截无配置后缀文件链接访问。
(!def open-file-link
<<@([[id:org-id-remap::open-file-link]])>>)
;;; 调试日志
(!def log
<<@([[id:org-id-remap::log]])>>)
(!def log (log " log:org-id-remap"))
;;; org-id-remap End
(when (fboundp 'org-id-remap)
(org-id-remap nil))
cmd-entry))
1.3
drawer-search 语义变更; open-file-link 缺陷修复；链接查找优先级重调。
1 drawer-search 语义变更。
之前抓取 drawer 的语义为 LINK:::DRAWER:, 其中 :DRAWER: 作为 option 被传入 org-link-search. 然，因为 org-element-link-parser 对 file:///~/a.org:::drawer: 和 [[file:///~/a.org:::drawer:]] 的解析结果不一致，现改用 ::NAME 语义，代码块是 ::SRC-BLOCK-NAME, drawer 是 ::DRAWER-NAME.
org-id-remap: 变更文档说明，从 LINK:::DRAWERNAE: 到 LINK::DRAWERNAME
;;; org-id-remap -*- lexical-binding: t; -*-
(!def 'org-id-remap
(!let* (_
;;;; 内部变量
<<@([[id:org-id-remap::private]])>>
;;;; 命令集（内部）
<<@([[id:org-id-remap::cmd-set]])>>)
;;;; `org-id-remap' 命令入口
(!def cmd-entry
<<@([[id:org-id-remap::cmd-entry]])>>)
;;;; 重映射函数
;; 整个重映射逻辑的入口，实现基于
;; `org-link-abbrev-alist'.
(!def remap
<<@([[id:org-id-remap::remap]])>>)
;;;; 链接有效性检测
;; 判断 `link' 是否有效地指向目标。
;; 输入: `link', 待映射的链接。
;; 输出: `link', 映射后的链接；或 nil, 无效映射。
(!def link-verify
<<@([[id:org-id-remap::link-verify]])>>)
;;;; HTTP链接文本缓存
;; 缓存 HTTP 页面文本。
;; 输入: `link', HTTP 链接。
;; 输出: `link', 指向缓存文件的链接；或 nil；或异常。
(!def cache-http-link
<<@([[id:org-id-remap::cache-http-link]])>>)
;;;; 命令实现
<<@([[id:org-id-remap::cmd-impl]])>>
;;;; Org扩展
;; Org Link Search Option 扩展。
;; 支持 LINK::DRAWERNAME 语义。
(!def search
<<@([[id:org-id-remap::drawer-search]])>>)
;; Org File Link 扩展。
;; 拦截无配置后缀文件链接访问。
(!def open-file-link
<<@([[id:org-id-remap::open-file-link]])>>)
;;;; 调试日志
(!def log
<<@([[id:org-id-remap::log]])>>)
(!def log (log " log:org-id-remap"))
;;;; org-id-remap End
(when (fboundp 'org-id-remap)
(ignore-errors (org-id-remap nil)))
cmd-entry))
link-verify: 移除原来对 link 加方括号的代码——对两种解析结果不一致的规避。
(lambda (link)
;; 对于 id-link, 我们直接尝试 open 它，
;; 如无错误，则该链接有效，`link' 被原样返回；
;;
;; 对于 http-link, 我们将 `link' 指向的资源缓存为
;; 纯文本，并尝试跳转到目标，如无错误，则该链接有
;; 效，返回缓存文件的链接。
;;
;; 依赖: log, cache-http-link
(log "valid? %s..." link)
(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))
(log "verify %s..." link)
(save-window-excursion
(org-link-open-from-string link))
link))
drawer-search: 改 drawer search 实现。
(lambda (option)
(setq option (format ":%s:" option))
(when (string-match-p org-drawer-regexp
option)
(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)))))))
2 open-file-link 缺陷修复。
open-file-link: 修复因为未判空串引发的异常；修复因可见性引发的查找失败。
(lambda (f l)
;; `org-persist' 的缓存文件后缀无法配置，导被缓存为
;; `*.nil' 的文件访问时被迫使用操作系统接口，为此，
;; 我们提供一个默认打开文件的函数，配合
;; `org-file-apps' 使用。
(let* ((s (string-trim l f)) p
(s (string-trim s "::")))
(find-file-other-window f)
(org-mode)
(when (length> s 0)
(org-with-wide-buffer
(org-link-search s) (setq p (point)))
(when p (widen) (goto-char p)))))
3 链接查找优先级重调。
remap: 分裂，剥离链接优先级调整相关代码。有重映射的 id-links 放前边，以便重映射能递归；其次是无映射的 id-link, 因为本地优先级高；最后是 http-link.
(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)
;; 分类处理 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))))
(setq
links
<<@([[id:org-id-remap::remap-sort-links]])>>)
;; 遍历 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))))
org-id-remap::remap-sort-links:
;; links 优先级调整。
;; 输入: id-links, other-links.
;; 输出: links.
;; 优化：启发式优先级。
(let (id-links-with-remap
id-links-without-remap
(ids-in-map-table
(hash-table-keys mapping)))
(mapcar
(lambda (link)
(if (member (string-trim link "id:")
ids-in-map-table)
(push link id-links-with-remap)
(push link id-links-without-remap)))
id-links)
;; 有重映射的 id-links 放前边，以便重映射能递
;; 归；其次是无映射的 id-link, 因为本地优先级
;; 高；最后是 http-link.
`(,@id-links-with-remap
,@id-links-without-remap
,@other-links))
1.4
表项覆盖；构建时间嵌入（附带更新）。
1 表项覆盖
在使用的过程中，常常会遇到这种场景[S]：个别文本块需要更新，进而联动到复制一份映射表，然后更新映射表中的 “个别” 表项。同样地，为了减少更新量，我们期望能够复用先前的映射表，或者说，在先前映射表的基础上，覆盖掉个别需要更新的表项。
原先 org-id-remap 的调用设计是为了实现一对多映射，即某个 id 存在多条映射链接（出于数据冗余考虑），具体来说：
映射表：
(org-id-remap
"id1" "link1"
"id1" "link2"
"id1" "link3")
可以让我们具有多份 id1 的映射，以便某个 link 损毁的情况下能使用其他 links.
现在，场景[S]对映射表提出了另一种需求：同一 id 不同版本。
为此，最简单且直观的实现方式为：新增一个特性，使得 “每次” 调用 org-id-remap 建立表项时，覆盖已存在的表项。具体来说：
某次调用：
(org-id-remap
"id1" "link1"
"id1" "link2"
"id2" "link3"
"id3" "link4")
后跟有调用：
(org-id-remap
"id2" "link6"
"id2" "link5")
此时，旧的 id2 将被覆盖，即当前映射表为：
id1->{link1,link2},id2->{link5,link6},id3->{link4}.
另外，我们还提供另一种覆盖表项的方法：
(org-id-remap 'reset)
(org-id-remap
;; old version
"id1" "link1"
"id1" "link2"
"id2" "link3"
"id3" "link4"
nil nil
;; new version
"id2" "link6"
"id2" "link5")
实现
cmd-impl: 分裂, 剥离 set-mapping. seq-filter 改 seq-remove.
(!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-remove
(lambda (it)
(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.")))
<<@([[id:org-id-remap::set-mapping]])>>
(!def get-mapping
(lambda ()
(!let (r)
(maphash
(lambda (k vs)
(mapc
(lambda (v) (push (list k v) r)) vs))
mapping)
(flatten-list r))))
set-mapping: 实现旧表项覆盖。修复因 flatten-list 导致版本分界符 (nil nil) 被移除的问题。
(!def set-mapping
(lambda (mappings)
(let ((mappings
(seq-partition mappings 2))
kv k v)
;; 覆盖已有的映射表项，以用新表项变更文本版本。
(mapcar
(lambda (kv)
(setf (gethash (car kv) mapping) nil))
mappings)
;; 建立映射。
(catch 'break
(while (length> mappings 0)
(setq kv (car mappings))
(setq mappings (cdr mappings))
(setq k (car kv))
(setq v (cadr kv))
;; nil nil 分隔不同版本。
(when (and (null k) (null v))
(throw 'break t))
(unless
(member v (gethash k mapping))
(push v (gethash k mapping)))))
(when mappings
(set-mapping (apply 'append mappings))))))
2 构建时间嵌入（附带更新）
新增 build-time 命令，以识别不同的 build.
(format-time-string "%FT%T%z")
org-id-remap::cmd-doc
将 Org ID 链接重映射为其他链接。
重映射仅在“打开链接”的上下文中有效。
零参时, toggle org-id-remap.
单参时:
'reset 重置重映射；
'enable? 查询使能情况；
nil 禁用重映射; t 使能。
其他情况时，建立 id 映射，调用形式如下：
(org-id-remap
"id1" "id:real-target1"
"id2" "id:real-target2"
...)
org-id-remap::org-id-remap
(lambda (&rest args)
"Org ID 重映射。
<<@([[id:org-id-remap::cmd-doc]])>>"
(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))
((eq 'build-time args)
"<<2025-07-25-21-32()>>")
((null args) (disable))
(t (enable))))
(t (set-mapping args))))
1.5
新增 locate 接口。
org-id-remap
;;; org-id-remap -*- lexical-binding: t; -*-
(!def 'org-id-remap
(!let* (org-id-remap
;;;; 内部变量
<<@([[id:org-id-remap::private]])>>
;;;; 命令集（内部）
<<@([[id:org-id-remap::cmd-set]])>>)
;;;; `org-id-remap' 命令入口
(!def org-id-remap
<<@([[id:org-id-remap::cmd-entry]])>>)
;;;; 重映射函数
;; 整个重映射逻辑的入口，实现基于
;; `org-link-abbrev-alist'.
(!def remap
<<@([[id:org-id-remap::remap]])>>)
;;;; 链接有效性检测
;; 判断 `link' 是否有效地指向目标。
;; 输入: `link', 待映射的链接。
;; 输出: `link', 映射后的链接；或 nil, 无效映射。
(!def link-verify
<<@([[id:org-id-remap::link-verify]])>>)
;;;; HTTP链接文本缓存
;; 缓存 HTTP 页面文本。
;; 输入: `link', HTTP 链接。
;; 输出: `link', 指向缓存文件的链接；或 nil；或异常。
(!def cache-http-link
<<@([[id:org-id-remap::cache-http-link]])>>)
;;;; Org链接定位
;; 定位 `link' 所指。
;; 输入: `link', Org 链接。
;; 输入: marker, 链接有效；或 nil, 链接无效。
(!def locate
<<@([[id::org-id-remap::locate]])>>)
;;;; 命令实现
<<@([[id:org-id-remap::cmd-impl]])>>
;;;; Org扩展
;; Org Link Search Option 扩展。
;; 支持 LINK::DRAWERNAME 语义。
(!def search
<<@([[id:org-id-remap::drawer-search]])>>)
;; Org File Link 扩展。
;; 拦截无配置后缀文件链接访问。
(!def open-file-link
<<@([[id:org-id-remap::open-file-link]])>>)
;;;; 调试日志
(!def log
<<@([[id:org-id-remap::log]])>>)
(!def log (log " log:org-id-remap"))
;;;; org-id-remap End
(when (fboundp 'org-id-remap)
(ignore-errors (org-id-remap nil)))
org-id-remap))
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))
(marker (make-marker)))
(condition-case msg
(save-window-excursion
;; 这个 guard 实际只对当前 buffer 有效，
;; 无法处理 open-link 跑到别的 buffer 的
;; 情况。但考虑到有时我们会 open 当前
;; buffer 中的 link, 为了防止因为可见性引
;; 发的链接查找失败，我们还是在这里加上这
;; 个 gaurd, 当然，也许还有更好的实现方法，
;; 但到时再说。
(org-with-wide-buffer
(if (not (stringp link))
(org-link-open link t)
(org-link-open-from-string link t))
(set-marker marker (point))))
(error
(when signal-errors
(signal (car msg) (cdr msg)))))))
private: 新增 locate.
(mapping (make-hash-table :test #'equal))
link-verify cache-http-link log
(locate (make-symbol "locate"))
;; `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"))
link-verify: 改用 locate. 新增对局部链接的处理，使用局部链接时，不校验有效性。
(lambda (link)
;; 对于 id-link, 我们直接尝试 open 它，
;; 如无错误，则该链接有效，`link' 被原样返回；
;;
;; 对于 http-link, 我们将 `link' 指向的资源缓存为
;; 纯文本，并尝试跳转到目标，如无错误，则该链接有
;; 效，返回缓存文件的链接。
;;
;; 依赖: log, locate, cache-http-link
(log "valid? %s..." link)
(or
(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))
(log "verify %s..." link)
(when (locate link) link))
(when (with-temp-buffer
(org-mode)
(save-excursion (insert "[[" link "]]"))
(member
(org-element-property
:type (org-element-link-parser))
`("fuzzy" "custom-id")))
link)))
org-id-remap::org-id-remap: 新增 ((eq 'locate args) locate), 导出 locate.
(lambda (&rest args)
"Org ID 重映射。
<<@([[id:org-id-remap::cmd-doc]])>>"
(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))
((eq 'build-time args)
"<<2025-07-25-21-32()>>")
((eq 'locate args) locate)
((null args) (disable))
(t (enable))))
(t (set-mapping args))))
2.0
TARGET
;;; org-id-remap -*- lexical-binding: t; -*-
(!let (org-id-remap)
:collect-symbol: !def
(!def mapping (make-hash-table :test #'equal))
(!def org-id-remap
(![&rest args]
<<2026-02-05-10-27>>))
(!def remap
(!def (gensym 'org-id-remap)
(![&optional id]
<<2026-01-29-16-26>>)))
(!def locate (! bootstrap lc))
(!def open-file-link
(!def (gensym 'org-id-remap-open-file)
(![f l]
<<2026-02-05-09-24>>)))
<<2026-02-05-10-28>>
(!def 'org-with-id-remap
(!"MAPPING &rest BODY"
<<2026-02-03-10-18>>))
(!def log 'message)
(when (fboundp 'org-id-remap)
(ignore-errors (org-id-remap nil)))
(!def 'org-id-remap org-id-remap))
X:org-id-remap
(!def set-mapping
(![mappings]
<<2026-01-29-11-01>>))
(!def get-mapping
(![&optional id-link all]
<<2026-01-29-16-34>>))
(!def sort-links
(![id-links other-links]
<<2026-02-05-09-25>>))
B:org-id-remap
(declare (indent 0))
(cond
((length> args 1) (set-mapping args))
((ignore (setq args (car args))))
((eq 'get-mapping args) (get-mapping))
((eq 'reset args) (clrhash mapping)))
B:remap
(cond
((and
;; Org Link 缩写特性可能会在非 打开链接 的上下
;; 文中使用，这里我们只处理 打开链接 时的情况。
(catch 'break
(mapbacktrace
(![...]
(when (memq (cadr ...)
'(org-open-at-point
org-link-open-from-string
org-link-open))
(log "try remap %s..." id)
(throw 'break t)))))
;; 从 mapping 中寻找一个有效目标。
(let ((links (get-mapping id t)))
;; 遍历 links, 直至我们找到一个可用的目标。
(log "pick from %S links" (length links))
(catch 'break
(dolist (link links)
(log "verify %s..." link)
(when-let* ((m (locate link t)))
(org-with-point-at m
(deactivate-mark)
(setq link (org-store-link nil))
(when (string-match
org-link-bracket-re link)
(setq link (match-string 1 link)))
(log "remap id:%s to %s" id link)
(throw 'break link))))
nil))))
;; 找不到 id 的 mapping, 返回其自身。
((ignore (log "not found")))
((concat "id:" id)))
B:open-file-link
;; `org-persist' 的缓存文件后缀无法配置，导被缓存为
;; `*.nil' 的文件访问时被迫使用操作系统接口，为此，
;; 我们提供一个默认打开文件的函数，配合
;; `org-file-apps' 使用。
(let* ((s (string-trim l f)) p
(s (string-trim s "::")))
(find-file-other-window f)
(org-mode)
(when (length> s 0)
(org-with-wide-buffer
(org-link-search s) (setq p (point)))
(when p (widen) (goto-char p))))
B:set-mapping
;; i: mappings, mapping, set-mapping.
(let ((mappings (seq-partition mappings 2)) k v)
;; 覆盖已有的映射表项，以用新表项变更文本版本。
(mapcar
(![kv] (setf (gethash (car kv) mapping) nil))
mappings)
;; 建立映射。
(catch 'break
(while (length> mappings 0)
(setq v (car mappings) k (car v) v (cadr v)
mappings (cdr mappings))
;; nil nil 分隔不同版本。
(when (and (null k) (null v))
(throw 'break t))
(unless (member v (gethash k mapping))
(push v (gethash k mapping)))))
(when mappings
(set-mapping (apply 'append mappings))))
B:get-mapping
;; i: id-link, all,
;; mapping, get-mapping, sort-links.
(cond*
((null id-link)
(maphash
( id-link)) V))
mapping)
(flatten-list id-link))
((bind* (id (if id-link (string-trim
id-link "id:")))))
((not all) (gethash id mapping))
((bind* (links (gethash id mapping))
id-links other-links new-id-links))
(t
;; 分类处理 links, 递归处理 id-links.
(while links
(setq new-id-links nil)
(mapcar
(![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 (mapcar get-mapping new-id-links)
links (flatten-list links)))
(setq links (sort-links id-links other-links))))
B:sort-links
;; links 优先级调整。
;; 输入: id-links, other-links.
;; 输出: links.
;; 优化：启发式优先级。
(let (id-links-with-remap
id-links-without-remap
(ids-in-map-table
(hash-table-keys mapping)))
(mapcar
(lambda (link)
(if (member (string-trim link "id:")
ids-in-map-table)
(push link id-links-with-remap)
(push link id-links-without-remap)))
id-links)
;; 有重映射的 id-links 放前边，以便重映射能递
;; 归；其次是无映射的 id-link, 因为本地优先级
;; 高；最后是 http-link.
`(,@id-links-with-remap
,@id-links-without-remap
,@other-links))
B:org-with-id-remap
`(let ((M (org-id-remap 'get-mapping))
(org-file-apps
'((t . ,open-file-link)
,@org-file-apps))
(org-link-abbrev-alist
'(("id" . ,remap)
,@org-link-abbrev-alist)))
(put ',remap 'org-link-abbrev-safe t)
(unwind-protect
(progn
(org-id-remap 'reset)
(apply 'org-id-remap ,MAPPING)
,@BODY)
(put ',remap 'org-link-abbrev-safe nil)
(org-id-remap 'reset)
(when M (apply 'org-id-remap M))))
2.2
TARGET
;;; org-id-remap -*- lexical-binding: t; -*-
(!let (org-id-remap)
:collect-symbol: !def
(!def mapping (make-hash-table :test #'equal))
;; `org-id-remap' 命令入口
(!def org-id-remap
(![&rest args]
<<@([[id:org-id-remap]])>>))
;; 整个重映射逻辑的入口，实现基于
;; `org-link-abbrev-alist'.
;; `org-link-abbrev-alist' 的元素 (key . val)
;; 中, val 可以是指向 function 的 symbol. 效
;; 果和 "%(sym-of-func)" 类似，但文档中未注明。
(!def remap
(!def (!def 'org-id-remap)
(![&optional id]
<<@([[id:remap]])>>)))
;; 定位 `link' 所指。
;; 输入: `link', Org 链接。
;; 输入: marker, 链接有效；或 nil, 链接无效。
(!def locate
(!def (!def 'locate)
<<@([[id::locate]])>>))
;; Org File Link 扩展。
;; 拦截无配置后缀文件链接访问。
(!def open-file-link
(!def (!def 'org-id-remap-open-file)
(![f l]
<<@([[id:open-file-link]])>>)))
<<@([[id:X:org-id-remap]])>>
(!def 'org-with-id-remap
(!"MAPPING &rest BODY"
<<@([[id:org-with-id-remap]])>>))
;; 调试日志
(!def log
<<@([[id:log]])>>)
(!def log (log " log:org-id-remap"))
;; org-id-remap End
(when (fboundp 'org-id-remap)
(ignore-errors (org-id-remap nil)))
(!def 'org-id-remap org-id-remap))
X:org-id-remap
(!def set-mapping
(![mappings]
<<@([[id:set-mapping]])>>))
(!def get-mapping
(![&optional id-link all]
<<@([[id:get-mapping]])>>))
(!def sort-links
(![id-links other-links]
<<@([[id:sort-links]])>>))
(!def enable? ())
(!def enable
(![]
<<@([[id:enable]])>>))
(!def disable
(![]
<<@([[id:disable]])>>))
(!def reset
(![] (clrhash mapping) (message "ID remap reset")))
DOC:org-id-remap
将 Org ID 链接重映射为其他链接。
重映射仅在“打开链接”的上下文中有效。
零参时, toggle org-id-remap.
单参时:
'reset 重置重映射；
'enable? 查询使能情况；
nil 禁用重映射; t 使能。
其他情况时，建立 id 映射，调用形式如下：
(org-id-remap
"id1" "id:real-target1"
"id2" "id:real-target2"
...)
org-id-remap
"Org ID 重映射。
<<@([[id:DOC:org-id-remap]])>>"
(interactive)
(declare (indent 0))
(cond
((length> args 1) (set-mapping args))
((length= args 0)
(org-id-remap (not (enable?))))
((ignore (setq args (car args))))
((eq 'get-mapping args) (get-mapping))
((eq 'reset args) (reset))
((eq 'locate args) locate)
((eq 'enable? args) (enable?))
((null args) (disable))
(t (enable)))
enable
;; i: open-file-link
(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)
(message "ID remap enable")
disable
;; i: open-file-link
(put remap 'org-link-abbrev-safe nil)
(setq
org-link-abbrev-alist
(assoc-delete-all "id" org-link-abbrev-alist
#'equal)
org-file-apps
(seq-remove
())
org-file-apps))
(message "ID remap disable")
