diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-01-31 11:37:05 +0100 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2016-01-31 20:38:35 +0100 |
commit | 67efff2fd81b75493ba082f4c14e2cc6755f2e21 (patch) | |
tree | 3eaaaf78e169dbf79fe4ed73cb4b84a19071211c | |
parent | 7d6b8f51ec1993a66a385b98b2df42d0853fe289 (diff) | |
download | org-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.el | 42 | ||||
-rw-r--r-- | testing/lisp/test-ob-tangle.el | 132 |
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) |