Patching elfeed and shr to handle SVG images with viewBox attributes

Posted: - Modified: | emacs

I 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*")
     (xml-parse-file "/tmp/test/index.xml")))))
Figure 1: The image is a little too big to be comfortable

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.

Figure 2: SVG image cut off

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 .")

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))

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)
             "SVG Image")))

The result is that the image now respects width, height, and viewBox:

Figure 3: Fixed image

Here is a small test for shr-correct-dom-case:

(ert-deftest shr-correct-dom-case ()
  (let ((case-fold-search nil))
          (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*")
  (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)))
Figure 4: Correct output: full circle

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.

View org source for this post
You can comment with Disqus or you can e-mail me at