diff --git a/contrib/lisp/org-e-html.el b/contrib/lisp/org-e-html.el index 4b6d6d5a9..8d456c9ac 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 ade6b052a..8f43a9956 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 952bdbf57..09ef2ae16 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 a5a273cc9..e58d915f2 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 6eafb06cf..8f7f00c9b 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 "" @@ -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."