branch: externals/org
commit fefc6711b30e20b067432483977161f91b66e12a
Author: Ihor Radchenko <yanta...@posteo.net>
Commit: Ihor Radchenko <yanta...@posteo.net>
org-src-font-lock-fontify-block: Gracefully recover from fontification
failure
* lisp/org-src.el (org-src-font-lock-fontify-block): When native
fontification fails for any reason (it may depend on user
configuration, for example), do not abort fontifying the Org buffer,
but just drop a message and skip fontifying a given src block.
Reported-by: Jordan Ellis Coppard <jc+o.orgm...@wz.ht>
Link: https://orgmode.org/list/m234dy2b18....@wz.ht
---
lisp/org-src.el | 137 +++++++++++++++++++++++++++++---------------------------
1 file changed, 72 insertions(+), 65 deletions(-)
diff --git a/lisp/org-src.el b/lisp/org-src.el
index a39a4066bd..2b2dab7725 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -669,71 +669,78 @@ as `org-src-fontify-natively' is non-nil."
(remove-text-properties start end '(face nil))
(let ((lang-mode (org-src-get-lang-mode lang)))
(when (fboundp lang-mode)
- (let ((string (buffer-substring-no-properties start end))
- (org-buffer (current-buffer)))
- (with-current-buffer
- (get-buffer-create
- (format " *org-src-fontification:%s*" lang-mode))
- (let ((inhibit-modification-hooks nil))
- (erase-buffer)
- ;; Add string and a final space to ensure property change.
- (insert string " "))
- (unless (eq major-mode lang-mode) (funcall lang-mode))
- (setq native-tab-width tab-width)
- (font-lock-ensure)
- (let ((pos (point-min)) next
- ;; Difference between positions here and in org-buffer.
- (offset (- start (point-min))))
- (while (setq next (next-property-change pos))
- ;; Handle additional properties from font-lock, so as to
- ;; preserve, e.g., composition.
- ;; FIXME: We copy 'font-lock-face property explicitly because
- ;; `font-lock-mode' is not enabled in the buffers starting from
- ;; space and the remapping between 'font-lock-face and 'face
- ;; text properties may thus not be set. See commit
- ;; 453d634bc.
- (dolist (prop (append '(font-lock-face face)
font-lock-extra-managed-props))
- (let ((new-prop (get-text-property pos prop)))
- (when new-prop
- (if (not (eq prop 'invisible))
- (put-text-property
- (+ offset pos) (+ offset next) prop new-prop
- org-buffer)
- ;; Special case. `invisible' text property may
- ;; clash with Org folding. Do not assign
- ;; `invisible' text property directly. Use
- ;; property alias instead.
- (let ((invisibility-spec
- (or
- ;; ATOM spec.
- (and (memq new-prop buffer-invisibility-spec)
- new-prop)
- ;; (ATOM . ELLIPSIS) spec.
- (assq new-prop buffer-invisibility-spec))))
- (with-current-buffer org-buffer
- ;; Add new property alias.
- (unless (memq 'org-src-invisible
- (cdr (assq 'invisible
char-property-alias-alist)))
- (setq-local
- char-property-alias-alist
- (cons (cons 'invisible
- (nconc (cdr (assq 'invisible
char-property-alias-alist))
- '(org-src-invisible)))
- (remove (assq 'invisible
char-property-alias-alist)
- char-property-alias-alist))))
- ;; Carry over the invisibility spec, unless
- ;; already present. Note that there might
- ;; be conflicting invisibility specs from
- ;; different major modes. We cannot do much
- ;; about this then.
- (when invisibility-spec
- (add-to-invisibility-spec invisibility-spec))
- (put-text-property
- (+ offset pos) (+ offset next)
- 'org-src-invisible new-prop
- org-buffer)))))))
- (setq pos next)))
- (set-buffer-modified-p nil)))))
+ (condition-case nil
+ (let ((string (buffer-substring-no-properties start end))
+ (org-buffer (current-buffer)))
+ (with-current-buffer
+ (get-buffer-create
+ (format " *org-src-fontification:%s*" lang-mode))
+ (let ((inhibit-modification-hooks nil))
+ (erase-buffer)
+ ;; Add string and a final space to ensure property change.
+ (insert string " "))
+ (unless (eq major-mode lang-mode) (funcall lang-mode))
+ (setq native-tab-width tab-width)
+ (font-lock-ensure)
+ (let ((pos (point-min)) next
+ ;; Difference between positions here and in org-buffer.
+ (offset (- start (point-min))))
+ (while (setq next (next-property-change pos))
+ ;; Handle additional properties from font-lock, so as to
+ ;; preserve, e.g., composition.
+ ;; FIXME: We copy 'font-lock-face property explicitly
because
+ ;; `font-lock-mode' is not enabled in the buffers starting
from
+ ;; space and the remapping between 'font-lock-face and
'face
+ ;; text properties may thus not be set. See commit
+ ;; 453d634bc.
+ (dolist (prop (append '(font-lock-face face)
font-lock-extra-managed-props))
+ (let ((new-prop (get-text-property pos prop)))
+ (when new-prop
+ (if (not (eq prop 'invisible))
+ (put-text-property
+ (+ offset pos) (+ offset next) prop new-prop
+ org-buffer)
+ ;; Special case. `invisible' text property may
+ ;; clash with Org folding. Do not assign
+ ;; `invisible' text property directly. Use
+ ;; property alias instead.
+ (let ((invisibility-spec
+ (or
+ ;; ATOM spec.
+ (and (memq new-prop
buffer-invisibility-spec)
+ new-prop)
+ ;; (ATOM . ELLIPSIS) spec.
+ (assq new-prop buffer-invisibility-spec))))
+ (with-current-buffer org-buffer
+ ;; Add new property alias.
+ (unless (memq 'org-src-invisible
+ (cdr (assq 'invisible
char-property-alias-alist)))
+ (setq-local
+ char-property-alias-alist
+ (cons (cons 'invisible
+ (nconc (cdr (assq 'invisible
char-property-alias-alist))
+ '(org-src-invisible)))
+ (remove (assq 'invisible
char-property-alias-alist)
+ char-property-alias-alist))))
+ ;; Carry over the invisibility spec, unless
+ ;; already present. Note that there might
+ ;; be conflicting invisibility specs from
+ ;; different major modes. We cannot do much
+ ;; about this then.
+ (when invisibility-spec
+ (add-to-invisibility-spec invisibility-spec))
+ (put-text-property
+ (+ offset pos) (+ offset next)
+ 'org-src-invisible new-prop
+ org-buffer)))))))
+ (setq pos next)))
+ (set-buffer-modified-p nil)))
+ (error
+ (message "Native code fontification error in %S at pos%d\n Error:
%S"
+ (current-buffer) start
+ (when (and (fboundp 'backtrace-get-frames)
+ (fboundp 'backtrace-to-string))
+ (backtrace-to-string (backtrace-get-frames
'backtrace))))))))
;; Add Org faces.
(let ((src-face (nth 1 (assoc-string lang org-src-block-faces t))))
(when (or (facep src-face) (listp src-face))
