182 lines
6.6 KiB
EmacsLisp
182 lines
6.6 KiB
EmacsLisp
;;; 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
|
|
(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
|