emacs-orgmode
[Top][All Lists]
Advanced

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

Re: [BUG] org-block face not working for "non-default" languages


From: Ihor Radchenko
Subject: Re: [BUG] org-block face not working for "non-default" languages
Date: Mon, 26 Dec 2022 08:58:20 +0000

duskhorn <duskhorn@proton.me> writes:

> I have set up my org-mode so that I use variable pitch fonts for most of the 
> items and fixed pitch fonts for verbatim and src blocks.
>
> This works as expected for languages babel knows by default, for example 
> emacs-lisp, python and c++.
>
> However, I get variable pitch fonts for when I use an unrecognized language, 
> such as nim (in my case) or R. 

Can you try the attached patch?
>From 16a73725e2f9291f614f5dd6c34b05ac68eebc74 Mon Sep 17 00:00:00 2001
Message-Id: 
<16a73725e2f9291f614f5dd6c34b05ac68eebc74.1672045049.git.yantar92@posteo.net>
From: Ihor Radchenko <yantar92@posteo.net>
Date: Mon, 26 Dec 2022 11:55:26 +0300
Subject: [PATCH] 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
---
 lisp/org-src.el | 154 ++++++++++++++++++++++++------------------------
 1 file changed, 77 insertions(+), 77 deletions(-)

diff --git a/lisp/org-src.el b/lisp/org-src.el
index 7d5f5d543..85262b32a 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -629,83 +629,83 @@ (defun org-src-font-lock-fontify-block (lang start end)
   "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'."
-- 
2.38.1

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

reply via email to

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