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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
| | ;;; eglot.el --- Client for Language Server Protocol (LSP) servers -*- lexical-binding: t; -*-
;; Copyright (C) 2003-2018 Free Software Foundation, Inc.
;; Version: 0.1
;; Author: João Távora <joaotavora@gmail.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
;; URL: https://github.com/joaotavora/eglot
;; Keywords: convenience, languages
;; Package-Requires: ((emacs "26.1"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; M-x eglot in some file under some .git controlled dir should get
;; you started, but see README.md.
;;; Code:
(require 'json)
(require 'cl-lib)
(require 'project)
(require 'url-parse)
(require 'url-util)
(require 'pcase)
(require 'compile) ; for some faces
(require 'warnings)
(require 'flymake)
(require 'xref)
(require 'subr-x)
\f
;;; User tweakable stuff
(defgroup eglot nil
"Interaction with Language Server Protocol servers"
:prefix "eglot-"
:group 'applications)
(defvar eglot-server-programs '((rust-mode . ("rls"))
(python-mode . ("pyls"))
(js-mode . ("javascript-typescript-stdio"))
(sh-mode . ("bash-language-server" "start")))
"Alist mapping major modes to server executables.")
(defface eglot-mode-line
'((t (:inherit font-lock-constant-face :weight bold)))
"Face for package-name in EGLOT's mode line.")
(defcustom eglot-request-timeout 10
"How many seconds to wait for a reply from the server."
:type :integer)
(defcustom eglot-autoreconnect 3
"Control EGLOT's ability to reconnect automatically.
If t, always reconnect automatically (not recommended). If nil,
never reconnect automatically after unexpected server shutdowns,
crashes or network failures. A positive integer number says to
only autoreconnect if the previous successful connection attempt
lasted more than that many seconds."
:type '(choice (boolean :tag "Whether to inhibit autoreconnection")
(integer :tag "Number of seconds")))
\f
;;; Process management
(defvar eglot--processes-by-project (make-hash-table :test #'equal)
"Keys are projects. Values are lists of processes.")
(defun eglot--current-process ()
"The current logical EGLOT process."
(let* ((cur (project-current))
(processes (and cur (gethash cur eglot--processes-by-project))))
(cl-find major-mode processes :key #'eglot--major-mode)))
(defun eglot--current-process-or-lose ()
"Return the current EGLOT process or error."
(or (eglot--current-process)
(eglot--error "No current EGLOT process%s"
(if (project-current) "" " (Also no current project)"))))
(defmacro eglot--define-process-var
(var-sym initval &optional doc)
"Define VAR-SYM as a generalized process-local variable.
INITVAL is the default value. DOC is the documentation."
(declare (indent 2))
`(progn
(put ',var-sym 'function-documentation ,doc)
(defun ,var-sym (proc)
(let* ((plist (process-plist proc))
(probe (plist-member plist ',var-sym)))
(if probe
(cadr probe)
(let ((def ,initval))
(process-put proc ',var-sym def)
def))))
(gv-define-setter ,var-sym (to-store process)
`(let ((once ,to-store)) (process-put ,process ',',var-sym once) once))))
(eglot--define-process-var eglot--short-name nil
"A short name for the process")
(eglot--define-process-var eglot--major-mode nil
"The major-mode this server is managing.")
(eglot--define-process-var eglot--expected-bytes nil
"How many bytes declared by server")
(eglot--define-process-var eglot--pending-continuations (make-hash-table)
"A hash table of request ID to continuation lambdas")
(eglot--define-process-var eglot--events-buffer nil
"A buffer pretty-printing the EGLOT RPC events")
(eglot--define-process-var eglot--capabilities :unreported
"Holds list of capabilities that server reported")
(eglot--define-process-var eglot--moribund nil
"Non-nil if server is about to exit")
(eglot--define-process-var eglot--project nil
"The project the server belongs to.")
(eglot--define-process-var eglot--spinner `(nil nil t)
"\"Spinner\" used by some servers.
A list (ID WHAT DONE-P).")
(eglot--define-process-var eglot--status `(:unknown nil)
"Status as declared by the server.
A list (WHAT SERIOUS-P).")
(eglot--define-process-var eglot--inhibit-autoreconnect eglot-autoreconnect
"If non-nil, don't autoreconnect on unexpected quit.")
(eglot--define-process-var eglot--contact nil
"Method used to contact a server.
Either a list of strings (a shell command and arguments), or a
list of a single string of the form <host>:<port>")
(eglot--define-process-var eglot--deferred-actions
(make-hash-table :test #'equal)
"Actions deferred to when server is thought to be ready.")
(defun eglot--make-process (name managed-major-mode contact)
"Make a process from CONTACT.
NAME is a name to give the inferior process or connection.
MANAGED-MAJOR-MODE is a symbol naming a major mode.
CONTACT is as `eglot--contact'. Returns a process object."
(let* ((readable-name (format "EGLOT server (%s/%s)" name managed-major-mode))
(buffer (get-buffer-create
(format "*%s inferior*" readable-name)))
singleton
(proc
(if (and (setq singleton (and (null (cdr contact)) (car contact)))
(string-match "^[\s\t]*\\(.*\\):\\([[:digit:]]+\\)[\s\t]*$"
singleton))
(open-network-stream readable-name
buffer
(match-string 1 singleton)
(string-to-number
(match-string 2 singleton)))
(make-process :name readable-name
:buffer buffer
:command contact
:connection-type 'pipe
:stderr (get-buffer-create (format "*%s stderr*"
name))))))
(set-process-filter proc #'eglot--process-filter)
(set-process-sentinel proc #'eglot--process-sentinel)
proc))
(defmacro eglot--obj (&rest what)
"Make WHAT a suitable argument for `json-encode'."
(declare (debug (&rest form)))
;; FIXME: maybe later actually do something, for now this just fixes
;; the indenting of literal plists.
`(list ,@what))
(defun eglot--project-short-name (project)
"Give PROJECT a short name."
(file-name-base (directory-file-name (car (project-roots project)))))
(defun eglot--all-major-modes ()
"Return all know major modes."
(let ((retval))
(mapatoms (lambda (sym)
(when (plist-member (symbol-plist sym) 'derived-mode-parent)
(push sym retval))))
retval))
(defun eglot--client-capabilities ()
"What the EGLOT LSP client supports."
(eglot--obj
:workspace (eglot--obj
:symbol `(:dynamicRegistration :json-false))
:textDocument (eglot--obj
:synchronization (eglot--obj
:dynamicRegistration :json-false
:willSave t
:willSaveWaitUntil :json-false
:didSave t)
:completion `(:dynamicRegistration :json-false)
:hover `(:dynamicRegistration :json-false)
:references `(:dynamicRegistration :json-false)
:definition `(:dynamicRegistration :json-false)
:documentSymbol `(:dynamicRegistration :json-false)
:documentHighlight `(:dynamicRegistration :json-false)
:rename `(:dynamicRegistration :json-false)
:publishDiagnostics `(:relatedInformation :json-false))
:experimental (eglot--obj)))
(defun eglot--connect (project managed-major-mode short-name contact interactive)
"Connect for PROJECT, MANAGED-MAJOR-MODE, SHORT-NAME and CONTACT.
INTERACTIVE is t if inside interactive call."
(let* ((proc (eglot--make-process short-name managed-major-mode contact))
(buffer (process-buffer proc)))
(setf (eglot--contact proc) contact
(eglot--project proc) project
(eglot--major-mode proc) managed-major-mode)
(with-current-buffer buffer
(let ((inhibit-read-only t))
(setf (eglot--inhibit-autoreconnect proc)
(cond
((booleanp eglot-autoreconnect) (not eglot-autoreconnect))
(interactive nil)
((cl-plusp eglot-autoreconnect)
(run-with-timer eglot-autoreconnect nil
(lambda ()
(setf (eglot--inhibit-autoreconnect proc)
(null eglot-autoreconnect)))))))
(setf (eglot--short-name proc) short-name)
(push proc (gethash project eglot--processes-by-project))
(erase-buffer)
(read-only-mode t)
(cl-destructuring-bind (&key capabilities)
(eglot--request
proc
:initialize
(eglot--obj :processId (unless (eq (process-type proc)
'network)
(emacs-pid))
:rootUri (eglot--path-to-uri
(car (project-roots project)))
:initializationOptions []
:capabilities (eglot--client-capabilities)))
(setf (eglot--capabilities proc) capabilities)
(setf (eglot--status proc) nil)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(eglot--maybe-activate-editing-mode proc)))
(eglot--notify proc :initialized (eglot--obj :__dummy__ t))
proc)))))
(defvar eglot--command-history nil
"History of COMMAND arguments to `eglot'.")
(defun eglot--interactive ()
"Helper for `eglot'."
(let* ((guessed-mode (if buffer-file-name major-mode))
(managed-mode
(cond
((or (>= (prefix-numeric-value current-prefix-arg) 16)
(not guessed-mode))
(intern
(completing-read
"[eglot] Start a server to manage buffers of what major mode? "
(mapcar #'symbol-name (eglot--all-major-modes)) nil t
(symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
(t guessed-mode)))
(guessed-command (cdr (assoc managed-mode eglot-server-programs)))
(base-prompt "[eglot] Enter program to execute (or <host>:<port>): ")
(prompt
(cond (current-prefix-arg base-prompt)
((null guessed-command)
(concat (format "[eglot] Sorry, couldn't guess for `%s'!"
managed-mode)
"\n" base-prompt))
((and (listp guessed-command)
(not (executable-find (car guessed-command))))
(concat (format "[eglot] I guess you want to run `%s'"
(combine-and-quote-strings guessed-command))
(format ", but I can't find `%s' in PATH!"
(car guessed-command))
"\n" base-prompt)))))
(list
managed-mode
(if prompt
(split-string-and-unquote
(read-shell-command prompt
(if (listp guessed-command)
(combine-and-quote-strings guessed-command))
'eglot-command-history))
guessed-command)
t)))
;;;###autoload
(defun eglot (managed-major-mode command &optional interactive)
"Start a Language Server Protocol server.
Server is started with COMMAND and manages buffers of
MANAGED-MAJOR-MODE for the current project.
COMMAND is a list of strings, an executable program and
optionally its arguments. If the first and only string in the
list is of the form \"<host>:<port>\" it is taken as an
indication to connect to a server instead of starting one. This
is also know as the server's \"contact\".
MANAGED-MAJOR-MODE is an Emacs major mode.
Interactively, guess MANAGED-MAJOR-MODE from current buffer and
COMMAND from `eglot-server-programs'. With a single
\\[universal-argument] prefix arg, prompt for COMMAND. With two
\\[universal-argument] prefix args, also prompt for
MANAGED-MAJOR-MODE.
INTERACTIVE is t if called interactively."
(interactive (eglot--interactive))
(let* ((project (project-current))
(short-name (eglot--project-short-name project)))
(unless project (eglot--error "Cannot work without a current project!"))
(unless command (eglot--error "Don't know how to start EGLOT for %s buffers"
major-mode))
(let ((current-process (eglot--current-process)))
(if (and (process-live-p current-process)
interactive
(y-or-n-p "[eglot] Live process found, reconnect instead? "))
(eglot-reconnect current-process interactive)
(when (process-live-p current-process)
(eglot-shutdown current-process))
(let ((proc (eglot--connect project
managed-major-mode
short-name
command
interactive)))
(eglot--message "Connected! Process `%s' now \
managing `%s' buffers in project `%s'."
proc managed-major-mode short-name))))))
(defun eglot-reconnect (process &optional interactive)
"Reconnect to PROCESS.
INTERACTIVE is t if called interactively."
(interactive (list (eglot--current-process-or-lose) t))
(when (process-live-p process)
(eglot-shutdown process interactive))
(eglot--connect (eglot--project process)
(eglot--major-mode process)
(eglot--short-name process)
(eglot--contact process)
interactive)
(eglot--message "Reconnected!"))
(defun eglot--process-sentinel (proc change)
"Called when PROC undergoes CHANGE."
(eglot--log-event proc `(:message "Process state changed" :change ,change))
(when (not (process-live-p proc))
(with-current-buffer (eglot-events-buffer proc)
(let ((inhibit-read-only t))
(insert "\n----------b---y---e---b---y---e----------\n")))
;; Cancel outstanding timers
(maphash (lambda (_id triplet)
(cl-destructuring-bind (_success _error timeout) triplet
(cancel-timer timeout)))
(eglot--pending-continuations proc))
(unwind-protect
;; Call all outstanding error handlers
(maphash (lambda (_id triplet)
(cl-destructuring-bind (_success error _timeout) triplet
(funcall error :code -1 :message (format "Server died"))))
(eglot--pending-continuations proc))
;; Turn off `eglot--managed-mode' where appropriate.
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (eglot--buffer-managed-p proc)
(eglot--managed-mode -1))))
;; Forget about the process-project relationship
(setf (gethash (eglot--project proc) eglot--processes-by-project)
(delq proc
(gethash (eglot--project proc) eglot--processes-by-project)))
(eglot--message "Server exited with status %s" (process-exit-status proc))
(cond ((eglot--moribund proc))
((not (eglot--inhibit-autoreconnect proc))
(eglot--warn "Reconnecting unexpected server exit.")
(eglot-reconnect proc))
(t
(eglot--warn "Not auto-reconnecting, last one didn't last long.")))
(delete-process proc))))
(defun eglot--process-filter (proc string)
"Called when new data STRING has arrived for PROC."
(when (buffer-live-p (process-buffer proc))
(with-current-buffer (process-buffer proc)
(let ((inhibit-read-only t)
(expected-bytes (eglot--expected-bytes proc))
(done (make-symbol "eglot--process-filter-done-tag")))
;; Insert the text, advancing the process marker.
;;
(save-excursion
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point)))
;; Loop (more than one message might have arrived)
;;
(unwind-protect
(catch done
(while t
(cond
((not expected-bytes)
;; Starting a new message
;;
(setq expected-bytes
(and (search-forward-regexp
"\\(?:.*: .*\r\n\\)*Content-Length: \
*\\([[:digit:]]+\\)\r\n\\(?:.*: .*\r\n\\)*\r\n"
(+ (point) 100)
t)
(string-to-number (match-string 1))))
(unless expected-bytes
(throw 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))))
(unwind-protect
(save-restriction
(narrow-to-region (point) message-end)
(let* ((json-object-type 'plist)
(json-message (json-read)))
;; Process content in another buffer,
;; shielding buffer from tamper
;;
(with-temp-buffer
(eglot--process-receive proc json-message))))
(goto-char message-end)
(delete-region (point-min) (point))
(setq expected-bytes nil))))
(t
;; Message is still incomplete
;;
(throw done :waiting-for-more-bytes-in-this-message))))))))
;; Saved parsing state for next visit to this filter
;;
(setf (eglot--expected-bytes proc) expected-bytes))))))
(defun eglot-events-buffer (process &optional interactive)
"Display events buffer for current LSP connection PROCESS.
INTERACTIVE is t if called interactively."
(interactive (list (eglot--current-process-or-lose) t))
(let* ((probe (eglot--events-buffer process))
(buffer (or (and (buffer-live-p probe)
probe)
(let ((buffer (get-buffer-create
(format "*%s events*"
(process-name process)))))
(with-current-buffer buffer
(buffer-disable-undo)
(read-only-mode t)
(setf (eglot--events-buffer process) buffer))
buffer))))
(when interactive (display-buffer buffer))
buffer))
(defun eglot--log-event (proc message &optional type)
"Log an eglot-related event.
PROC is the current process. MESSAGE is a JSON-like plist. TYPE
is a symbol saying if this is a client or server originated."
(with-current-buffer (eglot-events-buffer proc)
(cl-destructuring-bind (&key method id error &allow-other-keys) message
(let* ((inhibit-read-only t)
(subtype (cond ((and method id) 'request)
(method 'notification)
(id 'reply)
(t 'message)))
(type
(format "%s-%s" (or type :internal) subtype)))
(goto-char (point-max))
(let ((msg (format "%s%s%s:\n%s\n"
type
(if id (format " (id:%s)" id) "")
(if error " ERROR" "")
(pp-to-string message))))
(when error
(setq msg (propertize msg 'face 'error)))
(insert-before-markers msg))))))
(defun eglot--process-receive (proc message)
"Process MESSAGE from PROC."
(cl-destructuring-bind (&key method id error &allow-other-keys) message
(let* ((continuations (and id
(not method)
(gethash id (eglot--pending-continuations proc)))))
(eglot--log-event proc message 'server)
(when error (setf (eglot--status proc) `(,error t)))
(cond (method
;; a server notification or a server request
(let* ((handler-sym (intern (concat "eglot--server-" method))))
(if (functionp handler-sym)
(apply handler-sym proc (append
(plist-get message :params)
(if id `(:id ,id))))
(eglot--warn "No implementation of method %s yet" method)
(when id
(eglot--reply
proc id
:error (eglot--obj :code -32601
:message "Method unimplemented"))))))
(continuations
(cancel-timer (cl-third continuations))
(remhash id (eglot--pending-continuations proc))
(if error
(apply (cl-second continuations) error)
(let ((res (plist-get message :result)))
(if (listp res)
(apply (cl-first continuations) res)
(funcall (cl-first continuations) res)))))
(id
(eglot--warn "Ooops no continuation for id %s" id)))
(eglot--call-deferred proc)
(force-mode-line-update t))))
(defvar eglot--expect-carriage-return nil)
(defun eglot--process-send (proc message)
"Send MESSAGE to PROC (ID is optional)."
(let ((json (json-encode message)))
(process-send-string proc (format "Content-Length: %d\r\n\r\n%s"
(string-bytes json)
json))
(eglot--log-event proc message 'client)))
(defvar eglot--next-request-id 0)
(defun eglot--next-request-id ()
"Compute the next id for a client request."
(setq eglot--next-request-id (1+ eglot--next-request-id)))
(defun eglot-forget-pending-continuations (process)
"Stop waiting for responses from the current LSP PROCESS."
(interactive (list (eglot--current-process-or-lose)))
(clrhash (eglot--pending-continuations process)))
(defun eglot-clear-status (process)
"Clear most recent error message from PROCESS."
(interactive (list (eglot--current-process-or-lose)))
(setf (eglot--status process) nil))
(defun eglot--call-deferred (proc)
"Call PROC's deferred actions, who may again defer themselves."
(when-let ((actions (hash-table-values (eglot--deferred-actions proc))))
(eglot--log-event proc `(:running-deferred ,(length actions)))
(mapc #'funcall (mapcar #'car actions))))
(defvar eglot--ready-predicates '(eglot--server-ready-p)
"Special hook of predicates controlling deferred actions.
If one of these returns nil, a deferrable `eglot--async-request'
will be deferred. Each predicate is passed the symbol for the
request request and a process object.")
(defun eglot--server-ready-p (_what _proc)
"Tell if server of PROC ready for processing deferred WHAT."
(not (eglot--outstanding-edits-p)))
(cl-defmacro eglot--lambda (cl-lambda-list &body body)
(declare (indent 1) (debug (sexp &rest form)))
`(cl-function (lambda ,cl-lambda-list ,@body)))
(cl-defun eglot--async-request (proc
method
params
&rest args
&key success-fn error-fn timeout-fn
(timeout eglot-request-timeout)
(deferred nil))
"Make a request to PROCESS, expecting a reply.
Return the ID of this request. Wait TIMEOUT seconds for response.
If DEFERRED, maybe defer request to the future, or never at all,
in case a new request with identical DEFERRED and for the same
buffer overrides it. However, if that happens, the original
timeout keeps counting."
(let* ((id (eglot--next-request-id))
(existing-timer nil)
(make-timeout
(lambda ( )
(or existing-timer
(run-with-timer
timeout nil
(lambda ()
(remhash id (eglot--pending-continuations proc))
(funcall (or timeout-fn
(lambda ()
(eglot--error
"Tired of waiting for reply to %s, id=%s"
method id))))))))))
(when deferred
(let* ((buf (current-buffer))
(existing (gethash (list deferred buf) (eglot--deferred-actions proc))))
(when existing (setq existing-timer (cadr existing)))
(if (run-hook-with-args-until-failure 'eglot--ready-predicates
deferred proc)
(remhash (list deferred buf) (eglot--deferred-actions proc))
(eglot--log-event proc `(:deferring ,method :id ,id :params ,params))
(let* ((buf (current-buffer)) (point (point))
(later (lambda ()
(when (buffer-live-p buf)
(with-current-buffer buf
(save-excursion (goto-char point)
(apply #'eglot--async-request proc
method params args)))))))
(puthash (list deferred buf) (list later (funcall make-timeout))
(eglot--deferred-actions proc))
(cl-return-from eglot--async-request nil)))))
;; Really run it
;;
(puthash id
(list (or success-fn
(eglot--lambda (&rest _ignored)
(eglot--log-event
proc (eglot--obj :message "success ignored" :id id))))
(or error-fn
(eglot--lambda (&key code message &allow-other-keys)
(setf (eglot--status proc) `(,message t))
proc (eglot--obj :message "error ignored, status set"
:id id :error code)))
(funcall make-timeout))
(eglot--pending-continuations proc))
(eglot--process-send proc (eglot--obj :jsonrpc "2.0"
:id id
:method method
:params params))))
(defun eglot--request (proc method params &optional deferred)
"Like `eglot--async-request' for PROC, METHOD and PARAMS, but synchronous.
Meaning only return locally if successful, otherwise exit non-locally.
DEFERRED is passed to `eglot--async-request', which see."
;; Launching a deferred sync request with outstanding changes is a
;; bad idea, since that might lead to the request never having a
;; chance to run, because `eglot--ready-predicates'.
(when deferred (eglot--signal-textDocument/didChange))
(let (retval)
(eglot--async-request
proc method params
:success-fn (lambda (&rest args)
(setq retval `(done ,(if (vectorp (car args))
(car args) args))))
:error-fn (eglot--lambda (&key code message &allow-other-keys)
(setq retval `(error ,(format "Oops: %s: %s" code message))))
:timeout-fn (lambda ()
(setq retval '(error "Timed out")))
:deferred deferred)
(while (not retval) (accept-process-output nil 30))
(when (eq 'error (car retval)) (eglot--error (cadr retval)))
(cadr retval)))
(cl-defun eglot--notify (process method params)
"Notify PROCESS of something, don't expect a reply.e"
(eglot--process-send process (eglot--obj :jsonrpc "2.0"
:method method
:params params)))
(cl-defun eglot--reply (process id &key result error)
"Reply to PROCESS's request ID with MESSAGE."
(eglot--process-send
process `(:jsonrpc "2.0" :id ,id
,@(when result `(:result ,result))
,@(when error `(:error ,error)))))
\f
;;; Helpers
;;;
(defun eglot--error (format &rest args)
"Error out with FORMAT with ARGS."
(error (apply #'format format args)))
(defun eglot--message (format &rest args)
"Message out with FORMAT with ARGS."
(message (concat "[eglot] " (apply #'format format args))))
(defun eglot--warn (format &rest args)
"Warning message with FORMAT and ARGS."
(apply #'eglot--message (concat "(warning) " format) args)
(let ((warning-minimum-level :error))
(display-warning 'eglot
(apply #'format format args)
:warning)))
(defun eglot--pos-to-lsp-position (&optional pos)
"Convert point POS to LSP position."
(save-excursion
(eglot--obj :line
;; F!@(#*&#$)CKING OFF-BY-ONE
(1- (line-number-at-pos pos t))
:character
(- (goto-char (or pos (point)))
(line-beginning-position)))))
(defun eglot--lsp-position-to-point (pos-plist)
"Convert LSP position POS-PLIST to Emacs point."
(save-excursion (goto-char (point-min))
(forward-line (plist-get pos-plist :line))
(forward-char
(min (plist-get pos-plist :character)
(- (line-end-position)
(line-beginning-position))))
(point)))
(defun eglot--mapply (fun seq)
"Apply FUN to every element of SEQ."
(mapcar (lambda (e) (apply fun e)) seq))
(defun eglot--path-to-uri (path)
"Urify PATH."
(url-hexify-string (concat "file://" (file-truename path))
url-path-allowed-chars))
(defun eglot--uri-to-path (uri)
"Convert URI to a file path."
(when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
(url-filename (url-generic-parse-url (url-unhex-string uri))))
(defconst eglot--kind-names
`((1 . "Text") (2 . "Method") (3 . "Function") (4 . "Constructor")
(5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface")
(9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value")
(13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color")
(17 . "File") (18 . "Reference")))
(defun eglot--format-markup (markup)
"Format MARKUP according to LSP's spec."
(cond ((stringp markup)
(with-temp-buffer
(ignore-errors (funcall (intern "markdown-mode"))) ;escape bytecomp
(font-lock-ensure)
(insert markup)
(string-trim (buffer-string))))
(t
(with-temp-buffer
(ignore-errors (funcall (intern (concat
(plist-get markup :language)
"-mode" ))))
(insert (plist-get markup :value))
(font-lock-ensure)
(buffer-string)))))
(defun eglot--server-capable (feat)
"Determine if current server is capable of FEAT."
(plist-get (eglot--capabilities (eglot--current-process-or-lose)) feat))
(cl-defmacro eglot--with-lsp-range ((start end) range &body body
&aux (range-sym (cl-gensym)))
"Bind LSP RANGE to START and END. Evaluate BODY."
(declare (indent 2) (debug (sexp sexp &rest form)))
`(let* ((,range-sym ,range)
(,start (eglot--lsp-position-to-point (plist-get ,range-sym :start)))
(,end (eglot--lsp-position-to-point (plist-get ,range-sym :end))))
,@body))
\f
;;; Minor modes
;;;
(defvar eglot-mode-map (make-sparse-keymap))
(define-minor-mode eglot--managed-mode
"Mode for source buffers managed by some EGLOT project."
nil nil eglot-mode-map
(cond
(eglot--managed-mode
(add-hook 'after-change-functions 'eglot--after-change nil t)
(add-hook 'before-change-functions 'eglot--before-change nil t)
(add-hook 'flymake-diagnostic-functions 'eglot-flymake-backend nil t)
(add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t)
(add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t)
(add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t)
(add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t)
(add-hook 'xref-backend-functions 'eglot-xref-backend nil t)
(add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t)
(add-function :before-until (local 'eldoc-documentation-function)
#'eglot-eldoc-function)
(add-function :around (local imenu-create-index-function) #'eglot-imenu))
(t
(remove-hook 'flymake-diagnostic-functions 'eglot-flymake-backend t)
(remove-hook 'after-change-functions 'eglot--after-change t)
(remove-hook 'before-change-functions 'eglot--before-change t)
(remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t)
(remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t)
(remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t)
(remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t)
(remove-hook 'xref-backend-functions 'eglot-xref-backend t)
(remove-hook 'completion-at-point-functions #'eglot-completion-at-point t)
(remove-function (local 'eldoc-documentation-function)
#'eglot-eldoc-function)
(remove-function (local imenu-create-index-function) #'eglot-imenu)
(let ((proc (eglot--current-process)))
(when (and (process-live-p proc) (y-or-n-p "[eglot] Kill server too? "))
(eglot-shutdown proc t))))))
(add-hook 'eglot--managed-mode-hook 'flymake-mode)
(add-hook 'eglot--managed-mode-hook 'eldoc-mode)
(defun eglot--buffer-managed-p (&optional proc)
"Tell if current buffer is managed by PROC."
(and buffer-file-name (let ((cur (eglot--current-process)))
(or (and (null proc) cur)
(and proc (eq proc cur))))))
(defvar-local eglot--current-flymake-report-fn nil
"Current flymake report function for this buffer")
(defun eglot--maybe-activate-editing-mode (&optional proc)
"Maybe activate mode function `eglot--managed-mode'.
If PROC is supplied, do it only if BUFFER is managed by it. In
that case, also signal textDocument/didOpen."
;; Called even when revert-buffer-in-progress-p
(when (eglot--buffer-managed-p proc)
(eglot--managed-mode 1)
(eglot--signal-textDocument/didOpen)
(flymake-start)
(funcall (or eglot--current-flymake-report-fn #'ignore) nil)))
(add-hook 'find-file-hook 'eglot--maybe-activate-editing-mode)
\f
;;; Mode-line, menu and other sugar
;;;
(defvar eglot-menu)
(easy-menu-define eglot-menu eglot-mode-map "EGLOT" `("EGLOT" ))
(defvar eglot--mode-line-format `(:eval (eglot--mode-line-format)))
(put 'eglot--mode-line-format 'risky-local-variable t)
(defun eglot--mode-line-call (what)
"Make an interactive lambda for calling WHAT from mode-line."
(lambda (event)
(interactive "e")
(with-selected-window (posn-window (event-start event))
(call-interactively what))))
(defun eglot--mode-line-props (thing face defs &optional prepend)
"Helper for function `eglot--mode-line-format'.
Uses THING, FACE, DEFS and PREPEND."
(cl-loop with map = (make-sparse-keymap)
for (elem . rest) on defs
for (key def help) = elem
do (define-key map `[mode-line ,key] (eglot--mode-line-call def))
concat (format "%s: %s" key help) into blurb
when rest concat "\n" into blurb
finally (return `(:propertize ,thing
face ,face
keymap ,map help-echo ,(concat prepend blurb)
mouse-face mode-line-highlight))))
(defun eglot--mode-line-format ()
"Compose the EGLOT's mode-line."
(pcase-let* ((proc (eglot--current-process))
(name (and (process-live-p proc) (eglot--short-name proc)))
(pending (and proc (hash-table-count
(eglot--pending-continuations proc))))
(`(,_id ,doing ,done-p ,detail) (and proc (eglot--spinner proc)))
(`(,status ,serious-p) (and proc (eglot--status proc))))
(append
`(,(eglot--mode-line-props "eglot" 'eglot-mode-line
'((down-mouse-1 eglot-menu "pop up EGLOT menu"))))
(when name
`(":" ,(eglot--mode-line-props
name 'eglot-mode-line
'((mouse-1 eglot-events-buffer "go to events buffer")
(mouse-2 eglot-shutdown "quit server")
(mouse-3 eglot-reconnect "reconnect to server")))
,@(when serious-p
`("/" ,(eglot--mode-line-props
"error" 'compilation-mode-line-fail
'((mouse-1 eglot-events-buffer "go to events buffer")
(mouse-3 eglot-clear-status "clear this status"))
(format "An error occured: %s\n" status))))
,@(when (and doing (not done-p))
`("/" ,(eglot--mode-line-props
(format "%s%s" doing
(if detail (format ":%s" detail) ""))
'compilation-mode-line-run
'((mouse-1 eglot-events-buffer "go to events buffer")))))
,@(when (cl-plusp pending)
`("/" ,(eglot--mode-line-props
(format "%d" pending) 'warning
'((mouse-1 eglot-events-buffer "go to events buffer")
(mouse-3 eglot-clear-status "clear this status"))
(format "%d pending requests\n" pending)))))))))
(add-to-list 'mode-line-misc-info
`(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
\f
;;; Protocol implementation (Requests, notifications, etc)
;;;
(defun eglot-shutdown (proc &optional interactive)
"Politely ask the server PROC to quit.
Forcefully quit it if it doesn't respond. Don't leave this
function with the server still running. INTERACTIVE is t if
called interactively."
(interactive (list (eglot--current-process-or-lose) t))
(when interactive (eglot--message "Asking %s politely to terminate" proc))
(unwind-protect
(let ((eglot-request-timeout 3))
(setf (eglot--moribund proc) t)
(eglot--request proc
:shutdown
nil)
;; this one should always fail
(ignore-errors (eglot--request proc :exit nil)))
(when (process-live-p proc)
(eglot--warn "Brutally deleting existing process %s" proc)
(delete-process proc))))
(cl-defun eglot--server-window/showMessage (_process &key type message)
"Handle notification window/showMessage"
(eglot--message (propertize "Server reports (type=%s): %s"
'face (if (<= type 1) 'error))
type message))
(cl-defun eglot--server-window/showMessageRequest
(process &key id type message actions)
"Handle server request window/showMessageRequest"
(let (reply)
(unwind-protect
(setq reply
(completing-read
(concat
(format (propertize "[eglot] Server reports (type=%s): %s"
'face (if (<= type 1) 'error))
type message)
"\nChoose an option: ")
(or (mapcar (lambda (obj) (plist-get obj :title)) actions)
'("OK"))
nil t (plist-get (elt actions 0) :title)))
(if reply
(eglot--reply process id :result (eglot--obj :title reply))
(eglot--reply process id
:error (eglot--obj :code -32800
:message "User cancelled"))))))
(cl-defun eglot--server-window/logMessage (_proc &key _type _message)
"Handle notification window/logMessage") ;; noop, use events buffer
(cl-defun eglot--server-telemetry/event (_proc &rest _any)
"Handle notification telemetry/event") ;; noop, use events buffer
(defvar-local eglot--unreported-diagnostics nil
"Unreported diagnostics for this buffer.")
(cl-defun eglot--server-textDocument/publishDiagnostics
(_process &key uri diagnostics)
"Handle notification publishDiagnostics"
(let* ((obj (url-generic-parse-url uri))
(filename (car (url-path-and-query obj)))
(buffer (find-buffer-visiting filename)))
(cond
(buffer
(with-current-buffer buffer
(cl-loop
for diag-spec across diagnostics
collect (cl-destructuring-bind (&key range severity _group
_code source message)
diag-spec
(eglot--with-lsp-range (beg end) range
(flymake-make-diagnostic (current-buffer)
beg end
(cond ((<= severity 1) :error)
((= severity 2) :warning)
(t :note))
(concat source ": " message))))
into diags
finally (cond (eglot--current-flymake-report-fn
(funcall eglot--current-flymake-report-fn diags)
(setq eglot--unreported-diagnostics nil))
(t
(setq eglot--unreported-diagnostics diags))))))
(t
(eglot--message "OK so %s isn't visited" filename)))))
(cl-defun eglot--server-client/registerCapability
(proc &key id registrations)
"Handle notification client/registerCapability"
(let ((jsonrpc-id id)
(done (make-symbol "done")))
(catch done
(mapc
(lambda (reg)
(apply
(cl-function
(lambda (&key id method registerOptions)
(pcase-let*
((handler-sym (intern (concat "eglot--register-"
method)))
(`(,ok ,message)
(and (functionp handler-sym)
(apply handler-sym proc :id id registerOptions))))
(unless ok
(throw done
(eglot--reply proc jsonrpc-id
:error (eglot--obj
:code -32601
:message (or message "sorry :-("))))))))
reg))
registrations)
(eglot--reply proc id :result (eglot--obj :message "OK")))))
(cl-defun eglot--server-workspace/applyEdit
(proc &key id _label edit)
"Handle notification client/registerCapability"
(condition-case err
(progn
(eglot--apply-workspace-edit edit 'confirm)
(eglot--reply proc id :result `(:applied )))
(error
(eglot--reply proc id
:result `(:applied :json-false)
:error
(eglot--obj :code -32001
:message (format "%s" err))))))
(defun eglot--TextDocumentIdentifier ()
"Compute TextDocumentIdentifier object for current buffer."
(eglot--obj :uri (eglot--path-to-uri buffer-file-name)))
(defvar-local eglot--versioned-identifier 0)
(defun eglot--VersionedTextDocumentIdentifier ()
"Compute VersionedTextDocumentIdentifier object for current buffer."
(append (eglot--TextDocumentIdentifier)
(eglot--obj :version eglot--versioned-identifier)))
(defun eglot--TextDocumentItem ()
"Compute TextDocumentItem object for current buffer."
(append
(eglot--VersionedTextDocumentIdentifier)
(eglot--obj :languageId
(if (string-match "\\(.*\\)-mode" (symbol-name major-mode))
(match-string 1 (symbol-name major-mode))
"unknown")
:text
(save-restriction
(widen)
(buffer-substring-no-properties (point-min) (point-max))))))
(defun eglot--TextDocumentPositionParams ()
"Compute TextDocumentPositionParams."
(eglot--obj :textDocument (eglot--TextDocumentIdentifier)
:position (eglot--pos-to-lsp-position)))
(defvar-local eglot--recent-changes nil
"Recent buffer changes as collected by `eglot--before-change'.")
(defun eglot--outstanding-edits-p ()
"Non-nil if there are outstanding edits."
(cl-plusp (+ (length (car eglot--recent-changes))
(length (cdr eglot--recent-changes)))))
(defun eglot--before-change (start end)
"Hook onto `before-change-functions'.
Records START and END, crucially convert them into
LSP (line/char) positions before that information is
lost (because the after-change thingy doesn't know if newlines
were deleted/added)"
(setf (car eglot--recent-changes)
(vconcat (car eglot--recent-changes)
`[(,(eglot--pos-to-lsp-position start)
,(eglot--pos-to-lsp-position end))])))
(defun eglot--after-change (start end pre-change-length)
"Hook onto `after-change-functions'.
Records START, END and PRE-CHANGE-LENGTH locally."
(cl-incf eglot--versioned-identifier)
(setf (cdr eglot--recent-changes)
(vconcat (cdr eglot--recent-changes)
`[(,pre-change-length
,(buffer-substring-no-properties start end))])))
(defun eglot--signal-textDocument/didChange ()
"Send textDocument/didChange to server."
(when (eglot--outstanding-edits-p)
(let* ((proc (eglot--current-process-or-lose))
(sync-kind (eglot--server-capable :textDocumentSync))
(emacs-messup (/= (length (car eglot--recent-changes))
(length (cdr eglot--recent-changes))))
(full-sync-p (or (eq sync-kind 1) emacs-messup)))
(when emacs-messup
(eglot--warn "`eglot--recent-changes' messup: %s" eglot--recent-changes))
(save-restriction
(widen)
(eglot--notify
proc :textDocument/didChange
(eglot--obj
:textDocument
(eglot--VersionedTextDocumentIdentifier)
:contentChanges
(if full-sync-p (vector
(eglot--obj
:text (buffer-substring-no-properties (point-min)
(point-max))))
(cl-loop for (start-pos end-pos) across (car eglot--recent-changes)
for (len after-text) across (cdr eglot--recent-changes)
vconcat `[,(eglot--obj :range (eglot--obj :start start-pos
:end end-pos)
:rangeLength len
:text after-text)])))))
(setq eglot--recent-changes (cons [] []))
(setf (eglot--spinner proc) (list nil :textDocument/didChange t))
(eglot--call-deferred proc))))
(defun eglot--signal-textDocument/didOpen ()
"Send textDocument/didOpen to server."
(setq eglot--recent-changes (cons [] []))
(eglot--notify (eglot--current-process-or-lose)
:textDocument/didOpen
(eglot--obj :textDocument
(eglot--TextDocumentItem))))
(defun eglot--signal-textDocument/didClose ()
"Send textDocument/didClose to server."
(eglot--notify (eglot--current-process-or-lose)
:textDocument/didClose
(eglot--obj :textDocument
(eglot--TextDocumentIdentifier))))
(defun eglot--signal-textDocument/willSave ()
"Send textDocument/willSave to server."
(eglot--notify
(eglot--current-process-or-lose)
:textDocument/willSave
(eglot--obj
:reason 1 ; Manual, emacs laughs in the face of auto-save muahahahaha
:textDocument (eglot--TextDocumentIdentifier))))
(defun eglot--signal-textDocument/didSave ()
"Send textDocument/didSave to server."
(eglot--notify
(eglot--current-process-or-lose)
:textDocument/didSave
(eglot--obj
;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
:text (buffer-substring-no-properties (point-min) (point-max))
:textDocument (eglot--TextDocumentIdentifier))))
(defun eglot-flymake-backend (report-fn &rest _more)
"An EGLOT Flymake backend.
Calls REPORT-FN maybe if server publishes diagnostics in time."
(setq eglot--current-flymake-report-fn report-fn)
;; Report anything unreported
(when eglot--unreported-diagnostics
(funcall report-fn eglot--unreported-diagnostics)
(setq eglot--unreported-diagnostics nil))
;; Signal a didChange that might eventually bring new diagnotics
(eglot--signal-textDocument/didChange))
(defun eglot-xref-backend ()
"EGLOT xref backend."
(when (eglot--server-capable :definitionProvider) 'eglot))
(defvar eglot--xref-known-symbols nil)
(defun eglot--xref-reset-known-symbols (&rest _dummy)
"Reset `eglot--xref-reset-known-symbols'.
DUMMY is ignored"
(setq eglot--xref-known-symbols nil))
(advice-add 'xref-find-definitions :after #'eglot--xref-reset-known-symbols)
(advice-add 'xref-find-references :after #'eglot--xref-reset-known-symbols)
(defun eglot--xref-make (name uri position)
"Like `xref-make' but with LSP's NAME, URI and POSITION."
(cl-destructuring-bind (&key line character) position
(xref-make name (xref-make-file-location
(eglot--uri-to-path uri)
;; F!@(#*&#$)CKING OFF-BY-ONE again
(1+ line) character))))
(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
(when (eglot--server-capable :documentSymbolProvider)
(let ((proc (eglot--current-process-or-lose))
(text-id (eglot--TextDocumentIdentifier)))
(completion-table-with-cache
(lambda (string)
(setq eglot--xref-known-symbols
(eglot--mapply
(eglot--lambda (&key name kind location containerName)
(propertize name
:textDocumentPositionParams
(eglot--obj :textDocument text-id
:position (plist-get
(plist-get location :range)
:start))
:locations (list location)
:kind kind
:containerName containerName))
(eglot--request proc
:textDocument/documentSymbol
(eglot--obj
:textDocument text-id))))
(all-completions string eglot--xref-known-symbols))))))
(cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
(when-let ((symatpt (symbol-at-point)))
(propertize (symbol-name symatpt)
:textDocumentPositionParams
(eglot--TextDocumentPositionParams))))
(cl-defmethod xref-backend-definitions ((_backend (eql eglot)) identifier)
(let* ((rich-identifier
(car (member identifier eglot--xref-known-symbols)))
(location-or-locations
(if rich-identifier
(get-text-property 0 :locations rich-identifier)
(eglot--request (eglot--current-process-or-lose)
:textDocument/definition
(get-text-property
0 :textDocumentPositionParams identifier)))))
(eglot--mapply
(eglot--lambda (&key uri range)
(eglot--xref-make identifier uri (plist-get range :start)))
location-or-locations)))
(cl-defmethod xref-backend-references ((_backend (eql eglot)) identifier)
(unless (eglot--server-capable :referencesProvider)
(cl-return-from xref-backend-references nil))
(let ((params
(or (get-text-property 0 :textDocumentPositionParams identifier)
(let ((rich (car (member identifier eglot--xref-known-symbols))))
(and rich (get-text-property 0 :textDocumentPositionParams rich))))))
(unless params
(eglot--error "Don' know where %s is in the workspace!" identifier))
(eglot--mapply
(eglot--lambda (&key uri range)
(eglot--xref-make identifier uri (plist-get range :start)))
(eglot--request (eglot--current-process-or-lose)
:textDocument/references
(append
params
(eglot--obj :context
(eglot--obj :includeDeclaration t)))))))
(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
(when (eglot--server-capable :workspaceSymbolProvider)
(eglot--mapply
(eglot--lambda (&key name location &allow-other-keys)
(cl-destructuring-bind (&key uri range) location
(eglot--xref-make name uri (plist-get range :start))))
(eglot--request (eglot--current-process-or-lose)
:workspace/symbol
(eglot--obj :query pattern)))))
(defun eglot-completion-at-point ()
"EGLOT's `completion-at-point' function."
(let ((bounds (bounds-of-thing-at-point 'symbol))
(proc (eglot--current-process-or-lose)))
(when (eglot--server-capable :completionProvider)
(list
(or (car bounds) (point))
(or (cdr bounds) (point))
(completion-table-with-cache
(lambda (_ignored)
(let* ((resp (eglot--request proc
:textDocument/completion
(eglot--TextDocumentPositionParams)
:textDocument/completion))
(items (if (vectorp resp) resp (plist-get resp :items))))
(eglot--mapply
(eglot--lambda (&rest all &key label &allow-other-keys)
(add-text-properties 0 1 all label) label)
items))))
:annotation-function
(lambda (obj)
(propertize (concat " " (or (get-text-property 0 :detail obj)
(cdr (assoc (get-text-property 0 :kind obj)
eglot--kind-names))))
'face 'font-lock-function-name-face))
:display-sort-function
(lambda (items)
(sort items (lambda (a b)
(string-lessp
(or (get-text-property 0 :sortText a) "")
(or (get-text-property 0 :sortText b) "")))))
:company-doc-buffer
(lambda (obj)
(let ((documentation
(or (get-text-property 0 :documentation obj)
(plist-get (eglot--request proc :completionItem/resolve
(text-properties-at 0 obj))
:documentation))))
(when documentation
(with-current-buffer (get-buffer-create " *eglot doc*")
(erase-buffer)
(ignore-errors (funcall (intern "markdown-mode")))
(font-lock-ensure)
(insert documentation)
(current-buffer)))))
:exit-function
(lambda (_string _status) (eglot-eldoc-function))))))
(defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.")
(defun eglot-eldoc-function ()
"EGLOT's `eldoc-documentation-function' function."
(let ((buffer (current-buffer))
(proc (eglot--current-process-or-lose))
(position-params (eglot--TextDocumentPositionParams)))
(when (eglot--server-capable :hoverProvider)
(eglot--async-request
proc :textDocument/hover position-params
:success-fn (eglot--lambda (&key contents range)
(when (get-buffer-window buffer)
(with-current-buffer buffer
(eldoc-message
(concat
(and range
(eglot--with-lsp-range (beg end) range
(concat (buffer-substring beg end) ": ")))
(mapconcat #'eglot--format-markup
(append
(cond ((vectorp contents)
contents)
(contents
(list contents)))) "\n"))))))
:deferred :textDocument/hover))
(when (eglot--server-capable :documentHighlightProvider)
(eglot--async-request
proc :textDocument/documentHighlight position-params
:success-fn (lambda (highlights)
(mapc #'delete-overlay eglot--highlights)
(setq eglot--highlights
(when (get-buffer-window buffer)
(with-current-buffer buffer
(eglot--mapply
(eglot--lambda (&key range kind)
(eglot--with-lsp-range (beg end) range
(let ((ov (make-overlay beg end)))
(overlay-put ov 'face 'highlight)
(overlay-put ov 'evaporate t)
(overlay-put ov :kind kind)
ov)))
highlights)))))
:deferred :textDocument/documentHighlight)))
nil)
(defun eglot-imenu (oldfun)
"EGLOT's `imenu-create-index-function' overriding OLDFUN."
(if (eglot--server-capable :documentSymbolProvider)
(let ((entries
(eglot--mapply
(eglot--lambda (&key name kind location _containerName)
(cons (propertize name :kind (cdr (assoc kind eglot--kind-names)))
(eglot--lsp-position-to-point
(plist-get (plist-get location :range) :start))))
(eglot--request (eglot--current-process-or-lose)
:textDocument/documentSymbol
(eglot--obj
:textDocument (eglot--TextDocumentIdentifier))))))
(append
(seq-group-by (lambda (e) (get-text-property 0 :kind (car e)))
entries)
entries))
(funcall oldfun)))
(defun eglot--apply-text-edits (buffer edits &optional version)
"Apply the EDITS for BUFFER."
(with-current-buffer buffer
(unless (or (not version)
(equal version eglot--versioned-identifier))
(eglot--error "Edits on `%s' require version %d, you have %d"
buffer version eglot--versioned-identifier))
(eglot--mapply
(eglot--lambda (&key range newText)
(save-restriction
(widen)
(save-excursion
(eglot--with-lsp-range (beg end) range
(goto-char beg) (delete-region beg end) (insert newText)))))
edits)
(eglot--message "%s: Performed %s edits" (current-buffer) (length edits))))
(defun eglot--apply-workspace-edit (wedit &optional confirm)
"Apply the workspace edit WEDIT. If CONFIRM, ask user first."
(let (prepared)
(cl-destructuring-bind (&key changes documentChanges)
wedit
(cl-loop
for change on documentChanges
do (push (cl-destructuring-bind (&key textDocument edits) change
(cl-destructuring-bind (&key uri version) textDocument
(list (eglot--uri-to-path uri) edits version)))
prepared))
(cl-loop for (uri edits) on changes by #'cddr
do (push (list (eglot--uri-to-path uri) edits) prepared)))
(if (or confirm
(cl-notevery #'find-buffer-visiting
(mapcar #'car prepared)))
(unless (y-or-n-p
(format "[eglot] Server requests to edit %s files.\n %s\n\
Proceed? "
(length prepared)
(mapconcat #'identity
(mapcar #'car prepared)
"\n ")))
(eglot--error "User cancelled server edit")))
(unwind-protect
(let (edit)
(while (setq edit (car prepared))
(cl-destructuring-bind (path edits &optional version) edit
(eglot--apply-text-edits (find-file-noselect path)
edits
version)
(pop prepared))))
(if prepared
(eglot--warn "Caution: edits of files %s failed."
(mapcar #'car prepared))
(eglot--message "Edit successful!")))))
(defun eglot-rename (newname)
"Rename the current symbol to NEWNAME."
(interactive
(list (read-from-minibuffer (format "Rename `%s' to: " (symbol-at-point)))))
(unless (eglot--server-capable :renameProvider)
(eglot--error "Server can't rename!"))
(eglot--apply-workspace-edit
(eglot--request (eglot--current-process-or-lose)
:textDocument/rename `(,@(eglot--TextDocumentPositionParams)
,@(eglot--obj :newName newname)))
current-prefix-arg))
\f
;;; Dynamic registration
;;;
(cl-defun eglot--register-workspace/didChangeWatchedFiles
(_proc &key _id _watchers)
"Handle dynamic registration of workspace/didChangeWatchedFiles"
;; TODO: file-notify-add-watch and
;; file-notify-rm-watch can probably handle this
(list nil "Sorry, can't do this yet"))
\f
;;; Rust-specific
;;;
(defun eglot--rls-probably-ready-for-p (what proc)
"Guess if the RLS running in PROC is ready for WHAT."
(or (eq what :textDocument/completion) ; RLS normally ready for this
; one, even if building ;
(pcase-let ((`(,_id ,what ,done ,_detail) (eglot--spinner proc)))
(and (equal "Indexing" what) done))))
;;;###autoload
(progn
(add-hook 'rust-mode-hook 'eglot--setup-rls-idiosyncrasies)
(defun eglot--setup-rls-idiosyncrasies ()
"Prepare `eglot' to deal with RLS's special treatment."
(add-hook 'eglot--ready-predicates 'eglot--rls-probably-ready-for-p t t)))
(cl-defun eglot--server-window/progress
(process &key id done title message &allow-other-keys)
"Handle notification window/progress"
(setf (eglot--spinner process) (list id title done message))
(when (and (equal "Indexing" title) done)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (eglot--buffer-managed-p process)
(funcall (or eglot--current-flymake-report-fn #'ignore)
eglot--unreported-diagnostics))))))
(provide 'eglot)
;;; eglot.el ends here
|