Browse Source

org-element: Parse diary-sexp elements

* lisp/org-element.el (org-element-paragraph-separate): Diary-sexp
  elements can separate paragraphs.
(org-element-all-elements): Install new `diary-sexp' type.
(org-element--current-element): Recognize new `diary-sexp' elements.
(org-element-diary-sexp-parser, org-element-diary-sexp-interpreter):
New functions.
* testing/lisp/test-org-element.el: Add tests.
Nicolas Goaziou 12 years ago
parent
commit
d81982ae9d
2 changed files with 77 additions and 11 deletions
  1. 52 11
      lisp/org-element.el
  2. 25 0
      testing/lisp/test-org-element.el

+ 52 - 11
lisp/org-element.el

@@ -46,11 +46,12 @@
 ;; and `special-block'.
 ;;
 ;; Other element types are: `babel-call', `clock', `comment',
-;; `comment-block', `example-block', `export-block', `fixed-width',
-;; `horizontal-rule', `keyword', `latex-environment', `node-property',
-;; `paragraph', `planning', `quote-section', `src-block', `table',
-;; `table-row' and `verse-block'.  Among them, `paragraph' and
-;; `verse-block' types can contain Org objects and plain text.
+;; `comment-block', `diary-sexp', `example-block', `export-block',
+;; `fixed-width', `horizontal-rule', `keyword', `latex-environment',
+;; `node-property', `paragraph', `planning', `quote-section',
+;; `src-block', `table', `table-row' and `verse-block'.  Among them,
+;; `paragraph' and `verse-block' types can contain Org objects and
+;; plain text.
 ;;
 ;; Objects are related to document's contents.  Some of them are
 ;; recursive.  Associated types are of the following: `bold', `code',
@@ -132,6 +133,8 @@
           org-outline-regexp "\\|"
           ;; Footnote definitions.
 	  "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+	  ;; Diary sexps.
+	  "%%(" "\\|"
           "[ \t]*\\(?:"
           ;; Empty lines.
           "$" "\\|"
@@ -164,12 +167,12 @@ is not sufficient to know if point is at a paragraph ending.  See
 `org-element-paragraph-parser' for more information.")
 
 (defconst org-element-all-elements
-  '(babel-call center-block clock comment comment-block drawer dynamic-block
-	       example-block export-block fixed-width footnote-definition
-	       headline horizontal-rule inlinetask item keyword
-	       latex-environment node-property paragraph plain-list planning
-	       property-drawer quote-block quote-section section special-block
-	       src-block table table-row verse-block)
+  '(babel-call center-block clock comment comment-block diary-sexp drawer
+	       dynamic-block example-block export-block fixed-width
+	       footnote-definition headline horizontal-rule inlinetask item
+	       keyword latex-environment node-property paragraph plain-list
+	       planning property-drawer quote-block quote-section section
+	       special-block src-block table table-row verse-block)
   "Complete list of element types.")
 
 (defconst org-element-greater-elements
@@ -1559,6 +1562,41 @@ CONTENTS is nil."
 	  (org-remove-indentation (org-element-property :value comment-block))))
 
 
+;;;; Diary Sexp
+
+(defun org-element-diary-sexp-parser (limit affiliated)
+  "Parse a diary sexp.
+
+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
+their value.
+
+Return a list whose CAR is `diary-sexp' and CDR is a plist
+containing `:begin', `:end', `:value' and `:post-blank'
+keywords."
+  (save-excursion
+    (let ((begin (car affiliated))
+	  (value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
+			(org-match-string-no-properties 1)))
+	  (pos-before-blank (progn (forward-line) (point)))
+	  (end (progn (skip-chars-forward " \r\t\n" limit)
+		      (skip-chars-backward " \t")
+		      (if (bolp) (point) (line-end-position)))))
+      (list 'diary-sexp
+	    (nconc
+	     (list :value value
+		   :begin begin
+		   :end end
+		   :post-blank (count-lines pos-before-blank end))
+	     (cdr affiliated))))))
+
+(defun org-element-diary-sexp-interpreter (diary-sexp contents)
+  "Interpret DIARY-SEXP as Org syntax.
+CONTENTS is nil."
+  (org-element-property :value diary-sexp))
+
+
 ;;;; Example Block
 
 (defun org-element-example-block-parser (limit affiliated)
@@ -3553,6 +3591,9 @@ element it has to parse."
 	     ;; Horizontal Rule.
 	     ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
 	      (org-element-horizontal-rule-parser limit affiliated))
+	     ;; Diary Sexp.
+	     ((looking-at "%%(")
+	      (org-element-diary-sexp-parser limit affiliated))
 	     ;; Table.
 	     ((org-at-table-p t) (org-element-table-parser limit affiliated))
 	     ;; List.

+ 25 - 0
testing/lisp/test-org-element.el

@@ -389,6 +389,23 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] =>  0:01"
       (org-element-parse-buffer) 'comment-block 'identity nil t))))
 
 
+;;;; Diary Sexp
+
+(ert-deftest test-org-element/diary-sexp-parser ()
+  "Test `diary-sexp' parser."
+  ;; Standard test.
+  (should
+   (eq 'diary-sexp
+       (org-test-with-temp-text
+	   "%%(org-anniversary 1956  5 14)(2) Arthur Dent is %d years old"
+	 (org-element-type (org-element-at-point)))))
+  ;; Diary sexp must live at beginning of line
+  (should-not
+   (eq 'diary-sexp
+       (org-test-with-temp-text " %%(org-bbdb-anniversaries)"
+	 (org-element-type (org-element-at-point))))))
+
+
 ;;;; Drawer
 
 (ert-deftest test-org-element/drawer-parser ()
@@ -2022,6 +2039,14 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] =>  0:01"))
 		  "#+BEGIN_COMMENT\nTest\n#+END_COMMENT")
 		 "#+BEGIN_COMMENT\nTest\n#+END_COMMENT\n")))
 
+(ert-deftest test-org-element/diary-sexp ()
+  "Test diary-sexp interpreter."
+  (should
+   (equal
+    (org-test-parse-and-interpret
+     "%%(org-anniversary 1956  5 14)(2) Arthur Dent is %d years old")
+    "%%(org-anniversary 1956  5 14)(2) Arthur Dent is %d years old\n")))
+
 (ert-deftest test-org-element/example-block-interpreter ()
   "Test example block interpreter."
   ;; Without switches.