1

I've made small function to create SVG tags (see below) and I would like to use the image property of faces to replace some keywords. I'm not sure how to do that and if it is possible. For example, any :NOTE: would be replaced by the image returned by the (tag "NOTE") call. From Replacing a string with symbols using font-lock?, it seems possible but I'm not sure how to adapt the code for image.

Code:

(require 's)
(require 'svg)

(defface tag-face
  '((t :foreground "white" :background "orange" :box "orange"
       :family "Roboto Mono" :weight light :height 120))
  "Face for default tag" :group 'tag)

(defun tag (text &optional face inner-padding outer-padding radius)
  (let* ((face       (or face 'tag-face))
         (foreground (face-attribute face :foreground))
         (background (face-attribute face :background))
         (border     (face-attribute face :box))
         (family     (face-attribute face :family))
         (weight     "light") ;; (face-attribute face :weight))
         (size       (/ (face-attribute face :height) 10))

         (tag-char-width  (window-font-width nil face))
         (tag-char-height (window-font-height nil face))
         (txt-char-width  (window-font-width))
         (txt-char-height (window-font-height))
         (inner-padding   (or inner-padding 1))
         (outer-padding   (or outer-padding 0))

         (text (s-trim text))
         (tag-width (* (+ (length text) inner-padding) txt-char-width))
         (tag-height (* txt-char-height 0.9))
         
         (svg-width (+ tag-width (* outer-padding txt-char-width)))
         (svg-height tag-height)

         (tag-x (/ (- svg-width tag-width) 2))
         (text-x (+ tag-x (/ (- tag-width (* (length text) tag-char-width)) 2)))
         (text-y (- tag-char-height (- txt-char-height tag-char-height)))
         
         (radius  (or radius 3))
         (svg (svg-create svg-width svg-height)))
         
    (svg-rectangle svg tag-x 0 tag-width tag-height
                   :fill        border
                   :rx          radius)
    (svg-rectangle svg (+ tag-x 1) 1 (- tag-width 2) (- tag-height 2)
                   :fill        background
                   :rx          (- radius 1))
    (svg-text      svg text 
                   :font-family family
                   :font-weight weight
                   :font-size   size
                   :fill        foreground
                   :x           text-x
                   :y           text-y)
    (svg-image svg :ascent 'center)))

(insert-image (tag "INFO")) ;; Type C-x C-e here to see the tag

Result:

tag function output

Update:

Something like this almost works but the call is not evaluted:

(add-to-list 'font-lock-extra-managed-props 'display)
(font-lock-add-keywords nil
     '(("\\(\:TODO\:\\)" 1 '(face nil display (tag "TODO")))))
Nicolas Rougier
  • 487
  • 3
  • 15

1 Answers1

0

This is how to do it:

(add-to-list 'font-lock-extra-managed-props 'display)
(font-lock-add-keywords nil
        '(("\\(\:TODO\:\\)" 1 `(face nil display ,(tag "TODO")))))
Nicolas Rougier
  • 487
  • 3
  • 15