- fixed 'starting-emoji'.

src/emoji-matcher.lisp

@@ -54,6 +54,15 @@
      (find-if (lambda (a) (match-codepoint-p chars a))
               ',(extract-emojis-codepoints "https://unicode.org/Public/emoji/13.1/emoji-zwj-sequences.txt"))))
 
+(defun fetch-max-codepoints-emoji-lengths ()
+  (length (reduce (lambda (a b)
+                    (if (> (length a) (length b))
+                        a
+                        b))
+                  (text-utils::extract-emojis-codepoints "https://unicode.org/Public/emoji/13.1/emoji-zwj-sequences.txt"))))
+
+(alexandria:define-constant +max-codepoints-emoji-lengths+ 10 :test #'=)
+
 ;;;; expansion of (gen-matcher-sequences)
 
 (defun emoji-sequences-p (chars)
@@ -1302,7 +1311,13 @@
 (defgeneric starting-emoji (object))
 
 (defmethod starting-emoji ((object list))
-  (emojip object))
+    (loop for end from 1 to +max-codepoints-emoji-lengths+
+          when (>= (length object) end) do
+            (alexandria:when-let* ((sample     (subseq object 0 end))
+                                   (emoji-list (emojip sample)))
+              (return-from starting-emoji emoji-list)))
+    nil)
 
 (defmethod starting-emoji ((object string))
-  (emojip (coerce object 'list)))
+  (let ((chars-list (coerce object 'list)))
+    (starting-emoji chars-list)))

src/gui/client/main-window.lisp

@@ -541,6 +541,26 @@
                                      (format nil "~a~a" prefix-other link-name))))))
     (values link-rendered-label link-name link-value)))
 
+(defun colorize-emoji (main-window line-index color &optional (start 0))
+  (with-accessors ((ir-lines             ir-lines)
+                   (ir-rendered-lines    ir-rendered-lines)
+                   (gemtext-widget       gemtext-widget)) main-window
+    (let ((line (coerce (elt ir-rendered-lines line-index) 'list)))
+      (loop for i from start below (length line)
+            with skip-index = 0
+            do
+               (let ((emoji-code-points (starting-emoji (subseq line skip-index))))
+                 (if emoji-code-points
+                     (let ((tag (gui:tag-create gemtext-widget
+                                                (gui::create-tag-name)
+                                                `(:char ,i :line ,(1+ line-index))
+                                                `(:char ,(1+ i) :line ,(1+ line-index)))))
+                       (gui:tag-configure gemtext-widget
+                                          tag
+                                          :foreground color))
+                       (incf skip-index (length emoji-code-points)))
+                     (incf skip-index))))))
+
 (defun render-ir-lines (request-iri main-window)
   (with-accessors ((ir-lines             ir-lines)
                    (ir-rendered-lines    ir-rendered-lines)