diff options
Diffstat (limited to 'elpa/lsp-ui-20220425.1046/lsp-ui-sideline.el')
| -rw-r--r-- | elpa/lsp-ui-20220425.1046/lsp-ui-sideline.el | 768 |
1 files changed, 768 insertions, 0 deletions
diff --git a/elpa/lsp-ui-20220425.1046/lsp-ui-sideline.el b/elpa/lsp-ui-20220425.1046/lsp-ui-sideline.el new file mode 100644 index 0000000..f627a6a --- /dev/null +++ b/elpa/lsp-ui-20220425.1046/lsp-ui-sideline.el @@ -0,0 +1,768 @@ +;;; 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 nil + "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 (cdr 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 |