Hi emacs-orgmode, I use prettify-symbols-mode heavily, and prettification isn't currently copied by org-src's native fontification. The two attached patches add this feature. You can test them by enabling global-prettify-symbols-mode and creating an emacs-lisp code block in org-mode. I already have FSF papers on file.
The first one is not strictly necessary, but it makes the second one easier to write, and it fixes (what I think is) a bug in the current implementation (if the 'face in the fontified buffer is already a list, say '(a b), then org-src will construct an invalid face '(:inherit (a b) org-block)) instead of (:inherit (a b org-block))—which could really just be (a b org-block), as done by patch 1). Cheers, Clément.
From 1ee0c94dba1519d7a32161a826421b455cea75b8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <clement.pitclau...@live.com>
Date: Sun, 7 Aug 2016 14:59:05 -0400
Subject: [PATCH 1/2] Use font-lock-append-text-property to apply org-src faces
* lisp/org-src.el (org-src-font-lock-fontify-block): Replace anonymous
faces with inheritance by lists of faces constructed by
`font-lock-add-text-property`. This properly deals with cases when
the source buffer's `face' property is already a list.
---
lisp/org-src.el | 19 ++++++++-----------
1 file changed, 8 insertions(+), 11 deletions(-)
diff --git a/lisp/org-src.el b/lisp/org-src.el
index 892c52e..9392e58 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -492,10 +492,7 @@ as `org-src-fontify-natively' is non-nil."
(when (fboundp lang-mode)
(let ((string (buffer-substring-no-properties start end))
(modified (buffer-modified-p))
- (org-buffer (current-buffer))
- (block-faces (let ((face-name (intern (format "org-block-%s" lang))))
- (append (and (facep face-name) (list face-name))
- '(org-block)))))
+ (org-buffer (current-buffer)))
(remove-text-properties start end '(face nil))
(with-current-buffer
(get-buffer-create
@@ -509,14 +506,14 @@ as `org-src-fontify-natively' is non-nil."
(while (setq next (next-single-property-change pos 'face))
(let ((new-face (get-text-property pos 'face)))
(put-text-property
- (+ start (1- pos)) (1- (+ start next)) 'face
- (list :inherit (append (and new-face (list new-face))
- block-faces))
+ (+ start (1- pos)) (1- (+ start next)) 'face new-face
org-buffer))
- (setq pos next))
- ;; Add the face to the remaining part of the text.
- (put-text-property (1- (+ start pos)) end 'face
- (list :inherit block-faces) org-buffer)))
+ (setq pos next))))
+ ;; Add org faces
+ (let ((face-name (intern (format "org-block-%s" lang))))
+ (when face-name
+ (font-lock-append-text-property start end 'face face-name))
+ (font-lock-append-text-property start end 'face 'org-block))
(add-text-properties
start end
'(font-lock-fontified t fontified t font-lock-multiline t))
--
2.7.4
From 6a586ffca728f78d9a0dbb5b27eb3388e5fdd49f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <clement.pitclau...@live.com> Date: Sun, 7 Aug 2016 15:03:55 -0400 Subject: [PATCH 2/2] Copy all font-lock properties in org-src, not just face * lisp/org-src (org-src-font-lock-fontify-block): Loop over `font-lock-extra-managed-props', thus copying other properties that might be applied using font-lock. An example is composition, applied by `prettify-symbols-mode'. --- lisp/org-src.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index 9392e58..33eee4b 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -503,11 +503,12 @@ as `org-src-fontify-natively' is non-nil." (unless (eq major-mode lang-mode) (funcall lang-mode)) (org-font-lock-ensure) (let ((pos (point-min)) next) - (while (setq next (next-single-property-change pos 'face)) - (let ((new-face (get-text-property pos 'face))) - (put-text-property - (+ start (1- pos)) (1- (+ start next)) 'face new-face - org-buffer)) + (while (setq next (next-property-change pos)) + (dolist (prop (cons 'face font-lock-extra-managed-props)) + (let ((new-prop (get-text-property pos prop))) + (put-text-property + (+ start (1- pos)) (1- (+ start next)) prop new-prop + org-buffer))) (setq pos next)))) ;; Add org faces (let ((face-name (intern (format "org-block-%s" lang)))) -- 2.7.4
signature.asc
Description: OpenPGP digital signature
