summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <n.goaziou@gmail.com>2012-10-27 14:23:37 +0200
committerNicolas Goaziou <n.goaziou@gmail.com>2012-10-27 14:43:30 +0200
commitd81982ae9d26dd4fd84f6e8d8878ca0c1305889c (patch)
tree98e3b02301855776eeb923bd392d8af3dbba21d9
parent1d58b0b2cd87395c919020b921a5e154149cdae4 (diff)
downloadorg-mode-d81982ae9d26dd4fd84f6e8d8878ca0c1305889c.tar.gz
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.
-rw-r--r--lisp/org-element.el63
-rw-r--r--testing/lisp/test-org-element.el25
2 files changed, 77 insertions, 11 deletions
diff --git a/lisp/org-element.el b/lisp/org-element.el
index a32c5d7..c60d979 100644
--- a/lisp/org-element.el
+++ b/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.
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 70a263d..18f78b0 100644
--- a/testing/lisp/test-org-element.el
+++ b/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.