特性
链接展开
结合 Org-Babel 提供额外的引用文本块的语义：
<<@(org-link)>>
配合 ‘org-open-at-point-global’ 使用，方便打开代
码块中的 Org 链接。
"Org Noweb Extension
<<@([[id:D:org-noweb-expand-link]])>>"
(cond*
((bind* (s? (stringp link)) p))
((bind* (m (and s? (locate link))) body)
(log "expanding %s" link)
(setq conf (plist-put conf :link link)
conf (plist-put conf :ref-props
ref-properties))
(org-with-point-at m
<<@([[id:P:pre:run-hook]])>>
;; 如果展开失败，设置 :failed 及
;; :err-msg, 并将 body 置为空串。
(setq body (expand conf))))
((bind* (_ (and s? (null m))))
(plist-put conf :failed t)
(plist-put conf :err-msg
(format "failed to expand %s"
link))
(setq body ""))
(body
(org-with-point-at m
(dolist (p `(,@(plist-get conf :noweb-post)
,@(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:B:org-noweb-expand-link:cmd-set]])>>)
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)))))))
Expand
;; conf 输入输出
;; 输入: :expanders.
;; 输出: :failed, :err-msg.
"展开位于 current point 的 Org element."
(!let ((link (plist-get conf :link))
ele type expand)
(cond
;; 展开文件
((with-temp-buffer
(org-mode)
(save-excursion (insert link))
(setq link (org-element-link-parser))
(and
(equal (org-element-property :type link)
"file")
(null (org-element-property
:search-option link))))
(substring-no-properties (buffer-string)))
;; 展开 Org 元素
((ignore
(setq ele (org-element-at-point)
type (org-element-type ele)
expand (expander type))))
((and expand (expand ele conf)))
;; 未定义
(t
(plist-put conf :failed t)
(plist-put
conf :err-msg
(format "%s unsupported target %S %S"
link (current-buffer) (point)))
"")))
日志
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)))))
logging
(!def log
<<@([[id:log]])>>)
(!def log (log " log:org-noweb"))
logging default
(!def log 'message)
Org Babel接口
(with-temp-buffer
(org-mode)
(message "register org babel function: @")
(let* ((vars `((level (ignore))))
(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)))
代码块展开
;; conf 输入输出
;; 输入: :link, :ref-props.
;; 输出: :lang, :failed, :err-msg.
(cond*
((bind* (link (plist-get conf :link))
(ref-props (plist-get conf :ref-props))
(info (org-babel-get-src-block-info))
(params (nth 2 info))))
;; 如果代码块参数 `:expand' 存在且其 sexp 求值
;; 为 nil 或 "no",
((and
(assq :expand params)
(member (alist-get :expand params)
'(nil "no")))
;; 表明该代码块在当前环境下拒绝展开。
(plist-put conf :failed t)
(plist-put conf :err-msg
(format "ignore %s." link))
"")
(t
(dolist (p ref-props)
(plist-put conf p (alist-get p params)))
(plist-put conf :lang (nth 0 info))
(org-babel-expand-noweb-references info)))
动态块展开
;; conf 输入输出
;; 输入: :link.
;; 输出: :block-name, :failed, :err-msg.
(cond*
((bind* (link (plist-get conf :link))
(ref-props (plist-get conf :ref-props))
(beg (org-element-contents-begin ele))
(end (org-element-contents-end ele))
;; org-element parser 与 org.el 中
;; 的不一致，导致解析失败，所以有了这段
;; workground 代码。
(org-element-dynamic-block-open-re
org-dblock-start-re)
(ele
(save-excursion
(save-match-data
(re-search-forward
org-dblock-start-re nil t)
(forward-line 0)
(org-element-dynamic-block-parser
nil nil))))
(args (org-element-property
:arguments ele))
(args (format "'(%s)" args))
(args (eval (read args)))
(block-name
(org-element-property
:block-name ele))))
;; 如果块参数 `:expand' 存在，且其 sexp 求值
;; 为 nil 或 "no",
((and (plist-member args :expand)
(or (eq (plist-get args :expand) 'no)
(member (ignore-errors
(eval (plist-get args :expand)))
'(nil "no"))))
;; 表明该块在当前环境下拒绝展开。
(plist-put conf :failed t)
(plist-put conf :err-msg
(format "ignore %s." link))
"")
((ignore
(dolist (p ref-props)
(plist-put conf p
(eval (plist-get args p))))
(plist-put conf :block-name block-name)
(setq ele (buffer-substring beg end)
ele (string-trim ele))))
((and (plist-member args :noweb)
(or (eq (plist-get args :noweb) 'yes)
(member (ignore-errors
(eval (plist-get args :noweb)))
'(t "yes"))))
;; 不在 temp buffer 里执行，保持执行上下文。
(replace-regexp-in-string
"^\0\\(#[+]\\(begin\\|end\\)_src\\)" "\\1"
(org-babel-expand-noweb-references
(with-temp-buffer
(org-mode)
(save-excursion
(insert
"#+begin_src C "
(substring (format "%S" args) 1 -1) "\n"
(replace-regexp-in-string
"\\(^#[+]\\(begin\\|end\\)_src\\)"
"\0\\1" ele)
"\n#+end_src"))
(org-babel-get-src-block-info)))))
(t (substring-no-properties ele)))
Elisp文档格式化
将文本格式化为 elisp docstring. 转义文本中的特殊字
符，并移除文本在根节点的缩进。
使用：
将文本置于 Org Dynamic Block elisp-docstring 中。
见 Info node ‘(org)Dynamic Blocks’.
-- 特殊字符转义
将“"”转义“\"”，“\”转义“\\”，此外，在 elisp
docstring 中，字符“`”，“'”，“"”需用“\=”转义。
见 Info node ‘(elisp)Text Quoting Style’.
:escape "no" 时不进行转义。
-- 缩进移除
如片段展开的最终结果嵌套在另外的片段中，且含缩进，
移除其缩进。
考虑如下代码块：
a:
(progn
<<b>>)
b:
(def remove-indent
"Remove indent.
<<c>>")
c:
移除文本在根节点的缩进。
正常情况下，展开 a 得：
(progn
(def remove-indent
"Remove indent
移除文本在根节点的缩进。"))
受 a 缩进影响，作为 b 的 docstring, c 每行都被填
充了缩进用的空白字符。移除缩进后，可得如下结果：
(progn
(def remove-indent
"Remove indent
移除文本在根节点的缩进。"))
"Format emacs lisp docstring.
<<@([[id:D:format-elisp-docstring]])>>"
;; 依赖: elisp-doc.
(let* ((name '("elisp-docstring"
"elisp" "elispdocstring"))
(mark "org-noweb-expand-link:")
(indent "^[ \t]*")
(mark (concat mark (car name))))
(cond
;; 无 body 时当 hook 用；
((null body)
(remove-hook 'org-babel-tangle-body-hook
elisp-doc)
(goto-char (point-min))
(while (re-search-forward
(concat indent mark) nil t)
(replace-match ""))
(goto-char (point-min))
(while (re-search-forward mark nil t)
(replace-match "")))
;; 有 body 时转义特殊字符，并往所有行行首加 mark.
((and
(member (plist-get conf :block-name) name)
(not (plist-get conf :failed)))
(add-hook 'org-babel-tangle-body-hook
elisp-doc)
;; (setf body (help--docstring-quote body))
(cond
((equal (plist-get conf :escape) "no")
(setf body (string-replace
"\"" "\\\"" body)))
(t
(with-temp-buffer
(save-excursion (insert body))
(while (re-search-forward "[`'\"\\]"
nil t)
(pcase (match-string 0)
("`" (replace-match "\\\\=`" nil t))
("'" (replace-match "\\\\='" nil t))
("\"" (replace-match "\\\"" nil t))
((and "\\" (guard (looking-at-p "=")))
(replace-match "\\\\=\\\\" nil t))
("\\" (replace-match "\\\\" nil t))))
(setq body (buffer-string)))))
(string-join
(mapcar
(lambda (line) (concat mark line))
(string-split body "\n"))
"\n"))
(t body)))
条件Tangle
条件展开。
通过 :expand Header Argument 指定代码块是否在其
被引用处展开. :expand 为 nil 或 "no" 时不展开
该代码块.
考虑不同平台的键绑定配置：
#+name: android
#+header: :expand (eq system-type 'android)
#+begin_src emacs-lisp :eval no
(defkey [c i] #'open-init.el)
#+end_src
#+name: window
#+header: :expand (eq system-type 'windows-nt)
#+begin_src emacs-lisp :eval no
(defkey [C-c i] #'open-init.el)
#+end_src
#+begin_src emacs-lisp :eval no
(keymap-setting platform
<<@([[id:ID::window]])>>
<<@([[id:ID::android]])>>)
#+end_src
Window 上的展开为：
#+begin_src emacs-lisp :eval no
(keymap-setting platform
(defkey [C-c i] #'open-init.el)
)
#+end_src
Android 上的展开为（自动删除展开为空的行）：
#+begin_src emacs-lisp :eval no
(keymap-setting platform
(defkey [c i] #'open-init.el))
#+end_src
"Conditional Tangle.
<<@([[id:D:conditional-tangle]])>>"
(cond
;; process body
(body
(cond
((and
(plist-get conf :failed)
(backtrace-frame 0 'org-babel-tangle))
(add-hook 'org-babel-tangle-body-hook
cond-tangle)
(let* ((msg (plist-get conf :err-msg))
(msg (or msg "_"))
(zw-spc (char-to-string ?\u200B)))
;; 用 org-noweb-expand-link 及零宽空格界
;; 定非法字符串。
(concat zw-spc
"org-noweb-expand-link " msg
zw-spc)))
(body)))
;; org-babel-tangle-body-hook
(t
(save-excursion
(let* ((zw-spc (char-to-string ?\u200B))
(re (concat
zw-spc
"org-noweb-expand-link .*"
zw-spc))
;; if remove trailing space
(re (concat re "[ \t]*"))
(re (format
"^\\(.*?\\)\\(%s\\)\\(\n?\\)"
re)))
(save-match-data
(goto-char (point-min))
(while (re-search-forward re nil t)
(if (and (length=
(save-match-data
(string-trim
(match-string 1)))
0)
(length= (match-string 3)
1))
(replace-match "")
(replace-match "" nil nil nil 2)))))
(remove-hook 'org-babel-tangle-body-hook
cond-tangle))))
局部引用重写
D:rewrite-lref
针对 org-id-remap 映射表的局部引用重写。
将局部引用 lref 改写为 file:///path::lref.
rewrite-lref
"局部引用重写
<<@([[id:D:rewrite-lref]])>>"
(cond
((not(member
(plist-get C :rewrite-lref)
'(t yes "yes")))
B)
((setq
B (read(format"(%s)"B))
B (seq-map-indexed
(![l i]
(cond
((evenp i) l)
((with-temp-buffer
(org-mode)
(save-excursion
(setq l (string-trim l "\\[+" "\\]+"))
(insert (format "[[%s]]" l)))
(member
(org-element-property
:type (org-element-link-parser))
'("fuzzy")))
(format "file:///%s::%s"
(buffer-file-name) l))
(l)))
B))
(substring (format "%S" B) 1 -1)))
版本
1.0
;;; org-noweb-expand-link -*- lexical-binding: t; -*-
(!def 'org-noweb-expand-link
(![link &rest conf]
(setq conf (plist-put conf :link link))
(setq link (locate link))
(org-with-point-at link
(cond
((and
(org-element-type-p
(org-element-at-point) '(src-block))
link)
<<2026-02-03-13-40>>)
("")))))
(with-temp-buffer
(org-mode)
(insert
"#+name: @\n"
"#+begin_src emacs-lisp :var link=\"\" x=0\n"
"(org-noweb-expand-link (format \"%s\" link))\n"
"#+end_src")
(org-babel-lob-ingest))
2.x
描述：基于 ! 的Org文学编程引用展开重构。
废弃把：Org文学编程引用展开。
说明：如果想构建此版本，请将中的映射表设置为：。
TARGET
;;; ! org noweb -*- lexical-binding: t; -*-
(!let (org-noweb-expand-link
(:apply (! apply macro) !def org
ref-props expanders expand-link
post-processes))
:collect-symbol: !def (!(indent 1)!)
(!def org (! org)) (!def log (![...]))
(org def 'noweb (! package nil :def '!def))
(!def !def
(!"s &optional v"
`(setf ,s (org noweb def ',s ,v))))
<<@([[id:F:logging]])>>
;;;; core
(!def ref-props (! package nil))
(ref-props def 'all
;; 这里复用 ref-props 的 symbol-value
(progn
(setf (symbol-value ref-props) '(:noweb-post))
()))
(ref-props def 'add
(![p]
(setf (cdr(last(symbol-value ref-props))) `(,p))))
(!def expanders (! package nil))
(expanders def 'get
(![type] (eval `(,expanders ,type) t)))
<<@([[id:F:pre]])>>
(!def post-processes (! package nil))
(post-processes def 'all
(![] (cdr (! export all post-processes))))
(!def expand
(!let ((expander (expanders get)))
(![conf]
<<@([[id:expand]])>>)))
(!def locate
<<@([[id:locate]])>>)
;;;; expand-link
(!def expand-link
(! package
(!let ((post-process (post-processes all))
<<@([[id:E:pre]])>>
(ref-properties (symbol-value ref-props)))
(![link &rest conf]
<<@([[id:org-noweb-expand-link]])>>))))
(expand-link def 'locate locate)
)
;;;; register
(!def 'org-noweb-expand-link(! org noweb expand-link))
<<@([[id:P:register-@]])>>
;;;; features
<<@([[id:FEAT]])>>
;;;; documentation
<<@([[id:DOC]])>>
FEAT
<<@([[id:F:expand-src-block]])>>
<<@([[id:F:expand-dynamic-block]])>>
<<@([[id:F:format-elisp-docstring]])>>
<<@([[id:F:conditional-tangle]])>>
<<@([[id:F:rewrite-lref]])>>
F:expand-src-block
(!let ((!def (! org noweb expanders def)))
(!def 'src-block
(![ele conf]
<<@([[id:expand-src-block]])>>)))
F:expand-dynamic-block
(!let ((!def (! org noweb expanders def)))
(!def 'dynamic-block
(![ele conf]
<<@([[id:expand-dynamic-block]])>>)))
F:conditional-tangle
(!let ((!def (! org noweb post-processes def)))
(!def 'cond-tangle
(!let ((cond-tangle (!def 'cond-tangle)))
(![&optional body conf]
<<@([[id:conditional-tangle]])>>))))
F:elisp-docstring
(!let ((!def (! org noweb post-processes def)))
(!def 'elisp-doc
(!let ((elisp-doc (!def 'elisp-doc))(org (! org))
(:apply org ! apply macro))
(defun org-dblock-write:elisp-docstring (p)
(insert (string-trim (plist-get p :content))))
(org noweb ref-props add :escape)
(![&optional body conf]
<<@([[id:format-elisp-docstring]])>>))))
F:rewrite-lref
(!let ((!def (! org noweb post-processes def)))
(!def 'rewrite-lref
(!let ((rewrite-lref (!def 'rewrite-lref))
(org (! org)) (:apply org ! apply macro))
(org noweb ref-props add :rewrite-lref)
(![B C]
<<@([[id:rewrite-lref]])>>))))
DOC
(!let* ((org (! org)) (noweb (org noweb))
(ref-props (noweb ref-props))
(expanders (noweb expanders))
(post-processes (noweb post-processes)))
(! defdoc 'org-noweb-expand-link
"另见 " (! button noweb)" .")
(! defdoc noweb
"Org Noweb 扩展\n\n"
"当前特性集: "
(! button
(cdr (! export all expanders))
(cdr (! export all post-processes)))
"\n\n"
"另见: " (! button expanders post-processes
ref-props))
(! defdoc expanders
"Org Noweb 展开函数集\n\n"
"展开函数为签名如下的函数：\n\n"
"(![ELE CONF]BODY)\n\n"
"其中，ELE 为 ‘org-element’, CONF 为展开配置, "
"BODY 为 ELE 展开后的文本。\n\n"
"新的展开函数可通过 "
"("(! button expanders)
" def ORG-ELEMENT-TYPE)"
" 定义。\n\n"
"当前支持展开的 org elements: "
(! button
(cdr (! export all expanders))))
(! defdoc post-processes
"Org Noweb 后处理函数集\n\n"
"后处理函数为签名如下的函数：\n\n"
"(![BODY CONF]NEW-BODY)\n\n"
"其中, BODY 为 "(! button expanders)" "
"对特定的 org element 展开后得到的文本, "
"CONF 为展开配置, NEW-BODY 为对 BODY 处理后的结果。\n\n"
"新的后处理函数可通过 "
"("(! button post-processes)" def)"
" 定义。\n\n"
"当前特性集: "
(! button (cdr (! export all post-processes))))
(! defdoc ref-props
"Noweb Ref 属性集\n\n"
"当展开 noweb ref 所指的文本块时，展开函数会根据 "
"ref-props 提取文本块中对应的属性。\n\n"
"属性可通过 "(! button (ref-props add))
" 添加。\n\n"
"当前属性集: ("
(mapconcat
(![p](format "%s" p))
(funcall (ref-props all))
", ")
")")
(! defdoc (ref-props add)
"添加 noweb ref 属性 P"
"\n\n"
"P: (keywordp)")
)
MAPPING
"TARGET"
"[[2026-01-15-10-25]]"
"org-noweb-expand-link"
"[[2025-08-15-09-26]]"
"D:org-noweb-expand-link"
"[[2025-08-15-09-27]]"
"locate"
"[[2025-08-15-10-10]]"
"expand"
"[[2025-07-26-10-30]]"
"P:register-@"
"[[2025-07-26-10-32]]"
"log"
"[[2025-07-20-15-52]]"
"FEAT"
"[[2026-01-15-16-16]]"
"F:expand-src-block"
"[[2026-01-15-16-03]]"
"F:expand-dynamic-block"
"[[2026-01-15-16-04]]"
"F:conditional-tangle"
"[[2026-01-15-16-05]]"
"F:format-elisp-docstring"
"[[2026-01-15-16-06]]"
"F:rewrite-lref"
"[[2026-03-01-01-12]]"
"F:logging"
"[[2025-08-17-00-33]]"
"expand-src-block"
"[[2026-02-03-13-40]]"
"expand-dynamic-block"
"[[2025-08-16-10-39]]"
"D:conditional-tangle"
"[[2025-08-15-09-29]]"
"conditional-tangle"
"[[2025-08-15-09-28]]"
"D:format-elisp-docstring"
"[[2025-08-15-07-55]]"
"format-elisp-docstring"
"[[2025-08-15-08-23]]"
"D:rewrite-lref"
"[[2026-03-01-10-02]]"
"rewrite-lref"
"[[2026-03-01-10-04]]"
"DOC"
"[[2026-01-16-14-39]]"
构建
构建
(setq mapping (org-noweb-expand-link mapping)
mapping (read (format "(%s)" mapping)))
(cond
((and conf-only (member conf-only '(t "yes")))
(org-id-remap 'reset)
(apply 'org-id-remap mapping)
(org-id-remap 'enable)
;; return "" for expand nothing
"")
((org-with-id-remap mapping
(cond
(tangle
(org-exec target 'org-babel-tangle '(4) tangle))
((org-exec target nil :eval "yes" :results "none"
:lexical t :noweb "yes"))))))
autoload
(when (not(file-exists-p file))
(org-exec
tangle nil :eval "yes" :results "none"
:lexical t :noweb "yes" 'tangle file))
(load file)
