From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id EN+7NuPmRmF1rwAAgWs5BA (envelope-from ) for ; Sun, 19 Sep 2021 09:29:39 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id MA5xMuPmRmGyPwAA1q6Kng (envelope-from ) for ; Sun, 19 Sep 2021 07:29:39 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 8E96F11107 for ; Sun, 19 Sep 2021 09:29:38 +0200 (CEST) Received: from localhost ([::1]:43890 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1mRrGZ-0006HA-SE for larch@yhetil.org; Sun, 19 Sep 2021 03:29:35 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:40730) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mRrFx-0006Gx-MF for emacs-orgmode@gnu.org; Sun, 19 Sep 2021 03:28:57 -0400 Received: from mail-pj1-x1032.google.com ([2607:f8b0:4864:20::1032]:42883) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1mRrFs-00015v-AC for emacs-orgmode@gnu.org; Sun, 19 Sep 2021 03:28:57 -0400 Received: by mail-pj1-x1032.google.com with SMTP id p12-20020a17090adf8c00b0019c959bc795so4834433pjv.1 for ; Sun, 19 Sep 2021 00:28:51 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:subject:date:message-id:mime-version; bh=sXqWknlaO5rR8+sQBTJ1tfnb8NEDx6pyP4//1CuVjAM=; b=SfaitBWFsTHOGqKIKDHqlm8aYlBkf8AgoWhl1WODIqdELobB7UNji+874tmgEhgqv4 dDh3nJXFG8Y//MKqRQNyNMOp8MdGD+WD2POM9ZSBDKrTuTBAKx+ivDfwuUGWbDr29dc/ GvcB++nsGlC5h2bIiffy+R5JJ9y+A6A1Su+anrtcVKunmhO9DfVifzIaC0TF/lWMdKTS 3JnNNSvUq8IzQwapIe+wXytB9L4/6b9BeBTWsG2lQbAhG2FCJAhhip4+1WpyUHOkOzR5 wSAbVMNv1dJsV7GLokqIh92+EODFhQu1jxBGLhK8A5AHP4V3VwJ0NB4teN2AVY9/IwTA pI3Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:subject:date:message-id:mime-version; bh=sXqWknlaO5rR8+sQBTJ1tfnb8NEDx6pyP4//1CuVjAM=; b=amW141z38Xt5CJ+71kc0k5r2Y5S89YFKq5JykETBFp7bus8R5Dcg04EfsJZEb+ctbx /NNsAB00gGx1lPcTaJJoPEhJInbKiF8OEOUSdTORd633ovz8UZI0tZBgvedItdo+5iR7 5NewVLJRooNxiuVGt+84xqZBeaasiiM4U8NGpq6Z0ml9ayPTk0g2xxbwj8AmbIkau4Nk gEwXfcz9h9Tzs43Di7ETztBafW2VGJLlZw2D77GCq/oVIClUbg9xpKJ1AYA5QfcISBPO pvQEtatyOxyA+s1dnLB5v8WOMorYrRWq4c5/tuMyXfwAZd1s0nPW0hIWR5WY3rS5/OQJ KS6Q== X-Gm-Message-State: AOAM531FQlbyDF4o7wLIKDn/By/hIa8At3VCAmXv11ndsQaTHSa87UKb ZIeMd6R+v0iWXd+D2BGsdkvJLHt69Xb0ZZCA X-Google-Smtp-Source: ABdhPJx1hLj1XYZ08KhUwJg2PeF+8jgk/L2ERcC0xHS+V4iRYvyxc3YN5ILvE/LeEJDGrDbG837TVQ== X-Received: by 2002:a17:902:c789:b0:13c:937b:a5ce with SMTP id w9-20020a170902c78900b0013c937ba5cemr17079792pla.75.1632036529722; Sun, 19 Sep 2021 00:28:49 -0700 (PDT) Received: from localhost ([160.202.160.104]) by smtp.gmail.com with ESMTPSA id v8sm14424384pjh.24.2021.09.19.00.28.45 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 19 Sep 2021 00:28:48 -0700 (PDT) From: Ihor Radchenko To: emacs-orgmode@gnu.org Subject: [feature proposal] Headline caching via org-element-cache = up to 2.5x performance boost X-Woof-Help: yes Date: Sun, 19 Sep 2021 15:30:01 +0800 Message-ID: <87bl4p6n0m.fsf@localhost> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Received-SPF: pass client-ip=2607:f8b0:4864:20::1032; envelope-from=yantar92@gmail.com; helo=mail-pj1-x1032.google.com X-Spam_score_int: -17 X-Spam_score: -1.8 X-Spam_bar: - X-Spam_report: (-1.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_ENVFROM_END_DIGIT=0.25, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-orgmode@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+larch=yhetil.org@gnu.org Sender: "Emacs-orgmode" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1632036579; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=BaHVFH7yE9JX2ky2YcbzelS4Xm7i0LUF1999kCB6cNA=; b=GmqoYf0Pgg5K9k4R2jEvz7vqwcPRimlFqfyGieJO/EfXTzXowtiWwT/mpvGHGRSFDqf77/ SSGIkSJuao5cMBDZPedXdwmfbbXUkyX3gWsfto1+O4peCo50fnjjpe4d16kmv2UgHbE/mh /6DhBSjMFiZ9nshmB2PbCfp8e1P3eyqFAmTdA7/RqvYfWq7sb/gAczm2gqy6ub4bx1CYTV Xgb7cW2vJhm1z3kv3vhYOIWiqJ9Vyzd8WvjOf/BRfzW26mBHHW2wd6wVdxzoEEHB49i9pE Rj1FuJpn/tw72p7r8g3pDxSNMDcTvf0DSKzjBIX20tcyOodEm7sPdvmVrJZdOg== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1632036579; a=rsa-sha256; cv=none; b=lDtngZBAId2GxjHIZ7k2EcWagkmli94RANcrIk+5h8/fDT0l4ZbUNazsVBJxrPJs2FJu2x +ya2i7ENT6c0IoZaGb0rAHBpwnG9uvaHJEDUOHu0vntawOaIW+RBUyfCjDDLmhmsBtVsum 13bMCwq/Rx61Gq/R8sRC3dIViI7unoAupzooh5Zs6StNpKLAHFAN136ip+ftnFdNGIGoE1 BwnhVOHobAKyQRu5eH0BBtiadTKfB7xnURukmRE8AohyQR2Ep6ubaNPWdZT1ewYQPFLuPz Ub07IRbRTAeUyhEvRw1TedXwj1rA1oDWj1/re52fmBZH/yvOEtbSwzGL98hxBw== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20210112 header.b=SfaitBWF; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none); spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Migadu-Spam-Score: -0.79 Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20210112 header.b=SfaitBWF; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none); spf=pass (aspmx1.migadu.com: domain of emacs-orgmode-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=emacs-orgmode-bounces@gnu.org X-Migadu-Queue-Id: 8E96F11107 X-Spam-Score: -0.79 X-Migadu-Scanner: scn0.migadu.com X-TUID: EsKGfr7tXqmO --=-=-= Content-Type: text/plain Hi Org, I would like to propose adding support of storing headlines in org-element-cache. Currently, org-element-cache only stores elements within individual sections. Storing headlines in cache would open various possibilities to improve Org performance: tag inheritance, property inheritance, category queries, id lookup, refile targets, agenda views, etc could all make use of cache. I am not proposing a mere idea, but have an actual working (WIP) code in: https://github.com/yantar92/org. Also, I am attaching a reference patch for org-element.el (the actual branch contains more changes). Some preliminary benchmarks: 1. Complex agenda - with cache: 12.165218664 sec - without cache: 16.703388763 sec 2. Tangling org file with many (570) code blocks: - with cache: 2.886041933 sec - without cache: 6.093907514 sec 3. Archiving heading from a huge org file with many categories - with cache: 0.6030461106 sec - without cache: 1.0111324396 sec 4. Complex search query in a huge org file: - with cache (via org-element-cache-map): 0.41087909697 sec - without cache (via org-ql): 1.07440562674 sec TBD. org-id lookups and org-refile-cache ----- Moreover, the cache can persist across Emacs sessions, so we do not need to care about initial cache population. See org-element-cache-persistent and org-element-cache-path. ----- The current state of the branch is satisfactory and I am able to use it daily in my own system. However, the cache code is notoriously difficult to debug. The original cache implementation has several bugs to start with. While fixing those, I kept seeing more bugs for a very long time. I am not yet sure that the new code is completely bug-free, though I do not see issues anymore in my setup. ---- If there is any interest in merging this work to Org, I will need the community help to catch any leftover bugs. The cache is now supplied with self-consistency checks that can catch errors and report backtrace. The self-consistency checks are enabled by default for now. Any issues will be reported as Emacs warnings. See org-element--cache-self-verify, org-element--cache-self-verify-frequency, org-element--cache-diagnostics-level, and org-element--cache-diagnostics-ring-size for details. ---- Note that self-consistency checks do slow down the cache. Setting org-element--cache-self-verify to nil will showcase the true performance. However, I am not confident enough in the code to disable self-checks by default. ----- Also, I have made several changes to org parser and org API in order to make cache more useful. If there are any objections to the changes, I would like to hear them. ----- 1. I introduced a new element: org-data. In a way, org-data is already used as a placeholder element in org-element-parse-buffer. I extended the idea further and made org-data contain actual properties. Similar to headline elements, org-data contains property list with contents of the top property drawer. Also, category parser not lives inside org-element, unlike original implementation from org.el that had little interaction with org-element API. 2. I added new standard properties to Org elements: :robust-begin, :robust-end, :cached, :mode, :org-element--cache-sync-key, and :granularity. They greatly reduced complexity of cache implementation. 3. headline/org-data properties are now aware about accumulated property values (PROPERTY/PROPERTY+ style). PROPERTY+ lines of the property drawers are now all merged into :PROPERTY headline/org-data element property. 4. org-element-at-point is now guaranteed to return the correct :parent property all the way up to org-data. org-element-at-point now accepts an extra argument preventing it from synchronising the cache. 5. New function: org-element-at-point-no-context. It behaves similar to old org-element-at-point - :parent properties are not guaranteed to be correct. 6. New function: org-element-cache-map. It is similar to org-element-map, but operates on cache. Looking forward for the feedback. Best, Ihor --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: inline; filename=org-cache-new-org-element.patch Content-Transfer-Encoding: quoted-printable diff --git a/lisp/org-element.el b/lisp/org-element.el index 2dfbaea24..f1bc80810 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -59,9 +59,11 @@ ;;; Commentary: ;;; Code: =20 (require 'avl-tree) +(require 'ring) (require 'cl-lib) (require 'ol) (require 'org) +(require 'org-id) (require 'org-compat) (require 'org-entities) (require 'org-footnote) @@ -245,7 +247,7 @@ (defconst org-element-all-elements (defconst org-element-greater-elements '(center-block drawer dynamic-block footnote-definition headline inlinet= ask item plain-list property-drawer quote-block section - special-block table) + special-block table org-data) "List of recursive element types aka Greater Elements.") =20 (defconst org-element-all-objects @@ -473,7 +475,14 @@ (defsubst org-element-type (element) ((not (consp element)) (and (stringp element) 'plain-text)) ((symbolp (car element)) (car element)))) =20 -(defsubst org-element-property (property element) +(defsubst org-element-put-property (element property value) + "In ELEMENT set PROPERTY to VALUE. +Return modified element." + (if (stringp element) (org-add-props element nil property value) + (setcar (cdr element) (plist-put (nth 1 element) property value)) + element)) + +(defun org-element-property (property element) "Extract the value from the PROPERTY of an ELEMENT." (if (stringp element) (get-text-property 0 property element) (plist-get (nth 1 element) property))) @@ -491,13 +500,6 @@ (defsubst org-element-restriction (element) (cdr (assq (if (symbolp element) element (org-element-type element)) org-element-object-restrictions))) =20 -(defsubst org-element-put-property (element property value) - "In ELEMENT set PROPERTY to VALUE. -Return modified 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's contents to CONTENTS. Return ELEMENT." @@ -612,11 +614,18 @@ (defun org-element-insert-before (element location) ;; Set appropriate :parent property. (org-element-put-property element :parent parent))) =20 +(defconst org-element--cache-element-properties '(:cached + :org-element--cache-sync-key) + "List of element properties used internally by cache.") + (defun org-element-set-element (old new) "Replace element or object OLD with element or object NEW. The function takes care of setting `:parent' property for NEW." ;; Ensure OLD and NEW have the same parent. (org-element-put-property new :parent (org-element-property :parent old)) + (dolist (p org-element--cache-element-properties) + (when (org-element-property p old) + (org-element-put-property new p (org-element-property p old)))) (if (or (memq (org-element-type old) '(plain-text nil)) (memq (org-element-type new) '(plain-text nil))) ;; We cannot replace OLD with NEW since one of them is not an @@ -944,24 +953,34 @@ (defun org-element-footnote-definition-interpreter (f= ootnote-definition contents (if (=3D pre-blank 0) (concat " " (org-trim contents)) (concat (make-string pre-blank ?\n) contents))))) =20 - ;;;; Headline =20 -(defun org-element--get-node-properties () +(defun org-element--get-node-properties (&optional at-point-p?) "Return node properties associated to headline at point. Upcase property names. It avoids confusion between properties obtained through property drawer and default properties from the parser (e.g. `:end' and :END:). Return value is a plist." (save-excursion - (forward-line) - (when (looking-at-p org-planning-line-re) (forward-line)) + (unless at-point-p? + (forward-line) + (when (looking-at-p org-planning-line-re) (forward-line))) (when (looking-at org-property-drawer-re) (forward-line) (let ((end (match-end 0)) properties) (while (< (line-end-position) end) (looking-at org-property-re) - (push (match-string-no-properties 3) properties) - (push (intern (concat ":" (upcase (match-string 2)))) properties) + (let* ((property-name (concat ":" (upcase (match-string 2)))) + (property-name-symbol (intern property-name)) + (property-value (match-string-no-properties 3))) + (cond + ((and (plist-member properties property-name-symbol) + (string-match-p "+$" property-name)) + (let ((val (plist-get properties property-name-symbol))) + (if (listp val) + (setf (plist-get properties property-name-symbol) + (append (plist-get properties property-name-symb= ol) (list property-value))) + (plist-put properties property-name-symbol (list val pro= perty-value))))) + (t (setq properties (plist-put properties property-name-symbo= l property-value))))) (forward-line)) properties)))) =20 @@ -983,7 +1002,7 @@ (defun org-element--get-time-properties () (t (setq plist (plist-put plist :closed time)))))) plist)))) =20 -(defun org-element-headline-parser (limit &optional raw-secondary-p) +(defun org-element-headline-parser (&optional _ raw-secondary-p) "Parse a headline. =20 Return a list whose CAR is `headline' and CDR is a plist @@ -998,8 +1017,6 @@ (defun org-element-headline-parser (limit &optional ra= w-secondary-p) with its name in upper cases and colons added at the beginning (e.g., `:CUSTOM_ID'). =20 -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. =20 @@ -1021,7 +1038,10 @@ (defun org-element-headline-parser (limit &optional = raw-secondary-p) (commentedp (and (let (case-fold-search) (looking-at org-comment-string)) (goto-char (match-end 0)))) - (title-start (point)) + (title-start (prog1 (point) + (unless (or todo priority commentedp) + ;; Headline like "* :tag:" + (skip-syntax-backward " \t")))) (tags (when (re-search-forward "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" (line-end-position) @@ -1036,7 +1056,17 @@ (defun org-element-headline-parser (limit &optional = raw-secondary-p) (string=3D org-footnote-section raw-value))) (standard-props (org-element--get-node-properties)) (time-props (org-element--get-time-properties)) - (end (min (save-excursion (org-end-of-subtree t t)) limit)) + (end (save-excursion + ;; Make sure that `org-end-of-subtree' does not try + ;; to use cache. The headline parser might be + ;; called in the midst of cache processing. + ;; FIXME: We cannot simply bind `org-element-use-cache' = here + ;; because apparently some magic related to lexical + ;; scoping prevents `org-element--cache-active-p' call i= nside + ;; `org-end-of-subtree' to use the overridden value + ;; of `org-element-use-cache'. + (cl-letf (((symbol-function #'org-element--cache-active-= p) (lambda () nil))) + (org-end-of-subtree t t)))) (contents-begin (save-excursion (forward-line) (skip-chars-forward " \r\t\n" end) @@ -1044,7 +1074,24 @@ (defun org-element-headline-parser (limit &optional = raw-secondary-p) (contents-end (and contents-begin (progn (goto-char end) (skip-chars-backward " \r\t\n") - (line-beginning-position 2))))) + (line-beginning-position 2)))) + (robust-begin (and contents-begin + (progn (goto-char contents-begin) + (when (looking-at-p org-planning-line= -re) + (forward-line)) + (when (looking-at org-property-drawer= -re) + (goto-char (match-end 0))) + ;; If there is :pre-blank, we + ;; need to be careful about + ;; robust beginning. + (max (if (< (+ 2 contents-begin) cont= ents-end) + (+ 2 contents-begin) + 0) + (point))))) + (robust-end (and robust-begin + (when (> (- contents-end 2) robust-begin) + (- contents-end 2))))) + (unless robust-end (setq robust-begin nil)) (let ((headline (list 'headline (nconc @@ -1056,6 +1103,8 @@ (defun org-element-headline-parser (limit &optional r= aw-secondary-p) (1- (count-lines begin contents-begin))) :contents-begin contents-begin :contents-end contents-end + :robust-begin robust-begin + :robust-end robust-end :level level :priority priority :tags tags @@ -1128,6 +1177,79 @@ (defun org-element-headline-interpreter (headline co= ntents) (make-string (1+ pre-blank) ?\n) contents))) =20 +;;;; org-data + +(defun org-element--get-global-node-properties () + "Return node properties associated with the whole Org buffer. +Upcase property names. It avoids confusion between properties +obtained through property drawer and default properties from the +parser (e.g. `:end' and :END:). Return value is a plist." + (org-with-wide-buffer + (goto-char (point-min)) + (while (and (org-at-comment-p) (bolp)) (forward-line)) + (org-element--get-node-properties t))) + +(defun org-element-org-data-parser (&optional _) + "Parse org-data." + (org-with-wide-buffer + (let* ((begin 1) + (contents-begin (progn + (goto-char 1) + (org-skip-whitespace) + (beginning-of-line) + (point))) + (end (point-max)) + (pos-before-blank (progn (goto-char (point-max)) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2))) + (robust-end (when (> (- pos-before-blank 2) contents-begin) + (- pos-before-blank 2))) + (robust-begin (when (and robust-end + (< (+ 2 contents-begin) pos-before-blan= k)) + (or + (org-with-wide-buffer + (goto-char (point-min)) + (while (and (org-at-comment-p) (bolp)) (forwar= d-line)) + (when (looking-at org-property-drawer-re) + (goto-char (match-end 0)) + (skip-chars-backward " \t") + (min robust-end (point)))) + (+ 2 contents-begin)))) + (category (cond ((null org-category) + (when buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)))) + ((symbolp org-category) (symbol-name org-category)) + (t org-category))) + (category (catch 'buffer-category + (org-with-point-at end + (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-= min) t) + (let ((element (org-element-at-point-no-context))) + (when (eq (org-element-type element) 'keyword) + (throw 'buffer-category + (org-element-property :value element)))))) + category)) + (properties (org-element--get-global-node-properties))) + (unless (plist-get properties :CATEGORY) + (setq properties (plist-put properties :CATEGORY category))) + (list 'org-data + (nconc + (list :begin begin + :contents-begin contents-begin + :contents-end pos-before-blank + :end end + :robust-begin robust-begin + :robust-end robust-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated begin + :path (buffer-file-name) + :mode 'org-data) + properties))))) + +(defun org-element-org-data-interpreter (_ contents) + "Interpret ORG-DATA element as Org syntax. +CONTENTS is the contents of the element." + contents) =20 ;;;; Inlinetask =20 @@ -1283,69 +1405,69 @@ (defun org-element-item-parser (_ struct &optional = raw-secondary-p) Assume point is at the beginning of the item." (save-excursion (beginning-of-line) - (looking-at org-list-full-item-re) - (let* ((begin (point)) - (bullet (match-string-no-properties 1)) - (checkbox (let ((box (match-string 3))) - (cond ((equal "[ ]" box) 'off) - ((equal "[X]" box) 'on) - ((equal "[-]" box) 'trans)))) - (counter (let ((c (match-string 2))) - (save-match-data - (cond - ((not c) nil) - ((string-match "[A-Za-z]" c) - (- (string-to-char (upcase (match-string 0 c))) - 64)) - ((string-match "[0-9]+" c) - (string-to-number (match-string 0 c))))))) - (end (progn (goto-char (nth 6 (assq (point) struct))) - (if (bolp) (point) (line-beginning-position 2)))) - (pre-blank 0) - (contents-begin - (progn - (goto-char - ;; Ignore tags in un-ordered lists: they are just - ;; a part of item's body. - (if (and (match-beginning 4) - (save-match-data (string-match "[.)]" bullet))) - (match-beginning 4) - (match-end 0))) - (skip-chars-forward " \r\t\n" end) - (cond ((=3D (point) end) nil) - ;; If first line isn't empty, contents really - ;; start at the text after item's meta-data. - ((=3D (line-beginning-position) begin) (point)) - (t - (setq pre-blank - (count-lines (line-beginning-position) begin)) - (line-beginning-position))))) - (contents-end (and contents-begin - (progn (goto-char end) - (skip-chars-backward " \r\t\n") - (line-beginning-position 2)))) - (item - (list 'item - (list :bullet bullet - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :checkbox checkbox - :counter counter - :structure struct - :pre-blank pre-blank - :post-blank (count-lines (or contents-end begin) end) - :post-affiliated begin)))) - (org-element-put-property - item :tag - (let ((raw (org-list-get-tag begin struct))) - (when raw - (if raw-secondary-p raw - (org-element--parse-objects - (match-beginning 4) (match-end 4) nil - (org-element-restriction 'item) - item)))))))) + (when (looking-at org-list-full-item-re) + (let* ((begin (point)) + (bullet (match-string-no-properties 1)) + (checkbox (let ((box (match-string 3))) + (cond ((equal "[ ]" box) 'off) + ((equal "[X]" box) 'on) + ((equal "[-]" box) 'trans)))) + (counter (let ((c (match-string 2))) + (save-match-data + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c))))))) + (end (progn (goto-char (nth 6 (assq (point) struct))) + (if (bolp) (point) (line-beginning-position 2)))) + (pre-blank 0) + (contents-begin + (progn + (goto-char + ;; Ignore tags in un-ordered lists: they are just + ;; a part of item's body. + (if (and (match-beginning 4) + (save-match-data (string-match "[.)]" bullet))) + (match-beginning 4) + (match-end 0))) + (skip-chars-forward " \r\t\n" end) + (cond ((=3D (point) end) nil) + ;; If first line isn't empty, contents really + ;; start at the text after item's meta-data. + ((=3D (line-beginning-position) begin) (point)) + (t + (setq pre-blank + (count-lines (line-beginning-position) begin)) + (line-beginning-position))))) + (contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + (item + (list 'item + (list :bullet bullet + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :checkbox checkbox + :counter counter + :structure struct + :pre-blank pre-blank + :post-blank (count-lines (or contents-end begin) end) + :post-affiliated begin)))) + (org-element-put-property + item :tag + (let ((raw (org-list-get-tag begin struct))) + (when raw + (if raw-secondary-p raw + (org-element--parse-objects + (match-beginning 4) (match-end 4) nil + (org-element-restriction 'item) + item))))))))) =20 (defun org-element-item-interpreter (item contents) "Interpret ITEM element as Org syntax. @@ -1397,7 +1519,12 @@ (defun org-element--list-struct (limit) (let ((case-fold-search t) (top-ind limit) (item-re (org-item-re)) - (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ ")) + (inlinetask-re (and (featurep 'org-inlinetask) + (boundp 'org-inlinetask-min-level) + (boundp 'org-inlinetask-max-level) + (format "^\\*\\{%d,%d\\}+ " + org-inlinetask-min-level + org-inlinetask-max-level))) items struct) (save-excursion (catch :exit @@ -1622,16 +1749,22 @@ (defun org-element-section-parser (_) (save-excursion ;; Beginning of section is the beginning of the first non-blank ;; line after previous headline. - (let ((begin (point)) - (end (progn (org-with-limited-levels (outline-next-heading)) - (point))) - (pos-before-blank (progn (skip-chars-backward " \r\t\n") - (line-beginning-position 2)))) + (let* ((begin (point)) + (end (progn (org-with-limited-levels (outline-next-heading)) + (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (line-beginning-position 2))) + (robust-end (when (> (- pos-before-blank 2) begin) + (- pos-before-blank 2))) + (robust-begin (when robust-end begin)) + ) (list 'section (list :begin begin :end end :contents-begin begin :contents-end pos-before-blank + :robust-begin robust-begin + :robust-end robust-end :post-blank (count-lines pos-before-blank end) :post-affiliated begin))))) =20 @@ -3958,7 +4091,7 @@ ;;; Parsing Element Starting At Point ;; It returns the Lisp representation of the element starting at ;; point. =20 -(defun org-element--current-element (limit &optional granularity mode stru= cture) +(defun org-element--current-element (limit &optional granularity mode stru= cture add-to-cache) "Parse the element starting at point. =20 Return value is a list like (TYPE PROPS) where TYPE is the type @@ -3983,157 +4116,196 @@ (defun org-element--current-element (limit &optio= nal granularity mode structure) If STRUCTURE isn't provided but MODE is set to `item', it will be computed. =20 +Optional argument ADD-TO-CACHE, when non-nil, and when cache is active, +will also add current element to cache if it is not yet there. Use +this argument with care, as validity of the element in parse tree is +not checked. + This function assumes point is always at the beginning of the element it has to parse." - (save-excursion - (let ((case-fold-search t) - ;; Determine if parsing depth allows for secondary strings - ;; parsing. It only applies to elements referenced in - ;; `org-element-secondary-value-alist'. - (raw-secondary-p (and granularity (not (eq granularity 'object))))) - (cond - ;; Item. - ((eq mode 'item) - (org-element-item-parser limit structure raw-secondary-p)) - ;; Table Row. - ((eq mode 'table-row) (org-element-table-row-parser limit)) - ;; Node Property. - ((eq mode '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)) - ;; Sections (must be checked after headline). - ((eq mode 'section) (org-element-section-parser limit)) - ((eq mode 'first-section) - (org-element-section-parser - (or (save-excursion (org-with-limited-levels (outline-next-heading))) - limit))) - ;; Comments. - ((looking-at "^[ \t]*#\\(?: \\|$\\)") - (org-element-comment-parser limit)) - ;; Planning. - ((and (eq mode 'planning) - (eq ?* (char-after (line-beginning-position 0))) - (looking-at org-planning-line-re)) - (org-element-planning-parser limit)) - ;; Property drawer. - ((and (pcase mode - (`planning (eq ?* (char-after (line-beginning-position 0)))) - ((or `property-drawer `top-comment) - (save-excursion - (beginning-of-line 0) - (not (looking-at "[[:blank:]]*$")))) - (_ nil)) - (looking-at org-property-drawer-re)) - (org-element-property-drawer-parser 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 (list (point)))) - ;; Clock. - ((looking-at org-clock-line-re) (org-element-clock-parser limit)) - ;; Inlinetask. - ((looking-at "^\\*+ ") - (org-element-inlinetask-parser limit raw-secondary-p)) - ;; From there, elements can have affiliated keywords. - (t (let ((affiliated (org-element--collect-affiliated-keywords - limit (memq granularity '(nil object))))) - (cond - ;; Jumping over affiliated keywords put point off-limits. - ;; Parse them as regular keywords. - ((and (cdr affiliated) (>=3D (point) limit)) - (goto-char (car affiliated)) - (org-element-keyword-parser limit nil)) - ;; LaTeX Environment. - ((looking-at org-element--latex-begin-environment) - (org-element-latex-environment-parser limit affiliated)) - ;; Drawer. - ((looking-at org-drawer-regexp) - (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 "BEGIN_\\(\\S-+\\)") - (beginning-of-line) - (funcall (pcase (upcase (match-string 1)) - ("CENTER" #'org-element-center-block-parser) - ("COMMENT" #'org-element-comment-block-parser) - ("EXAMPLE" #'org-element-example-block-parser) - ("EXPORT" #'org-element-export-block-parser) - ("QUOTE" #'org-element-quote-block-parser) - ("SRC" #'org-element-src-block-parser) - ("VERSE" #'org-element-verse-block-parser) - (_ #'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. - ((or (looking-at "[ \t]*|") - ;; There is no strict definition of a table.el - ;; table. Try to prevent false positive while being - ;; quick. - (let ((rule-regexp - (rx (zero-or-more (any " \t")) - "+" - (one-or-more (one-or-more "-") "+") - (zero-or-more (any " \t")) - eol)) - (non-table.el-line - (rx bol - (zero-or-more (any " \t")) - (or eol (not (any "+| \t"))))) - (next (line-beginning-position 2))) - ;; Start with a full rule. - (and - (looking-at rule-regexp) - (< next limit) ;no room for a table.el table - (save-excursion - (end-of-line) - (cond - ;; Must end with a full rule. - ((not (re-search-forward non-table.el-line limit 'move)) - (if (bolp) (forward-line -1) (beginning-of-line)) - (looking-at rule-regexp)) - ;; Ignore pseudo-tables with a single - ;; rule. - ((=3D next (line-beginning-position)) - nil) - ;; Must end with a full rule. - (t - (forward-line -1) - (looking-at rule-regexp))))))) - (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))))))))) + (if-let* ((element (and (not (buffer-narrowed-p)) + (org-element--cache-active-p) + (not org-element--cache-sync-requests) + (org-element--cache-find (point) t))) + (element (progn (while (and element + (not (and (eq (point) (org-element= -property :begin element)) + (eq mode (org-element-prop= erty :mode element))))) + (setq element (org-element-property :parent = element))) + element)) + (old-element element) + (element (when + (pcase (org-element-property :granularity element) + (`nil t) + (`object t) + (`element (not (memq granularity '(nil object))= )) + (`greater-element (not (memq granularity '(nil = object element)))) + (`headline (eq granularity 'headline))) + element))) + element + (save-excursion + (let ((case-fold-search t) + ;; Determine if parsing depth allows for secondary strings + ;; parsing. It only applies to elements referenced in + ;; `org-element-secondary-value-alist'. + (raw-secondary-p (and granularity (not (eq granularity 'object)))) + result) + (setq + result + (cond + ;; Item. + ((eq mode 'item) + (org-element-item-parser limit structure raw-secondary-p)) + ;; Table Row. + ((eq mode 'table-row) (org-element-table-row-parser limit)) + ;; Node Property. + ((eq mode 'node-property) (org-element-node-property-parser limi= t)) + ;; Headline. + ((org-with-limited-levels (org-at-heading-p)) + (org-element-headline-parser limit raw-secondary-p)) + ;; Sections (must be checked after headline). + ((eq mode 'section) (org-element-section-parser limit)) + ((eq mode 'first-section) + (org-element-section-parser + (or (save-excursion (org-with-limited-levels (outline-next-heading))) + limit))) + ;; Comments. + ((looking-at "^[ \t]*#\\(?: \\|$\\)") + (org-element-comment-parser limit)) + ;; Planning. + ((and (eq mode 'planning) + (eq ?* (char-after (line-beginning-position 0))) + (looking-at org-planning-line-re)) + (org-element-planning-parser limit)) + ;; Property drawer. + ((and (pcase mode + (`planning (eq ?* (char-after (line-beginning-position 0)))) + ((or `property-drawer `top-comment) + (save-excursion + (beginning-of-line 0) + (not (looking-at "[[:blank:]]*$")))) + (_ nil)) + (looking-at org-property-drawer-re)) + (org-element-property-drawer-parser 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 (list (point))= )) + ;; Clock. + ((looking-at org-clock-line-re) (org-element-clock-parser limit)) + ;; Inlinetask. + ((looking-at "^\\*+ ") + (org-element-inlinetask-parser limit raw-secondary-p)) + ;; From there, elements can have affiliated keywords. + (t (let ((affiliated (org-element--collect-affiliated-keywords + limit (memq granularity '(nil object))))) + (cond + ;; Jumping over affiliated keywords put point off-limits. + ;; Parse them as regular keywords. + ((and (cdr affiliated) (>=3D (point) limit)) + (goto-char (car affiliated)) + (org-element-keyword-parser limit nil)) + ;; LaTeX Environment. + ((looking-at org-element--latex-begin-environment) + (org-element-latex-environment-parser limit affiliated)) + ;; Drawer. + ((looking-at org-drawer-regexp) + (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 "BEGIN_\\(\\S-+\\)") + (beginning-of-line) + (funcall (pcase (upcase (match-string 1)) + ("CENTER" #'org-element-center-block-parser) + ("COMMENT" #'org-element-comment-block-parser) + ("EXAMPLE" #'org-element-example-block-parser) + ("EXPORT" #'org-element-export-block-parser) + ("QUOTE" #'org-element-quote-block-parser) + ("SRC" #'org-element-src-block-parser) + ("VERSE" #'org-element-verse-block-parser) + (_ #'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. + ((or (looking-at "[ \t]*|") + ;; There is no strict definition of a table.el + ;; table. Try to prevent false positive while being + ;; quick. + (let ((rule-regexp + (rx (zero-or-more (any " \t")) + "+" + (one-or-more (one-or-more "-") "+") + (zero-or-more (any " \t")) + eol)) + (non-table.el-line + (rx bol + (zero-or-more (any " \t")) + (or eol (not (any "+| \t"))))) + (next (line-beginning-position 2))) + ;; Start with a full rule. + (and + (looking-at rule-regexp) + (< next limit) ;no room for a table.el table + (save-excursion + (end-of-line) + (cond + ;; Must end with a full rule. + ((not (re-search-forward non-table.el-line limit 'move)) + (if (bolp) (forward-line -1) (beginning-of-line)) + (looking-at rule-regexp)) + ;; Ignore pseudo-tables with a single + ;; rule. + ((=3D next (line-beginning-position)) + nil) + ;; Must end with a full rule. + (t + (forward-line -1) + (looking-at rule-regexp))))))) + (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))))))) + (when result + (org-element-put-property result :mode mode) + (org-element-put-property result :granularity granularity)) + (when (and (not (buffer-narrowed-p)) + (org-element--cache-active-p) + (not org-element--cache-sync-requests) + add-to-cache) + (if (not old-element) + (setq result (org-element--cache-put result)) + (org-element-set-element old-element result) + (setq result old-element))) + result)))) =20 =20 ;; Most elements can have affiliated keywords. When looking for an @@ -4148,6 +4320,8 @@ (defun org-element--collect-affiliated-keywords (limi= t parse) CDR a plist of keywords and values and move point to the beginning of the first line after them. =20 +The plist of keywords preserves their order. + 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. @@ -4202,7 +4376,7 @@ (defun org-element--collect-affiliated-keywords (limi= t parse) (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)))) + (setq value (append (plist-get output kwd-sym) (list value)))) ;; Eventually store the new value in OUTPUT. (setq output (plist-put output kwd-sym value)) ;; Move to next keyword. @@ -4274,12 +4448,13 @@ (defun org-element-parse-buffer (&optional granular= ity visible-only) This function assumes that current major mode is `org-mode'." (save-excursion (goto-char (point-min)) - (org-skip-whitespace) - (org-element--parse-elements - (point-at-bol) (point-max) - ;; Start in `first-section' mode so text before the first - ;; headline belongs to a section. - 'first-section nil granularity visible-only (list 'org-data nil)))) + (let ((org-data (org-element-org-data-parser))) + (org-skip-whitespace) + (org-element--parse-elements + (point-at-bol) (point-max) + ;; Start in `first-section' mode so text before the first + ;; headline belongs to a section. + 'first-section nil granularity visible-only org-data)))) =20 (defun org-element-parse-secondary-string (string restriction &optional pa= rent) "Recursively parse objects in STRING and return structure. @@ -4440,7 +4615,7 @@ (defun org-element-map ((not value)) ((member kwd org-element-dual-keywords) (if (member kwd org-element-multiple-keywords) - (dolist (line (reverse value)) + (dolist (line value) (funcall --walk-tree (cdr line)) (funcall --walk-tree (car line))) (funcall --walk-tree (cdr value)) @@ -4468,6 +4643,91 @@ (defun org-element-map ;; Return value in a proper order. (nreverse --acc))))) =20 +(defun org-element-cache-map (granularity func) + "Map all elements in current buffer with FUNC according to GRANULARITY. + +This function is a subset of what `org-element-map' does, but much more pe= rformant. +Cached elements are supplied as the single argument of FUNC. Changes +to elements made in FUNC will also alter the cache. + +GRANULARITY can be `headline', `greater-element', or `element'. +`object' granularity is not supported. + +If some elements are not yet in cache, they will be added." + (unless (org-element--cache-active-p) + (error "Cache must be active.")) + (org-with-wide-buffer + ;; Synchronise cache up to the end of buffer. + (org-element-at-point (point-max)) + (let ((start nil) + (prev nil) + (node (org-element--cache-root)) + (stack (list nil)) + (leftp t) + result + continue-flag) + (while node + (let ((data (avl-tree--node-data node))) + (if (and leftp (avl-tree--node-left node) + (or (not prev) + (not (org-element--cache-key-less-p + (org-element--cache-key data) + (org-element--cache-key prev))))) + (progn (push node stack) + (setq node (avl-tree--node-left node))) + (let ((type (org-element-type data)) + (beg (org-element-property :begin data)) + (end (org-element-property :end data)) + (cbeg (org-element-property :contents-begin data))) + (unless (or (and start (< beg start)) + (and prev (not (org-element--cache-key-less-p + (org-element--cache-key prev) + (org-element--cache-key data))))) + (if (or (not start) (=3D beg start)) + (progn + (pcase granularity + (`headline + (when (eq type 'headline) + (push (funcall func data) result) + (unless (car result) (pop result))) + (setq start (or (and (memq type '(headline org-data)) cbeg) + end))) + (`greater-element + (when (memq type org-element-greater-elements) + (push (funcall func data) result) + (unless (car result) (pop result))) + (setq start (or cbeg end)) + (let ((parent data)) + (catch :exit + (while (setq parent (org-element-property :parent parent)) + (if (eq start (org-element-property :contents-end parent)) + (setq start (org-element-property :end parent)) + (throw :exit t)))))) + (`element + (push (funcall func data) result) + (unless (car result) (pop result)) + (setq start (or cbeg end)) + (let ((parent data)) + (catch :exit + (while (setq parent (org-element-property :parent parent)) + (if (eq start (org-element-property :contents-end parent)) + (setq start (org-element-property :end parent)) + (throw :exit t)))))) + (_ (error "Unsupported granularity: %S" granularity))) + (setq prev data)) + (org-element--parse-to start) + (setq node (org-element--cache-root) + stack (list nil) + leftp t + continue-flag t)))) + (if continue-flag + (setq continue-flag nil) + (setq node (if (setq leftp (avl-tree--node-right node)) + (avl-tree--node-right node) + (pop stack))))))) + ;; Return result. + (nreverse result)))) + ;; The following functions are internal parts of the parser. ;; ;; The first one, `org-element--parse-elements' acts at the element's @@ -4494,6 +4754,8 @@ (defsubst org-element--next-mode (mode type parent?) (pcase type (`headline 'section) ((and (guard (eq mode 'first-section)) `section) 'top-comment) + ((and (guard (eq mode 'org-data)) `org-data) 'first-section) + ((and (guard (not mode)) `org-data) 'first-section) (`inlinetask 'planning) (`plain-list 'item) (`property-drawer 'node-property) @@ -5035,12 +5297,35 @@ ;;; Cache ;; even when the tree is only partially synchronized. =20 =20 -(defvar org-element-use-cache nil +(defvar org-element-use-cache t "Non-nil when Org parser should cache its results. =20 WARNING: for the time being, using cache sometimes triggers freezes. Therefore, it is disabled by default. Activate it if -you want to help debugging the issue.") +you want to help debugging the issue. + +UPDATE: At least part of the freezes should not happen anymore. +Hopefully, this is finally fixed, but need more testing.") + +(defvar org-element-cache-persistent t + "Non-nil when cache should persist between Emacs sessions.") + +(defvar org-element-cache-path (file-name-concat user-emacs-directory "org= -element-cache/") + "Directory where element cache is stored.") + +(defvar org-element-cache-index-file "index" + "File name used to store `org-element-cache--index'.") + +(defvar org-element-cache--index nil + "Global cache index. + +The index is a list of plists. Each plist contains information about +a file cache. Each plist contains the following properties: + +- `:path': buffer file path +- `:inode': buffer file inode +- `:hash': buffer hash +- `:cache-file': cache file name") =20 (defvar org-element-cache-sync-idle-time 0.6 "Length, in seconds, of idle time before syncing cache.") @@ -5055,16 +5340,47 @@ (defvar org-element-cache-sync-break 0.3 "Duration, as a time value, of the pause between synchronizations. See `org-element-cache-sync-duration' for more information.") =20 +(defvar org-element--cache-self-verify t + "Activate extra consistency for the cache. + +This will cause performance degradation. + +When set to symbol `backtrace', record and display backtrace log if +any inconsistency is detected.") + +(defvar org-element--cache-self-verify-frequency 0.03 + "Frequency of cache element verification. + +This number is a probability to check an element requested from cache +to be correct. Setting this to a value less than 0.0001 is useless.") + +(defvar org-element--cache-diagnostics nil + "Print detailed diagnostics of cache processing.") + +(defvar org-element--cache-diagnostics-level 2 + "Detail level of the diagnostics.") + +(defvar-local org-element--cache-diagnostics-ring nil + "Ring containing last `org-element--cache-diagnostics-ring-size' +cache process log entries.") + +(defvar org-element--cache-diagnostics-ring-size 5000 + "Size of `org-element--cache-diagnostics-ring'.") =20 ;;;; Data Structure =20 -(defvar org-element--cache nil +(defvar-local org-element--cache nil "AVL tree used to cache elements. Each node of the tree contains an element. Comparison is done with `org-element--cache-compare'. This cache is used in `org-element-at-point'.") =20 -(defvar org-element--cache-sync-requests nil +(defvar-local org-element--cache-size 0 + "Size of the `org-element--cache'. + +Storing value is variable is faster because `avl-tree-size' is O(N).") + +(defvar-local org-element--cache-sync-requests nil "List of pending synchronization requests. =20 A request is a vector with the following pattern: @@ -5081,7 +5397,10 @@ (defvar org-element--cache-sync-requests nil removed, BEG and END is buffer position delimiting the modifications. Elements starting between them (inclusive) are removed. So are elements whose parent is removed. PARENT, when -non-nil, is the parent of the first element to be removed. +non-nil, is the common parent of all the elements between BEG and END. + +It is guaranteed that only a single phase 0 request exists at any +moment of time. If it does, it must be the first request in the list. =20 During phase 1, NEXT is the key of the next known element in cache and BEG its beginning position. Parse buffer between that @@ -5090,18 +5409,112 @@ (defvar org-element--cache-sync-requests nil =20 During phase 2, NEXT is the key of the next element to shift in the parse tree. All elements starting from this one have their -properties relatives to buffer positions shifted by integer +properties relative to buffer positions shifted by integer OFFSET and, if they belong to element PARENT, are adopted by it. =20 -PHASE specifies the phase number, as an integer.") +PHASE specifies the phase number, as an integer. + +For any synchronisation request, all the later requests in the cache +must not start at or before END. See `org-element--cache-submit-request'.= ") =20 -(defvar org-element--cache-sync-timer nil +(defvar-local org-element--cache-sync-timer nil "Timer used for cache synchronization.") =20 -(defvar org-element--cache-sync-keys nil - "Hash table used to store keys during synchronization. +(defvar-local org-element--cache-sync-keys-value nil + "Id value used to identify keys during synchronisation. See `org-element--cache-key' for more information.") =20 +(defvar-local org-element--cache-change-tic nil + "Last `buffer-chars-modified-tick' for registered changes.") + +(defvar org-element--cache-non-modifying-commands '(org-agenda + org-agenda-redo + org-sparse-tree + org-occur + org-columns + org-columns-redo + org-columns-new + org-columns-delete + org-columns-compute + org-columns-insert-dblock + org-agenda-columns + org-ctrl-c-ctrl-c) + "List of commands that are not expected to change the cache state. + +This variable is used to determine when re-parsing buffer is not going +to slow down the command. + +If the commends end up modifying the cache, the worst case scenario is +performance drop. So, advicing these commands is safe. Yet, it is +better to remove the commands adviced in such way from this list.") + +(defmacro org-element--request-key (request) + "Get NEXT part of a `org-element--cache-sync-requests' REQUEST." + `(aref ,request 0)) + +(defmacro org-element--request-beg (request) + "Get BEG part of a `org-element--cache-sync-requests' REQUEST." + `(aref ,request 1)) + +(defmacro org-element--request-end (request) + "Get END part of a `org-element--cache-sync-requests' REQUEST." + `(aref ,request 2)) + +(defmacro org-element--request-offset (request) + "Get OFFSET part of a `org-element--cache-sync-requests' REQUEST." + `(aref ,request 3)) + +(defmacro org-element--request-parent (request) + "Get PARENT part of a `org-element--cache-sync-requests' REQUEST." + `(aref ,request 4)) + +(defmacro org-element--request-phase (request) + "Get PHASE part of a `org-element--cache-sync-requests' REQUEST." + `(aref ,request 5)) + +(defmacro org-element--format-element (element) + "Format ELEMENT for printing in diagnostics." + `(let ((print-length 50) + (print-level 5)) + (prin1-to-string ,element))) + +(cl-defmacro org-element--cache-log-message (format-string &rest args &key= (level 1) &allow-other-keys) + "Add a new log message for org-element-cache." + `(when (and + (<=3D ,level org-element--cache-diagnostics-level) + (or org-element--cache-diagnostics + (eq org-element--cache-self-verify 'backtrace))) + (let* ((format-string (concat (format "org-element-cache diagnostics(= %s): " + (buffer-name (current-buffer))) + ,format-string)) + (format-string (funcall #'format format-string ,@args))) + (if org-element--cache-diagnostics + (warn "%s" format-string) + (unless org-element--cache-diagnostics-ring + (setq org-element--cache-diagnostics-ring + (make-ring org-element--cache-diagnostics-ring-size))) + (ring-insert org-element--cache-diagnostics-ring format-string)))= )) + +(defmacro org-element--cache-warn (format-string &rest args) + "Raise warning for org-element-cache." + `(let* ((format-string (funcall #'format ,format-string ,@args)) + (format-string + (if (or (not org-element--cache-diagnostics-ring) + (not (eq 'backtrace org-element--cache-self-verify))) + format-string + (prog1 + (concat (format "Warning(%s): " + (buffer-name (current-buffer))) + format-string + "\nBacktrace:\n " + (mapconcat #'identity + (ring-elements org-element--cache-diag= nostics-ring) + "\n ")) + (setq org-element--cache-diagnostics-ring nil))))) + (if (and (boundp 'org-batch-test) org-batch-test) + (error "%s" (concat "org-element--cache: " format-string)) + (warn "%s" (concat "org-element--cache: " format-string))))) + (defsubst org-element--cache-key (element) "Return a unique key for ELEMENT in cache tree. =20 @@ -5111,16 +5524,19 @@ (defsubst org-element--cache-key (element) When no synchronization is taking place, a key is simply the beginning position of the element, or that position plus one in the case of an first item (respectively row) in -a list (respectively a table). +a list (respectively a table). They key of a section is its beginning +position minus one. =20 During a synchronization, the key is the one the element had when the cache was synchronized for the last time. Elements added to cache during the synchronization get a new key generated with `org-element--cache-generate-key'. =20 -Such keys are stored in `org-element--cache-sync-keys'. The hash -table is cleared once the synchronization is complete." - (or (gethash element org-element--cache-sync-keys) +Such keys are stored inside the element property +`:org-element--cache-sync-key'. The property is a cons containing +current `org-element--cache-sync-keys-value' and the element key." + (or (when (eq org-element--cache-sync-keys-value (car (org-element-prope= rty :org-element--cache-sync-key element))) + (cdr (org-element-property :org-element--cache-sync-key element))) (let* ((begin (org-element-property :begin element)) ;; Increase beginning position of items (respectively ;; table rows) by one, so the first item can get @@ -5128,10 +5544,19 @@ (defsubst org-element--cache-key (element) ;; table). (key (if (memq (org-element-type element) '(item table-row)) (1+ begin) - begin))) - (if org-element--cache-sync-requests - (puthash element key org-element--cache-sync-keys) - key)))) + ;; Decrease beginning position of sections by one, + ;; so that the first element of the section get + ;; different key from the parent section. + (if (eq (org-element-type element) 'section) + (1- begin) + (if (eq (org-element-type element) 'org-data) + (- begin 2) + begin))))) + (when org-element--cache-sync-requests + (org-element-put-property element + :org-element--cache-sync-key + (cons org-element--cache-sync-keys-value key))) + key))) =20 (defun org-element--cache-generate-key (lower upper) "Generate a key between LOWER and UPPER. @@ -5224,8 +5649,7 @@ (defsubst org-element--cache-key-less-p (a b) =20 (defun org-element--cache-compare (a b) "Non-nil when element A is located before element B." - (org-element--cache-key-less-p (org-element--cache-key a) - (org-element--cache-key b))) + (org-element--cache-key-less-p (org-element--cache-key a) (org-element--= cache-key b))) =20 (defsubst org-element--cache-root () "Return root value in cache. @@ -5235,11 +5659,27 @@ (defsubst org-element--cache-root () =20 ;;;; Tools =20 -(defsubst org-element--cache-active-p () +(defsubst org-element--cache-active-p (&optional called-from-cache-change-= func-p) "Non-nil when cache is active in current buffer." (and org-element-use-cache org-element--cache - (derived-mode-p 'org-mode))) + (derived-mode-p 'org-mode) + ;; org-num-mode calls some Org structure analysis functions + ;; that can trigger cache update in the middle of changes. See + ;; `org-num--verify' calling `org-num--skip-value' calling + ;; `org-entry-get' that uses cache. + ;; Forcefully disable cache when called from inside a + ;; modification hook, where `inhibit-modification-hooks' is set + ;; to t. + (or called-from-cache-change-func-p + (not inhibit-modification-hooks) + (eq org-element--cache-change-tic (buffer-chars-modified-tick))= ))) + +(defmacro org-element-with-disabled-cache (&rest body) + "Run BODY without active org-element-cache." + (declare (debug (form body)) (indent 1)) + `(cl-letf (((symbol-function #'org-element--cache-active-p) (lambda () n= il))) + ,@body)) =20 (defun org-element--cache-find (pos &optional side) "Find element in cache starting at POS or before. @@ -5254,51 +5694,55 @@ (defun org-element--cache-find (pos &optional side) =20 The function can only find elements in the synchronized part of the cache." - (let ((limit (and org-element--cache-sync-requests - (aref (car org-element--cache-sync-requests) 0))) - (node (org-element--cache-root)) - lower upper) - (while node - (let* ((element (avl-tree--node-data node)) - (begin (org-element-property :begin element))) - (cond - ((and limit - (not (org-element--cache-key-less-p + (with-current-buffer (or (buffer-base-buffer) (current-buffer)) + (let ((limit (and org-element--cache-sync-requests + (org-element--request-key (car org-element--cache-sy= nc-requests)))) + (node (org-element--cache-root)) + lower upper) + (while node + (let* ((element (avl-tree--node-data node)) + (begin (org-element-property :begin element))) + (cond + ((and limit + (not (org-element--cache-key-less-p (org-element--cache-key element) limit))) - (setq node (avl-tree--node-left node))) - ((> begin pos) - (setq upper element - node (avl-tree--node-left node))) - ((< begin pos) - (setq lower element - node (avl-tree--node-right node))) - ;; We found an element in cache starting at POS. If `side' - ;; is `both' we also want the next one in order to generate - ;; a key in-between. - ;; - ;; If the element is the first row or item in a table or - ;; a plain list, we always return the table or the plain - ;; list. - ;; - ;; In any other case, we return the element found. - ((eq side 'both) - (setq lower element) - (setq node (avl-tree--node-right node))) - ((and (memq (org-element-type element) '(item table-row)) - (let ((parent (org-element-property :parent element))) - (and (=3D (org-element-property :begin element) - (org-element-property :contents-begin parent)) - (setq node nil - lower parent - upper parent))))) - (t - (setq node nil - lower element - upper element))))) - (pcase side - (`both (cons lower upper)) - (`nil lower) - (_ upper)))) + (setq node (avl-tree--node-left node))) + ((> begin pos) + (setq upper element + node (avl-tree--node-left node))) + ((or (< begin pos) + ;; If the element is section or org-data, we also need + ;; to check the following element. + (memq (org-element-type element) '(section org-data))) + (setq lower element + node (avl-tree--node-right node))) + ;; We found an element in cache starting at POS. If `side' + ;; is `both' we also want the next one in order to generate + ;; a key in-between. + ;; + ;; If the element is the first row or item in a table or + ;; a plain list, we always return the table or the plain + ;; list. + ;; + ;; In any other case, we return the element found. + ((eq side 'both) + (setq lower element) + (setq node (avl-tree--node-right node))) + ((and (memq (org-element-type element) '(item table-row)) + (let ((parent (org-element-property :parent element))) + (and (=3D (org-element-property :begin element) + (org-element-property :contents-begin parent)) + (setq node nil + lower parent + upper parent))))) + (t + (setq node nil + lower element + upper element))))) + (pcase side + (`both (cons lower upper)) + (`nil lower) + (_ upper))))) =20 (defun org-element--cache-put (element) "Store ELEMENT in current buffer's cache, if allowed." @@ -5307,21 +5751,43 @@ (defun org-element--cache-put (element) ;; During synchronization, first build an appropriate key for ;; the new element so `avl-tree-enter' can insert it at the ;; right spot in the cache. - (let ((keys (org-element--cache-find - (org-element-property :begin element) 'both))) - (puthash element - (org-element--cache-generate-key - (and (car keys) (org-element--cache-key (car keys))) - (cond ((cdr keys) (org-element--cache-key (cdr keys))) - (org-element--cache-sync-requests - (aref (car org-element--cache-sync-requests) 0)))) - org-element--cache-sync-keys))) + (let* ((keys (org-element--cache-find + (org-element-property :begin element) 'both)) + (new-key (org-element--cache-generate-key + (and (car keys) (org-element--cache-key (car keys))) + (cond ((cdr keys) (org-element--cache-key (cdr keys))) + (org-element--cache-sync-requests + (org-element--request-key (car org-element--cache-sync-requests))= ))))) + (org-element-put-property element + :org-element--cache-sync-key + (cons org-element--cache-sync-keys-value new-key)))) + (org-element--cache-log-message "Added new element with %S key: %S" + (org-element-property :org-element--cache-sync-ke= y element) + (org-element--format-element element) + :level 2) + (org-element-put-property element :cached t) + (cl-incf org-element--cache-size) (avl-tree-enter org-element--cache element))) =20 (defsubst org-element--cache-remove (element) "Remove ELEMENT from cache. Assume ELEMENT belongs to cache and that a cache is active." - (avl-tree-delete org-element--cache element)) + (org-element-put-property element :cached nil) + (cl-decf org-element--cache-size) + (let ((parent element)) + (while (setq parent (org-element-property :parent parent)) + (org-element-set-contents parent))) + (or (avl-tree-delete org-element--cache element) + (progn + ;; This should not happen, but if it is, would be better to know + ;; where it happens. + (org-element--cache-warn "Failed to delete %S element in %S at %S.= The element cache key was %S." + (org-element-type element) + (current-buffer) + (org-element-property :begin element) + (org-element-property :org-element--cache-sync-key e= lement)) + (org-element-cache-reset) + (throw 'quit nil)))) =20 =20 ;;;; Synchronization @@ -5361,12 +5827,12 @@ (defsubst org-element--cache-shift-positions (eleme= nt offset &optional props) ;; shifting it more than once. (when (and (or (not props) (memq :structure props)) (eq (org-element-type element) 'plain-list) - (not (eq (org-element-type (plist-get properties :parent)) - 'item))) + (not (eq (org-element-type (plist-get properties :parent)) 'item))) (dolist (item (plist-get properties :structure)) (cl-incf (car item) offset) (cl-incf (nth 6 item) offset))) - (dolist (key '(:begin :contents-begin :contents-end :end :post-affilia= ted)) + (dolist (key '( :begin :contents-begin :contents-end :end + :post-affiliated :robust-begin :robust-end)) (let ((value (and (or (not props) (memq key props)) (plist-get properties key)))) (and value (plist-put properties key (+ offset value))))))) @@ -5385,42 +5851,68 @@ (defun org-element--cache-sync (buffer &optional th= reshold future-change) in `org-element--cache-submit-request', where cache is partially updated before current modification are actually submitted." (when (buffer-live-p buffer) - (with-current-buffer buffer - (let ((inhibit-quit t) request next) - (when org-element--cache-sync-timer - (cancel-timer org-element--cache-sync-timer)) - (catch 'interrupt - (while org-element--cache-sync-requests - (setq request (car org-element--cache-sync-requests) - next (nth 1 org-element--cache-sync-requests)) - (org-element--cache-process-request - request - (and next (aref next 0)) - threshold - (and (not threshold) - (org-time-add nil - org-element-cache-sync-duration)) - future-change) - ;; Request processed. Merge current and next offsets and - ;; transfer ending position. - (when next - (cl-incf (aref next 3) (aref request 3)) - (aset next 2 (aref request 2))) - (setq org-element--cache-sync-requests - (cdr org-element--cache-sync-requests)))) - ;; If more requests are awaiting, set idle timer accordingly. - ;; Otherwise, reset keys. - (if org-element--cache-sync-requests - (org-element--cache-set-timer buffer) - (clrhash org-element--cache-sync-keys)))))) + (with-current-buffer (or (buffer-base-buffer buffer) buffer) + ;; Check if the buffer have been changed outside visibility of + ;; `org-element--cache-before-change' and `org-element--cache-after-= change'. + (if (/=3D org-element--cache-change-tic + (buffer-chars-modified-tick)) + (progn + (org-element--cache-warn "Unregistered buffer modifications de= tected. Resetting\n The buffer is: %s\n Current command: %S" + (buffer-name (current-buffer)) + this-command) + (org-element-cache-reset)) + (let ((inhibit-quit t) request next) + (when org-element--cache-sync-timer + (cancel-timer org-element--cache-sync-timer)) + (let ((time-limit (org-time-add nil org-element-cache-sync-durat= ion))) + (catch 'interrupt + (when org-element--cache-sync-requests + (org-element--cache-log-message "Syncing down to %S-%S" (o= r future-change threshold) threshold)) + (while org-element--cache-sync-requests + (setq request (car org-element--cache-sync-requests) + next (nth 1 org-element--cache-sync-requests)) + (org-element--cache-process-request + request + (when next (org-element--request-key next)) + threshold + (unless threshold time-limit) + future-change) + ;; Re-assign current and next requests. It could have + ;; been altered during phase 1. + (setq request (car org-element--cache-sync-requests) + next (nth 1 org-element--cache-sync-requests)) + ;; Request processed. Merge current and next offsets and + ;; transfer ending position. + (when next + ;; The following requests can only be either phase 1 + ;; or phase 2 requests. We need to let them know + ;; that additional shifting happened ahead of them. + (cl-incf (org-element--request-offset next) (org-element--reque= st-offset request)) + (org-element--cache-log-message "Updating next request o= ffset to %d: %s" + (org-element--request-offset next) + (let ((print-length 10) (print-leve= l 3)) (prin1-to-string next))) + ;; FIXME: END part of the request only matters for + ;; phase 0 requests. However, the only possible + ;; phase 0 request must be the first request in the + ;; list all the time. END position should be + ;; unused. + (setf (org-element--request-end next) (org-element--requ= est-end request))) + (setq org-element--cache-sync-requests + (cdr org-element--cache-sync-requests))))) + ;; If more requests are awaiting, set idle timer accordingly. + ;; Otherwise, reset keys. + (if org-element--cache-sync-requests + (org-element--cache-set-timer buffer) + (setq org-element--cache-sync-keys-value (buffer-chars-modifie= d-tick)))))))) =20 (defun org-element--cache-process-request - (request next threshold time-limit future-change) + (request next-request-key threshold time-limit future-change) "Process synchronization REQUEST for all entries before NEXT. =20 REQUEST is a vector, built by `org-element--cache-submit-request'. =20 -NEXT is a cache key, as returned by `org-element--cache-key'. +NEXT-REQUEST-KEY is a cache key of the next request, as returned by +`org-element--cache-key'. =20 When non-nil, THRESHOLD is a buffer position. Synchronization stops as soon as a shifted element begins after it. @@ -5434,62 +5926,84 @@ (defun org-element--cache-process-request =20 Throw `interrupt' if the process stops before completing the request." + (org-element--cache-log-message "org-element-cache: Processing request %= s up to %S-%S, next: %S" + (let ((print-length 10) (print-level 3)) (prin1-to-= string request)) + future-change + threshold + next-request-key) (catch 'quit - (when (=3D (aref request 5) 0) + (when (=3D (org-element--request-phase request) 0) ;; Phase 0. ;; - ;; Delete all elements starting after BEG, but not after buffer - ;; position END or past element with key NEXT. Also delete - ;; elements contained within a previously removed element - ;; (stored in `last-container'). + ;; Delete all elements starting after beginning of the element + ;; with request key NEXT, but not after buffer position END. ;; ;; At each iteration, we start again at tree root since ;; a deletion modifies structure of the balanced tree. + (org-element--cache-log-message "Phase 0") (catch 'end-phase - (while t - (when (org-element--cache-interrupt-p time-limit) - (throw 'interrupt nil)) - ;; Find first element in cache with key BEG or after it. - (let ((beg (aref request 0)) - (end (aref request 2)) - (node (org-element--cache-root)) - data data-key last-container) - (while node - (let* ((element (avl-tree--node-data node)) - (key (org-element--cache-key element))) - (cond - ((org-element--cache-key-less-p key beg) - (setq node (avl-tree--node-right node))) - ((org-element--cache-key-less-p beg key) - (setq data element - data-key key - node (avl-tree--node-left node))) - (t (setq data element + (let ((deletion-count 0)) + (while t + (when (org-element--cache-interrupt-p time-limit) + (org-element--cache-log-message "Interrupt: time limit") + (throw 'interrupt nil)) + (let ((request-key (org-element--request-key request)) + (end (org-element--request-end request)) + (node (org-element--cache-root)) + data data-key) + ;; Find first element in cache with key REQUEST-KEY or + ;; after it. + (while node + (let* ((element (avl-tree--node-data node)) + (key (org-element--cache-key element))) + (cond + ((org-element--cache-key-less-p key request-key) + (setq node (avl-tree--node-right node))) + ((org-element--cache-key-less-p request-key key) + (setq data element data-key key - node nil))))) - (if data - (let ((pos (org-element-property :begin data))) - (if (if (or (not next) - (org-element--cache-key-less-p data-key next)) - (<=3D pos end) - (and last-container - (let ((up data)) - (while (and up (not (eq up last-container))) - (setq up (org-element-property :parent up))) - up))) - (progn (when (and (not last-container) - (> (org-element-property :end data) - end)) - (setq last-container data)) - (org-element--cache-remove data)) - (aset request 0 data-key) - (aset request 1 pos) - (aset request 5 1) - (throw 'end-phase nil))) - ;; No element starting after modifications left in - ;; cache: further processing is futile. - (throw 'quit t)))))) - (when (=3D (aref request 5) 1) + node (avl-tree--node-left node))) + (t (setq data element + data-key key + node nil))))) + (if data + ;; We found first element in cache starting at or + ;; after REQUEST-KEY. + (let ((pos (org-element-property :begin data))) + ;; FIXME: Maybe simply (< pos end)? + (if (<=3D pos end) + (progn + (org-element--cache-log-message "removing %S::%S" + (org-element-pro= perty :org-element--cache-sync-key data) + (org-element--fo= rmat-element data)) + (cl-incf deletion-count) + (org-element--cache-remove data) + (when (and (> (log org-element--cache-size 2) 10) + (> deletion-count + (/ org-element--cache-size (log or= g-element--cache-size 2)))) + (org-element--cache-log-message "Removed %S>N/= LogN(=3D%S/%S) elements. Resetting cache to prevent performance degradatio= n" + deletion-count + org-element--c= ache-size + (log org-eleme= nt--cache-size 2)) + (org-element-cache-reset) + (throw 'quit t))) + ;; Done deleting everthing starting before END. + ;; DATA-KEY is the first known element after END. + ;; Move on to phase 1. + (org-element--cache-log-message "found element after= %d: %S::%S" + end + (org-element-propert= y :org-element--cache-sync-key data) + (org-element--format= -element data)) + (setf (org-element--request-key request) data-key) + (setf (org-element--request-beg request) pos) + (setf (org-element--request-phase request) 1) + (throw 'end-phase nil))) + ;; No element starting after modifications left in + ;; cache: further processing is futile. + (org-element--cache-log-message "Phase 0 deleted all eleme= nts in cache after %S!" + request-key) + (throw 'quit t))))))) + (when (=3D (org-element--request-phase request) 1) ;; Phase 1. ;; ;; Phase 0 left a hole in the cache. Some elements after it @@ -5515,31 +6029,57 @@ (defun org-element--cache-process-request ;; Note that we only need to get the parent from the first ;; element in cache after the hole. ;; - ;; When next key is lesser or equal to the current one, delegate - ;; phase 1 processing to next request in order to preserve key - ;; order among requests. - (let ((key (aref request 0))) - (when (and next (not (org-element--cache-key-less-p key next))) + ;; When next key is lesser or equal to the current one, current + ;; request is inside a to-be-shifted part of the cache. It is + ;; fine because the order of elements will not be altered by + ;; shifting. However, we cannot know the real position of the + ;; unshifted NEXT element in the current request. So, we need + ;; to sort the request list according to keys and re-start + ;; processing from the new leftmost request. + (org-element--cache-log-message "Phase 1") + (let ((key (org-element--request-key request))) + (when (and next-request-key (not (org-element--cache-key-less-p key next-= request-key))) + ;; In theory, the only case when requests are not + ;; ordered is when key of the next request is either the + ;; same with current key or it is a key for a removed + ;; element. Either way, we can simply merge the two + ;; requests. (let ((next-request (nth 1 org-element--cache-sync-requests))) - (aset next-request 0 key) - (aset next-request 1 (aref request 1)) - (aset next-request 5 1)) - (throw 'quit t))) + (org-element--cache-log-message "Phase 1: Unorderered requests= . Merging: %S\n%S\n" + (let ((print-length 10) (print-level 3)) = (prin1-to-string request)) + (let ((print-length 10) (print-level 3)) = (prin1-to-string next-request))) + (setf (org-element--request-key next-request) key) + (setf (org-element--request-beg next-request) (org-element--re= quest-beg request)) + (setf (org-element--request-phase next-request) 1) + (throw 'quit t)))) ;; Next element will start at its beginning position plus ;; offset, since it hasn't been shifted yet. Therefore, LIMIT ;; contains the real beginning position of the first element to ;; shift and re-parent. - (let ((limit (+ (aref request 1) (aref request 3)))) - (cond ((and threshold (> limit threshold)) (throw 'interrupt nil)) + (let ((limit (+ (org-element--request-beg request) (org-element--req= uest-offset request)))) + (cond ((and threshold (> limit threshold)) + (org-element--cache-log-message "Interrupt: position %d aft= er threshold %d" limit threshold) + (throw 'interrupt nil)) ((and future-change (>=3D limit future-change)) - ;; Changes are going to happen around this element and - ;; they will trigger another phase 1 request. Skip the - ;; current one. - (aset request 5 2)) + ;; Changes happened around this element and they will + ;; trigger another phase 1 request. Skip re-parenting + ;; and simply proceed with shifting (phase 2) to make + ;; sure that followup phase 0 request for the recent + ;; changes can operate on the correctly shifted cache. + (org-element--cache-log-message "position %d after future c= hange %d" limit future-change) + (setf (org-element--request-parent request) nil) + (setf (org-element--request-phase request) 2)) (t - (let ((parent (org-element--parse-to limit t time-limit))) - (aset request 4 parent) - (aset request 5 2)))))) + ;; No relevant changes happened after submitting this + ;; request. We are safe to look at the actual Org + ;; buffer and calculate the new parent. + (let ((parent (org-element--parse-to limit nil time-limit))) + (org-element--cache-log-message "New parent at %d: %S::%S" + limit + (org-element-property :org-element--= cache-sync-key parent) + (org-element--format-element parent)) + (setf (org-element--request-parent request) parent) + (setf (org-element--request-phase request) 2)))))) ;; Phase 2. ;; ;; Shift all elements starting from key START, but before NEXT, by @@ -5551,32 +6091,56 @@ (defun org-element--cache-process-request ;; Once THRESHOLD, if any, is reached, or once there is an input ;; pending, exit. Before leaving, the current synchronization ;; request is updated. - (let ((start (aref request 0)) - (offset (aref request 3)) - (parent (aref request 4)) + (org-element--cache-log-message "Phase 2") + (let ((start (org-element--request-key request)) + (offset (org-element--request-offset request)) + (parent (org-element--request-parent request)) (node (org-element--cache-root)) (stack (list nil)) (leftp t) - exit-flag) + exit-flag continue-flag) ;; No re-parenting nor shifting planned: request is over. - (when (and (not parent) (zerop offset)) (throw 'quit t)) + (when (and (not parent) (zerop offset)) + (org-element--cache-log-message "Empty offset. Request completed.") + (throw 'quit t)) (while node (let* ((data (avl-tree--node-data node)) (key (org-element--cache-key data))) + ;; Traverse the cache tree. Ignore all the elements before + ;; START. Note that `avl-tree-stack' would not bypass the + ;; elements before START and thus would have beeen less + ;; efficient. (if (and leftp (avl-tree--node-left node) (not (org-element--cache-key-less-p key start))) (progn (push node stack) (setq node (avl-tree--node-left node))) + ;; Shift and re-parent when current node starts at or + ;; after START, but before NEXT. (unless (org-element--cache-key-less-p key start) ;; We reached NEXT. Request is complete. - (when (equal key next) (throw 'quit t)) + (when (and next-request-key + (not (org-element--cache-key-less-p key next-requ= est-key))) + (org-element--cache-log-message "Reached next request.") + (let ((next-request (nth 1 org-element--cache-sync-request= s))) + (unless (and (org-element-property :cached (org-element-= -request-parent next-request)) + (org-element-property :begin (org-element--= request-parent next-request)) + (> (org-element-property :begin (org-elemen= t--request-parent next-request)) + (org-element-property :begin parent))) + (setf (org-element--request-parent next-request) paren= t))) + (throw 'quit t)) ;; Handle interruption request. Update current request. (when (or exit-flag (org-element--cache-interrupt-p time-limit)) - (aset request 0 key) - (aset request 4 parent) - (throw 'interrupt nil)) + (org-element--cache-log-message "Interrupt: %s" (if exit-f= lag "threshold" "time limit")) + (setf (org-element--request-key request) key) + (setf (org-element--request-parent request) parent) + (throw 'interrupt nil)) ;; Shift element. (unless (zerop offset) + (org-element--cache-log-message "Shifting positions (=F0= =9D=9D=99%S) in %S::%S" + offset + (org-element-property :org-element--c= ache-sync-key data) + (org-element--format-element data) + :level 3) (org-element--cache-shift-positions data offset)) (let ((begin (org-element-property :begin data))) ;; Update PARENT and re-parent DATA, only when @@ -5585,25 +6149,93 @@ (defun org-element--cache-process-request (<=3D (org-element-property :end parent) begin)) (setq parent (org-element-property :parent parent))) (cond ((and (not parent) (zerop offset)) (throw 'quit nil)) + ;; Consider scenario when DATA lays within + ;; sensitive lines of PARENT that was found + ;; during phase 2. For example: + ;;=20 + ;; #+ begin_quote + ;; Paragraph + ;; #+end_quote + ;; + ;; In the above source block, remove space in + ;; the first line will trigger re-parenting of + ;; the paragraph and "#+end_quote" that is also + ;; considered paragraph before the modification. + ;; However, the paragraph element stored in + ;; cache must be deleted instead. + ((and parent + (or (not (memq (org-element-type parent) org-e= lement-greater-elements)) + (and (org-element-property :contents-begin= parent) + (< (org-element-property :begin data)= (org-element-property :contents-begin parent))) + (and (org-element-property :contents-end p= arent) + (>=3D (org-element-property :begin da= ta) (org-element-property :contents-end parent))) + (> (org-element-property :end data) (org-e= lement-property :end parent)) + (and (org-element-property :contents-end d= ata) + (> (org-element-property :contents-en= d data) (org-element-property :contents-end parent))))) + (org-element--cache-log-message "org-element-cache:= Removing obsolete element with key %S::%S" + (org-element-property :org-ele= ment--cache-sync-key data) + (org-element--format-element d= ata)) + (org-element--cache-remove data) + ;; We altered the tree structure. The tree + ;; traversal needs to be restarted. + (setf (org-element--request-key request) key) + (setf (org-element--request-parent request) parent) + ;; Restart tree traversal. + (setq node (org-element--cache-root) + stack (list nil) + leftp t + begin -1 + continue-flag t)) ((and parent + (not (eq parent data)) (let ((p (org-element-property :parent data))) (or (not p) (< (org-element-property :begin p) - (org-element-property :begin parent))))) + (org-element-property :begin parent)) + (unless (eq p parent) + (not (org-element-property :cached p)) + ;; (not (avl-tree-member-p org-element= --cache p)) + )))) + (org-element--cache-log-message "Updating parent in= %S\n Old parent: %S\n New parent: %S" + (org-element--format-element d= ata) + (org-element--format-element (= org-element-property :parent data)) + (org-element--format-element p= arent)) (org-element-put-property data :parent parent) (let ((s (org-element-property :structure parent))) (when (and s (org-element-property :structure data)) (org-element-put-property data :structure s))))) ;; Cache is up-to-date past THRESHOLD. Request ;; interruption. - (when (and threshold (> begin threshold)) (setq exit-flag t)))) - (setq node (if (setq leftp (avl-tree--node-right node)) - (avl-tree--node-right node) - (pop stack)))))) + (when (and threshold (> begin threshold)) + (org-element--cache-log-message "Reached threshold %d: %= S" + threshold + (org-element--format-element data)) + (setq exit-flag t)))) + (if continue-flag + (setq continue-flag nil) + (setq node (if (setq leftp (avl-tree--node-right node)) + (avl-tree--node-right node) + (pop stack))))))) ;; We reached end of tree: synchronization complete. - t))) - -(defun org-element--parse-to (pos &optional syncp time-limit) + t)) + (org-element--cache-log-message "org-element-cache: Finished process. Th= e cache size is %d. The remaining sync requests: %S" + org-element--cache-size + (let ((print-level 2)) (prin1-to-string org-element= --cache-sync-requests)))) + +(defsubst org-element--open-end-p (element) + "Check if ELEMENT in current buffer contains extra blank lines after +it and does not have closing term. + +Examples of such elements are: section, headline, org-data, +and footnote-definition." + (and (org-element-property :contents-end element) + (=3D (org-element-property :contents-end element) + (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\n\t") + (line-beginning-position 2))))) + +(defun org-element--parse-to (pos &optional syncp time-limit recursive) "Parse elements in current section, down to POS. =20 Start parsing from the closest between the last known element in @@ -5614,128 +6246,173 @@ (defun org-element--parse-to (pos &optional syncp= time-limit) element containing POS instead. In that case, it is also possible to provide TIME-LIMIT, which is a time value specifying when the parsing should stop. The function throws `interrupt' if -the process stopped before finding the expected result." - (catch 'exit - (org-with-wide-buffer - (goto-char pos) - (let* ((cached (and (org-element--cache-active-p) - (org-element--cache-find pos nil))) - (begin (org-element-property :begin cached)) - element next mode) - (cond - ;; Nothing in cache before point: start parsing from first - ;; element following headline above, or first element in - ;; buffer. - ((not cached) - (if (org-with-limited-levels (outline-previous-heading)) - (progn - (setq mode 'planning) - (forward-line)) - (setq mode 'top-comment)) - (skip-chars-forward " \r\t\n") - (beginning-of-line)) - ;; Cache returned exact match: return it. - ((=3D pos begin) - (throw 'exit (if syncp (org-element-property :parent cached) cached))) - ;; There's a headline between cached value and POS: cached - ;; value is invalid. Start parsing from first element - ;; following the headline. - ((re-search-backward - (org-with-limited-levels org-outline-regexp-bol) begin t) - (forward-line) - (skip-chars-forward " \r\t\n") - (beginning-of-line) - (setq mode 'planning)) - ;; Check if CACHED or any of its ancestors contain point. - ;; - ;; If there is such an element, we inspect it in order to know - ;; if we return it or if we need to parse its contents. - ;; Otherwise, we just start parsing from current location, - ;; which is right after the top-most element containing - ;; CACHED. - ;; - ;; As a special case, if POS is at the end of the buffer, we - ;; want to return the innermost element ending there. - ;; - ;; Also, if we find an ancestor and discover that we need to - ;; parse its contents, make sure we don't start from - ;; `:contents-begin', as we would otherwise go past CACHED - ;; again. Instead, in that situation, we will resume parsing - ;; from NEXT, which is located after CACHED or its higher - ;; ancestor not containing point. - (t - (let ((up cached) - (pos (if (=3D (point-max) pos) (1- pos) pos))) - (goto-char (or (org-element-property :contents-begin cached) be= gin)) - (while (let ((end (org-element-property :end up))) - (and (<=3D end pos) - (goto-char end) - (setq up (org-element-property :parent up))))) - (cond ((not up)) - ((eobp) (setq element up)) - (t (setq element up next (point))))))) - ;; Parse successively each element until we reach POS. - (let ((end (or (org-element-property :end element) - (save-excursion - (org-with-limited-levels (outline-next-heading)) - (point)))) - (parent element)) - (while t - (when syncp - (cond ((=3D (point) pos) (throw 'exit parent)) - ((org-element--cache-interrupt-p time-limit) - (throw 'interrupt nil)))) - (unless element - (setq element (org-element--current-element - end 'element mode - (org-element-property :structure parent))) - (org-element-put-property element :parent parent) - (org-element--cache-put element)) - (let ((elem-end (org-element-property :end element)) - (type (org-element-type element))) - (cond - ;; Skip any element ending before point. Also skip - ;; element ending at point (unless it is also the end of - ;; buffer) since we're sure that another element begins - ;; after it. - ((and (<=3D elem-end pos) (/=3D (point-max) elem-end)) - (goto-char elem-end) - (setq mode (org-element--next-mode mode type nil))) - ;; A non-greater element contains point: return it. - ((not (memq type org-element-greater-elements)) - (throw 'exit element)) - ;; Otherwise, we have to decide if ELEMENT really - ;; contains POS. In that case we start parsing from - ;; contents' beginning. - ;; - ;; If POS is at contents' beginning but it is also at - ;; the beginning of the first item in a list or a table. - ;; In that case, we need to create an anchor for that - ;; list or table, so return it. - ;; - ;; Also, if POS is at the end of the buffer, no element - ;; can start after it, but more than one may end there. - ;; Arbitrarily, we choose to return the innermost of - ;; such elements. - ((let ((cbeg (org-element-property :contents-begin element)) - (cend (org-element-property :contents-end element))) - (when (or syncp - (and cbeg cend - (or (< cbeg pos) - (and (=3D cbeg pos) - (not (memq type '(plain-list table))))) - (or (> cend pos) - (and (=3D cend pos) (=3D (point-max) pos))))) - (goto-char (or next cbeg)) - (setq next nil - mode (org-element--next-mode mode type t) - parent element - end cend)))) - ;; Otherwise, return ELEMENT as it is the smallest - ;; element containing POS. - (t (throw 'exit element)))) - (setq element nil))))))) +the process stopped before finding the expected result. =20 +When optional argument RECURSIVE is non-nil, parse element recursively." + (catch 'exit + (save-match-data + (org-with-wide-buffer + (goto-char pos) + (save-excursion + (end-of-line) + (skip-chars-backward " \r\t\n") + ;; Within blank lines at the beginning of buffer, return nil. + (when (bobp) (throw 'exit nil))) + (let* ((cached (and (org-element--cache-active-p) + (org-element--cache-find pos nil))) + (mode (org-element-property :mode cached)) + element next) + (cond + ;; Nothing in cache before point: start parsing from first + ;; element in buffer down to POS or from the beginning of the + ;; file. + ((and (not cached) (org-element--cache-active-p)) + (setq element (org-element-org-data-parser)) + (unless (org-element-property :begin element) (org-element--cac= he-warn "Error parsing org-data. Got %S" element)) + (org-element--cache-log-message "Nothing in cache. Adding org-d= ata: %S" + (org-element--format-element element)) + (org-element--cache-put element) + (goto-char (org-element-property :contents-begin element)) + (setq mode 'org-data)) + ;; Nothing in cache before point because cache is not active. + ;; Parse from previous heading to avoid re-parsing the whole + ;; buffer above. This comes at the cost of not calculating + ;; `:parent' property for headings. + ((not cached) + (if (org-with-limited-levels (outline-previous-heading)) + (progn + (setq element (org-element-headline-parser nil 'fast)) + (setq mode 'planning) + (forward-line)) + (setq mode 'top-comment)) + (org-skip-whitespace) + (beginning-of-line)) + ;; Check if CACHED or any of its ancestors contain point. + ;; + ;; If there is such an element, we inspect it in order to know + ;; if we return it or if we need to parse its contents. + ;; Otherwise, we just start parsing from location, which is + ;; right after the top-most element containing CACHED but + ;; still before POS. + ;; + ;; As a special case, if POS is at the end of the buffer, we + ;; want to return the innermost element ending there. + ;; + ;; Also, if we find an ancestor and discover that we need to + ;; parse its contents, make sure we don't start from + ;; `:contents-begin', as we would otherwise go past CACHED + ;; again. Instead, in that situation, we will resume parsing + ;; from NEXT, which is located after CACHED or its higher + ;; ancestor not containing point. + (t + (let ((up cached) + (pos (if (=3D (point-max) pos) (1- pos) pos))) + (while (and up (<=3D (org-element-property :end up) pos)) + (goto-char (org-element-property :end up)) + (setq element up + mode (org-element--next-mode (org-element-property :m= ode element) (org-element-type element) nil) + up (org-element-property :parent up) + next (point))) + (when up (setq element up))))) + ;; Parse successively each element until we reach POS. + (let ((end (or (org-element-property :end element) (point-max))) + (parent (org-element-property :parent element))) + (while t + (when (org-element--cache-interrupt-p time-limit) + (throw 'interrupt nil)) + (unless element + (setq element (org-element--current-element + end 'element mode + (org-element-property :structure parent))) + ;; Make sure that we return referenced element in cache + ;; that can be altered directly. + (setq element (or (org-element--cache-put element) element)) + ;; Nothing to parse (i.e. empty file). + (unless element (throw 'exit parent)) + (org-element-put-property element :parent parent)) + (let ((elem-end (org-element-property :end element)) + (type (org-element-type element))) + (cond + ;; Skip any element ending before point. Also skip + ;; element ending at point (unless it is also the end of + ;; buffer) since we're sure that another element begins + ;; after it. + ((and (<=3D elem-end pos) (/=3D (point-max) elem-end)) + (when (and recursive + (org-element-property :contents-end element)) + (org-element--parse-to (1- (org-element-property :conte= nts-end element)) + nil time-limit recursive)) + ;; Avoid parsing headline siblings above. + (goto-char elem-end) + (when (eq type 'headline) + (save-match-data + (unless (when (and (/=3D 1 (org-element-property :lev= el element)) + (re-search-forward + (rx-to-string + `(and bol (repeat 1 ,(1- (org-el= ement-property :level element)) "*") " ")) + pos t)) + (beginning-of-line) + t) + (goto-char pos) + (re-search-backward + (rx-to-string + `(and bol (repeat ,(org-element-property :level e= lement) "*") " ")) + elem-end t)))) + (setq mode (org-element--next-mode mode type nil))) + ;; A non-greater element contains point: return it. + ((not (memq type org-element-greater-elements)) + (throw 'exit (if syncp parent element))) + ;; Otherwise, we have to decide if ELEMENT really + ;; contains POS. In that case we start parsing from + ;; contents' beginning. + ;; + ;; If POS is at contents' beginning but it is also at + ;; the beginning of the first item in a list or a table. + ;; In that case, we need to create an anchor for that + ;; list or table, so return it. + ;; + ;; Also, if POS is at the end of the buffer, no element + ;; can start after it, but more than one may end there. + ;; Arbitrarily, we choose to return the innermost of + ;; such elements. + ((let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + (when (and cbeg cend + (or (< cbeg pos) + (and (=3D cbeg pos) + (not (memq type '(plain-list table))))) + (or (> cend pos) + ;; When we are at cend or within blank + ;; lines after, it is a special case: + ;; 1. At the end of buffer we return + ;; the innermost element. + ;; 2. At cend of element with return + ;; that element. + ;; 3. At the end of element, we would + ;; return in the earlier cond form. + ;; 4. Within blank lines after cend, + ;; when element does not have a + ;; closing keyword, we return that + ;; outermost element, unless the + ;; outermost element is a non-empty + ;; headline. In the latter case, we + ;; return the outermost element inside + ;; the headline section. + (and (org-element--open-end-p element) + (or (=3D (org-element-property :end= element) (point-max)) + (and (> pos (org-element-proper= ty :contents-end element)) + (memq (org-element-type el= ement) '(org-data section headline))))))) + (goto-char (or next cbeg)) + (setq mode (if next mode (org-element--next-mode mode type t)) + next nil + parent element + end (if (org-element--open-end-p element) + (org-element-property :end element) + (org-element-property :contents-end eleme= nt)))))) + ;; Otherwise, return ELEMENT as it is the smallest + ;; element containing POS. + (t (throw 'exit (if syncp parent element))))) + (setq element nil)))))))) =20 ;;;; Staging Buffer Changes =20 @@ -5745,6 +6422,8 @@ (defconst org-element--cache-sensitive-re "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|" "^[ \t]*\\(?:" "#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|" + org-list-full-item-re "\\|" + ":\\(?: \\|$\\)" "\\|" "\\\\begin{[A-Za-z0-9*]+}" "\\|" ":\\(?:\\w\\|[-_]\\)+:[ \t]*$" "\\)") @@ -5756,64 +6435,82 @@ (defconst org-element--cache-sensitive-re =20 (defvar org-element--cache-change-warning nil "Non-nil when a sensitive line is about to be changed. -It is a symbol among nil, t and `headline'.") +It is a symbol among nil, t, or a number representing smallest level of +modified headline. The level considers headline levels both before +and after the modification.") =20 (defun org-element--cache-before-change (beg end) - "Request extension of area going to be modified if needed. + "Detect modifications in sensitive parts of Org buffer. BEG and END are the beginning and end of the range of changed -text. See `before-change-functions' for more information." - (when (org-element--cache-active-p) - (org-with-wide-buffer - (goto-char beg) - (beginning-of-line) - (let ((bottom (save-excursion (goto-char end) (line-end-position)))) - (setq org-element--cache-change-warning - (save-match-data - (if (and (org-with-limited-levels (org-at-heading-p)) - (=3D (line-end-position) bottom)) - 'headline - (let ((case-fold-search t)) - (re-search-forward - org-element--cache-sensitive-re bottom t))))))))) +text. See `before-change-functions' for more information. + +The function returns the new value of `org-element--cache-change-warning'." + (when (org-element--cache-active-p t) + (with-current-buffer (or (buffer-base-buffer (current-buffer)) + (current-buffer)) + (org-with-wide-buffer + (setq org-element--cache-change-tic (buffer-chars-modified-tick)) + (goto-char beg) + (beginning-of-line) + (let ((bottom (save-excursion (goto-char end) (line-end-position)))) + (prog1 + (let ((org-element--cache-change-warning-before org-element--= cache-change-warning) + (org-element--cache-change-warning-after)) + (setq org-element--cache-change-warning-after + (save-match-data + (let ((case-fold-search t)) + (when (re-search-forward + org-element--cache-sensitive-re bottom t) + (goto-char beg) + (beginning-of-line) + (let (min-level) + (cl-loop while (re-search-forward + (rx-to-string + (if min-level + `(and bol (repeat 1 ,(1-= min-level) "*") " ") + `(and bol (+ "*") " "))) + bottom t) + do (setq min-level (1- (length (matc= h-string 0)))) + until (=3D min-level 1)) + (goto-char beg) + (beginning-of-line) + (or min-level + (when (looking-at-p "^[ \t]*#\\+CATEGORY:= ") + 'org-data) + t)))))) + (setq org-element--cache-change-warning + (cond + ((and (numberp org-element--cache-change-warning-bef= ore) + (numberp org-element--cache-change-warning-aft= er)) + (min org-element--cache-change-warning-after + org-element--cache-change-warning-before)) + ((numberp org-element--cache-change-warning-before) + org-element--cache-change-warning-before) + ((numberp org-element--cache-change-warning-after) + org-element--cache-change-warning-after) + (t (or org-element--cache-change-warning-after + org-element--cache-change-warning-before))))) + (org-element--cache-log-message "%S is about to modify text: wa= rning %S" + this-command + org-element--cache-change-warning))))))) =20 (defun org-element--cache-after-change (beg end pre) "Update buffer modifications for current buffer. BEG and END are the beginning and end of the range of changed text, and the length in bytes of the pre-change text replaced by that range. See `after-change-functions' for more information." - (when (org-element--cache-active-p) - (org-with-wide-buffer - (goto-char beg) - (beginning-of-line) - (save-match-data - (let ((top (point)) - (bottom (save-excursion (goto-char end) (line-end-position)))) - ;; Determine if modified area needs to be extended, according - ;; to both previous and current state. We make a special - ;; case for headline editing: if a headline is modified but - ;; not removed, do not extend. - (when (pcase org-element--cache-change-warning - (`t t) - (`headline - (not (and (org-with-limited-levels (org-at-heading-p)) - (=3D (line-end-position) bottom)))) - (_ - (let ((case-fold-search t)) - (re-search-forward - org-element--cache-sensitive-re bottom t)))) - ;; Effectively extend modified area. - (org-with-limited-levels - (setq top (progn (goto-char top) - (when (outline-previous-heading) (forward-line)) - (point))) - (setq bottom (progn (goto-char bottom) - (if (outline-next-heading) (1- (point)) - (point)))))) - ;; Store synchronization request. - (let ((offset (- end beg pre))) - (org-element--cache-submit-request top (- bottom offset) offset))))) - ;; Activate a timer to process the request during idle time. - (org-element--cache-set-timer (current-buffer)))) + (when (org-element--cache-active-p t) + (with-current-buffer (or (buffer-base-buffer (current-buffer)) + (current-buffer)) + (when (not (eq org-element--cache-change-tic (buffer-chars-modified-= tick))) + (org-element--cache-log-message "After change") + (setq org-element--cache-change-warning (org-element--cache-before= -change beg end)) + ;; Store synchronization request. + (let ((offset (- end beg pre))) + (save-match-data + (org-element--cache-submit-request beg (- end offset) offset))) + ;; Activate a timer to process the request during idle time. + (org-element--cache-set-timer (current-buffer)))))) =20 (defun org-element--cache-for-removal (beg end offset) "Return first element to remove from cache. @@ -5825,7 +6522,13 @@ (defun org-element--cache-for-removal (beg end offse= t) any position between BEG and END. As an exception, greater elements around the changes that are robust to contents modifications are preserved and updated according to the -changes." +changes. In the latter case, the returned element is the outermost +non-robust element affected by the changes. Note that the returned +element may end before END position in which case some cached element +starting after the returned may still be affected by the changes. + +Also, when there are no elements in cache before BEG, return first +known element in cache (it may start after END)." (let* ((elements (org-element--cache-find (1- beg) 'both)) (before (car elements)) (after (cdr elements))) @@ -5834,34 +6537,108 @@ (defun org-element--cache-for-removal (beg end off= set) (robust-flag t)) (while up (if (let ((type (org-element-type up))) - (and (or (memq type '(center-block dynamic-block quote-block - special-block)) - ;; Drawers named "PROPERTIES" are probably - ;; a properties drawer being edited. Force - ;; parsing to check if editing is over. - (and (eq type 'drawer) - (not (string=3D - (org-element-property :drawer-name up) - "PROPERTIES")))) - (let ((cbeg (org-element-property :contents-begin up))) - (and cbeg - (<=3D cbeg beg) - (> (org-element-property :contents-end up) end))))) + (or (and (memq type '( center-block dynamic-block + quote-block special-block)) + ;; Sensitive change. This is + ;; unconditionally non-robust change. + (not org-element--cache-change-warning) + (let ((cbeg (org-element-property :contents-begin up)) + (cend (org-element-property :contents-end u= p))) + (and cbeg + (<=3D cbeg beg) + (or (> cend end) + (and (=3D cend end) + (=3D (+ end offset) (point-max)))= )))) + (and (memq type '(headline section org-data)) + (let ((rbeg (org-element-property :robust-begin up)) + (rend (org-element-property :robust-end up)= )) + (and rbeg rend + (<=3D rbeg beg) + (or (> rend end) + (and (=3D rend end) + (=3D (+ end offset) (point-max)))= ))) + (pcase type + ;; Sensitive change in section. Need to + ;; re-parse. + (`section (not org-element--cache-change-warnin= g)) + ;; Headline might be inserted. This is non-rob= ust + ;; change when `up' is a `headline' or `section' + ;; with `>' level compared to the inserted head= line. + ;; + ;; Also, planning info/property drawer + ;; could have been inserted. It is not + ;; robust change then. + (`headline + (and + (or (not (numberp org-element--cache-change-w= arning)) + (> org-element--cache-change-warning + (org-element-property :level up))) + (org-with-point-at (org-element-property :con= tents-begin up) + (unless + (save-match-data + (when (looking-at-p org-planning-line= -re) + (forward-line)) + (when (looking-at org-property-drawer= -re) + (< beg (match-end 0)))) + 'robust)))) + (`org-data (not (eq org-element--cache-change-w= arning 'org-data))) + (_ 'robust))))) ;; UP is a robust greater element containing changes. ;; We only need to extend its ending boundaries. - (org-element--cache-shift-positions - up offset '(:contents-end :end)) - (setq before up) - (when robust-flag (setq robust-flag nil))) + (progn + (org-element--cache-shift-positions + up offset + (if (and (org-element-property :robust-begin up) + (org-element-property :robust-end up)) + '(:contents-end :end :robust-end) + '(:contents-end :end))) + (org-element--cache-log-message "Shifting end positions of= robust parent: %S" + (org-element--format-element up))) + (unless (or + ;; UP is non-robust. Yet, if UP is headline, flagging + ;; everything inside for removal may be to + ;; costly. Instead, we should better re-parse only t= he + ;; headline itself when possible. If a headline is s= till + ;; starting from old :begin position, we do not care = that + ;; its boundaries could have extended to shrinked - we + ;; will re-parent and shift them anyway. + (and (eq 'headline (org-element-type up)) + ;; The change is not inside headline. Not + ;; updating here. + (not (<=3D beg (org-element-property :begin up))) + (not (>=3D end (org-element-property :end up))) + (let ((current (org-with-point-at (org-element-p= roperty :begin up) + (cl-letf (((symbol-function #'o= rg-element--cache-active-p) (lambda () nil))) + (org-element--current-element= (point-max)))))) + (when (eq 'headline (org-element-type current)) + (org-element--cache-log-message "Found non-r= obust headline that can be updated individually: %S" + (org-element--format-el= ement current)) + (org-element-set-element up current) + t))) + ;; If UP is org-data, the situation is similar to + ;; headline case. We just need to re-parse the + ;; org-data itself. + (when (eq 'org-data (org-element-type up)) + (org-element-set-element up (org-with-point-at 1 (o= rg-element-org-data-parser))) + (org-element--cache-log-message "Found non-robust c= hange invalidating org-data. Re-parsing: %S" + (org-element--format-element u= p)) + t)) + (org-element--cache-log-message "Found non-robust element: %= S" + (org-element--format-element up)) + (setq before up) + (when robust-flag (setq robust-flag nil)))) + (unless (or (org-element-property :parent up) + (eq 'org-data (org-element-type up))) + (org-element--cache-warn "Got element without parent.\n%S" up)) (setq up (org-element-property :parent up))) - ;; We're at top level element containing ELEMENT: if it's - ;; altered by buffer modifications, it is first element in - ;; cache to be removed. Otherwise, that first element is the - ;; following one. - ;; - ;; As a special case, do not remove BEFORE if it is a robust - ;; container for current changes. - (if (or (< (org-element-property :end before) beg) robust-flag) after + ;; We're at top level element containing ELEMENT: if it's + ;; altered by buffer modifications, it is first element in + ;; cache to be removed. Otherwise, that first element is the + ;; following one. + ;; + ;; As a special case, do not remove BEFORE if it is a robust + ;; container for current changes. + (if (or (< (org-element-property :end before) beg) robust-flag) af= ter before))))) =20 (defun org-element--cache-submit-request (beg end offset) @@ -5869,68 +6646,209 @@ (defun org-element--cache-submit-request (beg end = offset) BEG and END are buffer positions delimiting the minimal area where cache data should be removed. OFFSET is the size of the change, as an integer." - (let ((next (car org-element--cache-sync-requests)) - delete-to delete-from) - (if (and next - (zerop (aref next 5)) - (> (setq delete-to (+ (aref next 2) (aref next 3))) end) - (<=3D (setq delete-from (aref next 1)) end)) - ;; Current changes can be merged with first sync request: we - ;; can save a partial cache synchronization. - (progn - (cl-incf (aref next 3) offset) - ;; If last change happened within area to be removed, extend - ;; boundaries of robust parents, if any. Otherwise, find - ;; first element to remove and update request accordingly. - (if (> beg delete-from) - (let ((up (aref next 4))) - (while up - (org-element--cache-shift-positions - up offset '(:contents-end :end)) - (setq up (org-element-property :parent up)))) - (let ((first (org-element--cache-for-removal beg delete-to offset))) - (when first - (aset next 0 (org-element--cache-key first)) - (aset next 1 (org-element-property :begin first)) - (aset next 4 (org-element-property :parent first)))))) - ;; Ensure cache is correct up to END. Also make sure that NEXT, - ;; if any, is no longer a 0-phase request, thus ensuring that - ;; phases are properly ordered. We need to provide OFFSET as - ;; optional parameter since current modifications are not known - ;; yet to the otherwise correct part of the cache (i.e, before - ;; the first request). - (when next (org-element--cache-sync (current-buffer) end beg)) - (let ((first (org-element--cache-for-removal beg end offset))) - (if first - (push (let ((beg (org-element-property :begin first)) - (key (org-element--cache-key first))) - (cond - ;; When changes happen before the first known - ;; element, re-parent and shift the rest of the - ;; cache. - ((> beg end) (vector key beg nil offset nil 1)) - ;; Otherwise, we find the first non robust - ;; element containing END. All elements between - ;; FIRST and this one are to be removed. - ((let ((first-end (org-element-property :end first))) - (and (> first-end end) - (vector key beg first-end offset first 0)))) - (t - (let* ((element (org-element--cache-find end)) - (end (org-element-property :end element)) - (up element)) - (while (and (setq up (org-element-property :parent up)) - (>=3D (org-element-property :begin up) beg)) - (setq end (org-element-property :end up) - element up)) - (vector key beg end offset element 0))))) - org-element--cache-sync-requests) - ;; No element to remove. No need to re-parent either. - ;; Simply shift additional elements, if any, by OFFSET. - (when org-element--cache-sync-requests - (cl-incf (aref (car org-element--cache-sync-requests) 3) - offset))))))) - + (org-element--cache-log-message "Submitting new synchronization request = for [%S..%S]=F0=9D=9D=99%S" + beg end offset) + (with-current-buffer (or (buffer-base-buffer (current-buffer)) + (current-buffer)) + (let ((next (car org-element--cache-sync-requests)) + delete-to delete-from) + (if (and next + ;; First existing sync request is in phase 0. + (=3D 0 (org-element--request-phase next)) + ;; Current changes intersect with the first sync request. + (> (setq delete-to (+ (org-element--request-end next) + (org-element--request-offset next))) + end) + (<=3D (setq delete-from (org-element--request-beg next)) + end)) + ;; Current changes can be merged with first sync request: we + ;; can save a partial cache synchronization. + (progn + (org-element--cache-log-message "Found another phase 0 request= intersecting with current") + ;; Update OFFSET of the existing request. + (cl-incf (org-element--request-offset next) offset) + ;; If last change happened within area to be removed, extend + ;; boundaries of robust parents, if any. Otherwise, find + ;; first element to remove and update request accordingly. + (if (> beg delete-from) + ;; The current modification is completely inside NEXT. + ;; We already added the current OFFSET to the NEXT + ;; request. However, the robust elements around + ;; modifications also need to be shifted. Moreover, the + ;; new modification may also have non-nil + ;; `org-element--cache-change-warning'. In the latter cas= e, we + ;; also need to update the request. + (let ((first (org-element--cache-for-removal beg end offse= t) ; Shift as needed. + )) + (org-element--cache-log-message "Current request is insi= de next. Candidate parent: %S" + (org-element--format-element first)) + (when + ;; Non-robust element is now before NEXT. Need to + ;; update. + (and first + (org-element--cache-key-less-p (org-element--ca= che-key first) + (org-element--request-key n= ext))) + (org-element--cache-log-message "Current request is in= side next. New parent: %S" + (org-element--format-element firs= t)) + (setf (org-element--request-key next) (org-element--ca= che-key first)) + (setf (org-element--request-beg next) (org-element-pro= perty :begin first)) + (setf (org-element--request-end next) (max (org-elemen= t-property :end first) + (org-element--request-= end next))) + (setf (org-element--request-parent next) (org-element-= property :parent first)))) + ;; The current and NEXT modifications are intersecting + ;; with current modification starting before NEXT and NEXT + ;; ending after current. We need to update the common + ;; non-robust parent for the new extended modification + ;; region. + (let ((first (org-element--cache-for-removal beg delete-to offset))) + (org-element--cache-log-message "Current request intersect= s with next. Candidate parent: %S" + (org-element--format-element first)) + (when (and first + (org-element--cache-key-less-p (org-element--ca= che-key first) + (org-element--request-key n= ext))) + (org-element--cache-log-message "Current request interse= cts with next. Updating. New parent: %S" + (org-element--format-element first)) + (setf (org-element--request-key next) (org-element--cach= e-key first)) + (setf (org-element--request-beg next) (org-element-prope= rty :begin first)) + (setf (org-element--request-end next) (max (org-element-= property :end first) + (org-element--request-en= d next))) + (setf (org-element--request-parent next) (org-element-pr= operty :parent first)))))) + ;; Ensure cache is correct up to END. Also make sure that NEXT, + ;; if any, is no longer a 0-phase request, thus ensuring that + ;; phases are properly ordered. We need to provide OFFSET as + ;; optional parameter since current modifications are not known + ;; yet to the otherwise correct part of the cache (i.e, before + ;; the first request). + (org-element--cache-log-message "Adding new phase 0 request") + ;; FIXME: Disabling this optimisation to hunt errors. + ;; (when next (org-element--cache-sync (current-buffer) end beg)) + (when next (org-element--cache-sync (current-buffer) end)) + (let ((first (org-element--cache-for-removal beg end offset))) + (if first + (push (let ((first-beg (org-element-property :begin first)) + (key (org-element--cache-key first))) + (cond + ;; When changes happen before the first known + ;; element, re-parent and shift the rest of the + ;; cache. + ((> first-beg end) + (org-element--cache-log-message "Changes are befor= e first known element. Submitting phase 1 request") + (vector key first-beg nil offset nil 1)) + ;; Otherwise, we find the first non robust + ;; element containing END. All elements between + ;; FIRST and this one are to be removed. + ;; + ;; The current modification is completely inside + ;; FIRST. Clear and update cached elements in + ;; region containing FIRST. + ((let ((first-end (org-element-property :end first))) + (when (> first-end end) + (org-element--cache-log-message "Extending to = non-robust element %S" (org-element--format-element first)) + (vector key first-beg first-end offset (org-element-property :paren= t first) 0)))) + (t + ;; Now, FIRST is the first element after BEG or + ;; non-robust element containing BEG. However, + ;; FIRST ends before END and there might be + ;; another ELEMENT before END that spans beyond + ;; END. If there is such element, we need to + ;; extend the region down to end of the common + ;; parent of FIRST and everything inside + ;; BEG..END. + (let* ((element (org-element--cache-find end)) + (element-end (org-element-property :end element)) + (up element)) + (while (and (not (eq up first)) + (setq up (org-element-property :pare= nt up)) + (>=3D (org-element-property :begin up) first-beg)) + ;; Note that UP might have been already + ;; shifted if it is a robust element. After + ;; deletion, it can put it's end before yet + ;; unprocessed ELEMENT. + (setq element-end (max (org-element-property :end up) element-end) + element up)) + ;; Extend region to remove elements between + ;; beginning of first and the end of outermost + ;; element starting before END but after + ;; beginning of first. + ;; of the FIRST. + (org-element--cache-log-message "Extending to al= l elements between:\n 1: %S\n 2: %S" + (org-element--format-elemen= t first) + (org-element--format-elemen= t element)) + (vector key first-beg element-end offset up 0))))) + org-element--cache-sync-requests) + ;; No element to remove. No need to re-parent either. + ;; Simply shift additional elements, if any, by OFFSET. + (if org-element--cache-sync-requests + (progn + (org-element--cache-log-message "Nothing to remove. Upda= ting offset of the next request by =F0=9D=9D=99%d: %S" + offset + (let ((print-level 3)) + (car org-element--cache-sync-requ= ests))) + (cl-incf (org-element--request-offset (car org-element--cache-s= ync-requests)) + offset)) + (org-element--cache-log-message "Nothing to remove. No eleme= nts in cache after %d. Terminating." + end)))))) + (setq org-element--cache-change-warning nil))) + +(defun org-element--cache-verify-element (element) + "Verify correctness of ELEMENT when `org-element--cache-self-verify' is = non-nil. + +Return non-nil when verification failed." + ;; Verify correct parent for the element. + (let ((org-element--cache-self-verify (or org-element--cache-self-verify + (and (boundp 'org-batch-test) org-batch-t= est))) + (org-element--cache-self-verify-frequency (if (and (boundp 'org-ba= tch-test) org-batch-test) + 1 + org-element--cache-self-verify-fr= equency))) + (when (and org-element--cache-self-verify + (org-element--cache-active-p) + (derived-mode-p 'org-mode) + (org-element-property :parent element) + (eq 'headline (org-element-type element)) + ;; Avoid too much slowdown + (< (random 1000) (* 1000 org-element--cache-self-verify-fre= quency))) + (org-with-point-at (org-element-property :begin element) + (org-element-with-disabled-cache (org-up-heading-or-point-min)) + (unless (or (=3D (point) (org-element-property :begin (org-element= -property :parent element))) + (eq (point) (point-min))) + (org-element--cache-warn "Cached element has wrong parent in %s.= Resetting.\n The element is: %S\n The parent is: %S\n The real parent is: = %S" + (buffer-name (current-buffer)) + (org-element--format-element element) + (org-element--format-element (org-element-property= :parent element)) + (org-element--format-element (org-element--current= -element (org-element-property :end (org-element-property :parent element))= ))) + (org-element-cache-reset)) + (org-element--cache-verify-element (org-element-property :parent e= lement)))) + ;; Verify the element itself. + (when (and org-element--cache-self-verify + (org-element--cache-active-p) + element + (not (memq (org-element-type element) '(section org-data))) + ;; Avoid too much slowdown + (< (random 1000) (* 1000 org-element--cache-self-verify-fre= quency))) + (let ((real-element (let (org-element-use-cache) + (org-element--parse-to + (if (memq (org-element-type element) '(table-= row item)) + (1+ (org-element-property :begin element)) + (org-element-property :begin element)))))) + (unless (and (eq (org-element-type real-element) (org-element-type= element)) + (eq (org-element-property :begin real-element) (org-e= lement-property :begin element)) + (eq (org-element-property :end real-element) (org-ele= ment-property :end element)) + (eq (org-element-property :contents-begin real-elemen= t) (org-element-property :contents-begin element)) + (eq (org-element-property :contents-end real-element)= (org-element-property :contents-end element)) + (or (not (org-element-property :ID real-element)) + (string=3D (org-element-property :ID real-element= ) (org-element-property :ID element)))) + (org-element--cache-warn "(%S) Cached element is incorrect in %s= . (Cache tic up to date: %S) Resetting.\n The element is: %S\n The real ele= ment is: %S\n Cache around :begin:\n%S\n%S\n%S" + this-command + (buffer-name (current-buffer)) + (if (/=3D org-element--cache-change-tic + (buffer-chars-modified-tick)) + "no" "yes") + (org-element--format-element element) + (org-element--format-element real-element) + (org-element--cache-find (1- (org-element-property= :begin real-element))) + (car (org-element--cache-find (org-element-propert= y :begin real-element) 'both)) + (cdr (org-element--cache-find (org-element-propert= y :begin real-element) 'both))) + (org-element-cache-reset)))))) =20 ;;;; Public Functions =20 @@ -5941,12 +6859,18 @@ (defun org-element-cache-reset (&optional all) buffers." (interactive "P") (dolist (buffer (if all (buffer-list) (list (current-buffer)))) - (with-current-buffer buffer + (with-current-buffer (or (buffer-base-buffer buffer) buffer) (when (and org-element-use-cache (derived-mode-p 'org-mode)) + (setq-local org-element--cache-change-tic (buffer-chars-modified-t= ick)) (setq-local org-element--cache (avl-tree-create #'org-element--cache-compare)) - (setq-local org-element--cache-sync-keys - (make-hash-table :weakness 'key :test #'eq)) + (setq-local org-element--cache-size 0) + (when org-element-cache-persistent + (org-element--cache-read) + (add-hook 'kill-buffer-hook #'org-element--cache-write 1000 'loc= al) + (add-hook 'kill-emacs-hook #'org-element-cache-gc) + (add-hook 'kill-emacs-hook #'org-element--cache-write-all 1000)) + (setq-local org-element--cache-sync-keys-value (buffer-chars-modified-tic= k)) (setq-local org-element--cache-change-warning nil) (setq-local org-element--cache-sync-requests nil) (setq-local org-element--cache-sync-timer nil) @@ -5963,8 +6887,108 @@ (defun org-element-cache-refresh (pos) (org-element--cache-submit-request pos pos 0) (org-element--cache-set-timer (current-buffer)))) =20 - + +;;;; Persistent cache + +(defun org-element--cache-get-cache-index () + "Return plist used to store cache of the current buffer." + (when (and (org-element--cache-active-p) + (buffer-file-name)) + (let* ((buffer-file (buffer-file-name)) + (inode (file-attribute-inode-number (file-attributes buffer-fil= e)))) + (let ((result (or (seq-find (lambda (plist) (equal inode (plist-get = plist :inode))) org-element-cache--index) + (seq-find (lambda (plist) (equal buffer-file (plis= t-get plist :path))) org-element-cache--index)))) + (when result + (unless (equal buffer-file (plist-get result :path)) + (setf result (plist-put result :path buffer-file)))) + (unless result + (push (list :path buffer-file + :inode inode + :hash (secure-hash 'md5 (current-buffer)) + :cache-file (replace-regexp-in-string "^.." "\\&/" (= org-id-uuid))) + org-element-cache--index) + (setf result (car org-element-cache--index))) + result)))) + +(defun org-element--cache-write (&optional all-buffers) + "Save cache in current buffer or all the buffers when AL-BUFFERS is non-= nil." + (let ((buffer-list (if all-buffers (buffer-list) (list (current-buffer))= ))) + (dolist (buf buffer-list) + (with-current-buffer buf + (when (and (org-element--cache-active-p) + org-element-cache-persistent + (buffer-file-name) + (not (buffer-modified-p))) + (let ((index (org-element--cache-get-cache-index))) + (setf index (plist-put index :hash (secure-hash 'md5 (current-= buffer)))) + (unless (file-exists-p org-element-cache-path) + (make-directory org-element-cache-path)) + (let ((cache org-element--cache) + (print-circle t) + (print-continuous-numbering t) + print-number-table) + (org-with-wide-buffer + (org-element--cache-sync (current-buffer) (point-max))) + (with-temp-file (file-name-concat org-element-cache-path org= -element-cache-index-file) + (prin1 org-element-cache--index (current-buffer))) + (let ((file (file-name-concat org-element-cache-path (plist-= get index :cache-file)))) + (unless (file-exists-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (with-temp-file file + (prin1 cache (current-buffer))))))))))) + +(defun org-element--cache-write-all () + "Write cache in all buffers." + (org-element--cache-write t)) + +(defun org-element-cache-gc () + "Remove cached data for not existing files." + (when org-element-cache-persistent + (let (new-index) + (dolist (index org-element-cache--index) + (let ((file (plist-get index :path)) + (cache-file (plist-get index :cache-file))) + (if (file-exists-p file) + (push index new-index) + (when (file-exists-p (file-name-concat org-element-cache-path = cache-file)) + (delete-file (file-name-concat org-element-cache-path cache-= file)) + (when (directory-empty-p (file-name-directory (file-name-con= cat org-element-cache-path cache-file))) + (delete-directory (file-name-directory (file-name-concat o= rg-element-cache-path cache-file)))))))) + (setq org-element-cache--index (nreverse new-index))))) + +(defun org-element--cache-read () + "Restore cache for the current buffer" + (when (and (org-element--cache-active-p) + org-element-cache-persistent + (buffer-file-name) + (not (buffer-modified-p))) + (unless org-element-cache--index + (when (file-exists-p (file-name-concat org-element-cache-path org-el= ement-cache-index-file)) + (with-temp-buffer + (insert-file-contents (file-name-concat org-element-cache-path o= rg-element-cache-index-file)) + (setq org-element-cache--index (read (current-buffer)))))) + (let* ((index (org-element--cache-get-cache-index)) + (cache-file (file-name-concat org-element-cache-path (plist-get= index :cache-file))) + (cache nil)) + (when (and (file-exists-p cache-file) + (equal (secure-hash 'md5 (current-buffer)) (plist-get ind= ex :hash))) + (with-temp-buffer + (let ((coding-system-for-read 'utf-8) + (read-circle t)) + (insert-file-contents cache-file)) + ;; FIXME: Reading sometimes fails to read circular objects. + ;; I suspect that it happens when we have object reference + ;; #N# read before object definition #N=3D. If it is really + ;; #so, it should be Emacs bug - either in `read' or in + ;; #`prin1'. Meanwhile, just fail silently when `read' + ;; #fails to parse the saved cache object. + (condition-case nil + (setq cache (read (current-buffer))) + (error (setq cache nil)))) + (setq-local org-element--cache cache) + (setq-local org-element--cache-size (avl-tree-size org-element--ca= che)))))) + ;;; The Toolbox ;; ;; The first move is to implement a way to obtain the smallest element @@ -5983,8 +7007,11 @@ ;;; The Toolbox =20 =20 ;;;###autoload -(defun org-element-at-point () - "Determine closest element around point. +(defun org-element-at-point (&optional pom cached-only) + "Determine closest element around point or POM. + +Only check cached element when CACHED-ONLY is non-nil and return nil +unconditionally when element at POM is not in cache. =20 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 @@ -6002,24 +7029,61 @@ (defun org-element-at-point () =20 When point is at the end of the buffer, return the innermost element ending there." - (org-with-wide-buffer - (let ((origin (point))) - (end-of-line) - (skip-chars-backward " \r\t\n") - (cond - ;; Within blank lines at the beginning of buffer, return nil. - ((bobp) nil) - ;; Within blank lines right after a headline, return that - ;; headline. - ((org-with-limited-levels (org-at-heading-p)) - (beginning-of-line) - (org-element-headline-parser (point-max) t)) - ;; Otherwise parse until we find element containing ORIGIN. - (t - (when (org-element--cache-active-p) - (if (not org-element--cache) (org-element-cache-reset) - (org-element--cache-sync (current-buffer) origin))) - (org-element--parse-to origin)))))) + (setq pom (or pom (point))) + ;; Allow re-parsing when the command can benefit from it. + (when (and cached-only + (memq this-command org-element--cache-non-modifying-commands)) + (setq cached-only nil)) + (let (element) + (when (org-element--cache-active-p) + (if (not org-element--cache) (org-element-cache-reset) + (unless cached-only (org-element--cache-sync (current-buffer) pom)= ))) + (setq element (if cached-only + (and (org-element--cache-active-p) + (or (not org-element--cache-sync-requests) + (org-element--cache-key-less-p pom (org-ele= ment--request-key (car org-element--cache-sync-requests)))) + (org-element--cache-find pom)) + (condition-case err + (org-element--parse-to pom) + (error + (org-element--cache-warn "Cache corruption detected= in %s. Resetting.\n The error was: %S" + (buffer-name (current-buffer)) + err) + (org-element-cache-reset) + (org-element--parse-to pom))))) + (when (and (org-element--cache-active-p) + element + (org-element--cache-verify-element element)) + (setq element (org-element--parse-to pom))) + (unless (eq 'org-data (org-element-type element)) + (unless (and cached-only + (not (and element + (or (=3D pom (org-element-property :begin ele= ment)) + (and (not (memq (org-element-type element= ) org-element-greater-elements)) + (>=3D pom (org-element-property :beg= in element)) + (< pom (org-element-property :end el= ement))) + (and (org-element-property :contents-begi= n element) + (>=3D pom (org-element-property :beg= in element)) + (< pom (org-element-property :conten= ts-begin element))) + (and (org-element-property :contents-end = element) + (< pom (org-element-property :end el= ement)) + (>=3D pom (org-element-property :con= tents-end element))) + (and (not (org-element-property :contents= -end element)) + (>=3D pom (org-element-property :beg= in element)) + (< pom (org-element-property :end el= ement))))))) + (if (not (eq (org-element-type element) 'section)) + element + (org-element-at-point (1+ pom) cached-only)))))) + +;;;###autoload +(defsubst org-element-at-point-no-context (&optional pom) + "Quickly find element at point or POM. + +It is a faster version of `org-element-at-point' that is not +guaranteed to return correct `:parent' properties even when cache is +enabled." + (or (org-element-at-point pom 'cached-only) + (let (org-element-use-cache) (org-element-at-point pom)))) =20 ;;;###autoload (defun org-element-context (&optional element) @@ -6043,7 +7107,7 @@ (defun org-element-context (&optional element) (catch 'objects-forbidden (org-with-wide-buffer (let* ((pos (point)) - (element (or element (org-element-at-point))) + (element (or element (org-element-at-point-no-context))) (type (org-element-type element)) (post (org-element-property :post-affiliated element))) ;; If point is inside an element containing objects or --=-=-=--