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

[Aaron Ecay]

* 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)))


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


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

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