From 22ace85fd4d9fdd61b2e92b79152d95cd571f0e9 Mon Sep 17 00:00:00 2001
From: MT <mtekman89@gmail.com>
Date: Tue, 2 May 2023 18:10:07 +0200
Subject: [PATCH 4/6] lisp/ob-tangle.el: Sync aware tangle function with better
 messages

* ob-tangle.el (org-babel-tangle): The tangle function is now aware of
the desired sync action for a given block by parsing the
`:tangle-sync' source block header in the org file.  It populates
three seperate block counters depending on the action of the block as
given: "skip" = `skip', "tangle" = `export' or `both' or `nil', and
"detangle" = `import').
---
 lisp/ob-tangle.el | 60 +++++++++++++++++++++++++++++++++++++----------
 1 file changed, 48 insertions(+), 12 deletions(-)

diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index 596b4b3eb..cbe6fca0d 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -244,10 +244,13 @@ matching a regular expression."
 	      (goto-char head)
 	    (user-error "Point is not in a source code block"))))
       (let ((block-counter 0)
+            (skip-counter 0)
+            (blocks-to-detangle nil)
 	    (org-babel-default-header-args
 	     (if target-file
 		 (org-babel-merge-params org-babel-default-header-args
-					 (list (cons :tangle target-file)))
+					 (list (cons :tangle target-file)
+                                               (cons :tangle-sync "both")))
 	       org-babel-default-header-args))
 	    (tangle-file
 	     (when (equal arg '(16))
@@ -281,7 +284,10 @@ matching a regular expression."
 			     (get-spec (lambda (name) (cdr (assq name (nth 4 spec)))))
 			     (she-bang (let ((sheb (funcall get-spec :shebang)))
 				         (when (> (length sheb) 0) sheb)))
-			     (tangle-mode (funcall get-spec :tangle-mode)))
+                             (tangle-name (funcall get-spec :tangle))
+			     (tangle-mode (funcall get-spec :tangle-mode))
+                             (tangle-sync (funcall get-spec :tangle-sync))
+                             (tfile-block (nth 8 lspec)))
 		        (unless (string-equal block-lang lang)
 			  (setq lang block-lang)
 			  (let ((lang-f (org-src-get-lang-mode lang)))
@@ -291,6 +297,19 @@ matching a regular expression."
 			  (unless tangle-mode (setq tangle-mode #o755)))
 		        (when tangle-mode
 			  (add-to-list 'modes (org-babel-interpret-file-mode tangle-mode)))
+                        ;; Replace block contents with remote tangle
+                        ;; comments if "import" or "skip".
+                        (when (and tfile-block (or (string= "import" tangle-sync)
+                                                   (string= "skip" tangle-sync)))
+                          (let* ((remote-body (with-current-buffer (find-file-noselect tangle-name)
+                                                (buffer-substring
+                                                 (plist-get tfile-block :start)
+                                                 (plist-get tfile-block :end)))))
+                            ;; Replace the spec text body with the remote body contents
+                            (setf (nth 5 spec) remote-body)
+                            (if (string= "import" tangle-sync)
+                                (push spec blocks-to-detangle)
+                              (setq skip-counter (+ 1 skip-counter)))))
 		        ;; Possibly create the parent directories for file.
 		        (let ((m (funcall get-spec :mkdirp)))
 			  (and m fnd (not (string= m "no"))
@@ -302,8 +321,8 @@ matching a regular expression."
 		        (when (and she-bang (not she-banged))
 			  (insert (concat she-bang "\n"))
 			  (setq she-banged t))
-		        (org-babel-spec-to-string spec)
-		        (setq block-counter (+ 1 block-counter))))
+		        (org-babel-spec-to-string spec))
+		        (setq block-counter (+ 1 block-counter)))
 		    lspecs)
 		   (when make-dir
 		     (make-directory fnd 'parents))
@@ -329,14 +348,31 @@ matching a regular expression."
 	 (if (equal arg '(4))
 	     (org-babel-tangle-single-block 1 t)
 	   (org-babel-tangle-collect-blocks lang-re tangle-file)))
-	(message "Tangled %d code block%s from %s" block-counter
-		 (if (= block-counter 1) "" "s")
-		 (file-name-nondirectory
-		  (buffer-file-name
-		   (or (buffer-base-buffer)
-                       (current-buffer)
-                       (and (org-src-edit-buffer-p)
-                            (org-src-source-buffer))))))
+        (let ((detang-counter (length blocks-to-detangle)))
+          (when (> detang-counter 0)
+            (mapc (lambda (dspec)
+                    (let ((lnum (car dspec))
+                          (new-body (nth 5 dspec)))
+                      ;; For de-tangling, we assume already in the correct source buffer
+                      (goto-char 0)
+                      (forward-line lnum)
+                      (when new-body
+                        (org-babel-update-block-body new-body))))
+                  blocks-to-detangle))
+          (message "Tangled %d code block%s from %s%s%s%s%s" block-counter
+                   (if (= block-counter 1) "" "s")
+                   (file-name-nondirectory
+		    (buffer-file-name
+		     (or (buffer-base-buffer)
+                         (current-buffer)
+                         (and (org-src-edit-buffer-p)
+                              (org-src-source-buffer)))))
+                   (if (= (+ skip-counter detang-counter) 0) "" " of which: ")
+                   (if (= skip-counter 0) ""
+                     (format "%d were skipped" skip-counter))
+                   (if (= (* skip-counter detang-counter) 0) "" " and ")
+                   (if (= detang-counter 0) ""
+                     (format "%d were detangled" detang-counter))))
 	;; run `org-babel-post-tangle-hook' in all tangled files
 	(when org-babel-post-tangle-hook
 	  (mapc
-- 
2.40.1

