diff --git a/src/emoji-matcher.lisp b/src/emoji-matcher.lisp index 6a9dc69..7e76a94 100644 --- a/src/emoji-matcher.lisp +++ b/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))) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 18037f0..4ec3184 100644 --- a/src/gui/client/main-window.lisp +++ b/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)