blob: 0bf952fa7229ef3b24fb9e033f86375d31d5a4d0 (
plain) (
tree)
|
|
;; 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 'compile)
(require 'url-util)
(require 'url-parse)
(require 'subr-x)
(require 'filenotify)
(require 'cl)
(defconst lsp--message-type-face
`((1 . ,compilation-error-face)
(2 . ,compilation-warning-face)
(3 . ,compilation-message-face)
(4 . ,compilation-info-face)))
(defcustom lsp-print-io nil
"If non-nil, print all messages to and from the language server to *Messages*."
:group 'lsp-mode
:type 'boolean)
(defvar-local lsp--cur-workspace nil)
(defvar lsp--uri-file-prefix (pcase system-type
(`windows-nt "file:///")
(_ "file://"))
"Prefix for a file-uri.")
(defvar-local lsp-buffer-uri nil
"If set, return it instead of calculating it using `buffer-file-name'.")
(define-error 'lsp-error "Unknown lsp-mode error")
(define-error 'lsp-empty-response-error
"Empty response from the language server" 'lsp-error)
(define-error 'lsp-timed-out-error
"Timed out while waiting for a response from the language server" 'lsp-error)
(define-error 'lsp-capability-not-supported
"Capability not supported by the language server" 'lsp-error)
(defun lsp--propertize (str type)
"Propertize STR as per TYPE."
(propertize str 'face (alist-get type lsp--message-type-face)))
(defvar lsp--no-response)
;; from http://emacs.stackexchange.com/questions/8082/how-to-get-buffer-position-given-line-number-and-column-number
(defun lsp--position-to-point (params)
"Convert Position object in PARAMS to a point."
(save-excursion
(save-restriction
(widen)
(goto-char (point-min))
(forward-line (gethash "line" params))
(forward-char (gethash "character" params))
(point))))
;;; TODO: Use the current LSP client name instead of lsp-mode for the type.
(defun lsp-warn (message &rest args)
"Display a warning message made from (`format-message' MESSAGE ARGS...).
This is equivalent to `display-warning', using `lsp-mode' as the type and
`:warning' as the level."
(display-warning 'lsp-mode (apply #'format-message message args)))
(defvar lsp-message-project-root-warning nil
"Output the project root warning as a message and not to the *Warnings* buffer.")
(defun lsp-make-traverser (name)
"Return a closure that walks up the current directory until NAME is found.
NAME can either be a string or a predicate used for `locate-dominating-file'.
The value returned by the function will be the directory name for NAME.
If no such directory could be found, log a warning and return `default-directory'"
(lambda ()
(let ((dir (locate-dominating-file "." name)))
(if dir
(file-truename dir)
(if lsp-message-project-root-warning
(message "Couldn't find project root, using the current directory as the root.")
(lsp-warn "Couldn't find project root, using the current directory as the root.")
default-directory)))))
(defun lsp--get-uri-handler (scheme)
"Get uri handler for SCHEME in the current workspace."
(when lsp--cur-workspace
(gethash scheme (lsp--client-uri-handlers
(lsp--workspace-client lsp--cur-workspace)))))
(defun lsp--uri-to-path (uri)
"Convert URI to a file path."
(let* ((url (url-generic-parse-url (url-unhex-string uri)))
(type (url-type url))
(file (url-filename url)))
(if (and type (not (string= type "file")))
(let ((handler (lsp--get-uri-handler type)))
(if handler
(funcall handler uri)
(error "Unsupported file scheme: %s" uri)))
;; `url-generic-parse-url' is buggy on windows:
;; https://github.com/emacs-lsp/lsp-mode/pull/265
(or (and (eq system-type 'windows-nt)
(eq (elt file 0) ?\/)
(substring file 1))
file))))
(define-inline lsp--buffer-uri ()
"Return URI of the current buffer."
(inline-quote
(or lsp-buffer-uri (lsp--path-to-uri buffer-file-name))))
(define-inline lsp--path-to-uri (path)
"Convert PATH to a uri."
(inline-quote
(concat lsp--uri-file-prefix
(url-hexify-string (file-truename ,path) url-path-allowed-chars))))
(defun lsp--string-match-any (regex-list str)
"Given a list of REGEX-LIST and STR return the first matching regex if any."
(find-if (lambda (regex) (string-match regex str)) regex-list))
(defun lsp-create-watch (dir file-regexp-list callback &optional watches root-dir)
"Create recursive file notificaton watch in DIR monitoring FILE-REGEXP-LIST.
CALLBACK is the will be called when there are changes in any of
the monitored files. WATCHES is a hash table directory->file
notification handle which contains all of the watches that
already have been created. "
(let ((all-dirs (thread-last
(directory-files-recursively dir ".*" t)
(seq-filter (lambda (f) (file-directory-p f)))
(list* dir)))
(watches (or watches (make-hash-table :test 'equal)))
(root-dir (or root-dir dir)))
(seq-do
(lambda (dir-to-watch)
(puthash
dir-to-watch
(file-notify-add-watch
dir-to-watch
'(change)
(lambda (event)
(let ((file-name (caddr event))
(event-type (cadr event)))
(cond
((and (file-directory-p file-name)
(equal 'created event-type))
(lsp-create-watch file-name file-regexp-list callback watches root-dir)
;; process the files that are already present in
;; the directory.
(thread-last
(directory-files-recursively file-name ".*" t)
(seq-do (lambda (f)
(when (and (lsp--string-match-any
file-regexp-list
(concat "/" (file-relative-name f root-dir)))
(not (file-directory-p f)))
(funcall callback (list nil 'created f)))))))
((and (not (file-directory-p file-name))
(lsp--string-match-any
file-regexp-list
(concat "/" (file-relative-name file-name root-dir))))
(funcall callback event))))))
watches))
all-dirs)
watches))
(defun lsp-kill-watch (watches)
"Delete WATCHES."
(maphash
(lambda (_dir watch)
(file-notify-rm-watch watch))
watches))
(declare-function lsp--workspace-client "lsp-methods" (cl-x))
(declare-function lsp--client-uri-handlers "lsp-methods" (cl-x))
(provide 'lsp-common)
;;; lsp-common.el ends here
|
