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