diff options
Diffstat (limited to 'configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180911.1829/lsp-io.el')
| -rw-r--r-- | configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180911.1829/lsp-io.el | 350 |
1 files changed, 0 insertions, 350 deletions
diff --git a/configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180911.1829/lsp-io.el b/configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180911.1829/lsp-io.el deleted file mode 100644 index 0686b08f9906..000000000000 --- a/configs/shared/emacs/.emacs.d/elpa/lsp-mode-20180911.1829/lsp-io.el +++ /dev/null @@ -1,350 +0,0 @@ -;; 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" - (seq-doseq (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" - (seq-doseq (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 |