769 lines
33 KiB
EmacsLisp
769 lines
33 KiB
EmacsLisp
;;; lsp-ui-sideline.el --- Lsp-Ui-Sideline -*- lexical-binding: t -*-
|
||
|
||
;; Copyright (C) 2017 Sebastien Chapuis
|
||
|
||
;; Author: Sebastien Chapuis <sebastien@chapu.is>
|
||
;; URL: https://github.com/emacs-lsp/lsp-ui
|
||
;; Keywords: languages, tools
|
||
;; Version: 6.2
|
||
|
||
;;; License
|
||
;;
|
||
;; 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, 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; see the file COPYING. If not, write to
|
||
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
|
||
;; Floor, Boston, MA 02110-1301, USA.
|
||
|
||
;;; Commentary:
|
||
;;
|
||
;; Utility to show information for the current line
|
||
|
||
;;; Code:
|
||
|
||
(require 'lsp-ui-util)
|
||
(require 'lsp-protocol)
|
||
(require 'lsp-mode)
|
||
(require 'flycheck nil 'noerror)
|
||
(require 'dash)
|
||
(require 'seq)
|
||
(require 'subr-x)
|
||
(require 'face-remap)
|
||
|
||
(defvar flycheck-display-errors-function)
|
||
(declare-function flycheck-overlay-errors-in "ext:flycheck.el")
|
||
(declare-function flycheck-error-format-message-and-id "ext:flycheck.el")
|
||
(declare-function flycheck-error-level "ext:flycheck.el")
|
||
|
||
(defgroup lsp-ui-sideline nil
|
||
"Display information for the current line."
|
||
:group 'tools
|
||
:group 'convenience
|
||
:group 'lsp-ui
|
||
:link '(custom-manual "(lsp-ui-sideline) Top")
|
||
:link '(info-link "(lsp-ui-sideline) Customizing"))
|
||
|
||
(defcustom lsp-ui-sideline-enable t
|
||
"Whether or not to enable ‘lsp-ui-sideline’."
|
||
:type 'boolean
|
||
:group 'lsp-ui)
|
||
|
||
(defcustom lsp-ui-sideline-ignore-duplicate nil
|
||
"Ignore duplicates when there is a same symbol with the same contents."
|
||
:type 'boolean
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-show-symbol t
|
||
"When t, show the symbol name on the right of the information."
|
||
:type 'boolean
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-show-hover nil
|
||
"Whether to show hover messages in sideline."
|
||
:type 'boolean
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-show-diagnostics t
|
||
"Whether to show diagnostics messages in sideline."
|
||
:type 'boolean
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-show-code-actions nil
|
||
"Whether to show code actions in sideline."
|
||
:type 'boolean
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-update-mode 'point
|
||
"Define the mode for updating sideline actions.
|
||
|
||
When set to `line' the actions will be updated when user
|
||
changes current line otherwise the actions will be updated
|
||
when user changes current point."
|
||
:type '(choice (const line)
|
||
(const point))
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-delay 0.2
|
||
"Number of seconds to wait before showing sideline."
|
||
:type 'number
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-diagnostic-max-lines 1
|
||
"Maximum number of lines to show of diagnostics in sideline."
|
||
:type 'integer
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-diagnostic-max-line-length 100
|
||
"Maximum line length of diagnostics in sideline."
|
||
:type 'integer
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defconst lsp-ui-sideline-actions-icon-default
|
||
(and (bound-and-true-p lsp-ui-resources-dir)
|
||
(image-type-available-p 'png)
|
||
(expand-file-name "lightbulb.png" lsp-ui-resources-dir)))
|
||
|
||
;; TODO: Set the default actions to `nil' temporarily due to image
|
||
;; scale issue on Emacs version 26.3 or below.
|
||
;;
|
||
;; See #573
|
||
(defcustom lsp-ui-sideline-actions-icon nil
|
||
"Image file for actions. It must be a png file."
|
||
:type '(choice file (const :tag "Disable" nil))
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-wait-for-all-symbols t
|
||
"Wait for all symbols before displaying info in sideline."
|
||
:type 'boolean
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defcustom lsp-ui-sideline-actions-kind-regex "quickfix.*\\|refactor.*"
|
||
"Regex for the code actions kinds to show in the sideline."
|
||
:type 'string
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defvar lsp-ui-sideline-code-actions-prefix ""
|
||
"Prefix to insert before the code action title.
|
||
This can be used to insert, for example, an unicode character: 💡")
|
||
|
||
(defvar-local lsp-ui-sideline--ovs nil
|
||
"Overlays used by `lsp-ui-sideline'.")
|
||
|
||
(defvar-local lsp-ui-sideline--occupied-lines nil
|
||
"List of lines occupied by an overlay of `lsp-ui-sideline'.")
|
||
|
||
(defvar-local lsp-ui-sideline--first-line-pushed nil
|
||
"Record weather if we display sideline in the first line.
|
||
|
||
If we do, then sideline will always look downward instead of the upward
|
||
direction.
|
||
|
||
This prevent sideline displays below than the first line, which it will cause
|
||
weird looking user interface.")
|
||
|
||
(defvar-local lsp-ui-sideline--tag nil
|
||
"Tag marking where the last operation was based.
|
||
It is used to know when the cursor has changed its line or point.")
|
||
|
||
(defvar-local lsp-ui-sideline--last-width nil
|
||
"Value of window's width on the last operation.
|
||
It is used to know when the window has changed of width.")
|
||
|
||
(defvar-local lsp-ui-sideline--last-line-number nil
|
||
"Line number on the last operation.
|
||
Used to avoid calling `line-number-at-pos' when we're on the same line.")
|
||
|
||
(defvar-local lsp-ui-sideline--timer nil)
|
||
|
||
(defvar-local lsp-ui-sideline--code-actions nil
|
||
"Holds the latest code actions.")
|
||
|
||
(defvar-local lsp-ui-sideline--cached-infos nil
|
||
"Cache of rendered line when `lsp-ui-sideline-wait-for-all-symbols'
|
||
is nil. Used to not re-render the same line multiple times.")
|
||
|
||
(defface lsp-ui-sideline-symbol
|
||
'((t :foreground "grey"
|
||
:box (:line-width -1 :color "grey")
|
||
:height 0.99))
|
||
"Face used to highlight symbols."
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defface lsp-ui-sideline-current-symbol
|
||
'((((background light))
|
||
:foreground "black"
|
||
:weight ultra-bold
|
||
:box (:line-width -1 :color "black")
|
||
:height 0.99)
|
||
(t :foreground "white"
|
||
:weight ultra-bold
|
||
:box (:line-width -1 :color "white")
|
||
:height 0.99))
|
||
"Face used to highlight the symbol on point."
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defface lsp-ui-sideline-code-action
|
||
'((((background light)) :foreground "DarkOrange")
|
||
(t :foreground "yellow"))
|
||
"Face used to highlight code action text."
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defface lsp-ui-sideline-symbol-info
|
||
'((t :slant italic :height 0.99))
|
||
"Face used to highlight the symbols informations (LSP hover)."
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defface lsp-ui-sideline-global
|
||
'((t))
|
||
"Face which apply to all overlays.
|
||
This face have a low priority over the others."
|
||
:group 'lsp-ui-sideline)
|
||
|
||
(defun lsp-ui-sideline--first-line-p (pos)
|
||
"Return non-nil if POS is on the first line."
|
||
(when (integerp pos)
|
||
(save-excursion (goto-char 1) (forward-line 1) (> (point) pos))))
|
||
|
||
(defun lsp-ui-sideline--calc-space (win-width str-len index)
|
||
"Calculate whether there is enough space on line.
|
||
If there is enough space, it returns the point of the last
|
||
character on the line.
|
||
|
||
WIN-WIDTH is the window width.
|
||
STR-LEN is the string size.
|
||
INDEX is the line number (relative to the current line)."
|
||
(let ((eol (line-end-position index)))
|
||
(unless (member eol lsp-ui-sideline--occupied-lines)
|
||
(save-excursion
|
||
(goto-char eol)
|
||
(end-of-line)
|
||
(when (>= (- win-width (current-column)) str-len)
|
||
eol)))))
|
||
|
||
(defun lsp-ui-sideline--find-line (str-len bol eol &optional up offset)
|
||
"Find a line where the string can be inserted.
|
||
|
||
It loops on the nexts lines to find enough space. Returns the point
|
||
of the last character on the line.
|
||
|
||
Argument STR-LEN is the string size.
|
||
Argument BOL and EOL are beginning and ending of the user point line.
|
||
If optional argument UP is non-nil, it loops on the previous lines.
|
||
If optional argument OFFSET is non-nil, it starts search OFFSET lines
|
||
from user point line."
|
||
(let ((win-width (lsp-ui-sideline--window-width))
|
||
(inhibit-field-text-motion t)
|
||
(index (if (null offset) 1 offset))
|
||
pos)
|
||
(while (and (null pos) (<= (abs index) 30))
|
||
(setq index (if up (1- index) (1+ index)))
|
||
(setq pos (lsp-ui-sideline--calc-space win-width str-len index)))
|
||
(if (and up (or (null pos) (and (<= pos 1) lsp-ui-sideline--first-line-pushed)))
|
||
(lsp-ui-sideline--find-line str-len bol eol nil offset)
|
||
(when (and (null lsp-ui-sideline--first-line-pushed)
|
||
(lsp-ui-sideline--first-line-p pos))
|
||
(setq lsp-ui-sideline--first-line-pushed t)) ; mark first line push
|
||
(and pos (or (> pos eol) (< pos bol))
|
||
(push pos lsp-ui-sideline--occupied-lines)
|
||
(list pos (1- index))))))
|
||
|
||
(defun lsp-ui-sideline--delete-ov ()
|
||
"Delete overlays."
|
||
(seq-do 'delete-overlay lsp-ui-sideline--ovs)
|
||
(setq lsp-ui-sideline--tag nil
|
||
lsp-ui-sideline--cached-infos nil
|
||
lsp-ui-sideline--occupied-lines nil
|
||
lsp-ui-sideline--first-line-pushed (lsp-ui-sideline--first-line-p (point))
|
||
lsp-ui-sideline--ovs nil))
|
||
|
||
(defun lsp-ui-sideline--extract-info (contents)
|
||
"Extract the line to print from CONTENTS.
|
||
CONTENTS can be differents type of values:
|
||
MarkedString | MarkedString[] | MarkupContent (as defined in the LSP).
|
||
We prioritize string with a language (which is probably a type or a
|
||
function signature)."
|
||
(when contents
|
||
(cond
|
||
((lsp-marked-string? contents) contents)
|
||
((vectorp contents)
|
||
(seq-find (lambda (it) (and (lsp-marked-string? it)
|
||
(lsp-get-renderer (lsp:marked-string-language it))))
|
||
contents))
|
||
((lsp-markup-content? contents) contents))))
|
||
|
||
(defun lsp-ui-sideline--format-info (marked-string win-width)
|
||
"Format MARKED-STRING.
|
||
If the string has a language, we fontify it with the function provided
|
||
by `lsp-mode'.
|
||
MARKED-STRING is the string returned by `lsp-ui-sideline--extract-info'."
|
||
(when (and marked-string (or (lsp-marked-string? marked-string) (lsp-markup-content? marked-string)))
|
||
(setq marked-string (lsp--render-element marked-string))
|
||
(add-face-text-property 0 (length marked-string) 'lsp-ui-sideline-symbol-info nil marked-string)
|
||
(add-face-text-property 0 (length marked-string) 'default t marked-string)
|
||
(->> (if (> (length marked-string) (/ win-width 2))
|
||
(car (split-string (string-trim-left marked-string) "[\r\n]+"))
|
||
marked-string)
|
||
(replace-regexp-in-string "[\n\r\t ]+" " "))))
|
||
|
||
(defun lsp-ui-sideline--align (&rest lengths)
|
||
"Align sideline string by LENGTHS from the right of the window."
|
||
(+ (apply '+ lengths)
|
||
(if (display-graphic-p) 1 2)))
|
||
|
||
(defun lsp-ui-sideline--compute-height ()
|
||
"Return a fixed size for text in sideline."
|
||
(if (null text-scale-mode-remapping)
|
||
'(height 1)
|
||
;; Readjust height when text-scale-mode is used
|
||
(list 'height
|
||
(/ 1 (or (plist-get (cdar text-scale-mode-remapping) :height)
|
||
1)))))
|
||
|
||
(defun lsp-ui-sideline--make-display-string (info symbol current)
|
||
"Make final string to display in buffer.
|
||
INFO is the information to display.
|
||
SYMBOL is the symbol associated with the info.
|
||
CURRENT is non-nil when the point is on the symbol."
|
||
(let* ((face (if current 'lsp-ui-sideline-current-symbol 'lsp-ui-sideline-symbol))
|
||
(str (if lsp-ui-sideline-show-symbol
|
||
(concat info " " (propertize (concat " " symbol " ") 'face face))
|
||
info))
|
||
(len (length str))
|
||
(margin (lsp-ui-sideline--margin-width)))
|
||
(add-face-text-property 0 len 'lsp-ui-sideline-global nil str)
|
||
(concat
|
||
(propertize " " 'display `(space :align-to (- right-fringe ,(lsp-ui-sideline--align len margin))))
|
||
(propertize str 'display (lsp-ui-sideline--compute-height)))))
|
||
|
||
(defun lsp-ui-sideline--check-duplicate (symbol info)
|
||
"Check if there's already a SYMBOL containing INFO, unless `lsp-ui-sideline-ignore-duplicate'
|
||
is set to t."
|
||
(not (when lsp-ui-sideline-ignore-duplicate
|
||
(--any (and (string= (overlay-get it 'symbol) symbol)
|
||
(string= (overlay-get it 'info) info))
|
||
lsp-ui-sideline--ovs))))
|
||
|
||
(defun lsp-ui-sideline--margin-width ()
|
||
(+ (if fringes-outside-margins right-margin-width 0)
|
||
(or (and (boundp 'fringe-mode)
|
||
(consp fringe-mode)
|
||
(or (equal (car fringe-mode) 0)
|
||
(equal (cdr fringe-mode) 0))
|
||
1)
|
||
(and (boundp 'fringe-mode) (equal fringe-mode 0) 1)
|
||
0)
|
||
(let ((win-fringes (window-fringes)))
|
||
(if (or (equal (car win-fringes) 0)
|
||
(equal (cadr win-fringes) 0))
|
||
2
|
||
0))
|
||
(if (< emacs-major-version 27)
|
||
;; This was necessary with emacs < 27, recent versions take
|
||
;; into account the display-line width with :align-to
|
||
(lsp-ui-util-line-number-display-width)
|
||
0)
|
||
(if (or
|
||
(bound-and-true-p whitespace-mode)
|
||
(bound-and-true-p global-whitespace-mode))
|
||
1
|
||
0)))
|
||
|
||
(defun lsp-ui-sideline--window-width ()
|
||
(- (min (window-text-width) (window-body-width))
|
||
(lsp-ui-sideline--margin-width)
|
||
(or (and (>= emacs-major-version 27)
|
||
;; We still need this number when calculating available space
|
||
;; even with emacs >= 27
|
||
(lsp-ui-util-line-number-display-width))
|
||
0)))
|
||
|
||
(defun lsp-ui-sideline--valid-tag-p (tag mode)
|
||
(when tag
|
||
(-let ((inhibit-field-text-motion t)
|
||
((p bol _eol buffer) tag))
|
||
(when (and (= bol (line-beginning-position))
|
||
(eq buffer (current-buffer)))
|
||
(pcase mode
|
||
('point (eq p (point)))
|
||
('line t) ;; For 'line only bol is relevant
|
||
(_ (error "Wrong tag mode")))))))
|
||
|
||
(defun lsp-ui-sideline--display-all-info (list-infos tag bol eol)
|
||
(when (and (lsp-ui-sideline--valid-tag-p tag 'line)
|
||
(not (lsp-ui-sideline--stop-p)))
|
||
(let ((inhibit-modification-hooks t)
|
||
(win-width (window-body-width))
|
||
;; sort by bounds
|
||
(list-infos (--sort (< (caadr it) (caadr other)) list-infos)))
|
||
(lsp-ui-sideline--delete-kind 'info)
|
||
(--each list-infos
|
||
(-let (((symbol bounds info) it))
|
||
(lsp-ui-sideline--push-info win-width symbol bounds info bol eol))))))
|
||
|
||
(defun lsp-ui-sideline--push-info (win-width symbol bounds info bol eol)
|
||
(let* ((markdown-hr-display-char nil)
|
||
(info (or (alist-get info lsp-ui-sideline--cached-infos)
|
||
(-some--> (lsp:hover-contents info)
|
||
(lsp-ui-sideline--extract-info it)
|
||
(lsp-ui-sideline--format-info it win-width)
|
||
(progn (push (cons info it) lsp-ui-sideline--cached-infos) it))))
|
||
(current (and (>= (point) (car bounds)) (<= (point) (cdr bounds)))))
|
||
(when (and (> (length info) 0)
|
||
(lsp-ui-sideline--check-duplicate symbol info))
|
||
(let* ((final-string (lsp-ui-sideline--make-display-string info symbol current))
|
||
(pos-ov (lsp-ui-sideline--find-line (length final-string) bol eol))
|
||
(ov (when pos-ov (make-overlay (car pos-ov) (car pos-ov)))))
|
||
(when pos-ov
|
||
(overlay-put ov 'info info)
|
||
(overlay-put ov 'symbol symbol)
|
||
(overlay-put ov 'bounds bounds)
|
||
(overlay-put ov 'current current)
|
||
(overlay-put ov 'after-string final-string)
|
||
(overlay-put ov 'before-string " ")
|
||
(overlay-put ov 'window (get-buffer-window))
|
||
(overlay-put ov 'kind 'info)
|
||
(overlay-put ov 'position (car pos-ov))
|
||
(push ov lsp-ui-sideline--ovs))))))
|
||
|
||
(defun lsp-ui-sideline--toggle-current (ov current)
|
||
"Toggle the OV face according to CURRENT."
|
||
(let* ((info (overlay-get ov 'info))
|
||
(symbol (overlay-get ov 'symbol))
|
||
(string (lsp-ui-sideline--make-display-string info symbol current)))
|
||
(overlay-put ov 'current current)
|
||
(overlay-put ov 'after-string string)))
|
||
|
||
(defun lsp-ui-sideline--highlight-current (point)
|
||
"Update the symbol's face according to POINT."
|
||
(dolist (ov lsp-ui-sideline--ovs)
|
||
(let* ((bounds (overlay-get ov 'bounds))
|
||
(start (car bounds))
|
||
(end (cdr bounds)))
|
||
(if (and bounds (>= point start) (<= point end))
|
||
(unless (overlay-get ov 'current)
|
||
(lsp-ui-sideline--toggle-current ov t))
|
||
(when (overlay-get ov 'current)
|
||
(lsp-ui-sideline--toggle-current ov nil))))))
|
||
|
||
(defun lsp-ui-sideline--split-long-lines (lines)
|
||
"Fill LINES so that they are not longer than `lsp-ui-sideline-diagnostic-max-line-length' characters."
|
||
(cl-mapcan (lambda (line)
|
||
(if (< (length line) lsp-ui-sideline-diagnostic-max-line-length)
|
||
(list line)
|
||
(with-temp-buffer
|
||
(let ((fill-column lsp-ui-sideline-diagnostic-max-line-length))
|
||
(insert line)
|
||
(fill-region (point-min) (point-max))
|
||
(split-string (buffer-string) "\n")))))
|
||
lines))
|
||
|
||
(defun lsp-ui-sideline--diagnostics (buffer bol eol)
|
||
"Show diagnostics belonging to the current line.
|
||
Loop over flycheck errors with `flycheck-overlay-errors-in'.
|
||
Find appropriate position for sideline overlays with `lsp-ui-sideline--find-line'.
|
||
Push sideline overlays on `lsp-ui-sideline--ovs'."
|
||
(when (and (bound-and-true-p flycheck-mode)
|
||
(bound-and-true-p lsp-ui-sideline-mode)
|
||
lsp-ui-sideline-show-diagnostics
|
||
(eq (current-buffer) buffer))
|
||
(lsp-ui-sideline--delete-kind 'diagnostics)
|
||
(dolist (e (flycheck-overlay-errors-in bol (1+ eol)))
|
||
(let* ((lines (--> (flycheck-error-format-message-and-id e)
|
||
(split-string it "\n")
|
||
(lsp-ui-sideline--split-long-lines it)))
|
||
(display-lines (butlast lines (- (length lines) lsp-ui-sideline-diagnostic-max-lines)))
|
||
(offset 1))
|
||
(dolist (line (nreverse display-lines))
|
||
(let* ((msg (string-trim (replace-regexp-in-string "[\t ]+" " " line)))
|
||
(msg (replace-regexp-in-string " " " " msg))
|
||
(len (length msg))
|
||
(level (flycheck-error-level e))
|
||
(face (if (eq level 'info) 'success level))
|
||
(margin (lsp-ui-sideline--margin-width))
|
||
(msg (progn (add-face-text-property 0 len 'lsp-ui-sideline-global nil msg)
|
||
(add-face-text-property 0 len face nil msg)
|
||
msg))
|
||
(string (concat (propertize " " 'display `(space :align-to (- right-fringe ,(lsp-ui-sideline--align len margin))))
|
||
(propertize msg 'display (lsp-ui-sideline--compute-height))))
|
||
(pos-ov (lsp-ui-sideline--find-line len bol eol t offset))
|
||
(ov (and pos-ov (make-overlay (car pos-ov) (car pos-ov)))))
|
||
(when pos-ov
|
||
(setq offset (1+ (car (cdr pos-ov))))
|
||
(overlay-put ov 'after-string string)
|
||
(overlay-put ov 'kind 'diagnostics)
|
||
(overlay-put ov 'before-string " ")
|
||
(overlay-put ov 'position (car pos-ov))
|
||
(push ov lsp-ui-sideline--ovs))))))))
|
||
|
||
(defun lsp-ui-sideline-apply-code-actions nil
|
||
"Choose and apply code action(s) on the current line."
|
||
(interactive)
|
||
(unless lsp-ui-sideline--code-actions
|
||
(user-error "No code actions on the current line"))
|
||
(lsp-execute-code-action (lsp--select-action lsp-ui-sideline--code-actions)))
|
||
|
||
(defun lsp-ui-sideline-set-default-icon ()
|
||
"Set default icon for sideline actions."
|
||
(setq lsp-ui-sideline-actions-icon lsp-ui-sideline-actions-icon-default))
|
||
|
||
(defun lsp-ui-sideline--scale-lightbulb (height)
|
||
"Scale the lightbulb image to character height.
|
||
|
||
Argument HEIGHT is an actual image height in pixel."
|
||
(--> (- (frame-char-height) 1)
|
||
(/ (float it) height)))
|
||
|
||
(defun lsp-ui-sideline--code-actions-make-image nil
|
||
(let ((is-default (equal lsp-ui-sideline-actions-icon lsp-ui-sideline-actions-icon-default)))
|
||
(--> `(image :type png :file ,lsp-ui-sideline-actions-icon :ascent center)
|
||
(append it `(:scale ,(->> (cond (is-default 128)
|
||
((fboundp 'image-size) (cdr (image-size it t)))
|
||
(t (error "Function image-size undefined. Use default icon")))
|
||
(lsp-ui-sideline--scale-lightbulb)))))))
|
||
|
||
(defun lsp-ui-sideline--code-actions-image nil
|
||
(when lsp-ui-sideline-actions-icon
|
||
(with-demoted-errors "[lsp-ui-sideline]: Error with actions icon: %s"
|
||
(concat
|
||
(propertize " " 'display (lsp-ui-sideline--code-actions-make-image))
|
||
(propertize " " 'display '(space :width 0.3))))))
|
||
|
||
(defun lsp-ui-sideline--code-actions (actions bol eol)
|
||
"Show code ACTIONS."
|
||
(let ((inhibit-modification-hooks t))
|
||
(when lsp-ui-sideline-actions-kind-regex
|
||
(setq actions (seq-filter (-lambda ((&CodeAction :kind?))
|
||
(or (not kind?)
|
||
(s-match lsp-ui-sideline-actions-kind-regex kind?)))
|
||
actions)))
|
||
(setq lsp-ui-sideline--code-actions actions)
|
||
(lsp-ui-sideline--delete-kind 'actions)
|
||
(seq-doseq (action actions)
|
||
(-let* ((title (->> (lsp:code-action-title action)
|
||
(replace-regexp-in-string "[\n\t ]+" " ")
|
||
(replace-regexp-in-string " " " ")
|
||
(concat (unless lsp-ui-sideline-actions-icon
|
||
lsp-ui-sideline-code-actions-prefix))))
|
||
(image (lsp-ui-sideline--code-actions-image))
|
||
(margin (lsp-ui-sideline--margin-width))
|
||
(keymap (let ((map (make-sparse-keymap)))
|
||
(define-key map [down-mouse-1] (lambda () (interactive)
|
||
(save-excursion
|
||
(lsp-execute-code-action action))))
|
||
map))
|
||
(len (length title))
|
||
(title (progn (add-face-text-property 0 len 'lsp-ui-sideline-global nil title)
|
||
(add-face-text-property 0 len 'lsp-ui-sideline-code-action nil title)
|
||
(add-text-properties 0 len `(keymap ,keymap mouse-face highlight) title)
|
||
title))
|
||
(string (concat (propertize " " 'display `(space :align-to (- right-fringe ,(lsp-ui-sideline--align (+ len (length image)) margin))))
|
||
image
|
||
(propertize title 'display (lsp-ui-sideline--compute-height))))
|
||
(pos-ov (lsp-ui-sideline--find-line (+ 1 (length title) (length image)) bol eol t))
|
||
(ov (and pos-ov (make-overlay (car pos-ov) (car pos-ov)))))
|
||
(when pos-ov
|
||
(overlay-put ov 'after-string string)
|
||
(overlay-put ov 'before-string " ")
|
||
(overlay-put ov 'kind 'actions)
|
||
(overlay-put ov 'position (car pos-ov))
|
||
(push ov lsp-ui-sideline--ovs))))))
|
||
|
||
(defun lsp-ui-sideline--calculate-tag nil
|
||
"Calculate the tag used to determine whether to update sideline information."
|
||
(let ((inhibit-field-text-motion t))
|
||
(list (point) (line-beginning-position) (line-end-position) (current-buffer))))
|
||
|
||
(defun lsp-ui-sideline--delete-kind (kind)
|
||
(->> (--remove
|
||
(when (eq (overlay-get it 'kind) kind)
|
||
(--> (overlay-get it 'position)
|
||
(remq it lsp-ui-sideline--occupied-lines)
|
||
(setq lsp-ui-sideline--occupied-lines it))
|
||
(delete-overlay it)
|
||
t)
|
||
lsp-ui-sideline--ovs)
|
||
(setq lsp-ui-sideline--ovs)))
|
||
|
||
(defvar-local lsp-ui-sideline--last-tick-info nil)
|
||
(defvar-local lsp-ui-sideline--previous-line nil)
|
||
|
||
(defun lsp-ui-sideline--get-line (bol eol)
|
||
(buffer-substring-no-properties bol eol))
|
||
|
||
(defun lsp-ui-sideline--line-diags (line)
|
||
(->> (--filter
|
||
(let ((range (lsp-get it :range)))
|
||
(or (-some-> range (lsp-get :start) (lsp-get :line) (= line))
|
||
(-some-> range (lsp-get :end) (lsp-get :line) (= line))))
|
||
(lsp--get-buffer-diagnostics))
|
||
(apply 'vector)))
|
||
|
||
(defun lsp-ui-sideline--run (&optional buffer bol eol this-line)
|
||
"Show information (flycheck + lsp).
|
||
It loops on the symbols of the current line and requests information
|
||
from the language server."
|
||
(when buffer-file-name
|
||
(let* ((inhibit-field-text-motion t)
|
||
(tag (lsp-ui-sideline--calculate-tag))
|
||
(eol (or eol (nth 2 tag)))
|
||
(bol (or bol (nth 1 tag)))
|
||
(this-tick (buffer-modified-tick))
|
||
(line-changed (not (lsp-ui-sideline--valid-tag-p lsp-ui-sideline--tag 'line)))
|
||
(line-widen (or (and (not line-changed) lsp-ui-sideline--last-line-number)
|
||
(and (buffer-narrowed-p) (save-restriction (widen) (line-number-at-pos)))
|
||
(line-number-at-pos)))
|
||
(new-tick (unless line-changed (not (equal this-tick lsp-ui-sideline--last-tick-info))))
|
||
(this-line (or this-line (lsp-ui-sideline--get-line bol eol)))
|
||
(line-modified (and new-tick (not (equal this-line lsp-ui-sideline--previous-line))))
|
||
(doc-id (lsp--text-document-identifier))
|
||
(inhibit-modification-hooks t)
|
||
symbols)
|
||
(setq lsp-ui-sideline--tag tag
|
||
lsp-ui-sideline--last-line-number line-widen
|
||
lsp-ui-sideline--last-width (window-text-width))
|
||
(when (and line-changed lsp-ui-sideline-show-diagnostics)
|
||
(lsp-ui-sideline--diagnostics buffer bol eol))
|
||
(when (and lsp-ui-sideline-show-code-actions
|
||
(or (lsp--capability "codeActionProvider")
|
||
(lsp--registered-capability "textDocument/codeAction")))
|
||
(lsp-request-async
|
||
"textDocument/codeAction"
|
||
(-let (((start . end) (if (eq lsp-ui-sideline-update-mode 'line)
|
||
(cons 0 (- eol bol))
|
||
(--> (- (point) bol) (cons it it)))))
|
||
(list :textDocument doc-id
|
||
:range (list :start (list :line (1- line-widen) :character start)
|
||
:end (list :line (1- line-widen) :character end))
|
||
:context (list :diagnostics (lsp-ui-sideline--line-diags (1- line-widen)))))
|
||
(lambda (actions)
|
||
(when (eq (current-buffer) buffer)
|
||
(lsp-ui-sideline--code-actions actions bol eol)))
|
||
:mode 'tick
|
||
:error-handler
|
||
(lambda (&rest _)
|
||
(lsp-ui-sideline--delete-kind 'actions))
|
||
:cancel-token :lsp-ui-code-actions))
|
||
;; Go through all symbols and request hover information. Note that the symbols are
|
||
;; traversed backwards as `forward-symbol' with a positive argument will jump just past the
|
||
;; current symbol. By going from the end of the line towards the front, point will be placed
|
||
;; at the beginning of each symbol. As the requests are first collected in a list before
|
||
;; being processed they are still sent in order from left to right.
|
||
(when (and lsp-ui-sideline-show-hover (or line-changed line-modified) (lsp--capability "hoverProvider"))
|
||
(setq lsp-ui-sideline--last-tick-info this-tick
|
||
lsp-ui-sideline--previous-line this-line)
|
||
(save-excursion
|
||
(goto-char eol)
|
||
(while (and (> (point) bol)
|
||
(progn (forward-symbol -1)
|
||
(>= (point) bol)))
|
||
(let* ((symbol (thing-at-point 'symbol t))
|
||
(bounds (bounds-of-thing-at-point 'symbol))
|
||
(parsing-state (syntax-ppss))
|
||
(in-string (nth 3 parsing-state))
|
||
(outside-comment (eq (nth 4 parsing-state) nil)))
|
||
;; Skip strings and comments
|
||
(when (and symbol (not in-string) outside-comment)
|
||
(push (list symbol bounds (list :line (1- line-widen) :character (- (point) bol))) symbols))))
|
||
(if (null symbols)
|
||
(lsp-ui-sideline--delete-kind 'info)
|
||
(let ((length-symbols (length symbols))
|
||
(current-index 0)
|
||
list-infos)
|
||
(--each symbols
|
||
(-let (((symbol bounds position) it))
|
||
(lsp-request-async
|
||
"textDocument/hover"
|
||
(lsp-make-hover-params :text-document doc-id :position position)
|
||
(lambda (info)
|
||
(cl-incf current-index)
|
||
(and info (push (list symbol bounds info) list-infos))
|
||
(when (or (= current-index length-symbols) (not lsp-ui-sideline-wait-for-all-symbols))
|
||
(lsp-ui-sideline--display-all-info list-infos tag bol eol)))
|
||
:error-handler
|
||
(lambda (&rest _)
|
||
(cl-incf current-index)
|
||
(when (or (= current-index length-symbols) (not lsp-ui-sideline-wait-for-all-symbols))
|
||
(lsp-ui-sideline--display-all-info list-infos tag bol eol)))
|
||
:mode 'tick))))))))))
|
||
|
||
(defun lsp-ui-sideline--stop-p ()
|
||
"Return non-nil if the sideline should not be display."
|
||
(or (region-active-p)
|
||
(bound-and-true-p company-pseudo-tooltip-overlay)
|
||
(bound-and-true-p lsp-ui-peek--overlay)))
|
||
|
||
(defun lsp-ui-sideline--hide-before-company (command)
|
||
"Disable the sideline before company's overlay appears.
|
||
COMMAND is `company-pseudo-tooltip-frontend' parameter."
|
||
(when (memq command '(post-command update))
|
||
(lsp-ui-sideline--delete-ov)))
|
||
|
||
(defun lsp-ui-sideline ()
|
||
"Show information for the current line."
|
||
(if (lsp-ui-sideline--stop-p)
|
||
(lsp-ui-sideline--delete-ov)
|
||
(let* ((inhibit-field-text-motion t)
|
||
(same-line (lsp-ui-sideline--valid-tag-p lsp-ui-sideline--tag 'line))
|
||
(same-width (equal (window-text-width) lsp-ui-sideline--last-width))
|
||
(new-tick (and same-line (not (equal (buffer-modified-tick) lsp-ui-sideline--last-tick-info))))
|
||
(bol (and new-tick (line-beginning-position)))
|
||
(eol (and new-tick (line-end-position)))
|
||
(this-line (and new-tick (lsp-ui-sideline--get-line bol eol)))
|
||
(unmodified (if new-tick (equal this-line lsp-ui-sideline--previous-line) t))
|
||
(buffer (current-buffer))
|
||
(point (point)))
|
||
(cond ((and unmodified same-line same-width)
|
||
(lsp-ui-sideline--highlight-current (point)))
|
||
((not (and same-line same-width))
|
||
(lsp-ui-sideline--delete-ov)))
|
||
(when lsp-ui-sideline--timer
|
||
(cancel-timer lsp-ui-sideline--timer))
|
||
(setq lsp-ui-sideline--timer
|
||
(run-with-idle-timer
|
||
lsp-ui-sideline-delay nil
|
||
(lambda nil
|
||
;; run lsp-ui only if current-buffer is the same.
|
||
(and (eq buffer (current-buffer))
|
||
(= point (point))
|
||
(lsp-ui-sideline--run buffer bol eol this-line))))))))
|
||
|
||
(defun lsp-ui-sideline-toggle-symbols-info ()
|
||
"Toggle display of symbols information.
|
||
This does not toggle display of flycheck diagnostics or code actions."
|
||
(interactive)
|
||
(when (bound-and-true-p lsp-ui-sideline-mode)
|
||
(setq lsp-ui-sideline-show-hover (not lsp-ui-sideline-show-hover))
|
||
(lsp-ui-sideline--run (current-buffer))))
|
||
|
||
(defun lsp-ui-sideline--diagnostics-changed ()
|
||
"Handler for flycheck notifications."
|
||
(when lsp-ui-sideline-show-diagnostics
|
||
(let* ((buffer (current-buffer))
|
||
(inhibit-field-text-motion t)
|
||
(eol (line-end-position))
|
||
(bol (line-beginning-position)))
|
||
(lsp-ui-sideline--diagnostics buffer bol eol))))
|
||
|
||
(defun lsp-ui-sideline--erase (&rest _)
|
||
"Remove all sideline overlays and delete last tag."
|
||
(when (bound-and-true-p lsp-ui-sideline-mode)
|
||
(ignore-errors (lsp-ui-sideline--delete-ov))))
|
||
|
||
(define-minor-mode lsp-ui-sideline-mode
|
||
"Minor mode for showing information for current line."
|
||
:init-value nil
|
||
:group lsp-ui-sideline
|
||
(cond
|
||
(lsp-ui-sideline-mode
|
||
(add-hook 'post-command-hook 'lsp-ui-sideline nil t)
|
||
(advice-add 'company-pseudo-tooltip-frontend :before 'lsp-ui-sideline--hide-before-company)
|
||
(add-hook 'flycheck-after-syntax-check-hook 'lsp-ui-sideline--diagnostics-changed nil t)
|
||
(when lsp-ui-sideline-show-diagnostics
|
||
(setq-local flycheck-display-errors-function nil)))
|
||
(t
|
||
(advice-remove 'company-pseudo-tooltip-frontend 'lsp-ui-sideline--hide-before-company)
|
||
(lsp-ui-sideline--delete-ov)
|
||
(remove-hook 'flycheck-after-syntax-check-hook 'lsp-ui-sideline--diagnostics-changed t)
|
||
(remove-hook 'post-command-hook 'lsp-ui-sideline t)
|
||
(when lsp-ui-sideline-show-diagnostics
|
||
(kill-local-variable 'flycheck-display-errors-function)))))
|
||
|
||
(defun lsp-ui-sideline-enable (enable)
|
||
"Enable/disable `lsp-ui-sideline-mode'."
|
||
(lsp-ui-sideline-mode (if enable 1 -1))
|
||
(if enable
|
||
(add-hook 'before-revert-hook 'lsp-ui-sideline--delete-ov nil t)
|
||
(remove-hook 'before-revert-hook 'lsp-ui-sideline--delete-ov t)))
|
||
|
||
(provide 'lsp-ui-sideline)
|
||
;;; lsp-ui-sideline.el ends here
|