org-element: Improve babel calls parsing

* lisp/org-element.el (org-element-babel-call-parser):
(org-element-inline-babel-call-parser): Parse call name, inside
header, arguments and end header.  Update docstring.

* testing/lisp/test-org-element.el (test-org-element/babel-call-parser):
(test-org-element/inline-babel-call-parser):
(test-org-element/babel-call-interpreter):
(test-org-element/inline-babel-call-interpreter): Add tests.
This commit is contained in:
Nicolas Goaziou 2015-04-21 11:54:22 +02:00
parent 797023b84c
commit bf024eed8d
2 changed files with 119 additions and 35 deletions

View File

@ -1609,27 +1609,39 @@ CONTENTS is the contents of the element."
(defun org-element-babel-call-parser (limit affiliated) (defun org-element-babel-call-parser (limit affiliated)
"Parse a babel call. "Parse a babel call.
LIMIT bounds the search. AFFILIATED is a list of which CAR is LIMIT bounds the search. AFFILIATED is a list of which car is
the buffer position at the beginning of the first affiliated the buffer position at the beginning of the first affiliated
keyword and CDR is a plist of affiliated keywords along with keyword and cdr is a plist of affiliated keywords along with
their value. their value.
Return a list whose CAR is `babel-call' and CDR is a plist Return a list whose car is `babel-call' and cdr is a plist
containing `:begin', `:end', `:value', `:post-blank' and containing `:call', `:inside-header', `:arguments',
`:end-header', `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' as keywords." `:post-affiliated' as keywords."
(save-excursion (save-excursion
(let ((begin (car affiliated)) (let* ((begin (car affiliated))
(post-affiliated (point)) (post-affiliated (point))
(value (progn (let ((case-fold-search t)) (value (progn (search-forward ":" nil t)
(re-search-forward "call:[ \t]*" nil t)) (org-trim
(buffer-substring-no-properties (point) (buffer-substring-no-properties
(line-end-position)))) (point) (line-end-position)))))
(pos-before-blank (progn (forward-line) (point))) (pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit) (end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position))))) (if (eobp) (point) (line-beginning-position))))
(valid-value
(string-match
"\\([^()\n]+?\\)\\(?:\\[\\(.*?\\)\\]\\)?(\\(.*?\\))[ \t]*\\(.*\\)"
value)))
(list 'babel-call (list 'babel-call
(nconc (nconc
(list :begin begin (list :call (and valid-value (match-string 1 value))
:inside-header (and valid-value
(org-string-nw-p (match-string 2 value)))
:arguments (and valid-value
(org-string-nw-p (match-string 3 value)))
:end-header (and valid-value
(org-string-nw-p (match-string 4 value)))
:begin begin
:end end :end end
:value value :value value
:post-blank (count-lines pos-before-blank end) :post-blank (count-lines pos-before-blank end)
@ -1639,7 +1651,13 @@ containing `:begin', `:end', `:value', `:post-blank' and
(defun org-element-babel-call-interpreter (babel-call contents) (defun org-element-babel-call-interpreter (babel-call contents)
"Interpret BABEL-CALL element as Org syntax. "Interpret BABEL-CALL element as Org syntax.
CONTENTS is nil." CONTENTS is nil."
(concat "#+CALL: " (org-element-property :value babel-call))) (concat "#+CALL: "
(org-element-property :call babel-call)
(let ((h (org-element-property :inside-header babel-call)))
(and h (format "[%s]" h)))
(concat "(" (org-element-property :arguments babel-call) ")")
(let ((h (org-element-property :end-header babel-call)))
(and h (concat " " h)))))
;;;; Clock ;;;; Clock
@ -2836,7 +2854,8 @@ CONTENTS is its definition, when inline, or nil."
"Parse inline babel call at point, if any. "Parse inline babel call at point, if any.
When at an inline babel call, return a list whose car is When at an inline babel call, return a list whose car is
`inline-babel-call' and cdr a plist with `:begin', `:end', `inline-babel-call' and cdr a plist with `:call',
`:inside-header', `:arguments', `:end-header', `:begin', `:end',
`:value' and `:post-blank' as keywords. Otherwise, return nil. `:value' and `:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the babel call." Assume point is at the beginning of the babel call."
@ -2845,12 +2864,20 @@ Assume point is at the beginning of the babel call."
(when (let ((case-fold-search t)) (when (let ((case-fold-search t))
(looking-at org-babel-inline-lob-one-liner-regexp)) (looking-at org-babel-inline-lob-one-liner-regexp))
(let ((begin (match-end 1)) (let ((begin (match-end 1))
(call (org-match-string-no-properties 2))
(inside-header (org-string-nw-p (org-match-string-no-properties 4)))
(arguments (org-string-nw-p (org-match-string-no-properties 6)))
(end-header (org-string-nw-p (org-match-string-no-properties 8)))
(value (buffer-substring-no-properties (match-end 1) (match-end 0))) (value (buffer-substring-no-properties (match-end 1) (match-end 0)))
(post-blank (progn (goto-char (match-end 0)) (post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t"))) (skip-chars-forward " \t")))
(end (point))) (end (point)))
(list 'inline-babel-call (list 'inline-babel-call
(list :begin begin (list :call call
:inside-header inside-header
:arguments arguments
:end-header end-header
:begin begin
:end end :end end
:value value :value value
:post-blank post-blank)))))) :post-blank post-blank))))))
@ -2858,7 +2885,13 @@ Assume point is at the beginning of the babel call."
(defun org-element-inline-babel-call-interpreter (inline-babel-call contents) (defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
"Interpret INLINE-BABEL-CALL object as Org syntax. "Interpret INLINE-BABEL-CALL object as Org syntax.
CONTENTS is nil." CONTENTS is nil."
(org-element-property :value inline-babel-call)) (concat "call_"
(org-element-property :call inline-babel-call)
(let ((h (org-element-property :inside-header inline-babel-call)))
(and h (format "[%s]" h)))
"(" (org-element-property :arguments inline-babel-call) ")"
(let ((h (org-element-property :end-header inline-babel-call)))
(and h (format "[%s]" h)))))
;;;; Inline Src Block ;;;; Inline Src Block

View File

@ -388,16 +388,38 @@ Some other text
"Test `babel-call' parsing." "Test `babel-call' parsing."
;; Standard test. ;; Standard test.
(should (should
(org-test-with-temp-text "#+CALL: test()" (eq 'babel-call
(org-element-map (org-element-parse-buffer) 'babel-call 'identity))) (org-test-with-temp-text "#+CALL: test()"
(org-element-type (org-element-at-point)))))
;; Ignore case. ;; Ignore case.
(should (should
(org-test-with-temp-text "#+call: test()" (eq 'babel-call
(org-element-map (org-element-parse-buffer) 'babel-call 'identity))) (org-test-with-temp-text "#+call: test()"
(org-element-type (org-element-at-point)))))
;; Handle non-empty blank line at the end of buffer. ;; Handle non-empty blank line at the end of buffer.
(should (should
(org-test-with-temp-text "#+CALL: test()\n " (org-test-with-temp-text "#+CALL: test()\n "
(= (org-element-property :end (org-element-at-point)) (point-max))))) (= (org-element-property :end (org-element-at-point)) (point-max))))
;; Parse call name.
(should
(equal "test"
(org-test-with-temp-text "#+CALL: test()"
(org-element-property :call (org-element-at-point)))))
;; Parse inside header.
(should
(equal ":results output"
(org-test-with-temp-text "#+CALL: test[:results output]()"
(org-element-property :inside-header (org-element-at-point)))))
;; Parse arguments.
(should
(equal "n=4"
(org-test-with-temp-text "#+CALL: test(n=4)"
(org-element-property :arguments (org-element-at-point)))))
;; Parse end header.
(should
(equal ":results html"
(org-test-with-temp-text "#+CALL: test() :results html"
(org-element-property :end-header (org-element-at-point))))))
;;;; Bold ;;;; Bold
@ -1091,10 +1113,39 @@ Some other text
(ert-deftest test-org-element/inline-babel-call-parser () (ert-deftest test-org-element/inline-babel-call-parser ()
"Test `inline-babel-call' parser." "Test `inline-babel-call' parser."
;; Standard test.
(should (should
(org-test-with-temp-text "call_test()" (eq 'inline-babel-call
(org-element-map (org-test-with-temp-text "call_test()"
(org-element-parse-buffer) 'inline-babel-call 'identity)))) (org-element-type (org-element-context)))))
(should
(eq 'inline-babel-call
(org-test-with-temp-text "call_test[:results output](x=2)[:results html]"
(org-element-type (org-element-context)))))
;; Parse call name.
(should
(equal
"test"
(org-test-with-temp-text "call_test[:results output](x=2)[:results html]"
(org-element-property :call (org-element-context)))))
;; Parse inside header.
(should
(equal
":results output"
(org-test-with-temp-text "call_test[:results output](x=2)[:results html]"
(org-element-property :inside-header (org-element-context)))))
;; Parse arguments.
(should
(equal
"x=2"
(org-test-with-temp-text "call_test[:results output](x=2)[:results html]"
(org-element-property :arguments (org-element-context)))))
;; Parse end header.
(should
(equal
":results html"
(org-test-with-temp-text "call_test[:results output](x=2)[:results html]"
(org-element-property :end-header (org-element-context))))))
;;;; Inline Src Block ;;;; Inline Src Block
@ -2445,17 +2496,17 @@ Outside list"
"#+BEGIN_SPECIAL\nTest\n#+END_SPECIAL\n"))) "#+BEGIN_SPECIAL\nTest\n#+END_SPECIAL\n")))
(ert-deftest test-org-element/babel-call-interpreter () (ert-deftest test-org-element/babel-call-interpreter ()
"Test babel call interpreter." "Test Babel call interpreter."
;; 1. Without argument. ;; Without argument.
(should (equal (org-test-parse-and-interpret "#+CALL: test()") (should (equal (org-test-parse-and-interpret "#+CALL: test()")
"#+CALL: test()\n")) "#+CALL: test()\n"))
;; 2. With argument. ;; With argument.
(should (equal (org-test-parse-and-interpret "#+CALL: test(x=2)") (should (equal (org-test-parse-and-interpret "#+CALL: test(x=2)")
"#+CALL: test(x=2)\n")) "#+CALL: test(x=2)\n"))
;; 3. With header arguments. ;; With header arguments.
(should (equal (org-test-parse-and-interpret (should (equal (org-test-parse-and-interpret
"#+CALL: test[:results output]()[:results html]") "#+CALL: test[:results output]() :results html")
"#+CALL: test[:results output]()[:results html]\n"))) "#+CALL: test[:results output]() :results html\n")))
(ert-deftest test-org-element/clock-interpreter () (ert-deftest test-org-element/clock-interpreter ()
"Test clock interpreter." "Test clock interpreter."
@ -2801,12 +2852,12 @@ DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu
(ert-deftest test-org-element/inline-babel-call-interpreter () (ert-deftest test-org-element/inline-babel-call-interpreter ()
"Test inline babel call interpreter." "Test inline babel call interpreter."
;; 1. Without arguments. ;; Without arguments.
(should (equal (org-test-parse-and-interpret "call_test()") "call_test()\n")) (should (equal (org-test-parse-and-interpret "call_test()") "call_test()\n"))
;; 2. With arguments. ;; With arguments.
(should (equal (org-test-parse-and-interpret "call_test(x=2)") (should (equal (org-test-parse-and-interpret "call_test(x=2)")
"call_test(x=2)\n")) "call_test(x=2)\n"))
;; 3. With header arguments. ;; With header arguments.
(should (equal (org-test-parse-and-interpret (should (equal (org-test-parse-and-interpret
"call_test[:results output]()[:results html]") "call_test[:results output]()[:results html]")
"call_test[:results output]()[:results html]\n"))) "call_test[:results output]()[:results html]\n")))