lsp-lens.el (19163B)
1 ;;; lsp-lens.el --- LSP lens -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2020 emacs-lsp maintainers 4 ;; 5 ;; This program is free software; you can redistribute it and/or modify 6 ;; it under the terms of the GNU General Public License as published by 7 ;; the Free Software Foundation, either version 3 of the License, or 8 ;; (at your option) any later version. 9 10 ;; This program is distributed in the hope that it will be useful, 11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ;; GNU General Public License for more details. 14 15 ;; You should have received a copy of the GNU General Public License 16 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 17 ;; 18 ;;; Commentary: 19 ;; 20 ;; LSP lens 21 ;; 22 ;;; Code: 23 24 (require 'lsp-mode) 25 26 (defgroup lsp-lens nil 27 "LSP support for lens" 28 :prefix "lsp-lens-" 29 :group 'lsp-mode 30 :tag "LSP Lens") 31 32 (defcustom lsp-lens-debounce-interval 0.001 33 "Debounce interval for loading lenses." 34 :group 'lsp-lens 35 :type 'number) 36 37 (defcustom lsp-lens-place-position 'end-of-line 38 "The position to place lens relative to returned lens position." 39 :group 'lsp-lens 40 :type '(choice (const above-line) 41 (const end-of-line)) 42 :package-version '(lsp-mode . "8.0.0")) 43 44 (defface lsp-lens-mouse-face 45 '((t :height 0.8 :inherit link)) 46 "The face used for code lens overlays." 47 :group 'lsp-lens) 48 49 (defface lsp-lens-face 50 '((t :inherit lsp-details-face)) 51 "The face used for code lens overlays." 52 :group 'lsp-lens) 53 54 (defvar-local lsp-lens--modified? nil) 55 56 (defvar-local lsp-lens--overlays nil 57 "Current lenses.") 58 59 (defvar-local lsp-lens--page nil 60 "Pair of points which holds the last window location the lenses were loaded.") 61 62 (defvar-local lsp-lens--last-count nil 63 "The number of lenses the last time they were rendered.") 64 65 (defvar lsp-lens-backends '(lsp-lens--backend) 66 "Backends providing lenses.") 67 68 (defvar-local lsp-lens--refresh-timer nil 69 "Refresh timer for the lenses.") 70 71 (defvar-local lsp-lens--data nil 72 "Pair of points which holds the last window location the lenses were loaded.") 73 74 (defvar-local lsp-lens--backend-cache nil) 75 76 (defun lsp-lens--text-width (from to) 77 "Measure the width of the text between FROM and TO. 78 Results are meaningful only if FROM and TO are on the same line." 79 ;; `current-column' takes prettification into account 80 (- (save-excursion (goto-char to) (current-column)) 81 (save-excursion (goto-char from) (current-column)))) 82 83 (defun lsp-lens--update (ov) 84 "Redraw quick-peek overlay OV." 85 (let* ((offset (lsp-lens--text-width (save-excursion 86 (beginning-of-visual-line) 87 (point)) 88 (save-excursion 89 (beginning-of-line-text) 90 (point)))) 91 (str (if (eq 'end-of-line lsp-lens-place-position) 92 (overlay-get ov 'lsp--lens-contents) 93 (concat (make-string offset ?\s) 94 (overlay-get ov 'lsp--lens-contents))))) 95 (save-excursion 96 (goto-char (overlay-start ov)) 97 (if (eq 'end-of-line lsp-lens-place-position) 98 (overlay-put ov 'after-string (propertize (concat " " str) 'cursor t)) 99 (overlay-put ov 'before-string (concat str "\n"))) 100 (overlay-put ov 'lsp-original str)))) 101 102 (defun lsp-lens--overlay-ensure-at (pos) 103 "Find or create a lens for the line at POS." 104 (-doto (save-excursion 105 (goto-char pos) 106 (if (eq 'end-of-line lsp-lens-place-position) 107 (make-overlay (line-end-position) -1 nil t t) 108 (make-overlay (line-beginning-position) (1+ (line-end-position)) nil t t))) 109 (overlay-put 'lsp-lens t) 110 (overlay-put 'lsp-lens-position pos))) 111 112 (defun lsp-lens--show (str pos metadata) 113 "Show STR in an inline window at POS including METADATA." 114 (let ((ov (lsp-lens--overlay-ensure-at pos))) 115 (save-excursion 116 (goto-char pos) 117 (setf (overlay-get ov 'lsp--lens-contents) str) 118 (setf (overlay-get ov 'lsp--metadata) metadata) 119 (lsp-lens--update ov) 120 ov))) 121 122 (defun lsp-lens--idle-function (&optional buffer) 123 "Create idle function for buffer BUFFER." 124 (when (and (or (not buffer) (eq (current-buffer) buffer)) 125 (not (equal (cons (window-start) (window-end)) lsp-lens--page))) 126 (lsp-lens--schedule-refresh nil))) 127 128 (defun lsp-lens--overlay-matches-pos (ov pos) 129 "Check if OV is a lens covering POS." 130 (and (overlay-get ov 'lsp-lens) 131 (overlay-start ov) 132 (<= (overlay-start ov) pos) 133 (< pos (overlay-end ov)))) 134 135 (defun lsp-lens--after-save () 136 "Handler for `after-save-hook' for lens mode." 137 (lsp-lens--schedule-refresh t)) 138 139 (defun lsp-lens--schedule-refresh (&optional buffer-modified?) 140 "Call each of the backend. 141 BUFFER-MODIFIED? determines whether the buffer was modified or 142 not." 143 (-some-> lsp-lens--refresh-timer cancel-timer) 144 145 (setq lsp-lens--page (cons (window-start) (window-end))) 146 (setq lsp-lens--refresh-timer 147 (run-with-timer lsp-lens-debounce-interval 148 nil 149 #'lsp-lens-refresh 150 (or lsp-lens--modified? buffer-modified?) 151 (current-buffer)))) 152 153 (defun lsp-lens--schedule-refresh-modified () 154 "Schedule a lens refresh due to a buffer-modification. 155 See `lsp-lens--schedule-refresh' for details." 156 (lsp-lens--schedule-refresh t)) 157 158 (defun lsp-lens--keymap (command) 159 "Build the lens keymap for COMMAND." 160 (-doto (make-sparse-keymap) 161 (define-key [mouse-1] (lsp-lens--create-interactive-command command)))) 162 163 (defun lsp-lens--create-interactive-command (command?) 164 "Create an interactive COMMAND? for the lens. 165 COMMAND? shall be an `&Command' (e.g. `&CodeLens' :command?) and 166 mustn't be nil." 167 (if (functionp (lsp:command-command command?)) 168 (lsp:command-command command?) 169 (lambda () 170 (interactive) 171 (lsp--execute-command command?)))) 172 173 (defun lsp-lens--display (lenses) 174 "Show LENSES." 175 ;; rerender only if there are lenses which are not processed or if their count 176 ;; has changed(e. g. delete lens should trigger redisplay). 177 (let ((scroll-preserve-screen-position t)) 178 (setq lsp-lens--modified? nil) 179 (when (or (-any? (-lambda ((&CodeLens :_processed processed)) 180 (not processed)) 181 lenses) 182 (eq (length lenses) lsp-lens--last-count) 183 (not lenses)) 184 (setq lsp-lens--last-count (length lenses)) 185 (mapc #'delete-overlay lsp-lens--overlays) 186 (setq lsp-lens--overlays 187 (->> lenses 188 (-filter #'lsp:code-lens-command?) 189 (--map (prog1 it (lsp-put it :_processed t))) 190 (-group-by (-compose #'lsp:position-line #'lsp:range-start #'lsp:code-lens-range)) 191 (-map 192 (-lambda ((_ . lenses)) 193 (let* ((sorted (-sort (-on #'< (-compose #'lsp:position-character 194 #'lsp:range-start 195 #'lsp:code-lens-range)) 196 lenses)) 197 (data (-map 198 (-lambda ((lens &as &CodeLens 199 :command? (command &as 200 &Command :title :_face face))) 201 (propertize 202 title 203 'face (or face 'lsp-lens-face) 204 'action (lsp-lens--create-interactive-command command) 205 'pointer 'hand 206 'mouse-face 'lsp-lens-mouse-face 207 'local-map (lsp-lens--keymap command))) 208 sorted))) 209 (lsp-lens--show 210 (s-join (propertize "|" 'face 'lsp-lens-face) data) 211 (-> sorted cl-first lsp:code-lens-range lsp:range-start lsp--position-to-point) 212 data))))))))) 213 214 (defun lsp-lens-refresh (buffer-modified? &optional buffer) 215 "Refresh lenses using lenses backend. 216 BUFFER-MODIFIED? determines whether the BUFFER is modified or not." 217 (let ((buffer (or buffer (current-buffer)))) 218 (when (buffer-live-p buffer) 219 (with-current-buffer buffer 220 (dolist (backend lsp-lens-backends) 221 (funcall backend buffer-modified? 222 (lambda (lenses version) 223 (when (buffer-live-p buffer) 224 (with-current-buffer buffer 225 (lsp-lens--process backend lenses version)))))))))) 226 227 (defun lsp-lens--process (backend lenses version) 228 "Process LENSES originated from BACKEND. 229 VERSION is the version of the file. The lenses has to be 230 refreshed only when all backends have reported for the same 231 version." 232 (setq lsp-lens--data (or lsp-lens--data (make-hash-table))) 233 (puthash backend (cons version (append lenses nil)) lsp-lens--data) 234 235 (-let [backend-data (->> lsp-lens--data ht-values (-filter #'cl-rest))] 236 (when (and 237 (= (length lsp-lens-backends) (ht-size lsp-lens--data)) 238 (seq-every-p (-lambda ((version)) 239 (or (not version) (eq version lsp--cur-version))) 240 backend-data)) 241 ;; display the data only when the backends have reported data for the 242 ;; current version of the file 243 (lsp-lens--display (apply #'append (-map #'cl-rest backend-data))))) 244 version) 245 246 (lsp-defun lsp--lens-backend-not-loaded? ((&CodeLens :range 247 (&Range :start) 248 :command? 249 :_pending pending)) 250 "Return t if LENS has to be loaded." 251 (let ((window (get-buffer-window (current-buffer)))) 252 ;; (window-start/end) does not consider current window buffer if not passed manually 253 (and (< (window-start window) (lsp--position-to-point start) (window-end window)) 254 (not command?) 255 (not pending)))) 256 257 (lsp-defun lsp--lens-backend-present? ((&CodeLens :range (&Range :start) :command?)) 258 "Return t if LENS has to be loaded." 259 (or command? 260 (not (< (window-start) (lsp--position-to-point start) (window-end))))) 261 262 (defun lsp-lens--backend-fetch-missing (lenses callback file-version) 263 "Fetch LENSES without command in for the current window. 264 265 TICK is the buffer modified tick. If it does not match 266 `buffer-modified-tick' at the time of receiving the updates the 267 updates must be discarded.. 268 CALLBACK - the callback for the lenses. 269 FILE-VERSION - the version of the file." 270 (seq-each 271 (lambda (it) 272 (with-lsp-workspace (lsp-get it :_workspace) 273 (lsp-put it :_pending t) 274 (lsp-put it :_workspace nil) 275 (lsp-request-async "codeLens/resolve" it 276 (-lambda ((&CodeLens :command?)) 277 (lsp-put it :_pending nil) 278 (lsp-put it :command command?) 279 (when (seq-every-p #'lsp--lens-backend-present? lenses) 280 (funcall callback lenses file-version))) 281 :mode 'tick))) 282 (seq-filter #'lsp--lens-backend-not-loaded? lenses))) 283 284 (defun lsp-lens--backend (modified? callback) 285 "Lenses backend using `textDocument/codeLens'. 286 MODIFIED? - t when buffer is modified since the last invocation. 287 CALLBACK - callback for the lenses." 288 (when (lsp--find-workspaces-for "textDocument/codeLens") 289 (if modified? 290 (progn 291 (setq lsp-lens--backend-cache nil) 292 (lsp-request-async "textDocument/codeLens" 293 `(:textDocument (:uri ,(lsp--buffer-uri))) 294 (lambda (lenses) 295 (setq lsp-lens--backend-cache 296 (seq-mapcat 297 (-lambda ((workspace . workspace-lenses)) 298 ;; preserve the original workspace so we can later use it to resolve the lens 299 (seq-do (-rpartial #'lsp-put :_workspace workspace) workspace-lenses) 300 workspace-lenses) 301 lenses)) 302 (if (-every? #'lsp:code-lens-command? lsp-lens--backend-cache) 303 (funcall callback lsp-lens--backend-cache lsp--cur-version) 304 (lsp-lens--backend-fetch-missing lsp-lens--backend-cache callback lsp--cur-version))) 305 :error-handler #'ignore 306 :mode 'tick 307 :no-merge t 308 :cancel-token (concat (buffer-name (current-buffer)) "-lenses"))) 309 (if (-all? #'lsp--lens-backend-present? lsp-lens--backend-cache) 310 (funcall callback lsp-lens--backend-cache lsp--cur-version) 311 (lsp-lens--backend-fetch-missing lsp-lens--backend-cache callback lsp--cur-version))))) 312 313 (defun lsp-lens--refresh-buffer () 314 "Trigger lens refresh on buffer." 315 (remove-hook 'lsp-on-idle-hook #'lsp-lens--refresh-buffer t) 316 (when (bound-and-true-p lsp-lens-mode) 317 (lsp-lens-refresh t))) 318 319 (defun lsp--lens-on-refresh (workspace) 320 "Clear lens within all buffers of WORKSPACE, refreshing all workspace buffers." 321 (cl-assert (not (eq nil workspace))) 322 (->> (lsp--workspace-buffers workspace) 323 (mapc (lambda (buffer) 324 (lsp-with-current-buffer buffer 325 (if (lsp--buffer-visible-p) 326 (when (bound-and-true-p lsp-lens-mode) 327 (lsp-lens-refresh t)) 328 (progn 329 (add-hook 'lsp-on-idle-hook #'lsp-lens--refresh-buffer nil t) 330 (lsp--idle-reschedule (current-buffer))))))))) 331 332 ;;;###autoload 333 (defun lsp-lens--enable () 334 "Enable lens mode." 335 (when (and lsp-lens-enable 336 (lsp-feature? "textDocument/codeLens")) 337 (lsp-lens-mode 1))) 338 339 (defun lsp-lens--disable () 340 "Disable lens mode." 341 (lsp-lens-mode -1)) 342 343 ;;;###autoload 344 (defun lsp-lens-show () 345 "Display lenses in the buffer." 346 (interactive) 347 (->> (lsp-request "textDocument/codeLens" 348 `(:textDocument (:uri 349 ,(lsp--path-to-uri buffer-file-name)))) 350 (seq-map (-lambda ((lens &as &CodeAction :command?)) 351 (if command? 352 lens 353 (lsp-request "codeLens/resolve" lens)))) 354 lsp-lens--display)) 355 356 ;;;###autoload 357 (defun lsp-lens-hide () 358 "Delete all lenses." 359 (interactive) 360 (let ((scroll-preserve-screen-position t)) 361 (seq-do #'delete-overlay lsp-lens--overlays) 362 (setq lsp-lens--overlays nil))) 363 364 ;;;###autoload 365 (define-minor-mode lsp-lens-mode 366 "Toggle code-lens overlays." 367 :group 'lsp-lens 368 :global nil 369 :init-value nil 370 :lighter " Lens" 371 (cond 372 (lsp-lens-mode 373 (add-hook 'lsp-unconfigure-hook #'lsp-lens--disable nil t) 374 (add-hook 'lsp-configure-hook #'lsp-lens--enable nil t) 375 (add-hook 'lsp-on-idle-hook #'lsp-lens--idle-function nil t) 376 (add-hook 'lsp-on-change-hook #'lsp-lens--schedule-refresh-modified nil t) 377 (add-hook 'after-save-hook #'lsp-lens--after-save nil t) 378 (add-hook 'before-revert-hook #'lsp-lens-hide nil t) 379 (lsp-lens-refresh t)) 380 (t 381 (remove-hook 'lsp-on-idle-hook #'lsp-lens--idle-function t) 382 (remove-hook 'lsp-on-change-hook #'lsp-lens--schedule-refresh-modified t) 383 (remove-hook 'after-save-hook #'lsp-lens--after-save t) 384 (remove-hook 'before-revert-hook #'lsp-lens-hide t) 385 (when lsp-lens--refresh-timer 386 (cancel-timer lsp-lens--refresh-timer)) 387 (setq lsp-lens--refresh-timer nil) 388 (lsp-lens-hide) 389 (setq lsp-lens--last-count nil) 390 (setq lsp-lens--backend-cache nil) 391 (remove-hook 'lsp-configure-hook #'lsp-lens--enable t) 392 (remove-hook 'lsp-unconfigure-hook #'lsp-lens--disable t)))) 393 394 395 ;; avy integration 396 397 (declare-function avy-process "ext:avy" (candidates &optional overlay-fn cleanup-fn)) 398 (declare-function avy--key-to-char "ext:avy" (c)) 399 (defvar avy-action) 400 (defvar avy-style) 401 402 ;;;###autoload 403 (defun lsp-avy-lens () 404 "Click lsp lens using `avy' package." 405 (interactive) 406 (unless lsp-lens--overlays 407 (user-error "No lenses in current buffer")) 408 (let* ((avy-action 'identity) 409 (avy-style 'lsp-avy-lens) 410 (position (if (eq lsp-lens-place-position 'end-of-line) 411 'after-string 412 'before-string)) 413 (action (cl-third 414 (avy-process 415 (-mapcat 416 (lambda (overlay) 417 (-map-indexed 418 (lambda (index lens-token) 419 (list overlay index 420 (get-text-property 0 'action lens-token))) 421 (overlay-get overlay 'lsp--metadata))) 422 lsp-lens--overlays) 423 (-lambda (path ((ov index) . _win)) 424 (let* ((path (mapcar #'avy--key-to-char path)) 425 (str (propertize (string (car (last path))) 426 'face 'avy-lead-face)) 427 (old-str (overlay-get ov position)) 428 (old-str-tokens (s-split "|" old-str)) 429 (old-token (seq-elt old-str-tokens index)) 430 (tokens `(,@(-take index old-str-tokens) 431 ,(-if-let ((_ prefix suffix) 432 (s-match "\\(^[[:space:]]+\\)\\(.*\\)" old-token)) 433 (concat prefix str suffix) 434 (concat str old-token)) 435 ,@(-drop (1+ index) old-str-tokens))) 436 (new-str (s-join (propertize "|" 'face 'lsp-lens-face) tokens)) 437 (new-str (if (or (s-ends-with? "\n" new-str) 438 (eq lsp-lens-place-position 'end-of-line)) 439 new-str 440 (concat new-str "\n")))) 441 (overlay-put ov position new-str))) 442 (lambda () 443 (--map 444 (let ((original (overlay-get it 'lsp-original))) 445 (overlay-put it position 446 (if (eq lsp-lens-place-position 'end-of-line) 447 (concat " " original) 448 original))) 449 lsp-lens--overlays)))))) 450 (when action (funcall-interactively action)))) 451 452 (lsp-consistency-check lsp-lens) 453 454 (provide 'lsp-lens) 455 ;;; lsp-lens.el ends here