From 6dd64339205c10adda9dbff90db96a067603398c Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Fri, 30 Sep 2022 09:22:42 +0300
Subject: [PATCH] ENHANCED: fontify quasi-quotation content according to its
 type

* sweeprolog-qq-mode-alist: new user option
* (sweeprolog--colour-term-to-faces): use it
---
 sweep.pl      |  3 +++
 sweeprolog.el | 38 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+)

diff --git a/sweep.pl b/sweep.pl
index c8a29f0..b445260 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -638,6 +638,9 @@ sweep_color_normalized_(Offset, syntax_error, [Message0,Start0-End0|_], ["syntax
 sweep_color_normalized_(_, comment, [Kind0|_], ["comment"|Kind]) :-
     !,
     atom_string(Kind0, Kind).
+sweep_color_normalized_(_, qq_content, [Type0|_], ["qq_content"|Type]) :-
+    !,
+    atom_string(Type0, Type).
 sweep_color_normalized_(_, Nom0, _, Nom) :-
     atom_string(Nom0, Nom).
 
diff --git a/sweeprolog.el b/sweeprolog.el
index 77dffd9..3846c2c 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -40,6 +40,14 @@
   :type 'integer
   :group 'sweeprolog)
 
+(defcustom sweeprolog-qq-mode-alist '(("graphql"    . graphql-mode)
+                                      ("javascript" . js-mode)
+                                      ("html"       . html-mode))
+  "Association between Prolog quasi-quotation types and Emacs modes."
+  :package-version '((sweeprolog . "0.4.3"))
+  :type '(alist :key-type string :value-type symbol)
+  :group 'sweeprolog)
+
 (defcustom sweeprolog-colourise-buffer-on-idle t
   "If non-nil, update highlighting of `sweeprolog-mode' buffers on idle."
   :package-version '((sweeprolog . "0.2.0"))
@@ -904,6 +912,13 @@ module name, F is a functor name and N is its arity."
   (:weight bold)
   "Quasi-quotation open sequences.")
 
+(sweeprolog-defface
+  qq-content
+  (:inherit default)
+  (:foreground "red4")
+  (:foreground "red4")
+  "Quasi-quotation content.")
+
 (sweeprolog-defface
   qq-close
   (:inherit font-lock-type-face)
@@ -1245,6 +1260,29 @@ module name, F is a functor name and N is its arity."
      (list (list beg end (sweeprolog-neck-face))))
     ("hook"
      (list (list beg end (sweeprolog-hook-face))))
+    (`("qq_content" . ,type)
+     (let ((mode (cdr (assoc-string type sweeprolog-qq-mode-alist))))
+       (if (and mode (fboundp mode))
+           (let ((res nil)
+                 (string (buffer-substring-no-properties beg end)))
+             (with-current-buffer
+                 (get-buffer-create
+                  (format " *sweep-qq-content:%s*" type))
+               (with-silent-modifications
+                 (erase-buffer)
+                 (insert string " "))
+               (unless (eq major-mode mode) (funcall mode))
+               (font-lock-ensure)
+               (let ((pos (point-min)) next)
+                 (while (setq next (next-property-change pos))
+                   (dolist (prop '(font-lock-face face))
+                     (let ((new-prop (get-text-property pos prop)))
+                       (when new-prop
+                         (setq res (cons (list (+ beg (1- pos)) (1- (+ beg next)) new-prop) res)))))
+                   (setq pos next)))
+               (set-buffer-modified-p nil)
+               res))
+         (list (list beg end (sweeprolog-qq-content-face))))))
     ("qq_type"
      (list (list beg end (sweeprolog-qq-type-face))))
     ("qq_sep"
-- 
2.39.2