2

If one sets org-src-fontify-natively to t org source blocks are fontified according to the associated major-mode. That is fine.

But, is it possible to emphasize text snippets within the source blocks, maybe such that the face for the major-mode fontification and the face for emphasis are combined?

I have still hope that there is already some package providing some means of emphasis in fontified source blocks.

If there is no package yet, my vision of it is:

  • have an header argument for source blocks (e.g., :emph) associating regexps to faces for emphasizing; Let us name matches of those regexps as emphasizers.
  • Override org-src-font-lock-fontify-block such that, in the temp buffer, it removes the emphasizers, runs org-font-lock-ensure for the major-mode, silently puts the emphasizers back, adds the fontification for the emphasizers and transfers the fontification to the original buffer

Example of an Org source block with emphasized text snippets:

#+BEGIN_SRC C++ :includes <iostream> :emph ("\\*\\*\\*" bold) ("///" italic)
std::***cout*** << "Hello ///World///!\n";
#+END_SRC

I am especially interested for a solution tackling the export of source blocks. Therefore, I add the tag org-export here.

In my case the execution of those source blocks are of less concern. But, maybe, one could also remove the emphasizers automatically in body before running org-babel-execute-src-block such as done with noweb references.

A feasibility study

The Elisp code below allows the following formatting of source blocks:

example Org source block

and exports as follows to HTML:

HTML export of the Org example

