[elpa] externals/org aafa0c2828 04/10: org-element: Cache commonly used property value strings in obarray

[ELPA Syncer]

branch: externals/org
commit aafa0c2828add139dc86f10b27e11ba17e14c416
Author: Ihor Radchenko <yantar92@posteo.net>
Commit: Ihor Radchenko <yantar92@posteo.net>

    org-element: Cache commonly used property value strings in obarray
    
    * lisp/org-element.el (org-element--string-cache): New obarray holding
    common strings in Org AST.
    (org-element--get-cached-string): New function retrieving interned
    string object.
    (org-element-drawer-parser):
    (org-element-dynamic-block-parser):
    (org-element-footnote-definition-parser):
    (org-element-headline-parser):
    (org-element-inlinetask-parser):
    (org-element-item-parser):
    (org-element-special-block-parser):
    (org-element-keyword-parser):
    (org-element-node-property-parser):
    (org-element-src-block-parser):
    (org-element-citation-parser):
    (org-element-citation-reference-parser):
    (org-element-export-snippet-parser):
    (org-element-footnote-reference-parser):
    (org-element-inline-babel-call-parser):
    (org-element-inline-src-block-parser):
    (org-element-link-parser):
    (org-element-macro-parser): Reuse string objects that are likely to
    occur in parsed elements.
---
 lisp/org-element.el | 64 ++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 44 insertions(+), 20 deletions(-)

diff --git a/lisp/org-element.el b/lisp/org-element.el
index a2db30c7b6..1c6099b0fc 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -731,6 +731,16 @@ is cleared and contents are removed in the process."
                         (org-element-put-property obj :parent element-copy))))
            element-copy))))))
 
+(defvar org-element--string-cache (obarray-make)
+  "Obarray holding tag strings and todo keyword objects.
+We use shared string storage to reduce memory footprint of the syntax
+tree.")
+
+(defsubst org-element--get-cached-string (string)
+  "Return cached object equal to STRING.
+Return nil if STRING is nil."
+  (when string
+    (symbol-name (intern string org-element--string-cache))))
 
 
 ;;; Greater elements
@@ -843,7 +853,7 @@ Assume point is at beginning of drawer."
               (name
                 (progn
                   (looking-at org-element-drawer-re)
-                 (match-string-no-properties 1)))
+                 (org-element--get-cached-string (match-string-no-properties 
1))))
               (begin (car affiliated))
               (post-affiliated (point))
               ;; Empty drawers have no contents.
