From 8e7aa38e098bd044a71fa20df1593d2b37347f1c Mon Sep 17 00:00:00 2001 From: Pip Cet Date: Sat, 25 Apr 2020 18:41:02 +0000 Subject: [PATCH] support generated display specs --- generated-image-specs.el | 31 ++++++++++++++++++++++++++++ src/callint.c | 1 + src/xdisp.c | 44 ++++++++++++++++++++++++++++++++++++++++ src/xfaces.c | 2 +- 4 files changed, 77 insertions(+), 1 deletion(-) create mode 100644 generated-image-specs.el diff --git a/generated-image-specs.el b/generated-image-specs.el new file mode 100644 index 0000000000..b764d1999d --- /dev/null +++ b/generated-image-specs.el @@ -0,0 +1,31 @@ +(require 'svg) + +(defun generate-circle-image (alist) + (let* ((vsize (font-get (alist-get :font alist) :size)) + (foreground (apply #'color-rgb-to-hex (nconc (color-name-to-rgb (alist-get :foreground alist)) (list 2)))) + (background (apply #'color-rgb-to-hex (nconc (color-name-to-rgb (alist-get :background alist)) (list 2)))) + (hsize (* vsize .8)) + (svg (svg-create hsize vsize)) + (sw (* .1 hsize))) + (svg-rectangle svg 0 0 hsize vsize :fill background) + (svg-circle svg (* hsize .5) + (- (* .8 vsize) (* .5 hsize)) + (- (* hsize .5) sw) + :fill "none" + :stroke foreground + :stroke-width sw) + (svg-line svg + (* hsize .5) (- (* .8 vsize) (* .5 hsize)) + (* hsize .5) (- (* .8 vsize) sw) + :stroke foreground + :stroke-width sw) + (svg-circle svg (* hsize .5) (- (* .8 vsize) (* (/ 2.0 3.0) hsize)) + sw + :fill foreground + :stroke "none") + (let ((ret (svg-image svg))) + (setcdr ret (plist-put (cdr ret) :scale 1.0)) + (setcdr ret (plist-put (cdr ret) :ascent 80)) + ret))) + +(insert (propertize " " 'display `(generated-spec ,#'generate-circle-image))) diff --git a/src/callint.c b/src/callint.c index eb916353a0..2c34dddbe4 100644 --- a/src/callint.c +++ b/src/callint.c @@ -826,6 +826,7 @@ syms_of_callint (void) DEFSYM (Qlet, "let"); DEFSYM (Qif, "if"); DEFSYM (Qwhen, "when"); + DEFSYM (Qgenerated_spec, "generated-spec"); DEFSYM (Qletx, "let*"); DEFSYM (Qsave_excursion, "save-excursion"); DEFSYM (Qprogn, "progn"); diff --git a/src/xdisp.c b/src/xdisp.c index 3258893956..b341cbb735 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -5050,6 +5050,7 @@ handle_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, #endif && !EQ (XCAR (spec), Qspace) && !EQ (XCAR (spec), Qwhen) + && !EQ (XCAR (spec), Qgenerated_spec) && !EQ (XCAR (spec), Qslice) && !EQ (XCAR (spec), Qspace_width) && !EQ (XCAR (spec), Qheight) @@ -5148,6 +5149,8 @@ display_prop_end (struct it *it, Lisp_Object object, struct text_pos start_pos) Value is non-zero if something was found which replaces the display of buffer or string text. */ +extern Lisp_Object *lface_id_to_name; + static int handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, Lisp_Object overlay, struct text_pos *position, @@ -5159,6 +5162,47 @@ handle_single_display_spec (struct it *it, Lisp_Object spec, Lisp_Object object, struct text_pos start_pos = *position; void *itdata = NULL; + if (it != NULL && + CONSP (spec) && + EQ (XCAR (spec), Qgenerated_spec)) + { + spec = XCDR (spec); + if (!CONSP (spec)) + return 0; + Lisp_Object gen = XCAR (spec); + struct face *face = FACE_FROM_ID (it->f, it->face_id); + Lisp_Object lface = Qnil; + Lisp_Object props[] = { + QCtype, + QCfamily, + QCfoundry, + QCwidth, + QCheight, + QCweight, + QCslant, + QCunderline, + QCinverse_video, + QCforeground, + QCbackground, + QCstipple, + QCoverline, + QCstrike_through, + QCbox, + QCfont, + QCinherit, + QCfontset, + QCdistant_foreground, + QCextend, + }; + for (int i = 0; i < LFACE_VECTOR_SIZE; i++) + lface = Fcons (Fcons (props[i], face->lface[i]), + lface); + Lisp_Object font = Qnil; + XSETFONT (font, face->font); + lface = Fcons (Fcons (QCfont, font), lface); + spec = safe_call1 (gen, lface); + } + /* If SPEC is a list of the form `(when FORM . VALUE)', evaluate FORM. If the result is non-nil, use VALUE instead of SPEC. */ form = Qt; diff --git a/src/xfaces.c b/src/xfaces.c index bab142ade0..01429ac86e 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -310,7 +310,7 @@ #define FACE_CACHE_BUCKETS_SIZE 1001 /* A vector mapping Lisp face Id's to face names. */ -static Lisp_Object *lface_id_to_name; +Lisp_Object *lface_id_to_name; static ptrdiff_t lface_id_to_name_size; #ifdef HAVE_WINDOW_SYSTEM -- 2.26.2