emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH v2 31/38] org-fold-core: Fix fontification inside folded regions


From: Ihor Radchenko
Subject: [PATCH v2 31/38] org-fold-core: Fix fontification inside folded regions
Date: Wed, 20 Apr 2022 21:28:01 +0800

* lisp/org-fold-core.el (org-fold-core-initialize): Declare
`org-fold-core-fontified' text property for font-lock.
(org-fold-core--force-fontification): New variable controlling forced
fontification inside folded regions.
(org-fold-core-fontify-region): Fix cases when BEG is inside folded
region.  Respect `org-fold-core--force-fontification'.
* lisp/org-macs.el (org-with-forced-fontification): New macro.
(org-buffer-substring-fontified):
(org-looking-at-fontified): Do not rely on jit-lock.  Use
`org-fold-core-fontified' text property to determine whether text is
already fontified.
---
 lisp/org-fold-core.el | 69 +++++++++++++++++++++++++------------------
 lisp/org-macs.el      | 31 +++++++++++++++++++
 2 files changed, 72 insertions(+), 28 deletions(-)

diff --git a/lisp/org-fold-core.el b/lisp/org-fold-core.el
index 121c6b5c4..edae316ff 100644
--- a/lisp/org-fold-core.el
+++ b/lisp/org-fold-core.el
@@ -746,7 +746,8 @@ (defun org-fold-core-initialize (&optional specs)
   (add-hook 'clone-indirect-buffer-hook 
#'org-fold-core-decouple-indirect-buffer-folds nil 'local)
   ;; Optimise buffer fontification to not fontify folded text.
   (when (eq font-lock-fontify-region-function 
#'font-lock-default-fontify-region)
-    (setq-local font-lock-fontify-region-function 
'org-fold-core-fontify-region))
+    (setq-local font-lock-fontify-region-function 
'org-fold-core-fontify-region)
+    (add-to-list 'font-lock-extra-managed-props 'org-fold-core-fontified))
   ;; Setup killing text
   (setq-local filter-buffer-substring-function 
#'org-fold-core--buffer-substring-filter)
   (if (and (boundp 'isearch-opened-regions)
@@ -1429,35 +1430,47 @@ (defun org-fold-core--buffer-substring-filter (beg end 
&optional delete)
     return-string))
 
 ;;; Do not fontify folded text until needed.
-
+(defvar org-fold-core--force-fontification nil
+  "Let-bind this variable to t in order to force fontification in
+folded regions.")
 (defun org-fold-core-fontify-region (beg end loudly &optional force)
   "Run `font-lock-default-fontify-region' in visible regions."
