;;; org-element.el --- Parser And Applications for Org syntax
-;; Copyright (C) 2012-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; to at least one element.
;;
;; An element always starts and ends at the beginning of a line. With
-;; a few exceptions (namely `babel-call', `clock', `headline', `item',
-;; `keyword', `planning', `property-drawer' and `section' types), it
-;; can also accept a fixed set of keywords as attributes. Those are
-;; called "affiliated keywords" to distinguish them from other
-;; keywords, which are full-fledged elements. Almost all affiliated
-;; keywords are referenced in `org-element-affiliated-keywords'; the
-;; others are export attributes and start with "ATTR_" prefix.
+;; a few exceptions (`clock', `headline', `inlinetask', `item',
+;; `planning', `node-property', `quote-section' `section' and
+;; `table-row' types), it can also accept a fixed set of keywords as
+;; attributes. Those are called "affiliated keywords" to distinguish
+;; them from other keywords, which are full-fledged elements. Almost
+;; all affiliated keywords are referenced in
+;; `org-element-affiliated-keywords'; the others are export attributes
+;; and start with "ATTR_" prefix.
;;
;; Element containing other elements (and only elements) are called
;; greater elements. Concerned types are: `center-block', `drawer',
;; `dynamic-block', `footnote-definition', `headline', `inlinetask',
-;; `item', `plain-list', `quote-block', `section' and `special-block'.
+;; `item', `plain-list', `property-drawer', `quote-block', `section'
+;; and `special-block'.
;;
;; Other element types are: `babel-call', `clock', `comment',
-;; `comment-block', `example-block', `export-block', `fixed-width',
-;; `horizontal-rule', `keyword', `latex-environment', `paragraph',
-;; `planning', `property-drawer', `quote-section', `src-block',
-;; `table', `table-row' and `verse-block'. Among them, `paragraph'
-;; and `verse-block' types can contain Org objects and plain text.
+;; `comment-block', `diary-sexp', `example-block', `export-block',
+;; `fixed-width', `horizontal-rule', `keyword', `latex-environment',
+;; `node-property', `paragraph', `planning', `quote-section',
+;; `src-block', `table', `table-row' and `verse-block'. Among them,
+;; `paragraph' and `verse-block' types can contain Org objects and
+;; plain text.
;;
;; Objects are related to document's contents. Some of them are
;; recursive. Associated types are of the following: `bold', `code',
;; `table-cell', `target', `timestamp', `underline' and `verbatim'.
;;
;; Some elements also have special properties whose value can hold
-;; objects themselves (i.e. an item tag or an headline name). Such
+;; objects themselves (e.g. an item tag or a headline name). Such
;; values are called "secondary strings". Any object belongs to
;; either an element or a secondary string.
;;
;; refer to the beginning and ending buffer positions of the
;; considered element or object, `:post-blank', which holds the number
;; of blank lines, or white spaces, at its end and `:parent' which
-;; refers to the element or object containing it. Greater elements
-;; and elements containing objects will also have `:contents-begin'
-;; and `:contents-end' properties to delimit contents.
+;; refers to the element or object containing it. Greater elements,
+;; elements and objects containing objects will also have
+;; `:contents-begin' and `:contents-end' properties to delimit
+;; contents. Eventually, greater elements and elements accepting
+;; affiliated keywords will have a `:post-affiliated' property,
+;; referring to the buffer position after all such keywords.
+;;
+;; At the lowest level, a `:parent' property is also attached to any
+;; string, as a text property.
;;
;; Lisp-wise, an element or an object can be represented as a list.
;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
;;; Code:
-(eval-when-compile
- (require 'cl))
-
+(eval-when-compile (require 'cl))
(require 'org)
+
\f
;;; Definitions And Rules
;;
org-outline-regexp "\\|"
;; Footnote definitions.
"\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+ ;; Diary sexps.
+ "%%(" "\\|"
"[ \t]*\\(?:"
;; Empty lines.
"$" "\\|"
;; Tables (any type).
"\\(?:|\\|\\+-[-+]\\)" "\\|"
- ;; Blocks (any type), Babel calls, drawers (any type),
- ;; fixed-width areas and keywords. Note: this is only an
- ;; indication and need some thorough check.
- "[#:]" "\\|"
+ ;; Blocks (any type), Babel calls and keywords. Note: this
+ ;; is only an indication and need some thorough check.
+ "#\\(?:[+ ]\\|$\\)" "\\|"
+ ;; Drawers (any type) and fixed-width areas. This is also
+ ;; only an indication.
+ ":" "\\|"
;; Horizontal rules.
"-\\{5,\\}[ \t]*$" "\\|"
;; LaTeX environments.
;; Lists.
(let ((term (case org-plain-list-ordered-item-terminator
(?\) ")") (?. "\\.") (otherwise "[.)]")))
- (alpha (and org-alphabetical-lists "\\|[A-Za-z]")))
+ (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
(concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
"\\(?:[ \t]\\|$\\)"))
"\\)\\)")
`org-element-paragraph-parser' for more information.")
(defconst org-element-all-elements
- '(center-block clock comment comment-block drawer dynamic-block example-block
- export-block fixed-width footnote-definition headline
- horizontal-rule inlinetask item keyword latex-environment
- babel-call paragraph plain-list planning property-drawer
- quote-block quote-section section special-block src-block table
- table-row verse-block)
+ '(babel-call center-block clock comment comment-block diary-sexp drawer
+ dynamic-block example-block export-block fixed-width
+ footnote-definition headline horizontal-rule inlinetask item
+ keyword latex-environment node-property paragraph plain-list
+ planning property-drawer quote-block quote-section section
+ special-block src-block table table-row verse-block)
"Complete list of element types.")
(defconst org-element-greater-elements
'(center-block drawer dynamic-block footnote-definition headline inlinetask
- item plain-list quote-block section special-block table)
+ item plain-list property-drawer quote-block section
+ special-block table)
"List of recursive element types aka Greater Elements.")
(defconst org-element-all-successors
- '(export-snippet footnote-reference inline-babel-call inline-src-block
- latex-or-entity line-break link macro radio-target
- statistics-cookie sub/superscript table-cell target
- text-markup timestamp)
+ '(link export-snippet footnote-reference inline-babel-call
+ inline-src-block latex-or-entity line-break macro plain-link
+ radio-target statistics-cookie sub/superscript table-cell target
+ text-markup timestamp)
"Complete list of successors.")
(defconst org-element-object-successor-alist
(verbatim . text-markup) (entity . latex-or-entity)
(latex-fragment . latex-or-entity))
"Alist of translations between object type and successor name.
-
Sharing the same successor comes handy when, for example, the
regexp matching one object can also match the other object.")
"Complete list of object types.")
(defconst org-element-recursive-objects
- '(bold italic link macro subscript radio-target strike-through superscript
+ '(bold italic link subscript radio-target strike-through superscript
table-cell underline)
"List of recursive object types.")
-(defconst org-element-block-name-alist
+(defvar org-element-block-name-alist
'(("CENTER" . org-element-center-block-parser)
("COMMENT" . org-element-comment-block-parser)
("EXAMPLE" . org-element-example-block-parser)
Names must be uppercase. Any block whose name has no association
is parsed with `org-element-special-block-parser'.")
+(defconst org-element-link-type-is-file
+ '("file" "file+emacs" "file+sys" "docview")
+ "List of link types equivalent to \"file\".
+Only these types can accept search options and an explicit
+application to open them.")
+
(defconst org-element-affiliated-keywords
'("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
"RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
"List of affiliated keywords as strings.
-By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+By default, all keywords setting attributes (e.g., \"ATTR_LATEX\")
are affiliated keywords and need not to be in this list.")
-(defconst org-element--affiliated-re
- (format "[ \t]*#\\+%s:"
- ;; Regular affiliated keywords.
- (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?"
- (regexp-opt org-element-affiliated-keywords)))
- "Regexp matching any affiliated keyword.
-
-Keyword name is put in match group 1. Moreover, if keyword
-belongs to `org-element-dual-keywords', put the dual value in
-match group 2.
-
-Don't modify it, set `org-element-affiliated-keywords' instead.")
-
(defconst org-element-keyword-translation-alist
'(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
The key is the old name and the value the new one. The property
holding their value will be named after the translated name.")
-(defconst org-element-multiple-keywords '("HEADER")
- "List of affiliated keywords that can occur more that once in an element.
+(defconst org-element-multiple-keywords '("CAPTION" "HEADER")
+ "List of affiliated keywords that can occur more than once in an element.
Their value will be consed into a list of strings, which will be
returned as the value of the property.
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.
-By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
+By default, all keywords setting attributes (e.g., \"ATTR_LATEX\")
allow multiple occurrences and need not to be in this list.")
-(defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "DATE" "TITLE")
- "List of keywords whose value can be parsed.
+(defconst org-element-parsed-keywords '("CAPTION")
+ "List of affiliated keywords whose value can be parsed.
Their value will be stored as a secondary string: a list of
strings and objects.
`org-element-keyword-translation-alist'.")
(defconst org-element-dual-keywords '("CAPTION" "RESULTS")
- "List of keywords which can have a secondary value.
+ "List of affiliated keywords which can have a secondary value.
In Org syntax, they can be written with optional square brackets
-before the colons. For example, results keyword can be
+before the colons. For example, RESULTS keyword can be
associated to a hash value with the following:
#+RESULTS[hash-string]: some-source
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
+(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE")
+ "List of properties associated to the whole document.
+Any keyword in this list will have its value parsed and stored as
+a secondary string.")
+
+(defconst org-element--affiliated-re
+ (format "[ \t]*#\\+\\(?:%s\\):\\(?: \\|$\\)"
+ (concat
+ ;; Dual affiliated keywords.
+ (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?"
+ (regexp-opt org-element-dual-keywords))
+ "\\|"
+ ;; Regular affiliated keywords.
+ (format "\\(?1:%s\\)"
+ (regexp-opt
+ (org-remove-if
+ #'(lambda (keyword)
+ (member keyword org-element-dual-keywords))
+ org-element-affiliated-keywords)))
+ "\\|"
+ ;; Export attributes.
+ "\\(?1:ATTR_[-_A-Za-z0-9]+\\)"))
+ "Regexp matching any affiliated keyword.
+
+Keyword name is put in match group 1. Moreover, if keyword
+belongs to `org-element-dual-keywords', put the dual value in
+match group 2.
+
+Don't modify it, set `org-element-affiliated-keywords' instead.")
+
(defconst org-element-object-restrictions
- '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link
- radio-target sub/superscript target text-markup timestamp)
- (footnote-reference export-snippet footnote-reference inline-babel-call
- inline-src-block latex-or-entity line-break link macro
- radio-target sub/superscript target text-markup
- timestamp)
- (headline inline-babel-call inline-src-block latex-or-entity link macro
- radio-target statistics-cookie sub/superscript target text-markup
- timestamp)
- (inlinetask inline-babel-call inline-src-block latex-or-entity link macro
- radio-target sub/superscript target text-markup timestamp)
- (italic export-snippet inline-babel-call inline-src-block latex-or-entity
- link radio-target sub/superscript target text-markup timestamp)
- (item export-snippet footnote-reference inline-babel-call latex-or-entity
- link macro radio-target sub/superscript target text-markup)
- (keyword latex-or-entity macro sub/superscript text-markup)
- (link export-snippet inline-babel-call inline-src-block latex-or-entity link
- sub/superscript text-markup)
- (macro macro)
- (paragraph export-snippet footnote-reference inline-babel-call
- inline-src-block latex-or-entity line-break link macro
- radio-target statistics-cookie sub/superscript target text-markup
- timestamp)
- (radio-target export-snippet latex-or-entity sub/superscript)
- (strike-through export-snippet inline-babel-call inline-src-block
- latex-or-entity link radio-target sub/superscript target
- text-markup timestamp)
- (subscript export-snippet inline-babel-call inline-src-block latex-or-entity
- sub/superscript target text-markup)
- (superscript export-snippet inline-babel-call inline-src-block
- latex-or-entity sub/superscript target text-markup)
- (table-cell export-snippet latex-or-entity link macro radio-target
- sub/superscript target text-markup timestamp)
- (table-row table-cell)
- (underline export-snippet inline-babel-call inline-src-block latex-or-entity
- link radio-target sub/superscript target text-markup timestamp)
- (verse-block footnote-reference inline-babel-call inline-src-block
- latex-or-entity line-break link macro radio-target
- sub/superscript target text-markup timestamp))
+ (let* ((standard-set
+ (remq 'plain-link (remq 'table-cell org-element-all-successors)))
+ (standard-set-no-line-break (remq 'line-break standard-set)))
+ `((bold ,@standard-set)
+ (footnote-reference ,@standard-set)
+ (headline ,@standard-set-no-line-break)
+ (inlinetask ,@standard-set-no-line-break)
+ (italic ,@standard-set)
+ (item ,@standard-set-no-line-break)
+ (keyword ,@standard-set)
+ ;; Ignore all links excepted plain links in a link description.
+ ;; Also ignore radio-targets and line breaks.
+ (link export-snippet inline-babel-call inline-src-block latex-or-entity
+ macro plain-link statistics-cookie sub/superscript text-markup)
+ (paragraph ,@standard-set)
+ ;; Remove any variable object from radio target as it would
+ ;; prevent it from being properly recognized.
+ (radio-target latex-or-entity sub/superscript text-markup)
+ (strike-through ,@standard-set)
+ (subscript ,@standard-set)
+ (superscript ,@standard-set)
+ ;; Ignore inline babel call and inline src block as formulas are
+ ;; possible. Also ignore line breaks and statistics cookies.
+ (table-cell link export-snippet footnote-reference latex-or-entity macro
+ radio-target sub/superscript target text-markup timestamp)
+ (table-row table-cell)
+ (underline ,@standard-set)
+ (verse-block ,@standard-set)))
"Alist of objects restrictions.
CAR is an element or object type containing objects and CDR is
object of such type.
For example, in a `radio-target' object, one can only find
-entities, export snippets, latex-fragments, subscript and
-superscript.
+entities, latex-fragments, subscript, superscript and text
+markup.
This alist also applies to secondary string. For example, an
`headline' type element doesn't directly contain objects, but
;; Provide four accessors: `org-element-type', `org-element-property'
;; `org-element-contents' and `org-element-restriction'.
;;
-;; Setter functions allow to modify elements by side effect. There is
-;; `org-element-put-property', `org-element-set-contents',
+;; Setter functions allow modification of elements by side effect.
+;; There is `org-element-put-property', `org-element-set-contents',
;; `org-element-set-element' and `org-element-adopt-element'. Note
;; that `org-element-set-element' and `org-element-adopt-elements' are
;; higher level functions since also update `:parent' property.
(defsubst org-element-property (property element)
"Extract the value from the PROPERTY of an ELEMENT."
- (plist-get (nth 1 element) property))
+ (if (stringp element) (get-text-property 0 property element)
+ (plist-get (nth 1 element) property)))
(defsubst org-element-contents (element)
"Extract contents from an ELEMENT."
- (and (consp element) (nthcdr 2 element)))
+ (cond ((not (consp element)) nil)
+ ((symbolp (car element)) (nthcdr 2 element))
+ (t element)))
(defsubst org-element-restriction (element)
"Return restriction associated to ELEMENT.
(defsubst org-element-put-property (element property value)
"In ELEMENT set PROPERTY to VALUE.
Return modified element."
- (when (consp element)
- (setcar (cdr element) (plist-put (nth 1 element) property value)))
- element)
+ (if (stringp element) (org-add-props element nil property value)
+ (setcar (cdr element) (plist-put (nth 1 element) property value))
+ element))
(defsubst org-element-set-contents (element &rest contents)
"Set ELEMENT contents to CONTENTS.
Return modified element."
(cond ((not element) (list contents))
+ ((not (symbolp (car element))) contents)
((cdr element) (setcdr (cdr element) contents))
(t (nconc element contents))))
The function takes care of setting `:parent' property for CHILD.
Return parent element."
- (if (not parent) children
- ;; Link every child to PARENT.
- (mapc (lambda (child)
- (unless (stringp child)
- (org-element-put-property child :parent parent)))
- children)
- ;; Add CHILDREN at the end of PARENT contents.
+ ;; Link every child to PARENT. If PARENT is nil, it is a secondary
+ ;; string: parent is the list itself.
+ (mapc (lambda (child)
+ (org-element-put-property child :parent (or parent children)))
+ children)
+ ;; Add CHILDREN at the end of PARENT contents.
+ (when parent
(apply 'org-element-set-contents
parent
- (nconc (org-element-contents parent) children))
- ;; Return modified PARENT element.
- parent))
+ (nconc (org-element-contents parent) children)))
+ ;; Return modified PARENT element.
+ (or parent children))
\f
;; cannot contain other greater elements of their own type.
;;
;; Beside implementing a parser and an interpreter, adding a new
-;; greater element requires to tweak `org-element--current-element'.
+;; greater element requires tweaking `org-element--current-element'.
;; Moreover, the newly defined type must be added to both
;; `org-element-all-elements' and `org-element-greater-elements'.
;;;; Center Block
-(defun org-element-center-block-parser (limit)
+(defun org-element-center-block-parser (limit affiliated)
"Parse a center block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `center-block' and CDR is a plist
containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
- (end (save-excursion (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (end (save-excursion
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
(list 'center-block
(nconc
(list :begin begin
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
(defun org-element-center-block-interpreter (center-block contents)
"Interpret CENTER-BLOCK element as Org syntax.
;;;; Drawer
-(defun org-element-drawer-parser (limit)
+(defun org-element-drawer-parser (limit affiliated)
"Parse a drawer.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `drawer' and CDR is a plist containing
`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of drawer."
(let ((case-fold-search t))
(if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
;; Incomplete drawer: parse it as a paragraph.
- (org-element-paragraph-parser limit)
- (let ((drawer-end-line (match-beginning 0)))
- (save-excursion
- (let* ((case-fold-search t)
- (name (progn (looking-at org-drawer-regexp)
- (org-match-string-no-properties 1)))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
- ;; Empty drawers have no contents.
- (contents-begin (progn (forward-line)
- (and (< (point) drawer-end-line)
- (point))))
- (contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
- (pos-before-blank (progn (goto-char drawer-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
- (list 'drawer
- (nconc
- (list :begin begin
- :end end
- :drawer-name name
- :hiddenp hidden
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ (org-element-paragraph-parser limit affiliated)
+ (save-excursion
+ (let* ((drawer-end-line (match-beginning 0))
+ (name (progn (looking-at org-drawer-regexp)
+ (org-match-string-no-properties 1)))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ ;; Empty drawers have no contents.
+ (contents-begin (progn (forward-line)
+ (and (< (point) drawer-end-line)
+ (point))))
+ (contents-end (and contents-begin drawer-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char drawer-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'drawer
+ (nconc
+ (list :begin begin
+ :end end
+ :drawer-name name
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
(defun org-element-drawer-interpreter (drawer contents)
"Interpret DRAWER element as Org syntax.
;;;; Dynamic Block
-(defun org-element-dynamic-block-parser (limit)
+(defun org-element-dynamic-block-parser (limit affiliated)
"Parse a dynamic block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `dynamic-block' and CDR is a plist
containing `:block-name', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:arguments' and
-`:post-blank' keywords.
+`:contents-begin', `:contents-end', `:arguments', `:post-blank'
+and `:post-affiliated' keywords.
Assume point is at beginning of dynamic block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(save-excursion
(let* ((name (progn (looking-at org-dblock-start-re)
(org-match-string-no-properties 1)))
(arguments (org-match-string-no-properties 3))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'dynamic-block
(nconc
(list :begin begin
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-dynamic-block-interpreter (dynamic-block contents)
"Interpret DYNAMIC-BLOCK element as Org syntax.
;;;; Footnote Definition
-(defun org-element-footnote-definition-parser (limit)
+(defun org-element-footnote-definition-parser (limit affiliated)
"Parse a footnote definition.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `footnote-definition' and CDR is
a plist containing `:label', `:begin' `:end', `:contents-begin',
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the footnote definition."
(save-excursion
(let* ((label (progn (looking-at org-footnote-definition-re)
(org-match-string-no-properties 1)))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
+ (post-affiliated (point))
(ending (save-excursion
(if (progn
(end-of-line)
(re-search-forward
(concat org-outline-regexp-bol "\\|"
org-footnote-definition-re "\\|"
- "^[ \t]*$") limit 'move))
+ "^\\([ \t]*\n\\)\\{2,\\}") limit 'move))
(match-beginning 0)
(point))))
- (contents-begin (progn (search-forward "]")
- (skip-chars-forward " \r\t\n" ending)
- (and (/= (point) ending) (point))))
+ (contents-begin (progn
+ (search-forward "]")
+ (skip-chars-forward " \r\t\n" ending)
+ (cond ((= (point) ending) nil)
+ ((= (line-beginning-position) begin) (point))
+ (t (line-beginning-position)))))
(contents-end (and contents-begin ending))
(end (progn (goto-char ending)
(skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'footnote-definition
(nconc
(list :label label
:end end
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines ending end))
- (cadr keywords))))))
+ :post-blank (count-lines ending end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
;;;; Headline
(defun org-element-headline-parser (limit &optional raw-secondary-p)
- "Parse an headline.
+ "Parse a headline.
Return a list whose CAR is `headline' and CDR is a plist
-containing `:raw-value', `:title', `:begin', `:end',
-`:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end',
-`:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
-`:scheduled', `:deadline', `:timestamp', `:clock', `:category',
-`:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p'
-keywords.
+containing `:raw-value', `:title', `:alt-title', `:begin',
+`:end', `:pre-blank', `:hiddenp', `:contents-begin',
+`:contents-end', `:level', `:priority', `:tags',
+`:todo-keyword',`:todo-type', `:scheduled', `:deadline',
+`:closed', `:quotedp', `:archivedp', `:commentedp',
+`:footnote-section-p' and `:post-blank' keywords.
The plist also contains any property set in the property drawer,
-with its name in lowercase, the underscores replaced with hyphens
-and colons at the beginning (i.e. `:custom-id').
+with its name in upper cases and colons added at the
+beginning (e.g., `:CUSTOM_ID').
+
+LIMIT is a buffer position bounding the search.
When RAW-SECONDARY-P is non-nil, headline's title will not be
parsed as a secondary string, but as a plain string instead.
(archivedp (member org-archive-tag tags))
(footnote-section-p (and org-footnote-section
(string= org-footnote-section raw-value)))
- ;; Normalize property names: ":SOME_PROP:" becomes
- ;; ":some-prop".
- (standard-props (let (plist)
- (mapc
- (lambda (p)
- (let ((p-name (downcase (car p))))
- (while (string-match "_" p-name)
- (setq p-name
- (replace-match "-" nil nil p-name)))
- (setq p-name (intern (concat ":" p-name)))
- (setq plist
- (plist-put plist p-name (cdr p)))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props (org-entry-properties nil 'special "CLOCK"))
- (scheduled (cdr (assoc "SCHEDULED" time-props)))
- (deadline (cdr (assoc "DEADLINE" time-props)))
- (clock (cdr (assoc "CLOCK" time-props)))
- (timestamp (cdr (assoc "TIMESTAMP" time-props)))
+ ;; Upcase property names. It avoids confusion between
+ ;; properties obtained through property drawer and default
+ ;; properties from the parser (e.g. `:end' and :END:)
+ (standard-props
+ (let (plist)
+ (mapc
+ (lambda (p)
+ (setq plist
+ (plist-put plist
+ (intern (concat ":" (upcase (car p))))
+ (cdr p))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props
+ ;; Read time properties on the line below the headline.
+ (save-excursion
+ (when (progn (forward-line)
+ (looking-at org-planning-or-clock-line-re))
+ (let ((end (line-end-position)) plist)
+ (while (re-search-forward
+ org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t")
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-scheduled-string)
+ (setq plist (plist-put plist :scheduled time)))
+ ((equal keyword org-deadline-string)
+ (setq plist (plist-put plist :deadline time)))
+ (t (setq plist (plist-put plist :closed time))))))
+ plist))))
(begin (point))
- (end (save-excursion (goto-char (org-end-of-subtree t t))))
+ (end (min (save-excursion (org-end-of-subtree t t)) limit))
(pos-after-head (progn (forward-line) (point)))
(contents-begin (save-excursion
(skip-chars-forward " \r\t\n" end)
:tags tags
:todo-keyword todo
:todo-type todo-type
- :scheduled scheduled
- :deadline deadline
- :timestamp timestamp
- :clock clock
:post-blank (count-lines
- (if (not contents-end) pos-after-head
- (goto-char contents-end)
- (forward-line)
- (point))
+ (or contents-end pos-after-head)
end)
:footnote-section-p footnote-section-p
:archivedp archivedp
:commentedp commentedp
:quotedp quotedp)
+ time-props
standard-props))))
+ (let ((alt-title (org-element-property :ALT_TITLE headline)))
+ (when alt-title
+ (org-element-put-property
+ headline :alt-title
+ (if raw-secondary-p alt-title
+ (org-element-parse-secondary-string
+ alt-title (org-element-restriction 'headline) headline)))))
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
(org-element-property :tags headline))
(org-element-property :tags headline))))
(and tag-list
- (format ":%s:" (mapconcat 'identity tag-list ":")))))
+ (format ":%s:" (mapconcat #'identity tag-list ":")))))
(commentedp (org-element-property :commentedp headline))
(quotedp (org-element-property :quotedp headline))
(pre-blank (or (org-element-property :pre-blank headline) 0))
- (heading (concat (make-string level ?*)
- (and todo (concat " " todo))
- (and quotedp (concat " " org-quote-string))
- (and commentedp (concat " " org-comment-string))
- (and priority
- (format " [#%s]" (char-to-string priority)))
- (cond ((and org-footnote-section
- (org-element-property
- :footnote-section-p headline))
- (concat " " org-footnote-section))
- (title (concat " " title))))))
- (concat heading
- ;; Align tags.
- (when tags
- (cond
- ((zerop org-tags-column) (format " %s" tags))
- ((< org-tags-column 0)
- (concat
- (make-string
- (max (- (+ org-tags-column (length heading) (length tags))) 1)
- ? )
- tags))
- (t
- (concat
- (make-string (max (- org-tags-column (length heading)) 1) ? )
- tags))))
- (make-string (1+ pre-blank) 10)
- contents)))
+ (heading
+ (concat (make-string (if org-odd-levels-only (1- (* level 2)) level)
+ ?*)
+ (and todo (concat " " todo))
+ (and quotedp (concat " " org-quote-string))
+ (and commentedp (concat " " org-comment-string))
+ (and priority (format " [#%s]" (char-to-string priority)))
+ " "
+ (if (and org-footnote-section
+ (org-element-property :footnote-section-p headline))
+ org-footnote-section
+ title))))
+ (concat
+ heading
+ ;; Align tags.
+ (when tags
+ (cond
+ ((zerop org-tags-column) (format " %s" tags))
+ ((< org-tags-column 0)
+ (concat
+ (make-string
+ (max (- (+ org-tags-column (length heading) (length tags))) 1)
+ ?\s)
+ tags))
+ (t
+ (concat
+ (make-string (max (- org-tags-column (length heading)) 1) ?\s)
+ tags))))
+ (make-string (1+ pre-blank) ?\n)
+ contents)))
;;;; Inlinetask
containing `:title', `:begin', `:end', `:hiddenp',
`:contents-begin' and `:contents-end', `:level', `:priority',
`:raw-value', `:tags', `:todo-keyword', `:todo-type',
-`:scheduled', `:deadline', `:timestamp', `:clock' and
-`:post-blank' keywords.
+`:scheduled', `:deadline', `:closed' and `:post-blank' keywords.
The plist also contains any property set in the property drawer,
-with its name in lowercase, the underscores replaced with hyphens
-and colons at the beginning (i.e. `:custom-id').
+with its name in upper cases and colons added at the
+beginning (e.g., `:CUSTOM_ID').
When optional argument RAW-SECONDARY-P is non-nil, inline-task's
title will not be parsed as a secondary string, but as a plain
Assume point is at beginning of the inline task."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (point))
(components (org-heading-components))
(todo (nth 2 components))
(todo-type (and todo
(tags (let ((raw-tags (nth 5 components)))
(and raw-tags (org-split-string raw-tags ":"))))
(raw-value (or (nth 4 components) ""))
- ;; Normalize property names: ":SOME_PROP:" becomes
- ;; ":some-prop".
- (standard-props (let (plist)
- (mapc
- (lambda (p)
- (let ((p-name (downcase (car p))))
- (while (string-match "_" p-name)
- (setq p-name
- (replace-match "-" nil nil p-name)))
- (setq p-name (intern (concat ":" p-name)))
- (setq plist
- (plist-put plist p-name (cdr p)))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props (org-entry-properties nil 'special "CLOCK"))
- (scheduled (cdr (assoc "SCHEDULED" time-props)))
- (deadline (cdr (assoc "DEADLINE" time-props)))
- (clock (cdr (assoc "CLOCK" time-props)))
- (timestamp (cdr (assoc "TIMESTAMP" time-props)))
+ ;; Upcase property names. It avoids confusion between
+ ;; properties obtained through property drawer and default
+ ;; properties from the parser (e.g. `:end' and :END:)
+ (standard-props
+ (let (plist)
+ (mapc
+ (lambda (p)
+ (setq plist
+ (plist-put plist
+ (intern (concat ":" (upcase (car p))))
+ (cdr p))))
+ (org-entry-properties nil 'standard))
+ plist))
+ (time-props
+ ;; Read time properties on the line below the inlinetask
+ ;; opening string.
+ (save-excursion
+ (when (progn (forward-line)
+ (looking-at org-planning-or-clock-line-re))
+ (let ((end (line-end-position)) plist)
+ (while (re-search-forward
+ org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t")
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-scheduled-string)
+ (setq plist (plist-put plist :scheduled time)))
+ ((equal keyword org-deadline-string)
+ (setq plist (plist-put plist :deadline time)))
+ (t (setq plist (plist-put plist :closed time))))))
+ plist))))
(task-end (save-excursion
(end-of-line)
- (and (re-search-forward "^\\*+ END" limit t)
- (match-beginning 0))))
+ (and (re-search-forward org-outline-regexp-bol limit t)
+ (org-looking-at-p "END[ \t]*$")
+ (line-beginning-position))))
(contents-begin (progn (forward-line)
(and task-end (< (point) task-end) (point))))
(hidden (and contents-begin (org-invisible-p2)))
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))
+ (if (eobp) (point) (line-beginning-position))))
(inlinetask
(list 'inlinetask
(nconc
:tags tags
:todo-keyword todo
:todo-type todo-type
- :scheduled scheduled
- :deadline deadline
- :timestamp timestamp
- :clock clock
:post-blank (count-lines before-blank end))
- standard-props
- (cadr keywords)))))
+ time-props
+ standard-props))))
(org-element-put-property
inlinetask :title
(if raw-secondary-p raw-value
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
CONTENTS is the contents of the element."
- (let* ((bullet (org-list-bullet-string (org-element-property :bullet item)))
+ (let* ((bullet (let ((bullet (org-element-property :bullet item)))
+ (org-list-bullet-string
+ (cond ((not (string-match "[0-9a-zA-Z]" bullet)) "- ")
+ ((eq org-plain-list-ordered-item-terminator ?\)) "1)")
+ (t "1.")))))
(checkbox (org-element-property :checkbox item))
(counter (org-element-property :counter item))
(tag (let ((tag (org-element-property :tag item)))
(off "[ ] ")
(trans "[-] "))
(and tag (format "%s :: " tag))
- (let ((contents (replace-regexp-in-string
- "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
- (if item-starts-with-par-p (org-trim contents)
- (concat "\n" contents))))))
+ (when contents
+ (let ((contents (replace-regexp-in-string
+ "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
+ (if item-starts-with-par-p (org-trim contents)
+ (concat "\n" contents)))))))
;;;; Plain List
-(defun org-element-plain-list-parser (limit &optional structure)
+(defun org-element--list-struct (limit)
+ ;; Return structure of list at point. Internal function. See
+ ;; `org-list-struct' for details.
+ (let ((case-fold-search t)
+ (top-ind limit)
+ (item-re (org-item-re))
+ (drawers-re (concat ":\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$"))
+ (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
+ items struct)
+ (save-excursion
+ (catch 'exit
+ (while t
+ (cond
+ ;; At limit: end all items.
+ ((>= (point) limit)
+ (throw 'exit
+ (let ((end (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))
+ (dolist (item items (sort (nconc items struct)
+ 'car-less-than-car))
+ (setcar (nthcdr 6 item) end)))))
+ ;; At list end: end all items.
+ ((looking-at org-list-end-re)
+ (throw 'exit (dolist (item items (sort (nconc items struct)
+ 'car-less-than-car))
+ (setcar (nthcdr 6 item) (point)))))
+ ;; At a new item: end previous sibling.
+ ((looking-at item-re)
+ (let ((ind (save-excursion (skip-chars-forward " \t")
+ (current-column))))
+ (setq top-ind (min top-ind ind))
+ (while (and items (<= ind (nth 1 (car items))))
+ (let ((item (pop items)))
+ (setcar (nthcdr 6 item) (point))
+ (push item struct)))
+ (push (progn (looking-at org-list-full-item-re)
+ (let ((bullet (match-string-no-properties 1)))
+ (list (point)
+ ind
+ bullet
+ (match-string-no-properties 2) ; counter
+ (match-string-no-properties 3) ; checkbox
+ ;; Description tag.
+ (and (save-match-data
+ (string-match "[-+*]" bullet))
+ (match-string-no-properties 4))
+ ;; Ending position, unknown so far.
+ nil)))
+ items))
+ (forward-line 1))
+ ;; Skip empty lines.
+ ((looking-at "^[ \t]*$") (forward-line))
+ ;; Skip inline tasks and blank lines along the way.
+ ((and inlinetask-re (looking-at inlinetask-re))
+ (forward-line)
+ (let ((origin (point)))
+ (when (re-search-forward inlinetask-re limit t)
+ (if (org-looking-at-p "END[ \t]*$") (forward-line)
+ (goto-char origin)))))
+ ;; At some text line. Check if it ends any previous item.
+ (t
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (when (<= ind top-ind)
+ (skip-chars-backward " \r\t\n")
+ (forward-line))
+ (while (<= ind (nth 1 (car items)))
+ (let ((item (pop items)))
+ (setcar (nthcdr 6 item) (line-beginning-position))
+ (push item struct)
+ (unless items
+ (throw 'exit (sort struct 'car-less-than-car))))))
+ ;; Skip blocks (any type) and drawers contents.
+ (cond
+ ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
+ (re-search-forward
+ (format "^[ \t]*#\\+END%s[ \t]*$"
+ (org-match-string-no-properties 1))
+ limit t)))
+ ((and (looking-at drawers-re)
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
+ (forward-line))))))))
+
+(defun org-element-plain-list-parser (limit affiliated structure)
"Parse a plain list.
-Optional argument STRUCTURE, when non-nil, is the structure of
-the plain list being parsed.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value. STRUCTURE is the structure of 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', `:structure' and `:post-blank' keywords.
+`:contents-end', `:structure', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the list."
(save-excursion
- (let* ((struct (or structure (org-list-struct)))
+ (let* ((struct (or structure (org-element--list-struct limit)))
(prevs (org-list-prevs-alist struct))
- (parents (org-list-parents-alist struct))
(type (org-list-get-list-type (point) struct prevs))
(contents-begin (point))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
(contents-end
(progn (goto-char (org-list-get-list-end (point) struct prevs))
(unless (bolp) (forward-line))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (= (point) limit) limit (line-beginning-position)))))
;; Return value.
(list 'plain-list
(nconc
:contents-begin contents-begin
:contents-end contents-end
:structure struct
- :post-blank (count-lines contents-end end))
- (cadr keywords))))))
+ :post-blank (count-lines contents-end end)
+ :post-affiliated contents-begin)
+ (cdr affiliated))))))
(defun org-element-plain-list-interpreter (plain-list contents)
"Interpret PLAIN-LIST element as Org syntax.
(buffer-string)))
+;;;; Property Drawer
+
+(defun org-element-property-drawer-parser (limit affiliated)
+ "Parse a property drawer.
+
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
+
+Return a list whose CAR is `property-drawer' and CDR is a plist
+containing `:begin', `:end', `:hiddenp', `:contents-begin',
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+
+Assume point is at the beginning of the property drawer."
+ (let ((case-fold-search t))
+ (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
+ ;; Incomplete drawer: parse it as a paragraph.
+ (org-element-paragraph-parser limit affiliated)
+ (save-excursion
+ (let* ((drawer-end-line (match-beginning 0))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ (contents-begin
+ (progn
+ (forward-line)
+ (and (re-search-forward org-property-re drawer-end-line t)
+ (line-beginning-position))))
+ (contents-end (and contents-begin drawer-end-line))
+ (hidden (org-invisible-p2))
+ (pos-before-blank (progn (goto-char drawer-end-line)
+ (forward-line)
+ (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'property-drawer
+ (nconc
+ (list :begin begin
+ :end end
+ :hiddenp hidden
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))))
+
+(defun org-element-property-drawer-interpreter (property-drawer contents)
+ "Interpret PROPERTY-DRAWER element as Org syntax.
+CONTENTS is the properties within the drawer."
+ (format ":PROPERTIES:\n%s:END:" contents))
+
+
;;;; Quote Block
-(defun org-element-quote-block-parser (limit)
+(defun org-element-quote-block-parser (limit affiliated)
"Parse a quote block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `quote-block' and CDR is a plist
containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'quote-block
(nconc
(list :begin begin
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-quote-block-interpreter (quote-block contents)
"Interpret QUOTE-BLOCK element as Org syntax.
;;;; Special Block
-(defun org-element-special-block-parser (limit)
+(defun org-element-special-block-parser (limit affiliated)
"Parse a special block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `special-block' and CDR is a plist
containing `:type', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end' and `:post-blank' keywords.
+`:contents-begin', `:contents-end', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let* ((case-fold-search t)
- (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)")
+ (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(upcase (match-string-no-properties 1)))))
(if (not (save-excursion
(re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
+ (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
+ limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Empty blocks have no contents.
(contents-begin (progn (forward-line)
(and (< (point) block-end-line)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'special-block
(nconc
(list :type type
:hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-special-block-interpreter (special-block contents)
"Interpret SPECIAL-BLOCK element as Org syntax.
;;;; Babel Call
-(defun org-element-babel-call-parser (limit)
+(defun org-element-babel-call-parser (limit affiliated)
"Parse a babel call.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `babel-call' and CDR is a plist
-containing `:begin', `:end', `:info' and `:post-blank' as
-keywords."
+containing `:begin', `:end', `:info', `:post-blank' and
+`:post-affiliated' as keywords."
(save-excursion
(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))
+ (begin (car affiliated))
+ (post-affiliated (point))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'babel-call
- (list :begin begin
- :end end
- :info info
- :post-blank (count-lines pos-before-blank end))))))
+ (nconc
+ (list :begin begin
+ :end end
+ :info info
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-babel-call-interpreter (babel-call contents)
"Interpret BABEL-CALL element as Org syntax.
(let* ((case-fold-search nil)
(begin (point))
(value (progn (search-forward org-clock-string (line-end-position) t)
- (org-skip-whitespace)
- (looking-at "\\[.*\\]")
- (org-match-string-no-properties 0)))
- (time (and (progn (goto-char (match-end 0))
- (looking-at " +=> +\\(\\S-+\\)[ \t]*$"))
- (org-match-string-no-properties 1)))
- (status (if time 'closed 'running))
+ (skip-chars-forward " \t")
+ (org-element-timestamp-parser)))
+ (duration (and (search-forward " => " (line-end-position) t)
+ (progn (skip-chars-forward " \t")
+ (looking-at "\\(\\S-+\\)[ \t]*$"))
+ (org-match-string-no-properties 1)))
+ (status (if duration 'closed 'running))
(post-blank (let ((before-blank (progn (forward-line) (point))))
(skip-chars-forward " \r\t\n" limit)
(skip-chars-backward " \t")
(list 'clock
(list :status status
:value value
- :time time
+ :duration duration
:begin begin
:end end
:post-blank post-blank)))))
"Interpret CLOCK element as Org syntax.
CONTENTS is nil."
(concat org-clock-string " "
- (org-element-property :value clock)
- (let ((time (org-element-property :time clock)))
- (and time
+ (org-element-timestamp-interpreter
+ (org-element-property :value clock) nil)
+ (let ((duration (org-element-property :duration clock)))
+ (and duration
(concat " => "
(apply 'format
"%2s:%02s"
- (org-split-string time ":")))))))
+ (org-split-string duration ":")))))))
;;;; Comment
-(defun org-element-comment-parser (limit)
+(defun org-element-comment-parser (limit affiliated)
"Parse a comment.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `comment' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank'
-keywords.
+containing `:begin', `:end', `:value', `:post-blank',
+`:post-affiliated' keywords.
Assume point is at comment beginning."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(value (prog2 (looking-at "[ \t]*# ?")
(buffer-substring-no-properties
(match-end 0) (line-end-position))
(point)))
(end (progn (goto-char com-end)
(skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'comment
(nconc
(list :begin begin
:end end
:value value
- :post-blank (count-lines com-end end))
- (cadr keywords))))))
+ :post-blank (count-lines com-end end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-comment-interpreter (comment contents)
"Interpret COMMENT element as Org syntax.
;;;; Comment Block
-(defun org-element-comment-block-parser (limit)
+(defun org-element-comment-block-parser (limit affiliated)
"Parse an export block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `comment-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:value' and
-`:post-blank' keywords.
+containing `:begin', `:end', `:hiddenp', `:value', `:post-blank'
+and `:post-affiliated' keywords.
Assume point is at comment block beginning."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
(hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))
+ (if (eobp) (point) (line-beginning-position))))
(value (buffer-substring-no-properties
contents-begin contents-end)))
(list 'comment-block
:end end
:value value
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-comment-block-interpreter (comment-block contents)
"Interpret COMMENT-BLOCK element as Org syntax.
(org-remove-indentation (org-element-property :value comment-block))))
+;;;; Diary Sexp
+
+(defun org-element-diary-sexp-parser (limit affiliated)
+ "Parse a diary sexp.
+
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
+
+Return a list whose CAR is `diary-sexp' and CDR is a plist
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords."
+ (save-excursion
+ (let ((begin (car affiliated))
+ (post-affiliated (point))
+ (value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
+ (org-match-string-no-properties 1)))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'diary-sexp
+ (nconc
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
+
+(defun org-element-diary-sexp-interpreter (diary-sexp contents)
+ "Interpret DIARY-SEXP as Org syntax.
+CONTENTS is nil."
+ (org-element-property :value diary-sexp))
+
+
;;;; Example Block
-(defun org-element-example-block-parser (limit)
+(defun org-element--remove-indentation (s &optional n)
+ "Remove maximum common indentation in string S and return it.
+When optional argument N is a positive integer, remove exactly
+that much characters from indentation, if possible, or return
+S as-is otherwise. Unlike to `org-remove-indentation', this
+function doesn't call `untabify' on S."
+ (catch 'exit
+ (with-temp-buffer
+ (insert s)
+ (goto-char (point-min))
+ ;; Find maximum common indentation, if not specified.
+ (setq n (or n
+ (let ((min-ind (point-max)))
+ (save-excursion
+ (while (re-search-forward "^[ \t]*\\S-" nil t)
+ (let ((ind (1- (current-column))))
+ (if (zerop ind) (throw 'exit s)
+ (setq min-ind (min min-ind ind))))))
+ min-ind)))
+ (if (zerop n) s
+ ;; Remove exactly N indentation, but give up if not possible.
+ (while (not (eobp))
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (cond ((eolp) (delete-region (line-beginning-position) (point)))
+ ((< ind n) (throw 'exit s))
+ (t (org-indent-line-to (- ind n))))
+ (forward-line)))
+ (buffer-string)))))
+
+(defun org-element-example-block-parser (limit affiliated)
"Parse an example block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `example-block' and CDR is a plist
containing `:begin', `:end', `:number-lines', `:preserve-indent',
`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
-`:switches', `:value' and `:post-blank' keywords."
+`:switches', `:value', `:post-blank' and `:post-affiliated'
+keywords."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
(let* ((switches
- (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
- (org-match-string-no-properties 1)))
+ (progn
+ (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
+ (org-match-string-no-properties 1)))
;; Switches analysis
- (number-lines (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
- (preserve-indent (and switches (string-match "-i\\>" switches)))
+ (number-lines
+ (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent
+ (or org-src-preserve-indentation
+ (and switches (string-match "-i\\>" switches))))
;; Should labels be retained in (or stripped from) example
;; blocks?
(retain-labels
;; line-numbers?
(use-labels
(or (not switches)
- (and retain-labels (not (string-match "-k\\>" switches)))))
- (label-fmt (and switches
- (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
+ (and retain-labels
+ (not (string-match "-k\\>" switches)))))
+ (label-fmt
+ (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches)))
;; Standard block parsing.
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
+ (post-affiliated (point))
+ (block-ind (progn (skip-chars-forward " \t") (current-column)))
(contents-begin (progn (forward-line) (point)))
(hidden (org-invisible-p2))
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties
- contents-begin contents-end)))
+ (value (org-element--remove-indentation
+ (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ contents-begin contents-end))
+ (and preserve-indent block-ind)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'example-block
(nconc
(list :begin begin
:use-labels use-labels
:label-fmt label-fmt
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-example-block-interpreter (example-block contents)
"Interpret EXAMPLE-BLOCK element as Org syntax.
CONTENTS is nil."
(let ((switches (org-element-property :switches example-block)))
(concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
- (org-remove-indentation
- (org-escape-code-in-string
- (org-element-property :value example-block)))
+ (org-escape-code-in-string
+ (org-element-property :value example-block))
"#+END_EXAMPLE")))
;;;; Export Block
-(defun org-element-export-block-parser (limit)
+(defun org-element-export-block-parser (limit affiliated)
"Parse an export block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `export-block' and CDR is a plist
-containing `:begin', `:end', `:type', `:hiddenp', `:value' and
-`:post-blank' keywords.
+containing `:begin', `:end', `:type', `:hiddenp', `:value',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at export-block beginning."
(let* ((case-fold-search t)
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
(hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))
+ (if (eobp) (point) (line-beginning-position))))
(value (buffer-substring-no-properties contents-begin
contents-end)))
(list 'export-block
:type type
:value value
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-export-block-interpreter (export-block contents)
"Interpret EXPORT-BLOCK element as Org syntax.
;;;; Fixed-width
-(defun org-element-fixed-width-parser (limit)
+(defun org-element-fixed-width-parser (limit affiliated)
"Parse a fixed-width section.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `fixed-width' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank' keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the fixed-width area."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
value
(end-area
(progn
(forward-line))
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'fixed-width
(nconc
(list :begin begin
:end end
:value value
- :post-blank (count-lines end-area end))
- (cadr keywords))))))
+ :post-blank (count-lines end-area end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-fixed-width-interpreter (fixed-width contents)
"Interpret FIXED-WIDTH element as Org syntax.
CONTENTS is nil."
- (replace-regexp-in-string
- "^" ": " (substring (org-element-property :value fixed-width) 0 -1)))
+ (let ((value (org-element-property :value fixed-width)))
+ (and value
+ (replace-regexp-in-string
+ "^" ": "
+ (if (string-match "\n\\'" value) (substring value 0 -1) value)))))
;;;; Horizontal Rule
-(defun org-element-horizontal-rule-parser (limit)
+(defun org-element-horizontal-rule-parser (limit affiliated)
"Parse an horizontal rule.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `horizontal-rule' and CDR is a plist
-containing `:begin', `:end' and `:post-blank' keywords."
+containing `:begin', `:end', `:post-blank' and `:post-affiliated'
+keywords."
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
- (post-hr (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (let ((begin (car affiliated))
+ (post-affiliated (point))
+ (post-hr (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
(list 'horizontal-rule
(nconc
(list :begin begin
:end end
- :post-blank (count-lines post-hr end))
- (cadr keywords))))))
+ :post-blank (count-lines post-hr end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
"Interpret HORIZONTAL-RULE element as Org syntax.
;;;; Keyword
-(defun org-element-keyword-parser (limit)
+(defun org-element-keyword-parser (limit affiliated)
"Parse a keyword at point.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `keyword' and CDR is a plist
-containing `:key', `:value', `:begin', `:end' and `:post-blank'
-keywords."
+containing `:key', `:value', `:begin', `:end', `:post-blank' and
+`:post-affiliated' keywords."
(save-excursion
- (let* ((case-fold-search t)
- (begin (point))
- (key (progn (looking-at "[ \t]*#\\+\\(\\S-+\\):")
- (upcase (org-match-string-no-properties 1))))
- (value (org-trim (buffer-substring-no-properties
- (match-end 0) (point-at-eol))))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (let ((begin (car affiliated))
+ (post-affiliated (point))
+ (key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
+ (upcase (org-match-string-no-properties 1))))
+ (value (org-trim (buffer-substring-no-properties
+ (match-end 0) (point-at-eol))))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
(list 'keyword
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end))))))
+ (nconc
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated))))))
(defun org-element-keyword-interpreter (keyword contents)
"Interpret KEYWORD element as Org syntax.
;;;; Latex Environment
-(defun org-element-latex-environment-parser (limit)
+(defun org-element-latex-environment-parser (limit affiliated)
"Parse a LaTeX environment.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `latex-environment' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank'
-keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the latex environment."
(save-excursion
- (let* ((case-fold-search t)
- (code-begin (point))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
- (env (progn (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
- (regexp-quote (match-string 1))))
- (code-end
- (progn (re-search-forward
- (format "^[ \t]*\\\\end{%s}[ \t]*$" env) limit t)
- (forward-line)
- (point)))
- (value (buffer-substring-no-properties code-begin code-end))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
- (list 'latex-environment
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines code-end end))
- (cadr keywords))))))
+ (let ((case-fold-search t)
+ (code-begin (point)))
+ (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
+ (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$"
+ (regexp-quote (match-string 1)))
+ limit t))
+ ;; Incomplete latex environment: parse it as a paragraph.
+ (org-element-paragraph-parser limit affiliated)
+ (let* ((code-end (progn (forward-line) (point)))
+ (begin (car affiliated))
+ (value (buffer-substring-no-properties code-begin code-end))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'latex-environment
+ (nconc
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank (count-lines code-end end)
+ :post-affiliated code-begin)
+ (cdr affiliated))))))))
(defun org-element-latex-environment-interpreter (latex-environment contents)
"Interpret LATEX-ENVIRONMENT element as Org syntax.
(org-element-property :value latex-environment))
+;;;; Node Property
+
+(defun org-element-node-property-parser (limit)
+ "Parse a node-property at point.
+
+LIMIT bounds the search.
+
+Return a list whose CAR is `node-property' and CDR is a plist
+containing `:key', `:value', `:begin', `:end' and `:post-blank'
+keywords."
+ (looking-at org-property-re)
+ (let ((begin (point))
+ (key (org-match-string-no-properties 2))
+ (value (org-match-string-no-properties 3))
+ (end (save-excursion
+ (end-of-line)
+ (if (re-search-forward org-property-re limit t)
+ (line-beginning-position)
+ limit))))
+ (list 'node-property
+ (list :key key
+ :value value
+ :begin begin
+ :end end
+ :post-blank 0))))
+
+(defun org-element-node-property-interpreter (node-property contents)
+ "Interpret NODE-PROPERTY element as Org syntax.
+CONTENTS is nil."
+ (format org-property-format
+ (format ":%s:" (org-element-property :key node-property))
+ (or (org-element-property :value node-property) "")))
+
+
;;;; Paragraph
-(defun org-element-paragraph-parser (limit)
+(defun org-element-paragraph-parser (limit affiliated)
"Parse a paragraph.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `paragraph' and CDR is a plist
containing `:begin', `:end', `:contents-begin' and
-`:contents-end' and `:post-blank' keywords.
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the paragraph."
(save-excursion
- (let* ((contents-begin (point))
- ;; INNER-PAR-P is non-nil when paragraph is at the
- ;; beginning of an item or a footnote reference. In that
- ;; case, we mustn't look for affiliated keywords since they
- ;; belong to the container.
- (inner-par-p (not (bolp)))
- (keywords (unless inner-par-p
- (org-element--collect-affiliated-keywords)))
- (begin (if inner-par-p contents-begin (car keywords)))
+ (let* ((begin (car affiliated))
+ (contents-begin (point))
(before-blank
(let ((case-fold-search t))
(end-of-line)
;; A matching `org-element-paragraph-separate' is not
;; necessarily the end of the paragraph. In
;; particular, lines starting with # or : as a first
- ;; non-space character are ambiguous. We have check
- ;; if they are valid Org syntax (i.e. not an
+ ;; non-space character are ambiguous. We have to
+ ;; check if they are valid Org syntax (e.g., not an
;; incomplete keyword).
(beginning-of-line)
(while (not
(re-search-forward
"^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Stop at valid blocks.
- (and (looking-at
- "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(save-excursion
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid latex environments.
(and (looking-at
- "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}[ \t]*$")
+ "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
(save-excursion
(re-search-forward
(format "^[ \t]*\\\\end{%s}[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid keywords.
(looking-at "[ \t]*#\\+\\S-+:")
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'paragraph
(nconc
(list :begin begin
:end end
:contents-begin contents-begin
:contents-end contents-end
- :post-blank (count-lines before-blank end))
- (cadr keywords))))))
+ :post-blank (count-lines before-blank end)
+ :post-affiliated contents-begin)
+ (cdr affiliated))))))
(defun org-element-paragraph-interpreter (paragraph contents)
"Interpret PARAGRAPH element as Org syntax.
(end (point))
closed deadline scheduled)
(goto-char begin)
- (while (re-search-forward org-keyword-time-not-clock-regexp
- (line-end-position) t)
+ (while (re-search-forward org-keyword-time-not-clock-regexp end t)
(goto-char (match-end 1))
- (org-skip-whitespace)
- (let ((time (buffer-substring-no-properties
- (1+ (point)) (1- (match-end 0))))
- (keyword (match-string 1)))
+ (skip-chars-forward " \t" end)
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
(cond ((equal keyword org-closed-string) (setq closed time))
((equal keyword org-deadline-string) (setq deadline time))
(t (setq scheduled time)))))
(mapconcat
'identity
(delq nil
- (list (let ((closed (org-element-property :closed planning)))
- (when closed (concat org-closed-string " [" closed "]")))
- (let ((deadline (org-element-property :deadline planning)))
- (when deadline (concat org-deadline-string " <" deadline ">")))
+ (list (let ((deadline (org-element-property :deadline planning)))
+ (when deadline
+ (concat org-deadline-string " "
+ (org-element-timestamp-interpreter deadline nil))))
(let ((scheduled (org-element-property :scheduled planning)))
(when scheduled
- (concat org-scheduled-string " <" scheduled ">")))))
+ (concat org-scheduled-string " "
+ (org-element-timestamp-interpreter scheduled nil))))
+ (let ((closed (org-element-property :closed planning)))
+ (when closed
+ (concat org-closed-string " "
+ (org-element-timestamp-interpreter closed nil))))))
" "))
-;;;; Property Drawer
-
-(defun org-element-property-drawer-parser (limit)
- "Parse a property drawer.
-
-LIMIT bounds the search.
-
-Return a list whose CAR is `property-drawer' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:properties' and `:post-blank' keywords.
-
-Assume point is at the beginning of the property drawer."
- (save-excursion
- (let ((case-fold-search t)
- (begin (point))
- (prop-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
- (properties
- (let (val)
- (while (not (looking-at "^[ \t]*:END:[ \t]*$"))
- (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):")
- (push (cons (org-match-string-no-properties 1)
- (org-trim
- (buffer-substring-no-properties
- (match-end 0) (point-at-eol))))
- val))
- (forward-line))
- val))
- (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t)
- (point-at-bol)))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
- (list 'property-drawer
- (list :begin begin
- :end end
- :hiddenp hidden
- :properties properties
- :post-blank (count-lines pos-before-blank end))))))
-
-(defun org-element-property-drawer-interpreter (property-drawer contents)
- "Interpret PROPERTY-DRAWER element as Org syntax.
-CONTENTS is nil."
- (let ((props (org-element-property :properties property-drawer)))
- (concat
- ":PROPERTIES:\n"
- (mapconcat (lambda (p)
- (format org-property-format (format ":%s:" (car p)) (cdr p)))
- (nreverse props) "\n")
- "\n:END:")))
-
-
;;;; Quote Section
(defun org-element-quote-section-parser (limit)
;;;; Src Block
-(defun org-element-src-block-parser (limit)
+(defun org-element-src-block-parser (limit affiliated)
"Parse a src block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `src-block' and CDR is a plist
containing `:language', `:switches', `:parameters', `:begin',
`:end', `:hiddenp', `:number-lines', `:retain-labels',
-`:use-labels', `:label-fmt', `:preserve-indent', `:value' and
-`:post-blank' keywords.
+`:use-labels', `:label-fmt', `:preserve-indent', `:value',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
(if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$"
limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- ;; Get beginning position.
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
;; Get language as a string.
(language
(progn
;; Get parameters.
(parameters (org-match-string-no-properties 3))
;; Switches analysis
- (number-lines (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
- (preserve-indent (and switches (string-match "-i\\>" switches)))
- (label-fmt (and switches
- (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
+ (number-lines
+ (cond ((not switches) nil)
+ ((string-match "-n\\>" switches) 'new)
+ ((string-match "+n\\>" switches) 'continued)))
+ (preserve-indent (or org-src-preserve-indentation
+ (and switches
+ (string-match "-i\\>" switches))))
+ (label-fmt
+ (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches)))
;; Should labels be retained in (or stripped from)
;; src blocks?
(retain-labels
;; line-numbers?
(use-labels
(or (not switches)
- (and retain-labels (not (string-match "-k\\>" switches)))))
+ (and retain-labels
+ (not (string-match "-k\\>" switches)))))
+ ;; Indentation.
+ (block-ind (progn (skip-chars-forward " \t") (current-column)))
;; Get visibility status.
(hidden (progn (forward-line) (org-invisible-p2)))
;; Retrieve code.
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties (point) contents-end)))
+ (value (org-element--remove-indentation
+ (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ (point) contents-end))
+ (and preserve-indent block-ind)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
;; Get position after ending blank lines.
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'src-block
(nconc
(list :language language
:label-fmt label-fmt
:hiddenp hidden
:value value
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-src-block-interpreter (src-block contents)
"Interpret SRC-BLOCK element as Org syntax.
(params (org-element-property :parameters src-block))
(value (let ((val (org-element-property :value src-block)))
(cond
- (org-src-preserve-indentation val)
- ((zerop org-edit-src-content-indentation)
- (org-remove-indentation val))
+ ((org-element-property :preserve-indent src-block) val)
+ ((zerop org-edit-src-content-indentation) val)
(t
(let ((ind (make-string
org-edit-src-content-indentation 32)))
(replace-regexp-in-string
- "\\(^\\)[ \t]*\\S-" ind
- (org-remove-indentation val) nil nil 1)))))))
+ "\\(^\\)[ \t]*\\S-" ind val nil nil 1)))))))
(concat (format "#+BEGIN_SRC%s\n"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
;;;; Table
-(defun org-element-table-parser (limit)
+(defun org-element-table-parser (limit affiliated)
"Parse a table at point.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `table' and CDR is a plist containing
`:begin', `:end', `:tblfm', `:type', `:contents-begin',
-`:contents-end', `:value' and `:post-blank' keywords.
+`:contents-end', `:value', `:post-blank' and `:post-affiliated'
+keywords.
Assume point is at the beginning of the table."
(save-excursion
(let* ((case-fold-search t)
(table-begin (point))
(type (if (org-at-table.el-p) 'table.el 'org))
- (keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (begin (car affiliated))
(table-end
(if (re-search-forward org-table-any-border-regexp limit 'm)
(goto-char (match-beginning 0))
acc))
(pos-before-blank (point))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'table
(nconc
(list :begin begin
:value (and (eq type 'table.el)
(buffer-substring-no-properties
table-begin table-end))
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated table-begin)
+ (cdr affiliated))))))
(defun org-element-table-interpreter (table contents)
"Interpret TABLE element as Org syntax.
-CONTENTS is nil."
+CONTENTS is a string, if table's type is `org', or nil."
(if (eq (org-element-property :type table) 'table.el)
(org-remove-indentation (org-element-property :value table))
(concat (with-temp-buffer (insert contents)
;;;; Verse Block
-(defun org-element-verse-block-parser (limit)
+(defun org-element-verse-block-parser (limit affiliated)
"Parse a verse block.
-LIMIT bounds the search.
+LIMIT bounds the search. AFFILIATED is a list of which CAR is
+the buffer position at the beginning of the first affiliated
+keyword and CDR is a plist of affiliated keywords along with
+their value.
Return a list whose CAR is `verse-block' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:hiddenp' and `:post-blank' keywords.
+`:hiddenp', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of the block."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
- (org-element-paragraph-parser limit)
+ (org-element-paragraph-parser limit affiliated)
(let ((contents-end (match-beginning 0)))
(save-excursion
- (let* ((keywords (org-element--collect-affiliated-keywords))
- (begin (car keywords))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
(hidden (progn (forward-line) (org-invisible-p2)))
(contents-begin (point))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position)))))
+ (if (eobp) (point) (line-beginning-position)))))
(list 'verse-block
(nconc
(list :begin begin
:contents-begin contents-begin
:contents-end contents-end
:hiddenp hidden
- :post-blank (count-lines pos-before-blank end))
- (cadr keywords)))))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated post-affiliated)
+ (cdr affiliated)))))))))
(defun org-element-verse-block-interpreter (verse-block contents)
"Interpret VERSE-BLOCK element as Org syntax.
;;
;; Unlike to elements, interstices can be found between objects.
;; That's why, along with the parser, successor functions are provided
-;; for each object. Some objects share the same successor (i.e. `code'
-;; and `verbatim' objects).
+;; for each object. Some objects share the same successor (e.g.,
+;; `code' and `verbatim' objects).
;;
;; A successor must accept a single argument bounding the search. It
;; will return either a cons cell whose CAR is the object's type, as
;; org-element-NAME-successor, where NAME is the name of the
;; successor, as defined in `org-element-all-successors'.
;;
-;; Some object types (i.e. `italic') are recursive. Restrictions on
+;; Some object types (e.g., `italic') are recursive. Restrictions on
;; object types they can contain will be specified in
;; `org-element-object-restrictions'.
;;
CONTENTS is the contents of the object."
(format "*%s*" contents))
-(defun org-element-text-markup-successor (limit)
+(defun org-element-text-markup-successor ()
"Search for the next text-markup object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is a symbol among `bold',
`italic', `underline', `strike-through', `code' and `verbatim'
and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-emph-re limit t)
+ (when (re-search-forward org-emph-re nil t)
(let ((marker (match-string 3)))
(cons (cond
((equal marker "*") 'bold)
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
-(defun org-element-latex-or-entity-successor (limit)
+(defun org-element-latex-or-entity-successor ()
"Search for the next latex-fragment or entity object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `entity' or
`latex-fragment' and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (let ((matchers
- (remove "begin" (plist-get org-format-latex-options :matchers)))
+ (let ((matchers (cdr org-latex-regexps))
;; ENTITY-RE matches both LaTeX commands and Org entities.
(entity-re
"\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
(when (re-search-forward
- (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
- matchers "\\|")
- "\\|" entity-re)
- limit t)
+ (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t)
(goto-char (match-beginning 0))
(if (looking-at entity-re)
;; Determine if it's a real entity or a LaTeX command.
;; Determine its type to get the correct beginning position.
(cons 'latex-fragment
(catch 'return
- (mapc (lambda (e)
- (when (looking-at (nth 1 (assoc e org-latex-regexps)))
- (throw 'return
- (match-beginning
- (nth 2 (assoc e org-latex-regexps))))))
- matchers)
+ (dolist (e matchers)
+ (when (looking-at (nth 1 e))
+ (throw 'return (match-beginning (nth 2 e)))))
(point))))))))
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
-(defun org-element-export-snippet-successor (limit)
+(defun org-element-export-snippet-successor ()
"Search for the next export-snippet object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `export-snippet' and CDR
its beginning position."
(save-excursion
(let (beg)
- (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
+ (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t)
(setq beg (match-beginning 0))
- (search-forward "@@" limit t))
+ (search-forward "@@" nil t))
(cons 'export-snippet beg)))))
(concat ":" (org-element-interpret-data inline-def))))))
(format "[%s]" (concat label def))))
-(defun org-element-footnote-reference-successor (limit)
+(defun org-element-footnote-reference-successor ()
"Search for the next footnote-reference object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `footnote-reference' and
CDR is beginning position."
(save-excursion
(catch 'exit
- (while (re-search-forward org-footnote-re limit t)
+ (while (re-search-forward org-footnote-re nil t)
(save-excursion
(let ((beg (match-beginning 0))
(count 1))
(backward-char)
- (while (re-search-forward "[][]" limit t)
+ (while (re-search-forward "[][]" nil t)
(if (equal (match-string 0) "[") (incf count) (decf count))
(when (zerop count)
(throw 'exit (cons 'footnote-reference beg))))))))))
main-source)
(and post-options (format "[%s]" post-options)))))
-(defun org-element-inline-babel-call-successor (limit)
+(defun org-element-inline-babel-call-successor ()
"Search for the next inline-babel-call object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
- ;; Use a simplified version of
- ;; `org-babel-inline-lob-one-liner-regexp'.
- (when (re-search-forward
- "call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?"
- limit t)
- (cons 'inline-babel-call (match-beginning 0)))))
+ (when (re-search-forward org-babel-inline-lob-one-liner-regexp nil t)
+ (cons 'inline-babel-call (match-end 1)))))
;;;; Inline Src Block
(defun org-element-inline-src-block-parser ()
"Parse inline source block at point.
-LIMIT bounds the search.
-
Return a list whose CAR is `inline-src-block' and CDR a plist
with `:begin', `:end', `:language', `:value', `:parameters' and
`:post-blank' as keywords.
(if arguments (format "[%s]" arguments) "")
body)))
-(defun org-element-inline-src-block-successor (limit)
+(defun org-element-inline-src-block-successor ()
"Search for the next inline-babel-call element.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-babel-inline-src-block-regexp limit t)
+ (when (re-search-forward org-babel-inline-src-block-regexp nil t)
(cons 'inline-src-block (match-beginning 1)))))
;;;; Italic
;;;; Latex Fragment
(defun org-element-latex-fragment-parser ()
- "Parse latex fragment at point.
+ "Parse LaTeX fragment at point.
Return a list whose CAR is `latex-fragment' and CDR a plist with
`:value', `:begin', `:end', and `:post-blank' as keywords.
-Assume point is at the beginning of the latex fragment."
+Assume point is at the beginning of the LaTeX fragment."
(save-excursion
(let* ((begin (point))
(substring-match
(catch 'exit
- (mapc (lambda (e)
- (let ((latex-regexp (nth 1 (assoc e org-latex-regexps))))
- (when (or (looking-at latex-regexp)
- (and (not (bobp))
- (save-excursion
- (backward-char)
- (looking-at latex-regexp))))
- (throw 'exit (nth 2 (assoc e org-latex-regexps))))))
- (plist-get org-format-latex-options :matchers))
+ (dolist (e (cdr org-latex-regexps))
+ (let ((latex-regexp (nth 1 e)))
+ (when (or (looking-at latex-regexp)
+ (and (not (bobp))
+ (save-excursion
+ (backward-char)
+ (looking-at latex-regexp))))
+ (throw 'exit (nth 2 e)))))
;; None found: it's a macro.
(looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
0))
- (value (match-string-no-properties substring-match))
+ (value (org-match-string-no-properties substring-match))
(post-blank (progn (goto-char (match-end substring-match))
(skip-chars-forward " \t")))
(end (point)))
`:begin', `:end' and `:post-blank' keywords.
Assume point is at the beginning of the line break."
- (list 'line-break (list :begin (point) :end (point-at-eol) :post-blank 0)))
+ (list 'line-break
+ (list :begin (point)
+ :end (progn (forward-line) (point))
+ :post-blank 0)))
(defun org-element-line-break-interpreter (line-break contents)
"Interpret LINE-BREAK object as Org syntax.
CONTENTS is nil."
- "\\\\")
+ "\\\\\n")
-(defun org-element-line-break-successor (limit)
+(defun org-element-line-break-successor ()
"Search for the next line-break object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `line-break' and CDR is
beginning position."
(save-excursion
- (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
+ (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t)
(goto-char (match-beginning 1)))))
;; A line break can only happen on a non-empty line.
(when (and beg (re-search-backward "\\S-" (point-at-bol) t))
"Parse link at point.
Return a list whose CAR is `link' and CDR a plist with `:type',
-`:path', `:raw-link', `:begin', `:end', `:contents-begin',
-`:contents-end' and `:post-blank' as keywords.
+`:path', `:raw-link', `:application', `:search-option', `:begin',
+`:end', `:contents-begin', `:contents-end' and `:post-blank' as
+keywords.
Assume point is at the beginning of the link."
(save-excursion
(let ((begin (point))
end contents-begin contents-end link-end post-blank path type
- raw-link link)
+ raw-link link search-option application)
(cond
;; Type 1: Text targeted from a radio target.
((and org-target-link-regexp (looking-at org-target-link-regexp))
(setq type "radio"
link-end (match-end 0)
- path (org-match-string-no-properties 0)))
+ path (org-match-string-no-properties 0)
+ contents-begin (match-beginning 0)
+ contents-end (match-end 0)))
;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
((looking-at org-bracket-link-regexp)
(setq contents-begin (match-beginning 3)
contents-end (match-end 3)
link-end (match-end 0)
- ;; RAW-LINK is the original link.
- raw-link (org-match-string-no-properties 1)
- link (org-translate-link
- (org-link-expand-abbrev
- (org-link-unescape raw-link))))
+ ;; RAW-LINK is the original link. Expand any
+ ;; abbreviation in it.
+ raw-link (org-translate-link
+ (org-link-expand-abbrev
+ (org-match-string-no-properties 1))))
;; Determine TYPE of link and set PATH accordingly.
(cond
;; File type.
- ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link))
- (setq type "file" path link))
+ ((or (file-name-absolute-p raw-link)
+ (string-match "\\`\\.\\.?/" raw-link))
+ (setq type "file" path raw-link))
;; Explicit type (http, irc, bbdb...). See `org-link-types'.
- ((string-match org-link-re-with-space3 link)
- (setq type (match-string 1 link) path (match-string 2 link)))
+ ((string-match org-link-types-re raw-link)
+ (setq type (match-string 1 raw-link)
+ ;; According to RFC 3986, extra whitespace should be
+ ;; ignored when a URI is extracted.
+ path (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" "" (substring raw-link (match-end 0)))))
;; Id type: PATH is the id.
- ((string-match "^id:\\([-a-f0-9]+\\)" link)
- (setq type "id" path (match-string 1 link)))
+ ((string-match "\\`id:\\([-a-f0-9]+\\)" raw-link)
+ (setq type "id" path (match-string 1 raw-link)))
;; Code-ref type: PATH is the name of the reference.
- ((string-match "^(\\(.*\\))$" link)
- (setq type "coderef" path (match-string 1 link)))
+ ((string-match "\\`(\\(.*\\))\\'" raw-link)
+ (setq type "coderef" path (match-string 1 raw-link)))
;; Custom-id type: PATH is the name of the custom id.
- ((= (aref link 0) ?#)
- (setq type "custom-id" path (substring link 1)))
+ ((= (aref raw-link 0) ?#)
+ (setq type "custom-id" path (substring raw-link 1)))
;; Fuzzy type: Internal link either matches a target, an
;; headline name or nothing. PATH is the target or
;; headline's name.
- (t (setq type "fuzzy" path link))))
- ;; Type 3: Plain link, i.e. http://orgmode.org
+ (t (setq type "fuzzy" path raw-link))))
+ ;; Type 3: Plain link, e.g., http://orgmode.org
((looking-at org-plain-link-re)
(setq raw-link (org-match-string-no-properties 0)
type (org-match-string-no-properties 1)
- path (org-match-string-no-properties 2)
- link-end (match-end 0)))
- ;; Type 4: Angular link, i.e. <http://orgmode.org>
+ link-end (match-end 0)
+ path (org-match-string-no-properties 2)))
+ ;; Type 4: Angular link, e.g., <http://orgmode.org>
((looking-at org-angle-link-re)
(setq raw-link (buffer-substring-no-properties
(match-beginning 1) (match-end 2))
type (org-match-string-no-properties 1)
- path (org-match-string-no-properties 2)
- link-end (match-end 0))))
+ link-end (match-end 0)
+ path (org-match-string-no-properties 2))))
;; In any case, deduce end point after trailing white space from
;; LINK-END variable.
(setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
end (point))
+ ;; Special "file" type link processing.
+ (when (member type org-element-link-type-is-file)
+ ;; Extract opening application and search option.
+ (cond ((string-match "^file\\+\\(.*\\)$" type)
+ (setq application (match-string 1 type)))
+ ((not (string-match "^file" type))
+ (setq application type)))
+ (when (string-match "::\\(.*\\)\\'" path)
+ (setq search-option (match-string 1 path)
+ path (replace-match "" nil nil path)))
+ ;; Normalize URI.
+ (when (and (not (org-string-match-p "\\`//" path))
+ (file-name-absolute-p path))
+ (setq path (concat "//" (expand-file-name path))))
+ ;; Make sure TYPE always reports "file".
+ (setq type "file"))
(list 'link
(list :type type
:path path
:raw-link (or raw-link path)
+ :application application
+ :search-option search-option
:begin begin
:end end
:contents-begin contents-begin
raw-link
(if contents (format "[%s]" contents) "")))))
-(defun org-element-link-successor (limit)
+(defun org-element-link-successor ()
"Search for the next link object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `link' and CDR is
beginning position."
(save-excursion
(let ((link-regexp
(if (not org-target-link-regexp) org-any-link-re
(concat org-any-link-re "\\|" org-target-link-regexp))))
- (when (re-search-forward link-regexp limit t)
+ (when (re-search-forward link-regexp nil t)
(cons 'link (match-beginning 0))))))
+(defun org-element-plain-link-successor ()
+ "Search for the next plain link object.
+
+Return value is a cons cell whose CAR is `link' and CDR is
+beginning position."
+ (and (save-excursion (re-search-forward org-plain-link-re nil t))
+ (cons 'link (match-beginning 0))))
+
;;;; Macro
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point))
- (args (let ((args (org-match-string-no-properties 3)) args2)
+ (args (let ((args (org-match-string-no-properties 3)))
(when args
;; Do not use `org-split-string' since empty
;; strings are meaningful here.
- (setq args (split-string args ","))
- (while args
- (while (string-match "\\\\\\'" (car args))
- ;; Repair bad splits, when comma is protected,
- ;; and thus not a real separator.
- (setcar (cdr args) (concat (substring (car args) 0 -1)
- "," (nth 1 args)))
- (pop args))
- (push (pop args) args2))
- (mapcar 'org-trim (nreverse args2))))))
+ (split-string
+ (replace-regexp-in-string
+ "\\(\\\\*\\)\\(,\\)"
+ (lambda (str)
+ (let ((len (length (match-string 1 str))))
+ (concat (make-string (/ len 2) ?\\)
+ (if (zerop (mod len 2)) "\000" ","))))
+ args nil t)
+ "\000")))))
(list 'macro
(list :key key
:value value
CONTENTS is nil."
(org-element-property :value macro))
-(defun org-element-macro-successor (limit)
+(defun org-element-macro-successor ()
"Search for the next macro object.
-LIMIT bounds the search.
-
Return value is cons cell whose CAR is `macro' and CDR is
beginning position."
(save-excursion
(when (re-search-forward
"{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
- limit t)
+ nil t)
(cons 'macro (match-beginning 0)))))
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
-(defun org-element-radio-target-successor (limit)
+(defun org-element-radio-target-successor ()
"Search for the next radio-target object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `radio-target' and CDR
is beginning position."
(save-excursion
- (when (re-search-forward org-radio-target-regexp limit t)
+ (when (re-search-forward org-radio-target-regexp nil t)
(cons 'radio-target (match-beginning 0)))))
CONTENTS is nil."
(org-element-property :value statistics-cookie))
-(defun org-element-statistics-cookie-successor (limit)
+(defun org-element-statistics-cookie-successor ()
"Search for the next statistics cookie object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `statistics-cookie' and
CDR is beginning position."
(save-excursion
- (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
+ (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t)
(cons 'statistics-cookie (match-beginning 0)))))
(if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
contents))
-(defun org-element-sub/superscript-successor (limit)
+(defun org-element-sub/superscript-successor ()
"Search for the next sub/superscript object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is either `subscript' or
`superscript' and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-match-substring-regexp limit t)
+ (when (re-search-forward org-match-substring-regexp nil t)
(cons (if (string= (match-string 2) "_") 'subscript 'superscript)
(match-beginning 2)))))
Return a list whose CAR is `table-cell' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end'
and `:post-blank' keywords."
- (looking-at "[ \t]*\\(.*?\\)[ \t]*|")
+ (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)")
(let* ((begin (match-beginning 0))
(end (match-end 0))
(contents-begin (match-beginning 1))
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
-(defun org-element-table-cell-successor (limit)
+(defun org-element-table-cell-successor ()
"Search for the next table-cell object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `table-cell' and CDR is
beginning position."
- (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point))))
+ (when (looking-at "[ \t]*.*?[ \t]*\\(|\\|$\\)") (cons 'table-cell (point))))
;;;; Target
CONTENTS is nil."
(format "<<%s>>" (org-element-property :value target)))
-(defun org-element-target-successor (limit)
+(defun org-element-target-successor ()
"Search for the next target object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `target' and CDR is
beginning position."
(save-excursion
- (when (re-search-forward org-target-regexp limit t)
+ (when (re-search-forward org-target-regexp nil t)
(cons 'target (match-beginning 0)))))
"Parse time stamp at point.
Return a list whose CAR is `timestamp', and CDR a plist with
-`:type', `:begin', `:end', `:value' and `:post-blank' keywords.
+`:type', `:raw-value', `:year-start', `:month-start',
+`:day-start', `:hour-start', `:minute-start', `:year-end',
+`:month-end', `:day-end', `:hour-end', `:minute-end',
+`:repeater-type', `:repeater-value', `:repeater-unit',
+`:warning-type', `:warning-value', `:warning-unit', `:begin',
+`:end' and `:post-blank' keywords.
Assume point is at the beginning of the timestamp."
(save-excursion
(let* ((begin (point))
(activep (eq (char-after) ?<))
- (main-value
+ (raw-value
(progn
- (looking-at "[<[]\\(\\(%%\\)?.*?\\)[]>]\\(?:--[<[]\\(.*?\\)[]>]\\)?")
- (match-string-no-properties 1)))
- (range-end (match-string-no-properties 3))
- (type (cond ((match-string 2) 'diary)
- ((and activep range-end) 'active-range)
- (activep 'active)
- (range-end 'inactive-range)
- (t 'inactive)))
+ (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
+ (match-string-no-properties 0)))
+ (date-start (match-string-no-properties 1))
+ (date-end (match-string 3))
+ (diaryp (match-beginning 2))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
- (end (point)))
+ (end (point))
+ (time-range
+ (and (not diaryp)
+ (string-match
+ "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
+ date-start)
+ (cons (string-to-number (match-string 2 date-start))
+ (string-to-number (match-string 3 date-start)))))
+ (type (cond (diaryp 'diary)
+ ((and activep (or date-end time-range)) 'active-range)
+ (activep 'active)
+ ((or date-end time-range) 'inactive-range)
+ (t 'inactive)))
+ (repeater-props
+ (and (not diaryp)
+ (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
+ raw-value)
+ (list
+ :repeater-type
+ (let ((type (match-string 1 raw-value)))
+ (cond ((equal "++" type) 'catch-up)
+ ((equal ".+" type) 'restart)
+ (t 'cumulate)))
+ :repeater-value (string-to-number (match-string 2 raw-value))
+ :repeater-unit
+ (case (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ (warning-props
+ (and (not diaryp)
+ (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
+ (list
+ :warning-type (if (match-string 1 raw-value) 'first 'all)
+ :warning-value (string-to-number (match-string 2 raw-value))
+ :warning-unit
+ (case (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ year-start month-start day-start hour-start minute-start year-end
+ month-end day-end hour-end minute-end)
+ ;; Parse date-start.
+ (unless diaryp
+ (let ((date (org-parse-time-string date-start t)))
+ (setq year-start (nth 5 date)
+ month-start (nth 4 date)
+ day-start (nth 3 date)
+ hour-start (nth 2 date)
+ minute-start (nth 1 date))))
+ ;; Compute date-end. It can be provided directly in time-stamp,
+ ;; or extracted from time range. Otherwise, it defaults to the
+ ;; same values as date-start.
+ (unless diaryp
+ (let ((date (and date-end (org-parse-time-string date-end t))))
+ (setq year-end (or (nth 5 date) year-start)
+ month-end (or (nth 4 date) month-start)
+ day-end (or (nth 3 date) day-start)
+ hour-end (or (nth 2 date) (car time-range) hour-start)
+ minute-end (or (nth 1 date) (cdr time-range) minute-start))))
(list 'timestamp
- (list :type type
- :value main-value
- :range-end range-end
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (nconc (list :type type
+ :raw-value raw-value
+ :year-start year-start
+ :month-start month-start
+ :day-start day-start
+ :hour-start hour-start
+ :minute-start minute-start
+ :year-end year-end
+ :month-end month-end
+ :day-end day-end
+ :hour-end hour-end
+ :minute-end minute-end
+ :begin begin
+ :end end
+ :post-blank post-blank)
+ repeater-props
+ warning-props)))))
(defun org-element-timestamp-interpreter (timestamp contents)
"Interpret TIMESTAMP object as Org syntax.
CONTENTS is nil."
- (let ((type (org-element-property :type timestamp) ))
- (concat
- (format (if (memq type '(inactive inactive-range)) "[%s]" "<%s>")
- (org-element-property :value timestamp))
- (let ((range-end (org-element-property :range-end timestamp)))
- (when range-end
- (concat "--"
- (format (if (eq type 'inactive-range) "[%s]" "<%s>")
- range-end)))))))
-
-(defun org-element-timestamp-successor (limit)
+ ;; Use `:raw-value' if specified.
+ (or (org-element-property :raw-value timestamp)
+ ;; Otherwise, build timestamp string.
+ (let* ((repeat-string
+ (concat
+ (case (org-element-property :repeater-type timestamp)
+ (cumulate "+") (catch-up "++") (restart ".+"))
+ (let ((val (org-element-property :repeater-value timestamp)))
+ (and val (number-to-string val)))
+ (case (org-element-property :repeater-unit timestamp)
+ (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (warning-string
+ (concat
+ (case (org-element-property :warning-type timestamp)
+ (first "--")
+ (all "-"))
+ (let ((val (org-element-property :warning-value timestamp)))
+ (and val (number-to-string val)))
+ (case (org-element-property :warning-unit timestamp)
+ (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (build-ts-string
+ ;; Build an Org timestamp string from TIME. ACTIVEP is
+ ;; non-nil when time stamp is active. If WITH-TIME-P is
+ ;; non-nil, add a time part. HOUR-END and MINUTE-END
+ ;; specify a time range in the timestamp. REPEAT-STRING
+ ;; is the repeater string, if any.
+ (lambda (time activep &optional with-time-p hour-end minute-end)
+ (let ((ts (format-time-string
+ (funcall (if with-time-p 'cdr 'car)
+ org-time-stamp-formats)
+ time)))
+ (when (and hour-end minute-end)
+ (string-match "[012]?[0-9]:[0-5][0-9]" ts)
+ (setq ts
+ (replace-match
+ (format "\\&-%02d:%02d" hour-end minute-end)
+ nil nil ts)))
+ (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
+ (dolist (s (list repeat-string warning-string))
+ (when (org-string-nw-p s)
+ (setq ts (concat (substring ts 0 -1)
+ " "
+ s
+ (substring ts -1)))))
+ ;; Return value.
+ ts)))
+ (type (org-element-property :type timestamp)))
+ (case type
+ ((active inactive)
+ (let* ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp))
+ (time-range-p (and hour-start hour-end minute-start minute-end
+ (or (/= hour-start hour-end)
+ (/= minute-start minute-end)))))
+ (funcall
+ build-ts-string
+ (encode-time 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active)
+ (and hour-start minute-start)
+ (and time-range-p hour-end)
+ (and time-range-p minute-end))))
+ ((active-range inactive-range)
+ (let ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp)))
+ (concat
+ (funcall
+ build-ts-string (encode-time
+ 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active-range)
+ (and hour-start minute-start))
+ "--"
+ (funcall build-ts-string
+ (encode-time 0
+ (or minute-end 0)
+ (or hour-end 0)
+ (org-element-property :day-end timestamp)
+ (org-element-property :month-end timestamp)
+ (org-element-property :year-end timestamp))
+ (eq type 'active-range)
+ (and hour-end minute-end)))))))))
+
+(defun org-element-timestamp-successor ()
"Search for the next timestamp object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `timestamp' and CDR is
beginning position."
(save-excursion
"\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|"
"\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
- limit t)
+ nil t)
(cons 'timestamp (match-beginning 0)))))
;; point.
;;
;; `org-element--current-element' makes use of special modes. They
-;; are activated for fixed element chaining (i.e. `plain-list' >
-;; `item') or fixed conditional element chaining (i.e. `headline' >
-;; `section'). Special modes are: `first-section', `section',
-;; `quote-section', `item' and `table-row'.
+;; are activated for fixed element chaining (e.g., `plain-list' >
+;; `item') or fixed conditional element chaining (e.g., `headline' >
+;; `section'). Special modes are: `first-section', `item',
+;; `node-property', `quote-section', `section' and `table-row'.
(defun org-element--current-element
(limit &optional granularity special structure)
"Parse the element starting at point.
-LIMIT bounds the search.
-
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element and PROPS a plist of properties associated to the
element.
Possible types are defined in `org-element-all-elements'.
+LIMIT bounds the search.
+
Optional argument GRANULARITY determines the depth of the
recursion. Allowed values are `headline', `greater-element',
`element', `object' or nil. When it is broader than `object' (or
contain objects.
Optional argument SPECIAL, when non-nil, can be either
-`first-section', `section', `quote-section', `table-row' and
-`item'.
+`first-section', `item', `node-property', `quote-section',
+`section', and `table-row'.
If STRUCTURE isn't provided but SPECIAL is set to `item', it will
be computed.
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
- ;; keyword is orphaned and will be treated as plain text.
- (when (looking-at org-element--affiliated-re)
- (let ((opoint (point)))
- (while (looking-at org-element--affiliated-re) (forward-line))
- (when (looking-at "[ \t]*$") (goto-char opoint))))
(let ((case-fold-search t)
;; Determine if parsing depth allows for secondary strings
;; parsing. It only applies to elements referenced in
(org-element-item-parser limit structure raw-secondary-p))
;; Table Row.
((eq special 'table-row) (org-element-table-row-parser limit))
+ ;; Node Property.
+ ((eq special 'node-property) (org-element-node-property-parser limit))
;; Headline.
((org-with-limited-levels (org-at-heading-p))
(org-element-headline-parser limit raw-secondary-p))
limit)))
;; When not at bol, point is at the beginning of an item or
;; a footnote definition: next item is always a paragraph.
- ((not (bolp)) (org-element-paragraph-parser limit))
+ ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
;; Planning and Clock.
- ((and (looking-at org-planning-or-clock-line-re))
+ ((looking-at org-planning-or-clock-line-re)
(if (equal (match-string 1) org-clock-string)
(org-element-clock-parser limit)
(org-element-planning-parser limit)))
;; Inlinetask.
((org-at-heading-p)
(org-element-inlinetask-parser limit raw-secondary-p))
- ;; LaTeX Environment.
- ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}")
- (if (save-excursion
- (re-search-forward
- (format "[ \t]*\\\\end{%s}[ \t]*"
- (regexp-quote (match-string 1)))
- nil t))
- (org-element-latex-environment-parser limit)
- (org-element-paragraph-parser limit)))
- ;; Drawer and Property Drawer.
- ((looking-at org-drawer-regexp)
- (let ((name (match-string 1)))
- (cond
- ((not (save-excursion
- (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)))
- (org-element-paragraph-parser limit))
- ((equal "PROPERTIES" name)
- (org-element-property-drawer-parser limit))
- (t (org-element-drawer-parser limit)))))
- ;; Fixed Width
- ((looking-at "[ \t]*:\\( \\|$\\)")
- (org-element-fixed-width-parser limit))
- ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
- ;; Keywords.
- ((looking-at "[ \t]*#")
- (goto-char (match-end 0))
- (cond ((looking-at "\\(?: \\|$\\)")
- (beginning-of-line)
- (org-element-comment-parser limit))
- ((looking-at "\\+BEGIN_\\(\\S-+\\)")
- (beginning-of-line)
- (let ((parser (assoc (upcase (match-string 1))
- org-element-block-name-alist)))
- (if parser (funcall (cdr parser) limit)
- (org-element-special-block-parser limit))))
- ((looking-at "\\+CALL:")
- (beginning-of-line)
- (org-element-babel-call-parser limit))
- ((looking-at "\\+BEGIN:? ")
- (beginning-of-line)
- (org-element-dynamic-block-parser limit))
- ((looking-at "\\+\\S-+:")
- (beginning-of-line)
- (org-element-keyword-parser limit))
- (t
- (beginning-of-line)
- (org-element-paragraph-parser limit))))
- ;; Footnote Definition.
- ((looking-at org-footnote-definition-re)
- (org-element-footnote-definition-parser limit))
- ;; Horizontal Rule.
- ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
- (org-element-horizontal-rule-parser limit))
- ;; Table.
- ((org-at-table-p t) (org-element-table-parser limit))
- ;; List.
- ((looking-at (org-item-re))
- (org-element-plain-list-parser limit (or structure (org-list-struct))))
- ;; Default element: Paragraph.
- (t (org-element-paragraph-parser limit))))))
+ ;; From there, elements can have affiliated keywords.
+ (t (let ((affiliated (org-element--collect-affiliated-keywords limit)))
+ (cond
+ ;; Jumping over affiliated keywords put point off-limits.
+ ;; Parse them as regular keywords.
+ ((and (cdr affiliated) (>= (point) limit))
+ (goto-char (car affiliated))
+ (org-element-keyword-parser limit nil))
+ ;; LaTeX Environment.
+ ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$")
+ (org-element-latex-environment-parser limit affiliated))
+ ;; Drawer and Property Drawer.
+ ((looking-at org-drawer-regexp)
+ (if (equal (match-string 1) "PROPERTIES")
+ (org-element-property-drawer-parser limit affiliated)
+ (org-element-drawer-parser limit affiliated)))
+ ;; Fixed Width
+ ((looking-at "[ \t]*:\\( \\|$\\)")
+ (org-element-fixed-width-parser limit affiliated))
+ ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
+ ;; Keywords.
+ ((looking-at "[ \t]*#")
+ (goto-char (match-end 0))
+ (cond ((looking-at "\\(?: \\|$\\)")
+ (beginning-of-line)
+ (org-element-comment-parser limit affiliated))
+ ((looking-at "\\+BEGIN_\\(\\S-+\\)")
+ (beginning-of-line)
+ (let ((parser (assoc (upcase (match-string 1))
+ org-element-block-name-alist)))
+ (if parser (funcall (cdr parser) limit affiliated)
+ (org-element-special-block-parser limit affiliated))))
+ ((looking-at "\\+CALL:")
+ (beginning-of-line)
+ (org-element-babel-call-parser limit affiliated))
+ ((looking-at "\\+BEGIN:? ")
+ (beginning-of-line)
+ (org-element-dynamic-block-parser limit affiliated))
+ ((looking-at "\\+\\S-+:")
+ (beginning-of-line)
+ (org-element-keyword-parser limit affiliated))
+ (t
+ (beginning-of-line)
+ (org-element-paragraph-parser limit affiliated))))
+ ;; Footnote Definition.
+ ((looking-at org-footnote-definition-re)
+ (org-element-footnote-definition-parser limit affiliated))
+ ;; Horizontal Rule.
+ ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
+ (org-element-horizontal-rule-parser limit affiliated))
+ ;; Diary Sexp.
+ ((looking-at "%%(")
+ (org-element-diary-sexp-parser limit affiliated))
+ ;; Table.
+ ((org-at-table-p t) (org-element-table-parser limit affiliated))
+ ;; List.
+ ((looking-at (org-item-re))
+ (org-element-plain-list-parser
+ limit affiliated
+ (or structure (org-element--list-struct limit))))
+ ;; Default element: Paragraph.
+ (t (org-element-paragraph-parser limit affiliated)))))))))
;; Most elements can have affiliated keywords. When looking for an
;; element beginning, we want to move before them, as they belong to
;; that element, and, in the meantime, collect information they give
;; into appropriate properties. Hence the following function.
-;;
-;; Usage of optional arguments may not be obvious at first glance:
-;;
-;; - TRANS-LIST is used to polish keywords names that have evolved
-;; during Org history. In example, even though =result= and
-;; =results= coexist, we want to have them under the same =result=
-;; property. It's also true for "srcname" and "name", where the
-;; latter seems to be preferred nowadays (thus the "name" property).
-;;
-;; - CONSED allows to regroup multi-lines keywords under the same
-;; property, while preserving their own identity. This is mostly
-;; used for "attr_latex" and al.
-;;
-;; - PARSED prepares a keyword value for export. This is useful for
-;; "caption". Objects restrictions for such keywords are defined in
-;; `org-element-object-restrictions'.
-;;
-;; - DUALS is used to take care of keywords accepting a main and an
-;; optional secondary values. For example "results" has its
-;; source's name as the main value, and may have an hash string in
-;; optional square brackets as the secondary one.
-;;
-;; A keyword may belong to more than one category.
-
-(defun org-element--collect-affiliated-keywords
- (&optional key-re trans-list consed parsed duals)
- "Collect affiliated keywords before point.
-Optional argument KEY-RE is a regexp matching keywords, which
-puts matched keyword in group 1. It defaults to
-`org-element--affiliated-re'.
-
-TRANS-LIST is an alist where key is the keyword and value the
-property name it should be translated to, without the colons. It
-defaults to `org-element-keyword-translation-alist'.
-
-CONSED is a list of strings. Any keyword belonging to that list
-will have its value consed. The check is done after keyword
-translation. It defaults to `org-element-multiple-keywords'.
-
-PARSED is a list of strings. Any keyword member of this list
-will have its value parsed. The check is done after keyword
-translation. If a keyword is a member of both CONSED and PARSED,
-it's value will be a list of parsed strings. It defaults to
-`org-element-parsed-keywords'.
-
-DUALS is a list of strings. Any keyword member of this list can
-have two parts: one mandatory and one optional. Its value is
-a cons cell whose CAR is the former, and the CDR the latter. If
-a keyword is a member of both PARSED and DUALS, both values will
-be parsed. It defaults to `org-element-dual-keywords'.
+(defun org-element--collect-affiliated-keywords (limit)
+ "Collect affiliated keywords from point down to LIMIT.
Return a list whose CAR is the position at the first of them and
-CDR a plist of keywords and values."
- (save-excursion
+CDR a plist of keywords and values and move point to the
+beginning of the first line after them.
+
+As a special case, if element doesn't start at the beginning of
+the line (e.g., a paragraph starting an item), CAR is current
+position of point and CDR is nil."
+ (if (not (bolp)) (list (point))
(let ((case-fold-search t)
- (key-re (or key-re org-element--affiliated-re))
- (trans-list (or trans-list org-element-keyword-translation-alist))
- (consed (or consed org-element-multiple-keywords))
- (parsed (or parsed org-element-parsed-keywords))
- (duals (or duals org-element-dual-keywords))
+ (origin (point))
;; RESTRICT is the list of objects allowed in parsed
;; keywords value.
(restrict (org-element-restriction 'keyword))
output)
- (unless (bobp)
- (while (and (not (bobp)) (progn (forward-line -1) (looking-at key-re)))
- (let* ((raw-kwd (upcase (match-string 1)))
- ;; Apply translation to RAW-KWD. From there, KWD is
- ;; the official keyword.
- (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd))
- ;; Find main value for any keyword.
- (value
- (save-match-data
- (org-trim
- (buffer-substring-no-properties
- (match-end 0) (point-at-eol)))))
- ;; If KWD is a dual keyword, find its secondary
- ;; value. Maybe parse it.
- (dual-value
- (and (member kwd duals)
- (let ((sec (org-match-string-no-properties 2)))
- (if (or (not sec) (not (member kwd parsed))) sec
- (org-element-parse-secondary-string sec restrict)))))
- ;; Attribute a property name to KWD.
- (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
- ;; Now set final shape for VALUE.
- (when (member kwd parsed)
- (setq value (org-element-parse-secondary-string value restrict)))
- (when (member kwd duals)
- ;; VALUE is mandatory. Set it to nil if there is none.
- (setq value (and value (cons value dual-value))))
- ;; Attributes are always consed.
- (when (or (member kwd consed) (string-match "^ATTR_" kwd))
- (setq value (cons value (plist-get output kwd-sym))))
- ;; Eventually store the new value in OUTPUT.
- (setq output (plist-put output kwd-sym value))))
- (unless (looking-at key-re) (forward-line 1)))
- (list (point) output))))
+ (while (and (< (point) limit) (looking-at org-element--affiliated-re))
+ (let* ((raw-kwd (upcase (match-string 1)))
+ ;; Apply translation to RAW-KWD. From there, KWD is
+ ;; the official keyword.
+ (kwd (or (cdr (assoc raw-kwd
+ org-element-keyword-translation-alist))
+ raw-kwd))
+ ;; Find main value for any keyword.
+ (value
+ (save-match-data
+ (org-trim
+ (buffer-substring-no-properties
+ (match-end 0) (point-at-eol)))))
+ ;; PARSEDP is non-nil when keyword should have its
+ ;; value parsed.
+ (parsedp (member kwd org-element-parsed-keywords))
+ ;; If KWD is a dual keyword, find its secondary
+ ;; value. Maybe parse it.
+ (dualp (member kwd org-element-dual-keywords))
+ (dual-value
+ (and dualp
+ (let ((sec (org-match-string-no-properties 2)))
+ (if (or (not sec) (not parsedp)) sec
+ (org-element-parse-secondary-string sec restrict)))))
+ ;; Attribute a property name to KWD.
+ (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
+ ;; Now set final shape for VALUE.
+ (when parsedp
+ (setq value (org-element-parse-secondary-string value restrict)))
+ (when dualp
+ (setq value (and (or value dual-value) (cons value dual-value))))
+ (when (or (member kwd org-element-multiple-keywords)
+ ;; Attributes can always appear on multiple lines.
+ (string-match "^ATTR_" kwd))
+ (setq value (cons value (plist-get output kwd-sym))))
+ ;; Eventually store the new value in OUTPUT.
+ (setq output (plist-put output kwd-sym value))
+ ;; Move to next keyword.
+ (forward-line)))
+ ;; If affiliated keywords are orphaned: move back to first one.
+ ;; They will be parsed as a paragraph.
+ (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil))
+ ;; Return value.
+ (cons origin output))))
\f
;; `org-element-parse-secondary-string', which parses objects within
;; a given string.
;;
-;; The (almost) almighty `org-element-map' allows to apply a function
-;; on elements or objects matching some type, and accumulate the
+;; The (almost) almighty `org-element-map' allows applying a function
+;; on elements or objects matching some type, and accumulating the
;; resulting values. In an export situation, it also skips unneeded
;; parts of the parse tree.
Optional argument PARENT, when non-nil, is the element or object
containing the secondary string. It is used to set correctly
`:parent' property within the string."
- (with-temp-buffer
- (insert string)
- (let ((secondary (org-element--parse-objects
- (point-min) (point-max) nil restriction)))
- (mapc (lambda (obj) (org-element-put-property obj :parent parent))
- secondary))))
-
-(defun org-element-map (data types fun &optional info first-match no-recursion)
+ (let ((local-variables (buffer-local-variables)))
+ (with-temp-buffer
+ (dolist (v local-variables)
+ (ignore-errors
+ (if (symbolp v) (makunbound v)
+ (org-set-local (car v) (cdr v)))))
+ (insert string)
+ (restore-buffer-modified-p nil)
+ (let ((secondary (org-element--parse-objects
+ (point-min) (point-max) nil restriction)))
+ (when parent
+ (dolist (o secondary) (org-element-put-property o :parent parent)))
+ secondary))))
+
+(defun org-element-map
+ (data types fun &optional info first-match no-recursion with-affiliated)
"Map a function on selected elements or objects.
-DATA is an Org buffer parse tree, as returned by, i.e.,
-`org-element-parse-buffer'. TYPES is a symbol or list of symbols
-of elements or objects types (see `org-element-all-elements' and
+DATA is a parse tree, an element, an object, a string, or a list
+of such constructs. TYPES is a symbol or list of symbols of
+elements or objects types (see `org-element-all-elements' and
`org-element-all-objects' for a complete list of types). FUN is
the function called on the matching element or object. It has to
accept one argument: the element or object itself.
enter any recursive element or object whose type belongs to that
list. Though, FUN can still be applied on them.
+When optional argument WITH-AFFILIATED is non-nil, FUN will also
+apply to matching objects within parsed affiliated keywords (see
+`org-element-parsed-keywords').
+
Nil values returned from FUN do not appear in the results.
Examples:
---------
+---------
Assuming TREE is a variable containing an Org buffer parse tree,
the following example will return a flat list of all `src-block'
and `example-block' elements in it:
- \(org-element-map tree '(example-block src-block) 'identity)
+ (org-element-map tree \\='(example-block src-block) \\='identity)
The following snippet will find the first headline with a level
of 1 and a \"phone\" tag, and will return its beginning position:
- \(org-element-map
- tree 'headline
- \(lambda (hl)
- \(and (= (org-element-property :level hl) 1)
- \(member \"phone\" (org-element-property :tags hl))
- \(org-element-property :begin hl)))
+ (org-element-map tree \\='headline
+ (lambda (hl)
+ (and (= (org-element-property :level hl) 1)
+ (member \"phone\" (org-element-property :tags hl))
+ (org-element-property :begin hl)))
nil t)
-Eventually, this last example will return a flat list of all
-`bold' type objects containing a `latex-snippet' type object:
+The next example will return a flat list of all `plain-list' type
+elements in TREE that are not a sub-list themselves:
+
+ (org-element-map tree \\='plain-list \\='identity nil nil \\='plain-list)
+
+Eventually, this example will return a flat list of all `bold'
+type objects containing a `latex-snippet' type object, even
+looking into captions:
- \(org-element-map
- tree 'bold
- \(lambda (b)
- \(and (org-element-map b 'latex-snippet 'identity nil t)
- b)))"
+ (org-element-map tree \\='bold
+ (lambda (b)
+ (and (org-element-map b \\='latex-snippet \\='identity nil t) b))
+ nil nil nil t)"
;; Ensure TYPES and NO-RECURSION are a list, even of one element.
(unless (listp types) (setq types (list types)))
(unless (listp no-recursion) (setq no-recursion (list no-recursion)))
(setq category 'elements)))))
types)
category)))
+ ;; Compute properties for affiliated keywords if necessary.
+ (--affiliated-alist
+ (and with-affiliated
+ (mapcar (lambda (kwd)
+ (cons kwd (intern (concat ":" (downcase kwd)))))
+ org-element-affiliated-keywords)))
--acc
--walk-tree
(--walk-tree
((not --data))
;; Ignored element in an export context.
((and info (memq --data (plist-get info :ignore-list))))
- ;; Secondary string: only objects can be found there.
- ((not --type)
- (when (eq --category 'objects) (mapc --walk-tree --data)))
+ ;; List of elements or objects.
+ ((not --type) (mapc --walk-tree --data))
;; Unconditionally enter parse trees.
((eq --type 'org-data)
(mapc --walk-tree (org-element-contents --data)))
(t (push result --acc)))))
;; If --DATA has a secondary string that can contain
;; objects with their type among TYPES, look into it.
- (when (eq --category 'objects)
+ (when (and (eq --category 'objects) (not (stringp --data)))
(let ((sec-prop
(assq --type org-element-secondary-value-alist)))
(when sec-prop
(funcall --walk-tree
(org-element-property (cdr sec-prop) --data)))))
+ ;; If --DATA has any affiliated keywords and
+ ;; WITH-AFFILIATED is non-nil, look for objects in
+ ;; them.
+ (when (and with-affiliated
+ (eq --category 'objects)
+ (memq --type org-element-all-elements))
+ (mapc (lambda (kwd-pair)
+ (let ((kwd (car kwd-pair))
+ (value (org-element-property
+ (cdr kwd-pair) --data)))
+ ;; Pay attention to the type of value.
+ ;; Preserve order for multiple keywords.
+ (cond
+ ((not value))
+ ((and (member kwd org-element-multiple-keywords)
+ (member kwd org-element-dual-keywords))
+ (mapc (lambda (line)
+ (funcall --walk-tree (cdr line))
+ (funcall --walk-tree (car line)))
+ (reverse value)))
+ ((member kwd org-element-multiple-keywords)
+ (mapc (lambda (line) (funcall --walk-tree line))
+ (reverse value)))
+ ((member kwd org-element-dual-keywords)
+ (funcall --walk-tree (cdr value))
+ (funcall --walk-tree (car value)))
+ (t (funcall --walk-tree value)))))
+ --affiliated-alist))
;; Determine if a recursion into --DATA is possible.
(cond
;; --TYPE is explicitly removed from recursion.
(funcall --walk-tree data)
;; Return value in a proper order.
(nreverse --acc))))
+(put 'org-element-map 'lisp-indent-function 2)
;; The following functions are internal parts of the parser.
;;
Elements are accumulated into ACC."
(save-excursion
(goto-char beg)
+ ;; Visible only: skip invisible parts at the beginning of the
+ ;; element.
+ (when (and visible-only (org-invisible-p2))
+ (goto-char (min (1+ (org-find-visible)) end)))
;; When parsing only headlines, skip any text before first one.
(when (and (eq granularity 'headline) (not (org-at-heading-p)))
(org-with-limited-levels (outline-next-heading)))
(type (org-element-type element))
(cbeg (org-element-property :contents-begin element)))
(goto-char (org-element-property :end element))
+ ;; Visible only: skip invisible parts between siblings.
+ (when (and visible-only (org-invisible-p2))
+ (goto-char (min (1+ (org-find-visible)) end)))
;; Fill ELEMENT contents by side-effect.
(cond
- ;; If VISIBLE-ONLY is true and element is hidden or if it has
- ;; no contents, don't modify it.
- ((or (and visible-only (org-element-property :hiddenp element))
- (not cbeg)))
+ ;; If element has no contents, don't modify it.
+ ((not cbeg))
;; Greater element: parse it between `contents-begin' and
;; `contents-end'. Make sure GRANULARITY allows the
- ;; recursion, or ELEMENT is an headline, in which case going
+ ;; recursion, or ELEMENT is a headline, in which case going
;; inside is mandatory, in order to get sub-level headings.
((and (memq type org-element-greater-elements)
(or (memq granularity '(element object nil))
(if (org-element-property :quotedp element) 'quote-section
'section))
(plain-list 'item)
+ (property-drawer 'node-property)
(table 'table-row))
(and (memq type '(item plain-list))
(org-element-property :structure element))
Objects are accumulated in ACC.
-RESTRICTION is a list of object types which are allowed in the
-current object."
- (let (candidates)
+RESTRICTION is a list of object successors which are allowed in
+the current object."
+ (let ((candidates 'initial))
(save-excursion
- (goto-char beg)
- (while (and (< (point) end)
- (setq candidates (org-element--get-next-object-candidates
- end restriction candidates)))
- (let ((next-object
- (let ((pos (apply 'min (mapcar 'cdr candidates))))
- (save-excursion
- (goto-char pos)
- (funcall (intern (format "org-element-%s-parser"
- (car (rassq pos candidates)))))))))
- ;; 1. Text before any object. Untabify it.
- (let ((obj-beg (org-element-property :begin next-object)))
- (unless (= (point) obj-beg)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) obj-beg))))))
- ;; 2. Object...
- (let ((obj-end (org-element-property :end next-object))
- (cont-beg (org-element-property :contents-begin next-object)))
- ;; Fill contents of NEXT-OBJECT by side-effect, if it has
- ;; a recursive type.
- (when (and cont-beg
- (memq (car next-object) org-element-recursive-objects))
- (save-restriction
- (narrow-to-region
- cont-beg
- (org-element-property :contents-end next-object))
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates)))
+ (let ((next-object
+ (let ((pos (apply 'min (mapcar 'cdr candidates))))
+ (save-excursion
+ (goto-char pos)
+ (funcall (intern (format "org-element-%s-parser"
+ (car (rassq pos candidates)))))))))
+ ;; 1. Text before any object. Untabify it.
+ (let ((obj-beg (org-element-property :begin next-object)))
+ (unless (= (point) obj-beg)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) obj-beg))))))
+ ;; 2. Object...
+ (let ((obj-end (org-element-property :end next-object))
+ (cont-beg (org-element-property :contents-begin next-object)))
+ ;; Fill contents of NEXT-OBJECT by side-effect, if it has
+ ;; a recursive type.
+ (when (and cont-beg
+ (memq (car next-object) org-element-recursive-objects))
(org-element--parse-objects
- (point-min) (point-max) next-object
- (org-element-restriction next-object))))
- (setq acc (org-element-adopt-elements acc next-object))
- (goto-char obj-end))))
- ;; 3. Text after last object. Untabify it.
- (unless (= (point) end)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) end)))))
- ;; Result.
- acc)))
-
-(defun org-element--get-next-object-candidates (limit restriction objects)
+ cont-beg (org-element-property :contents-end next-object)
+ next-object (org-element-restriction next-object)))
+ (setq acc (org-element-adopt-elements acc next-object))
+ (goto-char obj-end))))
+ ;; 3. Text after last object. Untabify it.
+ (unless (eobp)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) end)))))
+ ;; Result.
+ acc))))
+
+(defun org-element--get-next-object-candidates (restriction objects)
"Return an alist of candidates for the next object.
-LIMIT bounds the search, and RESTRICTION narrows candidates to
-some object types.
-
-Return value is an alist whose CAR is position and CDR the object
-type, as a symbol.
-
-OBJECTS is the previous candidates alist."
- ;; Filter out any object found but not belonging to RESTRICTION.
- (setq objects
- (org-remove-if-not
- (lambda (obj)
- (let ((type (car obj)))
- (memq (or (cdr (assq type org-element-object-successor-alist))
- type)
- restriction)))
- objects))
- (let (next-candidates types-to-search)
- ;; If no previous result, search every object type in RESTRICTION.
- ;; Otherwise, keep potential candidates (old objects located after
- ;; point) and ask to search again those which had matched before.
- (if (not objects) (setq types-to-search restriction)
- (mapc (lambda (obj)
- (if (< (cdr obj) (point)) (push (car obj) types-to-search)
- (push obj next-candidates)))
- objects))
- ;; Call the appropriate successor function for each type to search
- ;; and accumulate matches.
- (mapc
- (lambda (type)
- (let* ((successor-fun
- (intern
- (format "org-element-%s-successor"
- (or (cdr (assq type org-element-object-successor-alist))
- type))))
- (obj (funcall successor-fun limit)))
- (and obj (push obj next-candidates))))
- types-to-search)
- ;; Return alist.
- next-candidates))
+RESTRICTION is a list of object types, as symbols. Only
+candidates with such types are looked after.
+
+OBJECTS is the previous candidates alist. If it is set to
+`initial', no search has been done before, and all symbols in
+RESTRICTION should be looked after.
+
+Return value is an alist whose CAR is the object type and CDR its
+beginning position."
+ (delq
+ nil
+ (if (eq objects 'initial)
+ ;; When searching for the first time, look for every successor
+ ;; allowed in RESTRICTION.
+ (mapcar
+ (lambda (res)
+ (funcall (intern (format "org-element-%s-successor" res))))
+ restriction)
+ ;; Focus on objects returned during last search. Keep those
+ ;; still after point. Search again objects before it.
+ (mapcar
+ (lambda (obj)
+ (if (>= (cdr obj) (point)) obj
+ (let* ((type (car obj))
+ (succ (or (cdr (assq type org-element-object-successor-alist))
+ type)))
+ (and succ
+ (funcall (intern (format "org-element-%s-successor" succ)))))))
+ objects))))
\f
(mapconcat
(lambda (obj) (org-element-interpret-data obj parent))
(org-element-contents data) ""))
- ;; Plain text.
+ ;; Plain text: return it.
((stringp data) data)
;; Element/Object without contents.
((not (org-element-contents data))
;; All attribute keywords can have multiple lines.
(string-match "^ATTR_" keyword))
(mapconcat (lambda (line) (funcall keyword-to-org keyword line))
- value
+ (reverse value)
"")
(funcall keyword-to-org keyword value)))))
;; List all ELEMENT's properties matching an attribute line or an
Return the normalized element that is element with global
indentation removed from its contents. The function assumes that
indentation is not done with TAB characters."
- (let* (ind-list ; for byte-compiler
- collect-inds ; for byte-compiler
- (collect-inds
- (function
- ;; Return list of indentations within BLOB. This is done by
- ;; walking recursively BLOB and updating IND-LIST along the
- ;; way. FIRST-FLAG is non-nil when the first string hasn't
- ;; been seen yet. It is required as this string is the only
- ;; one whose indentation doesn't happen after a newline
- ;; character.
- (lambda (blob first-flag)
- (mapc
- (lambda (object)
- (when (and first-flag (stringp object))
- (setq first-flag nil)
- (string-match "\\`\\( *\\)" object)
- (let ((len (length (match-string 1 object))))
- ;; An indentation of zero means no string will be
- ;; modified. Quit the process.
- (if (zerop len) (throw 'zero (setq ind-list nil))
- (push len ind-list))))
- (cond
- ((stringp object)
- (let ((start 0))
- ;; Avoid matching blank or empty lines.
- (while (and (string-match "\n\\( *\\)\\(.\\)" object start)
- (not (equal (match-string 2 object) " ")))
- (setq start (match-end 0))
- (push (length (match-string 1 object)) ind-list))))
- ((memq (org-element-type object) org-element-recursive-objects)
- (funcall collect-inds object first-flag))))
- (org-element-contents blob))))))
- ;; Collect indentation list in ELEMENT. Possibly remove first
- ;; value if IGNORE-FIRST is non-nil.
- (catch 'zero (funcall collect-inds element (not ignore-first)))
- (if (not ind-list) element
+ (let* ((min-ind most-positive-fixnum)
+ find-min-ind ; For byte-compiler.
+ (find-min-ind
+ ;; Return minimal common indentation within BLOB. This is
+ ;; done by walking recursively BLOB and updating MIN-IND
+ ;; along the way. FIRST-FLAG is non-nil when the first
+ ;; string hasn't been seen yet. It is required as this
+ ;; string is the only one whose indentation doesn't happen
+ ;; after a newline character.
+ (lambda (blob first-flag)
+ (dolist (object (org-element-contents blob))
+ (when (and first-flag (stringp object))
+ (setq first-flag nil)
+ (string-match "\\` *" object)
+ (let ((len (match-end 0)))
+ ;; An indentation of zero means no string will be
+ ;; modified. Quit the process.
+ (if (zerop len) (throw 'zero (setq min-ind 0))
+ (setq min-ind (min len min-ind)))))
+ (cond
+ ((stringp object)
+ (dolist (line (cdr (org-split-string object " *\n")))
+ (unless (string= line "")
+ (setq min-ind (min (org-get-indentation line) min-ind)))))
+ ((memq (org-element-type object) org-element-recursive-objects)
+ (funcall find-min-ind object first-flag)))))))
+ ;; Find minimal indentation in ELEMENT.
+ (catch 'zero (funcall find-min-ind element (not ignore-first)))
+ (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element
;; Build ELEMENT back, replacing each string with the same
;; string minus common indentation.
(let* (build ; For byte compiler.
(build
(function
- (lambda (blob mci first-flag)
+ (lambda (blob first-flag)
;; Return BLOB with all its strings indentation
- ;; shortened from MCI white spaces. FIRST-FLAG is
- ;; non-nil when the first string hasn't been seen
+ ;; shortened from MIN-IND white spaces. FIRST-FLAG
+ ;; is non-nil when the first string hasn't been seen
;; yet.
(setcdr (cdr blob)
(mapcar
- (lambda (object)
- (when (and first-flag (stringp object))
- (setq first-flag nil)
- (setq object
- (replace-regexp-in-string
- (format "\\` \\{%d\\}" mci) "" object)))
- (cond
- ((stringp object)
- (replace-regexp-in-string
- (format "\n \\{%d\\}" mci) "\n" object))
- ((memq (org-element-type object)
- org-element-recursive-objects)
- (funcall build object mci first-flag))
- (t object)))
+ #'(lambda (object)
+ (when (and first-flag (stringp object))
+ (setq first-flag nil)
+ (setq object
+ (replace-regexp-in-string
+ (format "\\` \\{%d\\}" min-ind)
+ "" object)))
+ (cond
+ ((stringp object)
+ (replace-regexp-in-string
+ (format "\n \\{%d\\}" min-ind) "\n" object))
+ ((memq (org-element-type object)
+ org-element-recursive-objects)
+ (funcall build object first-flag))
+ (t object)))
(org-element-contents blob)))
blob))))
- (funcall build element (apply 'min ind-list) (not ignore-first))))))
+ (funcall build element (not ignore-first))))))
\f
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
+ ;; If at a 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))
(list (org-element-headline-parser (point-max) t))))
;; Otherwise move at the beginning of the section containing
;; point.
- (let ((origin (point))
- (end (save-excursion
- (org-with-limited-levels (outline-next-heading)) (point)))
- element type special-flag trail struct prevs parent)
- (org-with-limited-levels
- (if (org-with-limited-levels (org-before-first-heading-p))
- (goto-char (point-min))
- (org-back-to-heading)
- (forward-line)))
- (org-skip-whitespace)
- (beginning-of-line)
- ;; Parse successively each element, skipping those ending
- ;; before original position.
- (catch 'exit
- (while t
- (setq element
+ (catch 'exit
+ (let ((origin (point))
+ (end (save-excursion
+ (org-with-limited-levels (outline-next-heading)) (point)))
+ element type special-flag trail struct prevs parent)
+ (org-with-limited-levels
+ (if (org-before-first-heading-p)
+ ;; In empty lines at buffer's beginning, return nil.
+ (progn (goto-char (point-min))
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ (throw 'exit nil)))
+ (org-back-to-heading)
+ (forward-line)
+ (org-skip-whitespace)
+ (when (or (eobp) (> (line-beginning-position) origin))
+ ;; In blank lines just after the headline, point still
+ ;; belongs to the headline.
+ (throw 'exit
+ (progn (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
+ (if (not keep-trail)
+ (org-element-headline-parser (point-max) t)
+ (list (org-element-headline-parser
+ (point-max) t))))))))
+ (beginning-of-line)
+ ;; Parse successively each element, skipping those ending
+ ;; before original position.
+ (while t
+ (setq element
(org-element--current-element end 'element special-flag struct)
- type (car element))
+ type (car element))
(org-element-put-property element :parent parent)
(when keep-trail (push element trail))
- (cond
+ (cond
;; 1. Skip any element ending before point. Also skip
;; element ending at point when we're sure that another
;; element has started.
;; into elements with an explicit ending, but
;; return that element instead.
(and (= cend origin)
- (memq type
- '(center-block
- drawer dynamic-block inlinetask item
- plain-list quote-block special-block))))
+ (or (memq type
+ '(center-block
+ drawer dynamic-block inlinetask
+ property-drawer quote-block
+ special-block))
+ ;; Corner case: if a list ends at the
+ ;; end of a buffer without a final new
+ ;; line, return last element in last
+ ;; item instead.
+ (and (memq type '(item plain-list))
+ (progn (goto-char cend)
+ (or (bolp) (not (eobp))))))))
(throw 'exit (if keep-trail trail element))
(setq parent element)
(case type
(goto-char cbeg)))))))))))
;;;###autoload
-(defun org-element-context ()
+(defun org-element-context (&optional element)
"Return closest element or object around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
Possible types are defined in `org-element-all-elements' and
`org-element-all-objects'. Properties depend on element or
object type, but always include `:begin', `:end', `:parent' and
-`:post-blank'."
- (org-with-wide-buffer
- (let* ((origin (point))
- (element (org-element-at-point))
- (type (car element))
- end)
- ;; Check if point is inside an element containing objects or at
- ;; a secondary string. In that case, move to beginning of the
- ;; element or secondary string and set END to the other side.
- (if (not (or (and (eq type 'item)
- (let ((tag (org-element-property :tag element)))
- (and tag
- (progn
- (beginning-of-line)
- (search-forward tag (point-at-eol))
- (goto-char (match-beginning 0))
- (and (>= origin (point))
- (<= origin
- ;; `1+' is required so some
- ;; successors can match
- ;; properly their object.
- (setq end (1+ (match-end 0)))))))))
- (and (memq type '(headline inlinetask))
- (progn (beginning-of-line)
- (skip-chars-forward "* ")
- (setq end (point-at-eol))))
- (and (memq type '(paragraph table-row verse-block))
- (let ((cbeg (org-element-property
- :contents-begin element))
- (cend (org-element-property
- :contents-end element)))
- (and (>= origin cbeg)
- (<= origin cend)
- (progn (goto-char cbeg) (setq end cend)))))))
- element
- (let ((restriction (org-element-restriction element))
- (parent element)
- candidates)
- (catch 'exit
- (while (setq candidates (org-element--get-next-object-candidates
- end restriction candidates))
- (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
- candidates)))
- ;; If ORIGIN is before next object in element, there's
- ;; no point in looking further.
- (if (> (cdr closest-cand) origin) (throw 'exit parent)
- (let* ((object
- (progn (goto-char (cdr closest-cand))
- (funcall (intern (format "org-element-%s-parser"
- (car closest-cand))))))
- (cbeg (org-element-property :contents-begin object))
- (cend (org-element-property :contents-end object))
- (obj-end (org-element-property :end object)))
- (cond
- ;; ORIGIN is after OBJECT, so skip it.
- ((<= obj-end origin)
- (if (/= obj-end end) (goto-char obj-end)
- (throw 'exit
- (org-element-put-property
- object :parent parent))))
- ;; ORIGIN is within a non-recursive object or at
- ;; an object boundaries: Return that object.
- ((or (not cbeg) (> cbeg origin) (< cend origin))
- (throw 'exit
- (org-element-put-property object :parent parent)))
- ;; Otherwise, move within current object and
- ;; restrict search to the end of its contents.
- (t (goto-char cbeg)
- (org-element-put-property object :parent parent)
- (setq parent object
- restriction (org-element-restriction object)
- end cend)))))))
- parent))))))
-
-(defsubst org-element-nested-p (elem-A elem-B)
+`:post-blank'.
+
+Optional argument ELEMENT, when non-nil, is the closest element
+containing point, as returned by `org-element-at-point'.
+Providing it allows for quicker computation."
+ (catch 'objects-forbidden
+ (org-with-wide-buffer
+ (let* ((origin (point))
+ (element (or element (org-element-at-point)))
+ (type (org-element-type element))
+ context)
+ ;; Check if point is inside an element containing objects or at
+ ;; a secondary string. In that case, narrow buffer to the
+ ;; containing area. Otherwise, return ELEMENT.
+ (cond
+ ;; At a parsed affiliated keyword, check if we're inside main
+ ;; or dual value.
+ ((let ((post (org-element-property :post-affiliated element)))
+ (and post (< origin post)))
+ (beginning-of-line)
+ (let ((case-fold-search t)) (looking-at org-element--affiliated-re))
+ (cond
+ ((not (member-ignore-case (match-string 1)
+ org-element-parsed-keywords))
+ (throw 'objects-forbidden element))
+ ((< (match-end 0) origin)
+ (narrow-to-region (match-end 0) (line-end-position)))
+ ((and (match-beginning 2)
+ (>= origin (match-beginning 2))
+ (< origin (match-end 2)))
+ (narrow-to-region (match-beginning 2) (match-end 2)))
+ (t (throw 'objects-forbidden element)))
+ ;; Also change type to retrieve correct restrictions.
+ (setq type 'keyword))
+ ;; At an item, objects can only be located within tag, if any.
+ ((eq type 'item)
+ (let ((tag (org-element-property :tag element)))
+ (if (not tag) (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward tag (line-end-position))
+ (goto-char (match-beginning 0))
+ (if (and (>= origin (point)) (< origin (match-end 0)))
+ (narrow-to-region (point) (match-end 0))
+ (throw 'objects-forbidden element)))))
+ ;; At an headline or inlinetask, objects are located within
+ ;; their title.
+ ((memq type '(headline inlinetask))
+ (goto-char (org-element-property :begin element))
+ (skip-chars-forward "*")
+ (if (and (> origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element)))
+ ;; At a paragraph, a table-row or a verse block, objects are
+ ;; located within their contents.
+ ((memq type '(paragraph table-row verse-block))
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ ;; CBEG is nil for table rules.
+ (if (and cbeg cend (>= origin cbeg) (< origin cend))
+ (narrow-to-region cbeg cend)
+ (throw 'objects-forbidden element))))
+ ;; At a parsed keyword, objects are located within value.
+ ((eq type 'keyword)
+ (if (not (member (org-element-property :key element)
+ org-element-document-properties))
+ (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward ":")
+ (if (and (>= origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element))))
+ ;; At a planning line, if point is at a timestamp, return it,
+ ;; otherwise, return element.
+ ((eq type 'planning)
+ (dolist (p '(:closed :deadline :scheduled))
+ (let ((timestamp (org-element-property p element)))
+ (when (and timestamp
+ (<= (org-element-property :begin timestamp) origin)
+ (> (org-element-property :end timestamp) origin))
+ (throw 'objects-forbidden timestamp))))
+ (throw 'objects-forbidden element))
+ (t (throw 'objects-forbidden element)))
+ (goto-char (point-min))
+ (let ((restriction (org-element-restriction type))
+ (parent element)
+ (candidates 'initial))
+ (catch 'exit
+ (while (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates))
+ (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
+ candidates)))
+ ;; If ORIGIN is before next object in element, there's
+ ;; no point in looking further.
+ (if (> (cdr closest-cand) origin) (throw 'exit parent)
+ (let* ((object
+ (progn (goto-char (cdr closest-cand))
+ (funcall (intern (format "org-element-%s-parser"
+ (car closest-cand))))))
+ (cbeg (org-element-property :contents-begin object))
+ (cend (org-element-property :contents-end object))
+ (obj-end (org-element-property :end object)))
+ (cond
+ ;; ORIGIN is after OBJECT, so skip it.
+ ((<= obj-end origin) (goto-char obj-end))
+ ;; ORIGIN is within a non-recursive object or at
+ ;; an object boundaries: Return that object.
+ ((or (not cbeg) (< origin cbeg) (>= origin cend))
+ (throw 'exit
+ (org-element-put-property object :parent parent)))
+ ;; Otherwise, move within current object and
+ ;; restrict search to the end of its contents.
+ (t (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (org-element-put-property object :parent parent)
+ (setq parent object
+ restriction (org-element-restriction object)
+ candidates 'initial)))))))
+ parent))))))
+
+(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."
(let ((beg-A (org-element-property :begin elem-A))
(beg-B (org-element-property :begin elem-B))