Function: jsonrpc--process-filter

jsonrpc--process-filter is a byte-compiled function defined in jsonrpc.el.gz.

Signature

(jsonrpc--process-filter PROC STRING)

Documentation

Called when new data STRING has arrived for PROC.

Source Code

;; Defined in /usr/src/emacs/lisp/jsonrpc.el.gz
(cl-defun jsonrpc--process-filter (proc string)
  "Called when new data STRING has arrived for PROC."
  (when jsonrpc--in-process-filter
    ;; Problematic recursive process filters may happen if
    ;; `jsonrpc-connection-receive', called by us, eventually calls
    ;; client code which calls `process-send-string' (which see) to,
    ;; say send a follow-up message.  If that happens to writes enough
    ;; bytes for pending output to be received, we will lose JSONRPC
    ;; messages.  In that case, remove recursiveness by re-scheduling
    ;; ourselves to run from within a timer as soon as possible
    ;; (bug#60088)
    (run-at-time 0 nil #'jsonrpc--process-filter proc string)
    (cl-return-from jsonrpc--process-filter))
  (when (buffer-live-p (process-buffer proc))
    (with-current-buffer (process-buffer proc)
      (let* ((conn (process-get proc 'jsonrpc-connection))
             (expected-bytes (jsonrpc--expected-bytes conn)))
        ;; Insert the text, advancing the process marker.
        ;;
        (save-excursion
          (goto-char (process-mark proc))
          (let ((inhibit-read-only t)) (insert string))
          (set-marker (process-mark proc) (point)))
        ;; Loop (more than one message might have arrived)
        ;;
        (unwind-protect
            (let (done)
              (while (not done)
                (cond
                 ((not expected-bytes)
                  ;; Starting a new message
                  ;;
                  (setq expected-bytes
                        (and (search-forward-regexp
                              (rx bol "Content-Length: " (group (+ digit))
                                  "\r\n"
                                  (* (* (not (in ":\n"))) ": "
                                     (* (not (in "\r\n"))) "\r\n")
                                  "\r\n")
                              (+ (point) 100)
                              t)
                             (string-to-number (match-string 1))))
                  (unless expected-bytes
                    (setq done :waiting-for-new-message)))
                 (t
                  ;; Attempt to complete a message body
                  ;;
                  (let ((available-bytes (- (position-bytes (process-mark proc))
                                            (position-bytes (point)))))
                    (cond
                     ((>= available-bytes
                          expected-bytes)
                      (let* ((message-end (byte-to-position
                                           (+ (position-bytes (point))
                                              expected-bytes)))
                             message
                             )
                        (unwind-protect
                            (save-restriction
                              (narrow-to-region (point) message-end)
                              (setq message
                                    (condition-case-unless-debug oops
                                        (jsonrpc--json-read)
                                      (error
                                       (jsonrpc--warn "Invalid JSON: %s %s"
                                                      (cdr oops) (buffer-string))
                                       nil)))
                              (when message
                                (setq message
                                      (plist-put message :jsonrpc-json
                                                 (buffer-string)))
                                ;; Put new messages at the front of the queue,
                                ;; this is correct as the order is reversed
                                ;; before putting the timers on `timer-list'.
                                (push message
                                      (process-get proc 'jsonrpc-mqueue))))
                          (goto-char message-end)
                          (let ((inhibit-read-only t))
                            (delete-region (point-min) (point)))
                          (setq expected-bytes nil))))
                     (t
                      ;; Message is still incomplete
                      ;;
                      (setq done :waiting-for-more-bytes-in-this-message))))))))
          ;; Saved parsing state for next visit to this filter, which
          ;; may well be a recursive one stemming from the tail call
          ;; to `jsonrpc-connection-receive' below (bug#60088).
          ;;
          (setf (jsonrpc--expected-bytes conn) expected-bytes)
          ;; Now, time to notify user code of one or more messages in
          ;; order.  Very often `jsonrpc-connection-receive' will exit
          ;; non-locally (typically the reply to a request), so do
          ;; this all this processing in top-level loops timer.
          (cl-loop
           ;; `timer-activate' orders timers by time, which is an
           ;; very expensive operation when jsonrpc-mqueue is large,
           ;; therefore the time object is reused for each timer
           ;; created.
           with time = (current-time)
           for msg = (pop (process-get proc 'jsonrpc-mqueue)) while msg
           do (let ((timer (timer-create)))
                (timer-set-time timer time)
                (timer-set-function timer
                                    (lambda (conn msg)
                                      (with-temp-buffer
                                        (jsonrpc-connection-receive conn msg)))
                                    (list conn msg))
                (timer-activate timer))))))))