SVG Previews for org mode

[Robert <robert+orgmode@robewald.de>]

Hello,

I created the attached code to be able to preview SVG in org mode. Please comment if you have suggestions for a better approach.

It works by having svg in a #+begin_src svg block and running org-format-svg on it.

I took inspiration from org-format-latex and wonder whether it should be merged with that function.

Upsides:
- The same keybinding (C-c C-x C-l) could be used.
- Less duplicated code
- More?

Downsides: 
- The name of the function would be misleading
- Other breakage
- More?

It could also be integrated with the C-c mechanisms on src_blocks. But I don’t know how to do that.

Best regards

Robert

(defun org--make-svg-preview-overlay (beg end image)
  "Build an overlay between BEG and END using the svg image data."
  (let ((ov (make-overlay beg end)))
    (overlay-put ov 'org-overlay-type 'org-svg-overlay)
    (overlay-put ov 'evaporate t)
    (overlay-put ov
		 'modification-hooks
		 (list (lambda (o _flag _beg _end &optional _l)
			 (delete-overlay o))))
    (overlay-put ov
		 'display
		 (find-image `((:type svg :data ,image :scale 1 :transform-smoothing t))))))

(defun org-format-svg (&optional beg end)
  (let ((context-regexp "#\\+begin_src +svg"))
    (goto-char (or beg (point-min)))
    (while (re-search-forward context-regexp end t)
      (let* ((context (org-element-context))
	     (type (org-element-type context)))
	(when (and (eq type 'src-block) 
		   (string= (org-element-property :language context) "svg"))
	  (let* ((value (org-element-property :value context))
		 (beg (org-element-property :begin context))
		 (end (save-excursion
			(goto-char (org-element-property :end context))
			(skip-chars-backward " \r\t\n")
			(point))))
	    (progn
	      (dolist (o (overlays-in beg end))
		(when (eq (overlay-get o 'org-overlay-type) 'org-svg-overlay)
		  (delete-overlay o))))
	    (org--make-svg-preview-overlay beg end value)
	    (goto-char end)))))))

(defun org-clear-svg-preview (&optional beg end)
  (let ((overlays (cl-remove-if-not
		   (lambda (o) (eq (overlay-get o 'org-overlay-type) 'org-svg-overlay))
		   (overlays-in (or beg (point-min)) (or end (point-max))))))
    (mapc #'delete-overlay overlays)
    overlays))

(defun org-svg-preview (&optional arg)
  "Toggle the preview of the svg fragment at point"
  (interactive)
  (cond
   ((not (display-graphic-p)) nil)  ;; noop on non-graphic displays
   ((use-region-p)
    (org-format-svg (region-beginning) (region-end)))
   ((let ((context (org-element-context)))
      (and (eq (org-element-type context) 'src-block)
	   (string= (org-element-property :language context) "svg")
	   (let ((beg (org-element-property :begin context))
		 (end (org-element-property :end context)))
	     (if (org-clear-svg-preview beg end)
		 (message "SVG preview removed")
	       (message "Creating SVG preview...")
	       (org-format-svg beg end)
	       (message "Creating SVG preview... done."))
	     t))))))
(provide 'bob-org-svg)