aboutsummaryrefslogtreecommitdiffstats
path: root/elpa/lsp-ui-20220425.1046/lsp-ui-sideline.el
blob: f627a6a1ff69e36735a01d76a665a7ebcb797a42 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
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