Org模式 中有些 执行 相关的概念,现整合。
1 概述
:2025-08-02-13-55:
不同的 Org元素 具有不同的执行器,org-exec 将根
据所指元素的类型,将控制流和 args 参数转交给其他
执行器。
link 可以是一条 Org链接,还可以是用于触发命令的
symbol.
link 是 Org链接 时,支持的类型包括:
string, org-element-link, vector. 即:
(org-exec \"[[id:target]]\" ...)
(org-exec (org-element-link-parser) ...)
(org-exec [[id:target]] ...)
当 link 为 nil 时,执行当前位置的元素。
link 是 symbol 时,执行 org-exec 内部命令。 支持的命令包括:
'set-executor
(org-exec 'set-executor
ORG-ELEMENT-TYPE FUNCTION)
FUNCTION 将会被 (apply FUNCTION args).
当 executor 为 nil 时, org-exec 会使用内置
的执行器执行 link 所指元素,非 nil 时用
executor 执行。调用方式为:
(apply executor args)
:end:
2 整体结构
#+name: 2025-08-02-13-49
#+begin_src emacs-lisp :eval no
;;; org-exec -*- lexical-binding: t; -*-
(!def 'org-exec
(!let* (org-exec
;;;; private
<<@([[id:org-exec::private]])>>)
;;;; entry
(!def org-exec
<<@([[id:org-exec::entry]])>>)
;;;; locate
;; 根据给定 Org 链接, 返回其指向的位置,以
;; marker 形式。
;;
;; 输入: `link', Org 链接。
;; 输出: marker or nil.
(!def locate
<<@([[id:org-exec::locate]])>>)
<<@([[id:org-exec::builtin-executors]])>>
<<@([[id:org-exec::debug]])>>
;;;; end
(put 'org-exec 'lisp-indent-function 'defun)
org-exec))
#+end_src
3 入口
#+name: 2025-08-02-13-56
#+begin_src emacs-lisp :eval no
(lambda (&optional link executor &rest args)
"Org 执行器,执行 `link' 所指元素。
<<@([[id:org-exec::cmd-doc]],rm-ws-p=1)>>"
(interactive)
(cond
;; 我们也支持 (org-exec [[link]] ...)
;; 不过,link 的有效性受限于 elisp reader,
;; 使用时需注意。
((and (vectorp link)
(setq link (format "%S" link))
nil))
((or (stringp link)
(org-element-type-p link '(link))
(null link))
(let* ((target (when link (locate link)))
(link (when (org-element-type-p
link '(link))
(org-element-property
:raw-link link))))
(when (and link (null target))
(error "Link %s invalid." link))
(org-with-point-at target
(let* ((otype (org-element-type
(org-element-at-point)))
(exec
(or executor
(alist-get otype exec-types)
(alist-get
'default exec-types)))
ret)
(unless exec
(error
"No executor found for link %s"
link))
(when link
(message
"Executing link: %s..." link))
(run-hooks pre-exec-hook)
(unwind-protect
(save-excursion
(save-window-excursion
(setq ret (apply exec args))))
(run-hooks post-exec-hook))
ret))))
((eq link 'break) (throw 'org-exec-break t))
((eq link 'set-executor)
(setf (alist-get executor exec-types)
(car args)))
((eq link 'pre-exec-hook) pre-exec-hook)
((eq link 'post-exec-hook) post-exec-hook)
((eq link 'locate) locate)))
#+end_src
4 元素定位
#+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
5 内部变量
#+name: 2025-08-02-13-57
#+begin_src emacs-lisp :eval no
(locate (make-symbol "locate"))
exec-types exec-default
(pre-exec-hook
(make-symbol "pre-exec-hook"))
(post-exec-hook
(make-symbol "post-exec-hook"))
#+end_src
6 内置执行器
[2025-07-29 Tue 21:07]builtin-executor
#+name: 2025-08-02-13-58
#+begin_src emacs-lisp :eval no
<<@([[id:org-exec::builtin-exec-default]])>>
<<@([[id:org-exec::builtin-exec-src-block]])>>
#+end_src
6.1 代码块执行器
#+name: 2025-08-02-13-59
#+begin_src emacs-lisp :eval no
(lambda (&rest args)
;; args 应为一对一对的参数, 如果入参长度为奇数
;; 我们直接 drop 掉最后一个参数。
(when (= (% (length args) 2) 1)
(setq args (seq-subseq args 0 -1)))
(let* ((params "") header-args variables)
(mapcar
(lambda (kv)
(cond
((keywordp (car kv))
(push (format
"%S %S" (car kv) (cadr kv))
header-args))
((push (format
"%S=%S" (car kv)
(cond
((symbolp (cadr kv))
`(identity ',(cadr kv)))
(t (cadr kv))))
variables))))
(seq-partition args 2))
(when header-args
(setq params
(concat params
(string-join
(nreverse header-args)
" "))))
(when variables
(setq params
(concat params
" :var "
(string-join
(nreverse variables)
" "))))
(setq params (string-trim params))
(message "[org-exec]params: %S" params)
(org-babel-execute-src-block
nil nil
;; 因为 `org-babel-execute-src-block' 开头
;; 调用 `org-babel-get-src-block-info' 时
;; 就已经 eval 了 header args, 所以我们在这里
;; 也直接对输入 header args 求值。
(org-babel-parse-header-arguments params))))
#+end_src
特性注册
#+name: 2025-08-02-14-00
#+begin_src emacs-lisp :eval no
;;;; exec-src-block
;; 默认 Org Src Block 执行器。
(!let ((exec-src-block
(make-symbol "exec-src-block")))
(!def exec-src-block
<<@([[id:org-exec::exec-src-block]])>>)
(org-exec 'set-executor 'src-block
exec-src-block))
#+end_src
6.2 默认执行器
#+name: 2025-08-02-14-01
#+begin_src emacs-lisp :eval no
(lambda (&rest args)
(let ((buf (current-buffer)))
(message "Executing buffer %S..." buf)
(org-babel-execute-buffer)
(message
"Buffer %S evaluation complete." buf)))
#+end_src
特性注册
#+name: 2025-08-02-14-02
#+begin_src emacs-lisp :eval no
;;;; exec-default
;; 默认执行器,无合适的执行器时使用。
(!let ((exec-default
(make-symbol "exec-default")))
(!def exec-default
<<@([[id:org-exec::exec-default]])>>)
(org-exec 'set-executor 'default exec-default))
#+end_src
7 调试
#+name: 2025-08-02-14-03
#+begin_src emacs-lisp :eval no
;;;; debug & logging
;; `message' advice. 临时拦截 `message' 的部分输出。
;; 拦截 Org Babel 的执行输出,并重定向到 `org-exec' 的
;; 日志 buffer 中;拦截 \"[org-exec]\" 打头的信息,以
;; 便子类 executor 能够将日志输出到日志 buffer 中。
(!let ((msg-adv
(make-symbol
"org-exec-message-advice")))
(!def msg-adv
<<@([[id:org-exec::msg-adv]])>>)
(!def msg-adv (msg-adv " log:org-exec"))
(add-hook (org-exec 'pre-exec-hook)
(lambda ()
(unless (advice-member-p
msg-adv 'message)
(advice-add
'message :around msg-adv))))
(add-hook (org-exec 'post-exec-hook)
(lambda ()
(when (advice-member-p
msg-adv 'message)
(advice-remove
'message msg-adv)))))
#+end_src
#+name: 2025-08-02-14-04
#+begin_src emacs-lisp :eval no
(lambda (log-target)
(let ((re
(rx
;; 拦截 Org Babel 的执行输出。
;; 当然,也可能拦截了其他的东西。
(or
(regexp "^Executing .*")
(regexp ".* evaluation complete.*")
(regexp "^\\[org-exec\\].*")
(regexp
"^Evaluation of this .*code block")
(regexp
"^Code block returned no value.*")
(regexp
"^Code block produced no output.*")))))
(lambda (old-func fmt &rest args)
(let* ((msg (apply #'format-message
fmt args)))
(cond
((string-match-p re msg)
(when debug-on-error
(let* ((ts
(format-time-string
"[%Y-%m-%d %H:%M:%S.%3N]"))
(messages-buffer-name
log-target)
(message-log-max 1000000)
(msg (string-trim
msg "\\[org-exec\\]"))
(msg (concat ts msg)))
(funcall old-func msg))))
((funcall old-func msg)))))))
#+end_src
构建目标及脚本
org-exec 完整代码,用于 eval 或 tangle.
#+name: 2025-08-02-14-05
#+begin_src emacs-lisp :eval no :noweb yes
<<@([[id:org-exec::org-exec]])>>
#+end_src
构建script
#+name: 2025-08-02-14-06
#+header: :var tangle=(ignore) load=(ignore)
#+header: :var target=(ignore) map-table=(ignore)
#+begin_src emacs-lisp :results silent :eval no :lexical t
(progn
;; 指向映射表的链接集
;; (unless map-table (error "No mapping."))
(unless target (error "No target."))
(!let
((load load) (tangle tangle)
(target target)
(map-table map-table)
(setup-mapping
(lambda (map-table)
(mapc
(lambda (link)
(let* ((mapping
(org-noweb-expand-link link))
(mapping
(read
(concat "(" mapping ")"))))
(apply #'org-id-remap mapping)))
map-table)))
(do-load
(lambda (f) (load f nil nil t))))
;; 建立映射表
(setup-mapping map-table)
;; Tangle 及 Eval
(when (and (stringp tangle)
(length> tangle 0)
(not (string= tangle "no")))
(org-exec target #'org-babel-tangle
'(4) tangle))
(when (string= load "yes")
(let ((f (make-temp-file "org-tangle")))
(org-exec target #'org-babel-tangle
'(4) f)
(do-load f)))
"yes"))
#+end_src