尝试用 Emacs Lisp 写简单的 Telegram 机器人

Emacs-general
1

试着用 Emacs Lisp 写了个 Telegram 机器人，输入 /doc func 返回函数的 docstring。

使用方法

  1. 注册机器人获得 Token，保存到 ~/.authinfo[.gpg]
  2. M-x telegram-bot-getUpdates

退出方法：（狂？）按任意键（C-g?）

注意很可能会遇到问题，除了我代码可能有问题之外，还可以怪 Emacs、怪 url.el、怪 gnutls.el、怪需要代理。

截屏2020-11-23 下午11.50.01
截屏2020-11-23 下午11.50.01527×675 116 KB 

(require 'json)
(require 'auth-source)

(defvar url-http-end-of-headers)
(defvar url-http-response-status)

(defvar telegram-bot-token
  (funcall
   (plist-get
    (car
     (auth-source-search :host "api.telegram.org" :max 1))
    :secret)))

(defun telegram-bot-endpoint (method)
  (format "https://api.telegram.org/bot%s/%s"
          telegram-bot-token
          method))

(defun telegram-bot-url (method &optional params)
  (let ((base (telegram-bot-endpoint method)))
    (if (null params)
        base
      (format "%s?%s"
              (telegram-bot-endpoint method)
              (mapconcat
               (pcase-lambda (`(,key . ,val))
                 (format "%s=%s"
                         (url-hexify-string (symbol-name key))
                         (if (numberp val)
                             (number-to-string val)
                           (url-hexify-string val))))
               params
               "&")))))

(defun telegram-bot-json-read ()
  (message "HTTP STATUS: %s" url-http-response-status)
  (goto-char (point-min))
  (if (not (re-search-forward "application/json" url-http-end-of-headers t))
      (let ((server-error
             (message "content-type is not json, skipping, see %s" (current-buffer))))
        `((server-error . ,server-error)))
    (set-buffer-multibyte t)
    (goto-char url-http-end-of-headers)
    (condition-case err
        (let ((json-object-type 'alist)
              (json-array-type  'list)
              (json-key-type    'symbol)
              (json-false       nil)
              (json-null        nil))
          (prog1 (json-read)
            (kill-buffer)))
      (json-readtable-error
       ;; seems not working, no buffer shows when error occurs
       (display-buffer (current-buffer))
       (signal (car err) (cdr err))))))

(defun telegram-bot-getUpdates (&optional offset)
  (interactive)
  (let ((url (if offset
                 (telegram-bot-url "getUpdates" `((offset . ,offset)))
               (telegram-bot-url "getUpdates"))))
    (message "Fetching %s" url)
    (url-retrieve
     url
     (lambda (_status)
       (let ((data (telegram-bot-json-read)))
         (let-alist data
           (if (not .ok)
               (message "getUpdates not ok: %s" data)
             (let ((updates .result))
               (mapc #'telegram-bot-sendMessage updates)
               (when updates
                 (setq offset (1+ (alist-get 'update_id (car (last updates))))))
               (if (sit-for 0.1)        ; 任意键退出
                   (telegram-bot-getUpdates offset)
                 (message "telegram-bot exited")))))))
     nil 'silent)))

(defun telegram-bot-sendMessage (update)
  (let-alist update
    (message "Handle update #%d" .update_id)
    (if (not .message)
        (message "Can't handle the update, it's not message type")
      (let ((url
             (telegram-bot-url "sendMessage"
                               `((chat_id . ,.message.chat.id)
                                 (text . ,(telegram-bot-handle-message .message))))))
        (message "Fetch %s" url)
        (url-retrieve
         url
         (lambda (_status)
           (let ((data (telegram-bot-json-read)))
             (let-alist data
               (unless .ok
                 (message "sendMessage not ok: %s" data)))))
         nil 'silent)))))

;; https://core.telegram.org/bots/api#message
(defun telegram-bot-handle-message (message)
  (let ((text (alist-get 'text message))
        ;; ensure case-insensitive regexp
        (case-fold-search t))
    (pcase text
      ('nil "Bot error! missing text")
      ((rx bos "/help")
       "Use `/doc FUNCTION` to lookup docstring, e.g., `/doc car`")
      ((rx bos "/doc " (let name (1+ (not space))) (* space) eos)
       (if-let ((sym (intern-soft name))
                (_ (functionp sym))
                (doc (documentation sym)))
           doc
         (format "No documentation for %S" name)))
      (_
       (upcase text)))))
6 个赞