Browse Source

ob-tangle: detangle changes in code files back to the original org files

* lisp/ob-tangle.el (org-babel-update-block-body): declaring function
  for updating code block bodies
  (org-babel-spec-to-string):
  (org-babel-detangle): detangle all tangled and commented code blocks
  in the current file back to org
  (org-babel-tangle-jump-to-org): jump from a tangled and commented
  file back to the originating org-mode code block
ob-tangle: detangle changes in code files back to the original org files

* lisp/ob-tangle.el (org-babel-update-block-body): declaring function
  for updating code block bodies
  (org-babel-spec-to-string):
  (org-babel-detangle): detangle all tangled and commented code blocks
  in the current file back to org
  (org-babel-tangle-jump-to-org): jump from a tangled and commented
  file back to the originating org-mode code block
Eric Schulte 10 years ago
parent
commit
2152f1ec28
2 changed files with 64 additions and 1 deletions
  1. 56 1
      lisp/ob-tangle.el
  2. 8 0
      lisp/ob.el

+ 56 - 1
lisp/ob-tangle.el

@@ -36,6 +36,7 @@
 (declare-function org-heading-components "org" ())
 (declare-function org-back-to-heading "org" (invisible-ok))
 (declare-function org-fill-template "org" (template alist))
+(declare-function org-babel-update-block-body "org" (new-body))
 
 ;;;###autoload
 (defcustom org-babel-tangle-lang-exts
@@ -370,7 +371,7 @@ form
 				     (eval el))))
 			    '(start-line file link source-name))))
     (flet ((insert-comment (text)
-	    (let ((text (org-babel-trim text)))
+            (let ((text (org-babel-trim text)))
 	      (when (and comments (not (string= comments "no"))
 			 (> (length text) 0))
 		(when org-babel-tangle-pad-newline (insert "\n"))
@@ -391,6 +392,60 @@ form
 	(insert-comment
 	 (org-fill-template org-babel-tangle-comment-format-end link-data))))))
 
+;; detangling functions
+(defvar org-bracket-link-analytic-regexp)
+(defun org-babel-detangle (&optional source-code-file)
+  "Propagate changes in source file back original to Org-mode file.
+This requires that code blocks were tangled with link comments
+which enable the original code blocks to be found."
+  (interactive)
+  (save-excursion
+    (when source-code-file (find-file source-code-file))
+    (goto-char (point-min))
+    (let ((counter 0) new-body end)
+      (while (re-search-forward org-bracket-link-analytic-regexp nil t)
+        (when (re-search-forward
+	       (concat " " (regexp-quote (match-string 5)) " ends here"))
+          (setq end (match-end 0))
+          (forward-line -1)
+          (save-excursion
+	    (when (setq new-body (org-babel-tangle-jump-to-org))
+	      (org-babel-update-block-body new-body)))
+          (setq counter (+ 1 counter)))
+        (goto-char end))
+      (prog1 counter (message "detangled %d code blocks" counter)))))
+
+(defun org-babel-tangle-jump-to-org ()
+  "Jump from a tangled code file to the related Org-mode file."
+  (interactive)
+  (let ((mid (point))
+        target-buffer target-char
+        start end link path block-name body)
+    (save-window-excursion
+      (save-excursion
+        (unless (and (re-search-backward org-bracket-link-analytic-regexp nil t)
+                     (setq start (point-at-eol))
+                     (setq link (match-string 0))
+                     (setq path (match-string 3))
+                     (setq block-name (match-string 5))
+                     (re-search-forward
+                      (concat " " (regexp-quote block-name) " ends here") nil t)
+                     (setq end (point-at-bol))
+                     (< start mid) (< mid end))
+          (error "not in tangled code"))
+        (setq body (org-babel-trim (buffer-substring start end))))
+      (when (string-match "::" path)
+        (setq path (substring path 0 (match-beginning 0))))
+      (find-file path) (setq target-buffer (current-buffer))
+      (goto-char start) (org-open-link-from-string link)
+      (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name)
+          (org-babel-next-src-block
+           (string-to-number (match-string 1 block-name)))
+        (org-babel-goto-named-src-block block-name))
+      (setq target-char (point)))
+    (pop-to-buffer target-buffer)
+    (prog1 body (goto-char target-char))))
+
 (provide 'ob-tangle)
 
 ;; arch-tag: 413ced93-48f5-4216-86e4-3fc5df8c8f24

+ 8 - 0
lisp/ob.el

@@ -1514,6 +1514,14 @@ file's directory then expand relative links."
 	     (forward-char (- end beg))
 	     (insert "#+end_example\n"))))))
 
+(defun org-babel-update-block-body (new-body)
+  "Update the body of the current code block to NEW-BODY."
+  (if (not (org-babel-where-is-src-block-head))
+      (error "not in source block")
+    (save-match-data
+      (replace-match (concat (org-babel-trim new-body) "\n") nil nil nil 5))
+    (indent-rigidly (match-beginning 5) (match-end 5) 2)))
+
 (defun org-babel-merge-params (&rest plists)
   "Combine all parameter association lists in PLISTS.
 Later elements of PLISTS override the values of previous element.