ob: Fix block evaluation in a narrowed buffer

* lisp/ob.el (org-babel-where-is-src-block-result): Insert new results
  keyword in current narrowed part of buffer, if necessary. Small
  refactoring.
(org-babel-insert-result): Do not widen buffer when new results have
to be inserted.  Therefore, results inserted after the last block of
a narrowed buffer still belong to the narrowed part of the buffer.
* testing/lisp/test-ob.el: Add tests.
* testing/lisp/test-ob-exp.el: Move test to test-ob.el
This commit is contained in:
Nicolas Goaziou 2012-10-24 17:23:20 +02:00
parent ccc98ebc2d
commit 2f2a80fe06
3 changed files with 237 additions and 160 deletions

View File

@ -1723,63 +1723,58 @@ following the source block."
(head (unless on-lob-line (org-babel-where-is-src-block-head)))
found beg end)
(when head (goto-char head))
(setq
found ;; was there a result (before we potentially insert one)
(or
inlinep
(and
;; named results:
;; - return t if it is found, else return nil
;; - if it does not need to be rebuilt, then don't set end
;; - if it does need to be rebuilt then do set end
name (setq beg (org-babel-find-named-result name))
(prog1 beg
(when (and hash (not (string= hash (match-string 3))))
(goto-char beg) (setq end beg) ;; beginning of result
(forward-line 1)
(delete-region end (org-babel-result-end)) nil)))
(and
;; unnamed results:
;; - return t if it is found, else return nil
;; - if it is found, and the hash doesn't match, delete and set end
(or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t))
(progn (end-of-line 1)
(if (eobp) (insert "\n") (forward-char 1))
(setq end (point))
(or (and (not name)
(progn ;; unnamed results line already exists
(re-search-forward "[^ \f\t\n\r\v]" nil t)
(beginning-of-line 1)
(looking-at
(concat org-babel-result-regexp "\n")))
(prog1 (point)
;; must remove and rebuild if hash!=old-hash
(if (and hash (not (string= hash (match-string 3))))
(prog1 nil
(forward-line 1)
(delete-region
end (org-babel-result-end)))
(setq end nil)))))))))
(if (and insert end)
(progn
(goto-char end)
(unless beg
(if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
(insert (concat
(if indent
(mapconcat
(lambda (el) " ")
(org-number-sequence 1 indent) "")
"")
"#+" org-babel-results-keyword
(when hash (concat "["hash"]"))
":"
(when name (concat " " name)) "\n"))
(unless beg (insert "\n") (backward-char))
(beginning-of-line 0)
(if hash (org-babel-hide-hash))
(point))
found))))
(org-with-wide-buffer
(setq
found ;; was there a result (before we potentially insert one)
(or
inlinep
(and
;; named results:
;; - return t if it is found, else return nil
;; - if it does not need to be rebuilt, then don't set end
;; - if it does need to be rebuilt then do set end
name (setq beg (org-babel-find-named-result name))
(prog1 beg
(when (and hash (not (string= hash (match-string 3))))
(goto-char beg) (setq end beg) ;; beginning of result
(forward-line 1)
(delete-region end (org-babel-result-end)) nil)))
(and
;; unnamed results:
;; - return t if it is found, else return nil
;; - if it is found, and the hash doesn't match, delete and set end
(or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t))
(progn (end-of-line 1)
(if (eobp) (insert "\n") (forward-char 1))
(setq end (point))
(or (and (not name)
(progn ;; unnamed results line already exists
(re-search-forward "[^ \f\t\n\r\v]" nil t)
(beginning-of-line 1)
(looking-at
(concat org-babel-result-regexp "\n")))
(prog1 (point)
;; must remove and rebuild if hash!=old-hash
(if (and hash (not (string= hash (match-string 3))))
(prog1 nil
(forward-line 1)
(delete-region
end (org-babel-result-end)))
(setq end nil))))))))))
(if (not (and insert end)) found
(goto-char end)
(unless beg
(if (looking-at "[\n\r]") (forward-char 1) (insert "\n")))
(insert (concat
(when (wholenump indent) (make-string indent ? ))
"#+" org-babel-results-keyword
(when hash (concat "["hash"]"))
":"
(when name (concat " " name)) "\n"))
(unless beg (insert "\n") (backward-char))
(beginning-of-line 0)
(if hash (org-babel-hide-hash))
(point)))))
(defvar org-block-regexp)
(defun org-babel-read-result ()
@ -1888,7 +1883,6 @@ code ---- the results are extracted in the syntax of the source
inside of a #+BEGIN_SRC block with the source-code
language set appropriately. Note this relies on the
optional LANG argument."
(save-restriction (widen)
(if (stringp result)
(progn
(setq result (org-no-properties result))
@ -1915,6 +1909,14 @@ code ---- the results are extracted in the syntax of the source
t info hash indent)))
(results-switches
(cdr (assoc :results_switches (nth 2 info))))
(visible-beg (copy-marker (point-min)))
(visible-end (copy-marker (point-max)))
;; When results exist outside of the current visible
;; region of the buffer, be sure to widen buffer to
;; update them.
(outside-scope-p (and existing-result
(or (> visible-beg existing-result)
(<= visible-end existing-result))))
beg end)
(when (and (stringp result) ; ensure results end in a newline
(not inlinep)
@ -1922,97 +1924,103 @@ code ---- the results are extracted in the syntax of the source
(not (or (string-equal (substring result -1) "\n")
(string-equal (substring result -1) "\r"))))
(setq result (concat result "\n")))
(if (not existing-result)
(setq beg (or inlinep (point)))
(goto-char existing-result)
(save-excursion
(re-search-forward "#" nil t)
(setq indent (- (current-column) 1)))
(forward-line 1)
(setq beg (point))
(cond
((member "replace" result-params)
(delete-region (point) (org-babel-result-end)))
((member "append" result-params)
(goto-char (org-babel-result-end)) (setq beg (point-marker)))
((member "prepend" result-params)))) ; already there
(setq results-switches
(if results-switches (concat " " results-switches) ""))
(let ((wrap (lambda (start finish)
(goto-char end) (insert (concat finish "\n"))
(goto-char beg) (insert (concat start "\n"))
(org-escape-code-in-region (point) end)
(goto-char end) (goto-char (point-at-eol))
(setq end (point-marker))))
(proper-list-p (lambda (it) (and (listp it) (null (cdr (last it)))))))
;; insert results based on type
(cond
;; do nothing for an empty result
((null result))
;; insert a list if preferred
((member "list" result-params)
(insert
(org-babel-trim
(org-list-to-generic
(cons 'unordered
(mapcar
(lambda (el) (list nil (if (stringp el) el (format "%S" el))))
(if (listp result) result (list result))))
'(:splicep nil :istart "- " :iend "\n")))
"\n"))
;; assume the result is a table if it's not a string
((funcall proper-list-p result)
(goto-char beg)
(insert (concat (orgtbl-to-orgtbl
(if (or (eq 'hline (car result))
(and (listp (car result))
(listp (cdr (car result)))))
result (list result))
'(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
(goto-char beg) (when (org-at-table-p) (org-table-align)))
((and (listp result) (not (funcall proper-list-p result)))
(insert (format "%s\n" result)))
((member "file" result-params)
(when inlinep (goto-char inlinep))
(insert result))
(t (goto-char beg) (insert result)))
(when (funcall proper-list-p result) (goto-char (org-table-end)))
(setq end (point-marker))
;; possibly wrap result
(cond
((assoc :wrap (nth 2 info))
(let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS")))
(funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name))))
((member "html" result-params)
(funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
((member "latex" result-params)
(funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
((member "org" result-params)
(funcall wrap "#+BEGIN_SRC org" "#+END_SRC"))
((member "code" result-params)
(funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
"#+END_SRC"))
((member "raw" result-params)
(goto-char beg) (if (org-at-table-p) (org-cycle)))
((or (member "drawer" result-params)
;; Stay backward compatible with <7.9.2
(member "wrap" result-params))
(funcall wrap ":RESULTS:" ":END:"))
((and (not (funcall proper-list-p result))
(not (member "file" result-params)))
(org-babel-examplize-region beg end results-switches)
(setq end (point)))))
;; possibly indent the results to match the #+results line
(when (and (not inlinep) (numberp indent) indent (> indent 0)
;; in this case `table-align' does the work for us
(not (and (listp result)
(member "append" result-params))))
(indent-rigidly beg end indent))))
(if (null result)
(if (member "value" result-params)
(message "Code block returned no value.")
(message "Code block produced no output."))
(message "Code block evaluation complete.")))))
(unwind-protect
(progn
(when outside-scope-p (widen))
(if (not existing-result)
(setq beg (or inlinep (point)))
(goto-char existing-result)
(save-excursion
(re-search-forward "#" nil t)
(setq indent (- (current-column) 1)))
(forward-line 1)
(setq beg (point))
(cond
((member "replace" result-params)
(delete-region (point) (org-babel-result-end)))
((member "append" result-params)
(goto-char (org-babel-result-end)) (setq beg (point-marker)))
((member "prepend" result-params)))) ; already there
(setq results-switches
(if results-switches (concat " " results-switches) ""))
(let ((wrap (lambda (start finish)
(goto-char end) (insert (concat finish "\n"))
(goto-char beg) (insert (concat start "\n"))
(org-escape-code-in-region (point) end)
(goto-char end) (goto-char (point-at-eol))
(setq end (point-marker))))
(proper-list-p (lambda (it) (and (listp it) (null (cdr (last it)))))))
;; insert results based on type
(cond
;; do nothing for an empty result
((null result))
;; insert a list if preferred
((member "list" result-params)
(insert
(org-babel-trim
(org-list-to-generic
(cons 'unordered
(mapcar
(lambda (el) (list nil (if (stringp el) el (format "%S" el))))
(if (listp result) result (list result))))
'(:splicep nil :istart "- " :iend "\n")))
"\n"))
;; assume the result is a table if it's not a string
((funcall proper-list-p result)
(goto-char beg)
(insert (concat (orgtbl-to-orgtbl
(if (or (eq 'hline (car result))
(and (listp (car result))
(listp (cdr (car result)))))
result (list result))
'(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
(goto-char beg) (when (org-at-table-p) (org-table-align)))
((and (listp result) (not (funcall proper-list-p result)))
(insert (format "%s\n" result)))
((member "file" result-params)
(when inlinep (goto-char inlinep))
(insert result))
(t (goto-char beg) (insert result)))
(when (funcall proper-list-p result) (goto-char (org-table-end)))
(setq end (point-marker))
;; possibly wrap result
(cond
((assoc :wrap (nth 2 info))
(let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS")))
(funcall wrap (concat "#+BEGIN_" name) (concat "#+END_" name))))
((member "html" result-params)
(funcall wrap "#+BEGIN_HTML" "#+END_HTML"))
((member "latex" result-params)
(funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX"))
((member "org" result-params)
(funcall wrap "#+BEGIN_SRC org" "#+END_SRC"))
((member "code" result-params)
(funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches)
"#+END_SRC"))
((member "raw" result-params)
(goto-char beg) (if (org-at-table-p) (org-cycle)))
((or (member "drawer" result-params)
;; Stay backward compatible with <7.9.2
(member "wrap" result-params))
(funcall wrap ":RESULTS:" ":END:"))
((and (not (funcall proper-list-p result))
(not (member "file" result-params)))
(org-babel-examplize-region beg end results-switches)
(setq end (point)))))
;; possibly indent the results to match the #+results line
(when (and (not inlinep) (numberp indent) indent (> indent 0)
;; in this case `table-align' does the work for us
(not (and (listp result)
(member "append" result-params))))
(indent-rigidly beg end indent))
(if (null result)
(if (member "value" result-params)
(message "Code block returned no value.")
(message "Code block produced no output."))
(message "Code block evaluation complete.")))
(when outside-scope-p (narrow-to-region visible-beg visible-end))
(set-marker visible-beg nil)
(set-marker visible-end nil))))))
(defun org-babel-remove-result (&optional info)
"Remove the result of the current source block."

View File

@ -273,17 +273,6 @@ elements in the final html."
(should (string-match (regexp-quote (format nil "%S" '(:foo :bar)))
ascii)))))
(ert-deftest ob-exp/blocks-with-spaces ()
"Test expansion of blocks followed by blank lines."
(should
(equal "#+RESULTS:\n: 3\n\n\n"
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp :exports results
\(+ 1 2)
#+END_SRC\n\n\n"
(let ((org-current-export-file (current-buffer)))
(org-export-blocks-preprocess)
(buffer-string))))))
(provide 'test-ob-exp)

View File

@ -1033,6 +1033,86 @@ Line 3\"
(move-beginning-of-line 0)
(should (looking-at (format ": %d" num))))))
(ert-deftest test-ob/blocks-with-spaces ()
"Test expansion of blocks followed by blank lines."
(should
(equal "#+BEGIN_SRC emacs-lisp
\(+ 1 2)
#+END_SRC
#+RESULTS:
: 3\n\n\n"
(org-test-with-temp-text "#+BEGIN_SRC emacs-lisp
\(+ 1 2)
#+END_SRC\n\n\n"
(progn (org-babel-execute-src-block)
(buffer-string))))))
(ert-deftest test-ob/results-in-narrowed-buffer ()
"Test block execution in a narrowed buffer."
;; If results don't exist, they should be inserted in visible part
;; of the buffer.
(should
(equal
"#+BEGIN_SRC emacs-lisp\n(+ 1 2)\n#+END_SRC\n\n#+RESULTS:\n: 3"
(org-test-with-temp-text
"#+BEGIN_SRC emacs-lisp\n(+ 1 2)\n#+END_SRC\n\nParagraph"
(progn
(narrow-to-region (point) (save-excursion (forward-line 3) (point)))
(org-babel-execute-src-block)
(org-trim (buffer-string))))))
(should
(equal
"#+NAME: test\n#+BEGIN_SRC emacs-lisp\n(+ 1 2)\n#+END_SRC\n\n#+RESULTS: test\n: 3"
(org-test-with-temp-text
"#+NAME: test\n#+BEGIN_SRC emacs-lisp\n(+ 1 2)\n#+END_SRC\n\nParagraph"
(progn
(narrow-to-region (point) (save-excursion (forward-line 4) (point)))
(org-babel-execute-src-block)
(org-trim (buffer-string))))))
;; Results in visible part of buffer, should be updated here.
(should
(equal
"#+NAME: test
#+BEGIN_SRC emacs-lisp
\(+ 1 2)
#+END_SRC
#+RESULTS: test
: 3"
(org-test-with-temp-text
"#+NAME: test
#+BEGIN_SRC emacs-lisp
\(+ 1 2)
#+END_SRC
#+RESULTS: test
: 4
Paragraph"
(progn
(narrow-to-region (point) (save-excursion (forward-line 7) (point)))
(org-babel-execute-src-block)
(org-trim (buffer-string))))))
;; Results in invisible part of buffer, should be updated there.
(org-test-with-temp-text
"#+NAME: test
#+BEGIN_SRC emacs-lisp
\(+ 1 2)
#+END_SRC
#+RESULTS: test
: 4
Paragraph"
(progn
(narrow-to-region (point) (save-excursion (forward-line 4) (point)))
(org-babel-execute-src-block)
(should-not (re-search-forward "^#\\+RESULTS:" nil t))
(widen)
(should (should (re-search-forward "^: 3" nil t))))))
(provide 'test-ob)
;;; test-ob ends here