diff options
| -rw-r--r-- | lisp/appearance.el | 73 |
1 files changed, 41 insertions, 32 deletions
diff --git a/lisp/appearance.el b/lisp/appearance.el index 2d365f7..c0ff65c 100644 --- a/lisp/appearance.el +++ b/lisp/appearance.el @@ -40,40 +40,49 @@ "Fontify code block. 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))) + (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)) pos next) - (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 - (unless (eq major-mode lang-mode) (funcall lang-mode)) - ;; Avoid `font-lock-ensure', which does not display fonts in - ;; source block. - (font-lock-fontify-buffer) - (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)) - ;; Addition: also copy 'composition info for prettified symbols - (setq pos (point-min)) - (while (setq next (next-single-property-change pos 'composition)) - (put-text-property - (+ start (1- pos)) (1- (+ start next)) 'composition - (get-text-property pos 'composition) org-buffer) - (setq pos next)) - ;; End addition - ) - (add-text-properties - start end - '(font-lock-fontified t fontified t font-lock-multiline t)) - (set-buffer-modified-p modified))))) + (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)) + (org-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. + (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)) + ;; Addition: also copy 'composition info for prettified symbols + (setq pos (point-min)) + (while (setq next (next-single-property-change pos 'composition)) + (put-text-property + (+ start (1- pos)) (1- (+ start next)) 'composition + (get-text-property pos 'composition) org-buffer) + (setq pos next))) + ;; End addition + ) + ;; 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)) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified))))) ;; Although I'm usually not a fan of treating non-printable ASCII like this, the ;; lines act as sort more of a cue for me to use <C-x [> and <C-x ]> than a |