Disclaimer: The following source code is just a feasibility study and most likely not error free. (Pityingly, I don't have much time to smooth it out.) It is supposed to give somebody a base who wants to fiddle around with it.

;; -*- lexical-binding: t; -*-
(require 'cl-lib)
(require 'subr-x)
(require 'org)
(require 'ob)
(require 'org-element)
(require 'ox-html)

(defvar org+-export-src-block-info nil)

(defun org+-export-data-src-block-ad (data _info)
  "Store the source block info  in `org+-export-src-block-info'.
This is a :before advice for function `org-export-data'.
DATA and _INFO are the same arguments as for `org-export-data'."
  (when (eq (org-element-type data) 'src-block)
    (let* ((beg (org-element-property :begin data))
       (info (save-excursion
           (goto-char beg)
           (org-babel-exp--at-source
               (org-babel-get-src-block-info 'light)))))
      (setq org+-export-src-block-info info))))

(advice-add 'org-export-data :before #'org+-export-data-src-block-ad)

(defun org+-src-font-lock-strip-emph (emphasizers)
  "Replace emphasis markers by text properties in current buffer.
The emphasis markers are described by the list EMPHASIZERS.
Each marker is a list (RE-BEGIN RE-END FACE).
Non-greedy matches for \\(?1:RE-BEGIN\\)\\(?2:.*\\)\\(?3:RE-END\\) are searched.
The groups 1 and 3 are removed and group 1 is propertised by
:org+emph (MATCH1 MATCH2 FACE)."
  (dolist (emph emphasizers)
    (goto-char (point-min))
    (cl-multiple-value-bind
    (re-begin re-end face) emph
      (let ((re (format "\\(?1:%s\\)\\(?2:\\(?:.\\|\n\\)*?\\)\\(?3:%s\\)" re-begin re-end)))
    (while (re-search-forward re nil t)
      (put-text-property (match-beginning 2) (match-end 2)
                 :org+emph (list (match-string 1) (match-string 3) face))
      (replace-match "" nil nil nil 3)
      (replace-match "" nil nil nil 1))
    ))))

(cl-defun org+-src-font-lock-restore-emph (&key (face-prop 'face) emph-marks)
  "Restore emphasis from text properties in current buffer.
See `org+-src-font-lock-strip-emph' for the structure of
emphasis markers and text properties.
If FACE-PROP is non-nil put the face with that property on the marked text.
If EMPH-MARKS is non-nil insert the emphasis markers
at their original positions."
  (declare (special int))
  (goto-char (point-min))
  (cl-loop for int being the intervals property :org+emph
       for start = (car int)
       for end = (cdr int)
       for prop = (get-text-property start :org+emph)
       when prop
       when face-prop
       do
       (font-lock-append-text-property start end face-prop (nth 2 prop))
       and when emph-marks
       do
       (goto-char end) (insert (nth 1 prop))
       (goto-char start) (insert (nth 0 prop))))

(defun org+-src-font-lock-html-fontify-code (fun code lang)
  "Consider emphasis markers in source blocks.
This is an around advice for `org-html-fontify-code' as FUN.
CODE and LANG are passed to FUN.
But before, emphasis markers are replaced by text properties in CODE."
  (if-let ((args (nth 2 org+-export-src-block-info))
       (emph-arg (alist-get :emph args))
       ((null (string-equal emph-arg "'%emph")))
       (emph-exprs (eval (read emph-arg))))
      (let ((org-src-mode-hook (cons 'org+-src-font-lock-restore-emph org-src-mode-hook))
        (new-code (with-temp-buffer
            (insert code)
            (org+-src-font-lock-strip-emph emph-exprs)
            (buffer-string))))
    (funcall fun new-code lang))
    (funcall fun code lang)))

(advice-add 'org-html-fontify-code :around #'org+-src-font-lock-html-fontify-code)

(defun org+-src-font-lock-transfer-props (org-buffer start)
  "Transfer font lock properties from current buffer to ORG-BUFFER.
In the ORG-BUFFER the text is at START."
  ;; This code segment is adapted from `org-src-font-lock-fontify-block'.
  (cl-loop
   for int being the intervals
   for pos = (car int)
   for next = (cdr int)
   do
   (dolist (prop (cons 'face font-lock-extra-managed-props))
     (let ((new-prop (get-text-property pos prop)))
       (put-text-property
    (+ start pos) (+ start next) prop new-prop
    org-buffer)))))

(defun org+-src-font-lock-fontify-block (fun lang start end)
  "Consider the :emph source block header argument.
This is an around advice for `org-src-font-lock-fontify-block' as FUN.
The args LANG START END are the same as for `org-src-font-lock-fontify-block'."
  (if-let* ((buf (current-buffer))
          (info (org-babel-get-src-block-info 'light))
          (body (nth 1 info))
          (args (nth 2 info))
          (emph-arg (alist-get :emph args))
          ((null (string-equal emph-arg "%emph")))
          (emph-exprs (eval (read emph-arg))))
      (with-temp-buffer
    (insert body)
    (org+-src-font-lock-strip-emph emph-exprs)
    (funcall fun lang (point-min) (point-max))
    (org+-src-font-lock-restore-emph :emph-marks t)
    (org+-src-font-lock-transfer-props buf start)
    )
    (funcall fun lang start end)))

(advice-add 'org-src-font-lock-fontify-block :around #'org+-src-font-lock-fontify-block)

(defun org+-src-babel-spec-to-string (arg-list)
  "Filter-args advice removing :emph for tangling.
ARG-LIST contains the spec list for `org-babel-spec-to-string'.
See `org+-src-font-lock-strip-emph' for the meaning of :emph."
  (let* ((spec (car arg-list))
     (body (gv-ref (nth 5 spec)))
     (params (nth 4 spec))
     (emph (alist-get :emph params nil nil #'string-equal)))
    (with-temp-buffer
      (insert (gv-deref body))
      (org+-src-font-lock-strip-emph emph)
      (setf (gv-deref body) (buffer-string))))
  arg-list)

(advice-add 'org-babel-spec-to-string :filter-args #'org+-src-babel-spec-to-string)

(defun org+-src-font-lock-template-with-emph (_backend)
  "Temporarily add :emph to `org-babel-exp-code-template'."
  (make-local-variable 'org-babel-exp-code-template)
  (setq org-babel-exp-code-template
    (replace-regexp-in-string
     "\\(#\\+BEGIN_SRC[^\n]*\\)\n"
     "\\1 :emph '%emph\n"
     org-babel-exp-code-template)))

(add-hook 'org-export-before-processing-hook #'org+-src-font-lock-template-with-emph)
3
  • Wow!! Very cool question & code example!! I'm guessing you plan to strip the code markup before tangling as well. Since you're already comfortable with adding in markup to code, have you considered using built-in no-web functionality to mark up code instead? E.g. create b SRC block, then implement like <<b(t="cout")>>. The noweb markup is not pretty but it is easy to maintain and doesn't require much setup. – Melioratus Feb 27 at 23:04
  • @Melioratus If you would present a working example with noweb I would be very happy to give you the bounty. But I do not think that noweb works in that context out of the box. How would you highlight the marked snippets for export and maybe for displaying the Org-buffer? – Tobias Feb 28 at 22:34
  • Tobias - Unfortunately, I'm not sure if noweb could be used out of the box to render snippets in the org-buffer without a possibly kludge-ish workaround. My intuition (memory?) tells me it's possible to use noweb to markup the code for a formatted export but this would potentially break the source code for a tangle. I've been searching notes & google for programmatic way for a src block to detect whether export or tangle is happening so conditional code could adjust markup behaviour as needed. – Melioratus Mar 8 at 0:18

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.