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")))))
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")))))
| improve this answer | |

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.