Merge branch 'master' into various-fixes-and-enhancements

This commit is contained in:
Bastien Guerry 2012-05-05 14:24:53 +02:00
commit 0a1fe26054
5 changed files with 870 additions and 370 deletions

View File

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

View File

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

View File

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

View File

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

View File

@ -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."