summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien Guerry <bzg@altern.org>2012-05-05 14:24:53 +0200
committerBastien Guerry <bzg@altern.org>2012-05-05 14:24:53 +0200
commit0a1fe260544a367e4473c53367e9453016e90c04 (patch)
treee4f4ec5a39e260e031cfda29ffe8df1a052eae64
parent7c513b3047ceff0fb60ce344646838d597c8d122 (diff)
parent5cbc56a17517f2081f0ef236bae85cbd0bfd144a (diff)
downloadorg-mode-0a1fe260544a367e4473c53367e9453016e90c04.tar.gz
Merge branch 'master' into various-fixes-and-enhancements
-rw-r--r--contrib/lisp/org-e-html.el3
-rw-r--r--contrib/lisp/org-e-latex.el20
-rw-r--r--contrib/lisp/org-e-odt.el3
-rw-r--r--contrib/lisp/org-element.el563
-rw-r--r--testing/lisp/test-org-element.el651
5 files changed, 870 insertions, 370 deletions
diff --git a/contrib/lisp/org-e-html.el b/contrib/lisp/org-e-html.el
index 4b6d6d5..8d456c9 100644
--- a/contrib/lisp/org-e-html.el
+++ b/contrib/lisp/org-e-html.el
@@ -2219,11 +2219,8 @@ contextual information."
"Transcode an ITEM element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- ;; Grab `:level' from plain-list properties, which is always the
- ;; first element above current item.
(let* ((plain-list (org-export-get-parent item info))
(type (org-element-property :type plain-list))
- (level (org-element-property :level plain-list))
(counter (org-element-property :counter item))
(checkbox (org-element-property :checkbox item))
(tag (let ((tag (org-element-property :tag item)))
diff --git a/contrib/lisp/org-e-latex.el b/contrib/lisp/org-e-latex.el
index ade6b05..8f43a99 100644
--- a/contrib/lisp/org-e-latex.el
+++ b/contrib/lisp/org-e-latex.el
@@ -1347,15 +1347,17 @@ contextual information."
"Transcode an ITEM element from Org to LaTeX.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- ;; Grab `:level' from plain-list properties, which is always the
- ;; first element above current item.
- (let* ((level (org-element-property :level (org-export-get-parent item info)))
- (counter (let ((count (org-element-property :counter item)))
- (and count
- (< level 4)
- (format "\\setcounter{enum%s}{%s}\n"
- (nth level '("i" "ii" "iii" "iv"))
- (1- count)))))
+ (let* ((counter
+ (let ((count (org-element-property :counter item))
+ (level
+ (loop for parent in (org-export-get-genealogy item info)
+ count (eq (org-element-type parent) 'plain-list)
+ until (eq (org-element-type parent) 'headline))))
+ (and count
+ (< level 5)
+ (format "\\setcounter{enum%s}{%s}\n"
+ (nth (1- level) '("i" "ii" "iii" "iv"))
+ (1- count)))))
(checkbox (let ((checkbox (org-element-property :checkbox item)))
(cond ((eq checkbox 'on) "$\\boxtimes$ ")
((eq checkbox 'off) "$\\Box$ ")
diff --git a/contrib/lisp/org-e-odt.el b/contrib/lisp/org-e-odt.el
index 952bdbf..09ef2ae 100644
--- a/contrib/lisp/org-e-odt.el
+++ b/contrib/lisp/org-e-odt.el
@@ -3283,11 +3283,8 @@ contextual information."
"Transcode an ITEM element from Org to HTML.
CONTENTS holds the contents of the item. INFO is a plist holding
contextual information."
- ;; Grab `:level' from plain-list properties, which is always the
- ;; first element above current item.
(let* ((plain-list (org-export-get-parent item info))
(type (org-element-property :type plain-list))
- (level (org-element-property :level plain-list))
(counter (org-element-property :counter item))
(checkbox (org-element-property :checkbox item))
(tag (let ((tag (org-element-property :tag item)))
diff --git a/contrib/lisp/org-element.el b/contrib/lisp/org-element.el
index a5a273c..e58d915 100644
--- a/contrib/lisp/org-element.el
+++ b/contrib/lisp/org-element.el
@@ -46,9 +46,8 @@
;; `comment-block', `example-block', `export-block', `fixed-width',
;; `horizontal-rule', `keyword', `latex-environment', `paragraph',
;; `planning', `property-drawer', `quote-section', `src-block',
-;; `table', `table-cell', `table-row' and `verse-block'. Among them,
-;; `paragraph', `table-cell' and `verse-block' types can contain Org
-;; objects and plain text.
+;; `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',
@@ -295,9 +294,9 @@ Assume point is at the beginning of the footnote definition."
(re-search-forward
(concat org-outline-regexp-bol "\\|"
org-footnote-definition-re "\\|"
- "^[ \t]*$") nil t))
+ "^[ \t]*$") nil 'move))
(match-beginning 0)
- (point-max)))
+ (point)))
(end (progn (org-skip-whitespace)
(if (eobp) (point) (point-at-bol)))))
`(footnote-definition
@@ -709,8 +708,7 @@ the plain list being parsed.
Return a list whose CAR is `plain-list' and CDR is a plist
containing `:type', `:begin', `:end', `:contents-begin' and
-`:contents-end', `:level', `:structure' and `:post-blank'
-keywords.
+`:contents-end', `:structure' and `:post-blank' keywords.
Assume point is at the beginning of the list."
(save-excursion
@@ -724,17 +722,9 @@ Assume point is at the beginning of the list."
(contents-end
(goto-char (org-list-get-list-end (point) struct prevs)))
(end (save-excursion (org-skip-whitespace)
- (if (eobp) (point) (point-at-bol))))
- (level 0))
- ;; Get list level.
- (let ((item contents-begin))
- (while (setq item
- (org-list-get-parent
- (org-list-get-list-begin item struct prevs)
- struct parents))
- (incf level)))
+ (if (eobp) (point) (point-at-bol)))))
;; Blank lines below list belong to the top-level list only.
- (when (> level 0)
+ (unless (= (org-list-get-top-point struct) contents-begin)
(setq end (min (org-list-get-bottom-point struct)
(progn (org-skip-whitespace)
(if (eobp) (point) (point-at-bol))))))
@@ -745,7 +735,6 @@ Assume point is at the beginning of the list."
:end ,end
:contents-begin ,contents-begin
:contents-end ,contents-end
- :level ,level
:structure ,struct
:post-blank ,(count-lines contents-end end)
,@(cadr keywords))))))
@@ -879,8 +868,7 @@ CONTENTS is the contents of the element."
;; type and add that new type to `org-element-all-elements'.
;; As a special case, when the newly defined type is a block type,
-;; `org-element-non-recursive-block-alist' has to be modified
-;; accordingly.
+;; `org-element-block-name-alist' has to be modified accordingly.
;;;; Babel Call
@@ -892,7 +880,8 @@ Return a list whose CAR is `babel-call' and CDR is a plist
containing `:begin', `:end', `:info' and `:post-blank' as
keywords."
(save-excursion
- (let ((info (progn (looking-at org-babel-block-lob-one-liner-regexp)
+ (let ((case-fold-search t)
+ (info (progn (looking-at org-babel-block-lob-one-liner-regexp)
(org-babel-lob-get-info)))
(begin (point-at-bol))
(pos-before-blank (progn (forward-line) (point)))
@@ -2851,17 +2840,21 @@ regexp matching one object can also match the other object.")
table-cell underline)
"List of recursive object types.")
-(defconst org-element-non-recursive-block-alist
- '(("ASCII" . export-block)
- ("COMMENT" . comment-block)
- ("DOCBOOK" . export-block)
- ("EXAMPLE" . example-block)
- ("HTML" . export-block)
- ("LATEX" . export-block)
- ("ODT" . export-block)
- ("SRC" . src-block)
- ("VERSE" . verse-block))
- "Alist between non-recursive block name and their element type.")
+(defconst org-element-block-name-alist
+ '(("ASCII" . org-element-export-block-parser)
+ ("CENTER" . org-element-center-block-parser)
+ ("COMMENT" . org-element-comment-block-parser)
+ ("DOCBOOK" . org-element-export-block-parser)
+ ("EXAMPLE" . org-element-example-block-parser)
+ ("HTML" . org-element-export-block-parser)
+ ("LATEX" . org-element-export-block-parser)
+ ("ODT" . org-element-export-block-parser)
+ ("QUOTE" . org-element-quote-block-parser)
+ ("SRC" . org-element-src-block-parser)
+ ("VERSE" . org-element-verse-block-parser))
+ "Alist between block names and the associated parsing function.
+Names must be uppercase. Any block whose name has no association
+is parsed with `org-element-special-block-parser'.")
(defconst org-element-affiliated-keywords
'("ATTR_ASCII" "ATTR_DOCBOOK" "ATTR_HTML" "ATTR_LATEX" "ATTR_ODT" "CAPTION"
@@ -3006,8 +2999,7 @@ element or object type."
;;
;; `org-element-current-element' is the core function of this section.
;; It returns the Lisp representation of the element starting at
-;; point. It uses `org-element--element-block-re' for quick access to
-;; a common regexp.
+;; point.
;;
;; `org-element-current-element' makes use of special modes. They are
;; activated for fixed element chaining (i.e. `plain-list' > `item')
@@ -3015,14 +3007,6 @@ element or object type."
;; `section'). Special modes are: `section', `quote-section', `item'
;; and `table-row'.
-(defconst org-element--element-block-re
- (format "[ \t]*#\\+BEGIN_\\(%s\\)\\(?: \\|$\\)"
- (mapconcat
- 'regexp-quote
- (mapcar 'car org-element-non-recursive-block-alist) "\\|"))
- "Regexp matching the beginning of a non-recursive block type.
-Used internally by `org-element-current-element'.")
-
(defun org-element-current-element (&optional granularity special structure)
"Parse the element starting at point.
@@ -3044,9 +3028,8 @@ Optional argument SPECIAL, when non-nil, can be either `section',
If STRUCTURE isn't provided but SPECIAL is set to `item', it will
be computed.
-Unlike to `org-element-at-point', this function assumes point is
-always at the beginning of the element it has to parse. As such,
-it is quicker than its counterpart, albeit more restrictive."
+This function assumes point is always at the beginning of the
+element it has to parse."
(save-excursion
;; If point is at an affiliated keyword, try moving to the
;; beginning of the associated element. If none is found, the
@@ -3061,7 +3044,7 @@ it is quicker than its counterpart, albeit more restrictive."
;; `org-element-secondary-value-alist'.
(raw-secondary-p (and granularity (not (eq granularity 'object)))))
(cond
- ;; Item
+ ;; Item.
((eq special 'item)
(org-element-item-parser (or structure (org-list-struct))
raw-secondary-p))
@@ -3079,67 +3062,49 @@ it is quicker than its counterpart, albeit more restrictive."
(if (equal (match-string 1) org-clock-string)
(org-element-clock-parser)
(org-element-planning-parser)))
- ;; Non-recursive block.
- ((when (looking-at org-element--element-block-re)
- (let ((type (upcase (match-string 1))))
- (if (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s\\(?: \\|$\\)" type) nil t))
- (funcall
- (intern
- (format
- "org-element-%s-parser"
- (cdr (assoc type org-element-non-recursive-block-alist)))))
- (org-element-paragraph-parser)))))
+ ;; Blocks.
+ ((when (looking-at "[ \t]*#\\+BEGIN_\\([-A-Za-z0-9]+\\)\\(?: \\|$\\)")
+ (let ((name (upcase (match-string 1))) parser)
+ (cond
+ ((not (save-excursion
+ (re-search-forward
+ (format "^[ \t]*#\\+END_%s\\(?: \\|$\\)" name) nil t)))
+ (org-element-paragraph-parser))
+ ((setq parser (assoc name org-element-block-name-alist))
+ (funcall (cdr parser)))
+ (t (org-element-special-block-parser))))))
;; Inlinetask.
((org-at-heading-p) (org-element-inlinetask-parser raw-secondary-p))
- ;; LaTeX Environment or Paragraph if incomplete.
+ ;; LaTeX Environment.
((looking-at "[ \t]*\\\\begin{")
(if (save-excursion
(re-search-forward "[ \t]*\\\\end{[^}]*}[ \t]*" nil t))
(org-element-latex-environment-parser)
(org-element-paragraph-parser)))
- ;; Property Drawer.
- ((looking-at org-property-start-re)
- (if (save-excursion (re-search-forward org-property-end-re nil t))
- (org-element-property-drawer-parser)
- (org-element-paragraph-parser)))
- ;; Recursive Block, or Paragraph if incomplete.
- ((looking-at "[ \t]*#\\+BEGIN_\\([-A-Za-z0-9]+\\)\\(?: \\|$\\)")
- (let ((type (upcase (match-string 1))))
- (cond
- ((not (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s\\(?: \\|$\\)" type) nil t)))
- (org-element-paragraph-parser))
- ((string= type "CENTER") (org-element-center-block-parser))
- ((string= type "QUOTE") (org-element-quote-block-parser))
- (t (org-element-special-block-parser)))))
- ;; Drawer.
+ ;; Drawer and Property Drawer.
((looking-at org-drawer-regexp)
- (if (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" nil t))
- (org-element-drawer-parser)
- (org-element-paragraph-parser)))
+ (let ((name (match-string 1)))
+ (cond
+ ((not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)))
+ (org-element-paragraph-parser))
+ ((equal "PROPERTIES" name) (org-element-property-drawer-parser))
+ (t (org-element-drawer-parser)))))
+ ;; Fixed Width
((looking-at "[ \t]*:\\( \\|$\\)") (org-element-fixed-width-parser))
- ;; Babel Call.
- ((looking-at org-babel-block-lob-one-liner-regexp)
- (org-element-babel-call-parser))
- ;; Dynamic Block or Paragraph if incomplete. This must be
- ;; checked before regular keywords since their regexp matches
- ;; dynamic blocks too.
- ((looking-at "[ \t]*#\\+BEGIN:\\(?: \\|$\\)")
- (if (save-excursion
- (re-search-forward "^[ \t]*#\\+END:\\(?: \\|$\\)" nil t))
- (org-element-dynamic-block-parser)
- (org-element-paragraph-parser)))
- ;; Keyword, or Paragraph if at an orphaned affiliated keyword.
+ ;; Babel Call, Dynamic Block and Keyword.
((looking-at "[ \t]*#\\+\\([a-z]+\\(:?_[a-z]+\\)*\\):")
(let ((key (upcase (match-string 1))))
- (if (or (string= key "TBLFM")
- (member key org-element-affiliated-keywords))
- (org-element-paragraph-parser)
- (org-element-keyword-parser))))
- ;; Footnote definition.
+ (cond
+ ((equal key "CALL") (org-element-babel-call-parser))
+ ((and (equal key "BEGIN")
+ (save-excursion
+ (re-search-forward "^[ \t]*#\\+END:\\(?: \\|$\\)" nil t)))
+ (org-element-dynamic-block-parser))
+ ((and (not (equal key "TBLFM"))
+ (not (member key org-element-affiliated-keywords)))
+ (org-element-keyword-parser))
+ (t (org-element-paragraph-parser)))))
+ ;; Footnote Definition.
((looking-at org-footnote-definition-re)
(org-element-footnote-definition-parser))
;; Comment.
@@ -3150,7 +3115,7 @@ it is quicker than its counterpart, albeit more restrictive."
(org-element-horizontal-rule-parser))
;; Table.
((org-at-table-p t) (org-element-table-parser))
- ;; List or Item.
+ ;; List.
((looking-at (org-item-re))
(org-element-plain-list-parser (or structure (org-list-struct))))
;; Default element: Paragraph.
@@ -3846,19 +3811,18 @@ first row.
If optional argument KEEP-TRAIL is non-nil, the function returns
a list of of elements leading to element at point. The list's
-CAR is always the element at point. Its last item will be the
-element's parent, unless element was either the first in its
-section (in which case the last item in the list is the first
-element of section) or an headline (in which case the list
-contains that headline as its single element). Elements
-in-between, if any, are siblings of the element at point."
+CAR is always the element at point. Following positions contain
+element's siblings, then parents, siblings of parents, until the
+first element of current section."
(org-with-wide-buffer
;; If at an headline, parse it. It is the sole element that
;; doesn't require to know about context. Be sure to disallow
;; secondary string parsing, though.
(if (org-with-limited-levels (org-at-heading-p))
- (if (not keep-trail) (org-element-headline-parser t)
- (list (org-element-headline-parser t)))
+ (progn
+ (beginning-of-line)
+ (if (not keep-trail) (org-element-headline-parser t)
+ (list (org-element-headline-parser t))))
;; Otherwise move at the beginning of the section containing
;; point.
(let ((origin (point)) element type special-flag trail struct prevs)
@@ -3868,72 +3832,39 @@ in-between, if any, are siblings of the element at point."
(forward-line)))
(org-skip-whitespace)
(beginning-of-line)
- ;; Starting parsing successively each element with
- ;; `org-element-current-element'. Skip those ending before
- ;; original position.
+ ;; Parse successively each element, skipping those ending
+ ;; before original position.
(catch 'exit
(while t
(setq element (org-element-current-element
'element special-flag struct)
type (car element))
- (when keep-trail (push element trail))
+ (push element trail)
(cond
;; 1. Skip any element ending before point or at point.
((let ((end (org-element-property :end element)))
(when (<= end origin)
(if (> (point-max) end) (goto-char end)
- (throw 'exit (or trail element))))))
+ (throw 'exit (if keep-trail trail element))))))
;; 2. An element containing point is always the element at
;; point.
((not (memq type org-element-greater-elements))
(throw 'exit (if keep-trail trail element)))
- ;; 3. At a plain list.
- ((eq type 'plain-list)
- (setq struct (org-element-property :structure element)
- prevs (or prevs (org-list-prevs-alist struct)))
- (let ((beg (org-element-property :contents-begin element)))
- (if (<= origin beg) (throw 'exit (or trail element))
- ;; Find the item at this level containing ORIGIN.
- (let ((items (org-list-get-all-items beg struct prevs))
- parent)
- (catch 'local
- (mapc
- (lambda (pos)
- (cond
- ;; Item ends before point: skip it.
- ((<= (org-list-get-item-end pos struct) origin))
- ;; Item contains point: store is in PARENT.
- ((<= pos origin) (setq parent pos))
- ;; We went too far: return PARENT.
- (t (throw 'local nil)))) items))
- ;; No parent: no item contained point, though the
- ;; plain list does. Point is in the blank lines
- ;; after the list: return plain list.
- (if (not parent) (throw 'exit (or trail element))
- (setq special-flag 'item)
- (goto-char parent))))))
- ;; 4. At a table.
- ((eq type 'table)
- (if (eq (org-element-property :type element) 'table.el)
- (throw 'exit (or trail element))
- (let ((beg (org-element-property :contents-begin element))
- (end (org-element-property :contents-end element)))
- (if (or (<= origin beg) (>= origin end))
- (throw 'exit (or trail element))
- (when keep-trail (setq trail (list element)))
- (setq special-flag 'table-row)
- (narrow-to-region beg end)))))
- ;; 4. At any other greater element type, if point is
+ ;; 3. At any other greater element type, if point is
;; within contents, move into it. Otherwise, return
;; that element.
(t
- (when (eq type 'item) (setq special-flag nil))
(let ((beg (org-element-property :contents-begin element))
(end (org-element-property :contents-end element)))
- (if (or (not beg) (not end) (> beg origin) (< end origin))
- (throw 'exit (or trail element))
- ;; Reset trail, since we found a parent.
- (when keep-trail (setq trail (list element)))
+ (if (or (not beg) (not end) (> beg origin) (<= end origin)
+ (and (= beg origin) (memq type '(plain-list table))))
+ (throw 'exit (if keep-trail trail element))
+ (case type
+ (plain-list
+ (setq special-flag 'item
+ struct (org-element-property :structure element)))
+ (table (setq special-flag 'table-row))
+ (otherwise (setq special-flag nil)))
(narrow-to-region beg end)
(goto-char beg)))))))))))
@@ -3967,84 +3898,139 @@ in-between, if any, are siblings of the element at point."
(defun org-element-swap-A-B (elem-A elem-B)
"Swap elements ELEM-A and ELEM-B.
-
-Leave point at the end of ELEM-A."
+Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
+end of ELEM-A."
(goto-char (org-element-property :begin elem-A))
- (let* ((beg-A (org-element-property :begin elem-A))
- (end-A (save-excursion
- (goto-char (org-element-property :end elem-A))
- (skip-chars-backward " \r\t\n")
- (point-at-eol)))
- (beg-B (org-element-property :begin elem-B))
- (end-B (save-excursion
- (goto-char (org-element-property :end elem-B))
- (skip-chars-backward " \r\t\n")
- (point-at-eol)))
- (body-A (buffer-substring beg-A end-A))
- (body-B (delete-and-extract-region beg-B end-B)))
- (goto-char beg-B)
- (insert body-A)
- (goto-char beg-A)
- (delete-region beg-A end-A)
- (insert body-B)
- (goto-char (org-element-property :end elem-B))))
+ ;; There are two special cases when an element doesn't start at bol:
+ ;; the first paragraph in an item or in a footnote definition.
+ (let ((specialp (not (bolp))))
+ ;; Only a paragraph without any affiliated keyword can be moved at
+ ;; ELEM-A position in such a situation. Note that the case of
+ ;; a footnote definition is impossible: it cannot contain two
+ ;; paragraphs in a row because it cannot contain a blank line.
+ (if (and specialp
+ (or (not (eq (org-element-type elem-B) 'paragraph))
+ (/= (org-element-property :begin elem-B)
+ (org-element-property :contents-begin elem-B))))
+ (error "Cannot swap elements"))
+ ;; In a special situation, ELEM-A will have no indentation. We'll
+ ;; give it ELEM-B's (which will in, in turn, have no indentation).
+ (let* ((ind-B (when specialp
+ (goto-char (org-element-property :begin elem-B))
+ (org-get-indentation)))
+ (beg-A (org-element-property :begin elem-A))
+ (end-A (save-excursion
+ (goto-char (org-element-property :end elem-A))
+ (skip-chars-backward " \r\t\n")
+ (point-at-eol)))
+ (beg-B (org-element-property :begin elem-B))
+ (end-B (save-excursion
+ (goto-char (org-element-property :end elem-B))
+ (skip-chars-backward " \r\t\n")
+ (point-at-eol)))
+ (body-A (buffer-substring beg-A end-A))
+ (body-B (delete-and-extract-region beg-B end-B)))
+ (goto-char beg-B)
+ (when specialp
+ (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
+ (org-indent-to-column ind-B))
+ (insert body-A)
+ (goto-char beg-A)
+ (delete-region beg-A end-A)
+ (insert body-B)
+ (goto-char (org-element-property :end elem-B)))))
+
+(defun org-element-forward ()
+ "Move forward by one element.
+Move to the next element at the same level, when possible."
+ (interactive)
+ (if (org-with-limited-levels (org-at-heading-p))
+ (let ((origin (point)))
+ (org-forward-same-level 1)
+ (unless (org-with-limited-levels (org-at-heading-p))
+ (goto-char origin)
+ (error "Cannot move further down")))
+ (let* ((trail (org-element-at-point 'keep-trail))
+ (elem (pop trail))
+ (end (org-element-property :end elem))
+ (parent (loop for prev in trail
+ when (>= (org-element-property :end prev) end)
+ return prev)))
+ (cond
+ ((eobp) (error "Cannot move further down"))
+ ((and parent (= (org-element-property :contents-end parent) end))
+ (goto-char (org-element-property :end parent)))
+ (t (goto-char end))))))
(defun org-element-backward ()
"Move backward by one element.
Move to the previous element at the same level, when possible."
(interactive)
- (if (save-excursion (skip-chars-backward " \r\t\n") (bobp))
- (error "Cannot move further up")
+ (if (org-with-limited-levels (org-at-heading-p))
+ ;; At an headline, move to the previous one, if any, or stay
+ ;; here.
+ (let ((origin (point)))
+ (org-backward-same-level 1)
+ (unless (org-with-limited-levels (org-at-heading-p))
+ (goto-char origin)
+ (error "Cannot move further up")))
(let* ((trail (org-element-at-point 'keep-trail))
- (element (car trail))
- (beg (org-element-property :begin element)))
- ;; Move to beginning of current element if point isn't there.
- (if (/= (point) beg) (goto-char beg)
- (let ((type (org-element-type element)))
- (cond
- ;; At an headline: move to previous headline at the same
- ;; level, a parent, or BOB.
- ((eq type 'headline)
- (let ((dest (save-excursion (org-backward-same-level 1) (point))))
- (if (= (point-min) dest) (error "Cannot move further up")
- (goto-char dest))))
- ;; At an item: try to move to the previous item, if any.
- ((and (eq type 'item)
- (let* ((struct (org-element-property :structure element))
- (prev (org-list-get-prev-item
- beg struct (org-list-prevs-alist struct))))
- (when prev (goto-char prev)))))
- ;; In any other case, find the previous element in the
- ;; trail and move to its beginning. If no previous element
- ;; can be found, move to headline.
- (t (let ((prev (nth 1 trail)))
- (if prev (goto-char (org-element-property :begin prev))
- (org-back-to-heading))))))))))
+ (elem (car trail))
+ (prev-elem (nth 1 trail))
+ (beg (org-element-property :begin elem)))
+ (cond
+ ;; Move to beginning of current element if point isn't there
+ ;; already.
+ ((/= (point) beg) (goto-char beg))
+ ((not prev-elem) (error "Cannot move further up"))
+ (t (goto-char (org-element-property :begin prev-elem)))))))
+
+(defun org-element-up ()
+ "Move to upper element."
+ (interactive)
+ (if (org-with-limited-levels (org-at-heading-p))
+ (unless (org-up-heading-safe)
+ (error "No surrounding element"))
+ (let* ((trail (org-element-at-point 'keep-trail))
+ (elem (pop trail))
+ (end (org-element-property :end elem))
+ (parent (loop for prev in trail
+ when (>= (org-element-property :end prev) end)
+ return prev)))
+ (cond
+ (parent (goto-char (org-element-property :begin parent)))
+ ((org-before-first-heading-p) (error "No surrounding element"))
+ (t (org-back-to-heading))))))
+
+(defun org-element-down ()
+ "Move to inner element."
+ (interactive)
+ (let ((element (org-element-at-point)))
+ (cond
+ ((memq (org-element-type element) '(plain-list table))
+ (goto-char (org-element-property :contents-begin element))
+ (forward-char))
+ ((memq (org-element-type element) org-element-greater-elements)
+ ;; If contents are hidden, first disclose them.
+ (when (org-element-property :hiddenp element) (org-cycle))
+ (goto-char (org-element-property :contents-begin element)))
+ (t (error "No inner element")))))
(defun org-element-drag-backward ()
- "Drag backward element at point."
+ "Move backward element at point."
(interactive)
- (let* ((pos (point))
- (elem (org-element-at-point)))
- (when (= (progn (goto-char (point-min))
- (org-skip-whitespace)
- (point-at-bol))
- (org-element-property :end elem))
- (error "Cannot drag element backward"))
- (goto-char (org-element-property :begin elem))
- (org-element-backward)
- (let ((prev-elem (org-element-at-point)))
- (when (or (org-element-nested-p elem prev-elem)
- (and (eq (org-element-type elem) 'headline)
- (not (eq (org-element-type prev-elem) 'headline))))
- (goto-char pos)
- (error "Cannot drag element backward"))
- ;; Compute new position of point: it's shifted by PREV-ELEM
- ;; body's length.
- (let ((size-prev (- (org-element-property :end prev-elem)
- (org-element-property :begin prev-elem))))
- (org-element-swap-A-B prev-elem elem)
- (goto-char (- pos size-prev))))))
+ (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up)
+ (let* ((trail (org-element-at-point 'keep-trail))
+ (elem (car trail))
+ (prev-elem (nth 1 trail)))
+ ;; Error out if no previous element or previous element is
+ ;; a parent of the current one.
+ (if (or (not prev-elem) (org-element-nested-p elem prev-elem))
+ (error "Cannot drag element backward")
+ (let ((pos (point)))
+ (org-element-swap-A-B prev-elem elem)
+ (goto-char (+ (org-element-property :begin prev-elem)
+ (- pos (org-element-property :begin elem)))))))))
(defun org-element-drag-forward ()
"Move forward element at point."
@@ -4067,7 +4053,9 @@ Move to the previous element at the same level, when possible."
(goto-char (org-element-property :end next-elem))
(skip-chars-backward " \r\t\n")
(forward-line)
- (point))
+ ;; Small correction if buffer doesn't end
+ ;; with a newline character.
+ (if (and (eolp) (not (bolp))) (1+ (point)) (point)))
(org-element-property :begin next-elem)))
(size-blank (- (org-element-property :end elem)
(save-excursion
@@ -4078,43 +4066,6 @@ Move to the previous element at the same level, when possible."
(org-element-swap-A-B elem next-elem)
(goto-char (+ pos size-next size-blank))))))
-(defun org-element-forward ()
- "Move forward by one element.
-Move to the next element at the same level, when possible."
- (interactive)
- (if (eobp) (error "Cannot move further down")
- (let* ((trail (org-element-at-point 'keep-trail))
- (element (car trail))
- (type (org-element-type element))
- (end (org-element-property :end element)))
- (cond
- ;; At an headline, move to next headline at the same level.
- ((eq type 'headline) (goto-char end))
- ;; At an item. Move to the next item, if possible.
- ((and (eq type 'item)
- (let* ((struct (org-element-property :structure element))
- (prevs (org-list-prevs-alist struct))
- (beg (org-element-property :begin element))
- (next-item (org-list-get-next-item beg struct prevs)))
- (when next-item (goto-char next-item)))))
- ;; In any other case, move to element's end, unless this
- ;; position is also the end of its parent's contents, in which
- ;; case, directly jump to parent's end.
- (t
- (let ((parent
- ;; Determine if TRAIL contains the real parent of ELEMENT.
- (and (> (length trail) 1)
- (let* ((parent-candidate (car (last trail))))
- (and (memq (org-element-type parent-candidate)
- org-element-greater-elements)
- (>= (org-element-property
- :contents-end parent-candidate) end)
- parent-candidate)))))
- (cond ((not parent) (goto-char end))
- ((= (org-element-property :contents-end parent) end)
- (goto-char (org-element-property :end parent)))
- (t (goto-char end)))))))))
-
(defun org-element-mark-element ()
"Put point at beginning of this element, mark at end.
@@ -4152,102 +4103,40 @@ ones already marked."
(org-element-property :begin elem)
(org-element-property :end elem))))))
-(defun org-transpose-elements ()
+(defun org-element-transpose ()
"Transpose current and previous elements, keeping blank lines between.
Point is moved after both elements."
(interactive)
(org-skip-whitespace)
- (let ((pos (point))
- (cur (org-element-at-point)))
- (when (= (save-excursion (goto-char (point-min))
- (org-skip-whitespace)
- (point-at-bol))
- (org-element-property :begin cur))
- (error "No previous element"))
- (goto-char (org-element-property :begin cur))
- (forward-line -1)
- (let ((prev (org-element-at-point)))
- (when (org-element-nested-p cur prev)
- (goto-char pos)
- (error "Cannot transpose nested elements"))
- (org-element-swap-A-B prev cur))))
+ (let ((end (org-element-property :end (org-element-at-point))))
+ (org-element-drag-backward)
+ (goto-char end)))
(defun org-element-unindent-buffer ()
"Un-indent the visible part of the buffer.
-Relative indentation \(between items, inside blocks, etc.\) isn't
+Relative indentation (between items, inside blocks, etc.) isn't
modified."
(interactive)
(unless (eq major-mode 'org-mode)
(error "Cannot un-indent a buffer not in Org mode"))
(let* ((parse-tree (org-element-parse-buffer 'greater-element))
- unindent-tree ; For byte-compiler.
+ unindent-tree ; For byte-compiler.
(unindent-tree
(function
(lambda (contents)
- (mapc (lambda (element)
- (if (eq (org-element-type element) 'headline)
- (funcall unindent-tree
- (org-element-contents element))
- (save-excursion
- (save-restriction
- (narrow-to-region
- (org-element-property :begin element)
- (org-element-property :end element))
- (org-do-remove-indentation)))))
- (reverse contents))))))
+ (mapc
+ (lambda (element)
+ (if (memq (org-element-type element) '(headline section))
+ (funcall unindent-tree (org-element-contents element))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region
+ (org-element-property :begin element)
+ (org-element-property :end element))
+ (org-do-remove-indentation)))))
+ (reverse contents))))))
(funcall unindent-tree (org-element-contents parse-tree))))
-(defun org-element-up ()
- "Move to upper element."
- (interactive)
- (cond
- ((bobp) (error "No surrounding element"))
- ((org-with-limited-levels (org-at-heading-p))
- (or (org-up-heading-safe) (error "No surronding element")))
- (t
- (let* ((trail (org-element-at-point 'keep-trail))
- (element (car trail))
- (type (org-element-type element)))
- (cond
- ;; At an item, with a parent in the list: move to that parent.
- ((and (eq type 'item)
- (let* ((beg (org-element-property :begin element))
- (struct (org-element-property :structure element))
- (parents (org-list-parents-alist struct))
- (parentp (org-list-get-parent beg struct parents)))
- (and parentp (goto-char parentp)))))
- ;; Determine parent in the trail.
- (t
- (let ((parent
- (and (> (length trail) 1)
- (let ((parentp (car (last trail))))
- (and (memq (org-element-type parentp)
- org-element-greater-elements)
- (>= (org-element-property :contents-end parentp)
- (org-element-property :end element))
- parentp)))))
- (cond
- ;; When parent is found move to its beginning.
- (parent (goto-char (org-element-property :begin parent)))
- ;; If no parent was found, move to headline above, if any
- ;; or return an error.
- ((org-before-first-heading-p) (error "No surrounding element"))
- (t (org-back-to-heading))))))))))
-
-(defun org-element-down ()
- "Move to inner element."
- (interactive)
- (let ((element (org-element-at-point)))
- (cond
- ((memq (org-element-type element) '(plain-list table))
- (goto-char (org-element-property :contents-begin element))
- (forward-char))
- ((memq (org-element-type element) org-element-greater-elements)
- ;; If contents are hidden, first disclose them.
- (when (org-element-property :hiddenp element) (org-cycle))
- (goto-char (org-element-property :contents-begin element)))
- (t (error "No inner element")))))
-
(provide 'org-element)
;;; org-element.el ends here
diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el
index 6eafb06..8f7f00c 100644
--- a/testing/lisp/test-org-element.el
+++ b/testing/lisp/test-org-element.el
@@ -36,10 +36,118 @@ Return interpreted string."
;;; Test Parsers
-;;;; Comments
+;;;; Babel Call
+
+(ert-deftest test-org-element/babel-call-parser ()
+ "Test `babel-call' parsing."
+ (should
+ (equal
+ (org-test-with-temp-text "#+CALL: test()"
+ (org-element-map (org-element-parse-buffer) 'babel-call 'identity nil t))
+ '(babel-call (:begin 1 :end 15 :info ("test()" nil 0) :post-blank 0)))))
+
+
+;;;; Bold
+
+(ert-deftest test-org-element/bold-parser ()
+ "Test `bold' parser."
+ ;; Regular test.
+ (should
+ (equal
+ (org-test-with-temp-text "*bold*"
+ (org-element-map (org-element-parse-buffer) 'bold 'identity nil t))
+ '(bold (:begin 1 :end 7 :contents-begin 2 :contents-end 6 :post-blank 0)
+ "bold")))
+ ;; Multi-line markup.
+ (should
+ (equal
+ (org-test-with-temp-text "*first line\nsecond line*"
+ (org-element-map (org-element-parse-buffer) 'bold 'identity nil t))
+ '(bold (:begin 1 :end 25 :contents-begin 2 :contents-end 24 :post-blank 0)
+ "first line\nsecond line"))))
+
+
+;;;; Center Block
+
+(ert-deftest test-org-element/center-block-parser ()
+ "Test `center-block' parser."
+ ;; Regular test.
+ (should
+ (equal
+ (org-test-with-temp-text "#+BEGIN_CENTER\nText\n#+END_CENTER"
+ (org-element-map
+ (org-element-parse-buffer) 'center-block 'identity nil t))
+ '(center-block
+ (:begin 1 :end 33 :hiddenp nil :contents-begin 16 :contents-end 21
+ :post-blank 0)
+ (paragraph
+ (:begin 16 :end 21 :contents-begin 16 :contents-end 20 :post-blank 0)
+ "Text"))))
+ ;; Test folded block.
+ (org-test-with-temp-text "#+BEGIN_CENTER\nText\n#+END_CENTER"
+ (org-cycle)
+ (should
+ (org-element-property
+ :hiddenp
+ (org-element-map
+ (org-element-parse-buffer) 'center-block 'identity nil t))))
+ ;; Ignore incomplete block.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_CENTER"
+ (org-element-map
+ (org-element-parse-buffer) 'center-block 'identity nil t))))
+
+
+;;;; Clock
+
+(ert-deftest test-org-element/clock-parser ()
+ "Test `clock' parser."
+ ;; Running clock.
+ (should
+ (equal
+ (let ((org-clock-string "CLOCK:"))
+ (org-test-with-temp-text "CLOCK: [2012-01-01 sun. 00:01]"
+ (org-element-map
+ (org-element-parse-buffer) 'clock 'identity nil t)))
+ '(clock
+ (:status running :value "[2012-01-01 sun. 00:01]" :time nil :begin 1
+ :end 31 :post-blank 0))))
+ ;; Closed clock.
+ (should
+ (equal
+ (let ((org-clock-string "CLOCK:"))
+ (org-test-with-temp-text "
+CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01"
+ (org-element-map
+ (org-element-parse-buffer) 'clock 'identity nil t)))
+ '(clock
+ (:status closed
+ :value "[2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02]"
+ :time "0:01" :begin 2 :end 66 :post-blank 0)))))
+
+
+;;;; Code
+
+(ert-deftest test-org-element/code-parser ()
+ "Test `code' parser."
+ ;; Regular test.
+ (should
+ (equal
+ (org-test-with-temp-text "~code~"
+ (org-element-map (org-element-parse-buffer) 'code 'identity nil t))
+ '(code (:value "code" :begin 1 :end 7 :post-blank 0))))
+ ;; Multi-line markup.
+ (should
+ (equal
+ (org-test-with-temp-text "~first line\nsecond line~"
+ (org-element-map (org-element-parse-buffer) 'code 'identity nil t))
+ '(code (:value "first line\nsecond line" :begin 1 :end 25 :post-blank 0)))))
+
+
+;;;; Comment
(ert-deftest test-org-element/comment-parser ()
- "Test `comment' parsing."
+ "Test `comment' parser."
;; Regular comment.
(should
(equal
@@ -64,10 +172,159 @@ Return interpreted string."
(org-test-with-temp-text "#+ First part\n#+ \n#+\n#+ Second part"
(org-element-map (org-element-parse-buffer) 'comment 'identity nil t))
'(comment
- (:begin 1 :end 36 :value "First part\n\n\nSecond part\n" :post-blank 0)))))
+ (:begin 1 :end 36 :value "First part\n\n\nSecond part\n"
+ :post-blank 0)))))
-;;;; Example-blocks and Src-blocks
+;;;; Comment Block
+
+(ert-deftest test-org-element/comment-block-parser ()
+ "Test `comment-block' parser."
+ ;; Regular tests.
+ (should
+ (equal
+ (org-test-with-temp-text "#+BEGIN_COMMENT\nText\n#+END_COMMENT"
+ (org-element-map
+ (org-element-parse-buffer) 'comment-block 'identity nil t))
+ '(comment-block (:begin 1 :end 35 :value "Text\n" :hiddenp nil
+ :post-blank 0))))
+ ;; Test folded block.
+ (org-test-with-temp-text "#+BEGIN_COMMENT\nText\n#+END_COMMENT"
+ (org-cycle)
+ (should
+ (org-element-property
+ :hiddenp
+ (org-element-map
+ (org-element-parse-buffer) 'comment-block 'identity nil t))))
+ ;; Ignore incomplete block.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_COMMENT"
+ (org-element-map
+ (org-element-parse-buffer) 'comment-block 'identity nil t))))
+
+
+;;;; Drawer
+
+(ert-deftest test-org-element/drawer-parser ()
+ "Test `drawer' parser."
+ ;; Regular test.
+ (should
+ (equal
+ (let ((org-drawers '("TEST")))
+ (org-test-with-temp-text ":TEST:\nText\n:END:"
+ (org-element-map (org-element-parse-buffer) 'drawer 'identity nil t)))
+ '(drawer
+ (:begin 1 :end 18 :drawer-name "TEST" :hiddenp nil :contents-begin 8
+ :contents-end 13 :post-blank 0)
+ (paragraph
+ (:begin 8 :end 13 :contents-begin 8 :contents-end 12 :post-blank 0)
+ "Text"))))
+ ;; Do not mix regular drawers and property drawers.
+ (should-not
+ (let ((org-drawers '("PROPERTIES")))
+ (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:"
+ (org-element-map
+ (org-element-parse-buffer) 'drawer 'identity nil t))))
+ ;; Ignore incomplete drawer.
+ (should-not
+ (let ((org-drawers '("TEST")))
+ (org-test-with-temp-text ":TEST:"
+ (org-element-map
+ (org-element-parse-buffer) 'drawer 'identity nil t)))))
+
+
+;;;; Dynamic Block
+
+(ert-deftest test-org-element/dynamic-block-parser ()
+ "Test `dynamic-block' parser."
+ ;; Regular test.
+ (should
+ (equal
+ (org-test-with-temp-text
+ "#+BEGIN: myblock :param1 val1 :param2 val2\nText\n#+END:"
+ (org-element-map
+ (org-element-parse-buffer) 'dynamic-block 'identity nil t))
+ '(dynamic-block
+ (:begin 1 :end 55 :block-name "myblock"
+ :arguments ":param1 val1 :param2 val2" :hiddenp nil
+ :contents-begin 44 :contents-end 49 :post-blank 0)
+ (paragraph
+ (:begin 44 :end 49 :contents-begin 44 :contents-end 48 :post-blank 0)
+ "Text"))))
+ ;; Folded view
+ (org-test-with-temp-text
+ "#+BEGIN: myblock :param1 val1 :param2 val2\nText\n#+END:"
+ (org-cycle)
+ (should
+ (org-element-property
+ :hiddenp
+ (org-element-map
+ (org-element-parse-buffer) 'dynamic-block 'identity nil t))))
+ ;; Ignore incomplete block.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN: myblock :param1 val1 :param2 val2"
+ (org-element-map
+ (org-element-parse-buffer) 'dynamic-block 'identity nil t))))
+
+
+;;;; Entity
+
+(ert-deftest test-org-element/entity-parser ()
+ "Test `entity' parser."
+ ;; Without brackets.
+ (should
+ (equal
+ (org-test-with-temp-text "\\sin"
+ (org-element-map (org-element-parse-buffer) 'entity 'identity nil t))
+ '(entity
+ (:name "sin" :latex "\\sin" :latex-math-p t :html "sin"
+ :ascii "sin" :latin1 "sin" :utf-8 "sin" :begin 1 :end 5
+ :use-brackets-p nil :post-blank 0))))
+ ;; With brackets.
+ (should
+ (org-element-property
+ :use-brackets-p
+ (org-test-with-temp-text "\\alpha{}text"
+ (org-element-map (org-element-parse-buffer) 'entity 'identity nil t))))
+ ;; User-defined entity.
+ (should
+ (equal
+ (org-element-property
+ :name
+ (let ((org-entities-user
+ '(("test" "test" nil "test" "test" "test" "test"))))
+ (org-test-with-temp-text "\\test"
+ (org-element-map (org-element-parse-buffer) 'entity 'identity nil t))))
+ "test")))
+
+
+;;;; Example Block
+
+(ert-deftest test-org-element/example-block-parser ()
+ "Test `example-block' parser."
+ ;; Regular tests.
+ (should
+ (equal
+ (org-test-with-temp-text "#+BEGIN_EXAMPLE\nText\n#+END_EXAMPLE"
+ (org-element-map
+ (org-element-parse-buffer) 'example-block 'identity nil t))
+ '(example-block
+ (:begin 1 :end 35 :value "Text\n" :switches nil
+ :number-lines nil :preserve-indent nil :retain-labels t
+ :use-labels t :label-fmt nil :hiddenp nil :post-blank 0))))
+ ;; Test folded block.
+ (org-test-with-temp-text "#+BEGIN_EXAMPLE\nText\n#+END_EXAMPLE"
+ (org-cycle)
+ (should
+ (org-element-property
+ :hiddenp
+ (org-element-map
+ (org-element-parse-buffer) 'example-block 'identity nil t))))
+ ;; Ignore incomplete block.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_EXAMPLE"
+ (org-element-map
+ (org-element-parse-buffer) 'example-block 'identity nil t))))
(ert-deftest test-org-element/block-switches ()
"Test `example-block' and `src-block' switches parsing."
@@ -169,10 +426,38 @@ Return interpreted string."
(equal (org-element-property :label-fmt element) "[ref:%s]"))))))
-;;;; Export snippets
+;;;; Export Block
+
+(ert-deftest test-org-element/export-block-parser ()
+ "Test `export-block' parser."
+ ;; Regular tests.
+ (should
+ (equal
+ (org-test-with-temp-text "#+BEGIN_LATEX\nText\n#+END_LATEX"
+ (org-element-map
+ (org-element-parse-buffer) 'export-block 'identity nil t))
+ '(export-block
+ (:begin 1 :end 31 :type "LATEX" :value "Text\n" :hiddenp nil
+ :post-blank 0))))
+ ;; Test folded block.
+ (org-test-with-temp-text "#+BEGIN_LATEX\nText\n#+END_LATEX"
+ (org-cycle)
+ (should
+ (org-element-property
+ :hiddenp
+ (org-element-map
+ (org-element-parse-buffer) 'export-block 'identity nil t))))
+ ;; Ignore incomplete block.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_LATEX"
+ (org-element-map
+ (org-element-parse-buffer) 'export-block 'identity nil t))))
+
+
+;;;; Export Snippet
(ert-deftest test-org-element/export-snippet-parser ()
- "Test export-snippet parsing."
+ "Test `export-snippet' parser."
(should
(equal
(org-test-with-temp-text "<back-end@contents>"
@@ -183,7 +468,7 @@ Return interpreted string."
:value "contents" :begin 1 :end 20 :post-blank 0)))))
-;;;; Fixed width
+;;;; Fixed Width
(ert-deftest test-org-element/fixed-width ()
"Test fixed-width area parsing."
@@ -220,10 +505,36 @@ Return interpreted string."
(org-element-parse-buffer) 'fixed-width 'identity))))))
-;;;; Footnotes references
+;;;; Footnote Definition.
+
+(ert-deftest test-org-element/footnote-definition-parser ()
+ "Test `footnote-definition' parser."
+ (should
+ (equal
+ (org-test-with-temp-text "[fn:1] Definition"
+ (org-element-map
+ (org-element-parse-buffer) 'footnote-definition 'identity nil t))
+ '(footnote-definition
+ (:label "fn:1" :begin 1 :end 18 :contents-begin 8 :contents-end 18
+ :post-blank 0)
+ (paragraph
+ (:begin 8 :end 18 :contents-begin 8 :contents-end 18 :post-blank 0)
+ "Definition"))))
+ ;; Footnote with more contents
+ (should
+ (= 28
+ (org-element-property
+ :end
+ (org-test-with-temp-text "[fn:1] Definition\n| a | b |"
+ (org-element-map
+ (org-element-parse-buffer)
+ 'footnote-definition 'identity nil t))))))
+
+
+;;;; Footnotes Reference
(ert-deftest test-org-element/footnote-reference-parser ()
- "Test footnote-reference parsing."
+ "Test `footnote-reference' parser."
;; 1. Parse a standard reference.
(org-test-with-temp-text "[fn:label]"
(should (equal (org-element-footnote-reference-parser)
@@ -346,10 +657,142 @@ Return interpreted string."
(should (equal (org-element-property :tags headline) '("test")))))))
-;;;; Links
+;;;; Inlinetask.
+
+(ert-deftest test-org-element/inlinetask-parser ()
+ "Test `inlinetask' parser."
+ (when (featurep 'org-inlinetask)
+ (let ((org-inlinetask-min-level 15))
+ ;; 1. Regular inlinetask.
+ (should
+ (equal
+ (org-test-with-temp-text
+ "*************** Task\nTest\n*************** END"
+ (org-element-map
+ (org-element-parse-buffer) 'inlinetask 'identity nil t))
+ '(inlinetask
+ (:title ("Task") :begin 1 :end 46 :hiddenp nil :contents-begin 22
+ :contents-end 27 :level 15 :priority nil :tags nil
+ :todo-keyword nil :todo-type nil :scheduled nil :deadline nil
+ :timestamp nil :clock nil :post-blank 0 :category "???")
+ (paragraph
+ (:begin 22 :end 27 :contents-begin 22 :contents-end 26 :post-blank 0)
+ "Test"))))
+ ;; 2. Degenerate inlinetask.
+ (should
+ (equal
+ (org-test-with-temp-text
+ "*************** Task"
+ (org-element-map
+ (org-element-parse-buffer) 'inlinetask 'identity nil t))
+ '(inlinetask
+ (:title ("Task") :begin 1 :end 21 :hiddenp nil :contents-begin 21
+ :contents-end 21 :level 15 :priority nil :tags nil
+ :todo-keyword nil :todo-type nil :scheduled nil :deadline nil
+ :timestamp nil :clock nil :post-blank 0 :category nil))))
+ ;; TODO keyword.
+ (should
+ (equal
+ "TODO"
+ (let ((org-todo-keywords '((sequence "TODO" "DONE"))))
+ (org-test-with-temp-text "*************** TODO Task"
+ (org-element-property
+ :todo-keyword
+ (org-element-map
+ (org-element-parse-buffer) 'inlinetask 'identity nil t))))))
+ ;; Planning info.
+ (should
+ (equal
+ "2012-03-29 thu."
+ (org-test-with-temp-text "
+*************** Task
+DEADLINE: <2012-03-29 thu.>"
+ (org-element-property
+ :deadline
+ (org-element-map
+ (org-element-parse-buffer) 'inlinetask 'identity nil t)))))
+ ;; Priority.
+ (should
+ (equal
+ ?A
+ (org-test-with-temp-text "
+*************** [#A] Task"
+ (org-element-property
+ :priority
+ (org-element-map
+ (org-element-parse-buffer) 'inlinetask 'identity nil t)))))
+ ;; Tags.
+ (should
+ (equal
+ '("test")
+ (org-test-with-temp-text "
+*************** Task :test:"
+ (org-element-property
+ :tags
+ (org-element-map
+ (org-element-parse-buffer) 'inlinetask 'identity nil t))))))))
+
+
+;;;; Item.
+
+(ert-deftest test-org-element/item-parser ()
+ "Test `item' parser."
+ ;; Standard test.
+ (should
+ (equal
+ (org-test-with-temp-text "- item"
+ (org-element-map (org-element-parse-buffer) 'item 'identity nil t))
+ '(item
+ (:bullet "- " :begin 1 :end 7 :contents-begin 3 :contents-end 7
+ :checkbox nil :counter nil :tag nil :hiddenp nil
+ :structure ((1 0 "- " nil nil nil 7))
+ :post-blank 0)
+ (paragraph
+ (:begin 3 :end 7 :contents-begin 3 :contents-end 7 :post-blank 0)
+ "item"))))
+ ;; Counter.
+ (should
+ (= 6
+ (org-element-property
+ :counter
+ (org-test-with-temp-text "6. [@6] item"
+ (org-element-map (org-element-parse-buffer) 'item 'identity nil t)))))
+ ;; Tag
+ (should
+ (equal
+ '("tag")
+ (org-element-property
+ :tag
+ (org-test-with-temp-text "- tag :: description"
+ (org-element-map (org-element-parse-buffer) 'item 'identity nil t)))))
+ ;; Check-boxes
+ (should
+ (equal
+ '(trans on off)
+ (org-test-with-temp-text "
+- [-] item 1
+ - [X] item 1.1
+ - [ ] item 1.2"
+ (org-element-map
+ (org-element-parse-buffer) 'item
+ (lambda (item) (org-element-property :checkbox item))))))
+ ;; Folded state.
+ (org-test-with-temp-text "* Headline
+- item
+
+ paragraph below"
+ (forward-line)
+ (let ((org-cycle-include-plain-lists t)) (org-cycle))
+ (should
+ (org-element-property
+ :hiddenp
+ (org-element-map (org-element-parse-buffer) 'item 'identity nil t)))))
+
+
+;;;; Link
(ert-deftest test-org-element/link-parser ()
- "Test link parsing."
+ "Test `link' parser."
;; 1. Radio target.
(should
(equal (org-test-with-temp-text "A radio link"
@@ -436,10 +879,162 @@ Return interpreted string."
:raw-link "http://orgmode.org" :begin 9 :end 29
:contents-begin nil :contents-end nil :post-blank 0)))))
-;;;; Verse blocks
+
+;;;; Plain List.
+
+(ert-deftest test-org-element/plain-list-parser ()
+ "Test `plain-list' parser."
+ (should
+ (equal
+ (org-test-with-temp-text "- item"
+ (org-element-map (org-element-parse-buffer) 'plain-list 'identity nil t))
+ '(plain-list
+ (:type unordered :begin 1 :end 7 :contents-begin 1 :contents-end 7
+ :structure ((1 0 "- " nil nil nil 7)) :post-blank 0)
+ (item
+ (:bullet "- " :begin 1 :end 7 :contents-begin 3 :contents-end 7
+ :checkbox nil :counter nil :tag nil :hiddenp nil
+ :structure ((1 0 "- " nil nil nil 7)) :post-blank 0)
+ (paragraph
+ (:begin 3 :end 7 :contents-begin 3 :contents-end 7 :post-blank 0)
+ "item")))))
+ ;; Blank lines after the list only belong to outer plain list.
+ (org-test-with-temp-text "
+- outer
+ - inner
+
+Outside list"
+ (let ((endings (org-element-map
+ (org-element-parse-buffer) 'plain-list
+ (lambda (pl) (org-element-property :end pl)))))
+ ;; Move to ending of outer list.
+ (goto-char (car endings))
+ (should (looking-at "Outside list"))
+ ;; Move to ending of inner list.
+ (goto-char (nth 1 endings))
+ (should (looking-at "^$")))))
+
+
+;;;; Src Block.
+
+(ert-deftest test-org-element/src-block-parser ()
+ "Test `src-block' parser."
+ ;; Regular tests.
+ (should
+ (equal
+ (org-test-with-temp-text "#+BEGIN_SRC\nText\n#+END_SRC"
+ (org-element-map
+ (org-element-parse-buffer) 'src-block 'identity nil t))
+ '(src-block
+ (:language nil :switches nil :parameters nil :begin 1 :end 27
+ :number-lines nil :preserve-indent nil :retain-labels t
+ :use-labels t :label-fmt nil :hiddenp nil :value "Text\n"
+ :post-blank 0))))
+ ;; Test folded block.
+ (org-test-with-temp-text "#+BEGIN_SRC\nText\n#+END_SRC"
+ (org-cycle)
+ (should
+ (org-element-property
+ :hiddenp
+ (org-element-map
+ (org-element-parse-buffer) 'src-block 'identity nil t))))
+ ;; Ignore incomplete block.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_SRC"
+ (org-element-map
+ (org-element-parse-buffer) 'src-block 'identity nil t))))
+
+
+;;;; Quote Block
+
+(ert-deftest test-org-element/quote-block-parser ()
+ "Test `quote-block' parser."
+ ;; Regular test.
+ (should
+ (equal
+ (org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE"
+ (org-element-map
+ (org-element-parse-buffer) 'quote-block 'identity nil t))
+ '(quote-block
+ (:begin 1 :end 31 :hiddenp nil :contents-begin 15 :contents-end 20
+ :post-blank 0)
+ (paragraph
+ (:begin 15 :end 20 :contents-begin 15 :contents-end 19 :post-blank 0)
+ "Text"))))
+ ;; Test folded block.
+ (org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE"
+ (org-cycle)
+ (should
+ (org-element-property
+ :hiddenp
+ (org-element-map
+ (org-element-parse-buffer) 'quote-block 'identity nil t))))
+ ;; Ignore incomplete block.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_QUOTE"
+ (org-element-map
+ (org-element-parse-buffer) 'quote-block 'identity nil t))))
+
+
+;;;; Section
+
+(ert-deftest test-org-element/section-parser ()
+ "Test `section' parser."
+ ;; Standard test.
+ (should
+ (equal
+ (org-test-with-temp-text "* Headline\nText"
+ (org-element-map (org-element-parse-buffer) 'section 'identity nil t))
+ '(section
+ (:begin 12 :end 16 :contents-begin 12 :contents-end 16 :post-blank 0)
+ (paragraph
+ (:begin 12 :end 16 :contents-begin 12 :contents-end 16 :post-blank 0)
+ "Text"))))
+ ;; There's a section before the first headline.
+ (should
+ (org-test-with-temp-text "Text"
+ (org-element-map (org-element-parse-buffer) 'section 'identity)))
+ ;; A section cannot be empty.
+ (should-not
+ (org-test-with-temp-text "* Headline 1\n* Headline 2"
+ (org-element-map (org-element-parse-buffer) 'section 'identity))))
+
+
+;;;; Special Block
+
+(ert-deftest test-org-element/special-block-parser ()
+ "Test `special-block' parser."
+ ;; Regular test.
+ (should
+ (equal
+ (org-test-with-temp-text "#+BEGIN_SPECIAL\nText\n#+END_SPECIAL"
+ (org-element-map
+ (org-element-parse-buffer) 'special-block 'identity nil t))
+ '(special-block
+ (:type "SPECIAL" :begin 1 :end 35 :hiddenp nil :contents-begin 17
+ :contents-end 22 :post-blank 0)
+ (paragraph
+ (:begin 17 :end 22 :contents-begin 17 :contents-end 21 :post-blank 0)
+ "Text"))))
+ ;; Test folded block.
+ (org-test-with-temp-text "#+BEGIN_SPECIAL\nText\n#+END_SPECIAL"
+ (org-cycle)
+ (should
+ (org-element-property
+ :hiddenp
+ (org-element-map
+ (org-element-parse-buffer) 'special-block 'identity nil t))))
+ ;; Ignore incomplete block.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_SPECIAL"
+ (org-element-map
+ (org-element-parse-buffer) 'special-block 'identity nil t))))
+
+
+;;;; Verse Block
(ert-deftest test-org-element/verse-block-parser ()
- "Test verse block parsing."
+ "Test `verse-block' parser."
;; Standard test.
(org-test-with-temp-text "#+BEGIN_VERSE\nVerse block\n#+END_VERSE"
(should
@@ -470,7 +1065,12 @@ Return interpreted string."
"Verse block\n"))))
;; Parse objects in verse blocks.
(org-test-with-temp-text "#+BEGIN_VERSE\nVerse \\alpha\n#+END_VERSE"
- (should (org-element-map (org-element-parse-buffer) 'entity 'identity))))
+ (should (org-element-map (org-element-parse-buffer) 'entity 'identity)))
+ ;; Ignore incomplete verse block.
+ (should-not
+ (org-test-with-temp-text "#+BEGIN_VERSE"
+ (org-element-map
+ (org-element-parse-buffer) 'verse-block 'identity nil t))))
@@ -1073,7 +1673,22 @@ Paragraph \\alpha."
;;; Test Navigation Tools.
-(ert-deftest test-org-element/forward-element ()
+(ert-deftest test-org-element/at-point ()
+ "Test `org-element-at-point' specifications."
+ ;; Special case: at the very beginning of a table, return `table'
+ ;; object instead of `table-row'.
+ (should
+ (eq 'table
+ (org-test-with-temp-text "| a | b |"
+ (org-element-type (org-element-at-point)))))
+ ;; Special case: at the very beginning of a list or sub-list, return
+ ;; `plain-list' object instead of `item'.
+ (should
+ (eq 'plain-list
+ (org-test-with-temp-text "- item"
+ (org-element-type (org-element-at-point))))))
+
+(ert-deftest test-org-element/forward ()
"Test `org-element-forward' specifications."
;; 1. At EOB: should error.
(org-test-with-temp-text "Some text\n"
@@ -1153,7 +1768,7 @@ Outside."
(org-element-forward)
(should (looking-at " - sub3"))))
-(ert-deftest test-org-element/backward-element ()
+(ert-deftest test-org-element/backward ()
"Test `org-element-backward' specifications."
;; 1. At BOB (modulo some white spaces): should error.
(org-test-with-temp-text " \nParagraph."
@@ -1232,7 +1847,7 @@ Outside."
(org-element-backward)
(should (looking-at "- item1"))))
-(ert-deftest test-org-element/up-element ()
+(ert-deftest test-org-element/up ()
"Test `org-element-up' specifications."
;; 1. At BOB or with no surrounding element: should error.
(org-test-with-temp-text "Paragraph."
@@ -1283,7 +1898,7 @@ Outside."
(org-element-up)
(should (looking-at "\\* Top"))))
-(ert-deftest test-org-element/down-element ()
+(ert-deftest test-org-element/down ()
"Test `org-element-down' specifications."
;; 1. Error when the element hasn't got a recursive type.
(org-test-with-temp-text "Paragraph."