summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2016-01-31 11:37:05 +0100
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2016-01-31 20:38:35 +0100
commit67efff2fd81b75493ba082f4c14e2cc6755f2e21 (patch)
tree3eaaaf78e169dbf79fe4ed73cb4b84a19071211c
parent7d6b8f51ec1993a66a385b98b2df42d0853fe289 (diff)
downloadorg-mode-67efff2fd81b75493ba082f4c14e2cc6755f2e21.tar.gz
ob-tangle: Fix `org-babel-tangle-jump-to-org'
* lisp/ob-tangle.el (org-babel-tangle-jump-to-org): Find correct location in the Org document. * testing/lisp/test-ob-tangle.el (ob-tangle/jump-to-org): New test.
-rw-r--r--lisp/ob-tangle.el42
-rw-r--r--testing/lisp/test-ob-tangle.el132
2 files changed, 128 insertions, 46 deletions
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index e9af695..399da66 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -29,10 +29,13 @@
(require 'org-src)
(declare-function make-directory "files" (dir &optional parents))
+(declare-function org-at-heading-p "org" (&optional ignored))
(declare-function org-babel-update-block-body "org" (new-body))
(declare-function org-back-to-heading "org" (invisible-ok))
(declare-function org-before-first-heading-p "org" ())
(declare-function org-edit-special "org" (&optional arg))
+(declare-function org-element-at-point "org-element" ())
+(declare-function org-element-type "org-element" (element))
(declare-function org-fill-template "org" (template alist))
(declare-function org-heading-components "org" ())
(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
@@ -545,7 +548,7 @@ which enable the original code blocks to be found."
(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."
+ "Jump from a tangled code file to the related Org mode file."
(interactive)
(let ((mid (point))
start body-start end done
@@ -554,9 +557,8 @@ which enable the original code blocks to be found."
(save-excursion
(while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
(not ; ever wider searches until matching block comments
- (and (setq start (point-at-eol))
- (setq body-start (save-excursion
- (forward-line 2) (point-at-bol)))
+ (and (setq start (line-beginning-position))
+ (setq body-start (line-beginning-position 2))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
@@ -565,29 +567,33 @@ which enable the original code blocks to be found."
(re-search-forward
(concat " " (regexp-quote block-name)
" ends here") nil t)
- (setq end (point-at-bol))))))))
+ (setq end (line-beginning-position))))))))
(unless (and start (< start mid) (< mid end))
(error "Not in tangled code"))
- (setq body (org-babel-trim (buffer-substring start end))))
+ (setq body (buffer-substring body-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)
+ (find-file path)
+ (setq target-buffer (current-buffer))
+ ;; Go to the beginning of the relative block in Org file.
+ (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)))
+ (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))
- ;; position at the beginning of the code block body
(goto-char (org-babel-where-is-src-block-head))
+ ;; Preserve location of point within the source code in tangled
+ ;; code file.
(forward-line 1)
- ;; Use org-edit-special to isolate the code.
- (org-edit-special)
- ;; Then move forward the correct number of characters in the
- ;; code buffer.
(forward-char (- mid body-start))
- ;; And return to the Org-mode buffer with the point in the right
- ;; place.
- (org-edit-src-exit)
(setq target-char (point)))
(org-src-switch-to-buffer target-buffer t)
(prog1 body (goto-char target-char))))
diff --git a/testing/lisp/test-ob-tangle.el b/testing/lisp/test-ob-tangle.el
index 8651a59..5249b16 100644
--- a/testing/lisp/test-ob-tangle.el
+++ b/testing/lisp/test-ob-tangle.el
@@ -36,17 +36,17 @@
;; (org-narrow-to-subtree)
;; (org-babel-tangle target-file))
;; (let ((tang (with-temp-buffer
-;; (insert-file-contents target-file)
-;; (buffer-string))))
+;; (insert-file-contents target-file)
+;; (buffer-string))))
;; (flet ((exp-p (arg)
-;; (and
-;; (string-match
-;; (format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
-;; tang)
-;; (string-match "expanded" (match-string 1 tang)))))
-;; (should (exp-p "yes"))
-;; (should-not (exp-p "no"))
-;; (should (exp-p "tangle"))))))
+;; (and
+;; (string-match
+;; (format "noweb-%s-start\\([^\000]*\\)noweb-%s-end" arg arg)
+;; tang)
+;; (string-match "expanded" (match-string 1 tang)))))
+;; (should (exp-p "yes"))
+;; (should-not (exp-p "no"))
+;; (should (exp-p "tangle"))))))
(ert-deftest ob-tangle/no-excessive-id-insertion-on-tangle ()
"Don't add IDs to headings without tangling code blocks."
@@ -60,13 +60,13 @@
"Test that the :noweb-ref header argument is used correctly."
(org-test-at-id "54d68d4b-1544-4745-85ab-4f03b3cbd8a0"
(let ((tangled
- "df|sed '1d'|awk '{print $5 \" \" $6}'|sort -n |tail -1|awk '{print $2}'"))
+ "df|sed '1d'|awk '{print $5 \" \" $6}'|sort -n |tail -1|awk '{print $2}'"))
(org-narrow-to-subtree)
(org-babel-tangle)
(with-temp-buffer
- (insert-file-contents "babel.sh")
- (goto-char (point-min))
- (should (re-search-forward (regexp-quote tangled) nil t)))
+ (insert-file-contents "babel.sh")
+ (goto-char (point-min))
+ (should (re-search-forward (regexp-quote tangled) nil t)))
(delete-file "babel.sh"))))
(ert-deftest ob-tangle/expand-headers-as-noweb-references ()
@@ -78,21 +78,21 @@
(should (string-match (regexp-quote "length 14") expanded)))))
(ert-deftest ob-tangle/comment-links-at-left-margin ()
- "Test commenting of links at left margin."
+ "Test commenting of links at left margin."
(should
(string-match
(regexp-quote "# [[http://orgmode.org][Org mode]]")
(org-test-with-temp-text-in-file
- "[[http://orgmode.org][Org mode]]
+ "[[http://orgmode.org][Org mode]]
#+header: :comments org :tangle \"test-ob-tangle.sh\"
#+begin_src sh
echo 1
#+end_src"
(unwind-protect
- (progn (org-babel-tangle)
- (with-temp-buffer (insert-file-contents "test-ob-tangle.sh")
- (buffer-string)))
- (delete-file "test-ob-tangle.sh"))))))
+ (progn (org-babel-tangle)
+ (with-temp-buffer (insert-file-contents "test-ob-tangle.sh")
+ (buffer-string)))
+ (delete-file "test-ob-tangle.sh"))))))
(ert-deftest ob-tangle/comment-links-numbering ()
"Test numbering of source blocks when commenting with links."
@@ -109,16 +109,92 @@ echo 1
2
#+end_src"
(unwind-protect
- (progn
- (org-babel-tangle)
- (with-temp-buffer
- (insert-file-contents "test-ob-tangle.el")
- (buffer-string)
- (goto-char (point-min))
- (and (search-forward "[H:1]]" nil t)
- (search-forward "[H:2]]" nil t))))
+ (progn
+ (org-babel-tangle)
+ (with-temp-buffer
+ (insert-file-contents "test-ob-tangle.el")
+ (buffer-string)
+ (goto-char (point-min))
+ (and (search-forward "[H:1]]" nil t)
+ (search-forward "[H:2]]" nil t))))
(delete-file "test-ob-tangle.el")))))
+(ert-deftest ob-tangle/jump-to-org ()
+ "Test `org-babel-tangle-jump-to-org' specifications."
+ ;; Standard test.
+ (should
+ (equal
+ "* H\n#+begin_src emacs-lisp\n1\n#+end_src"
+ (org-test-with-temp-text-in-file
+ "* H\n#+begin_src emacs-lisp\n1\n#+end_src"
+ (let ((file (buffer-file-name)))
+ (org-test-with-temp-text
+ (format ";; [[file:%s][H:1]]\n<point>1\n;; H:1 ends here\n"
+ (file-name-nondirectory file))
+ (org-babel-tangle-jump-to-org)
+ (buffer-string))))))
+ ;; Multiple blocks in the same section.
+ (should
+ (equal
+ "2"
+ (org-test-with-temp-text-in-file
+ "* H
+
+first block
+
+#+begin_src emacs-lisp
+1
+#+end_src
+
+another block
+
+#+begin_src emacs-lisp
+2
+#+end_src
+"
+ (let ((file (buffer-file-name)))
+ (org-test-with-temp-text
+ (format ";; [[file:%s][H:2]]\n<point>2\n;; H:2 ends here\n"
+ (file-name-nondirectory file))
+ (org-babel-tangle-jump-to-org)
+ (buffer-substring (line-beginning-position)
+ (line-end-position)))))))
+ ;; Preserve position within the source code.
+ (should
+ (equal
+ "1)"
+ (org-test-with-temp-text-in-file
+ "* H\n#+begin_src emacs-lisp\n(+ 1 1)\n#+end_src"
+ (let ((file (buffer-file-name)))
+ (org-test-with-temp-text
+ (format ";; [[file:%s][H:1]]\n(+ 1 <point>1)\n;; H:1 ends here\n"
+ (file-name-nondirectory file))
+ (org-babel-tangle-jump-to-org)
+ (buffer-substring-no-properties (point) (line-end-position)))))))
+ ;; Blocks before first heading.
+ (should
+ (equal
+ "Buffer start\n#+begin_src emacs-lisp\n1\n#+end_src\n* H"
+ (org-test-with-temp-text-in-file
+ "Buffer start\n#+begin_src emacs-lisp\n1\n#+end_src\n* H"
+ (let ((file (buffer-file-name)))
+ (org-test-with-temp-text
+ (format ";; [[file:%s][H:1]]\n<point>1\n;; H:1 ends here\n"
+ (file-name-nondirectory file))
+ (org-babel-tangle-jump-to-org)
+ (buffer-string))))))
+ ;; Special case: buffer starts with a source block.
+ (should
+ (equal
+ "#+begin_src emacs-lisp\n1\n#+end_src\n* H"
+ (org-test-with-temp-text-in-file
+ "#+begin_src emacs-lisp\n1\n#+end_src\n* H"
+ (let ((file (buffer-file-name)))
+ (org-test-with-temp-text
+ (format ";; [[file:%s][H:1]]\n<point>1\n;; H:1 ends here\n"
+ (file-name-nondirectory file))
+ (org-babel-tangle-jump-to-org)
+ (buffer-string)))))))
(provide 'test-ob-tangle)