diff options
Diffstat (limited to 'src/tg-types/user.lisp')
| -rw-r--r-- | src/tg-types/user.lisp | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/src/tg-types/user.lisp b/src/tg-types/user.lisp new file mode 100644 index 0000000..c5ed499 --- /dev/null +++ b/src/tg-types/user.lisp | |||
| @@ -0,0 +1,48 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/tg-types/user | ||
| 4 | (:use :c2cl :ukkoclot/tg-types/macros) | ||
| 5 | (:import-from :ukkoclot/strings :escape-xml) | ||
| 6 | (:export | ||
| 7 | user user-p | ||
| 8 | |||
| 9 | hash->user make-user parse-user-array user-format-name | ||
| 10 | |||
| 11 | user-id user-is-bot user-first-name user-last-name user-username user-language-code user-is-premium | ||
| 12 | user-added-to-attachment-menu user-can-join-groups user-can-read-all-group-messages user-supports-inline-queries | ||
| 13 | user-can-connect-to-business)) | ||
| 14 | (in-package :ukkoclot/tg-types/user) | ||
| 15 | |||
| 16 | (define-tg-type user | ||
| 17 | (id integer) | ||
| 18 | (is-bot boolean) | ||
| 19 | (first-name string) | ||
| 20 | (last-name (or string null) nil) | ||
| 21 | (username (or string null) nil) | ||
| 22 | (language-code (or string null) nil) | ||
| 23 | (is-premium boolean nil) | ||
| 24 | (added-to-attachment-menu boolean nil) | ||
| 25 | (can-join-groups boolean nil) | ||
| 26 | (can-read-all-group-messages boolean nil) | ||
| 27 | (supports-inline-queries boolean nil) | ||
| 28 | (can-connect-to-business boolean nil)) | ||
| 29 | |||
| 30 | (defun user-format-name% (user out) | ||
| 31 | (format out "<a href=\"tg://user?id=~A\"><i>" (user-id user)) | ||
| 32 | (escape-xml (user-first-name user) out) | ||
| 33 | (when (user-last-name user) | ||
| 34 | (write-char #\Space out) | ||
| 35 | (escape-xml (user-last-name user) out)) | ||
| 36 | (write-string "</i>" out) | ||
| 37 | |||
| 38 | (when (user-username user) | ||
| 39 | (write-string " @" out) | ||
| 40 | (escape-xml (user-username user) out)) | ||
| 41 | |||
| 42 | (format out "</a> [<code>~A</code>]" (user-id user))) | ||
| 43 | |||
| 44 | (defun user-format-name (user &optional out) | ||
| 45 | (if out | ||
| 46 | (user-format-name% user out) | ||
| 47 | (with-output-to-string (stream) | ||
| 48 | (user-format-name% user stream)))) | ||