[RFC] [PATCH] [parser] org-element.el: Handle block parameters

[Aaron Ecay <aaronecay@gmail.com>]

* lisp/org-element.el (org-element-center-block-parser,
org-element-quote-block-parser, org-element-special-block-parser,
org-element-verse-block-parser): Add :parameters to return value
(org-element-center-block-interpreter, org-element-quote-block-interpreter,
org-element-special-block-interpreter,
org-element-verse-block-interpreter): Interpret :parameters if present
* testing/lisp/test-org-element.el (test-org-element/center-block-parser,
test-org-element/example-block-parser,
test-org-element/quote-block-parser,
test-org-element/special-block-parser,
test-org-element/special-block-parser,
test-org-element/verse-block-parser,
test-org-element/center-block-interpreter,
test-org-element/quote-block-interpreter,
test-org-element/special-block-interpreter,
test-org-element/example-block-interpreter,
test-org-element/verse-block-interpreter): Update tests to check
:parameters

This brings the parser in line with the Org Syntax as documented on
Worg: <http://orgmode.org/worg/dev/org-syntax.html#Greater_Blocks>.
---

This does not handle paramters for export blocks (#+begin_latex et
al.) or comment blocks, but these would be trivial to add if needed.

 lisp/org-element.el              | 49 ++++++++++++++++++++++++-------
 testing/lisp/test-org-element.el | 63 +++++++++++++++++++++++++++++++++-------
 2 files changed, 92 insertions(+), 20 deletions(-)

diff --git a/lisp/org-element.el b/lisp/org-element.el
index 254af3c..c9ac9a5 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -494,7 +494,7 @@ their value.

 Return a list whose CAR is `center-block' and CDR is a plist
 containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:post-blank' and `:post-affiliated' keywords.
+`:parameters', `:post-blank' and `:post-affiliated' keywords.

 Assume point is at the beginning of the block."
   (let ((case-fold-search t))
@@ -505,6 +505,8 @@ Assume point is at the beginning of the block."
       (let ((block-end-line (match-beginning 0)))
 	(let* ((begin (car affiliated))
 	       (post-affiliated (point))
+               (params (progn (looking-at "[ \t]*#\\+BEGIN_CENTER\\(?: +\\(.*\\)\\)?")
+			      (match-string 1)))
 	       ;; Empty blocks have no contents.
 	       (contents-begin (progn (forward-line)
 				      (and (< (point) block-end-line)
@@ -522,6 +524,7 @@ Assume point is at the beginning of the block."
 		       :end end
 		       :contents-begin contents-begin
 		       :contents-end contents-end
+		       :parameters params
 		       :post-blank (count-lines pos-before-blank end)
 		       :post-affiliated post-affiliated)
 		 (cdr affiliated))))))))
@@ -529,7 +532,11 @@ Assume point is at the beginning of the block."
 (defun org-element-center-block-interpreter (center-block contents)
   "Interpret CENTER-BLOCK element as Org syntax.
 CONTENTS is the contents of the element."
-  (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
+  (format "#+BEGIN_CENTER%s\n%s#+END_CENTER"
+          (if (org-element-property :parameters center-block)
+              (concat " " (org-element-property :parameters center-block))
+            "")
+	  contents))


 ;;;; Drawer
@@ -1338,7 +1345,7 @@ their value.

 Return a list whose CAR is `quote-block' and CDR is a plist
 containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:post-blank' and `:post-affiliated' keywords.
+`:parameters', `:post-blank' and `:post-affiliated' keywords.

 Assume point is at the beginning of the block."
   (let ((case-fold-search t))
@@ -1350,6 +1357,8 @@ Assume point is at the beginning of the block."
 	(save-excursion
 	  (let* ((begin (car affiliated))
 		 (post-affiliated (point))
+                 (params (progn (looking-at "[ \t]*#\\+BEGIN_QUOTE\\(?: +\\(.*\\)\\)?")
+				(match-string 1)))
 		 ;; Empty blocks have no contents.
 		 (contents-begin (progn (forward-line)
 					(and (< (point) block-end-line)
@@ -1367,6 +1376,7 @@ Assume point is at the beginning of the block."
 			 :end end
 			 :contents-begin contents-begin
 			 :contents-end contents-end
+			 :parameters params
 			 :post-blank (count-lines pos-before-blank end)
 			 :post-affiliated post-affiliated)
 		   (cdr affiliated)))))))))
