diff options
Diffstat (limited to 'src/tg')
| -rw-r--r-- | src/tg/delete-message.lisp | 15 | ||||
| -rw-r--r-- | src/tg/get-me.lisp | 22 | ||||
| -rw-r--r-- | src/tg/send-animation.lisp | 16 | ||||
| -rw-r--r-- | src/tg/send-message.lisp | 13 |
4 files changed, 57 insertions, 9 deletions
diff --git a/src/tg/delete-message.lisp b/src/tg/delete-message.lisp index 3e79de7..fd6f323 100644 --- a/src/tg/delete-message.lisp +++ b/src/tg/delete-message.lisp | |||
| @@ -1,10 +1,21 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | 1 | ;; SPDX-License-Identifier: EUPL-1.2 |
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> |
| 3 | (defpackage :ukkoclot/tg/delete-message | 3 | (defpackage :ukkoclot/tg/delete-message |
| 4 | (:use :c2cl :ukkoclot/bot/method-macros) | 4 | (:use :c2cl :ukkoclot/tg/message :ukkoclot/bot/method-macros :ukkoclot/tg/send-animation) |
| 5 | (:export :delete-message)) | 5 | (:export :delete-message :try-delete-message)) |
| 6 | (in-package :ukkoclot/tg/delete-message) | 6 | (in-package :ukkoclot/tg/delete-message) |
| 7 | 7 | ||
| 8 | (define-tg-method (delete-message boolean) | 8 | (define-tg-method (delete-message boolean) |
| 9 | (chat-id (or integer string)) | 9 | (chat-id (or integer string)) |
| 10 | (message-id integer)) | 10 | (message-id integer)) |
| 11 | |||
| 12 | (defun try-delete-message (bot msg) | ||
| 13 | (handler-case | ||
| 14 | (delete-message bot | ||
| 15 | :chat-id (message-chat-id msg) | ||
| 16 | :message-id (message-id msg)) | ||
| 17 | (error () | ||
| 18 | (handler-case | ||
| 19 | (reply-animation bot msg #P"blob/do-not.mp4" | ||
| 20 | :allow-sending-without-reply nil) | ||
| 21 | (error () nil))))) | ||
diff --git a/src/tg/get-me.lisp b/src/tg/get-me.lisp index ae00717..cfb1304 100644 --- a/src/tg/get-me.lisp +++ b/src/tg/get-me.lisp | |||
| @@ -3,13 +3,25 @@ | |||
| 3 | (defpackage :ukkoclot/tg/get-me | 3 | (defpackage :ukkoclot/tg/get-me |
| 4 | (:use :c2cl :ukkoclot/bot/method-macros :ukkoclot/tg/user) | 4 | (:use :c2cl :ukkoclot/bot/method-macros :ukkoclot/tg/user) |
| 5 | (:import-from :ukkoclot/state :bot-id% :bot-username%) | 5 | (:import-from :ukkoclot/state :bot-id% :bot-username%) |
| 6 | (:export :get-me)) | 6 | (:export :bot-id :bot-username :get-me)) |
| 7 | (in-package :ukkoclot/tg/get-me) | 7 | (in-package :ukkoclot/tg/get-me) |
| 8 | 8 | ||
| 9 | (define-tg-method (get-me% user :GET)) | 9 | (define-tg-method (get-me% user :GET)) |
| 10 | 10 | ||
| 11 | (defun get-me (bot) | 11 | (defun get-me (bot) |
| 12 | (let ((res (get-me% bot))) | 12 | (let ((me (get-me bot))) |
| 13 | (setf (bot-id% bot) (user-id res)) | 13 | (setf (bot-id% bot) (user-id me)) |
| 14 | (setf (bot-username% bot) (user-username res)) | 14 | (setf (bot-username% bot) (user-username me)) |
| 15 | res)) | 15 | me)) |
| 16 | |||
| 17 | (defun bot-id (bot) | ||
| 18 | (or (bot-id% bot) | ||
| 19 | (progn | ||
| 20 | (get-me bot) | ||
| 21 | (bot-id% bot)))) | ||
| 22 | |||
| 23 | (defun bot-username (bot) | ||
| 24 | (or (bot-username% bot) | ||
| 25 | (progn | ||
| 26 | (get-me bot) | ||
| 27 | (bot-username% bot)))) | ||
diff --git a/src/tg/send-animation.lisp b/src/tg/send-animation.lisp index e9558fa..97dd9f0 100644 --- a/src/tg/send-animation.lisp +++ b/src/tg/send-animation.lisp | |||
| @@ -13,7 +13,7 @@ | |||
| 13 | :ukkoclot/tg/reply-keyboard-remove | 13 | :ukkoclot/tg/reply-keyboard-remove |
| 14 | :ukkoclot/tg/reply-parameters | 14 | :ukkoclot/tg/reply-parameters |
| 15 | :ukkoclot/tg/suggested-post-parameters) | 15 | :ukkoclot/tg/suggested-post-parameters) |
| 16 | (:export :send-animation)) | 16 | (:export :reply-animation :send-animation)) |
| 17 | (in-package :ukkoclot/tg/send-animation) | 17 | (in-package :ukkoclot/tg/send-animation) |
| 18 | 18 | ||
| 19 | (define-tg-method (send-animation message) | 19 | (define-tg-method (send-animation message) |
| @@ -38,3 +38,17 @@ | |||
| 38 | (suggested-post-parameters (or suggested-post-parameters null) nil) | 38 | (suggested-post-parameters (or suggested-post-parameters null) nil) |
| 39 | (reply-parameters (or reply-parameters null) nil) | 39 | (reply-parameters (or reply-parameters null) nil) |
| 40 | (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) | 40 | (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) |
| 41 | |||
| 42 | ;; TODO: Some kind of caching for files? | ||
| 43 | (defun reply-animation (bot msg animation &key allow-sending-without-reply text parse-mode caption-above) | ||
| 44 | (send-animation bot | ||
| 45 | :chat-id (message-chat-id msg) | ||
| 46 | :animation animation | ||
| 47 | :caption text | ||
| 48 | :parse-mode parse-mode | ||
| 49 | :show-caption-above-media caption-above | ||
| 50 | :reply-parameters | ||
| 51 | (make-reply-parameters | ||
| 52 | :allow-sending-without-reply allow-sending-without-reply | ||
| 53 | :message-id (message-id msg) | ||
| 54 | :chat-id (message-chat-id msg)))) | ||
diff --git a/src/tg/send-message.lisp b/src/tg/send-message.lisp index d2e7248..7cd91d9 100644 --- a/src/tg/send-message.lisp +++ b/src/tg/send-message.lisp | |||
| @@ -13,7 +13,7 @@ | |||
| 13 | :ukkoclot/tg/reply-keyboard-markup | 13 | :ukkoclot/tg/reply-keyboard-markup |
| 14 | :ukkoclot/tg/reply-keyboard-remove | 14 | :ukkoclot/tg/reply-keyboard-remove |
| 15 | :ukkoclot/tg/reply-parameters) | 15 | :ukkoclot/tg/reply-parameters) |
| 16 | (:export :send-message)) | 16 | (:export :reply-message :send-message)) |
| 17 | (in-package :ukkoclot/tg/send-message) | 17 | (in-package :ukkoclot/tg/send-message) |
| 18 | 18 | ||
| 19 | (define-tg-method (send-message message) | 19 | (define-tg-method (send-message message) |
| @@ -29,3 +29,14 @@ | |||
| 29 | (message-effect-id (or string null) nil) | 29 | (message-effect-id (or string null) nil) |
| 30 | (reply-parameters (or reply-parameters null) nil) | 30 | (reply-parameters (or reply-parameters null) nil) |
| 31 | (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) | 31 | (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) |
| 32 | |||
| 33 | (defun reply-message (bot msg text &key parse-mode allow-sending-without-reply) | ||
| 34 | (send-message bot | ||
| 35 | :chat-id (message-chat-id msg) | ||
| 36 | :text text | ||
| 37 | :parse-mode parse-mode | ||
| 38 | :reply-parameters | ||
| 39 | (make-reply-parameters | ||
| 40 | :allow-sending-without-reply allow-sending-without-reply | ||
| 41 | :message-id (message-id msg) | ||
| 42 | :chat-id (message-chat-id msg)))) | ||