-  (let ((pos beg) next
-        (org-fold-core--fontifying t))
-    (while (< pos end)
-      (setq next (org-fold-core-next-folding-state-change
-                  (if force nil
-                    (let (result)
-                      (dolist (spec (org-fold-core-folding-spec-list))
-                        (when (and (not 
(org-fold-core-get-folding-spec-property spec :visible))
-                                   (org-fold-core-get-folding-spec-property 
spec :font-lock-skip))
-                          (push spec result)))
-                      result))
-                  pos
-                  end))
-      (while (and (not (catch :found
-                       (dolist (spec (org-fold-core-get-folding-spec 'all 
next))
-                         (when (org-fold-core-get-folding-spec-property spec 
:font-lock-skip)
-                           (throw :found spec)))))
-                  (< next end))
-        (setq next (org-fold-core-next-folding-state-change nil next end)))
-      (save-excursion
-        (font-lock-default-fontify-region pos next loudly)
-        (save-match-data
-          (unless (<= pos (point) next)
-            (run-hook-with-args 'org-fold-core-first-unfold-functions pos 
next))))
-      (put-text-property pos next 'org-fold-core-fontified t)
-      (setq pos next))))
+  (with-silent-modifications
+    (let ((pos beg) next
+          (force (or force org-fold-core--force-fontification))
+          (org-fold-core--fontifying t)
+          (skip-specs
+           (let (result)
+             (dolist (spec (org-fold-core-folding-spec-list))
+               (when (and (not (org-fold-core-get-folding-spec-property spec 
:visible))
+                          (org-fold-core-get-folding-spec-property spec 
:font-lock-skip))
+                 (push spec result)))
+             result)))
+      ;; Move POS to first visible point within BEG..END.
+      (while (and (catch :found
+                    (dolist (spec (org-fold-core-get-folding-spec 'all pos))
+                      (when (org-fold-core-get-folding-spec-property spec 
:font-lock-skip)
+                        (throw :found spec))))
+                  (< pos end))
+        (setq pos (org-fold-core-next-folding-state-change nil pos end)))
+      (when force (setq pos beg next end))
+      (while (< pos end)
+        (unless force
+          (setq next (org-fold-core-next-folding-state-change skip-specs pos 
end)))
+        ;; Move to the end of the region to be fontified.
+        (while (and (not (catch :found
+                         (dolist (spec (org-fold-core-get-folding-spec 'all 
next))
+                           (when (org-fold-core-get-folding-spec-property spec 
:font-lock-skip)
+                             (throw :found spec)))))
+                    (< next end))
+          (setq next (org-fold-core-next-folding-state-change nil next end)))
+        (save-excursion
+          (font-lock-default-fontify-region pos next loudly)
+          (save-match-data
+            (unless (<= pos (point) next)
+              (run-hook-with-args 'org-fold-core-first-unfold-functions pos 
next))))
+        (put-text-property pos next 'org-fold-core-fontified t)
+        (setq pos next)))))
 
 (defun org-fold-core-update-optimisation (beg end)
   "Update huge buffer optimisation between BEG and END.
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index a1d514d50..5e6728101 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -39,6 +39,7 @@ (declare-function org-agenda-files "org" (&optional 
unrestricted archives))
 (declare-function org-fold-show-context "org-fold" (&optional key))
 (declare-function org-fold-save-outline-visibility "org-fold" (use-markers 
&rest body))
 (declare-function org-fold-next-visibility-change "org-fold" (&optional pos 
limit ignore-hidden-p previous-p))
+(declare-function org-fold-core-with-forced-fontification "org-fold" (&rest 
body))
 (declare-function org-fold-folded-p "org-fold" (&optional pos limit 
ignore-hidden-p previous-p))
 (declare-function string-collate-lessp "org-compat" (s1 s2 &optional locale 
ignore-case))
 
@@ -1178,6 +1179,36 @@ (defconst org-rm-props '(invisible t face t keymap t 
intangible t mouse-face t
                                   org-emphasis t)
   "Properties to remove when a string without properties is wanted.")
 
+(defvar org-fold-core--force-fontification)
+(defmacro org-with-forced-fontification (&rest body)
+  "Run BODY forcing fontification of folded regions."
+  (declare (debug (form body)) (indent 1))
+  `(unwind-protect
+       (progn
+         (setq org-fold-core--force-fontification t)
+         ,@body)
+     (setq org-fold-core--force-fontification nil)))
+
+(defun org-buffer-substring-fontified (beg end)
+  "Return fontified region between BEG and END."
+  (when (bound-and-true-p jit-lock-mode)
+    (org-with-forced-fontification
+        (when (text-property-not-all beg end 'org-fold-core-fontified t)
+          (save-match-data (font-lock-fontify-region beg end)))))
+  (buffer-substring beg end))
+
+(defun org-looking-at-fontified (re)
+  "Call `looking-at' RE and make sure that the match is fontified."
+  (prog1 (looking-at re)
+    (when (bound-and-true-p jit-lock-mode)
+      (org-with-forced-fontification
+          (when (text-property-not-all
+                 (match-beginning 0) (match-end 0)
+                 'org-fold-core-fontified t)
+            (save-match-data
+              (font-lock-fontify-region (match-beginning 0)
+                                (match-end 0))))))))
+
 (defsubst org-no-properties (s &optional restricted)
   "Remove all text properties from string S.
 When RESTRICTED is non-nil, only remove the properties listed
-- 
2.35.1



-- 
Ihor Radchenko,
PhD,
Center for Advancing Materials Performance from the Nanoscale (CAMP-nano)
State Key Laboratory for Mechanical Behavior of Materials, Xi'an Jiaotong 
University, Xi'an, China
Email: yantar92@gmail.com, ihor_radchenko@alumni.sutd.edu.sg



reply via email to

[Prev in Thread] Current Thread [Next in Thread]