]> code.delx.au - gnu-emacs/blobdiff - lisp/org/org-element.el
* lisp/simple.el (save-mark-and-excursion): Add declare forms.
[gnu-emacs] / lisp / org / org-element.el
index b44466e53df59c23a5b700c9575594e93b90d139..a19f52c7923d6f57ec7c65dfde76459a7462f56c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; org-element.el --- Parser And Applications for Org syntax
 
-;; Copyright (C) 2012-2014 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
@@ -360,11 +360,6 @@ still has an entry since one of its properties (`:title') does.")
     (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
@@ -372,8 +367,8 @@ These variables are copied to the temporary buffer created by
 ;; 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.
@@ -492,7 +487,7 @@ Return parent element."
 ;; 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'.
 
@@ -732,11 +727,11 @@ CONTENTS is the contents of the footnote-definition."
 
 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
@@ -875,38 +870,40 @@ CONTENTS is the contents of the element."
                                         (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
@@ -1315,36 +1312,36 @@ containing `:begin', `:end', `:hiddenp', `:contents-begin',
 `: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.
@@ -2099,28 +2096,28 @@ 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."
-  (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
@@ -2486,7 +2483,7 @@ Assume point is at the beginning of the table."
 
 (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)
@@ -3112,16 +3109,20 @@ Assume point is at the beginning of the link."
        (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) ?#)
@@ -3541,7 +3542,7 @@ Return a list whose CAR is `timestamp', and CDR a plist with
 `: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
@@ -3890,8 +3891,7 @@ element it has to parse."
              (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)
@@ -4023,8 +4023,8 @@ position of point and CDR is nil."
 ;; `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.
 
@@ -4090,21 +4090,18 @@ looked after.
 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
@@ -4144,30 +4141,30 @@ 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)
 
 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)
+  (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)))
@@ -4617,29 +4614,29 @@ indentation is not done with TAB characters."
   (let* ((min-ind most-positive-fixnum)
         find-min-ind                   ; For byte-compiler.
         (find-min-ind
-         (function
-          ;; 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 (length (match-string 1 object))))
-                  ;; 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 (delq "" (cdr (org-split-string object " *\n"))))
-                  (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))))))))
+         ;; 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