1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
| | ;;; ob-tangle-sync.el --- Synchronize Source Code and Org Files -*- lexical-binding: t; -*-
;; Copyright (C) 2009-2023 Free Software Foundation, Inc.
;; Author: Mehmet Tekman
;; Keywords: literate programming, reproducible research
;; URL: https://orgmode.org
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Synchronize the code between source blocks and raw source-code files.
;;; Code:
(require 'org-macs)
(org-assert-version)
(require 'ol)
(require 'org)
(require 'org-element)
(require 'ob-core)
(defgroup org-babel-tangle-sync nil
"Options for synchronizing source code and code blocks."
:tag "Org Babel Tangle sync"
:group 'org-babel-tangle)
;;;###autoload
(define-minor-mode org-babel-tangle-sync-mode
"Global minor mode that synchronizes tangled files after every save."
:global t
:interactive t
:lighter " o-ts"
(if org-babel-tangle-sync-mode
(add-hook 'after-save-hook 'org-babel-tangle-sync-synchronize nil t)
(remove-hook 'after-save-hook 'org-babel-tangle-sync-synchronize t)))
(defcustom org-babel-tangle-sync-files nil
"A list of `org-mode' files.
When `org-babel-tangle-sync-mode' is enabled only files listed
here are subject to the org-babel-tangle-sync treatment. If nil,
then all org files with tangle headers are considered."
:group 'org-babel-tangle-sync
:type 'list
:package-version '(Org . "9.6.5")
:set (lambda (_var val) (mapcar #'(lambda (x) (expand-file-name x)) val)))
(defun org-babel-tangle-sync--babel-tangle-jump (link block-name)
"Jump from a tangled file to the Org file without returning anything.
The location of the code block in the Org file is given by a
combination of the LINK filename and header, followed by the
BLOCK-NAME Org mode source block number. The code is borrowed
heavily from `org-babel-tangle-jump-to-org'"
;; Go to the beginning of the relative block in Org file.
;; Explicitly allow fuzzy search even if user customized
;; otherwise.
(let (org-link-search-must-match-exact-headline)
(org-link-open-from-string link))
;;(setq target-buffer (current-buffer))
(if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name)
(let ((n (string-to-number (match-string 1 block-name))))
(if (org-before-first-heading-p) (goto-char (point-min))
(org-back-to-heading t))
;; Do not skip the first block if it begins at point min.
(cond ((or (org-at-heading-p)
(not (eq (org-element-type (org-element-at-point))
'src-block)))
(org-babel-next-src-block n))
((= n 1))
(t (org-babel-next-src-block (1- n)))))
(org-babel-goto-named-src-block block-name))
(goto-char (org-babel-where-is-src-block-head))
(forward-line 1))
;;;###autoload
(defun org-babel-tangle-sync-synchronize ()
"Synchronize a tangled code block to its source-specific file, or vice versa.
If the cursor is either within the source file or in destination
tangled file, perform a desired tangling action. The tangling
action by default is to detangle the tangled files' changes back
to its source block, or to tangle the source block to its tangled
file. Actions are one of `skip' (no action), `pull' (detangle
only), `export' (tangle only), and `both' (default, synchronize
in both directions). All `org-mode' source blocks and all tangled
files with comments are considered valid targets, unless
specified otherwise by `org-babel-tangle-sync-files'."
(interactive)
(let* ((link (save-excursion
(progn (re-search-backward org-link-bracket-re nil t)
(match-string-no-properties 0))))
(block-name (match-string 2))
(orgfile-p (string= major-mode "org-mode"))
(tangled-file-p (and link (not orgfile-p))))
;; Tangled File → Source Block
(if tangled-file-p
;; Examine the block: Get the source file and the desired tangle-sync action
(let* ((parsed-link (with-temp-buffer
(let ((org-inhibit-startup nil))
(insert link)
(org-mode)
(goto-char (point-min))
(org-element-link-parser))))
(source-file (expand-file-name
(org-element-property :path parsed-link)))
(sync-action (save-window-excursion
(progn
(org-babel-tangle-sync--babel-tangle-jump link block-name)
(alist-get :tangle-sync
(nth 2 (org-babel-get-src-block-info
'no-eval)))))))
;; De-tangle file back to source block if:
;; - member of sync file list (or list is empty)
;; - source file tangle-sync action isn't "skip" or "export",
(if (or (null org-babel-tangle-sync-files)
(member source-file org-babel-tangle-sync-files))
(cond ((string= sync-action "skip") nil)
((string= sync-action "export")
(save-window-excursion
(progn (org-babel-tangle-sync--babel-tangle-jump link block-name)
(let ((current-prefix-arg '(16)))
(call-interactively 'org-babel-tangle))
(message "Exported from %s" source-file))))
(t
(save-window-excursion
(org-babel-detangle)
(message "Synced to %s" source-file))))))
;; Source Block → Tangled File (or Source Block ← Tangled File (via "pull"))
(when orgfile-p
;; Tangle action of Source file on Block if:
;; - member of sync file list (or list is empty)
;; Actions
;; - pull (Source Block ← File)
;; - skip (nothing)
;; - export, both, nil (Source Block → File)
(if (or (null org-babel-tangle-sync-files)
(member buffer-file-name org-babel-tangle-sync-files))
(let* ((src-headers (nth 2 (org-babel-get-src-block-info 'no-eval)))
(tangle-file (cdr (assq :tangle src-headers)))
(tangle-action (alist-get :tangle-sync src-headers)))
(when tangle-file
(cond ((string= tangle-action "pull") (save-excursion
(org-babel-detangle tangle-file)))
((string= tangle-action "skip") nil)
(t (let ((current-prefix-arg '(16)))
(call-interactively 'org-babel-tangle)
;; Revert to see changes, then re-enable the mode
(with-current-buffer (get-file-buffer tangle-file)
(revert-buffer)
(org-babel-tangle-sync-mode t))))))))))))
(provide 'ob-tangle-sync)
;;; ob-tangle-sync.el ends here
|