;;; org-element.el --- Parser And Applications for Org syntax
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
;; `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 a 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.
;;
"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 plain-link 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
'("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")
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 '("CAPTION")
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
(let* ((standard-set
(remq 'plain-link (remq 'table-cell org-element-all-successors)))
(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)
+ (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 export-snippet footnote-reference latex-or-entity link macro
+ (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)
object of such type.
For example, in a `radio-target' object, one can only find
-entities, 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
(footnote-reference . :inline-definition))
"Alist between element types and location of secondary value.")
-(defconst org-element-object-variables '(org-link-abbrev-alist-local)
- "List of buffer-local variables used when parsing objects.
-These variables are copied to the temporary buffer created by
-`org-export-secondary-string'.")
-
\f
;;; Accessors and Setters
Return a list whose CAR is `headline' and CDR is a plist
containing `:raw-value', `:title', `:alt-title', `:begin',
-`:end', `:pre-blank', `:hiddenp', `:contents-begin' and
+`:end', `:pre-blank', `:hiddenp', `:contents-begin',
`:contents-end', `:level', `:priority', `:tags',
`:todo-keyword',`:todo-type', `:scheduled', `:deadline',
-`:closed', `:quotedp', `:archivedp', `:commentedp' and
-`:footnote-section-p' keywords.
+`: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 upper cases and colons added at the
-beginning (i.e. `:CUSTOM_ID').
+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.
(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)
:todo-keyword todo
:todo-type todo-type
: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
(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 (org-reduced-level 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
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
-beginning (i.e. `:CUSTOM_ID').
+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
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)
(let ((origin (point)))
(when (re-search-forward inlinetask-re limit t)
- (if (looking-at "^\\*+ END[ \t]*$") (forward-line)
+ (if (org-looking-at-p "END[ \t]*$") (forward-line)
(goto-char origin)))))
;; At some text line. Check if it ends any previous item.
(t
`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the property drawer."
- (save-excursion
- (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 (< (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 '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)))))))))
+ (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.
Return a list whose CAR is `node-property' and CDR is a plist
containing `:key', `:value', `:begin', `:end' and `:post-blank'
keywords."
- (save-excursion
- (looking-at org-property-re)
- (let ((case-fold-search t)
- (begin (point))
- (key (org-match-string-no-properties 2))
- (value (org-match-string-no-properties 3))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (point-at-bol)))))
- (list 'node-property
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end))))))
+ (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))
- (org-element-property :value node-property)))
+ (or (org-element-property :value node-property) "")))
;;;; Paragraph
;; 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
(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)
;;
;; 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'.
;;
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]*?)\\(\\[.*?\\]\\)?"
- nil 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
((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)
(cond
;; File type.
((or (file-name-absolute-p raw-link)
- (string-match "^\\.\\.?/" 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 raw-link)
- (setq type (match-string 1 raw-link) path (match-string 2 raw-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]+\\)" raw-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 "^(\\(.*\\))$" raw-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 raw-link 0) ?#)
;; headline name or nothing. PATH is the target or
;; headline's name.
(t (setq type "fuzzy" path raw-link))))
- ;; Type 3: Plain link, i.e. http://orgmode.org
+ ;; 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)
link-end (match-end 0)
path (org-match-string-no-properties 2)))
- ;; Type 4: Angular link, i.e. <http://orgmode.org>
+ ;; 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))
;; LINK-END variable.
(setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
end (point))
- ;; Extract search option and opening application out of
- ;; "file"-type links.
+ ;; Special "file" type link processing.
(when (member type org-element-link-type-is-file)
- ;; Application.
+ ;; 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)))
- ;; Extract search option from PATH.
- (when (string-match "::\\(.*\\)$" path)
+ (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
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))
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
`:month-end', `:day-end', `:hour-end', `:minute-end',
`:repeater-type', `:repeater-value', `:repeater-unit',
`:warning-type', `:warning-value', `:warning-unit', `:begin',
-`:end', `:value' and `:post-blank' keywords.
+`:end' and `:post-blank' keywords.
Assume point is at the beginning of the timestamp."
(save-excursion
;; 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' >
+;; 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'.
(goto-char (car affiliated))
(org-element-keyword-parser limit nil))
;; LaTeX Environment.
- ((looking-at
- "[ \t]*\\\\begin{[A-Za-z0-9*]+}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$")
+ ((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)
beginning of the first line after them.
As a special case, if element doesn't start at the beginning of
-the line (i.e. a paragraph starting an item), CAR is current
+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)
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."
- ;; Copy buffer-local variables listed in
- ;; `org-element-object-variables' into temporary buffer. This is
- ;; required since object parsing is dependent on these variables.
- (let ((pairs (delq nil (mapcar (lambda (var)
- (when (boundp var)
- (cons var (symbol-value var))))
- org-element-object-variables))))
+ (let ((local-variables (buffer-local-variables)))
(with-temp-buffer
- (mapc (lambda (pair) (org-set-local (car pair) (cdr pair))) pairs)
+ (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
- (mapc (lambda (obj) (org-element-put-property obj :parent parent))
- secondary))
+ (dolist (o secondary) (org-element-put-property o :parent parent)))
secondary))))
(defun org-element-map
(mapconcat
(lambda (obj) (org-element-interpret-data obj parent))
(org-element-contents data) ""))
- ;; Plain text: remove `:parent' text property from output.
- ((stringp data) (org-no-properties data))
+ ;; Plain text: return it.
+ ((stringp data) data)
;; Element/Object without contents.
((not (org-element-contents data))
(funcall (intern (format "org-element-%s-interpreter" type))
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
;; their title.
((memq type '(headline inlinetask))
(goto-char (org-element-property :begin element))
- (skip-chars-forward "* ")
- (if (and (>= origin (point)) (< origin (line-end-position)))
+ (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
(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))