lsp-dired.el (6766B)
1 ;;; lsp-dired.el --- `lsp-mode' diagnostics integrated into `dired' -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2021 4 5 ;; Author: Alexander Miller <alexanderm@web.de> 6 ;; Author: Ivan Yonchovski <yyoncho@gmail.com> 7 8 ;; This program is free software; you can redistribute it and/or modify 9 ;; it under the terms of the GNU General Public License as published by 10 ;; the Free Software Foundation, either version 3 of the License, or 11 ;; (at your option) any later version. 12 13 ;; This program is distributed in the hope that it will be useful, 14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;; GNU General Public License for more details. 17 18 ;; You should have received a copy of the GNU General Public License 19 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 20 21 ;;; Commentary: 22 ;;; `lsp-mode' diagnostics integrated into `dired' 23 24 ;;; Code: 25 26 (require 'dired) 27 (require 'pcase) 28 (require 'lsp-mode) 29 30 (defgroup lsp-dired nil 31 "LSP support for dired" 32 :prefix "lsp-dired-" 33 :group 'lsp-mode 34 :tag "LSP Dired") 35 36 (defvar lsp-dired--ranger-adjust nil) 37 (with-eval-after-load 'ranger (setf lsp-dired--ranger-adjust t)) 38 39 (defvar-local lsp-dired-displayed nil 40 "Flags whether icons have been added.") 41 42 (defvar-local lsp-dired--covered-subdirs nil 43 "List of subdirs icons were already added for.") 44 45 (defun lsp-dired--display () 46 "Display the icons of files in a dired buffer." 47 (when (and (display-graphic-p) 48 (not lsp-dired-displayed) 49 dired-subdir-alist) 50 (setq-local lsp-dired-displayed t) 51 (pcase-dolist (`(,path . ,pos) dired-subdir-alist) 52 (lsp-dired--insert-for-subdir path pos)))) 53 54 (defun lsp-dired--insert-for-subdir (path pos) 55 "Display icons for subdir PATH at given POS." 56 (let ((buf (current-buffer))) 57 ;; run the function after current to make sure that we are creating the 58 ;; overlays after `treemacs-icons-dired' has run. 59 (run-with-idle-timer 60 0.0 nil 61 (lambda () 62 (unless (and (member path lsp-dired--covered-subdirs) 63 (not (buffer-live-p buf))) 64 (with-current-buffer buf 65 (add-to-list 'lsp-dired--covered-subdirs path) 66 (let (buffer-read-only) 67 (save-excursion 68 (goto-char pos) 69 (forward-line (if lsp-dired--ranger-adjust 1 2)) 70 (cl-block :file 71 (while (not (eobp)) 72 (if (dired-move-to-filename nil) 73 (let* ((file (dired-get-filename nil t)) 74 (bol (progn 75 (search-forward-regexp "^[[:space:]]*" (line-end-position) t) 76 (point))) 77 (face (lsp-dired--face-for-path file))) 78 (when face 79 (-doto (make-overlay bol (line-end-position)) 80 (overlay-put 'evaporate t) 81 (overlay-put 'face face)))) 82 (cl-return-from :file nil)) 83 (forward-line 1))))))))))) 84 85 (defface lsp-dired-path-face '((t :inherit font-lock-string-face)) 86 "Face used for breadcrumb paths on headerline." 87 :group 'lsp-dired) 88 89 (defface lsp-dired-path-error-face 90 '((t :underline (:style wave :color "Red1"))) 91 "Face used for breadcrumb paths on headerline when there is an error under 92 that path" 93 :group 'lsp-dired) 94 95 (defface lsp-dired-path-warning-face 96 '((t :underline (:style wave :color "Yellow"))) 97 "Face used for breadcrumb paths on headerline when there is an warning under 98 that path" 99 :group 'lsp-dired) 100 101 (defface lsp-dired-path-info-face 102 '((t :underline (:style wave :color "Green"))) 103 "Face used for breadcrumb paths on headerline when there is an info under that 104 path" 105 :group 'lsp-dired) 106 107 (defface lsp-dired-path-hint-face 108 '((t :underline (:style wave :color "Green"))) 109 "Face used for breadcrumb paths on headerline when there is an hint under that 110 path" 111 :group 'lsp-dired) 112 113 (defun lsp-dired--face-for-path (dir) 114 "Calculate the face for DIR." 115 (when-let ((diags (lsp-diagnostics-stats-for (directory-file-name dir)))) 116 (cl-labels ((check-severity 117 (severity) 118 (not (zerop (aref diags severity))))) 119 (cond 120 ((check-severity lsp/diagnostic-severity-error) 121 'lsp-dired-path-error-face) 122 ((check-severity lsp/diagnostic-severity-warning) 123 'lsp-dired-path-warning-face) 124 ((check-severity lsp/diagnostic-severity-information) 125 'lsp-dired-path-info-face) 126 ((check-severity lsp/diagnostic-severity-hint) 127 'lsp-dired-path-hint-face))))) 128 129 (defun lsp-dired--insert-subdir-advice (&rest args) 130 "Advice to dired & dired+ insert-subdir commands. 131 Will add icons for the subdir in the `car' of ARGS." 132 (let* ((path (car args)) 133 (pos (cdr (assoc path dired-subdir-alist)))) 134 (when pos 135 (lsp-dired--insert-for-subdir path pos)))) 136 137 (defun lsp-dired--kill-subdir-advice (&rest _args) 138 "Advice to dired kill-subdir commands. 139 Will remove the killed subdir from `lsp-dired--covered-subdirs'." 140 (setf lsp-dired--covered-subdirs (delete (dired-current-directory) 141 lsp-dired--covered-subdirs))) 142 143 (defun lsp-dired--reset (&rest _args) 144 "Reset metadata on revert." 145 (setq-local lsp-dired--covered-subdirs nil) 146 (setq-local lsp-dired-displayed nil)) 147 148 ;;;###autoload 149 (define-minor-mode lsp-dired-mode 150 "Display `lsp-mode' icons for each file in a dired buffer." 151 :require 'lsp-dired 152 :init-value nil 153 :global t 154 :group 'lsp-dired 155 (cond 156 (lsp-dired-mode 157 (add-hook 'dired-after-readin-hook #'lsp-dired--display) 158 (advice-add 'dired-kill-subdir :before #'lsp-dired--kill-subdir-advice) 159 (advice-add 'dired-insert-subdir :after #'lsp-dired--insert-subdir-advice) 160 (advice-add 'diredp-insert-subdirs :after #'lsp-dired--insert-subdir-advice) 161 (advice-add 'dired-revert :before #'lsp-dired--reset) 162 (dolist (buffer (buffer-list)) 163 (with-current-buffer buffer 164 (when (derived-mode-p 'dired-mode) 165 (lsp-dired--display))))) 166 (t 167 (advice-remove 'dired-kill-subdir #'lsp-dired--kill-subdir-advice) 168 (advice-remove 'dired-insert-subdir #'lsp-dired--insert-subdir-advice) 169 (advice-remove 'diredp-insert-subdirs #'lsp-dired--insert-subdir-advice) 170 (advice-remove 'dired-revert #'lsp-dired--reset) 171 (remove-hook 'dired-after-readin-hook #'lsp-dired--display) 172 (dolist (buffer (buffer-list)) 173 (with-current-buffer buffer 174 (when (derived-mode-p 'dired-mode) 175 (dired-revert))))))) 176 177 178 (lsp-consistency-check lsp-dired)(provide 'lsp-dired) 179 180 181 ;;; lsp-dired.el ends here