emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/eglot 8bd634c 016/139: Start working on this again


From: João Távora
Subject: [elpa] externals/eglot 8bd634c 016/139: Start working on this again
Date: Mon, 14 May 2018 09:54:43 -0400 (EDT)

branch: externals/eglot
commit 8bd634ce9d5058e2db36dcf250bb909cc96eeaeb
Author: João Távora <address@hidden>
Commit: João Távora <address@hidden>

    Start working on this again
    
    * eglot.el (url-util): Require it.
    (eglot--process-sentinel): pending continuations now are quads (added env).
    (eglot--process-filter): Unwind message markers correctly if handling fails.
    (eglot--obj): Simple macro.
    (eglot--log-event): Add some info to logged event.
    (eglot--environment-vars, eglot--environment): Helper vars.
    (eglot--process-receive): Improve.
    (eglot--process-send): Niver log.
    (eglot--request): Use eglot--obj. Add environment.
    (eglot--notify): New helper.
    (eglot--protocol-initialize): RLS must like file://
    (eglot--current-flymake-report-fn): New var.
    (eglot--textDocument/publishDiagnostics): Use flymake from Emacs 26.
    (eglot-mode): Proper minor mode.
    (eglot--recent-changes, eglot--versioned-identifier): New stuff.
    (eglot--current-buffer-versioned-identifier)
    (eglot--current-buffer-VersionedTextDocumentIdentifier)
    (eglot--current-buffer-TextDocumentItem, eglot--after-change)
    (eglot--signalDidOpen, eglot--maybe-signal-didChange): New stuff.
    (eglot-flymake-backend): More or less a flymake backend function.
---
 eglot.el | 267 ++++++++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 204 insertions(+), 63 deletions(-)

