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)
"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
keyword and CDR is a plist of affiliated keywords along with
keyword and cdr is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `babel-call' and CDR is a plist
containing `:begin', `:end', `:value', `:post-blank' and
Return a list whose car is `babel-call' and cdr is a plist
containing `:call', `:inside-header', `:arguments',
`:end-header', `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' as keywords."
(save-excursion
(let ((begin (car affiliated))
(post-affiliated (point))
(value (progn (let ((case-fold-search t))
(re-search-forward "call:[ \t]*" nil t))
(buffer-substring-no-properties (point)
(line-end-position))))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
(let* ((begin (car affiliated))
(post-affiliated (point))
(value (progn (search-forward ":" nil t)
(org-trim
(buffer-substring-no-properties
(point) (line-end-position)))))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position))))
(valid-value
(string-match
"\\([^()\n]+?\\)\\(?:\\[\\(.*?\\)\\]\\)?(\\(.*?\\))[ \t]*\\(.*\\)"
value)))
(list 'babel-call
(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
:value value
: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)
"Interpret BABEL-CALL element as Org syntax.
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
@ -2836,7 +2854,8 @@ CONTENTS is its definition, when inline, or nil."
"Parse inline babel call at point, if any.
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.
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))
(looking-at org-babel-inline-lob-one-liner-regexp))
(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)))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point)))
(list 'inline-babel-call
(list :begin begin
(list :call call
:inside-header inside-header
:arguments arguments
:end-header end-header
:begin begin
:end end
:value value
: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)
"Interpret INLINE-BABEL-CALL object as Org syntax.
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

View File

@ -388,16 +388,38 @@ Some other text
"Test `babel-call' parsing."
;; Standard test.
(should
(org-test-with-temp-text "#+CALL: test()"
(org-element-map (org-element-parse-buffer) 'babel-call 'identity)))
(eq 'babel-call
(org-test-with-temp-text "#+CALL: test()"
(org-element-type (org-element-at-point)))))
;; Ignore case.
(should
(org-test-with-temp-text "#+call: test()"
(org-element-map (org-element-parse-buffer) 'babel-call 'identity)))
(eq 'babel-call
(org-test-with-temp-text "#+call: test()"
(org-element-type (org-element-at-point)))))
;; Handle non-empty blank line at the end of buffer.
(should
(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
@ -1091,10 +1113,39 @@ Some other text
(ert-deftest test-org-element/inline-babel-call-parser ()
"Test `inline-babel-call' parser."
;; Standard test.
(should
(org-test-with-temp-text "call_test()"
(org-element-map
(org-element-parse-buffer) 'inline-babel-call 'identity))))
(eq 'inline-babel-call
(org-test-with-temp-text "call_test()"
(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
@ -2445,17 +2496,17 @@ Outside list"
"#+BEGIN_SPECIAL\nTest\n#+END_SPECIAL\n")))
(ert-deftest test-org-element/babel-call-interpreter ()
"Test babel call interpreter."
;; 1. Without argument.
"Test Babel call interpreter."
;; Without argument.
(should (equal (org-test-parse-and-interpret "#+CALL: test()")
"#+CALL: test()\n"))
;; 2. With argument.
;; With argument.
(should (equal (org-test-parse-and-interpret "#+CALL: test(x=2)")
"#+CALL: test(x=2)\n"))
;; 3. With header arguments.
;; With header arguments.
(should (equal (org-test-parse-and-interpret
"#+CALL: test[:results output]()[:results html]")
"#+CALL: test[:results output]()[:results html]\n")))
"#+CALL: test[:results output]() :results html")
"#+CALL: test[:results output]() :results html\n")))
(ert-deftest test-org-element/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 ()
"Test inline babel call interpreter."
;; 1. Without arguments.
;; Without arguments.
(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)")
"call_test(x=2)\n"))
;; 3. With header arguments.
;; With header arguments.
(should (equal (org-test-parse-and-interpret
"call_test[:results output]()[:results html]")
"call_test[:results output]()[:results html]\n")))