Org Tangle 扩展
鉴于我们已经有了Org ID Remap, 于此重构 Org Tangle 扩展.
HTTP Tangle 特性已被移除,Org Tangle 只专注于文本编织。
1 整体结构
#+name: 2025-06-20-21-35
#+begin_src emacs-lisp :eval no
;;; Org Noweb Expand Link -*- lexical-binding: t; -*-
(!def 'org-noweb-expand-link
(!let* (entry
;;;; Private
<<@([[id:org-noweb-expand-link::private]])>>)
;;;; Entry
;; `org-noweb-expand-link' 函数入口
(!def entry
<<@([[id:org-noweb-expand-link::entry]])>>)
;;;; Locate
;; 定位 `link' 所指。
;; 输入: `link', Org 链接。
;; 输出: marker, `link' 所指,或 nil.
(!def locate
<<@([[id::org-noweb-expand-link::locate]])>>)
;;;; Expand
;; 展开当前位置的 Org 元素
;; 输入: `conf', 同 entry 入参。
;; 输出: string, Org 元素展开后的文本。
(!def expand
<<@([[id:org-noweb-expand-link::expand]])>>)
<<@([[id:org-noweb-expand-link::features]],2)>>
;;;; Logging
(!def log
<<@([[id:org-noweb-expand-link::log]])>>)
(!def log (log " log:org-noweb"))
;;;; Prelude
;; 注册 org-babel 函数 @
<<@([[id:org-noweb-expand-link::org-babel-register]])>>
;;;; End
entry))
#+end_src
2 入口 (entry)
:2025-07-26-10-14:
Org Noweb 扩展。
结合 Org-Babel 提供额外的引用文本块的语义:
#+begin_src emacs-lisp :eval no
<<@(org-link)>>
#+end_src
配合 `org-open-at-point-global’ 使用,方便打开代
码块中的 Org 链接。
特性查询: M-x org-noweb-expand-link
:end:
实现:
#+name: 2025-07-26-10-15
#+begin_src emacs-lisp :eval no
(lambda (link &rest conf)
"Org Noweb Extension.
<<@([[id:org-noweb-expand-link::entry-docstring]],rm-ws-p=1)>>"
(interactive (list nil))
(cond
((stringp link)
(log "%s" link)
(let ((marker (locate link)) body)
(cond
(marker
(org-with-point-at marker
;; 如果展开失败,设置 :failed 及
;; :err-msg, 并将 body 置为空串。
(setq body (expand conf))))
(t
(plist-put conf :failed t)
(plist-put
conf :err-msg
(format-message
"failed to expand %s" link))
(setq body "")))
(dolist (p post-process)
(setq body (funcall p body conf)))
;; display warning
(when (plist-get conf :failed)
(display-warning
'org-noweb
(plist-get conf :err-msg)
:warning))
body))
<<@([[id:org-noweb-expand-link::cmd-set]])>>))
#+end_src
3 文本定位 (locate)
根据 Org链接 定位文本位置。
#+name: 2025-07-26-10-27
#+begin_src emacs-lisp :eval no
;; 借 `org-link-open' 定位 `link' 所指。
;;
;; 很遗憾, Org 本身并没有提供编程级别的 API 实现类似的
;; 接口。为了尽可能复用已有代码,我们只能借
;; `org-link-open' 之类的带副作用 (改变 window 或
;; buffer 或 point) 的接口实现。
(lambda (link)
(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)))
(ignore-errors
(save-window-excursion
;; 这个 guard 实际只对当前 buffer 有效,无法处
;; 理 open-link 跑到别的 buffer 的情况。但考虑
;; 到有时我们会 open 当前 buffer 中的 link, 为
;; 了防止因为可见性引发的链接查找失败,我们还
;; 是在这里加上这个 gaurd, 当然,也许还有更好
;; 的实现方法,但到时再说。
(org-with-wide-buffer
(if (not (stringp link))
(org-link-open link)
(org-link-open-from-string link))
(set-marker marker (point)))))))
#+end_src
4 文本展开 (expand)
根据当前位置的 Org元素 的类型将该元素展开为文本。转交给 org-element-expanders 处理。
#+name: 2025-07-26-10-30
#+begin_src emacs-lisp :eval no
(lambda (conf)
"展开位于 current point 的 Org element."
(!let* ((ele (org-element-at-point))
(type (org-element-type ele))
(expand
(alist-get
type org-element-expanders)))
(cond
((and expand (expand ele conf)))
;; 未定义
(t
(plist-put conf :failed t)
(plist-put
conf :err-msg
(format-message
"%s point to an unsupported position."
link))
""))))
#+end_src
5 Org Babel 接口
提供一个 Org Babel 函数: @,
以便将 babel call 转换为对 org-noweb-expand-link 的调用。
babel-variables 中的符号将作为 babel call 变量,并传递给 org-noweb-expand-link.
#+name: 2025-07-26-10-32
#+begin_src emacs-lisp :eval no
(with-temp-buffer
(org-mode)
(log "register org babel function: @")
(let* ((vars
`((level (ignore))
,@(mapcar
(lambda (v) `(,v (ignore)))
babel-variables)))
(ha (mapconcat
(lambda (v)
(format
":var %s=%s" (car v) (cadr v)))
vars " "))
(a (mapconcat
(lambda (v)
(format
":%s %s" (car v) (car v)))
vars " ")))
(insert
"#+name: @\n"
"#+begin_src emacs-lisp "
":var link=\"\" " ha "\n"
"(org-noweb-expand-link "
"(format \"%s\" link) " a ")\n"
"#+end_src")
(org-babel-lob-ingest)))
#+end_src
6 内部用变量
#+name: 2025-07-26-09-47
#+begin_src emacs-lisp :eval no
locate expand features log
babel-variables
org-element-expanders post-process
#+end_src