diff --git a/lisp/ob-tangle-sync.el b/lisp/ob-tangle-sync.el new file mode 100644 index 000000000..61c23f647 --- /dev/null +++ b/lisp/ob-tangle-sync.el @@ -0,0 +1,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 . + +;;; 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