Merge branch 'maint'

This commit is contained in:
Nicolas Goaziou 2016-01-31 20:47:06 +01:00
commit 06e144adef
4 changed files with 215 additions and 54 deletions

View File

@ -38,7 +38,9 @@
(defvar org-babel-call-process-region-original nil)
(defvar org-src-lang-modes)
(defvar org-babel-library-of-babel)
(declare-function outline-show-all "outline" ())
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-remove-indentation "org" (code &optional n))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function tramp-compat-make-temp-file "tramp-compat"
@ -96,6 +98,7 @@
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-type "org-element" (element))
(declare-function org-element-at-point "org-element" ())
(declare-function org-element-normalize-string "org-element" (s))
(declare-function org-element-property "org-element" (property element))
(declare-function org-macro-escape-arguments "org-macro" (&rest args))
@ -1705,13 +1708,17 @@ to the table for reinsertion to org-mode."
(org-babel-put-colnames table colnames) table))
table))
(defun org-babel-where-is-src-block-head ()
(defun org-babel-where-is-src-block-head (&optional src-block)
"Find where the current source block begins.
If optional argument SRC-BLOCK is `src-block' type element, find
its current beginning instead.
Return the point at the beginning of the current source block.
Specifically at the beginning of the #+BEGIN_SRC line. Also set
match-data relatively to `org-babel-src-block-regexp', which see.
If the point is not on a source block then return nil."
(let ((element (org-element-at-point)))
(let ((element (or src-block (org-element-at-point))))
(when (eq (org-element-type element) 'src-block)
(let ((end (org-element-property :end element)))
(org-with-wide-buffer
@ -2492,12 +2499,30 @@ file's directory then expand relative links."
(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 a source block")
(save-match-data
(replace-match (concat (org-babel-trim (org-remove-indentation new-body))
"\n") nil t nil 5))
(indent-rigidly (match-beginning 5) (match-end 5) 2)))
(let ((element (org-element-at-point)))
(unless (eq (org-element-type element) 'src-block)
(error "Not in a source block"))
(goto-char (org-babel-where-is-src-block-head element))
(let* ((ind (org-get-indentation))
(body-start (line-beginning-position 2))
(body (org-element-normalize-string
(if (or org-src-preserve-indentation
(org-element-property :preserve-indent element))
new-body
(with-temp-buffer
(insert (org-remove-indentation new-body))
(indent-rigidly
(point-min)
(point-max)
(+ ind org-edit-src-content-indentation))
(buffer-string))))))
(delete-region body-start
(org-with-wide-buffer
(goto-char (org-element-property :end element))
(skip-chars-backward " \t\n")
(line-beginning-position)))
(goto-char body-start)
(insert body))))
(defun org-babel-merge-params (&rest plists)
"Combine all parameter association lists in PLISTS.

View File

@ -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))))

View File

@ -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)

View File

@ -1513,6 +1513,60 @@ echo \"$data\"
(message (car pair))
(should (eq (org-test-babel-confirm-evaluate (car pair)) (cdr pair)))))))
(defun org-test-ob/update-block-body ()
"Test `org-babel-update-block-body' specifications."
(should
(equal "#+begin_src elisp\n 2\n#+end_src"
(let ((org-edit-src-content-indentation 2))
(org-test-with-temp-text "#+begin_src elisp\n(+ 1 1)\n#+end_src"
(org-babel-update-block-body "2")
(buffer-string)))))
;; Preserve block indentation.
(should
(equal " #+begin_src elisp\n 2\n #+end_src"
(let ((org-edit-src-content-indentation 1))
(org-test-with-temp-text
" #+begin_src elisp\n (+ 1 1)\n #+end_src"
(org-babel-update-block-body "2")
(buffer-string)))))
;; Ignore NEW-BODY global indentation.
(should
(equal "#+begin_src elisp\n 2\n#+end_src"
(let ((org-edit-src-content-indentation 2))
(org-test-with-temp-text "#+begin_src elisp\n(+ 1 1)\n#+end_src"
(org-babel-update-block-body " 2")
(buffer-string)))))
;; When indentation should be preserved ignore the two rules above.
(should
(equal " #+begin_src elisp\n2\n #+end_src"
(let ((org-edit-src-content-indentation 1)
(org-src-preserve-indentation t))
(org-test-with-temp-text
" #+begin_src elisp\n (+ 1 1)\n #+end_src"
(org-babel-update-block-body "2")
(buffer-string)))))
(should
(equal " #+begin_src elisp -i\n2\n #+end_src"
(let ((org-edit-src-content-indentation 1))
(org-test-with-temp-text
" #+begin_src elisp -i\n (+ 1 1)\n #+end_src"
(org-babel-update-block-body "2")
(buffer-string)))))
(should
(equal "#+begin_src elisp\n 2\n#+end_src"
(let ((org-edit-src-content-indentation 2)
(org-src-preserve-indentation t))
(org-test-with-temp-text "#+begin_src elisp\n(+ 1 1)\n#+end_src"
(org-babel-update-block-body " 2")
(buffer-string)))))
(should
(equal "#+begin_src elisp -i\n 2\n#+end_src"
(let ((org-edit-src-content-indentation 2)
(org-src-preserve-indentation t))
(org-test-with-temp-text "#+begin_src elisp -i\n(+ 1 1)\n#+end_src"
(org-babel-update-block-body " 2")
(buffer-string))))))
(provide 'test-ob)
;;; test-ob ends here