@@ -1374,7 +1384,11 @@ Assume point is at the beginning of the block."
 (defun org-element-quote-block-interpreter (quote-block contents)
   "Interpret QUOTE-BLOCK element as Org syntax.
 CONTENTS is the contents of the element."
-  (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
+  (format "#+BEGIN_QUOTE%s\n%s#+END_QUOTE"
+	  (if (org-element-property :parameters quote-block)
+              (concat " " (org-element-property :parameters quote-block))
+	    "")
+	  contents))


 ;;;; Section
@@ -1421,12 +1435,14 @@ their value.

 Return a list whose CAR is `special-block' and CDR is a plist
 containing `:type', `:begin', `:end', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+`:contents-end', `:parameters', `:post-blank' and `:post-affiliated'
+keywords.

 Assume point is at the beginning of the block."
   (let* ((case-fold-search t)
-	 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
-		      (upcase (match-string-no-properties 1)))))
+	 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)\\(?: +\\(.*\\)\\)?")
+		      (upcase (match-string-no-properties 1))))
+         (params (match-string-no-properties 2)))
     (if (not (save-excursion
 	       (re-search-forward
 		(format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
@@ -1455,6 +1471,7 @@ Assume point is at the beginning of the block."
 			 :end end
 			 :contents-begin contents-begin
 			 :contents-end contents-end
+			 :parameters params
 			 :post-blank (count-lines pos-before-blank end)
 			 :post-affiliated post-affiliated)
 		   (cdr affiliated)))))))))
@@ -1463,7 +1480,12 @@ Assume point is at the beginning of the block."
   "Interpret SPECIAL-BLOCK element as Org syntax.
 CONTENTS is the contents of the element."
   (let ((block-type (org-element-property :type special-block)))
-    (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type)))
+    (format "#+BEGIN_%s%s\n%s#+END_%s"
+	    block-type
+	    (if (org-element-property :parameters special-block)
+                (concat " " (org-element-property :parameters special-block))
+	      "")
+	    contents block-type)))


 \f
@@ -2491,7 +2513,7 @@ their value.

 Return a list whose CAR is `verse-block' and CDR is a plist
 containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:post-blank' and `:post-affiliated' keywords.
+`:parameters', `:post-blank' and `:post-affiliated' keywords.

 Assume point is at beginning of the block."
   (let ((case-fold-search t))
@@ -2503,6 +2525,8 @@ Assume point is at beginning of the block."
 	(save-excursion
 	  (let* ((begin (car affiliated))
 		 (post-affiliated (point))
+                 (params (progn (looking-at "[ \t]*#\\+BEGIN_VERSE\\(?: +\\(.*\\)\\)?")
+                                (match-string 1)))
 		 (contents-begin (progn (forward-line) (point)))
 		 (pos-before-blank (progn (goto-char contents-end)
 					  (forward-line)
@@ -2516,6 +2540,7 @@ Assume point is at beginning of the block."
 			 :end end
 			 :contents-begin contents-begin
 			 :contents-end contents-end
+			 :parameters params
 			 :post-blank (count-lines pos-before-blank end)
 			 :post-affiliated post-affiliated)
 		   (cdr affiliated)))))))))
@@ -2523,7 +2548,11 @@ Assume point is at beginning of the block."
 (defun org-element-verse-block-interpreter (verse-block contents)
   "Interpret VERSE-BLOCK element as Org syntax.
 CONTENTS is verse block contents."
-  (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
+  (format "#+BEGIN_VERSE%s\n%s#+END_VERSE"
+          (if (org-element-property :parameters verse-block)
+              (concat " " (org-element-property :parameters verse-block))
+            "")
+	  contents))


 \f
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 4f08e3e..7d29f3e 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -277,7 +277,14 @@ Some other text
   (should-not
    (org-test-with-temp-text "#+BEGIN_CENTER"
      (org-element-map
-      (org-element-parse-buffer) 'center-block 'identity nil t))))
+      (org-element-parse-buffer) 'center-block 'identity nil t)))
+  ;; Parameters
+  (should (equal (org-element-property
+		  :parameters
+		  (org-test-with-temp-text
+		      "#+BEGIN_CENTER param\nText\n#+END_CENTER"
+		    (org-element-at-point)))
+		 "param")))


 ;;;; Clock
@@ -1535,7 +1542,14 @@ Outside list"
   (should-not
    (org-test-with-temp-text "#+BEGIN_QUOTE"
      (org-element-map
-      (org-element-parse-buffer) 'quote-block 'identity nil t))))
+      (org-element-parse-buffer) 'quote-block 'identity nil t)))
+  ;; Parameters
+  (should (equal (org-element-property
+		  :parameters
+		  (org-test-with-temp-text
+		      "#+BEGIN_QUOTE param\nText\n#+END_QUOTE"
+		    (org-element-at-point)))
+                 "param")))


 ;;;; Quote Section
