3

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
    Commented Feb 27, 2021 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
    Commented Feb 28, 2021 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
    Commented Mar 8, 2021 at 0:18

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.