-
Notifications
You must be signed in to change notification settings - Fork 0
/
core-tramp-server.el
109 lines (94 loc) · 3.64 KB
/
core-tramp-server.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
;;; core-tramp-server -- Tramp server
;;; Author: Inge Jørgensen <inge@elektronaut.no>
;;; Commentary:
;;; Licence: MIT
;;; Code:
(require 'dash)
(defvar core-tramp-server-port 9999
"port of the echo server")
(defvar core-tramp-server-clients '()
"alist where KEY is a client process and VALUE is the string")
(defun core-tramp-server-start nil
"starts an emacs echo server"
(interactive)
(unless (process-status "core-tramp-server")
(make-network-process
:name "core-tramp-server"
:host 'local
:buffer "*core-tramp-server*"
:family 'ipv4
:service core-tramp-server-port
:sentinel 'core-tramp-server-sentinel
:filter 'core-tramp-server-filter
:server 't)
(setq core-tramp-server-clients '())
(set-process-query-on-exit-flag (get-process "core-tramp-server") nil)
(core-tramp-server-log
(propertize (concat "Server started, listening on port "
(number-to-string core-tramp-server-port))
'face 'font-lock-builtin-face))))
(defun core-tramp-server-stop nil
"stop an emacs core-tramp server"
(interactive)
(core-tramp-server-log
(propertize "Server shutting down..."
'face 'font-lock-builtin-face))
(while core-tramp-server-clients
(delete-process (car (car core-tramp-server-clients)))
(setq core-tramp-server-clients (cdr core-tramp-server-clients)))
(delete-process "core-tramp-server"))
(defun core-tramp-server-open-file (path)
(find-file path)
(x-focus-frame nil))
(defun core-tramp-server-perform (proc command args)
;;(core-tramp-server-open-file payload)
(core-tramp-server-log command)
(cond ((string-equal command "open")
(mapc (lambda (p) (core-tramp-server-open-file p)) args)
"OK")
((string-equal command "exit")
(delete-process proc))
(t (concat "Unknown command: " command))))
(defun core-tramp-server-filter (proc string)
(let ((pending (assoc proc core-tramp-server-clients))
message
index)
(unless pending
(setq core-tramp-server-clients (cons (cons proc "") core-tramp-server-clients))
(setq pending (assoc proc core-tramp-server-clients)))
(setq message (concat (cdr pending) string))
(while (setq index (string-match "\n" message))
(setq index (1+ index))
(let* ((payload (string-trim (substring message 0 index)))
(command (car (split-string payload " ")))
(args (--> (cdr (split-string payload " "))
(-remove (lambda (s) (string= "" s)) it))))
(core-tramp-server-log payload proc)
(process-send-string
proc
(core-tramp-server-perform proc command args))
)
(setq message (substring message index)))
(setcdr pending message)))
(defun core-tramp-server-sentinel (proc msg)
(when (string= msg "connection broken by remote peer\n")
(setq core-tramp-server-clients (assq-delete-all proc core-tramp-server-clients))
(core-tramp-server-log
(propertize "Client has quit"
'face 'font-lock-doc-face)
proc)))
;;from server.el
(defun core-tramp-server-log (string &optional client)
"If a *core-tramp-server* buffer exists, write STRING to it for logging purposes."
(if (get-buffer "*core-tramp-server*")
(with-current-buffer "*core-tramp-server*"
(goto-char (point-max))
(insert
(propertize (current-time-string) 'face 'font-lock-doc-face)
(propertize (if client (format " %s" client) "") 'face 'font-lock-type-face)
" "
string)
(or (bolp) (newline)))))
(core-tramp-server-start)
(provide 'core-tramp-server)
;;; core-tramp-server ends here