实现一个 HTTP 版 的 Emacs Server

自带的 Emacs Server 默认用的是 Unix Socket Domain,我用 web-server 库写了个 HTTP/JSON 版的

输入 eval 是一个字符串,但输出就是原生的 JSON 对象了,这样其它工具就比较好配合,不用去手动解析 emacsclient 的输出了。

~ $ curl -s -F eval="(number-sequence 1 10)" localhost:8888 | jq
{
  "result": [
    1,
    2,
    3,
    4,
    5,
    6,
    7,
    8,
    9,
    10
  ]
}
;; Handle GET and POST urlencode/form-data/json:
;; curl 'http://localhost:8888/?eval=emacs-version'
;; curl --data-urlencode eval=emacs-version localhost:8888
;; curl -F eval=emacs-version localhost:8888
;; curl -d '{"eval": "emacs-version"}' -H "Content-Type: application/json" localhost:8888
(defun chunyang-emacs-server ()
  (require 'web-server)
  (ws-start
   (lambda (request)
     (with-slots (process headers context) request
       (let ((expr
              (pcase context
                ('nil
                 (assoc-default "eval" headers))
                ('application/x-www-form-urlencoded
                 (assoc-default "eval" headers))
                ('multipart/form-data
                 (alist-get 'content (assoc-default "eval" headers)))
                ('application/json
                 (alist-get
                  'eval
                  (let ((json-false nil)
                        (json-array-type 'list))
                    (json-read-from-string
                     (substring
                      (oref request :pending)
                      (oref request :index)))))))))
         (pcase expr
           ('nil
            (process-send-string
             process
             (concat
              "HTTP/1.1 400 Bad Request\r\n"
              "Content-Type: text/plain\r\n"
              "\r\n"
              "The eval parameter not found")))
           (expr
            (process-send-string
             process
             (concat
              "HTTP/1.1 200 OK\r\n"
              "Content-Type: application/json\r\n"
              "\r\n"
              (condition-case err
                  (json-encode
                   (condition-case err
                       (with-timeout (3 '((error . "Timeout")))
                         `((result . ,(eval (read expr)))))
                     (error
                      `((error . ,(error-message-string err))))))
                (json-error
                 (json-encode `((error . ,(error-message-string err)))))))))))))
   8888))
3 个赞

编译报警,难道不是这样访问对象的字段的吗?(我没用过 defclass)

chunyang-emacs-server.el:51:22:Warning: Unknown slot `:pending'
chunyang-emacs-server.el:53:37:Warning: Unknown slot `:index'

应为 (oref request 'pending)

(defclass ws-request ()
  ((process  :initarg :process  :accessor process  :initform nil)
   (pending  :initarg :pending  :accessor pending  :initform "")
   (context  :initarg :context  :accessor context  :initform nil)
   (boundary :initarg :boundary :accessor boundary :initform nil)
   (index    :initarg :index    :accessor index    :initform 0)
   (active   :initarg :active   :accessor active   :initform nil)
   (headers  :initarg :headers  :accessor headers  :initform (list nil))
   (body     :initarg :body     :accessor body     :initform "")))

slot name 是 pending:pending 是给 make-instance 用的 keyword argument

1 个赞

邮件列表有个讨论是说编译的时候把字段名字加进 eieio–known-slot-names 就可以了:

https://lists.gnu.org/archive/html/emacs-devel/2017-01/msg00681.html

应该是(oref request pending)

(oref request pending) = (eieio-oref request 'pending) = (slot-value request 'pending)

1 个赞

我倒是还没注意到 @LdBeth @cireu 两位说的细节。

首先,我注意到的是楼主把 (require 'web-server) 写在函数里面,这样的话就必须在函数外面声明 ws-start 的原型:

(declare-function ws-start "web-server")

其次,是 slot 问题,我以为也要像函数一样必须声明一个原型,看了邮件列表的才知道,所有的 slot 都记录在 eieio–known-slot-names (无力吐槽😅),所以只要往里填就行了。

如果开一个新的 Emacs 来编译,应该是这样的:

不提前“占坑”就会出现警告(当然,如果是直接在当前 Emacs 且已经加载了 web-server 的情况下编译会有所不同)

为什么要有这个呢?跟类同名的不就是构造函数吗?

(defclass rect ()
  ((width  :initarg :width)
   (height :initarg :height)))

(rect :width 3 :height 4)
;; => #s(rect 3 4)

(make-instance 'rect :width 3 :height 4)
;; => #s(rect 3 4)

(funcall 'rect :width 3 :height 4)
;; => #s(rect 3 4)

呢,我把代码移动到文件的时候,把 (require 'web-server) 拿出来了,之后才编译的。

才意识到 :accessor process 定义了一个全局函数,没有 package prefix,要坑人,哪天突然发现 C-h f 多了 active index context process 出来。

这个是正解

这个会报错

;; -*- lexical-binding: t; -*-x

(require 'eieio)

(defclass rectangle ()
  ((width  :initarg :width)
   (height :initarg :height)))

(defvar rectangle-a  (rectangle :width 3 :height 4))

(message "%s" (oref rectangle-a width))
(message "%s" (oref rectangle-a :width))
(message "%s" (oref rectangle-a 'width))
~ $ /Users/xcy/src/emacs-mac/mac/Emacs.app/Contents/MacOS/Emacs -Q --batch -f batch-byte-compile rectangle.el

In toplevel form:
rectangle.el:13:1:Warning: Unknown slot ‘:width’
rectangle.el:15:1:Warning: Unknown slot ‘(quote width)’
~ $ /Users/xcy/src/emacs-mac/mac/Emacs.app/Contents/MacOS/Emacs -Q --batch -l rectangle.el
3
3
Wrong type argument: symbol, (quote width), slot
~ $

因为自动创建和类同名的函数作为构造器是EIEIO的扩展,此外oref和oset也是EIEIO的扩展。他把一般CLOS实现里的概念套过来就偏了。

事实上我觉得自动创建构造器这个功能很烦人,因为我不喜欢用initialize-instance方法,我喜欢单独写一个构造器,他这样占去了我的constructor的名字

如果不对外暴露属性,没必要创建accessor。这个其实就是getXX() setXX()的一个糖。我用EIEIO不用cl-struct就是因为cl-struct默认给所有slot创建accessor,对Elisp这种没有namespace的挺污染眼睛的

因为我习慣把 Emacs Lisp 当 Common Lisp 写了,汗⋯⋯

的确是个问题,看这包也发布好几年了 GitHub - eschulte/emacs-web-server: web server running Emacs Lisp handlers. 竟然没人对此提出异议

1 个赞

作者刚刚已经修复了。