Browse Source

org-src: Src-blocks also inherit org-block face

* lisp/org-src.el (org-src-font-lock-fontify-block): Inherit org-block
  face in addition to language specific faces.
* etc/ORG-NEWS: Add entry.
Rasmus 3 years ago
parent
commit
81af689d0f
2 changed files with 28 additions and 11 deletions
  1. 11 0
      etc/ORG-NEWS
  2. 17 11
      lisp/org-src.el

+ 11 - 0
etc/ORG-NEWS

@@ -301,6 +301,17 @@ sensitive.  Otherwise, it is case insensitive.
 *** More robust repeated =ox-latex= footnote handling
 Repeated footnotes are now numbered by referring to a label in the
 first footnote.
+*** The ~org-block~ face is inherited by ~src-blocks~
+This works also when =org-src-fontify-natively= is non-nil.
+
+Thus, =org-block-background= Org 8.2 can be replicated with something
+like the following,
+#+BEGIN_SRC emacs-lisp
+  (require 'color)
+  (set-face-attribute 'org-block nil :background
+                      (color-darken-name
+                       (face-attribute 'default :background) 3))
+#+END_SRC
 ** New functions
 *** ~org-next-line-empty-p~
 It replaces the deprecated ~next~ argument to ~org-previous-line-empty-p~.

+ 17 - 11
lisp/org-src.el

@@ -494,27 +494,33 @@ 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)) pos next)
+	    (org-buffer (current-buffer)))
 	(remove-text-properties start end '(face nil))
 	(with-current-buffer
 	    (get-buffer-create
-	     (concat " org-src-fontification:" (symbol-name lang-mode)))
-	  (delete-region (point-min) (point-max))
-	  (insert string " ") ;; so there's a final property change
+	     (format " *org-src-fontification:%s*" lang-mode))
+	  (erase-buffer)
+	  ;; Add string and a final space to ensure property change.
+	  (insert string " ")
 	  (unless (eq major-mode lang-mode) (funcall lang-mode))
 	  (org-font-lock-ensure)
-	  (setq pos (point-min))
-	  (while (setq next (next-single-property-change pos 'face))
-	    (put-text-property
-	     (+ start (1- pos)) (1- (+ start next)) 'face
-	     (get-text-property pos 'face) org-buffer)
-	    (setq pos next)))
+	  (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
+		 (list :inherit (append (and new-face (list new-face))
+					(list 'org-block)))
+		 org-buffer))
+	      (setq pos next))
+	    ;; Add the face to the remaining part of the text.
+	    (put-text-property (1- (+ start pos)) end 'face
+			       '(:inherit org-block) org-buffer)))
 	(add-text-properties
 	 start end
 	 '(font-lock-fontified t fontified t font-lock-multiline t))
 	(set-buffer-modified-p modified)))))
 
-
 
 ;;; Escape contents