diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180827.344/lsp-io.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180827.344/lsp-io.el | 350 |
1 files changed, 350 insertions, 0 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180827.344/lsp-io.el b/configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180827.344/lsp-io.el new file mode 100644 index 0000000000..2204aa4faa --- /dev/null +++ b/configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180827.344/lsp-io.el @@ -0,0 +1,350 @@ +;; Copyright (C) 2016-2018 Vibhav Pant <vibhavp@gmail.com> -*- lexical-binding: t -*- + +;; 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/>. + +;;; Code: + +(require 'json) +(require 'cl-lib) +(require 'lsp-common) +(require 'lsp-notifications) +(require 'pcase) +(require 'subr-x) + +;; vibhavp: Should we use a lower value (5)? +(defcustom lsp-response-timeout 10 + "Number of seconds to wait for a response from the language server before timing out." + :type 'number + :group 'lsp-mode) + +(defun lsp--send-wait (message proc parser) + "Send MESSAGE to PROC and wait for output from the process." + (when lsp-print-io + (let ((inhibit-message t)) + (message "lsp--stdio-wait: %s" message))) + (when (memq (process-status proc) '(stop exit closed failed nil)) + (error "%s: Cannot communicate with the process (%s)" (process-name proc) + (process-status proc))) + (process-send-string proc message) + (with-local-quit + (let* ((send-time (time-to-seconds (current-time))) + ;; max time by which we must get a response + (expected-time (+ send-time lsp-response-timeout))) + (while (lsp--parser-waiting-for-response parser) + ;; Wait for expected-time - current-time + (accept-process-output proc (- expected-time (time-to-seconds (current-time)))) + ;; We have timed out when expected-time < (current-time) + (when (< expected-time (time-to-seconds (current-time))) + (signal 'lsp-timed-out-error nil)))))) + +(defun lsp--send-no-wait (message proc) + "Send MESSAGE to PROC without waiting for further output." + (when lsp-print-io + (let ((inhibit-message t)) + (message "lsp--send-no-wait: %s" message))) + (when (memq (process-status proc) '(stop exit closed failed nil)) + (error "%s: Cannot communicate with the process (%s)" (process-name proc) + (process-status proc))) + (process-send-string proc message)) + +(cl-defstruct lsp--parser + (waiting-for-response nil) + (response-result nil) + (headers '()) ;; alist of headers + (body nil) ;; message body + (reading-body nil) ;; If non-nil, reading body + (body-length nil) ;; length of current message body + (body-received 0) ;; amount of current message body currently stored in 'body' + (leftovers nil) ;; Leftover data from previous chunk; to be processed + + (queued-notifications nil) ;; Unused field + (queued-requests nil) + + (workspace nil) ;; the workspace + ) + +(define-error 'lsp-parse-error + "Error parsing message from language server" 'lsp-error) +(define-error 'lsp-unknown-message-type + "Unknown message type" '(lsp-error lsp-parse-error)) +(define-error 'lsp-unknown-json-rpc-version + "Unknown JSON-RPC protocol version" '(lsp-error lsp-parse-error)) +(define-error 'lsp-no-content-length + "Content-Length header missing in message" '(lsp-error lsp-parse-error)) +(define-error 'lsp-invalid-header-name + "Invalid header name" '(lsp-error lsp-parse-error)) + +;; id method +;; x x request +;; x . response +;; . x notification + +(defun lsp--get-message-type (json-data) + "Get the message type from JSON-DATA." + (when (not (string= (gethash "jsonrpc" json-data "") "2.0")) + (signal 'lsp-unknown-json-rpc-version (list (gethash "jsonrpc" json-data)))) + (if (gethash "id" json-data nil) + (if (gethash "error" json-data nil) + 'response-error + (if (gethash "method" json-data nil) + 'request + 'response)) + (if (gethash "method" json-data nil) + 'notification + (signal 'lsp-unknown-message-type (list json-data))))) + +(defun lsp--default-message-handler (workspace params) + (lsp--window-show-message params workspace)) + +(defconst lsp--default-notification-handlers + #s(hash-table + test equal + data + ("window/showMessage" lsp--default-message-handler + "window/logMessage" lsp--default-message-handler + "textDocument/publishDiagnostics" (lambda (w p) (lsp--on-diagnostics p w)) + "textDocument/diagnosticsEnd" ignore + "textDocument/diagnosticsBegin" ignore))) + +(defun lsp--on-notification (p notification) + "Call the appropriate handler for NOTIFICATION." + (let* ((params (gethash "params" notification)) + (client (lsp--workspace-client (lsp--parser-workspace p))) + (method (gethash "method" notification)) + (handler (gethash method + (lsp--client-notification-handlers client) + (gethash method lsp--default-notification-handlers)))) + (if handler + (funcall handler (lsp--parser-workspace p) params) + (lsp-warn "Unknown method: %s" method)))) + +(defun lsp--on-request (p request) + "Call the appropriate handler for REQUEST, and send the return value to the server." + (let ((params (gethash "params" request)) + (client (lsp--workspace-client (lsp--parser-workspace p))) + (process (lsp--workspace-proc (lsp--parser-workspace p))) + (empty-response (lsp--make-response (gethash "id" request) nil nil)) + handler response) + (setq response + (pcase (gethash "method" request) + ("client/registerCapability" + (dolist (reg (gethash "registrations" params)) + (lsp--server-register-capability reg)) + empty-response) + ("window/showMessageRequest" + (let ((choice (lsp--window-show-message-request params))) + (lsp--make-response (gethash "id" request) + `(:title ,choice) + nil))) + ("client/unregisterCapability" + (dolist (unreg (gethash "unregisterations" params)) + (lsp--server-unregister-capability unreg)) + empty-response) + ("workspace/applyEdit" + (lsp--workspace-apply-edit-handler + (lsp--parser-workspace p) params) + empty-response) + (other + (setq handler (gethash other (lsp--client-request-handlers client) nil)) + (if (not handler) + (progn + (lsp-warn "Unknown request method: %s" other) + empty-response) + (lsp--make-response (gethash "id" request) + (funcall handler (lsp--parser-workspace p) params) nil))))) + ;; Send response to the server. + (lsp--send-no-wait (lsp--make-message response) process))) + +(defconst lsp--errors + '((-32700 "Parse Error") + (-32600 "Invalid Request") + (-32601 "Method not Found") + (-32602 "Invalid Parameters") + (-32603 "Internal Error") + (-32099 "Server Start Error") + (-32000 "Server End Error") + (-32002 "Server Not Initialized") + (-32001 "Unknown Error Code") + (-32800 "Request Cancelled")) + "alist of error codes to user friendly strings.") + +(defconst lsp--silent-errors '(-32800) + "Error codes that are okay to not notify the user about") + +(defun lsp--error-string (err) + "Format ERR as a user friendly string." + (let ((code (gethash "code" err)) + (message (gethash "message" err))) + (format "Error from the Language Server: %s (%s)" + message + (or (car (alist-get code lsp--errors)) "Unknown error")))) + +(defun lsp--get-body-length (headers) + (let ((content-length (cdr (assoc "Content-Length" headers)))) + (if content-length + (string-to-number content-length) + + ;; This usually means either the server our our parser is + ;; screwed up with a previous Content-Length + (error "No Content-Length header")))) + +(defun lsp--parse-header (s) + "Parse string S as a LSP (KEY . VAL) header." + (let ((pos (string-match "\:" s)) + key val) + (unless pos + (signal 'lsp-invalid-header-name (list s))) + (setq key (substring s 0 pos) + val (substring s (+ 2 pos))) + (when (string-equal key "Content-Length") + (cl-assert (cl-loop for c being the elements of val + when (or (> c ?9) (< c ?0)) return nil + finally return t) + nil (format "Invalid Content-Length value: %s" val))) + (cons key val))) + +(defun lsp--parser-reset (p) + (setf + (lsp--parser-leftovers p) "" + (lsp--parser-body-length p) nil + (lsp--parser-body-received p) nil + (lsp--parser-headers p) '() + (lsp--parser-body p) nil + (lsp--parser-reading-body p) nil)) + +(define-inline lsp--read-json (str) + (inline-quote + (let* ((json-array-type 'list) + (json-object-type 'hash-table) + (json-false nil)) + (json-read-from-string ,str)))) + +(defun lsp--parser-on-message (p msg) + "Called when the parser reads a complete message from the server." + (let* ((json-data (lsp--read-json msg)) + (id (gethash "id" json-data nil)) + (client (lsp--workspace-client (lsp--parser-workspace p))) + callback) + (pcase (lsp--get-message-type json-data) + ('response + (cl-assert id) + (setq callback (gethash (if (stringp id) + (string-to-number id) + id) + (lsp--client-response-handlers client) + nil)) + (if callback + (progn (funcall callback (gethash "result" json-data nil)) + (remhash id (lsp--client-response-handlers client))) + (setf (lsp--parser-response-result p) + (and json-data (gethash "result" json-data nil)) + (lsp--parser-waiting-for-response p) nil))) + ('response-error + (let* ((err (gethash "error" json-data nil)) + (code (gethash "code" err nil))) + (when (and json-data + (not (memq code lsp--silent-errors))) + (message (lsp--error-string err)))) + (setf (lsp--parser-response-result p) nil + (lsp--parser-waiting-for-response p) nil)) + ('notification (lsp--on-notification p json-data)) + ('request (lsp--on-request p json-data))))) + +(defun lsp--parser-read (p output) + (cl-assert (lsp--parser-workspace p) nil "Parser workspace cannot be nil.") + (let ((messages '()) + (chunk (concat (lsp--parser-leftovers p) output))) + (while (not (string-empty-p chunk)) + (if (not (lsp--parser-reading-body p)) + ;; Read headers + (let* ((body-sep-pos (string-match-p "\r\n\r\n" chunk))) + (if body-sep-pos + ;; We've got all the headers, handle them all at once: + (let* ((header-raw (substring chunk 0 body-sep-pos)) + (content (substring chunk (+ body-sep-pos 4))) + (headers + (mapcar 'lsp--parse-header + (split-string header-raw "\r\n"))) + (body-length (lsp--get-body-length headers))) + (setf + (lsp--parser-headers p) headers + (lsp--parser-reading-body p) t + (lsp--parser-body-length p) body-length + (lsp--parser-body-received p) 0 + (lsp--parser-body p) (make-string body-length ?\0) + (lsp--parser-leftovers p) nil) + (setq chunk content)) + + ;; Haven't found the end of the headers yet. Save everything + ;; for when the next chunk arrives and await further input. + (setf (lsp--parser-leftovers p) chunk) + (setq chunk ""))) + + ;; Read body + (let* ((total-body-length (lsp--parser-body-length p)) + (received-body-length (lsp--parser-body-received p)) + (chunk-length (string-bytes chunk)) + (left-to-receive (- total-body-length received-body-length)) + (this-body + (substring chunk 0 (min left-to-receive chunk-length))) + (leftovers (substring chunk (string-bytes this-body)))) + (store-substring (lsp--parser-body p) received-body-length this-body) + (setf (lsp--parser-body-received p) (+ (lsp--parser-body-received p) + (string-bytes this-body))) + (when (>= chunk-length left-to-receive) + ;; TODO: keep track of the Content-Type header, if + ;; present, and use its value instead of just defaulting + ;; to utf-8 + (push (decode-coding-string (lsp--parser-body p) 'utf-8) messages) + (lsp--parser-reset p)) + + (setq chunk leftovers)))) + (nreverse messages))) + +(defun lsp--json-pretty-print (msg) + "Convert json MSG string to pretty printed json string." + (let ((json-encoding-pretty-print t)) + (json-encode (json-read-from-string msg)))) + +(defun lsp--parser-make-filter (p ignore-regexps) + #'(lambda (_proc output) + (when (cl-loop for r in ignore-regexps + ;; check if the output is to be ignored or not + ;; TODO: Would this ever result in false positives? + when (string-match r output) return nil + finally return t) + (let ((messages + (condition-case err + (lsp--parser-read p output) + (error + (progn + (lsp--parser-reset p) + (setf (lsp--parser-response-result p) nil + (lsp--parser-waiting-for-response p) nil) + (error "Error parsing language server output: %s" err)))))) + + (dolist (m messages) + (when lsp-print-io + (let ((inhibit-message t)) + (message "Output from language server: %s" (lsp--json-pretty-print m)))) + (lsp--parser-on-message p m)))))) + +(declare-function lsp--client-notification-handlers "lsp-methods" (client)) +(declare-function lsp--client-request-handlers "lsp-methods" (client)) +(declare-function lsp--workspace-client "lsp-methods" (workspace)) +(declare-function lsp--workspace-apply-edit-handler "lsp-methods" (workspace params)) +(declare-function lsp--window-show-message-request "lsp-notifications" (params)) + +(provide 'lsp-io) +;;; lsp-io.el ends here |