@@ -900,7 +910,7 @@ Assume point is at beginning of dynamic block."
        (save-excursion
          (let* ((name (progn
                          (looking-at org-element-dynamic-block-open-re)
-                        (match-string-no-properties 1)))
+                        (org-element--get-cached-string 
(match-string-no-properties 1))))
                 (arguments (match-string-no-properties 2))
                 (begin (car affiliated))
                 (post-affiliated (point))
@@ -960,7 +970,8 @@ a plist containing `:label', `:begin' `:end', 
`:contents-begin',
 Assume point is at the beginning of the footnote definition."
   (save-excursion
     (let* ((label (progn (looking-at org-footnote-definition-re)
-                        (match-string-no-properties 1)))
+                        (org-element--get-cached-string
+                          (match-string-no-properties 1))))
           (begin (car affiliated))
           (post-affiliated (point))
           (end
@@ -1106,7 +1117,7 @@ Assume point is at beginning of the headline."
                      (let (case-fold-search) (looking-at (concat 
org-todo-regexp "\\(?: \\|$\\)")))
                      (progn (goto-char (match-end 0))
                             (skip-chars-forward " \t")
-                            (match-string-no-properties 1))))
+                             (org-element--get-cached-string 
(match-string-no-properties 1)))))
           (todo-type
            (and todo (if (member todo org-done-keywords) 'done 'todo)))
           (priority (and (looking-at "\\[#.\\][ \t]*")
@@ -1124,7 +1135,8 @@ Assume point is at beginning of the headline."
                        (line-end-position)
                        'move)
                   (goto-char (match-beginning 0))
-                  (org-split-string (match-string-no-properties 1) ":")))
+                   (mapcar #'org-element--get-cached-string
+                          (org-split-string (match-string-no-properties 1) 
":"))))
           (title-end (point))
           (raw-value (org-trim
                       (buffer-substring-no-properties title-start title-end)))
@@ -1363,7 +1375,7 @@ Assume point is at beginning of the inline task."
                      (let (case-fold-search) (looking-at org-todo-regexp))
                      (progn (goto-char (match-end 0))
                             (skip-chars-forward " \t")
-                            (match-string-no-properties 0))))
+                             (org-element--get-cached-string 
(match-string-no-properties 0)))))
           (todo-type (and todo
                           (if (member todo org-done-keywords) 'done 'todo)))
           (priority (and (looking-at "\\[#.\\][ \t]*")
@@ -1384,7 +1396,8 @@ Assume point is at beginning of the inline task."
                        (line-end-position)
                        'move)
                   (goto-char (match-beginning 0))
-                  (org-split-string (match-string-no-properties 1) ":")))
+                   (mapcar #'org-element--get-cached-string
+                          (org-split-string (match-string-no-properties 1) 
":"))))
           (title-end (point))
           (raw-value (org-trim
                       (buffer-substring-no-properties title-start title-end)))
@@ -1502,7 +1515,7 @@ Assume point is at the beginning of the item."
     (beginning-of-line)
     (looking-at org-list-full-item-re)
     (let* ((begin (point))
-          (bullet (match-string-no-properties 1))
+          (bullet (org-element--get-cached-string (match-string-no-properties 
1)))
           (checkbox (let ((box (match-string 3)))
                       (cond ((equal "[ ]" box) 'off)
                             ((equal "[X]" box) 'on)
@@ -1887,7 +1900,8 @@ containing `:type', `:parameters', `:begin', `:end',
 Assume point is at the beginning of the block."
   (let* ((case-fold-search t)
         (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)[ \t]*\\(.*\\)[ 
\t]*$")
-                     (match-string-no-properties 1)))
+                     (org-element--get-cached-string
+                       (match-string-no-properties 1))))
         (parameters (match-string-no-properties 2)))
     (if (not (save-excursion
               (re-search-forward
@@ -2443,7 +2457,8 @@ CDR is a plist containing `:key', `:value', `:begin', 
`:end',
     (let ((begin (or (car affiliated) (point)))
          (post-affiliated (point))
          (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):")
-                     (upcase (match-string-no-properties 1))))
+                     (org-element--get-cached-string
+                       (upcase (match-string-no-properties 1)))))
          (value (org-trim (buffer-substring-no-properties
                             (match-end 0) (line-end-position))))
          (pos-before-blank (progn (forward-line) (point)))
@@ -2534,7 +2549,8 @@ containing `:key', `:value', `:begin', `:end', 
`:post-blank' and
   (looking-at org-property-re)
   (let ((case-fold-search t)
        (begin (point))
-       (key   (match-string-no-properties 2))
+       (key   (org-element--get-cached-string
+                (match-string-no-properties 2)))
        (value (match-string-no-properties 3))
        (end (save-excursion
               (end-of-line)
@@ -2723,7 +2739,8 @@ Assume point is at the beginning of the block."
 \\(?: +\\(\\S-+\\)\\)?\
 \\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\
 \\(.*\\)[ \t]*$")
-                   (match-string-no-properties 1)))
+                   (org-element--get-cached-string
+                     (match-string-no-properties 1))))
                 ;; Get switches.
                 (switches (match-string-no-properties 2))
                 ;; Get parameters.
@@ -3054,7 +3071,8 @@ Assume point is at the beginning of the citation."
   (when (looking-at org-element-citation-prefix-re)
     (let* ((begin (point))
           (style (and (match-end 1)
-                      (match-string-no-properties 1)))
+                      (org-element--get-cached-string
+                        (match-string-no-properties 1))))
           ;; Ignore blanks between cite type and prefix or key.
           (start (match-end 0))
           (closing (with-syntax-table org-element--pair-square-table
@@ -3130,7 +3148,8 @@ Assume point is at the beginning of the reference."
   (save-excursion
     (let ((begin (point)))
       (when (re-search-forward org-element-citation-key-re nil t)
-        (let* ((key (match-string-no-properties 1))
+        (let* ((key (org-element--get-cached-string
+                     (match-string-no-properties 1)))
               (key-start (match-beginning 0))
               (key-end (match-end 0))
               (separator (search-forward ";" nil t))
@@ -3242,7 +3261,8 @@ Assume point is at the beginning of the snippet."
                                            (re-search-forward "@@" nil t)
                                          (match-beginning 0)))))
        (let* ((begin (match-beginning 0))
-              (backend (match-string-no-properties 1))
+              (backend (org-element--get-cached-string
+                         (match-string-no-properties 1)))
               (value (buffer-substring-no-properties
                       (match-end 0) contents-end))
               (post-blank (skip-chars-forward " \t"))
@@ -3276,7 +3296,8 @@ When at a footnote reference, return a list whose car is
       (when closing
        (save-excursion
          (let* ((begin (point))
-                (label (match-string-no-properties 1))
+                (label (org-element--get-cached-string
+                         (match-string-no-properties 1)))
                 (inner-begin (match-end 0))
                 (inner-end (1- closing))
                 (type (if (match-end 2) 'inline 'standard))
@@ -3317,7 +3338,8 @@ Assume point is at the beginning of the babel call."
              (looking-at "\\<call_\\([^ \t\n[(]+\\)[([]"))
        (goto-char (match-end 1))
        (let* ((begin (match-beginning 0))
-              (call (match-string-no-properties 1))
+              (call (org-element--get-cached-string
+                      (match-string-no-properties 1)))
               (inside-header
                (let ((p (org-element--parse-paired-brackets ?\[)))
                  (and (org-string-nw-p p)
@@ -3371,7 +3393,8 @@ Assume point is at the beginning of the inline source 
block."
              (looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]"))
        (goto-char (match-end 1))
        (let ((begin (match-beginning 0))
-             (language (match-string-no-properties 1))
+             (language (org-element--get-cached-string
+                         (match-string-no-properties 1)))
              (parameters
               (let ((p (org-element--parse-paired-brackets ?\[)))
                 (and (org-string-nw-p p)
@@ -3608,7 +3631,7 @@ Assume point is at the beginning of the link."
          (setq type (car trans))
          (setq path (cdr trans))))
       (list 'link
-           (list :type type
+           (list :type (org-element--get-cached-string type)
                  :path path
                  :format format
                  :raw-link (or raw-link path)
@@ -3673,7 +3696,8 @@ Assume point is at the macro."
   (save-excursion
     (when (looking-at 
"{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\(\\(?:.\\|\n\\)*?\\))\\)?}}}")
       (let ((begin (point))
-           (key (downcase (match-string-no-properties 1)))
+           (key (org-element--get-cached-string
+                  (downcase (match-string-no-properties 1))))
            (value (match-string-no-properties 0))
            (post-blank (progn (goto-char (match-end 0))
                               (skip-chars-forward " \t")))