summaryrefslogtreecommitdiff
path: root/src/tg-types/message-entity.lisp
diff options
context:
space:
mode:
authorGravatar Uko Kokņevičs2025-10-13 00:05:43 +0300
committerGravatar Uko Kokņevičs2025-10-13 00:05:43 +0300
commit5a941f218b918ca3b301d661942f0911c5153a12 (patch)
tree2846be6d3428342d1a1f9f1cd7bc5058a4d4fe1a /src/tg-types/message-entity.lisp
parentSome more TG types (diff)
downloadukkoclot-5a941f218b918ca3b301d661942f0911c5153a12.tar.gz
ukkoclot-5a941f218b918ca3b301d661942f0911c5153a12.tar.xz
ukkoclot-5a941f218b918ca3b301d661942f0911c5153a12.zip
Rename tg-types to just tg
Diffstat (limited to 'src/tg-types/message-entity.lisp')
-rw-r--r--src/tg-types/message-entity.lisp59
1 files changed, 0 insertions, 59 deletions
diff --git a/src/tg-types/message-entity.lisp b/src/tg-types/message-entity.lisp
deleted file mode 100644
index 1eb96cb..0000000
--- a/src/tg-types/message-entity.lisp
+++ /dev/null
@@ -1,59 +0,0 @@
1;; SPDX-License-Identifier: EUPL-1.2
2;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
3(defpackage :ukkoclot/tg-types/message-entity
4 (:use :c2cl :iterate :ukkoclot/tg-types/macros :ukkoclot/tg-types/message-entity-type :ukkoclot/tg-types/user)
5 (:export
6 #:message-entity
7 #:make-message-entity
8 #:message-entity-p
9 #:copy-message-entity
10 #:message-entity-type
11 #:message-entity-offset
12 #:message-entity-length
13 #:message-entity-url
14 #:message-entity-user
15 #:message-entity-language
16 #:message-entity-custom-emoji-id
17
18 #:message-entity-extract))
19(in-package :ukkoclot/tg-types/message-entity)
20
21(define-tg-type message-entity
22 (type message-entity-type)
23 (offset integer)
24 (length integer)
25 (url (or string null) nil)
26 (user (or user null) nil)
27 (language (or string null) nil)
28 (custom-emoji-id (or string null) nil))
29
30(unless (= char-code-limit #x110000)
31 (error "Some UTF-16 fuckery assumes that system chars are UTF-32"))
32
33(defun utf16-width (ch)
34 (if (< (char-code ch) #x10000)
35 1
36 2))
37
38(defun message-entity-extract (entity text)
39 (with-slots (length offset) entity
40 (if (= length 0)
41 ""
42 (let* ((start (iterate
43 (with curr-idx16 = 0)
44 (for ch in-string text with-index curr-idx32)
45 (for curr-width = (utf16-width ch))
46 (when (or (= curr-idx16 offset)
47 (> (+ curr-idx16 curr-width) offset))
48 (return curr-idx32))
49 (setq curr-idx16 (+ curr-idx16 curr-width))
50 (finally (return (length text)))))
51 (end (iterate
52 (with curr-len16 = 0)
53 (for ch in-string text from start with-index curr-idx32)
54 (for curr-width = (utf16-width ch))
55 (when (>= curr-len16 length)
56 (return curr-idx32))
57 (setq curr-len16 (+ curr-len16 curr-width))
58 (finally (return (length text))))))
59 (subseq text start end)))))