blob: 8b84af7d72d4ebc32e5e8ca4b70f0505f74e8387 (
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
|
;;; lsp-dired.el --- `lsp-mode' diagnostics integrated into `dired' -*- lexical-binding: t -*-
;; Copyright (C) 2021
;; Author: Alexander Miller <alexanderm@web.de>
;; Author: Ivan Yonchovski <yyoncho@gmail.com>
;; 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 of the License, 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. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; `lsp-mode' diagnostics integrated into `dired'
;;; Code:
(require 'dired)
(require 'pcase)
(require 'lsp-mode)
(defgroup lsp-dired nil
"LSP support for dired"
:prefix "lsp-dired-"
:group 'lsp-mode
:tag "LSP Dired")
(defvar lsp-dired--ranger-adjust nil)
(with-eval-after-load 'ranger (setf lsp-dired--ranger-adjust t))
(defvar-local lsp-dired-displayed nil
"Flags whether icons have been added.")
(defvar-local lsp-dired--covered-subdirs nil
"List of subdirs icons were already added for.")
(defun lsp-dired--display ()
"Display the icons of files in a dired buffer."
(when (and (display-graphic-p)
(not lsp-dired-displayed)
dired-subdir-alist)
(setq-local lsp-dired-displayed t)
(pcase-dolist (`(,path . ,pos) dired-subdir-alist)
(lsp-dired--insert-for-subdir path pos))))
(defun lsp-dired--insert-for-subdir (path pos)
"Display icons for subdir PATH at given POS."
(let ((buf (current-buffer)))
;; run the function after current to make sure that we are creating the
;; overlays after `treemacs-icons-dired' has run.
(run-with-idle-timer
0.0 nil
(lambda ()
(unless (and (member path lsp-dired--covered-subdirs)
(not (buffer-live-p buf)))
(with-current-buffer buf
(add-to-list 'lsp-dired--covered-subdirs path)
(let (buffer-read-only)
(save-excursion
(goto-char pos)
(forward-line (if lsp-dired--ranger-adjust 1 2))
(cl-block :file
(while (not (eobp))
(if (dired-move-to-filename nil)
(let* ((file (dired-get-filename nil t))
(bol (progn
(point-at-bol)
(search-forward-regexp "^[[:space:]]*" (line-end-position) t)
(point)))
(face (lsp-dired--face-for-path file)))
(when face
(-doto (make-overlay bol (point-at-eol))
(overlay-put 'evaporate t)
(overlay-put 'face face))))
(cl-return-from :file nil))
(forward-line 1)))))))))))
(defface lsp-dired-path-face '((t :inherit font-lock-string-face))
"Face used for breadcrumb paths on headerline."
:group 'lsp-dired)
(defface lsp-dired-path-error-face
'((t :underline (:style wave :color "Red1")))
"Face used for breadcrumb paths on headerline when there is an error under that path"
:group 'lsp-dired)
(defface lsp-dired-path-warning-face
'((t :underline (:style wave :color "Yellow")))
"Face used for breadcrumb paths on headerline when there is an warning under that path"
:group 'lsp-dired)
(defface lsp-dired-path-info-face
'((t :underline (:style wave :color "Green")))
"Face used for breadcrumb paths on headerline when there is an info under that path"
:group 'lsp-dired)
(defface lsp-dired-path-hint-face
'((t :underline (:style wave :color "Green")))
"Face used for breadcrumb paths on headerline when there is an hint under that path"
:group 'lsp-dired)
(defun lsp-dired--face-for-path (dir)
"Calculate the face for DIR."
(when-let ((diags (lsp-diagnostics-stats-for (directory-file-name dir))))
(cl-labels ((check-severity
(severity)
(not (zerop (aref diags severity)))))
(cond
((check-severity lsp/diagnostic-severity-error)
'lsp-dired-path-error-face)
((check-severity lsp/diagnostic-severity-warning)
'lsp-dired-path-warning-face)
((check-severity lsp/diagnostic-severity-information)
'lsp-dired-path-info-face)
((check-severity lsp/diagnostic-severity-hint)
'lsp-dired-path-hint-face)))))
(defun lsp-dired--insert-subdir-advice (&rest args)
"Advice to dired & dired+ insert-subdir commands.
Will add icons for the subdir in the `car' of ARGS."
(let* ((path (car args))
(pos (cdr (assoc path dired-subdir-alist))))
(when pos
(lsp-dired--insert-for-subdir path pos))))
(defun lsp-dired--kill-subdir-advice (&rest _args)
"Advice to dired kill-subdir commands.
Will remove the killed subdir from `lsp-dired--covered-subdirs'."
(setf lsp-dired--covered-subdirs (delete (dired-current-directory)
lsp-dired--covered-subdirs)))
(defun lsp-dired--reset (&rest _args)
"Reset metadata on revert."
(setq-local lsp-dired--covered-subdirs nil)
(setq-local lsp-dired-displayed nil))
;;;###autoload
(define-minor-mode lsp-dired-mode
"Display `lsp-mode' icons for each file in a dired buffer."
:require 'lsp-dired
:init-value nil
:global t
:group 'lsp-dired
(cond
(lsp-dired-mode
(add-hook 'dired-after-readin-hook #'lsp-dired--display)
(advice-add 'dired-kill-subdir :before #'lsp-dired--kill-subdir-advice)
(advice-add 'dired-insert-subdir :after #'lsp-dired--insert-subdir-advice)
(advice-add 'diredp-insert-subdirs :after #'lsp-dired--insert-subdir-advice)
(advice-add 'dired-revert :before #'lsp-dired--reset)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (derived-mode-p 'dired-mode)
(lsp-dired--display)))))
(t
(advice-remove 'dired-kill-subdir #'lsp-dired--kill-subdir-advice)
(advice-remove 'dired-insert-subdir #'lsp-dired--insert-subdir-advice)
(advice-remove 'diredp-insert-subdirs #'lsp-dired--insert-subdir-advice)
(advice-remove 'dired-revert #'lsp-dired--reset)
(remove-hook 'dired-after-readin-hook #'lsp-dired--display)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (derived-mode-p 'dired-mode)
(dired-revert)))))))
(lsp-consistency-check lsp-dired)(provide 'lsp-dired)
;;; lsp-dired.el ends here
|
