Working Gallery example.

examples/calc.lisp

@@ -23,8 +23,8 @@
                 #:message-message-id)
   (:import-from #:cl-telegram-bot2/states/ask-for-number
                 #:ask-for-number)
-  (:import-from #:cl-telegram-bot2/state
-                #:result-var)
+  (:import-from #:cl-telegram-bot2/states/base
+                #:var)
   (:import-from #:cl-telegram-bot2/states/ask-for-choice
                 #:ask-for-choice)
   (:import-from #:40ants-logging)
@@ -35,9 +35,9 @@
 
 
 (defun calc-result ()
-  (let* ((num1 (result-var "first-num"))
-         (num2 (result-var "second-num"))
-         (op-name (result-var "operation-name"))
+  (let* ((num1 (var "first-num"))
+         (num2 (var "second-num"))
+         (op-name (var "operation-name"))
          (op (gethash op-name
                       (dict "+" #'+
                             "-" #'-
@@ -49,8 +49,8 @@
 
 (defun make-prompt-for-op-choice ()
   (fmt "Select an operation to apply to ~A and ~A:"
-       (result-var "first-num")
-       (result-var "second-num")))
+       (var "first-num")
+       (var "second-num")))
 
 (defbot test-bot ()
   ()

examples/gallery.lisp

@@ -32,7 +32,12 @@
   (:import-from #:str
                 #:trim)
   (:import-from #:cl-telegram-bot2/actions/send-photo
-                #:send-photo))
+                #:send-photo)
+  (:import-from #:cl-telegram-bot2/actions/edit-message-media
+                #:edit-message-media)
+  (:import-from #:cl-telegram-bot2/states/base
+                #:var)
+  (:documentation "This example shows how to keep use state's vars to keep current photo's index and to edit message's media when user clicks on Prev/Next buttons."))
 (in-package #:cl-telegram-bot2-examples/gallery)
 
 
@@ -43,21 +48,65 @@
                (make-pathname :directory '(:relative "examples" "images"))))))
 
 
+(defun make-keyboard (photo-index)
+  (remove nil
+          (list
+           (unless (zerop photo-index)
+             "Prev")
+           (unless (= photo-index
+                      (1- (length *photos*)))
+             "Next"))))
+
+
+(defun show-photo ()
+  (let ((photo-index (var "photo-index")))
+
+    (unless photo-index
+      (setf photo-index 0)
+      (setf (var "photo-index")
+            photo-index))
+
+    (send-photo (elt *photos* photo-index)
+                :caption (fmt "Cat ~A" (1+ photo-index))
+                :inline-keyboard (make-keyboard photo-index))))
+
+
+(defun show-next-photo ()
+  (let ((photo-index (min (1- (length *photos*))
+                          (1+ (var "photo-index")))))
+
+    (setf (var "photo-index")
+          photo-index)
+
+    (edit-message-media (elt *photos* photo-index)
+                        :caption (fmt "Cat ~A" (1+ photo-index))
+                        :inline-keyboard (make-keyboard photo-index))))
+
+(defun show-prev-photo ()
+  (let ((photo-index (max 0
+                          (1- (var "photo-index")))))
+
+    (setf (var "photo-index")
+          photo-index)
+
+    (edit-message-media (elt *photos* photo-index)
+                        :caption (fmt "Cat ~A" (1+ photo-index))
+                        :inline-keyboard (make-keyboard photo-index))))
+
+
 (defbot test-bot ()
   ()
   (:initial-state
    (state nil
-          :on-update (send-photo (first *photos*)
-                                 :caption "Cat 1"
-                                 :inline-keyboard (list "Prev" "Next"))
+          :on-update 'show-photo
           :on-callback-query
           (list (cons "Next"
-                      (edit-photo (second *photos*)
-                                  :caption "Cat 2"
-                                  :inline-keyboard (list "Prev" "Next")))
+                      'show-next-photo)
                 (cons "Prev"
-                      (send-text "No prev photo"))))))
+                      'show-prev-photo)))))
+
 
+;; Technical part
 
 (defvar *bot* nil)
 

v2/actions/edit-message-media.lisp

@@ -0,0 +1,114 @@
+(uiop:define-package #:cl-telegram-bot2/actions/edit-message-media
+  (:use #:cl)
+  (:import-from #:cl-telegram-bot2/action
+                #:action)
+  (:import-from #:cl-telegram-bot2/vars
+                #:*current-state*
+                #:*current-chat*)
+  (:import-from #:cl-telegram-bot2/api
+                #:message-chat
+                #:update-message
+                #:update
+                #:chat-id
+                #:send-message)
+  (:import-from #:cl-telegram-bot2/generics
+                #:on-result
+                #:process
+                #:on-state-activation)
+  (:import-from #:cl-telegram-bot2/high
+                #:reply)
+  (:import-from #:serapeum
+                #:soft-list-of
+                #:->)
+  (:import-from #:cl-telegram-bot2/utils
+                #:call-if-needed)
+  (:import-from #:cl-telegram-bot2/states/base
+                #:sent-message-ids)
+  (:export #:edit-message-media))
+(in-package #:cl-telegram-bot2/actions/edit-message-media)
+
+
+(defclass edit-message-media (action)
+  ((path :initarg :path
+         :type (or string
+                   pathname
+                   symbol)
+         :reader media-path)
+   (caption :initarg :caption
+            :type string
+            :reader caption)
+   (inline-keyboard :initarg :inline-keyboard
+                    :type (soft-list-of string)
+                    :reader inline-keyboard)))
+
+
+(-> edit-message-media ((or string pathname symbol)
+                        &key
+                        (:caption string)
+                        (:inline-keyboard (soft-list-of string)))
+    (values edit-message-media &optional))
+
+
+(defun edit-message-media (path-or-func-name &key caption inline-keyboard)
+  (when (and (symbolp path-or-func-name)
+             (not (fboundp path-or-func-name)))
+    (error "EDIT-MESSAGE-MEDIA waits a path or fbound symbol. ~S is not fbound."
+           path-or-func-name))
+
+  (make-instance 'edit-message-media
+                 :path path-or-func-name
+                 :caption (or caption "")
+                 :inline-keyboard inline-keyboard))
+
+
+(defmethod print-object ((obj edit-message-media) stream)
+  (print-unreadable-object (obj stream :type t)
+    (format stream "~S"
+            (media-path obj))))
+
+
+(defun send-reply (action)
+  (let ((path (call-if-needed
+               (media-path action)))
+        (caption (call-if-needed
+                  (caption action)))
+        (buttons (call-if-needed
+                  (inline-keyboard action)))
+        (message-id (first (sent-message-ids *current-state*)))
+        (chat-id (chat-id *current-chat*)))
+
+    (cl-telegram-bot2/api:edit-message-media
+     (make-instance 'cl-telegram-bot2/api:input-media-photo
+                    :type "photo"
+                    :media path
+                    ;; These options aren't supported yet
+                    ;; has_spoiler
+                    ;; show_caption_above_media
+                    ;; parse_mode
+                    ;; caption_entities
+                    :caption caption)
+     :chat-id chat-id
+     :message-id message-id
+     :reply-markup
+     (make-instance 'cl-telegram-bot2/api:inline-keyboard-markup
+                    :inline-keyboard
+                    (list
+                     (loop for button in buttons
+                           collect (make-instance 'cl-telegram-bot2/api:inline-keyboard-button
+                                                  :text button
+                                                  :callback-data button)))))))
+
+
+(defmethod on-state-activation ((action edit-message-media))
+  (send-reply action)
+  (values))
+
+
+(defmethod process ((action edit-message-media) update)
+  (send-reply action)
+  (values))
+
+
+(defmethod on-result ((action edit-message-media) result)
+  (send-reply action)
+  (values))

v2/actions/send-photo.lisp

@@ -63,15 +63,14 @@
             (image-path obj))))
 
 
-(defun reply-with-image (action)
+(defun send-reply (action)
   (let ((path (call-if-needed
                (image-path action)))
         (caption (call-if-needed
                   (caption action)))
         (buttons (call-if-needed
                   (inline-keyboard action))))
-    (cl-telegram-bot2/api:send-photo
-     (chat-id *current-chat*)
+    (cl-telegram-bot2/high:reply-with-photo
      path
      :caption caption
      :reply-markup
@@ -85,15 +84,15 @@
 
 
 (defmethod on-state-activation ((action send-photo))
-  (reply-with-image action)
+  (send-reply action)
   (values))
 
 
 (defmethod process ((action send-photo) update)
-  (reply-with-image action)
+  (send-reply action)
   (values))
 
 
 (defmethod on-result ((action send-photo) result)
-  (reply-with-image action)
+  (send-reply action)
   (values))

v2/high.lisp

@@ -3,6 +3,7 @@
   (:import-from #:serapeum
                 #:defvar-unbound)
   (:import-from #:cl-telegram-bot2/api
+                #:send-photo
                 #:message-chat
                 #:update-message
                 #:update
@@ -19,7 +20,8 @@
   (:documentation "High level API for implementing Telegram bots.")
   (:export #:reply
            #:chat-state
-           #:collect-sent-messages))
+           #:collect-sent-messages
+           #:reply-with-photo))
 (in-package #:cl-telegram-bot2/high)
 
 
@@ -34,7 +36,12 @@
 (defmacro collect-sent-messages (&body body)
   "Returns as the first value a list of messages created by REPLY function called
    during BODY execution. Values returned by the BODY code are returned as the second,
-   third and following arguments."
+   third and following arguments.
+
+   Also, messages are collected when these actions are called:
+
+   - CL-TELEGRAM-BOT2/ACTIONS/SEND-TEXT:SEND-TEXT
+   - CL-TELEGRAM-BOT2/ACTIONS/SEND-PHOTO:SEND-PHOTO"
   `(let* ((*collected-messages* nil)
           (result-values (multiple-value-list ,@body)))
      (values-list (list* *collected-messages*
@@ -56,7 +63,7 @@
        ,@body)))
 
 
-(defun-with-same-keys (reply cl-telegram-bot2/api::send-message)
+(defun-with-same-keys (reply send-message)
                       (text &rest rest)
   (let* ((chat-id (chat-id *current-chat*))
          (message (apply #'send-message
@@ -68,6 +75,18 @@
     (values message)))
 
 
+(defun-with-same-keys (reply-with-photo send-photo)
+                      (photo &rest rest)
+  (let* ((chat-id (chat-id *current-chat*))
+         (message (apply #'send-photo
+                         chat-id
+                         photo
+                         rest)))
+    (when (boundp '*collected-messages*)
+      (push message *collected-messages*))
+    (values message)))
+
+
 ;; (defun reply (text &rest rest &key #.*args*)
 ;;   (let ((chat-id (chat-id *current-chat*)))
 ;;     (apply #'send-message

v2/pipeline.lisp

@@ -31,6 +31,7 @@
   ;; (:import-from #:cl-telegram-bot/user
   ;;               #:get-user-info)
   (:import-from #:cl-telegram-bot2/vars
+                #:*current-state*
                 #:*current-bot*
                 #:*current-user*)
   (:import-from #:cl-telegram-bot2/generics
@@ -334,15 +335,15 @@
   (handler-bind ((serious-condition #'invoke-debugger))
     (log:info "Processing chat update"
               update)
-    (let* ((state-to-process (car *state*))
+    (let* ((*current-state* (car *state*))
            (*current-chat* (get-chat update))
            (*current-user* (get-user update))
-           (new-state (process state-to-process update)))
+           (new-state (process *current-state* update)))
 
       (labels ((probably-switch-to-new-state (new-state)
-                 (let ((current-state (car *state*)))
+                 (let ((*current-state* (car *state*)))
                    (when (and new-state
-                              (not (eql current-state new-state)))
+                              (not (eql *current-state* new-state)))
 
                      (cond
                        ;; If next state is a symbol, we need to instantiate it:
@@ -383,6 +384,7 @@
                         (probably-switch-to-new-state
                          (on-state-activation new-state)))
                        (t
+                        (break)
                         (log:warn "Object ~S is not of BASE-STATE class and can't be pushed to the states stack."
                                   new-state)))))))
         (probably-switch-to-new-state new-state)))