@@ -1616,8 +1630,14 @@ Outside list"
 	  (org-test-with-temp-text "#+BEGIN_SPECIAL*\nContents\n#+END_SPECIAL*"
 	    (let ((element (org-element-at-point)))
 	      (list (org-element-type element)
-		    (org-element-property :type element)))))))
-
+		    (org-element-property :type element))))))
+  ;; Parameters
+  (should (equal (org-element-property
+		  :parameters
+		  (org-test-with-temp-text
+		      "#+BEGIN_SPECIAL param\nText\n#+END_SPECIAL"
+		    (org-element-at-point)))
+		 "param")))

 ;;;; Src Block

@@ -1916,8 +1936,14 @@ Outside list"
   (should-not
    (org-test-with-temp-text "#+BEGIN_VERSE"
      (org-element-map
-	 (org-element-parse-buffer) 'verse-block 'identity nil t))))
-
+	 (org-element-parse-buffer) 'verse-block 'identity nil t)))
+  ;; Parameters
+  (should (equal (org-element-property
+		  :parameters
+		  (org-test-with-temp-text
+		      "#+BEGIN_VERSE param\nText\n#+END_VERSE"
+		    (org-element-at-point)))
+		 "param")))

 \f
 ;;; Test Interpreters.
@@ -1960,7 +1986,10 @@ Outside list"
   "Test center block interpreter."
   (should
    (equal (org-test-parse-and-interpret "#+BEGIN_CENTER\nTest\n#+END_CENTER")
-	  "#+BEGIN_CENTER\nTest\n#+END_CENTER\n")))
+	  "#+BEGIN_CENTER\nTest\n#+END_CENTER\n"))
+  (should
+   (equal (org-test-parse-and-interpret "#+BEGIN_CENTER param\nTest\n#+END_CENTER")
+          "#+BEGIN_CENTER param\nTest\n#+END_CENTER\n")))

 (ert-deftest test-org-element/drawer-interpreter ()
   "Test drawer interpreter."
@@ -2108,13 +2137,19 @@ Outside list"
   "Test quote block interpreter."
   (should (equal (org-test-parse-and-interpret
 		  "#+BEGIN_QUOTE\nTest\n#+END_QUOTE")
-		 "#+BEGIN_QUOTE\nTest\n#+END_QUOTE\n")))
+		 "#+BEGIN_QUOTE\nTest\n#+END_QUOTE\n"))
+  (should (equal (org-test-parse-and-interpret
+                  "#+BEGIN_QUOTE param\nTest\n#+END_QUOTE")
+                 "#+BEGIN_QUOTE param\nTest\n#+END_QUOTE\n")))

 (ert-deftest test-org-element/special-block-interpreter ()
   "Test special block interpreter."
   (should (equal (org-test-parse-and-interpret
 		  "#+BEGIN_SPECIAL\nTest\n#+END_SPECIAL")
-		 "#+BEGIN_SPECIAL\nTest\n#+END_SPECIAL\n")))
+		 "#+BEGIN_SPECIAL\nTest\n#+END_SPECIAL\n"))
+  (should (equal (org-test-parse-and-interpret
+                  "#+BEGIN_SPECIAL param\nTest\n#+END_SPECIAL")
+                 "#+BEGIN_SPECIAL param\nTest\n#+END_SPECIAL\n")))

 (ert-deftest test-org-element/babel-call-interpreter ()
   "Test babel call interpreter."
@@ -2180,6 +2215,11 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] =>  0:01"))
    (equal (org-test-parse-and-interpret
 	   "#+BEGIN_EXAMPLE -n -k\n(+ 1 1)\n#+END_EXAMPLE")
 	  "#+BEGIN_EXAMPLE -n -k\n(+ 1 1)\n#+END_EXAMPLE\n"))
+  ;; With arbitrary parameter
+  (should
+   (equal (org-test-parse-and-interpret
+           "#+BEGIN_EXAMPLE param\n(+ 1 1)\n#+END_EXAMPLE")
+          "#+BEGIN_EXAMPLE param\n(+ 1 1)\n#+END_EXAMPLE\n"))
   ;; Preserve code escaping.
   (should
    (equal (org-test-parse-and-interpret
@@ -2408,7 +2448,10 @@ DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n"))))
   "Test verse block interpretation."
   (should
    (equal (org-test-parse-and-interpret "#+BEGIN_VERSE\nTest\n#+END_VERSE")
-	  "#+BEGIN_VERSE\nTest\n#+END_VERSE\n")))
+	  "#+BEGIN_VERSE\nTest\n#+END_VERSE\n"))
+  (should
+   (equal (org-test-parse-and-interpret "#+BEGIN_VERSE param\nTest\n#+END_VERSE")
+          "#+BEGIN_VERSE param\nTest\n#+END_VERSE\n")))

 (ert-deftest test-org-element/bold-interpreter ()
   "Test bold interpreter."
--
1.8.4.1