diff --git a/eglot.el b/eglot.el
index 8946692..8da6267 100644
--- a/eglot.el
+++ b/eglot.el
@@ -28,6 +28,7 @@
 (require 'cl-lib)
 (require 'project)
 (require 'url-parse)
+(require 'url-util)
 
 (defgroup eglot nil
   "Interaction with Language Server Protocol servers"
@@ -143,8 +144,8 @@
     (when (not (process-live-p process))
       ;; Remember to cancel all timers
       ;;
-      (maphash (lambda (id triplet)
-                 (cl-destructuring-bind (_success _error timeout) triplet
+      (maphash (lambda (id quad)
+                 (cl-destructuring-bind (_success _error timeout _env) quad
                    (eglot--message
                     "(sentinel) Cancelling timer for continuation %s" id)
                    (cancel-timer timeout)))
@@ -185,7 +186,7 @@
             (when new-expected-bytes
               (when expected-bytes
                 (eglot--warn
-                 (concat "Unexpectedly starting new message but %s bytes"
+                 (concat "Unexpectedly starting new message but %s bytes "
                          "reportedly remaining from previous one")
                  expected-bytes))
               (set-marker message-mark (point))
@@ -207,22 +208,29 @@
                  (let* ((message-end (byte-to-position
                                       (+ (position-bytes message-mark)
                                          expected-bytes))))
-                   (save-excursion
-                     (save-restriction
-                       (goto-char message-mark)
-                       (narrow-to-region message-mark
-                                         message-end)
-                       (eglot--process-receive
-                        proc
-                        (let ((json-object-type 'plist))
-                          (json-read)))))
-                   (set-marker message-mark message-end)
-                   (setf (eglot--expected-bytes proc) nil)))
+                   (unwind-protect
+                       (save-excursion
+                         (save-restriction
+                           (goto-char message-mark)
+                           (narrow-to-region message-mark
+                                             message-end)
+                           (eglot--process-receive
+                            proc
+                            (let ((json-object-type 'plist))
+                              (json-read)))))
+                     (set-marker message-mark message-end)
+                     (setf (eglot--expected-bytes proc) nil))))
                 (t
                  ;; just adding some stuff to the end that doesn't yet
                  ;; complete the message
                  )))))))
 
+(defmacro eglot--obj (&rest what)
+  "Make an object suitable for `json-encode'"
+  ;; FIXME: maybe later actually do something, for now this just fixes
+  ;; the indenting of literal plists.
+  `(list ,@what))
+
 (defun eglot-events-buffer (process &optional interactive)
   (interactive (list (eglot--current-process-or-lose) t))
   (let* ((probe (eglot--events-buffer process))
@@ -241,22 +249,39 @@
       (display-buffer buffer))
     buffer))
 
-(defun eglot--log-event (proc type message)
+(defun eglot--log-event (proc type message id error)
   (with-current-buffer (eglot-events-buffer proc)
     (let ((inhibit-read-only t))
       (goto-char (point-max))
-      (insert (format "%s: \n%s\n" type (pp-to-string message))))))
+      (insert (format "%s%s%s:\n%s\n"
+                      type
+                      (if id (format " (id:%s)" id) "")
+                      (if error " ERROR" "")
+                      (pp-to-string message))))))
+
+(defvar eglot--environment-vars
+  '(eglot--current-flymake-report-fn)
+  "A list of variables with saved values on every request.")
+
+(defvar eglot--environment nil
+  "Dynamically bound alist of symbol and values")
 
 (defun eglot--process-receive (proc message)
-  (let ((inhibit-read-only t))
-    (insert (format "Server said:\n%s\n" message)))
-  (eglot--log-event proc 'server message)
-  ;; Maybe this is a responsee
-  ;;
+  "Process MESSAGE from PROC."
   (let* ((response-id (plist-get message :id))
          (err (plist-get message :error))
          (continuations (and response-id
                              (gethash response-id 
(eglot--pending-continuations)))))
+    (eglot--log-event proc
+                      (cond ((not response-id)
+                             'server-notification)
+                            ((not continuations)
+                             'unexpected-server-reply)
+                            (t
+                             'server-reply))
+                      message
+                      response-id
+                      err)
     (cond ((and response-id
                 (not continuations))
            (eglot--warn "Ooops no continuation for id %s" response-id))
@@ -271,21 +296,28 @@
           (t
            (let* ((method (plist-get message :method))
                   (handler-sym (intern (concat "eglot--"
-                                               method))))
+                                               method)))
+                  (eglot--environment (cl-fourth continuations)))
              (if (functionp handler-sym)
-                 (apply handler-sym proc (plist-get message :params))
+                 (cl-progv
+                     (mapcar #'car eglot--environment)
+                     (mapcar #'cdr eglot--environment)
+                   (apply handler-sym proc (plist-get message :params)))
                (eglot--debug "No implemetation for notification %s yet"
                              method)))))))
 
 (defvar eglot--expect-carriage-return nil)
 
-(defun eglot--process-send (proc message)
+(defun eglot--process-send (id proc message)
   (let* ((json (json-encode message))
          (to-send (format "Content-Length: %d\r\n\r\n%s"
                           (string-bytes json)
                           json)))
     (process-send-string proc to-send)
-    (eglot--log-event proc 'client message)))
+    (eglot--log-event proc (if id
+                               'client-request
+                             'client-notification)
+                      message id nil)))
 
 (defvar eglot--next-request-id 0)
 
@@ -300,6 +332,7 @@
                           method
                           params
                           &key success-fn error-fn timeout-fn (async-p t))
+  "Make a request to PROCESS, expecting a reply."
   (let* ((id (eglot--next-request-id))
          (timeout-fn
           (or timeout-fn
@@ -322,11 +355,12 @@
                   "(request) Request id=%s replied to with result=%s: %s"
                   id result-body)))))
          (catch-tag (cl-gensym (format "eglot--tag-%d-" id))))
-    (eglot--process-send process
-                         `(:jsonrpc  "2.0"
-                                     :id  ,id
-                                     :method  ,method
-                                     :params  ,params))
+    (eglot--process-send id
+                         process
+                         (eglot--obj :jsonrpc "2.0"
+                                     :id id
+                                     :method method
+                                     :params params))
     (catch catch-tag
       (let ((timeout-timer
              (run-with-timer 5 nil
@@ -343,7 +377,9 @@
                            error-fn
                          (lambda (&rest args)
                            (throw catch-tag (apply error-fn args))))
-                       timeout-timer)
+                       timeout-timer
+                       (cl-loop for var in eglot--environment-vars
+                                collect (cons var (symbol-value var))))
                  (eglot--pending-continuations process))
         (unless async-p
           (unwind-protect
@@ -362,6 +398,15 @@
                "(request) Last-change cancelling timer for continuation %s" id)
               (cancel-timer timeout-timer))))))))
 
+(cl-defun eglot--notify (process method params)
+  "Notify PROCESS of something, don't expect a reply.e"
+  (eglot--process-send nil
+                       process
+                       (eglot--obj :jsonrpc  "2.0"
+                                   :id nil
+                                   :method method
+                                   :params params)))
+
 
 ;;; Requests
 ;;;
@@ -373,8 +418,7 @@ INTERACTIVE is t if caller was called interactively."
    process
    :initialize
    `(:processId  ,(emacs-pid)
-                 :rootPath  ,(concat "" ;; FIXME RLS doesn't like "file://"
-                                     ;; "file://"
+                 :rootPath  ,(concat "file://"
                                      (expand-file-name (car (project-roots
                                                              
(project-current)))))
                  :initializationOptions  []
@@ -423,45 +467,54 @@ running.  INTERACTIVE is t if called interactively."
 
 ;;; Notifications
 ;;;
-(defvar-local eglot--diagnostic-overlays nil)
+(defvar eglot--current-flymake-report-fn nil)
 
 (cl-defun eglot--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)))
+         (buffer (find-buffer-visiting filename))
+         (report-fn (cdr (assoc 'eglot--current-flymake-report-fn
+                                eglot--environment))))
     (cond
+     ((not eglot--current-flymake-report-fn)
+      (eglot--warn "publishDiagnostics called but no report-fn"))
+     ((and report-fn
+           (not (eq report-fn
+                    eglot--current-flymake-report-fn)))
+      (eglot--warn "outdated publishDiagnostics report from server"))
      (buffer
       (with-current-buffer buffer
         (eglot--message "OK so add some %s diags" (length diagnostics))
-        (mapc #'delete-overlay eglot--diagnostic-overlays)
-        (setq eglot--diagnostic-overlays nil)
-        (cl-flet ((pos-at (pos-plist)
-                          (save-excursion
-                            (goto-char (point-min))
-                            (forward-line (plist-get pos-plist :line))
-                            (forward-char (plist-get pos-plist :character))
-                            (point))))
-          (cl-loop for diag across diagnostics
-                   do (cl-destructuring-bind (&key range severity
-                                                   _code _source message)
-                          diag
-                        (cl-destructuring-bind (&key start end)
-                            range
-                          (let* ((begin-pos (pos-at start))
-                                 (end-pos (pos-at end))
-                                 (ov (make-overlay begin-pos
-                                                   end-pos
-                                                   buffer)))
-                            (push ov eglot--diagnostic-overlays)
-                            (overlay-put ov 'face
-                                         (cl-case severity
-                                           (1 'flymake-errline)
-                                           (2 'flymake-warnline)))
-                            (overlay-put ov 'help-echo
-                                         message)
-                            (overlay-put ov 'eglot--diagnostic diag))))))))
+        (cl-flet ((pos-at
+                   (pos-plist)
+                   (car (flymake-diag-region
+                         (current-buffer)
+                         (plist-get pos-plist :line)
+                         (plist-get pos-plist :character)))))
+          (cl-loop for diag-spec across diagnostics
+                   collect (cl-destructuring-bind (&key range severity
+                                                        _code _source message)
+                               diag-spec
+                             (cl-destructuring-bind (&key start end)
+                                 range
+                               (let* ((begin-pos (pos-at start))
+                                      (end-pos (pos-at end)))
+                                 (flymake-make-diagnostic
+                                  (current-buffer)
+                                  begin-pos end-pos
+                                  (cond ((<= severity 1)
+                                         :error)
+                                        ((= severity 2)
+                                         :warning)
+                                        (t
+                                         :note))
+                                  message))))
+                   into diags
+                   finally (funcall
+                            eglot--current-flymake-report-fn
+                            diags)))))
      (t
       (eglot--message "OK so %s isn't visited" filename)))))
 
@@ -498,7 +551,19 @@ running.  INTERACTIVE is t if called interactively."
   :group 'eglot)
 
 (define-minor-mode eglot-mode
-  "Minor mode for buffers where EGLOT is possible")
+  "Minor mode for buffers where EGLOT is possible"
+  nil
+  nil
+  eglot-mode-map
+  (cond (eglot-mode
+         (add-hook 'after-change-functions 'eglot--after-change nil t)
+         (add-hook 'flymake-diagnostic-functions 'eglot-flymake-backend nil t)
+         (if (eglot--current-process)
+             (eglot--signalDidOpen)
+           (eglot--warn "No process")))
+        (t
+         (remove-hook 'flymake-diagnostic-functions 'eglot-flymake-backend t)
+         (remove-hook 'after-change-functions 'eglot--after-change t))))
 
 (defvar eglot-menu)
 
@@ -575,5 +640,81 @@ running.  INTERACTIVE is t if called interactively."
              `(eglot-mode
                (" [" eglot--mode-line-format "] ")))
 
+(defvar eglot--recent-changes nil
+  "List of recent changes as collected by `eglot--after-change'")
+
+(defvar-local eglot--versioned-identifier 0)
+
+(defun eglot--current-buffer-versioned-identifier ()
+  "Return a VersionedTextDocumentIdentifier."
+  ;; FIXME: later deal with workspaces
+  eglot--versioned-identifier)
+
+(defun eglot--current-buffer-VersionedTextDocumentIdentifier ()
+  (eglot--obj :uri
+              (concat "file://"
+                      (url-hexify-string
+                       (file-truename buffer-file-name)
+                       url-path-allowed-chars))
+              :version (eglot--current-buffer-versioned-identifier)))
+
+(defun eglot--current-buffer-TextDocumentItem ()
+  (append
+   (eglot--current-buffer-VersionedTextDocumentIdentifier)
+   (eglot--obj :languageId (cdr (assoc major-mode
+                                       '((rust-mode . rust)
+                                         (emacs-lisp-mode . emacs-lisp))))
+               :text
+               (save-restriction
+                 (widen)
+                 (buffer-substring-no-properties (point-min) (point-max))))))
+
+(defun eglot--after-change (start end length)
+  (cl-incf eglot--versioned-identifier)
+  (push (list start end length) eglot--recent-changes)
+  (eglot--message "start is %s, end is %s, length is %s" start end length))
+
+(defun eglot--signalDidOpen ()
+  (eglot--notify (eglot--current-process-or-lose)
+                 :textDocument/didOpen
+                 (eglot--obj :textDocument
+                             (eglot--current-buffer-TextDocumentItem))))
+
+(defun eglot--maybe-signal-didChange ()
+  (when eglot--recent-changes
+    (save-excursion
+      (save-restriction
+        (widen)
+        (let* ((start (cl-reduce #'min (mapcar #'car eglot--recent-changes)))
+               (end (cl-reduce #'max (mapcar #'cadr eglot--recent-changes))))
+          (eglot--notify
+           (eglot--current-process-or-lose)
+           :textDocument/didChange
+           (eglot--obj
+            :textDocument 
(eglot--current-buffer-VersionedTextDocumentIdentifier)
+            :contentChanges
+            (vector
+             (eglot--obj
+              :range (eglot--obj
+                      :start
+                      (eglot--obj :line
+                                  (line-number-at-pos start t)
+                                  :character
+                                  (- (goto-char start)
+                                     (line-beginning-position)))
+                      :end
+                      (eglot--obj :line
+                                  (line-number-at-pos end t)
+                                  :character
+                                  (- (goto-char end)
+                                     (line-beginning-position))))
+              :rangeLength (- end start)
+              :text (buffer-substring-no-properties start end))))))))
+    (setq eglot--recent-changes nil)))
+
+(defun eglot-flymake-backend (report-fn &rest _more)
+  (setq eglot--current-flymake-report-fn report-fn)
+  (eglot--maybe-signal-didChange))
+
 (provide 'eglot)
 ;;; eglot.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]