Org模式中的exec概念

60 阅读6分钟

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