branch: externals/org-transclusion
commit c086f248f71c1b7a1203b96017ca262657cc05ef
Merge: d0e43fa5e0 44b6372045
Author: Noboru Ota <[email protected]>
Commit: Noboru Ota <[email protected]>
Merge remote-tracking branch 'origin/feat/transient'
---
org-transclusion-font-lock.el | 25 ++-
org-transclusion-html.el | 22 ++-
org-transclusion-indent-mode.el | 27 ++-
org-transclusion-src-lines.el | 111 ++++++-----
org-transclusion-transient.el | 258 +++++++++++++++++++++++++
org-transclusion.el | 417 +++++++++++++++++++++++++---------------
test/273/test273.org | 23 +++
test/bertrand-russell.org | 168 ++++++++--------
test/test-2.0.org | 75 +++++++-
test/things-at-point.org | 9 +-
10 files changed, 828 insertions(+), 307 deletions(-)
diff --git a/org-transclusion-font-lock.el b/org-transclusion-font-lock.el
index 912c1a81fa..8c4b6d1a83 100644
--- a/org-transclusion-font-lock.el
+++ b/org-transclusion-font-lock.el
@@ -1,6 +1,6 @@
;;; org-transclusion-font-lock.el --- font-lock for Org-transclusion -*-
lexical-binding: t; -*-
-;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; This program is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
@@ -17,7 +17,7 @@
;; Author: Noboru Ota <[email protected]>
;; Created: 22 August 2021
-;; Last modified: 21 January 2024
+;; Last modified: 02 January 2025
;;; Commentary:
;; This file is part of Org-transclusion
@@ -26,7 +26,26 @@
;;; Code:
(require 'org)
-(add-hook 'org-font-lock-set-keywords-hook #'org-transclusion-font-lock-set)
+(require 'org-transclusion)
+
+;;;###autoload
+(define-minor-mode org-transclusion-font-lock-mode ()
+ :lighter nil
+ :global t
+ :group 'org-transclusion
+ (if org-transclusion-font-lock-mode
+ (org-transclusion-extension-functions-add-or-remove
+ org-transclusion-font-lock-extension-functions)
+ (org-transclusion-extension-functions-add-or-remove
+ org-transclusion-font-lock-extension-functions :remove)))
+
+(defvar org-transclusion-font-lock-extension-functions
+ (list (cons 'org-font-lock-set-keywords-hook
#'org-transclusion-font-lock-set))
+ "Alist of functions to activate `org-transclusion-font-lock'.
+CAR of each cons cell is a symbol name of an abnormal hook
+\(*-functions\). CDR is either a symbol or list of symbols, which
+are names of functions to be called in the corresponding abnormal
+hook.")
(defface org-transclusion-keyword
'((((class color) (min-colors 88) (background light))
diff --git a/org-transclusion-html.el b/org-transclusion-html.el
index 09a0b7fef0..17f952f972 100644
--- a/org-transclusion-html.el
+++ b/org-transclusion-html.el
@@ -1,6 +1,6 @@
;;; org-transclusion-html.el --- Converting HTML content to Org -*-
lexical-binding: t; -*-
-;; Copyright (C) 2024 Free Software Foundation, Inc.
+;; Copyright (C) 2024-2025 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Affero General Public License
@@ -31,6 +31,7 @@
;;;; Requirements
+(require 'org-transclusion)
(require 'org)
(require 'org-element)
(require 'cl-lib)
@@ -39,7 +40,24 @@
;;;; Hook into org-transclusion
-(add-hook 'org-transclusion-add-functions #'org-transclusion-html-add-file)
+;;;###autoload
+(define-minor-mode org-transclusion-html-mode ()
+ :lighter nil
+ :global t
+ :group 'org-transclusion
+ (if org-transclusion-html-mode
+ (org-transclusion-extension-functions-add-or-remove
+ org-transclusion-html-extension-functions)
+ (org-transclusion-extension-functions-add-or-remove
+ org-transclusion-html-extension-functions :remove)))
+
+(defvar org-transclusion-html-extension-functions
+ (list (cons 'org-transclusion-add-functions
#'org-transclusion-html-add-file))
+ "Alist of functions to activate `org-transclusion-html'.
+CAR of each cons cell is a symbol name of an abnormal hook
+\(*-functions\). CDR is either a symbol or list of symbols, which
+are names of functions to be called in the corresponding abnormal
+hook.")
;;;; Functions
diff --git a/org-transclusion-indent-mode.el b/org-transclusion-indent-mode.el
index 532439bfd3..d28c8828db 100644
--- a/org-transclusion-indent-mode.el
+++ b/org-transclusion-indent-mode.el
@@ -1,6 +1,6 @@
;;; org-transclusion-indent-mode.el --- support org-indent-mode -*-
lexical-binding: t; -*-
-;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; This program is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
@@ -17,7 +17,7 @@
;; Author: Noboru Ota <[email protected]>
;; Created: 22 August 2021
-;; Last modified: 21 January 2024
+;; Last modified: 18 December 2025
;;; Commentary:
;; This file is part of Org-transclusion
@@ -34,6 +34,7 @@
;;; Code:
+(require 'org-transclusion)
(require 'org-indent)
;;;; Variables
@@ -251,10 +252,11 @@ are removed."
:group 'org-transclusion
(if org-transclusion-indent-mode
(progn
+ (org-transclusion-extension-functions-add-or-remove
+ org-transclusion-indent-extension-functions)
;; Install hooks for source buffer fringe preservation
(add-hook 'after-change-functions
#'org-transclusion-indent--after-change nil t)
-
;; Register with org-indent or wait for it
(cond
;; Already initialized before, just toggle
@@ -268,6 +270,8 @@ are removed."
(t (org-transclusion-indent--wait-and-init (current-buffer)))))
;; Cleanup
+ (org-transclusion-extension-functions-add-or-remove
+ org-transclusion-indent-extension-functions :remove)
(remove-hook 'after-change-functions
#'org-transclusion-indent--after-change t)
(when (boundp 'org-indent-post-buffer-init-functions)
@@ -294,12 +298,17 @@ Adds `post-command-hook' to detect when source overlays
appear."
;; Auto-setup in org-mode buffers - add late to hook like org-modern-indent
(add-hook 'org-mode-hook #'org-transclusion-indent-mode-setup 90)
-;;;; Hook Registration
-
-(add-hook 'org-transclusion-after-add-functions
- #'org-transclusion-indent--add-properties-and-fringes)
-(add-hook 'org-transclusion-after-remove-functions
- #'org-transclusion-indent--refresh-source-region)
+(defvar org-transclusion-indent-extension-functions
+ (list
+ (cons 'org-transclusion-after-add-functions
+ #'org-transclusion-indent--add-properties-and-fringes)
+ (cons 'org-transclusion-after-remove-functions
+ #'org-transclusion-indent--refresh-source-region))
+ "Alist of functions to activate `org-transclusion-indent-mode'.
+CAR of each cons cell is a symbol name of an abnormal hook
+\(*-functions\). CDR is either a symbol or list of symbols, which
+are names of functions to be called in the corresponding abnormal
+hook.")
(provide 'org-transclusion-indent-mode)
diff --git a/org-transclusion-src-lines.el b/org-transclusion-src-lines.el
index 6059206a14..66d82100d0 100644
--- a/org-transclusion-src-lines.el
+++ b/org-transclusion-src-lines.el
@@ -1,6 +1,6 @@
;;; org-transclusion-src-lines.el --- Extension -*- lexical-binding: t; -*-
-;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; This program is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
@@ -17,7 +17,7 @@
;; Author: Noboru Ota <[email protected]>
;; Created: 24 May 2021
-;; Last modified: 27 December 2024
+;; Last modified: 18 December 2025
;;; Commentary:
;; This is an extension to `org-transclusion'. When active, it adds features
@@ -25,6 +25,7 @@
;;; Code:
+(require 'org-transclusion)
(require 'org-element)
(declare-function text-clone-make-overlay "text-clone")
(declare-function org-transclusion-live-sync-buffers-others-default
@@ -34,36 +35,46 @@
;;;; Setting up the extension
-;; Add a new transclusion type
-(add-hook 'org-transclusion-add-functions
- #'org-transclusion-add-src-lines)
-;; Keyword values
-(add-hook 'org-transclusion-keyword-value-functions
- #'org-transclusion-keyword-value-lines)
-(add-hook 'org-transclusion-keyword-value-functions
- #'org-transclusion-keyword-value-src)
-(add-hook 'org-transclusion-keyword-value-functions
- #'org-transclusion-keyword-value-rest)
-(add-hook 'org-transclusion-keyword-value-functions
- #'org-transclusion-keyword-value-end)
-(add-hook 'org-transclusion-keyword-value-functions
- #'org-transclusion-keyword-value-noweb-chunk)
-(add-hook 'org-transclusion-keyword-value-functions
- #'org-transclusion-keyword-value-thing-at-point)
-;; plist back to string
-(add-hook 'org-transclusion-keyword-plist-to-string-functions
- #'org-transclusion-keyword-plist-to-string-src-lines)
-
-;; Transclusion content formatting
-(add-hook 'org-transclusion-content-format-functions
- #'org-transclusion-content-format-src-lines)
-
-;; Open source buffer
-(add-hook 'org-transclusion-open-source-marker-functions
- #'org-transclusion-open-source-marker-src-lines)
-;; Live-sync
-(add-hook 'org-transclusion-live-sync-buffers-functions
- #'org-transclusion-live-sync-buffers-src-lines)
+;;;###autoload
+(define-minor-mode org-transclusion-src-lines-mode ()
+ :lighter nil
+ :global t
+ :group 'org-transclusion
+ (if org-transclusion-src-lines-mode
+ (org-transclusion-extension-functions-add-or-remove
+ org-transclusion-src-lines-extension-functions)
+ (org-transclusion-extension-functions-add-or-remove
+ org-transclusion-src-lines-extension-functions :remove)))
+
+(defvar org-transclusion-src-lines-extension-functions
+ (list
+ ;; Add a new transclusion type
+ (cons 'org-transclusion-add-functions #'org-transclusion-add-src-lines)
+ ;; Keyword values
+ (cons 'org-transclusion-keyword-value-functions
+ '(org-transclusion-keyword-value-lines
+ org-transclusion-keyword-value-src
+ org-transclusion-keyword-value-rest
+ org-transclusion-keyword-value-end
+ org-transclusion-keyword-value-noweb-chunk
+ org-transclusion-keyword-value-thing-at-point))
+ ;; plist back to string
+ (cons 'org-transclusion-keyword-plist-to-string-functions
+ #'org-transclusion-keyword-plist-to-string-src-lines)
+ ;; Transclusion content formatting
+ (cons 'org-transclusion-content-format-functions
+ #'org-transclusion-content-format-src-lines)
+ ;; Open source buffer
+ (cons 'org-transclusion-open-source-marker-functions
+ #'org-transclusion-open-source-marker-src-lines)
+ ;; Live-sync
+ (cons 'org-transclusion-live-sync-buffers-functions
+ #'org-transclusion-live-sync-buffers-src-lines))
+ "Alist of functions to activate `org-transclusion-src-lines'.
+CAR of each cons cell is a symbol name of an abnormal hook
+\(*-functions\). CDR is either a symbol or list of symbols, which
+are names of functions to be called in the corresponding abnormal
+hook.")
;;; Functions
@@ -129,7 +140,7 @@ it means from line 10 to the end of file."
(entry-pos) (buf)
(lines (plist-get plist :lines))
(end-search-op (plist-get plist :end))
- (noweb-chunk (plist-get plist :noweb-chunk))
+ (noweb-chunk (plist-get plist :noweb-chunk))
(thing-at-point (plist-get plist :thing-at-point))
(thing-at-point (when thing-at-point
(make-symbol (cadr (split-string
thing-at-point))))))
@@ -144,14 +155,14 @@ it means from line 10 to the end of file."
(entry-pos)
((when search-option
(save-excursion
- (if noweb-chunk
-
(org-transclusion--goto-noweb-chunk-beginning search-option)
+ (if noweb-chunk
+
(org-transclusion--goto-noweb-chunk-beginning search-option)
(ignore-errors
;; FIXME `org-link-search' does not
;; return position when eithher
;; ::/regex/ or ::number is used
(if (org-link-search search-option)
- (line-beginning-position)))))))
+ (line-beginning-position)))))))
((point-min))))
(bounds (when thing-at-point
(let ((count (if end-search-op
@@ -169,10 +180,10 @@ it means from line 10 to the end of file."
;; or ::number is used
(when (org-link-search end-search-op)
(line-beginning-position))))))
- ((when noweb-chunk
- (goto-char (1+ start-pos))
- (org-transclusion--goto-noweb-chunk-end)
- (point)))))
+ ((when noweb-chunk
+ (goto-char (1+ start-pos))
+ (org-transclusion--goto-noweb-chunk-end)
+ (point)))))
(range (when lines (split-string lines "-")))
(lbeg (if range (string-to-number (car range))
0))
@@ -187,9 +198,9 @@ it means from line 10 to the end of file."
;;; This `cond' means :end prop has priority over the end
;;; position of the range. They don't mix.
(end (cond
- ((when noweb-chunk
- (org-transclusion--goto-noweb-chunk-:lines-end
start-pos end-pos lend)
- (point)))
+ ((when noweb-chunk
+ (org-transclusion--goto-noweb-chunk-:lines-end
start-pos end-pos lend)
+ (point)))
((when thing-at-point end-pos))
((when (and end-pos (> end-pos beg))
end-pos))
@@ -219,8 +230,8 @@ POINT shall be inside the current chunk."
;; or the beginning of the next code chunk ("<<.*>>=").
(if (re-search-forward "^\\(?:[[:blank:]]*\n\\)*\\(?:@\\|<<.*?>>=\\)" nil t)
(progn
- (goto-char (match-beginning 0))
- (line-beginning-position))
+ (goto-char (match-beginning 0))
+ (line-beginning-position))
;; Else the chunk ends at the end of the buffer.
(when (re-search-forward "\\(?:[[:blank:]\n]*\\)*\\'" nil t)
(goto-char (match-beginning 0)))))
@@ -234,7 +245,7 @@ LEND is the end line of the `:lines' range."
(goto-char start-pos)
(forward-line lend)
(when (> (point) end-pos)
- (goto-char end-pos))))
+ (goto-char end-pos))))
(defun org-transclusion-content-src-lines (link plist)
"Return a list of payload from LINK and PLIST in a src-block.
@@ -311,7 +322,7 @@ abnormal hook
(src (plist-get plist :src))
(rest (plist-get plist :rest))
(end (plist-get plist :end))
- (noweb-chunk (plist-get plist :noweb-chunk))
+ (noweb-chunk (plist-get plist :noweb-chunk))
(thing-at-point (plist-get plist :thing-at-point)))
(concat
(when noweb-chunk ":noweb-chunk")
@@ -367,16 +378,16 @@ match any valid elisp symbol (but please don't quote it)."
(when (string-match "\\(:thing-at-point\\|:thingatpt\\)
\\([[:alnum:][:punct:]]+\\)" string)
(list :thing-at-point (org-strip-quotes (match-string 0 string)))))
-(defun org-transclusion-content-format-src-lines (type content indent)
+(defun org-transclusion-content-format-src-lines (type content keyword-values)
"Format text CONTENT from source before transcluding.
Return content modified (or unmodified, if not applicable).
This is the default one. It only returns the content as is.
-INDENT is the number of current indentation of the #+transclude."
+KEYWORD-VALUES is a plist of transclusion properties."
(when (org-transclusion-src-lines-p type)
(let ((content (org-transclusion-ensure-newline content)))
- (org-transclusion-content-format type content indent))))
+ (org-transclusion-content-format type content keyword-values))))
(defun org-transclusion-ensure-newline (str)
(if (not (string-suffix-p "\n" str))
diff --git a/org-transclusion-transient.el b/org-transclusion-transient.el
new file mode 100644
index 0000000000..636ce71f75
--- /dev/null
+++ b/org-transclusion-transient.el
@@ -0,0 +1,258 @@
+;; -*- lexical-binding: t; -*-
+
+;; https://github.com/nobiot/org-transclusion/issues/169
+
+(require 'org-transclusion)
+(require 'transient) ; Need more recent than that comes with 29.4; tested on
+ ; transient-20241224.2234
+
+;; Utilities
+
+(defmacro hydra-org-transclusion--detect-transclude-at-point-wrapper (body)
+ `(let ((line-text (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position)))
+ (position (point))
+ (end-of-line (line-end-position)))
+ (if (string-match-p "#\\+transclude:" line-text)
+ (save-excursion
+ (unless (eq position end-of-line) (end-of-line))
+ (insert " ")
+ ,body
+ (pulse-momentary-highlight-region end-of-line (line-end-position)
+ 'pulse-highlight-start-face))
+ (user-error "You'r not on #+transclude: [[link]] line."))))
+
+(defun org-transclusion--transient-read-level (&rest _)
+ "Read a string from the minibuffer, restricted to the range 1 to 9 or an
empty value."
+ (cl-loop for result =
+ (read-string "Enter org-transclusion content headline\
+level (1-9) or leave empty: ")
+ if (or (string= result "")
+ (string-match-p "^[1-9]$" result))
+ return result
+ else do (progn
+ (message "Invalid input. Number 1-9 or leave empty")
+ (sit-for 1))))
+
+(defun org-transclusion--transient-read-lines (&rest _)
+ "Read a string from the minibuffer, restricted to eg 5-10, 6-, -6."
+ (cl-loop for result =
+ (read-string "Enter :lines option values (eg 5-10, 6-, -6): ")
+ if (string-match-p "\"?[0-9]*-[0-9]*\"?" result)
+ return result
+ else do (progn
+ (message "Invalid input. The format must be eg 5-10, 6-,
-6")
+ (sit-for 1))))
+
+;; You can add `org-roam-node-insert' as an example.
+(defvar org-transclusion-insert-link-functions '(org-insert-link))
+
+(defun org-transclusion-insert-org-link ()
+ (let ((function (if (length> org-transclusion-insert-link-functions 1)
+ (intern (completing-read
+ "Choose a function: "
+ org-transclusion-insert-link-functions))
+ (car org-transclusion-insert-link-functions))))
+ (when function
+ (with-temp-buffer
+ (funcall function)
+ (buffer-string)))))
+
+(defun org-transclusion-insert-from-link (&optional insert-below)
+ "Insert #+TRANSCLUDE: keyword from a link.
+If you pass a `universal-argument' via \\[universal-argument]
+ \(INSERT-BELOW is non-nil\), the keyword is added to the line
+ below current one. Otherwise, to the line above."
+ (interactive "P")
+ (let* ((link-elem-at-pt
+ (or (org-element-lineage (org-element-context) 'link t) ; at-point
+ ;; if not at-point, find the first one in the current line
+ (save-excursion
+ (beginning-of-line)
+ (re-search-forward org-link-bracket-re (line-end-position) t)
+ (org-element-lineage (org-element-context) 'link t))))
+ (blank-line-p (save-excursion
+ (beginning-of-line)
+ (looking-at-p "^[ \t]*$")))
+ (link-string (cond
+ (link-elem-at-pt
+ (buffer-substring (org-element-begin link-elem-at-pt)
+ (org-element-end link-elem-at-pt)))
+ (blank-line-p
+ (org-transclusion-insert-org-link)))))
+ (when link-string
+ ;; When the current line is not blank, open a line above or below the
+ ;; current.
+ (unless blank-line-p
+ (when insert-below (progn (forward-line 1) (unless (bolp) (insert
"\n"))))
+ (beginning-of-line)
+ (open-line 1))
+ (insert (format "#+transclude: %s" link-string))
+ (beginning-of-line)
+ (pulse-momentary-highlight-region
+ (point) (line-end-position) 'pulse-highlight-start-face))))
+
+(transient-define-prefix org-transclusion--buffer-transient ()
+ "Prefix that waves at the user"
+ [[:description "Add/Remove"
+ ("a" "Add at point"
+ org-transclusion-add
+ :transient transient--do-return)
+ ("A" "Add all in buffer" org-transclusion-add-all)
+ ("R" "Remove all in buffer" org-transclusion-remove-all)]
+ [:description "Options for #+TRANSCLUDE keyword"
+ (:info "Select options. Keep adding")
+ ("i" "insert from link at point or current line"
+ org-transclusion-transient--insert
+ :inapt-if org-transclusion-at-keyword-p)
+ ("l" "level" org-transclusion-transient--level
+ :inapt-if-not org-transclusion-at-keyword-p)
+ ("o" "only-contents"
org-transclusion-transient--only-contents
+ :inapt-if-not org-transclusion-at-keyword-p)
+ ("ex" "exclude-elements"
+ org-transclusion-transient--exclude-elements
+ :inapt-if-not org-transclusion-at-keyword-p)
+ ("el" "expand-links" org-transclusion-transient--expand-links
+ :inapt-if-not org-transclusion-at-keyword-p)]
+ [:description "Addiitonal options: :src and :lines"
+ ;; TODO check the extension to be active
+ :inapt-if-not org-transclusion-at-keyword-p
+ (:info "For extension src-lines")
+ ("ss" "src"
+ org-transclusion-transient--src
+ :inapt-if-not org-transclusion-at-keyword-p)
+ ("sr" "rest"
+ org-transclusion-transient--rest
+ :inapt-if-not org-transclusion-at-keyword-p)
+ ""
+ ("sl" "lines (eg 3-5, 6-, -6)"
+ org-transclusion-transient--lines
+ :inapt-if-not org-transclusion-at-keyword-p)
+ ("sl" "end"
+ org-transclusion-transient--end
+ :inapt-if-not org-transclusion-at-keyword-p)
+ ("st" "thing-at-point"
+ org-transclusion-transient--thingatpt
+ :inapt-if-not org-transclusion-at-keyword-p)]]
+ [:description "Setting"
+ (:info ".")
+ ("-m" "Show more" test/set-level)
+ ("-l" "show less" test/set-level-less)])
+
+(transient-define-suffix test/set-level ()
+ :transient t
+ (interactive)
+ (transient-set-level 'org-transclusion--buffer-transient
+ 4)
+ (org-transclusion-transient-menu))
+
+(transient-define-suffix test/set-level-less ()
+ :transient t
+ (interactive)
+ (transient-set-level 'org-transclusion--buffer-transient
+ 3)
+ (org-transclusion-transient-menu))
+
+(transient-define-prefix org-transclusion--at-point-transient ()
+ "Prefix that waves at the user"
+ [:description
+ "Operation on Transclusion at Point"
+ [:description "Remove"
+ ("r" "Remove at point" org-transclusion-remove)
+ ("d" "Detach at point" org-transclusion-detach)
+ ("R" "Remove all in buffer" org-transclusion-remove-all)]
+ [:description "Other at-point functions"
+ ("P" "Promote" org-transclusion-promote-subtree)
+ ("D" "Demote" org-transclusion-demote-subtree)
+ ("o" "Open the source buffer" org-transclusion-open-source)
+ ("O" "Move to the source buffer"
org-transclusion-move-to-source)]]
+ [:description ""
+ (:info ".")])
+
+(transient-define-suffix org-transclusion-transient--insert ()
+ :transient 'transient--do-return
+ (interactive)
+ (org-transclusion-insert-from-link)
+ (org-transclusion--buffer-transient))
+
+(transient-define-suffix org-transclusion-transient--level ()
+ :transient 'transient--do-stay
+ (interactive)
+ (let ((level-string (org-transclusion--transient-read-level)))
+ (hydra-org-transclusion--detect-transclude-at-point-wrapper
+ (insert (if (string-empty-p level-string)
+ ":level"
+ (format ":level %s" level-string))))))
+
+(transient-define-suffix org-transclusion-transient--only-contents ()
+ :transient 'transient--do-stay
+ (interactive)
+ (hydra-org-transclusion--detect-transclude-at-point-wrapper
+ (insert ":only-contents")))
+
+(transient-define-suffix org-transclusion-transient--expand-links ()
+ :transient 'transient--do-stay
+ (interactive)
+ (hydra-org-transclusion--detect-transclude-at-point-wrapper
+ (insert ":expand-links")))
+
+(transient-define-suffix org-transclusion-transient--exclude-elements ()
+ :transient 'transient--do-stay
+ (interactive)
+ (and-let* ((list-elements (completing-read-multiple
+ "Select elements to exclude: "
+ org-element-all-elements))
+ (elements-string (mapconcat #'identity list-elements "\s")))
+ (hydra-org-transclusion--detect-transclude-at-point-wrapper
+ (insert (format ":exclude-elements %S" elements-string)))))
+
+(transient-define-suffix org-transclusion-transient--src ()
+ :transient 'transient--do-stay
+ (interactive)
+ (let ((string (read-string "Enter language for :src option: ")))
+ (when string
+ (hydra-org-transclusion--detect-transclude-at-point-wrapper
+ (insert (format ":src %s" string))))))
+
+(transient-define-suffix org-transclusion-transient--rest ()
+ :transient 'transient--do-stay
+ (interactive)
+ (let ((string (read-string "Enter :rest option values: ")))
+ (when string
+ (hydra-org-transclusion--detect-transclude-at-point-wrapper
+ (insert (format ":rest %S" string))))))
+
+(transient-define-suffix org-transclusion-transient--lines ()
+ :transient 'transient--do-stay
+ (interactive)
+ (let ((string (org-transclusion--transient-read-lines)))
+ (when string
+ (hydra-org-transclusion--detect-transclude-at-point-wrapper
+ (insert (format ":lines %s" string))))))
+
+(transient-define-suffix org-transclusion-transient--end ()
+ :transient 'transient--do-stay
+ (interactive)
+ (let ((string (read-string "Enter :end option value: ")))
+ (when string
+ (hydra-org-transclusion--detect-transclude-at-point-wrapper
+ (insert (format ":end %S" string))))))
+
+(transient-define-suffix org-transclusion-transient--thingatpt ()
+ :transient 'transient--do-stay
+ (interactive)
+ (let ((string (completing-read "Enter :thingatpt option value: "
+ '("sentence" "paragraph" "defun" "sexp"))))
+ (when string
+ (hydra-org-transclusion--detect-transclude-at-point-wrapper
+ (insert (format ":thingatpt %s" string))))))
+
+;;;###autoload
+(defun org-transclusion-transient-menu ()
+ (interactive)
+ (unless (derived-mode-p 'org-mode)
+ (user-error "`org-transclusion' works only in `org' buffer"))
+ (let ((org-transclusion-buffer (current-buffer)))
+ (if (org-transclusion-within-transclusion-p)
+ (org-transclusion--at-point-transient)
+ (org-transclusion--buffer-transient))))
diff --git a/org-transclusion.el b/org-transclusion.el
index 6a922477d1..a2de117d65 100644
--- a/org-transclusion.el
+++ b/org-transclusion.el
@@ -1,6 +1,6 @@
;;; org-transclusion.el --- Transclude text content via links -*-
lexical-binding: t; -*-
-;; Copyright (C) 2021-2024 Free Software Foundation, Inc.
+;; Copyright (C) 2021-2025 Free Software Foundation, Inc.
;; This program is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the
@@ -17,7 +17,7 @@
;; Author: Noboru Ota <[email protected]>
;; Created: 10 October 2020
-;; Last modified: 01 January 2025
+;; Last modified: 18 December 2025
;; URL: https://github.com/nobiot/org-transclusion
;; Keywords: org-mode, transclusion, writing
@@ -231,7 +231,8 @@ the \\+`link', \\+`keyword-plist', and \\+`copy'
arguments.")
org-transclusion-keyword-value-only-contents
org-transclusion-keyword-value-exclude-elements
org-transclusion-keyword-value-expand-links
- org-transclusion-keyword-current-indentation)
+ org-transclusion-keyword-current-indentation
+ org-transclusion-keyword-value-no-first-heading)
"Define a list of functions used to parse a #+transclude keyword.
These functions take a single argument, the whole keyword value
as a string. Each function retrieves a property with using a
@@ -390,7 +391,7 @@ function automatically puts the :level property to the
resultant
transclusion keyword."
(interactive "P")
(let* ((context (org-element-lineage
- (org-element-context)'(link) t))
+ (org-element-context) '(link) t))
(auto-transclude-p (if (or (not arg) (numberp arg))
org-transclusion-mode
;; if `universal-argument' is passed,
@@ -459,54 +460,44 @@ does not support all the elements.
(let* ((keyword-plist (org-transclusion-keyword-string-to-plist))
(link (org-transclusion-wrap-path-to-link
(plist-get keyword-plist :link)))
+ ;; Note 2025-01-03 Retrospectively, PAYLOAD feels redundant now that
+ ;; `org-transclusion-add' is being refactored. For
+ ;; backword-compatibility, I am keeping PAYLOAD.
(payload (run-hook-with-args-until-success
- 'org-transclusion-add-functions link keyword-plist)))
- (if (functionp payload)
- ;; Allow for asynchronous transclusion
- (funcall payload link keyword-plist copy)
- (org-transclusion-add-payload payload link keyword-plist copy)))))
-
-(defun org-transclusion-add-payload (payload link keyword-plist copy)
- "Insert transcluded content with error handling.
-
-PAYLOAD should be a plist according to the description in
-`org-transclusion-add-functions'. LINK should be an org-element
-context object for the link. KEYWORD-PLIST should contain the
-\"#+transclude:\" keywords for the transclusion at point. With
-non-nil COPY, copy the transcluded content into the buffer.
-
-This function is intended to be called from within
-`org-transclusion-add' as well as payload functions returned by
-hooks in `org-transclusion-add-functions'."
- (let ((tc-type (plist-get payload :tc-type))
- (src-buf (plist-get payload :src-buf))
- (src-beg (plist-get payload :src-beg))
- (src-end (plist-get payload :src-end))
- (src-content (plist-get payload :src-content)))
- (if (or (string= src-content "")
- (eq src-content nil))
- ;; Keep going with program when no content `org-transclusion-add-all'
- ;; should move to the next transclusion
- (prog1 nil
- (message
- "No content found with \"%s\". Check the link at point %d, line %d"
- (org-element-property :raw-link link) (point) (org-current-line)))
- (let ((beg (line-beginning-position))
- (end))
- (org-transclusion-with-inhibit-read-only
- (when (save-excursion
- (end-of-line) (insert-char ?\n)
- (org-transclusion-content-insert
- keyword-plist tc-type src-content
- src-buf src-beg src-end copy)
- (unless (eobp) (delete-char 1))
- (setq end (point))
- t)
- ;; `org-transclusion-keyword-remove' checks element at point is a
- ;; keyword or not
- (org-transclusion-keyword-remove)))
- (run-hook-with-args 'org-transclusion-after-add-functions beg end))
- t)))
+ 'org-transclusion-add-functions link keyword-plist))
+ (tc-type (plist-get payload :tc-type))
+ (content (plist-get payload :src-content))
+ (keyword-plist (if (org-transclusion-type-is-org tc-type)
+ (plist-put
+ keyword-plist :current-level
+ (or (org-current-level) 0))
+ keyword-plist))
+ (content
+ (run-hook-with-args-until-success
+ 'org-transclusion-content-format-functions
+ tc-type content keyword-plist)))
+ (if (or (string-empty-p content)
+ (eq content nil))
+ ;; Keep going with program when no content `org-transclusion-add-all'
+ ;; should move to the next transclusion
+ (prog1 nil
+ (message
+ "No content found with \"%s\". Check the link at point %d, line
%d"
+ (org-element-property :raw-link link)
+ (point) (org-current-line)))
+ (pcase-let ((`(,beg . ,end) (org-transclusion-content-insert content)))
+ (when (and beg end)
+ (unless copy
+ (org-transclusion-content-add-text-props-and-overlay
+ payload keyword-plist beg end))
+ (run-hook-with-args 'org-transclusion-after-add-functions
+ beg end)))
+
+ ;; (if (functionp payload)
+ ;; ;; Allow for asynchronous transclusion
+ ;; (funcall payload link keyword-plist copy)
+ ;; (org-transclusion-add-payload payload link keyword-plist copy)
+ ))))
;;;###autoload
(defun org-transclusion-add-all (&optional narrowed)
@@ -756,9 +747,9 @@ the state before live-sync started."
(user-error "Not within a transclusion in live-sync")
(text-clone-delete-overlays)
(let* ((src-ov (car (org-transclusion-live-sync-buffers)))
- (src-buf (overlay-buffer src-ov)))
+ (src-buf (overlay-buffer src-ov)))
(with-current-buffer src-buf
- (org-element-cache-reset)))
+ (org-element-cache-reset)))
;; Re-activate hooks inactive during live-sync
(org-transclusion-activate)
(org-transclusion-refresh)
@@ -869,9 +860,10 @@ It needs to be set in
It is meant to be used by `org-transclusion-get-string-to-plist'.
It needs to be set in
`org-transclusion-keyword-value-functions'."
- (when (string-match ":level *\\([1-9]\\)" string)
- (list :level
- (string-to-number (org-strip-quotes (match-string 1 string))))))
+ (and-let* ((_ (string-match ":level *\\([1-9]?\\)" string))
+ (match (match-string 1 string))
+ (val (if (string-empty-p match) "auto" (string-to-number match))))
+ (list :level val)))
(defun org-transclusion-keyword-value-only-contents (string)
"It is a utility function used converting a keyword STRING to plist.
@@ -908,6 +900,14 @@ It needs to be set in
(list :expand-links
(org-strip-quotes (match-string 0 string)))))
+(defun org-transclusion-keyword-value-no-first-heading (string)
+ "It is a utility function used converting a keyword STRING to plist.
+It is meant to be used by `org-transclusion-get-string-to-plist'.
+It needs to be set in
+`org-transclusion-keyword-value-functions'."
+ (when (string-match ":no-first-heading" string)
+ (list :no-first-heading (org-strip-quotes (match-string 0 string)))))
+
(defun org-transclusion-keyword-remove ()
"Remove the keyword element at point.
Returns t if successful. It checks if the element at point is a
@@ -931,6 +931,7 @@ keyword. If not, returns nil."
(only-contents (plist-get plist :only-contents))
(exclude-elements (plist-get plist :exclude-elements))
(expand-links (plist-get plist :expand-links))
+ (no-first-heading (plist-get plist :no-first-heading))
(custom-properties-string nil))
(setq custom-properties-string
(dolist (fn org-transclusion-keyword-plist-to-string-functions
@@ -941,12 +942,15 @@ keyword. If not, returns nil."
(concat custom-properties-string " " str ))))))
(concat "#+transclude: "
link
- (when level (format " :level %d" level))
+ (when level (if (and (stringp level) (string= level "auto"))
+ " :level "
+ (format " :level %d" level)))
(when disable-auto (format " :disable-auto"))
(when only-contents (format " :only-contents"))
(when exclude-elements (format " :exclude-elements \"%s\""
exclude-elements))
(when expand-links (format " :expand-links"))
+ (when no-first-heading (format " :no-first-heading"))
custom-properties-string
"\n")))
@@ -967,47 +971,136 @@ inserted when more than one space is inserted between
symbols."
;;-----------------------------------------------------------------------------
;;;; Add-at-point functions
+
+(defun org-transclusion-add-target-marker (link)
+ "Return the marker of transclusion target by opening LINK.
+LINK must be Org's link object that `org-link-open' can act on. As long
+as `org-link-open' opens a buffer within Emacs, this function should
+return a marker."
+ ;; Assume the point now is the transcluding buffer
+ (let ((cur-buf (current-buffer))
+ (cur-marker (move-marker (make-marker) (line-beginning-position))))
+ ;; Note 2025-12-18 `org-link-open' does not necessarily obey
+ ;; `display-buffer-alist' and can open the target buffer in the currently
+ ;; selected window. This is disruptive for users. We want transclusions to
+ ;; keep the current buffer in the current window. To do this, it seems
+ ;; `save-window-excursion' is the only way.
+ (save-window-excursion
+ ;; This `save-excursion' is needed for the case where the target and
+ ;; source are the same buffer.
+ (save-excursion
+ ;; Don't ever prompt to create a headline when transcluding.
+ ;; t is a less surprising default than nil - fuzzy search.
+ (let ((org-link-search-must-match-exact-headline t))
+ (condition-case nil
+ (progn
+ (org-link-open link)
+ ;; In the target buffer temporarily.
+ (save-excursion
+ (move-marker (make-marker) (point))))
+ (error (user-error
+ "Org-transclusion: `org-link-open' cannot open link, %s"
+ (org-element-property :raw-link link)))))))))
+
(defun org-transclusion-add-org-id (link plist)
"Return a list for Org-ID LINK object and PLIST.
Return nil if not found."
- (when (string= "id" (org-element-property :type link))
- ;; when type is id, the value of path is the id
- (let* ((id (org-element-property :path link))
- (mkr (ignore-errors (org-id-find id t)))
- (payload '(:tc-type "org-id")))
- (if mkr
- (append payload (org-transclusion-content-org-marker mkr plist))
- (message
- "No transclusion done for this ID. Ensure it works at point %d, line
%d"
- (point) (org-current-line))
- nil))))
+ (and-let*
+ ((_ (string= "id" (org-element-property :type link)))
+ (mkr (org-transclusion-add-target-marker link))
+ (buf (marker-buffer mkr))
+ (_ (buffer-live-p (marker-buffer mkr))))
+ (with-current-buffer buf
+ (org-with-wide-buffer
+ (goto-char mkr)
+ (append '(:tc-type "org-id")
+ (if (org-before-first-heading-p)
+ (org-transclusion-content-org-filtered
+ nil plist)
+ (org-transclusion-content-org-filtered
+ 'only-element plist)))))))
(defun org-transclusion-add-org-file (link plist)
"Return a list for Org file LINK object and PLIST.
Return nil if not found."
- (and (string= "file" (org-element-property :type link))
- (org-transclusion-org-file-p (org-element-property :path link))
+ (and-let* ((_ (or (string= "file" (org-element-property :type link))
+ (string= "fuzzy" (org-element-property :type link))))
+ (_ (or (org-transclusion-org-file-p (org-element-property :path
link))
+ (string= "fuzzy" (org-element-property :type link))))
+ ;; The target needs to be carefully differentiated between the whole buffer
or
+ ;; element at point.
+
+ ;; When the link is ID, the current logic to check the first section should
+ ;; work.
+
+ ;; For the normal file links pointing to an Org file, the target buffer may
be
+ ;; already open with a point. If the search option is present, the point will
+ ;; move to the appropriate point and get the element. If the search option is
+ ;; not present, the whole buffer needs to be obtained.
+ (mkr (org-transclusion-add-target-marker link))
+ (buf (marker-buffer mkr)))
+ ;; - Silly to go back to the buffer here.
+ ;; - `org-transclusion-content-org-filtered' should not return other
+ ;; properties -- confusing.
+ (with-current-buffer buf
+ (org-with-wide-buffer
(append '(:tc-type "org-link")
- (org-transclusion-content-org-link link plist))))
-
-(defun org-transclusion-add-other-file (link plist)
+ ;; If search-option present, get only the element at point;
+ ;; otherwise, get the whole buffer.
+ (if (org-element-property :search-option link)
+ (progn
+ (goto-char mkr)
+ (org-transclusion-content-org-filtered
+ 'only-element plist))
+ (org-transclusion-content-org-filtered
+ nil plist)))))))
+
+(defun org-transclusion-add-other-file (link _plist)
"Return a list for non-Org file LINK object and PLIST.
Return nil if not found."
- (and (string= "file" (org-element-property :type link))
+ (and-let* (;; (_ (string= "file" (org-element-property :type link)))
+ (mkr (org-transclusion-add-target-marker link))
+ (buf (marker-buffer mkr)))
+ ;; FIXME It's silly to revisit the buffer when it was already visited.
+ (with-current-buffer buf
+ (org-with-wide-buffer
(append '(:tc-type "others-default")
- (org-transclusion-content-others-default link plist))))
+ (list :src-content (buffer-string)
+ :src-buf buf
+ :src-beg (point-min)
+ :src-end (point-max)))))))
;;-----------------------------------------------------------------------------
;;;; Functions for inserting content
-(defun org-transclusion-content-insert (keyword-values type content
- sbuf sbeg send copy)
- "Insert CONTENT at point and put source overlay in SBUF.
-Return t when successful.
-
-This function formats CONTENT with using one of the
-`org-transclusion-content-format-functions'; e.g. align a table
-for Org.
+(defun org-transclusion-content-insert (content)
+ "Insert CONTENT and return cons cell of BEG and END."
+ (let ((beg (line-beginning-position))
+ end-mkr end)
+ (org-transclusion-with-inhibit-read-only
+ (when (save-excursion
+ (end-of-line) (insert-char ?\n)
+ (insert content)
+ (unless (eobp) (delete-char 1))
+ (setq end-mkr (move-marker (make-marker) (point)))
+ t)
+ ;; `org-transclusion-keyword-remove' checks element at point is a
+ ;; keyword or not
+ (org-transclusion-keyword-remove)
+ (setq end (marker-position end-mkr))))
+ ;; Assume beg and end are non-nil?
+ (when (and beg end)
+ ;; (run-hook-with-args 'org-transclusion-after-add-functions beg end)
+ ;; Point END-MKR to nowhere for garbage collection.
+ (move-marker end-mkr nil)
+ (cons beg end))))
+
+(defun org-transclusion-content-add-text-props-and-overlay (payload
keyword-values beg end)
+ "
+BEG: before the text is inserted
+END: the end of text content after inserting it
+;; - KEYWORD-VALUES :: Property list of the value of transclusion keyword
+;; - TYPE :: Transclusion type; e.g. \"org-link\"
This function is intended to be used within
`org-transclusion-add'. All the arguments should be
@@ -1105,18 +1198,25 @@ This function assumes the buffer is an Org buffer."
(push (org-element-property :level h) list)))
(when list (seq-min list))))
-(defun org-transclusion-content-format-org (type content _indent)
+(defun org-transclusion-content-format-org (type content keyword-values)
"Format text CONTENT from source before transcluding.
Return content modified (or unmodified, if not applicable).
+KEYWORD-VALUES is a plist of transclusion properties.
+
This function is the default for org-transclusion-type (TYPE)
-\"org-*\". Currently it only re-aligns table with links in the
-content."
+\"org-*\"."
(when (org-transclusion-type-is-org type)
(with-temp-buffer
(let ((org-inhibit-startup t))
(delay-mode-hooks (org-mode))
(insert content)
+ ;; Adjust headline levels
+ (org-transclusion-content-format-org-headlines
+ type content keyword-values)
+
+ ;; TODO The following two formatting operations should be in a
function.
+
;; Fix table alignment
(let ((point (point-min)))
(while point
@@ -1125,68 +1225,56 @@ content."
(org-table-align)
(goto-char (org-table-end)))
(setq point (search-forward "|" (point-max) t))))
+
;; Fix indentation when `org-adapt-indentation' is non-nil
(org-indent-region (point-min) (point-max))
;; Return the temp-buffer's string
(buffer-string)))))
-(defun org-transclusion-content-format (_type content indent)
+(defun org-transclusion-content-format-org-headlines (_type _content
keyword-values)
+ "Adjust org headline levels for CONTENT.
+KEYWORD-VALUES is a plist of transclusion properties. This
+function assumes the point is within temp-buffer with `org-mode'
+active."
+ (org-with-point-at 1
+ ;; If NO-FIRST-HEADING, delete the first level
+ (and (org-at-heading-p)
+ (plist-get keyword-values :no-first-heading)
+ (delete-line))
+ (let* ((raw-to-level (plist-get keyword-values :level))
+ (to-level (if (and (stringp raw-to-level)
+ (string= raw-to-level "auto"))
+ (1+ (plist-get keyword-values :current-level))
+ raw-to-level))
+ (level (or (org-current-level)
+ (save-excursion
+ (org-next-visible-heading 1)
+ (org-current-level))))
+ (diff (when (and level to-level) (- level to-level))))
+ (when diff
+ (cond ((< diff 0) ; demote
+ (org-map-entries (lambda ()
+ (dotimes (_ (abs diff))
+ (org-do-demote)))))
+ ((> diff 0) ; promote
+ (org-map-entries (lambda ()
+ (dotimes (_ diff) (org-do-promote))))))))))
+
+
+(defun org-transclusion-content-format (_type content keyword-values)
"Format text CONTENT from source before transcluding.
Return content modified (or unmodified, if not applicable).
This is the default one. It only returns the content as is.
-INDENT is the number of current indentation of the #+transclude."
+KEYWORD-VALUES is a plist of transclusion properties."
(with-temp-buffer
(insert content)
;; Return the temp-buffer's string
- (set-left-margin (point-min)(point-max) indent)
+ (set-left-margin (point-min)(point-max)
+ (plist-get keyword-values :current-indentation))
(buffer-string)))
-(defun org-transclusion-content-org-marker (marker plist)
- "Return a list of payload from MARKER and PLIST.
-This function is intended to be used for Org-ID. It delegates the
-work to
-`org-transclusion-content-org-filtered'."
- (if (and marker (marker-buffer marker)
- (buffer-live-p (marker-buffer marker)))
- (progn
- (with-current-buffer (marker-buffer marker)
- (org-with-wide-buffer
- (goto-char marker)
- (if (org-before-first-heading-p)
- (org-transclusion-content-org-filtered
- nil plist)
- (org-transclusion-content-org-filtered
- 'only-element plist)))))
- (message "Nothing done. Cannot find marker for the ID.")))
-
-(defun org-transclusion-content-org-link (link plist)
- "Return a list of payload from Org LINK object and PLIST.
-This function is intended to be used for Org-ID. It delegates the
-work to
-`org-transclusion-content-org-filtered'."
- (save-excursion
- ;; First visit the buffer and go to the relevant element if
- ;; search-option is present.
- (let* ((path (org-element-property :path link))
- (search-option (org-element-property :search-option link))
- (buf (find-file-noselect path))
- (org-link-search-must-match-exact-headline
- ;; Don't ever prompt to create a headline when transcluding
- (if (eq 'query-to-create org-link-search-must-match-exact-headline)
- t ;; Less surprising default than nil - fuzzy search
- org-link-search-must-match-exact-headline)))
- (with-current-buffer buf
- (org-with-wide-buffer
- (if search-option
- (progn
- (org-link-search search-option)
- (org-transclusion-content-org-filtered
- 'only-element plist))
- (org-transclusion-content-org-filtered
- nil plist)))))))
-
(defvar org-transclusion-content-filter-org-functions '())
(add-hook 'org-transclusion-content-filter-org-functions
@@ -1254,10 +1342,10 @@ property controls the filter applied to the
transclusion."
#'org-transclusion-content-filter-org-first-section
nil nil org-element-all-elements nil)))
;; Apply other filters
- (dolist (fn org-transclusion-content-filter-org-functions)
- (let ((obj-returned (funcall fn obj plist)))
- ;; If nil is returned, do not change the org-content (obj)
- (when obj-returned (setq obj obj-returned))))
+ (dolist (fn org-transclusion-content-filter-org-functions)
+ (let ((obj-returned (funcall fn obj plist)))
+ ;; If nil is returned, do not change the org-content (obj)
+ (when obj-returned (setq obj obj-returned))))
obj)
(defun org-transclusion-content-filter-org-expand-links-function (obj plist)
@@ -1312,20 +1400,6 @@ is non-nil."
nil
data))
-;;;;---------------------------------------------------------------------------
-;;;; Functions to support non-Org-mode link types
-
-(defun org-transclusion-content-others-default (link _plist)
- "Use Org LINK element to return SRC-CONTENT, SRC-BEG, and SRC-END."
- (let* ((path (org-element-property :path link))
- (buf (find-file-noselect path)))
- (with-current-buffer buf
- (org-with-wide-buffer
- (list :src-content (buffer-string)
- :src-buf buf
- :src-beg (point-min)
- :src-end (point-max))))))
-
;;-----------------------------------------------------------------------------
;;; Helper Functions
(defun org-transclusion--fringe-spec-p (prop-value)
@@ -2046,7 +2120,7 @@ ensure the settings revert to the user's setting prior to
"Promote or demote transcluded subtree.
When DEMOTE is non-nil, demote."
(unless (org-transclusion-within-transclusion-p)
- (user-error "Not in a transcluded headline."))
+ (user-error "Not in a transcluded headline"))
(let* ((inhibit-read-only t)
(beg (car (plist-get (org-transclusion-at-point) :location)))
(pos (point)))
@@ -2078,10 +2152,45 @@ FORCE will let this function ignore
`org-transclusion-extensions-loaded' and load extensions again."
(when (or force (not org-transclusion-extensions-loaded))
(dolist (ext org-transclusion-extensions)
- (condition-case nil (require ext)
- (error (message "Problems while trying to load feature `%s'" ext))))
+ (let* ((ext-name (symbol-name ext))
+ (minor-mode (intern (if (string-suffix-p "-mode" ext-name)
+ ext-name
+ (concat ext-name "-mode")))))
+ (condition-case nil
+ (progn
+ (require ext)
+ (when (fboundp minor-mode) (funcall minor-mode +1)))
+ (error (message "Problems while trying to load feature `%s'" ext)))))
(setq org-transclusion-extensions-loaded t)))
+(defun org-transclusion-extension-set-a-hook-functions (add-or-remove list)
+ "Add/remove functions to an abnormal hook.
+LIST must be a cons cell for an extension. CAR is a symbol name
+of an abnormal hook \(generally suffixed with \"-functions\"\).
+CDR is either a symbol or list of symbols, which are names of
+functions to be set to the abnormal hook. ADD-OR-REMOVE must either
+`add-hook' or `remove-hook'."
+ (let* ((hook-name (car list))
+ (symbols (cdr list))
+ ;; If CDR is a single function symbol name, put it into a list.
+ (symbols (if (listp symbols) symbols (list symbols))))
+ (mapc (lambda (symbol) (funcall add-or-remove hook-name symbol))
+ symbols)))
+
+(defun org-transclusion-extension-functions-add-or-remove (extension-functions
&optional remove)
+ "Add or remove functions to abnormal hooks for extensions.
+EXTENSION-FUNCTIONS is an alist. CAR of each cons cell is a
+symbol name of an abnormal hook \(generally suffixed with
+\"-functions\"\). CDR is either a symbol or list of symbols,
+which are names of functions to be set to the abnormal hook. If
+REMOVE is non-nil, the functions will be removed from the
+abnormal hooks; otherwise, added to them."
+ (let* ((add-or-remove (if remove #'remove-hook #'add-hook))
+ (set-function (apply-partially
+ #'org-transclusion-extension-set-a-hook-functions
+ add-or-remove)))
+ (mapc set-function extension-functions)))
+
;; Load extensions upon loading this file
(org-transclusion-load-extensions-maybe)
diff --git a/test/273/test273.org b/test/273/test273.org
new file mode 100644
index 0000000000..4f472d7fa0
--- /dev/null
+++ b/test/273/test273.org
@@ -0,0 +1,23 @@
+* 08:49 Example of learning human languages via anki and youtube
:german:language:journals:2025_09_25:
+:PROPERTIES:
+:CREATED: [2025-09-25 Thu 08:49]
+:ID: 2025-12-18T060626
+:END:
+
+The [[https://cjauvin.github.io/posts/learning-persian/][blog post]] is short
and simple. However, showcases an effective
+method of using youtube and spaced repetition with langauage learning.
+The gist of it is that <<gist>>
+
+* 08:53 Showcasing in-file targeting with org-transclusion
+:PROPERTIES:
+:ID: d697a00d-62b9-4d49-8196-b1ebadfdccda
+:CREATED: [2025-09-25 Thu 08:53]
+:END:
+
+See this one:
+
+#+transclude: [[id:2025-12-18T060626::gist]]
+
+or this one:
+
+#+transclude: [[id:ccf3c642-fbef-4485-a21b-e83784c3303f::test]]
diff --git a/test/bertrand-russell.org b/test/bertrand-russell.org
index 4ffa366351..3a2430f92b 100644
--- a/test/bertrand-russell.org
+++ b/test/bertrand-russell.org
@@ -1,78 +1,90 @@
-* Bertrand Russell - Wikipedia
-:PROPERTIES:
-:ID: 2022-05-30T203553
-:END:
-:ref:
-:link: https://en.wikipedia.org/wiki/Bertrand_Russell
-:end:
-
-*Bertrand Arthur William Russell, 3rd Earl Russell* OM FRS[65] (18 May 1872 – 2
-February 1970) was a British polymath ande writer. He was born in Monmouthshire
-into one of the most prominent aristocratic families in the United Kingdom.
-
-#+transclude: [[file:bertrand-russell.org::*Bertrand Russell - Wikipedia]]
:level 1
-
-#+begin_export
-As an academic, he worked in philosophy, mathematics, and logic. His work has
had a considerable influence on mathematics, logic, set theory, linguistics,
artificial intelligence, cognitive science, computer science (see type theory
and type system) and various areas of analytic philosophy, especially logic,
philosophy of mathematics, philosophy of language, epistemology and metaphysics.
-#+end_export
-
-#+begin_src elisp
-If an integer $n$ is greater than 2, then the equation $a^n + b^n = c^n$
-has no solutions in non-zero integers $a$, $b$, and $c$.
-This is live-sync'ed
-#+end_src
-
-Russell was also a public intellectual, historian, social critic, political
activist, and Nobel laureate.[66][67] Throughout his life, Russell considered
himself a liberal, a socialist and a pacifist, although he later wrote he had
"never been any of these things, in any profound sense".[68] This is live sync.
As you can see, the edit on the left (transclusion) is copied over to the
right (source)
-
-Below is an example of a LaTex environment
-
-\begin{equation}
-x=\sqrt{b}
-\end{equation}
-
-: fixed width element
-: Second line
-
-\begin{align*}
-2x - 5y &= 8 \\
-3x + 9y &= -12
-\end{align*}
-
-** H2
-:ref:
-:data: data
-:end:
-
-#+begin_example
-Russell is one of the early 20th century's most prominent logicians,[67] and
one of the founders of analytic philosophy, along with his predecessor Gottlob
Frege, his friend and colleague G. E. Moore and his student and protégé Ludwig
Wittgenstein.
-#+end_example
-
-#+begin_verse
- Great clouds overhead
- Tiny black birds rise and fall
- Snow covers Emacs
-
- ---AlexSchroeder
- Verse can be live-synced
-#+end_verse
-
-#+begin: dynamic
-Russell with Moore led the British "revolt against idealism".[a] Together with
his former teacher A. N. Whitehead, Russell wrote Principia Mathematica, a
milestone in the development of classical logic, and a major attempt to reduce
the whole of mathematics to logic (see Logicism). Russell's article On Denoting
has been considered a "paradigm of philosophy".[70]
-#+end:
-
-*** H3
-This is content of H3
-
-* On Denoting
-:PROPERTIES:
-:ID: 2022-10-10T173507
-:link: https://en.wikipedia.org/wiki/On_Denoting
-:end:
-
- "On Denoting" is an essay by Bertrand Russell. It was published in the
philosophy journal Mind in 1905. In it, Russell introduces and advocates his
theory of denoting phrases, according to which definite descriptions and other
"denoting phrases ... never have any meaning in themselves, but every
proposition in whose verbal expression they occur has a meaning."[1] This
theory later became the basis for Russell's descriptivism with regard to proper
names, and his view that proper names ar [...]
-
-** H2
-In the 1920s, Frank P. Ramsey referred to the essay as "that paradigm of
philosophy".[2][3] In the Stanford Encyclopedia of Philosophy entry
Descriptions, Peter Ludlow singled the essay out as "the paradigm of
philosophy", and called it a work of "tremendous insight"; provoking discussion
and debate among philosophers of language and linguists for over a century.[4]
-
-*** H3
-This is content of H3
+* Bertrand Russell - Wikipedia
+:PROPERTIES:
+:ID: 2022-05-30T203553
+:END:
+:ref:
+:link: https://en.wikipedia.org/wiki/Bertrand_Russell
+:end:
+
+*Bertrand Arthur William Russell, 3rd Earl Russell* OM FRS[65] (18 May 1872 – 2
+February 1970) was a British polymath ande writer. He was born in Monmouthshire
+into one of the most prominent aristocratic families in the United Kingdom.
+
+#+transclude: [[file:bertrand-russell.org::*Bertrand Russell - Wikipedia]]
:level 1
+
+#+begin_export
+As an academic, he worked in philosophy, mathematics, and logic. His work has
had a considerable influence on mathematics, logic, set theory, linguistics,
artificial intelligence, cognitive science, computer science (see type theory
and type system) and various areas of analytic philosophy, especially logic,
philosophy of mathematics, philosophy of language, epistemology and metaphysics.
+#+end_export
+
+#+begin_src elisp
+If an integer $n$ is greater than 2, then the equation $a^n + b^n = c^n$
+has no solutions in non-zero integers $a$, $b$, and $c$.
+This is live-sync'ed
+#+end_src
+
+Russell was also a public intellectual, historian, social critic, political
activist, and Nobel laureate.[66][67] Throughout his life, Russell considered
himself a liberal, a socialist and a pacifist, although he later wrote he had
"never been any of these things, in any profound sense".[68] This is live sync.
As you can see, the edit on the left (transclusion) is copied over to the
right (source)
+
+Below is an example of a LaTex environment
+
+\begin{equation}
+x=\sqrt{b}
+\end{equation}
+
+: fixed width element
+: Second line
+
+\begin{align*}
+2x - 5y &= 8 \\
+3x + 9y &= -12
+\end{align*}
+
+** H2
+:ref:
+:data: data
+:end:
+
+#+begin_example
+Russell is one of the early 20th century's most prominent logicians,[67] and
one of the founders of analytic philosophy, along with his predecessor Gottlob
Frege, his friend and colleague G. E. Moore and his student and protégé Ludwig
Wittgenstein.
+#+end_example
+
+#+begin_verse
+ Great clouds overhead
+ Tiny black birds rise and fall
+ Snow covers Emacs
+
+ ---AlexSchroeder
+ Verse can be live-synced
+#+end_verse
+
+#+begin: dynamic
+Russell with Moore led the British "revolt against idealism".[a] Together with
his former teacher A. N. Whitehead, Russell wrote Principia Mathematica, a
milestone in the development of classical logic, and a major attempt to reduce
the whole of mathematics to logic (see Logicism). Russell's article On Denoting
has been considered a "paradigm of philosophy".[70]
+#+end:
+
+*** H3
+ This is content of H3
+
+* On Denoting
+ :PROPERTIES:
+ :ID: 2022-10-10T173507
+ :link: https://en.wikipedia.org/wiki/On_Denoting
+ :end:
+
+ "On Denoting" is an essay by Bertrand Russell. It was published in the
+ philosophy journal Mind in 1905. In it, Russell introduces and advocates his
+ theory of denoting phrases, according to which definite descriptions and
other
+ "denoting phrases ... never have any meaning in themselves, but every
+ proposition in whose verbal expression they occur has a meaning."[1] This
+ theory later became the basis for Russell's descriptivism with regard to
+ proper names, and his view that proper names are "disguised" or "abbreviated"
+ definite descriptions.
+
+** H2
+ In the 1920s, Frank P. Ramsey referred to the essay as "that paradigm of
+ philosophy".[2][3] In the Stanford Encyclopedia of Philosophy entry
+ Descriptions, Peter Ludlow singled the essay out as "the paradigm of
+ philosophy", and called it a work of "tremendous insight"; provoking
+ discussion and debate among philosophers of language and linguists for over
a
+ century.[4]
+
+*** H3
+This is content of H3
diff --git a/test/test-2.0.org b/test/test-2.0.org
index 230b2b9a20..78050504df 100644
--- a/test/test-2.0.org
+++ b/test/test-2.0.org
@@ -1,7 +1,44 @@
+#+title: Test file for Org-transclusion
+
+This is the first section before the first headline.
+
* Regression
-** make from link
+** notmuch
+
+ #+transclude: [[notmuch:id:[email protected]]]
+
+ [[notmuch:id:[email protected]]]
+
+** file search option
+
+ #+transclude: [[file:paragraph.org]]
+ => transclude entire buffer
+
+ #+transclude: [[file:paragraph.org::Sub heading][This is a description]]
+ => Sub heading only
+
+ #+transclude: [[file:paragraph.org::non-exisitent]]
+ => Should not transclude anything
+
+#+transclude: [[paragraph.tx]]
+
+** make from link -- ID and ID with search option
This is a link to a [[id:2022-05-30T203553][Bertrand Russell]] wikipedia
excerpt
#+transclude: [[id:2022-05-30T203553][Bertrand Russell]]
+
+#+transclude: [[id:2022-10-10T173507::*H2]]
+
+[[id:2022-10-10T173507::*H2]]
+
+ID with "first section" [[id:2022-06-26T152831]]
+
+#+begin_src emacs-lisp
+ (setq org-transclusion-include-first-section nil)
+ (setq org-transclusion-include-first-section t)
+#+end_src
+
+#+transclude: [[id:2022-06-26T152831]]
+
** test empty file
#+transclude: [[file:empty.txt::2][empty text file]]
@@ -52,7 +89,8 @@ t/nil will be dropped after remove-at-point
#+transclude: [[file:paragraph.org::quote][Link to a quote]]
** #Custom ID
-#+transclude: [[file:testpara.org::#custom-id-1][Custom ID]] :level 2
+
+ #+transclude: [[file:testpara.org::#custom-id-1][Custom ID]] :level 2
** *Hadline
#+transclude: [[file:bertrand-russell.org::*Bertrand Russell - Wikipedia]]
:level 2 :disable-auto
@@ -85,16 +123,16 @@ Temporarily set ~org-transclusion-include-first-section~
to nil
** center-block dynamic-block example-block export-block special-block
verse-block
** drawer
-#+begin_example
-(setq org-transclusion-exclude-elements '())
-(setq org-transclusion-exclude-elements '(property-drawer))
-#+end_example
+
+ #+begin_example
+ (setq org-transclusion-exclude-elements '())
+ (setq org-transclusion-exclude-elements '(property-drawer))
+ #+end_example
#+transclude: [[id:2022-05-30T203553][Bertrand Russell]]
** fixed-width
-
** latex-environment
** plain-list
@@ -181,11 +219,13 @@ Temporarily set ~org-transclusion-include-first-section~
to nil
#+transclude: [[id:2022-06-26T141859]] :exclude-elements "paragraph"
#+transclude: [[id:2022-06-26T141859]]
-* Test src
+* Test src and end
#+transclude: [[file:./python-1.py]]
#+transclude: [[file:./python-1.py]] :src python
+#+transclude: [[file:./python-1.py::id-1234]] :src python :end "id-1234 end
here"
+
#+begin_src python
import matplotlib
import matplotlib.pyplot as plt
@@ -199,4 +239,23 @@ Temporarily set ~org-transclusion-include-first-section~
to nil
# id-1234 end here
return fname # return this to org-mode
#+end_src
+* Test "auto" level and :no-first-heading
+ #+transclude: [[file:bertrand-russell.org::*On Denoting]] :level
:no-first-heading
+
+ #+transclude: [[file:bertrand-russell.org::*On Denoting]] :level
+
+*** A auto level
+
+ #+transclude: [[file:bertrand-russell.org::*On Denoting]] :level
:exclude-elements "headline drawer"
+
+
+ #+transclude: [[file:bertrand-russell.org::*On Denoting]] :level 3
:exclude-elements "headline drawer"
+
+*** First sectiona and "auto" level
+
+#+begin_src emacs-lisp
+ (setq org-transclusion-include-first-section nil)
+ (setq org-transclusion-include-first-section t)
+#+end_src
+ #+transclude: [[file:./test-no-first-section.org]] :level
diff --git a/test/things-at-point.org b/test/things-at-point.org
index 81d1eb6caf..698e521341 100644
--- a/test/things-at-point.org
+++ b/test/things-at-point.org
@@ -19,10 +19,13 @@ I expect these will be more common:
#+transclude: [[./things-at-point-dir/story.txt::Once upon a time][story]]
:end "2" :thing-at-point paragraph
-#+transclude: [[./things-at-point-dir/story.txt::Once upon a time][story]]
:end "3":thing-at-point sentence
+#+transclude: [[./things-at-point-dir/story.txt::Once upon a time][story]]
:end "1" :thing-at-point sentence
+
+#+transclude: [[./things-at-point-dir/story.txt::Once upon a time][story]]
:end "3" :thing-at-point sentence
#+transclude: [[./things-at-point-dir/baz.el::id:1234567890][barz-baz-fuzz]]
:src elisp
-#+transclude: [[./things-at-point-dir/baz.el::foo][barz-baz-fuzz]] :src elisp
:thingatpt sexp
+#+transclude: [[./things-at-point-dir/baz.el::id:1234567890][barz-baz-fuzz]]
:src elisp :thing-at-point sexp
+
+#+transclude: [[./things-at-point-dir/baz.el::foo][barz-baz-fuzz]] :src elisp
-#+transclude: [[./things-at-point-dir/baz.el::id:1234567890][barz-baz-fuzz]]
:src elisp :thing-at-point defun
