Patching elfeed and shr to handle SVG images with viewBox attributes
Posted: - Modified: | emacsI want to use more SVG sketches in my blog posts. I would like them to look reasonable in elfeed. When I first checked them out, though, the images were a little too big to be comfortable.
To test things quickly, I figured out how to use Elfeed to display the first entry from a local file.
(with-temp-buffer (get-buffer-create "*elfeed*") (elfeed-show-entry (car (elfeed-entries-from-rss "file:///tmp/test/index.xml" (xml-parse-file "/tmp/test/index.xml")))))
I'd just been using the default width and height from the pdftocairo import, but changing the width and height seemed like a good first step. I could fix this when I convert the file, export it from Org Mode as a my-include link, or transform it when processing it in the 11ty static site generator. Let's start by changing it in the SVG file itself.
(defun my-svg-resize (file width height) "Resize FILE to WIDTH and HEIGHT in pixels, keeping aspect ratio." (interactive "FSVG: \nnWidth: \nnHeight: ") (let* ((dom (xml-parse-file file)) (orig-height (string-to-number (dom-attr dom 'height))) (orig-width (string-to-number (dom-attr dom 'width))) (aspect-ratio (/ (* 1.0 orig-width) orig-height)) new-width new-height) (setq new-width width new-height (/ new-width aspect-ratio)) (when (> new-height height) (setq new-height height new-width (* new-height aspect-ratio))) (dom-set-attribute dom 'width (format "%dpx" new-width)) (dom-set-attribute dom 'height (format "%dpx" new-height)) (with-temp-file file (xml-print dom))))
Even when I changed the width and height of the SVG image, the image didn't follow suit. Mysterious.
After a bit of digging around using Edebug, I
found out that elfeed uses shr, which uses
libxml-parse-html-region, and that converts
attributes to lowercase. This is generally what
you want to do for HTML, since HTML tags and
attributes are case-insensitive, but SVG tags are
case-sensitive. It looks like other implementations work around this by special-casing attributes. libxml-parse-html-region is C code
that calls a library function, so it's hard to
tinker with, but I can at least fix the behaviour
at the level of shr. I took the list of SVG attributes to correct case for and wrote this code
to fix the attribute cases.
List of atttributes to correct
(defconst shr-correct-attribute-case '((attributename . attributeName) (attributetype . attributeType) (basefrequency . baseFrequency) (baseprofile . baseProfile) (calcmode . calcMode) (clippathunits . clipPathUnits) (diffuseconstant . diffuseConstant) (edgemode . edgeMode) (filterunits . filterUnits) (glyphref . glyphRef) (gradienttransform . gradientTransform) (gradientunits . gradientUnits) (kernelmatrix . kernelMatrix) (kernelunitlength . kernelUnitLength) (keypoints . keyPoints) (keysplines . keySplines) (keytimes . keyTimes) (lengthadjust . lengthAdjust) (limitingconeangle . limitingConeAngle) (markerheight . markerHeight) (markerunits . markerUnits) (markerwidth . markerWidth) (maskcontentunits . maskContentUnits) (maskunits . maskUnits) (numoctaves . numOctaves) (pathlength . pathLength) (patterncontentunits . patternContentUnits) (patterntransform . patternTransform) (patternunits . patternUnits) (pointsatx . pointsAtX) (pointsaty . pointsAtY) (pointsatz . pointsAtZ) (preservealpha . preserveAlpha) (preserveaspectratio . preserveAspectRatio) (primitiveunits . primitiveUnits) (refx . refX) (refy . refY) (repeatcount . repeatCount) (repeatdur . repeatDur) (requiredextensions . requiredExtensions) (requiredfeatures . requiredFeatures) (specularconstant . specularConstant) (specularexponent . specularExponent) (spreadmethod . spreadMethod) (startoffset . startOffset) (stddeviation . stdDeviation) (stitchtiles . stitchTiles) (surfacescale . surfaceScale) (systemlanguage . systemLanguage) (tablevalues . tableValues) (targetx . targetX) (targety . targetY) (textlength . textLength) (viewbox . viewBox) (viewtarget . viewTarget) (xchannelselector . xChannelSelector) (ychannelselector . yChannelSelector) (zoomandpan . zoomAndPan)) "Attributes for correcting the case in SVG and MathML. Based on https://html.spec.whatwg.org/multipage/parsing.html#parsing-main-inforeign .")
This recursive function does the actual replacements.
(defun shr-correct-dom-case (dom) "Correct the case for SVG segments." (dolist (attr (dom-attributes dom)) (when-let ((rep (assoc-default (car attr) shr-correct-attribute-case))) (setcar attr rep))) (dolist (child (dom-children dom)) (shr-correct-dom-case child)) dom)
Then we can replace shr-tag-svg with this:
(defun shr-tag-svg (dom) (when (and (image-type-available-p 'svg) (not shr-inhibit-images) (dom-attr dom 'width) (dom-attr dom 'height)) (funcall shr-put-image-function (list (shr-dom-to-xml (shr-correct-dom-case dom) 'utf-8) 'image/svg+xml) "SVG Image")))
The result is that the image now respects width, height, and viewBox:
Here is a small test for shr-correct-dom-case:
(ert-deftest shr-correct-dom-case () (let ((case-fold-search nil)) (should (string-match "viewBox" (shr-dom-to-xml (shr-correct-dom-case (with-temp-buffer (insert "<svg viewBox=\"0 0 100 100\"></svg>") (libxml-parse-html-region (point-min) (point-max)))))))))
And another test involving displaying an image:
(with-current-buffer (get-buffer-create "*test*") (erase-buffer) (insert "<svg width=\"100px\" height=\"100px\" viewBox=\"0 0 200 200\"><circle cx=\"100\" cy=\"100\" r=\"100\"/></svg>\n") (shr-insert-document (libxml-parse-html-region (point-min) (point-max))) (display-buffer (current-buffer)))
shr.el is in Emacs core, so I'll need to turn this into a patch and send it to emacs-devel at some point.