lsp-modeline.el (14859B)
1 ;;; lsp-modeline.el --- LSP modeline features -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2020 emacs-lsp maintainers 4 ;; 5 ;; This program is free software; you can redistribute it and/or modify 6 ;; it under the terms of the GNU General Public License as published by 7 ;; the Free Software Foundation, either version 3 of the License, or 8 ;; (at your option) any later version. 9 10 ;; This program is distributed in the hope that it will be useful, 11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ;; GNU General Public License for more details. 14 15 ;; You should have received a copy of the GNU General Public License 16 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 17 ;; 18 ;;; Commentary: 19 ;; 20 ;; LSP modeline 21 ;; 22 ;;; Code: 23 24 (require 'lsp-mode) 25 (require 'lsp-icons) 26 27 (defgroup lsp-modeline nil 28 "LSP support for modeline" 29 :prefix "lsp-modeline-" 30 :group 'lsp-mode 31 :tag "LSP Modeline") 32 33 (defcustom lsp-modeline-code-actions-kind-regex "$\\|quickfix.*\\|refactor.*" 34 "Regex for the code actions kinds to show in the modeline." 35 :type 'string 36 :group 'lsp-modeline) 37 38 (defcustom lsp-modeline-code-actions-segments '(count icon) 39 "Define what should display on the modeline when code actions are available." 40 :type '(repeat (choice 41 (const :tag "Show the lightbulb icon" icon) 42 (const :tag "Show the name of the preferred code action" name) 43 (const :tag "Show the count of how many code actions available" count))) 44 :group 'lsp-modeline 45 :package-version '(lsp-mode . "8.0.0")) 46 47 (defcustom lsp-modeline-code-action-fallback-icon "💡" 48 "Define what should display on the modeline when code actions are available." 49 :type 'string 50 :group 'lsp-modeline 51 :package-version '(lsp-mode . "8.0.0")) 52 53 (defface lsp-modeline-code-actions-face 54 '((t :inherit homoglyph)) 55 "Face used to code action text on modeline." 56 :group 'lsp-modeline) 57 58 (defface lsp-modeline-code-actions-preferred-face 59 '((t :foreground "yellow")) 60 "Face used to code action text on modeline." 61 :group 'lsp-modeline) 62 63 ;;;###autoload 64 (define-obsolete-variable-alias 'lsp-diagnostics-modeline-scope 65 'lsp-modeline-diagnostics-scope "lsp-mode 7.0.1") 66 67 (defcustom lsp-modeline-diagnostics-scope :workspace 68 "The modeline diagnostics scope." 69 :group 'lsp-modeline 70 :type '(choice (const :tag "File" :file) 71 (const :tag "Project" :workspace) 72 (const :tag "All Projects" :global)) 73 :package-version '(lsp-mode . "6.3")) 74 75 (declare-function lsp-treemacs-errors-list "ext:lsp-treemacs" t) 76 77 78 ;; code actions 79 80 (defvar-local lsp-modeline--code-actions-string nil 81 "Holds the current code action string on modeline.") 82 83 (defun lsp-modeline--code-action-face (preferred-code-action) 84 "Return the face checking if there is any PREFERRED-CODE-ACTION." 85 (if preferred-code-action 86 'lsp-modeline-code-actions-preferred-face 87 'lsp-modeline-code-actions-face)) 88 89 (defun lsp-modeline--code-action-name (actions preferred-code-action-title) 90 "Return the code action name from ACTIONS and PREFERRED-CODE-ACTION-TITLE." 91 (or preferred-code-action-title 92 (->> actions 93 lsp-seq-first 94 lsp-modeline--code-action->string))) 95 96 (defun lsp-modeline--code-action->string (action) 97 "Convert code ACTION to friendly string." 98 (->> action 99 lsp:code-action-title 100 (replace-regexp-in-string "[\n\t ]+" " "))) 101 102 (defun lsp-modeline--build-code-actions-segments (actions) 103 "Build the code ACTIONS string from the defined segments." 104 (let* ((preferred-code-action (-some->> actions 105 (-first #'lsp:code-action-is-preferred?) 106 lsp-modeline--code-action->string)) 107 (face (lsp-modeline--code-action-face preferred-code-action))) 108 (mapconcat 109 (lambda (segment) 110 (pcase segment 111 ('icon (lsp-icons-all-the-icons-icon 112 'octicon 113 "light-bulb" 114 face 115 lsp-modeline-code-action-fallback-icon 116 'modeline-code-action 117 :v-adjust -0.0575)) 118 ('name (propertize (lsp-modeline--code-action-name actions preferred-code-action) 119 'face face)) 120 ('count (propertize (number-to-string (seq-length actions)) 121 'face face)))) 122 lsp-modeline-code-actions-segments " "))) 123 124 (defun lsp-modeline--build-code-actions-string (actions) 125 "Build the string to be presented on modeline for code ACTIONS." 126 (-let* ((single-action? (= (length actions) 1)) 127 (keybinding (concat "(" 128 (-some->> #'lsp-execute-code-action 129 where-is-internal 130 (-find (lambda (o) 131 (not (member (aref o 0) '(menu-bar normal-state))))) 132 key-description) 133 ")")) 134 (built-string (lsp-modeline--build-code-actions-segments actions)) 135 (preferred-code-action (-some->> actions 136 (-first #'lsp:code-action-is-preferred?) 137 lsp-modeline--code-action->string))) 138 (add-text-properties 0 (length built-string) 139 (list 'help-echo 140 (concat (format "Apply code actions %s\nmouse-1: " keybinding) 141 (if single-action? 142 (lsp-modeline--code-action-name actions preferred-code-action) 143 "select from multiple code actions")) 144 'mouse-face 'mode-line-highlight 145 'local-map (make-mode-line-mouse-map 146 'mouse-1 (lambda () 147 (interactive) 148 (if single-action? 149 (lsp-execute-code-action (lsp-seq-first actions)) 150 (lsp-execute-code-action (lsp--select-action actions)))))) 151 built-string) 152 (unless (string= "" built-string) 153 (concat built-string " ")))) 154 155 (defun lsp--modeline-update-code-actions (actions) 156 "Update modeline with new code ACTIONS." 157 (when lsp-modeline-code-actions-kind-regex 158 (setq actions (seq-filter (-lambda ((&CodeAction :kind?)) 159 (or (not kind?) 160 (s-match lsp-modeline-code-actions-kind-regex kind?))) 161 actions))) 162 (setq lsp-modeline--code-actions-string 163 (if (seq-empty-p actions) "" 164 (lsp-modeline--build-code-actions-string actions))) 165 (force-mode-line-update)) 166 167 (defun lsp-modeline--check-code-actions (&rest _) 168 "Request code actions to update modeline for given BUFFER." 169 (when (lsp-feature? "textDocument/codeAction") 170 (lsp-request-async 171 "textDocument/codeAction" 172 (lsp--text-document-code-action-params) 173 #'lsp--modeline-update-code-actions 174 :mode 'unchanged 175 :cancel-token :lsp-modeline-code-actions))) 176 177 (defun lsp-modeline--enable-code-actions () 178 "Enable code actions on modeline mode." 179 (when (and lsp-modeline-code-actions-enable 180 (lsp-feature? "textDocument/codeAction")) 181 (lsp-modeline-code-actions-mode 1))) 182 183 (defun lsp-modeline--disable-code-actions () 184 "Disable code actions on modeline mode." 185 (lsp-modeline-code-actions-mode -1)) 186 187 ;;;###autoload 188 (define-minor-mode lsp-modeline-code-actions-mode 189 "Toggle code actions on modeline." 190 :group 'lsp-modeline 191 :global nil 192 :lighter "" 193 (cond 194 (lsp-modeline-code-actions-mode 195 (add-to-list 'global-mode-string '(t (:eval lsp-modeline--code-actions-string))) 196 197 (add-hook 'lsp-on-idle-hook 'lsp-modeline--check-code-actions nil t) 198 (add-hook 'lsp-configure-hook #'lsp-modeline--enable-code-actions nil t) 199 (add-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-code-actions nil t)) 200 (t 201 (remove-hook 'lsp-on-idle-hook 'lsp-modeline--check-code-actions t) 202 (remove-hook 'lsp-configure-hook #'lsp-modeline--enable-code-actions t) 203 (remove-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-code-actions t) 204 (setq global-mode-string (remove '(t (:eval lsp-modeline--code-actions-string)) global-mode-string))))) 205 206 207 ;; diagnostics 208 209 (defvar-local lsp-modeline--diagnostics-string nil 210 "Value of current buffer diagnostics statistics.") 211 212 (defvar lsp-modeline--diagnostics-wks->strings nil 213 "Plist of workspaces to their modeline strings. 214 The `:global' workspace is global one.") 215 216 (defun lsp-modeline-diagnostics-statistics () 217 "Calculate diagnostics statistics based on `lsp-modeline-diagnostics-scope'." 218 (let ((diagnostics (cond 219 ((equal :file lsp-modeline-diagnostics-scope) 220 (list (lsp--get-buffer-diagnostics))) 221 (t (->> (eq :workspace lsp-modeline-diagnostics-scope) 222 (lsp-diagnostics) 223 (ht-values))))) 224 (stats (make-vector lsp/diagnostic-severity-max 0)) 225 strs 226 (i 0)) 227 (mapc (lambda (buf-diags) 228 (mapc (lambda (diag) 229 (-let [(&Diagnostic? :severity?) diag] 230 (when severity? 231 (cl-incf (aref stats severity?))))) 232 buf-diags)) 233 diagnostics) 234 (while (< i lsp/diagnostic-severity-max) 235 (when (> (aref stats i) 0) 236 (setq strs 237 (nconc strs 238 `(,(propertize 239 (format "%s" (aref stats i)) 240 'face 241 (cond 242 ((= i lsp/diagnostic-severity-error) 'error) 243 ((= i lsp/diagnostic-severity-warning) 'warning) 244 ((= i lsp/diagnostic-severity-information) 'success) 245 ((= i lsp/diagnostic-severity-hint) 'success))))))) 246 (cl-incf i)) 247 (-> (s-join "/" strs) 248 (propertize 'mouse-face 'mode-line-highlight 249 'help-echo "mouse-1: Show diagnostics" 250 'local-map (when (require 'lsp-treemacs nil t) 251 (make-mode-line-mouse-map 252 'mouse-1 #'lsp-treemacs-errors-list)))))) 253 254 (defun lsp-modeline--diagnostics-reset-modeline-cache () 255 "Reset the modeline diagnostics cache." 256 (plist-put lsp-modeline--diagnostics-wks->strings (car (lsp-workspaces)) nil) 257 (plist-put lsp-modeline--diagnostics-wks->strings :global nil) 258 (setq lsp-modeline--diagnostics-string nil)) 259 260 (defun lsp-modeline--diagnostics-update-modeline () 261 "Update diagnostics modeline string." 262 (cl-labels ((calc-modeline () 263 (let ((str (lsp-modeline-diagnostics-statistics))) 264 (if (string-empty-p str) "" 265 (concat str " "))))) 266 (setq lsp-modeline--diagnostics-string 267 (cl-case lsp-modeline-diagnostics-scope 268 (:file (or lsp-modeline--diagnostics-string 269 (calc-modeline))) 270 (:workspace 271 (let ((wk (car (lsp-workspaces)))) 272 (or (plist-get lsp-modeline--diagnostics-wks->strings wk) 273 (let ((ml (calc-modeline))) 274 (setq lsp-modeline--diagnostics-wks->strings 275 (plist-put lsp-modeline--diagnostics-wks->strings wk ml)) 276 ml)))) 277 (:global 278 (or (plist-get lsp-modeline--diagnostics-wks->strings :global) 279 (let ((ml (calc-modeline))) 280 (setq lsp-modeline--diagnostics-wks->strings 281 (plist-put lsp-modeline--diagnostics-wks->strings :global ml)) 282 ml))))))) 283 284 (defun lsp-modeline--enable-diagnostics () 285 "Enable diagnostics on modeline mode." 286 (when (and lsp-modeline-diagnostics-enable 287 (lsp-feature? "textDocument/publishDiagnostics")) 288 (lsp-modeline-diagnostics-mode 1))) 289 290 (defun lsp-modeline--disable-diagnostics () 291 "Disable diagnostics on modeline mode." 292 (lsp-modeline-diagnostics-mode -1)) 293 294 ;;;###autoload 295 (define-obsolete-function-alias 'lsp-diagnostics-modeline-mode 296 'lsp-modeline-diagnostics-mode "lsp-mode 7.0.1") 297 298 ;;;###autoload 299 (define-minor-mode lsp-modeline-diagnostics-mode 300 "Toggle diagnostics modeline." 301 :group 'lsp-modeline 302 :global nil 303 :lighter "" 304 (cond 305 (lsp-modeline-diagnostics-mode 306 (add-hook 'lsp-configure-hook #'lsp-modeline--enable-diagnostics nil t) 307 (add-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-diagnostics nil t) 308 (add-to-list 'global-mode-string '(t (:eval (lsp-modeline--diagnostics-update-modeline)))) 309 (add-hook 'lsp-diagnostics-updated-hook 'lsp-modeline--diagnostics-reset-modeline-cache)) 310 (t 311 (remove-hook 'lsp-configure-hook #'lsp-modeline--enable-diagnostics t) 312 (remove-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-diagnostics t) 313 (remove-hook 'lsp-diagnostics-updated-hook 'lsp-modeline--diagnostics-reset-modeline-cache) 314 (setq global-mode-string (remove '(t (:eval (lsp-modeline--diagnostics-update-modeline))) global-mode-string))))) 315 316 317 ;; workspace status 318 319 (defun lsp-modeline--workspace-status-string () 320 "Build the workspace status string." 321 '(t (:eval (-keep #'lsp--workspace-status-string (lsp-workspaces))))) 322 323 (defun lsp-modeline--enable-workspace-status () 324 "Enable workspace status on modeline." 325 (let ((status (lsp-modeline--workspace-status-string))) 326 (setq-local global-mode-string (if (-contains? global-mode-string status) 327 global-mode-string 328 (cons status global-mode-string))))) 329 330 (defun lsp-modeline--disable-workspace-status () 331 "Disable workspace status on modeline." 332 (let ((status (lsp-modeline--workspace-status-string))) 333 (setq-local global-mode-string (remove status global-mode-string)))) 334 335 ;;;###autoload 336 (define-minor-mode lsp-modeline-workspace-status-mode 337 "Toggle workspace status on modeline." 338 :group 'lsp-modeline 339 :global nil 340 :lighter "" 341 (cond 342 (lsp-modeline-workspace-status-mode 343 (add-hook 'lsp-configure-hook #'lsp-modeline--enable-workspace-status nil t) 344 (add-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-workspace-status nil t)) 345 (t 346 (remove-hook 'lsp-configure-hook #'lsp-modeline--enable-workspace-status t) 347 (remove-hook 'lsp-unconfigure-hook #'lsp-modeline--disable-workspace-status t)))) 348 349 (lsp-consistency-check lsp-modeline) 350 351 (provide 'lsp-modeline) 352 ;;; lsp-modeline.el ends here