瀏覽代碼

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.
Nicolas Goaziou 10 年之前
父節點
當前提交
bf024eed8d
共有 2 個文件被更改,包括 119 次插入35 次删除
  1. 51 18
      lisp/org-element.el
  2. 68 17
      testing/lisp/test-org-element.el

+ 51 - 18
lisp/org-element.el

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

+ 68 - 17
testing/lisp/test-org-element.el

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