fixes

bot.lisp

@@ -49,21 +49,19 @@
 (def-message-admin-cmd-handler handle-admin-setsetting (:setsetting)
   (let* ((*package* (find-package :chatikbot))
          (var (read-from-string (car *args*)))
-         (val (read-from-string (format nil "~{~A~^ ~}" (rest *args*)))))
+         (val (read-from-string (spaced (cdr *args*)))))
     (bot-send-message (format nil "OK, ~A" (set-setting var val)))))
 
 (defvar *chat-next-message-handlers* (make-hash-table) "Out-of-order chat message handler")
 (defmacro on-next-message (&body body)
   `(setf (gethash *chat-id* *chat-next-message-handlers*)
-         (lambda (message)
-           (with-parsed-message message
-             ,@body))))
+         (lambda () ,@body)))
 
-(def-message-handler chat-next-message-handler (message 1000)
+(def-message-handler chat-next-message-handler (1000)
   (let ((handler (gethash *chat-id* *chat-next-message-handlers*)))
     (when handler
       (remhash *chat-id* *chat-next-message-handlers*)
-      (handler-case (funcall handler message)
+      (handler-case (funcall handler)
         (error (e)
           (log:error "~A" e)
           (bot-send-message (format nil "Ошибочка вышла~@[: ~A~]"

common.lisp

@@ -163,6 +163,10 @@
            :with-random-state
            :defcron
 
+           :handle-update
+           :*bot-user-id*
+           :on-next-message
+
            :get-inline-keyboard
            :inline-button
 

inline.lisp

@@ -39,16 +39,17 @@
   (prune-buttons))
 
 (defmacro inline-button ((text) &body body)
-  `(cons ,text
-         (lambda (callback)
-           (with-parsed-callback callback
-             (handler-case (progn ,@body)
-               (error (e)
-                 (log:error "~A" e)
-                 (telegram-answer-callback-query
-                  *query-id*
-                  :text (format nil "Ошибочка вышла~@[: ~A~]"
-                                (when (is-admin *source-chat-id*) e)))))))))
+  (alexandria:with-gensyms (g-callback)
+    `(cons ,text
+           (lambda (,g-callback)
+             (with-parsed-callback ,g-callback
+               (handler-case (progn ,@body)
+                 (error (e)
+                   (log:error "~A" e)
+                   (telegram-answer-callback-query
+                    *query-id*
+                    :text (format nil "Ошибочка вышла~@[: ~A~]"
+                                  (when (is-admin) e))))))))))
 
 (defun get-inline-keyboard (buttons &optional (chat-id *chat-id*))
   (telegram-inline-keyboard-markup

macros.lisp

@@ -22,26 +22,28 @@
                           (values))))
 
 (defmacro with-parsed-message (message &body body)
-  `(let ((*message-id* (agets ,message "message_id"))
-         (*from-id* (agets ,message "from" "id"))
-         (*chat-id* (agets ,message "chat" "id"))
-         (*text* (agets ,message "text")))
+  `(let* ((*message* ,message)
+          (*message-id* (agets *message* "message_id"))
+          (*from-id* (agets *message* "from" "id"))
+          (*chat-id* (agets *message* "chat" "id"))
+          (*text* (agets *message* "text")))
      ,@body))
 
-(defmacro def-message-handler (name (message &optional prio) &body body)
-  `(progn
-     (defun ,name (,message)
-       (with-parsed-message ,message
-         (handler-case (progn ,@body)
-           (error (e)
-             (log:error "~A" e)
-             (bot-send-message (format nil "Ошибочка вышла~@[: ~A~]"
-                                       (when (is-admin) e)))))))
-     (when ,prio (setf (get ',name :prio) ,prio))
-     (add-hook :update-message ',name)))
+(defmacro def-message-handler (name (&optional prio) &body body)
+  (alexandria:with-gensyms (g-message)
+    `(progn
+       (defun ,name (,g-message)
+         (with-parsed-message ,g-message
+           (handler-case (progn ,@body)
+             (error (e)
+               (log:error "~A" e)
+               (bot-send-message (format nil "Ошибочка вышла~@[: ~A~]"
+                                         (when (is-admin) e)))))))
+       (when ,prio (setf (get ',name :prio) ,prio))
+       (add-hook :update-message ',name))))
 
 (defmacro def-message-cmd-handler (name (&rest commands) &body body)
-  `(def-message-handler ,name (*message*)
+  `(def-message-handler ,name ()
      (when (and *text* (equal #\/ (char *text* 0)))
        (multiple-value-bind (*cmd* *args*) (parse-cmd *text*)
          (when (member *cmd* (list ,@commands))
@@ -50,7 +52,7 @@
            t)))))
 
 (defmacro def-message-admin-cmd-handler (name (&rest commands) &body body)
-  `(def-message-handler ,name (*message*)
+  `(def-message-handler ,name ()
      (when (and (is-admin)
                 *text* (equal #\/ (char *text* 0)))
        (multiple-value-bind (*cmd* *args*) (parse-cmd *text*)
@@ -60,31 +62,34 @@
            t)))))
 
 (defmacro with-parsed-callback (callback &body body)
-  `(let* ((*query-id* (agets ,callback "id"))
-          (*from* (agets ,callback "from"))
-          (*raw-data* (agets ,callback "data"))
-          (*source-message* (agets ,callback "message"))
-          (*inline-message-id* (agets ,callback "inline_message_id"))
+  `(let* ((*callback* ,callback)
+          (*query-id* (agets *callback* "id"))
+          (*from* (agets *callback* "from"))
+          (*raw-data* (agets *callback* "data"))
+          (*source-message* (agets *callback* "message"))
+          (*inline-message-id* (agets *callback* "inline_message_id"))
           (*from-id* (agets *from* "id"))
           (*source-chat-id* (agets *source-message* "chat" "id"))
-          (*source-message-id* (agets *source-message* "message_id")))
+          (*source-message-id* (agets *source-message* "message_id"))
+          (*chat-id* *source-chat-id*))
      ,@body))
 
-(defmacro def-callback-handler (name (callback &optional prio) &body body)
-  `(progn
-     (defun ,name (,callback)
-       (with-parsed-callback ,callback
-         (handler-case (progn ,@body)
-           (error (e)
-             (log:error "~A" e)
-             (bot-send-message (format nil "Ошибочка вышла~@[: ~A~]"
-                                       (when (member *source-chat-id* *admins*) e))
-                               :chat-id (or *source-chat-id* *from-id*))))))
-     (when ,prio (setf (get ',name :prio) ,prio))
-     (add-hook :update-callback-query ',name)))
+(defmacro def-callback-handler (name (&optional prio) &body body)
+  (alexandria:with-gensyms (g-callback)
+    `(progn
+       (defun ,name (,g-callback)
+         (with-parsed-callback ,g-callback
+           (handler-case (progn ,@body)
+             (error (e)
+               (log:error "~A" e)
+               (bot-send-message (format nil "Ошибочка вышла~@[: ~A~]"
+                                         (when (is-admin*) e))
+                                 :chat-id (or *source-chat-id* *from-id*))))))
+       (when ,prio (setf (get ',name :prio) ,prio))
+       (add-hook :update-callback-query ',name))))
 
 (defmacro def-callback-section-handler (name (&rest sections) &body body)
-  `(def-callback-handler ,name (*callback*)
+  `(def-callback-handler ,name ()
      (when *source-chat-id*
        (multiple-value-bind (*data* *section*) (decode-callback-data *source-chat-id* *raw-data*)
          (when (member *section* (list ,@sections))

plugins/finance.lisp

@@ -173,7 +173,7 @@
 (defun db/orders-get (chat-id &optional user-id symbol opened)
   (db-select "select rowid, user_id, user_name, symbol, amount, open, open_at, close, close_at from finance_orders where chat_id = ? and (user_id = ? or ?) and (symbol = ? or ?) and (close is null or ?) order by open_at, close_at"
              chat-id
-             user-id (if (or (null user-id) (member user-id *admins*)) 1 0)
+             user-id (if (or (null user-id) (is-admin)) 1 0)
              symbol (if (null symbol) 1 0)
              (if opened 0 1)))
 

plugins/forecast.lisp

@@ -74,9 +74,9 @@
 ;;; Hooks
 (defvar *chat-locations* nil "ALIST of chat->location")
 
-(def-message-handler handle-location (message)
-  (let ((chat-id (aget "id" (aget "chat" message)))
-        (location (aget "location" message)))
+(def-message-handler handle-location ()
+  (let ((chat-id (aget "id" (aget "chat" *message*)))
+        (location (aget "location" *message*)))
     (when location
       (log:info "handler-location" chat-id location)
       (set-setting '*chat-locations* (cons (cons chat-id location) *chat-locations*))

plugins/huiza.lisp

@@ -52,7 +52,7 @@
     (when resp
       (bot-send-message resp :reply-to reply-id))))
 
-(def-message-handler huiza-handler (message -1000)
-  (log:info "handle-unknown-message" message)
+(def-message-handler huiza-handler (-1000)
+  (log:info "handle-unknown-message" *message*)
   (send-dont-understand (preprocess-input text))
   t)

plugins/ledger.lisp

@@ -329,9 +329,10 @@
   (cond
     ((>= (length *args*) 2)
      (ledger/new-chat-entry *chat-id* (create-entry *chat-id*
-                                                  (spaced (subseq *args* 1))
-                                                  (parse-float (car *args*)))))
-    (:otherwise (bot-send-message format nil "/~A <amount> <description>" *cmd*))))
+                                                    (spaced (subseq *args* 1))
+                                                    (parse-float (car *args*))
+                                                    (symbol-name *cmd*))))
+    (:otherwise (bot-send-message (format nil "/~A <amount> <description>" *cmd*)))))
 
 (def-webhook-handler ledger/handle-webhook ("ledger")
   (when (= 2 (length *paths*))
@@ -380,7 +381,7 @@
      (format-entry entry)
      :chat-id chat-id
      :parse-mode "markdown"
-     :reply-markup (keyboard/entry chat-id entry))))
+     :reply-markup (keyboard/entry entry))))
 
 (defun entry-edit (chat-id message-id entry)
   (let ((entry (extend-entry! chat-id entry)))
@@ -388,9 +389,9 @@
      (format-entry entry)
      :chat-id chat-id :message-id message-id
      :parse-mode "markdown"
-     :reply-markup (keyboard/edit-entry chat-id entry))))
+     :reply-markup (keyboard/edit-entry chat-id message-id entry))))
 
-(defun keyboard/entry (chat-id entry)
+(defun keyboard/entry (entry)
   (get-inline-keyboard
    (list
     (list (inline-button ("➕")
@@ -408,7 +409,7 @@
   (if (or (null str) (string= "" str)) default
       str))
 
-(defun keyboard/edit-entry (chat-id entry)
+(defun keyboard/edit-entry (chat-id message-id entry)
   (get-inline-keyboard
    (append
     (list
@@ -421,20 +422,20 @@
                    (if date
                        (progn
                          (setf (pta-ledger:entry-date entry) date)
-                         (entry-edit chat-id *source-message-id* entry))
+                         (entry-edit chat-id message-id entry))
                        (bot-send-message "Не разобрал" :chat-id chat-id)))))
            (inline-button ((def (pta-ledger:entry-description entry) "Описание"))
              (bot-send-message "Введите описание" :chat-id chat-id
                                :reply-markup (telegram-force-reply))
              (on-next-message
                (setf (pta-ledger:entry-description entry) *text*)
-               (entry-edit chat-id *source-message-id* entry)))
+               (entry-edit chat-id message-id entry)))
            (inline-button ((def (pta-ledger:entry-comment entry) "Коммент"))
              (bot-send-message "Введите комментарий" :chat-id chat-id
                                :reply-markup (telegram-force-reply))
              (on-next-message
                  (setf (pta-ledger:entry-comment entry) *text*)
-               (entry-edit chat-id *source-message-id* entry)))))
+               (entry-edit chat-id message-id entry)))))
     (loop for posting in (pta-ledger:entry-postings entry)
        collect
          (let ((this-posting posting))
@@ -450,7 +451,7 @@
                        (let ((amount (pta-ledger:parse-amount *text*)))
                          (setf (pta-ledger:posting-amount this-posting) amount
                                (pta-ledger:posting-status this-posting) nil)
-                         (entry-edit chat-id *source-message-id* entry))))
+                         (entry-edit chat-id message-id entry))))
                  (inline-button ("❌")
                    (setf (pta-ledger:entry-postings entry)
                          (remove this-posting (pta-ledger:entry-postings entry)
@@ -458,7 +459,7 @@
                    (entry-edit chat-id *source-message-id* entry)))))
     (list (list (inline-button ("Готово")
                   (telegram-edit-message-reply-markup
-                   (keyboard/entry chat-id entry)
+                   (keyboard/entry entry)
                    :chat-id chat-id :message-id *source-message-id*)))))))
 
 (defun accounts/nav (account accounts &optional (offset 0) (count 5))
@@ -504,10 +505,10 @@
            (nav-list (multiple-value-list
                       (accounts/nav account accounts offset))))
       (telegram-edit-message-reply-markup
-       (apply #'keyboard/account chat-id entry posting nav-list)
+       (apply #'keyboard/account chat-id message-id entry posting nav-list)
        :chat-id chat-id :message-id message-id))))
 
-(defun keyboard/account (chat-id entry posting account parent children prev next)
+(defun keyboard/account (chat-id message-id entry posting account parent children prev next)
   (get-inline-keyboard
    (append
     (list (list (when account
@@ -524,7 +525,7 @@
                             (progn
                               (setf (pta-ledger:posting-account posting) account
                                     (pta-ledger:posting-status posting) nil)
-                              (entry-edit chat-id *source-message-id* entry))
+                              (entry-edit chat-id message-id entry))
                             (bot-send-message "Не разобрал" :chat-id chat-id)))))))
     (loop for (acc . leaf) in children
        collect (let ((this-account acc))

plugins/transmission.lisp

@@ -100,11 +100,11 @@
                         :reply-markup (and markup (telegram-inline-keyboard-markup (list markup)))))))
 
 (defparameter +magnet-regex+ (ppcre:create-scanner "magnet:\\?\\S+"))
-(def-message-handler handle-magnet (message)
+(def-message-handler handle-magnet ()
   (alexandria:when-let (magnet (ppcre:scan-to-strings +magnet-regex+ *text*))
     (%torrent-add-and-respond :filename magnet)))
 
-(def-message-handler handle-torrent (message)
+(def-message-handler handle-torrent ()
   (alexandria:when-let* ((url (aget *chat-id* *transmission-settings*))
                          (doc (aget "document" *message*))
                          (file-name (aget "file_name" doc))

plugins/tumblr.lisp

@@ -55,7 +55,7 @@
 (defun tumblr-random-photo (&optional (roll *tumblr-roll*) (num 1))
   (tumblr-random-post :roll roll :type :photo :num num))
 
-(def-message-handler handle-tumblr (message -500)
+(def-message-handler handle-tumblr (-500)
   (let* ((*package* (find-package :chatikbot.plugins.tumblr))
          (resp (eliza (read-from-string-no-punct text) *tumblr-rules*)))
     (when resp

poller.lisp

@@ -54,7 +54,7 @@
          (response (apply 'poller-request module method params)))
     (if (poller-validate module response) response
         (with-secret (secret (list module chat-id))
-          (unless secret (error 'polller-no-secret))
+          (unless secret (error 'poller-no-secret))
           (let ((*poller-token* (poller-authenticate module secret)))
             (unless *poller-token* (error 'poller-cant-authenticate))
             (set-data *tokens* chat-id *poller-token* module)

utils.lisp

@@ -1,11 +1,11 @@
 (in-package :cl-user)
 (defpackage chatikbot.utils
   (:use :cl)
-  (:export :*message-id*
+  (:export :*message*
+           :*message-id*
            :*from-id*
            :*chat-id*
            :*text*
-           :*message*
            :*cmd*
            :*args*
            :*query-id*
@@ -78,11 +78,11 @@
 (in-package #:chatikbot.utils)
 
 ;; Special variables
+(defvar *message*)
 (defvar *message-id*)
 (defvar *from-id*)
 (defvar *chat-id*)
 (defvar *text*)
-(defvar *message*)
 (defvar *cmd*)
 (defvar *args*)
 (defvar *query-id*)