SHARE
TWEET

Untitled

a guest Jun 20th, 2019 54 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. (defvar server)
  2. (progn
  3.   (delete-process server)
  4.   (let ((coding-system-for-read 'binary))
  5.     (setq server
  6.           (make-network-process
  7.            :name "image-server"
  8.            :buffer "*image-server*"
  9.            :family 'ipv4
  10.            :service 9009
  11.            :sentinel 'image-server-sentinel
  12.            :filter 'image-server-filter
  13.            :coding 'binary
  14.            :server 't)))
  15.   )
  16.  
  17. (defun image-server-sentinel (proc msg)
  18.   (let ((buffer-name (concat " *image-server-" (process-name proc) "*")))
  19.     (if (string-match "^open" msg)
  20.         (progn
  21.           (process-put proc 'start-time (current-time))
  22.           (process-put
  23.            proc
  24.            'buffer
  25.            (with-current-buffer (get-buffer-create buffer-name)
  26.              (erase-buffer)
  27.              (toggle-enable-multibyte-characters -1)
  28.              (current-buffer))))
  29.       (progn (message "image-server: receive time: %.0fms"
  30.                       (* 1000 (float-time (time-since (process-get proc 'start-time)))))
  31.              (kill-buffer (get-buffer-create buffer-name))
  32.              (with-current-buffer (get-buffer-create "*image-output*")
  33.                (let ((img (create-image (process-get proc 'payload) 'jpeg t)))
  34.                  (insert-image img)))))))
  35.  
  36. (defun image-server-filter (proc string)
  37.   (with-current-buffer (process-get proc 'buffer)
  38.     (insert string)
  39.     (save-excursion
  40.       (goto-char (point-min))
  41.       (cond
  42.        ((not (process-get proc 'boundary))
  43.         (let ((point (search-forward-regexp "\r\n\r\n" nil t 1)))
  44.           (when point
  45.             (process-put proc 'boundary point)
  46.             (goto-char (point-min))
  47.             (search-forward "Content-Length: " point nil 1)
  48.             (process-put proc
  49.                          'content-length
  50.                          (string-to-number (buffer-substring (point) (line-end-position)))))))
  51.        (t
  52.         (let ((boundary (process-get proc 'boundary))
  53.               (content-length (process-get proc 'content-length)))
  54.           (when (>= (point-max) (+ boundary content-length))
  55.             (process-put proc 'payload
  56.                          (buffer-substring-no-properties boundary content-length))
  57.             (delete-process proc))))))))
  58.  
  59. (provide 'test)
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top