forked from mirrors/org-mode
org-src.el: Apply common faces even when src block language mode is absent
* lisp/org-src.el (org-src-font-lock-fontify-block): Apply `org-src-block-faces'/`org-block' faces even when no major mode is available for the src block language. Reported-by: duskhorn <duskhorn@proton.me> Link: https://orgmode.org/list/zCjC9UjXEgJk8kuyi8t2K2XzO3fL7pYWynHhoYWAes9eCA1FkomCY9bss4uKZfBg60M4xUisyDqFWKVMOn1r_XzUVE7gr3ci82MEOLjGIMk=@proton.me
This commit is contained in:
Ihor Radchenko
parent
de83f548d9
commit
ecfb55af0a
154
lisp/org-src.el
154
lisp/org-src.el
|
|
@ -629,83 +629,83 @@ Leave point in edit buffer."
|
|||
"Fontify code block between START and END using LANG's syntax.
|
||||
This function is called by Emacs' automatic fontification, as long
|
||||
as `org-src-fontify-natively' is non-nil."
|
||||
(let ((lang-mode (org-src-get-lang-mode lang)))
|
||||
(when (fboundp lang-mode)
|
||||
(let ((string (buffer-substring-no-properties start end))
|
||||
(modified (buffer-modified-p))
|
||||
(org-buffer (current-buffer)))
|
||||
(remove-text-properties start end '(face nil))
|
||||
(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))
|
||||
(font-lock-ensure)
|
||||
(let ((pos (point-min)) next)
|
||||
(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
|
||||
(+ start (1- pos)) (1- (+ start 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
|
||||
(+ start (1- pos)) (1- (+ start next))
|
||||
'org-src-invisible new-prop
|
||||
org-buffer)))))))
|
||||
(setq pos next)))
|
||||
(set-buffer-modified-p nil))
|
||||
;; Add Org faces.
|
||||
(let ((src-face (nth 1 (assoc-string lang org-src-block-faces t))))
|
||||
(when (or (facep src-face) (listp src-face))
|
||||
(font-lock-append-text-property start end 'face src-face))
|
||||
(font-lock-append-text-property start end 'face 'org-block))
|
||||
;; Clear abbreviated link folding.
|
||||
(org-fold-region start end nil 'org-link)
|
||||
(add-text-properties
|
||||
start end
|
||||
'(font-lock-fontified t fontified t font-lock-multiline t))
|
||||
(set-buffer-modified-p modified)))))
|
||||
(let ((modified (buffer-modified-p)))
|
||||
(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))
|
||||
(font-lock-ensure)
|
||||
(let ((pos (point-min)) next)
|
||||
(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
|
||||
(+ start (1- pos)) (1- (+ start 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
|
||||
(+ start (1- pos)) (1- (+ start next))
|
||||
'org-src-invisible new-prop
|
||||
org-buffer)))))))
|
||||
(setq pos next)))
|
||||
(set-buffer-modified-p nil)))))
|
||||
;; Add Org faces.
|
||||
(let ((src-face (nth 1 (assoc-string lang org-src-block-faces t))))
|
||||
(when (or (facep src-face) (listp src-face))
|
||||
(font-lock-append-text-property start end 'face src-face))
|
||||
(font-lock-append-text-property start end 'face 'org-block))
|
||||
;; Clear abbreviated link folding.
|
||||
(org-fold-region start end nil 'org-link)
|
||||
(add-text-properties
|
||||
start end
|
||||
'(font-lock-fontified t fontified t font-lock-multiline t))
|
||||
(set-buffer-modified-p modified)))
|
||||
|
||||
(defun org-fontify-inline-src-blocks (limit)
|
||||
"Try to apply `org-fontify-inline-src-blocks-1'."
|
||||
|
|
|
|||
Loading…
Reference in New Issue