;;; lsp-dired.el --- `lsp-mode' diagnostics integrated into `dired' -*- lexical-binding: t -*- ;; Copyright (C) 2021 ;; Author: Alexander Miller ;; Author: Ivan Yonchovski ;; 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 . ;;; 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 (search-forward-regexp "^[[:space:]]*" (line-end-position) t) (point))) (face (lsp-dired--face-for-path file))) (when face (-doto (make-overlay bol (line-end-position)) (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