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