kemonine/emacs
Archived
1
0
Fork 0
Code Activity
This repository has been archived on 2024-10-19. You can view files and clone it, but cannot push or open issues or pull requests.
emacs/code/elpa/lsp-ui-20230811.552/lsp-ui-peek.el

764 lines
31 KiB
EmacsLisp
Raw Normal View History

force update packages ; add lsp-mode, lsp-ui, helm-lsp
2023-07-27 19:52:58 +00:00
;;; lsp-ui-peek.el --- Lsp-Ui-Peek -*- lexical-binding: t -*-
;; Copyright (C) 2017 Sebastien Chapuis
;; Author: Sebastien Chapuis <sebastien@chapu.is>
;; URL: https://github.com/emacs-lsp/lsp-ui
;; Keywords: languagues, tools
;; Version: 0.0.1
;;; 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:
;;
;; Load this file and execute `lsp-ui-peek-find-references'
;; on a symbol to find its references
;; or `lsp-ui-peek-find-definitions'.
;; Type 'q' to close the window.
;;
;;; Code:
(require 'lsp-protocol)
(require 'lsp-mode)
(require 'xref)
(require 'dash)
(defgroup lsp-ui-peek nil
"Improve version of xref with peek feature."
:group 'tools
:group 'convenience
:group 'lsp-ui
:link '(custom-manual "(lsp-ui-peek) Top")
:link '(info-link "(lsp-ui-peek) Customizing"))
(defcustom lsp-ui-peek-enable t
"Whether or not to enable ‘lsp-ui-peek’."
:type 'boolean
:group 'lsp-ui)
(defcustom lsp-ui-peek-show-directory t
"Whether or not to show the directory of files."
:type 'boolean
:safe t
:group 'lsp-ui-peek)
(defcustom lsp-ui-peek-peek-height 20
"Height of the peek code."
:type 'integer
:group 'lsp-ui-peek)
(defcustom lsp-ui-peek-list-width 50
"Width of the right panel."
:type 'integer
:group 'lsp-ui-peek)
(defcustom lsp-ui-peek-fontify 'on-demand
"Whether to fontify chunks of code (use semantics colors).
WARNING: 'always can heavily slow the processing when
`lsp-ui-peek-expand-function' expands more than 1 file.
It is recommended to keep the default value of `lsp-ui-peek-expand-function'
when this variable is set to 'always."
:type '(choice (const :tag "Never" never)
(const :tag "On demand" on-demand)
(const :tag "Always" always))
:group 'lsp-ui-peek)
(defcustom lsp-ui-peek-always-show nil
"Show the peek view even if there is only 1 cross reference.
By default, the peek view isn't shown if there is 1 xref."
:type 'boolean
:group 'lsp-ui-peek)
(defface lsp-ui-peek-peek
'((((background light)) :background "light gray")
(t :background "#031A25"))
"Face used for the peek."
:group 'lsp-ui-peek)
(defface lsp-ui-peek-list
'((((background light)) :background "light gray")
(t :background "#181818"))
"Face used to list references."
:group 'lsp-ui-peek)
(defface lsp-ui-peek-filename
'((((background light)) :foreground "red")
(t :foreground "dark orange"))
"Face used for the filename's reference in the list."
:group 'lsp-ui-peek)
(defface lsp-ui-peek-line-number
'((t :foreground "grey25"))
"Line number face."
:group 'lsp-ui-peek)
(defface lsp-ui-peek-highlight
'((((background light)) :background "yellow"
:box (:line-width -1 :color "red"))
(t :background "white"
:foreground "black"
:distant-foreground "white"
:box (:line-width -1 :color "red")))
"Face used to highlight the reference/definition.
Do not use box, underline or overline prop. If you want to use
box, use a negative value for its width. Those properties deform
the whole overlay."
:group 'lsp-ui-peek)
(defface lsp-ui-peek-header
'((((background light)) :background "grey30" :foreground "white")
(t :background "white" :foreground "black"))
"Face used for the headers."
:group 'lsp-ui-peek)
(defface lsp-ui-peek-footer
'((t :inherit lsp-ui-peek-header))
"Face used for the footers. Only the background of this face is used."
:group 'lsp-ui-peek)
(defface lsp-ui-peek-selection
'((((background light)) :background "grey30" :foreground "white")
(t :background "white" :foreground "black"))
"Face used for the current selection.
Do not use box, underline or overline prop. If you want to use
box, use a negative value for its width. Those properties
deform the whole overlay."
:group 'lsp-ui-peek)
(defvar lsp-ui-peek-expand-function 'lsp-ui-peek--expand-buffer
"A function used to determinate which file(s) to expand in the list of xrefs.
The function takes one parameter: a list of cons where the car is the
filename and the cdr is the number of references in that file.
It should returns a list of filenames to expand.
WARNING: If you change this variable and expand more than 1 file, it is
recommended to set `lsp-ui-peek-fontify' to 'never or 'on-demand, otherwise it
will cause performances issues.")
(defvar-local lsp-ui-peek--overlay nil)
(defvar-local lsp-ui-peek--list nil)
(defvar-local lsp-ui-peek--last-xref nil)
(defvar-local lsp-ui-peek--selection 0)
(defvar-local lsp-ui-peek--offset 0)
(defvar-local lsp-ui-peek--size-list 0)
(defvar-local lsp-ui-peek--win-start nil)
(defvar-local lsp-ui-peek--method nil)
(defvar-local lsp-ui-peek--deactivate-keymap-fn nil)
(defvar lsp--peek-save-major-mode nil
"Stores the major mode for lsp ui peek.")
(defvar lsp-ui-peek--jumps (make-hash-table)
"Hashtable which stores all jumps on a per window basis.")
(defvar evil--jumps-window-jumps) ; defined in evil-jumps.el
(defmacro lsp-ui-peek--with-evil-jumps (&rest body)
"Make `evil-jumps.el' commands work on `lsp-ui-peek--jumps'."
(declare (indent 1))
`(let ((evil--jumps-window-jumps lsp-ui-peek--jumps))
,@body))
(with-eval-after-load 'evil-jumps
;; We need to jump through some hoops to prevent the byte-compiler from
;; compiling this code. We can’t compile the code without requiring
;; ‘evil-macros’.
(eval '(progn
(evil-define-motion lsp-ui-peek-jump-backward (count)
(lsp-ui-peek--with-evil-jumps
(evil--jump-backward count)
(run-hooks 'xref-after-return-hook)))
(evil-define-motion lsp-ui-peek-jump-forward (count)
(lsp-ui-peek--with-evil-jumps
(evil--jump-forward count)
(run-hooks 'xref-after-return-hook))))
t))
(defmacro lsp-ui-peek--prop (prop &optional string)
`(get-text-property 0 ,prop (or ,string (lsp-ui-peek--get-text-selection) "")))
(defmacro lsp-ui-peek--add-prop (prop &optional string)
`(let ((obj (or ,string (lsp-ui-peek--get-text-selection))))
(add-text-properties 0 (length obj) ,prop obj)
obj))
(defun lsp-ui-peek--truncate (len s)
(if (> (string-width s) len)
(concat (truncate-string-to-width s (max (- len 2) 0)) "..")
s))
(defun lsp-ui-peek--get-text-selection (&optional n)
(nth (or n lsp-ui-peek--selection)
(--remove (get-text-property 0 'lsp-ui-peek-hidden it) lsp-ui-peek--list)))
(defun lsp-ui-peek--get-selection ()
(get-text-property 0 'lsp-ui-peek (or (lsp-ui-peek--get-text-selection) "")))
(defun lsp-ui-peek--visual-index ()
(- lsp-ui-peek--selection lsp-ui-peek--offset))
(defun lsp-ui-peek--make-line (index src)
(-let* (((s1 . s2) src)
(len-s1 (length s1))
(len-s2 (length s2))
(on-selection (= (1+ (lsp-ui-peek--visual-index)) index))
(face-left (if (= index 0) 'lsp-ui-peek-header 'lsp-ui-peek-peek))
(face-right (cond (on-selection 'lsp-ui-peek-selection)
((= index 0) 'lsp-ui-peek-header)
(t 'lsp-ui-peek-list))))
(when on-selection
(setq s2 (copy-sequence s2))
(add-face-text-property 0 len-s2 face-right nil s2))
(unless (get-text-property 0 'lsp-ui-peek-faced s2)
(add-face-text-property 0 len-s2 face-right t s2)
(add-text-properties 0 len-s2 '(lsp-ui-peek-faced t) s2)
(add-face-text-property 0 len-s2 'default t s2))
(add-face-text-property 0 len-s1 face-left t s1)
(add-face-text-property 0 len-s1 'default t s1)
(concat
s1
(propertize "_" 'face face-left 'display `(space :align-to (- right-fringe ,(1+ lsp-ui-peek-list-width))))
" "
s2
(propertize "_" 'face face-right 'display `(space :align-to (- right-fringe 1)))
(propertize "\n" 'face face-right))))
(defun lsp-ui-peek--adjust (width strings)
(-let* (((s1 . s2) strings))
(cons (lsp-ui-peek--truncate (- width (1+ lsp-ui-peek-list-width)) s1)
(lsp-ui-peek--truncate (- lsp-ui-peek-list-width 2) s2))))
(defun lsp-ui-peek--make-footer ()
;; Character-only terminals don't support characters of different height
(when (display-graphic-p)
(list
(concat
(propertize " "
'face `(:background ,(face-background 'lsp-ui-peek-footer nil t) :height 1)
'display `(space :align-to (- right-fringe ,(1+ lsp-ui-peek-list-width))))
(propertize " " 'face '(:height 1)
'display `(space :align-to (- right-fringe ,lsp-ui-peek-list-width)))
(propertize " "
'face `(:background ,(face-background 'lsp-ui-peek-footer nil t) :height 1)
'display `(space :align-to (- right-fringe 0)))
(propertize "\n" 'face '(:height 1))
(propertize "\n" 'face '(:height 0.5))))))
(defun lsp-ui-peek--peek-new (src1 src2)
(-let* ((win-width (- (window-text-width)
(if (bound-and-true-p display-line-numbers-mode)
(+ 2 (line-number-display-width))
0)))
(string (-some--> (-zip-fill "" src1 src2)
(--map (lsp-ui-peek--adjust win-width it) it)
(-map-indexed 'lsp-ui-peek--make-line it)
(-concat it (lsp-ui-peek--make-footer))))
(next-line (line-beginning-position 2))
(ov (or (when (overlayp lsp-ui-peek--overlay) lsp-ui-peek--overlay)
(make-overlay next-line next-line))))
(setq lsp-ui-peek--overlay ov)
(overlay-put ov 'after-string (mapconcat 'identity string ""))
(overlay-put ov 'display-line-numbers-disable t)
(overlay-put ov 'window (get-buffer-window))))
(defun lsp-ui-peek--expand-buffer (files)
(if (--any? (equal (car it) buffer-file-name) files)
(list buffer-file-name)
(list (caar files))))
(defun lsp-ui-peek--expand (xrefs)
(let* ((to-expand (->> (--map (cons (plist-get it :file) (plist-get it :count)) xrefs)
(funcall lsp-ui-peek-expand-function)))
first)
(while (nth lsp-ui-peek--selection lsp-ui-peek--list)
(when (and (lsp-ui-peek--prop 'xrefs)
(member (lsp-ui-peek--prop 'file) to-expand))
(unless first
(setq first (1+ lsp-ui-peek--selection)))
(lsp-ui-peek--toggle-file t))
(setq lsp-ui-peek--selection (1+ lsp-ui-peek--selection)))
(setq lsp-ui-peek--selection (or first 0))
(lsp-ui-peek--recenter)))
(defun lsp-ui-peek--show (xrefs)
"Create a window to list references/defintions.
XREFS is a list of references/definitions."
(setq lsp-ui-peek--win-start (window-start)
lsp-ui-peek--selection 0
lsp-ui-peek--offset 0
lsp-ui-peek--size-list 0
lsp-ui-peek--list nil)
(when (eq (logand lsp-ui-peek-peek-height 1) 1)
(setq lsp-ui-peek-peek-height (1+ lsp-ui-peek-peek-height)))
(when (< (- (line-number-at-pos (window-end)) (line-number-at-pos))
(+ lsp-ui-peek-peek-height 3))
(recenter 15))
(setq xrefs (--sort (string< (plist-get it :file) (plist-get other :file)) xrefs))
(--each xrefs
(-let* (((&plist :file filename :xrefs xrefs :count count) it)
(len-str (number-to-string count)))
(setq lsp-ui-peek--size-list (+ lsp-ui-peek--size-list count))
(push (concat (propertize (if lsp-ui-peek-show-directory
(lsp-ui--workspace-path filename)
(file-name-nondirectory filename))
'face 'lsp-ui-peek-filename
'file filename
'xrefs xrefs)
(propertize " " 'display `(space :align-to (- right-fringe
;; Account for Emacs TTY's window divider
;; Without this leeway, the reference count
;; string goes to next line - impairs readability
,(if (display-graphic-p) 0 1)
,(1+ (length len-str)))))
(propertize len-str 'face 'lsp-ui-peek-filename))
lsp-ui-peek--list)))
(setq lsp-ui-peek--list (nreverse lsp-ui-peek--list))
(lsp-ui-peek--expand xrefs)
(lsp-ui-peek--peek))
(defun lsp-ui-peek--recenter ()
(let ((half-height (/ lsp-ui-peek-peek-height 2)))
(when (> lsp-ui-peek--selection half-height)
(setq lsp-ui-peek--offset (- lsp-ui-peek--selection (1- half-height))))))
(defun lsp-ui-peek--fill (min-len list)
(let ((len (length list)))
(if (< len min-len)
(append list (-repeat (- min-len len) ""))
list)))
(defun lsp-ui-peek--render (major string)
(with-temp-buffer
(insert string)
(delay-mode-hooks
(let ((inhibit-message t))
(funcall major))
(ignore-errors
(font-lock-ensure)))
(buffer-string)))
(defun lsp-ui-peek--peek ()
"Show reference's chunk of code."
(-let* ((xref (lsp-ui-peek--get-selection))
((&plist :file file :chunk chunk) (or xref lsp-ui-peek--last-xref))
(header (concat " " (lsp-ui--workspace-path file) "\n"))
(header2 (format " %s %s" lsp-ui-peek--size-list
(string-remove-prefix "workspace/" (string-remove-prefix "textDocument/" lsp-ui-peek--method))))
(ref-view (--> chunk
(subst-char-in-string ?\t ?\s it)
(concat header it)
(split-string it "\n")))
(list-refs (->> lsp-ui-peek--list
(--remove (lsp-ui-peek--prop 'lsp-ui-peek-hidden it))
(-drop lsp-ui-peek--offset)
(-take (1- lsp-ui-peek-peek-height))
(lsp-ui-peek--fill (1- lsp-ui-peek-peek-height))
(-concat (list header2)))))
(setq lsp-ui-peek--last-xref (or xref lsp-ui-peek--last-xref))
(lsp-ui-peek--peek-new ref-view list-refs)
(and (fboundp 'lsp-ui-doc--hide-frame)
(lsp-ui-doc--hide-frame))))
(defun lsp-ui-peek--toggle-text-prop (s)
(let ((state (lsp-ui-peek--prop 'lsp-ui-peek-hidden s)))
(lsp-ui-peek--add-prop `(lsp-ui-peek-hidden ,(not state)) s)))
(defun lsp-ui-peek--toggle-hidden (file)
(setq lsp-ui-peek--list
(--map-when (string= (plist-get (lsp-ui-peek--prop 'lsp-ui-peek it) :file) file)
(prog1 it (lsp-ui-peek--toggle-text-prop it))
lsp-ui-peek--list)))
(defun lsp-ui-peek--remove-hidden (file)
(setq lsp-ui-peek--list
(--map-when (string= (plist-get (lsp-ui-peek--prop 'lsp-ui-peek it) :file) file)
(prog1 it (lsp-ui-peek--add-prop '(lsp-ui-peek-hidden nil) it))
lsp-ui-peek--list)))
(defun lsp-ui-peek--make-ref-line (xref)
(-let* (((&plist :summary summary :line line :file file) xref)
(string (format "%-3s %s"
(propertize (number-to-string (1+ line))
'face 'lsp-ui-peek-line-number)
(string-trim summary))))
(lsp-ui-peek--add-prop `(lsp-ui-peek ,xref file ,file) string)))
(defun lsp-ui-peek--insert-xrefs (xrefs filename index)
(setq lsp-ui-peek--list (--> (lsp-ui-peek--get-xrefs-in-file (cons filename xrefs))
(-map 'lsp-ui-peek--make-ref-line it)
(-insert-at (1+ index) it lsp-ui-peek--list)
(-flatten it)))
(lsp-ui-peek--add-prop '(xrefs nil)))
(defun lsp-ui-peek--toggle-file (&optional no-update)
(interactive)
(-if-let* ((xrefs (lsp-ui-peek--prop 'xrefs))
(filename (lsp-ui-peek--prop 'file))
(index (--find-index (equal (lsp-ui-peek--prop 'file it) filename)
lsp-ui-peek--list)))
(lsp-ui-peek--insert-xrefs xrefs filename index)
(let ((file (lsp-ui-peek--prop 'file)))
(lsp-ui-peek--toggle-hidden file)
(while (not (equal file (lsp-ui-peek--prop 'file)))
(lsp-ui-peek--select-prev t))))
(unless no-update
(lsp-ui-peek--peek)))
(defun lsp-ui-peek--select (index)
(setq lsp-ui-peek--selection (+ lsp-ui-peek--selection index)))
(defun lsp-ui-peek--select-next (&optional no-update)
(interactive)
(when (lsp-ui-peek--get-text-selection (1+ lsp-ui-peek--selection))
(lsp-ui-peek--select 1)
(while (> (lsp-ui-peek--visual-index) (- lsp-ui-peek-peek-height 2))
(setq lsp-ui-peek--offset (1+ lsp-ui-peek--offset)))
(unless no-update
(lsp-ui-peek--peek))))
(defun lsp-ui-peek--select-prev (&optional no-update)
(interactive)
(when (> lsp-ui-peek--selection 0)
(lsp-ui-peek--select -1)
(while (< (lsp-ui-peek--visual-index) 0)
(setq lsp-ui-peek--offset (1- lsp-ui-peek--offset))))
(unless no-update
(lsp-ui-peek--peek)))
(defun lsp-ui-peek--skip-refs (fn)
(let ((last-file (lsp-ui-peek--prop 'file))
last-selection)
(when (lsp-ui-peek--get-selection)
(while (and (equal (lsp-ui-peek--prop 'file) last-file)
(not (equal last-selection lsp-ui-peek--selection)))
(setq last-selection lsp-ui-peek--selection)
(funcall fn t)))))
(defun lsp-ui-peek--select-prev-file ()
(interactive)
(if (not (lsp-ui-peek--get-selection))
(lsp-ui-peek--select-prev)
(lsp-ui-peek--skip-refs 'lsp-ui-peek--select-prev)
(when (lsp-ui-peek--get-selection)
(lsp-ui-peek--skip-refs 'lsp-ui-peek--select-prev)
(unless (= lsp-ui-peek--selection 0)
(lsp-ui-peek--select-next t))))
(if (lsp-ui-peek--prop 'xrefs)
(lsp-ui-peek--toggle-file)
(lsp-ui-peek--remove-hidden (lsp-ui-peek--prop 'file)))
(lsp-ui-peek--select-next t)
(lsp-ui-peek--recenter)
(lsp-ui-peek--peek))
(defun lsp-ui-peek--select-next-file ()
(interactive)
(lsp-ui-peek--skip-refs 'lsp-ui-peek--select-next)
(if (lsp-ui-peek--prop 'xrefs)
(lsp-ui-peek--toggle-file)
(lsp-ui-peek--remove-hidden (lsp-ui-peek--prop 'file)))
(lsp-ui-peek--select-next t)
(lsp-ui-peek--recenter)
(lsp-ui-peek--peek))
(defun lsp-ui-peek--peek-hide ()
"Hide the chunk of code and restore previous state."
(when (overlayp lsp-ui-peek--overlay)
(delete-overlay lsp-ui-peek--overlay))
(setq lsp-ui-peek--overlay nil
lsp-ui-peek--last-xref nil)
(when lsp-ui-peek--win-start
(set-window-start (get-buffer-window) lsp-ui-peek--win-start)))
(defun lsp-ui-peek--deactivate-keymap ()
"Deactivate keymap."
(-when-let (fn lsp-ui-peek--deactivate-keymap-fn)
(setq lsp-ui-peek--deactivate-keymap-fn nil)
(funcall fn)))
(defun lsp-ui-peek--goto-xref (&optional x other-window)
"Go to a reference/definition."
(interactive)
(-if-let (xref (or x (lsp-ui-peek--get-selection)))
(-let (((&plist :file file :line line :column column) xref)
(buffer (current-buffer)))
(if (not (file-readable-p file))
(user-error "File not readable: %s" file)
(setq lsp-ui-peek--win-start nil)
(lsp-ui-peek--abort)
(let ((marker (with-current-buffer
(or (get-file-buffer file)
(find-file-noselect file))
(save-restriction
(widen)
(save-excursion
;; When we jump to a file with line/column unspecified,
;; we do not want to move the point if the buffer exists.
;; We interpret line=column=0 differently here.
(when (> (+ line column) 0)
(goto-char 1)
(forward-line line)
(forward-char column))
(point-marker)))))
(cur-buffer-workspaces (and (boundp 'lsp--buffer-workspaces) lsp--buffer-workspaces)))
(if other-window
(pop-to-buffer (marker-buffer marker) t)
(switch-to-buffer (marker-buffer marker)))
(with-current-buffer buffer
(lsp-ui-peek-mode -1))
(unless lsp--buffer-workspaces
(setq lsp--buffer-workspaces cur-buffer-workspaces)
(lsp-mode 1)
(dolist (workspace cur-buffer-workspaces)
(lsp--open-in-workspace workspace)))
(goto-char marker)
(run-hooks 'xref-after-jump-hook))))
(lsp-ui-peek--toggle-file)))
(defun lsp-ui-peek--goto-xref-other-window ()
(interactive)
(lsp-ui-peek--goto-xref nil t))
(defvar lsp-ui-peek-mode-map
(let ((map (make-sparse-keymap)))
(suppress-keymap map t)
(define-key map "\e\e\e" 'lsp-ui-peek--abort)
(define-key map "\C-g" 'lsp-ui-peek--abort)
(define-key map (kbd "M-n") 'lsp-ui-peek--select-next-file)
(define-key map (kbd "<right>") 'lsp-ui-peek--select-next-file)
(define-key map (kbd "M-p") 'lsp-ui-peek--select-prev-file)
(define-key map (kbd "<left>") 'lsp-ui-peek--select-prev-file)
(define-key map (kbd "C-n") 'lsp-ui-peek--select-next)
(define-key map (kbd "n") 'lsp-ui-peek--select-next)
(define-key map (kbd "<down>") 'lsp-ui-peek--select-next)
(define-key map (kbd "C-p") 'lsp-ui-peek--select-prev)
(define-key map (kbd "p") 'lsp-ui-peek--select-prev)
(define-key map (kbd "<up>") 'lsp-ui-peek--select-prev)
(define-key map (kbd "TAB") 'lsp-ui-peek--toggle-file)
(define-key map (kbd "<tab>") 'lsp-ui-peek--toggle-file)
(define-key map (kbd "q") 'lsp-ui-peek--abort)
(define-key map (kbd "RET") 'lsp-ui-peek--goto-xref)
(define-key map (kbd "M-RET") 'lsp-ui-peek--goto-xref-other-window)
map)
"Keymap for ‘lsp-ui-peek-mode’.")
(defun lsp-ui-peek--disable ()
"Do not call this function, call `lsp-ui-peek--abort' instead."
(when (bound-and-true-p lsp-ui-peek-mode)
(lsp-ui-peek-mode -1)
(lsp-ui-peek--peek-hide)))
(defun lsp-ui-peek--abort ()
"Abort peek."
(interactive)
;; The timer fixes https://github.com/emacs-lsp/lsp-ui/issues/33
(run-with-idle-timer 0 nil 'lsp-ui-peek--disable))
(define-minor-mode lsp-ui-peek-mode
"Mode for lsp-ui-peek."
:init-value nil
(if lsp-ui-peek-mode
(setq lsp-ui-peek--deactivate-keymap-fn (set-transient-map lsp-ui-peek-mode-map t 'lsp-ui-peek--abort))
(lsp-ui-peek--deactivate-keymap)
(lsp-ui-peek--peek-hide)))
(defun lsp-ui-peek--find-xrefs (input method param)
"Find INPUT references.
METHOD is ‘references’, ‘definitions’, `implementation` or a custom kind.
PARAM is the request params."
(setq lsp-ui-peek--method method)
(let ((xrefs (lsp-ui-peek--get-references method param)))
(unless xrefs
(user-error "Not found for: %s" input))
(xref-push-marker-stack)
(when (featurep 'evil-jumps)
(lsp-ui-peek--with-evil-jumps (evil-set-jump)))
(if (and (not lsp-ui-peek-always-show)
(not (cdr xrefs))
(= (length (plist-get (car xrefs) :xrefs)) 1))
(let ((x (car (plist-get (car xrefs) :xrefs))))
(-if-let (uri (lsp:location-uri x))
(-let (((&Range :start (&Position :line :character)) (lsp:location-range x)))
(lsp-ui-peek--goto-xref `(:file ,(lsp--uri-to-path uri) :line ,line :column ,character)))
(-let (((&Range :start (&Position :line :character)) (or (lsp:location-link-target-selection-range x)
(lsp:location-link-target-range x))))
(lsp-ui-peek--goto-xref `(:file ,(lsp--uri-to-path (lsp:location-link-target-uri x)) :line ,line :column ,character)))))
(lsp-ui-peek-mode)
(lsp-ui-peek--show xrefs))))
(defun lsp-ui-peek-find-references (&optional include-declaration extra)
"Find references to the IDENTIFIER at point."
(interactive)
(lsp-ui-peek--find-xrefs (symbol-at-point) "textDocument/references"
(append extra (lsp--make-reference-params nil include-declaration))))
(defun lsp-ui-peek-find-definitions (&optional extra)
"Find definitions to the IDENTIFIER at point."
(interactive)
(lsp-ui-peek--find-xrefs (symbol-at-point) "textDocument/definition"
(append extra (lsp--text-document-position-params))))
(defun lsp-ui-peek-find-implementation (&optional extra)
"Find implementation locations of the symbol at point."
(interactive)
(lsp-ui-peek--find-xrefs (symbol-at-point) "textDocument/implementation"
(append extra (lsp--text-document-position-params))))
(defun lsp-ui-peek-find-workspace-symbol (pattern &optional extra)
"Find symbols in the worskpace.
The symbols are found matching PATTERN."
(interactive (list (read-string "workspace/symbol: "
nil 'xref--read-pattern-history)))
(lsp-ui-peek--find-xrefs pattern "workspace/symbol"
(append extra (lsp-make-workspace-symbol-params :query pattern))))
(defun lsp-ui-peek-find-custom (method &optional extra)
"Find custom references.
KIND is a symbol to name the references (definition, reference, ..).
REQUEST is the method string to send the the language server.
EXTRA is a plist of extra parameters."
(lsp-ui-peek--find-xrefs (symbol-at-point) method
(append extra (lsp--text-document-position-params))))
(defun lsp-ui-peek--extract-chunk-from-buffer (pos start end)
"Return the chunk of code pointed to by POS (a Position object) in the current buffer.
START and END are delimiters."
(let* ((point (lsp--position-to-point pos))
(inhibit-field-text-motion t)
(line-start (1+ (- 1 (/ lsp-ui-peek-peek-height 2))))
(line-end (/ lsp-ui-peek-peek-height 2)))
(save-excursion
(goto-char point)
(let* ((before (buffer-substring (line-beginning-position line-start) (line-beginning-position)))
(line (buffer-substring (line-beginning-position) (line-end-position)))
(after (buffer-substring (line-end-position) (line-end-position line-end)))
(len (length line))
(chunk (concat before line after))
(start-in-chunk (length before)))
(when (eq lsp-ui-peek-fontify 'on-demand)
(setq chunk (lsp-ui-peek--render lsp--peek-save-major-mode chunk)))
(remove-text-properties (+ (min start len) start-in-chunk)
(+ (if (null end) len (min end len)) start-in-chunk) '(face nil)
chunk)
(add-face-text-property (+ (min start len) start-in-chunk)
(+ (if (null end) len (min end len)) start-in-chunk)
'lsp-ui-peek-highlight t chunk)
`(,(substring chunk start-in-chunk (+ start-in-chunk len)) . ,chunk)))))
(defun lsp-ui-peek--xref-make-item (filename loc)
"Return an item from FILENAME given a LOC.
LOCATION can be either a LSP Location or SymbolInformation."
;; TODO: Read more informations from SymbolInformation.
;; For now, only the location is used.
(-let* ((loc (or (lsp:symbol-information-location loc) loc))
(range (or (lsp:location-range loc)
(lsp:location-link-target-selection-range loc)
(lsp:location-link-target-range loc)))
((&Range :start pos-start :end pos-end) range)
((&Position :line start-line :character start-col) pos-start)
((&Position :line end-line :character end-col) pos-end)
((line . chunk) (lsp-ui-peek--extract-chunk-from-buffer pos-start start-col
(when (= start-line end-line) end-col))))
(list :summary (or line filename)
:chunk (or chunk filename)
:file filename
:line start-line
:column start-col)))
(defun lsp-ui-peek--fontify-buffer (filename)
(when (eq lsp-ui-peek-fontify 'always)
(unless buffer-file-name
(make-local-variable 'delay-mode-hooks)
(let ((buffer-file-name filename)
(enable-local-variables nil)
(inhibit-message t)
(delay-mode-hooks t))
(set-auto-mode)))
(font-lock-ensure)))
(defun lsp-ui-peek--get-xrefs-in-file (file)
"Return all references that contain a file.
FILE is a cons where its car is the filename and the cdr is a list of Locations
within the file. We open and/or create the file/buffer only once for all
references. The function returns a list of `ls-xref-item'."
(let* ((filename (car file))
(visiting (find-buffer-visiting filename))
(fn (lambda (loc) (lsp-ui-peek--xref-make-item filename loc))))
(setq lsp--peek-save-major-mode major-mode)
(cond
(visiting
(with-temp-buffer
(insert-buffer-substring-no-properties visiting)
(lsp-ui-peek--fontify-buffer filename)
(mapcar fn (cdr file))))
((file-readable-p filename)
(with-temp-buffer
(insert-file-contents-literally filename)
(lsp-ui-peek--fontify-buffer filename)
(mapcar fn (cdr file))))
(t (user-error "Cannot read %s" filename)))))
(defun lsp-ui-peek--get-xrefs-list (file)
"Return a list of xrefs in FILE."
(-let* (((filename . xrefs) file))
`(:file ,filename :xrefs ,xrefs :count ,(length xrefs))))
(defun lsp-ui-peek--get-references (method params)
"Get all references/definitions for the symbol under point.
Returns item(s)."
(-when-let* ((locs (lsp-request method params))
(locs (if (listp locs)
(if (symbolp (car locs))
;; A single plist was returned
(list locs)
locs)
(if (vectorp locs)
(append locs nil)
(list locs)))))
(-filter
(-lambda ((&plist :file))
(or (f-file? file)
(ignore
(lsp-log "The following file %s is missing, ignoring from the results."
file))))
(mapcar #'lsp-ui-peek--get-xrefs-list
(if (lsp:location-uri (car locs))
;; Location[]
(--group-by (lsp--uri-to-path (lsp:location-uri it)) locs)
;; LocationLink[]
(--group-by (lsp--uri-to-path (lsp:location-link-target-uri it)) locs))))))
(defvar lsp-ui-mode-map)
(defun lsp-ui-peek-enable (_enable)
(interactive)
(unless (bound-and-true-p lsp-ui-mode-map)
(user-error "Please load lsp-ui before trying to enable lsp-ui-peek")))
;; lsp-ui.el loads lsp-ui-peek.el, so we can’t ‘require’ lsp-ui.
;; FIXME: Remove this cyclic dependency.
(declare-function lsp-ui--workspace-path "lsp-ui" (path))
(declare-function evil-set-jump "ext:evil-jumps.el" (&optional pos))
(provide 'lsp-ui-peek)
;;; lsp-ui-peek.el ends here
Copy permalink