【存档】Org Tangle 扩展

Org-mode
4

特性：大纲等级调节

文档

:2025-07-26-11-04:

大纲调节。

使用: <​<@(LINK,LEVEL)>> 或 <​<@(LINK,level=LEVEL)>>

将展开后的代码片段的 Outline 等级 demote 至 LEVEL.

考虑如下两个片段：

#+name: section
#+begin_src emacs-lisp :eval no
;;; Level 1
(ignore 'section)
<<@([[id:ID::subsection]],2)>>
#+end_src

#+name: subsection
#+begin_src emacs-lisp :eval no
;;; Level 2
(ignore 'subsection)
;;;; Level 3
(ignore 'subsubsection)
#+end_src

<​<@([​[id​:ID::section]])>> 展开为：

#+begin_src emacs-lisp :eval no
;;; Level 1
(ignore 'section)
;;;; Level 2
(ignore 'subsection)
;;;;; Level 3
(ignore 'subsubsection)
#+end_src

:end:

实现

#+name: 2025-07-26-11-05
#+begin_src emacs-lisp :eval no
;; 根据 lang 调节 body 中的 outline。具体实现交由
;; `org-noweb-demote:LANG' 处理。这里只提供一个针对
;; emacs-lisp 的默认调整函数。
(!let (entry demote:emacs-lisp)
 (!def entry
  ;; 将 body 中所有 level 1 的 outline 及其子树
  ;; demote 至 level `LEVEL'.
  (lambda (body conf)
    "Outline Adjust.

<<@([[id:org-noweb-expand-link::feat-doc:outline-adjust]],rm-ws-p=1)>>"
    (or
     (when-let*
         ((_ (not (plist-get conf :failed)))
          (level (plist-get conf :level))
          (_ (> level 1))
          (lang (plist-get conf :lang))
          (major-mode
           (org-src-get-lang-mode lang))
          (demote
           (string-trim-right
            (format "org-noweb-demote:%s"
                    major-mode)
            "-mode"))
          (demote (intern demote))
          (demote
           (or (and (functionp demote) demote)
               (and
                (eq demote
                    'org-noweb-demote:emacs-lisp)
                demote:emacs-lisp))))
       (ignore-errors
         (with-temp-buffer
           (outline-mode)
           (save-excursion (insert body))
           (funcall demote level)
           (buffer-string))))
     body)))

 (!def demote:emacs-lisp
  ;; 提供一个调节 emacs-lisp outline 的默认函数。
  (lambda (level)
    (let ((outline-regexp
           ";;\\(;\\)\\{1,20\\} ")
          (outline-heading-alist
           (mapcar
            (lambda (n)
              `(,(concat
                  (make-string (+ 2 n) ?\;)
                  " ")
                . ,n))
            (number-sequence 1 20))))
      (save-excursion
        (outline-map-region
         (lambda ()
           (dotimes (_ (1- level))
             (outline-demote nil)))
         (point-min) (point-max))))))

 entry)
#+end_src

注册到整体结构中的文本片段：

#+name: 2025-07-26-11-06
#+begin_src emacs-lisp :eval no

;;; Outline Adjust
  (!let ((outline-adjust
          (make-symbol
           (concat
            "org-noweb-expand-link" ":"
            "outline-adjust"))))
   (!def outline-adjust
    <<@([[id:org-noweb-expand-link::outline-adjust]])>>)
   (entry 'add-post-process
          outline-adjust 'outline-adjust))
#+end_src