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.
|
"Fontify code block between START and END using LANG's syntax.
|
||||||
This function is called by Emacs' automatic fontification, as long
|
This function is called by Emacs' automatic fontification, as long
|
||||||
as `org-src-fontify-natively' is non-nil."
|
as `org-src-fontify-natively' is non-nil."
|
||||||
(let ((lang-mode (org-src-get-lang-mode lang)))
|
(let ((modified (buffer-modified-p)))
|
||||||
(when (fboundp lang-mode)
|
(remove-text-properties start end '(face nil))
|
||||||
(let ((string (buffer-substring-no-properties start end))
|
(let ((lang-mode (org-src-get-lang-mode lang)))
|
||||||
(modified (buffer-modified-p))
|
(when (fboundp lang-mode)
|
||||||
(org-buffer (current-buffer)))
|
(let ((string (buffer-substring-no-properties start end))
|
||||||
(remove-text-properties start end '(face nil))
|
(org-buffer (current-buffer)))
|
||||||
(with-current-buffer
|
(with-current-buffer
|
||||||
(get-buffer-create
|
(get-buffer-create
|
||||||
(format " *org-src-fontification:%s*" lang-mode))
|
(format " *org-src-fontification:%s*" lang-mode))
|
||||||
(let ((inhibit-modification-hooks nil))
|
(let ((inhibit-modification-hooks nil))
|
||||||
(erase-buffer)
|
(erase-buffer)
|
||||||
;; Add string and a final space to ensure property change.
|
;; Add string and a final space to ensure property change.
|
||||||
(insert string " "))
|
(insert string " "))
|
||||||
(unless (eq major-mode lang-mode) (funcall lang-mode))
|
(unless (eq major-mode lang-mode) (funcall lang-mode))
|
||||||
(font-lock-ensure)
|
(font-lock-ensure)
|
||||||
(let ((pos (point-min)) next)
|
(let ((pos (point-min)) next)
|
||||||
(while (setq next (next-property-change pos))
|
(while (setq next (next-property-change pos))
|
||||||
;; Handle additional properties from font-lock, so as to
|
;; Handle additional properties from font-lock, so as to
|
||||||
;; preserve, e.g., composition.
|
;; preserve, e.g., composition.
|
||||||
;; FIXME: We copy 'font-lock-face property explicitly because
|
;; FIXME: We copy 'font-lock-face property explicitly because
|
||||||
;; `font-lock-mode' is not enabled in the buffers starting from
|
;; `font-lock-mode' is not enabled in the buffers starting from
|
||||||
;; space and the remapping between 'font-lock-face and 'face
|
;; space and the remapping between 'font-lock-face and 'face
|
||||||
;; text properties may thus not be set. See commit
|
;; text properties may thus not be set. See commit
|
||||||
;; 453d634bc.
|
;; 453d634bc.
|
||||||
(dolist (prop (append '(font-lock-face face) font-lock-extra-managed-props))
|
(dolist (prop (append '(font-lock-face face) font-lock-extra-managed-props))
|
||||||
(let ((new-prop (get-text-property pos prop)))
|
(let ((new-prop (get-text-property pos prop)))
|
||||||
(when new-prop
|
(when new-prop
|
||||||
(if (not (eq prop 'invisible))
|
(if (not (eq prop 'invisible))
|
||||||
(put-text-property
|
(put-text-property
|
||||||
(+ start (1- pos)) (1- (+ start next)) prop new-prop
|
(+ start (1- pos)) (1- (+ start next)) prop new-prop
|
||||||
org-buffer)
|
org-buffer)
|
||||||
;; Special case. `invisible' text property may
|
;; Special case. `invisible' text property may
|
||||||
;; clash with Org folding. Do not assign
|
;; clash with Org folding. Do not assign
|
||||||
;; `invisible' text property directly. Use
|
;; `invisible' text property directly. Use
|
||||||
;; property alias instead.
|
;; property alias instead.
|
||||||
(let ((invisibility-spec
|
(let ((invisibility-spec
|
||||||
(or
|
(or
|
||||||
;; ATOM spec.
|
;; ATOM spec.
|
||||||
(and (memq new-prop buffer-invisibility-spec)
|
(and (memq new-prop buffer-invisibility-spec)
|
||||||
new-prop)
|
new-prop)
|
||||||
;; (ATOM . ELLIPSIS) spec.
|
;; (ATOM . ELLIPSIS) spec.
|
||||||
(assq new-prop buffer-invisibility-spec))))
|
(assq new-prop buffer-invisibility-spec))))
|
||||||
(with-current-buffer org-buffer
|
(with-current-buffer org-buffer
|
||||||
;; Add new property alias.
|
;; Add new property alias.
|
||||||
(unless (memq 'org-src-invisible
|
(unless (memq 'org-src-invisible
|
||||||
(cdr (assq 'invisible char-property-alias-alist)))
|
(cdr (assq 'invisible char-property-alias-alist)))
|
||||||
(setq-local
|
(setq-local
|
||||||
char-property-alias-alist
|
char-property-alias-alist
|
||||||
(cons (cons 'invisible
|
(cons (cons 'invisible
|
||||||
(nconc (cdr (assq 'invisible char-property-alias-alist))
|
(nconc (cdr (assq 'invisible char-property-alias-alist))
|
||||||
'(org-src-invisible)))
|
'(org-src-invisible)))
|
||||||
(remove (assq 'invisible char-property-alias-alist)
|
(remove (assq 'invisible char-property-alias-alist)
|
||||||
char-property-alias-alist))))
|
char-property-alias-alist))))
|
||||||
;; Carry over the invisibility spec, unless
|
;; Carry over the invisibility spec, unless
|
||||||
;; already present. Note that there might
|
;; already present. Note that there might
|
||||||
;; be conflicting invisibility specs from
|
;; be conflicting invisibility specs from
|
||||||
;; different major modes. We cannot do much
|
;; different major modes. We cannot do much
|
||||||
;; about this then.
|
;; about this then.
|
||||||
(when invisibility-spec
|
(when invisibility-spec
|
||||||
(add-to-invisibility-spec invisibility-spec))
|
(add-to-invisibility-spec invisibility-spec))
|
||||||
(put-text-property
|
(put-text-property
|
||||||
(+ start (1- pos)) (1- (+ start next))
|
(+ start (1- pos)) (1- (+ start next))
|
||||||
'org-src-invisible new-prop
|
'org-src-invisible new-prop
|
||||||
org-buffer)))))))
|
org-buffer)))))))
|
||||||
(setq pos next)))
|
(setq pos next)))
|
||||||
(set-buffer-modified-p nil))
|
(set-buffer-modified-p nil)))))
|
||||||
;; Add Org faces.
|
;; Add Org faces.
|
||||||
(let ((src-face (nth 1 (assoc-string lang org-src-block-faces t))))
|
(let ((src-face (nth 1 (assoc-string lang org-src-block-faces t))))
|
||||||
(when (or (facep src-face) (listp src-face))
|
(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 src-face))
|
||||||
(font-lock-append-text-property start end 'face 'org-block))
|
(font-lock-append-text-property start end 'face 'org-block))
|
||||||
;; Clear abbreviated link folding.
|
;; Clear abbreviated link folding.
|
||||||
(org-fold-region start end nil 'org-link)
|
(org-fold-region start end nil 'org-link)
|
||||||
(add-text-properties
|
(add-text-properties
|
||||||
start end
|
start end
|
||||||
'(font-lock-fontified t fontified t font-lock-multiline t))
|
'(font-lock-fontified t fontified t font-lock-multiline t))
|
||||||
(set-buffer-modified-p modified)))))
|
(set-buffer-modified-p modified)))
|
||||||
|
|
||||||
(defun org-fontify-inline-src-blocks (limit)
|
(defun org-fontify-inline-src-blocks (limit)
|
||||||
"Try to apply `org-fontify-inline-src-blocks-1'."
|
"Try to apply `org-fontify-inline-src-blocks-1'."
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue