【存档】Org Tangle 扩展


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