Restructure project

mood-line has been restructured to improve modularity and configurability
with careful attention paid to performance and overall project complexity.
This commit is contained in:
Jessie Hildebrandt 2023-11-18 20:20:29 -05:00
parent d948ba7a94
commit b41f6ba1dd
5 changed files with 665 additions and 542 deletions

View File

@ -0,0 +1,168 @@
;;; mood-line-segment-checker.el --- A checker status segment for mood-line -*- lexical-binding: t; -*-
;;
;; Author: Jessie Hildebrandt <jessieh.net>
;; Homepage: https://gitlab.com/jessieh/mood-line
;; This file is not part of GNU Emacs.
;;; Commentary:
;;
;; This segment displays the current status of any active checker.
;;; License:
;;
;; 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 2, 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;; Code:
;; -------------------------------------------------------------------------- ;;
;;
;; Byte-compiler declarations
;;
;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; Compile time requirements
;; ---------------------------------- ;;
(eval-when-compile
(require 'flymake))
;; ---------------------------------- ;;
;; External variable defs
;; ---------------------------------- ;;
(defvar flycheck-current-errors)
;; ---------------------------------- ;;
;; External function decls
;; ---------------------------------- ;;
(declare-function mood-line--get-glyph "mood-line")
(declare-function flycheck-count-errors "flycheck")
(declare-function flymake-running-backends "flymake")
(declare-function flymake-reporting-backends "flymake")
(declare-function flymake--lookup-type-property "flymake")
;; -------------------------------------------------------------------------- ;;
;;
;; Helper functions
;;
;; -------------------------------------------------------------------------- ;;
(defun mood-line-segment-checker--format-status (status error warning note)
"Format STATUS into a segment string with ERROR, WARNING, and NOTE counts."
(pcase status
('running
(format #("%s Checking"
0 11 (face mood-line-status-neutral))
(mood-line--get-glyph :checker-checking)))
('errored
(format #("%s Error"
0 2 (face mood-line-status-error))
(mood-line--get-glyph :checker-errored)))
('interrupted
(format #("%s Paused"
0 9 (face mood-line-status-neutral))
(mood-line--get-glyph :checker-interrupted)))
('finished
(cond
((> error 0)
(let ((issues (+ error warning)))
(format #("%s %s Issue%s"
0 2 (face mood-line-status-error))
(mood-line--get-glyph :checker-issues)
issues
(if (> issues 1) "s" ""))))
((> warning 0)
(format #("%s %s Issue%s"
0 2 (face mood-line-status-warning))
(mood-line--get-glyph :checker-issues)
warning
(if (> warning 1) "s" "")))
((> note 0)
(format #("%s %s Note%s"
0 2 (face mood-line-status-info))
(mood-line--get-glyph :checker-info)
note
(if (> note 1) "s" "")))
(t
(format #("%s No Issues"
0 12 (face mood-line-status-neutral))
(mood-line--get-glyph :checker-good)))))))
;; -------------------------------------------------------------------------- ;;
;;
;; Flycheck update handler
;;
;; -------------------------------------------------------------------------- ;;
(defvar-local mood-line-segment-checker--flycheck-text nil
"Mode line segment string indicating the current state of `flycheck-mode'.")
(defun mood-line-segment-checker--flycheck-update (&optional status)
"Update `mood-line-segment-checker--flycheck-text' with flycheck's STATUS."
(setq mood-line-segment-checker--flycheck-text
(let-alist (flycheck-count-errors flycheck-current-errors)
(when-let* ((valid-statuses '(finished running errored interrupted))
(status-valid (member status valid-statuses))
(error (or .error 0))
(warning (or .warning 0))
(note (or .info 0)))
(mood-line-segment-checker--format-status
status error warning note)))))
;; -------------------------------------------------------------------------- ;;
;;
;; Flymake update handler
;;
;; -------------------------------------------------------------------------- ;;
(defvar-local mood-line-segment-checker--flymake-text nil
"Mode line segment string indicating the current state of `flymake-mode'.")
(defun mood-line-segment-checker--flymake-count (type)
"Return count of current flymake reports of TYPE."
(cl-loop for diag in (flymake-diagnostics)
as diag-type = (flymake-diagnostic-type diag)
count (eq (flymake--lookup-type-property diag-type 'severity)
(flymake--lookup-type-property type 'severity))))
(defun mood-line-segment-checker--flymake-update (&rest _args)
"Update `mood-line-segment-checker--flymake-state' with flymake's status."
(setq mood-line-segment-checker--flymake-text
(when-let ((flymake-active (and (fboundp 'flymake-is-running)
(flymake-is-running)))
(status (if (seq-difference (flymake-running-backends)
(flymake-reporting-backends))
'running 'finished))
(error (mood-line-segment-checker--flymake-count :error))
(warning (mood-line-segment-checker--flymake-count :warning))
(note (mood-line-segment-checker--flymake-count :note)))
(mood-line-segment-checker--format-status
status error warning note))))
;; -------------------------------------------------------------------------- ;;
;;
;; Provide package
;;
;; -------------------------------------------------------------------------- ;;
(provide 'mood-line-segment-checker)
;;; mood-line-segment-checker.el ends here

View File

@ -39,7 +39,7 @@
;; External function decls ;; External function decls
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(declare-function mood-line--get-glyph "mood-line" (glyph)) (declare-function mood-line--get-glyph "mood-line")
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ;;
@ -47,6 +47,14 @@
;; ;;
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; Group definitions
;; ---------------------------------- ;;
(defgroup mood-line-segment-indentation nil
"An indentation info segment for mood-line."
:group 'mood-line)
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Variable definitions ;; Variable definitions
;; ---------------------------------- ;; ;; ---------------------------------- ;;
@ -62,7 +70,7 @@ When `mood-line-segment-indentation-always-show-offset' is set to non-nil, the
indentation offset will always be shown alongside `tab-width'. If an offset indentation offset will always be shown alongside `tab-width'. If an offset
value cannot be found for the current mode, a \"?\" character will be displayed value cannot be found for the current mode, a \"?\" character will be displayed
alongside `tab-width'." alongside `tab-width'."
:group 'mood-line :group 'mood-line-segment-indentation
:type 'boolean) :type 'boolean)
;; Assembled from `editorconfig-indentation-alist' and `doom-modeline-indent-alist': ;; Assembled from `editorconfig-indentation-alist' and `doom-modeline-indent-alist':
@ -173,9 +181,9 @@ alongside `tab-width'."
"Alist mapping major mode names to their respective indent offset variables. "Alist mapping major mode names to their respective indent offset variables.
When multiple variables are specified for a given mode, the offset value will When multiple variables are specified for a given mode, the offset value will
be retrieved from the first variable that resolves to a value (evaluated in the be retrieved from the first variable that resolves to a value, evaluated in the
order provided)." order provided."
:group 'mood-line :group 'mood-line-segment-indentation
:type '(alist :key-type symbol :value-type sexp)) :type '(alist :key-type symbol :value-type sexp))
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
@ -188,8 +196,8 @@ order provided)."
;; Segment function ;; Segment function
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-indentation--segment () (defun mood-line-segment-indentation ()
"Display the indentation style of the current buffer." "Return the indentation style of the current buffer."
(let* ((mode-offset (symbol-value (let* ((mode-offset (symbol-value
(seq-some #'identity (seq-some #'identity
(cdr (assoc major-mode (cdr (assoc major-mode
@ -202,8 +210,7 @@ order provided)."
tab-width) tab-width)
(number-to-string (if indent-tabs-mode (number-to-string (if indent-tabs-mode
tab-width tab-width
(or mode-offset tab-width)))) (or mode-offset tab-width)))))
" ")
'face 'mood-line-encoding))) 'face 'mood-line-encoding)))
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;

View File

@ -1,4 +1,4 @@
;;; mood-line-segment-modal.el --- A modal editing segment for mood-line -*- lexical-binding: t; -*- ;;; mood-line-segment-modal.el --- A modal editing status segment for mood-line -*- lexical-binding: t; -*-
;; ;;
;; Author: trevDev() <trev@trevdev.ca> ;; Author: trevDev() <trev@trevdev.ca>
;; Jessie Hildebrandt <jessieh.net> ;; Jessie Hildebrandt <jessieh.net>
@ -35,11 +35,19 @@
;; ;;
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; Group definitions
;; ---------------------------------- ;;
(defgroup mood-line-segment-modal nil
"A modal editing status segment for mood-line."
:group 'mood-line)
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Variable definitions ;; Variable definitions
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defcustom mood-line-evil-state-alist (defcustom mood-line-segment-modal-evil-state-alist
'((normal . ("<N>" . font-lock-variable-name-face)) '((normal . ("<N>" . font-lock-variable-name-face))
(insert . ("<I>" . font-lock-string-face)) (insert . ("<I>" . font-lock-string-face))
(visual . ("<V>" . font-lock-keyword-face)) (visual . ("<V>" . font-lock-keyword-face))
@ -47,71 +55,66 @@
(motion . ("<M>" . font-lock-constant-face)) (motion . ("<M>" . font-lock-constant-face))
(operator . ("<O>" . font-lock-function-name-face)) (operator . ("<O>" . font-lock-function-name-face))
(emacs . ("<E>" . font-lock-builtin-face))) (emacs . ("<E>" . font-lock-builtin-face)))
"Set the string and corresponding face for any `evil-mode' state. "Alist specifying indicators and faces for corresponding `evil-mode' states.
The `Face' may be either a face symbol or a property list of key-value pairs The face may be either a face symbol or a property list of key-value pairs;
e.g. (:foreground \"red\")." e.g., (:foreground \"red\")."
:group 'mood-line :group 'mood-line-segment-modal
:type '(alist :type '(alist :key-type symbol
:key-type symbol :value-type (cons (string :tag "Display text")
:value-type (choice :tag "Face" face plist))))
(cons (string :tag "Display Text") (choice :tag "Face" face plist))))
(defcustom mood-line-meow-state-alist (defcustom mood-line-segment-modal-meow-state-alist
'((normal . ("<N>" . font-lock-variable-name-face)) '((normal . ("<N>" . font-lock-variable-name-face))
(insert . ("<I>" . font-lock-string-face)) (insert . ("<I>" . font-lock-string-face))
(keypad . ("<K>" . font-lock-keyword-face)) (keypad . ("<K>" . font-lock-keyword-face))
(beacon . ("<B>" . font-lock-type-face)) (beacon . ("<B>" . font-lock-type-face))
(motion . ("<M>" . font-lock-constant-face))) (motion . ("<M>" . font-lock-constant-face)))
"Set the string and corresponding face for any `meow-mode' state. "Alist specifying indicators and faces corresponding `meow-mode' states.
The `Face' may be either a face symbol or a property list of key-value pairs The face may be either a face symbol or a property list of key-value pairs;
e.g. (:foreground \"red\")." e.g., (:foreground \"red\")."
:group 'mood-line :group 'mood-line-segment-modal
:type '(alist :type '(alist :key-type symbol
:key-type symbol :value-type (cons (string :tag "Display text")
:value-type (choice :tag "Face" face plist))))
(cons (string :tag "Display Text") (choice :tag "Face" face plist))))
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ;;
;; Modal editing segment ;; Modal editing segments
;; ;;
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Evil segment function ;; Evil segment
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-modal--evil () (defun mood-line-segment-modal--evil-fn ()
"Display the current evil-mode state." "Return the current `evil-mode' state."
(when (boundp 'evil-state) (when (boundp 'evil-state)
(let ((mode-cons (alist-get evil-state mood-line-evil-state-alist))) (let ((mode-cons (alist-get evil-state
mood-line-segment-modal-evil-state-alist)))
(concat (propertize (car mode-cons) (concat (propertize (car mode-cons)
'face (cdr mode-cons)) 'face (cdr mode-cons))))))
" "))))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Meow segment function ;; Meow segment
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-modal--meow () (defun mood-line-segment-modal--meow-fn ()
"Display the current meow-mode state." "Return the current `meow-mode' state."
(when (boundp 'meow--current-state) (when (boundp 'meow--current-state)
(let ((mode-cons (alist-get (let ((mode-cons (alist-get meow--current-state
meow--current-state mood-line-segment-modal-meow-state-alist)))
mood-line-meow-state-alist)))
(concat (propertize (car mode-cons) (concat (propertize (car mode-cons)
'face (cdr mode-cons)) 'face (cdr mode-cons))))))
" "))))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; God segment function ;; God segment
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-modal--god () (defun mood-line-segment-modal--god-fn ()
"Indicate whether or not god-mode is active." "Return an indicator of whether or not `god-mode' is active."
(if (bound-and-true-p god-local-mode) (if (bound-and-true-p god-local-mode)
'(:propertize "<G> " (propertize "<G>" 'face 'mood-line-status-warning)
face (:inherit mood-line-status-warning))
"---")) "---"))
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;

110
mood-line-segment-vc.el Normal file
View File

@ -0,0 +1,110 @@
;;; mood-line-segment-vc.el --- A vc-mode info segment for mood-line -*- lexical-binding: t; -*-
;;
;; Author: Jessie Hildebrandt <jessieh.net>
;; Homepage: https://gitlab.com/jessieh/mood-line
;; This file is not part of GNU Emacs.
;;; Commentary:
;;
;; This segment displays the current status of vc-mode.
;;; License:
;;
;; 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 2, 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; see the file COPYING. If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
;; Floor, Boston, MA 02110-1301, USA.
;;; Code:
;; -------------------------------------------------------------------------- ;;
;;
;; Byte-compiler declarations
;;
;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; External function decls
;; ---------------------------------- ;;
(declare-function mood-line--get-glyph "mood-line")
;; -------------------------------------------------------------------------- ;;
;;
;; Helper functions
;;
;; -------------------------------------------------------------------------- ;;
(defun mood-line-segment-vc--rev (vc-mode-str backend)
"Return name of current file's revision for BACKEND according to `vc-mode'.
VC-MODE-STR is expected to be the value of `vc-mode' in the current buffer."
(or (pcase backend
('Git (substring-no-properties vc-mode-str 5))
('Hg (substring-no-properties vc-mode-str 4)))
(ignore-errors
(substring (vc-working-revision buffer-file-name backend) 0 7))
"???"))
;; -------------------------------------------------------------------------- ;;
;;
;; VC segment
;;
;; -------------------------------------------------------------------------- ;;
(defvar-local mood-line-segment-vc--text nil
"Mode line segment string indicating the current state of `vc-mode'.")
(defun mood-line-segment-vc--update (&rest _args)
"Update `mood-line-segment-vc--text' against the current VCS state."
(setq mood-line-segment-vc--text
(when-let* ((vc-active (and vc-mode buffer-file-name))
(backend (vc-backend buffer-file-name))
(state (vc-state buffer-file-name))
(rev (mood-line-segment-vc--rev vc-mode backend)))
(cond
((memq state '(edited added))
(format #("%s %s"
0 2 (face mood-line-status-info))
(mood-line--get-glyph :vc-added)
rev))
((eq state 'needs-merge)
(format #("%s %s"
0 2 (face mood-line-status-warning))
(mood-line--get-glyph :vc-needs-merge)
rev))
((eq state 'needs-update)
(format #("%s %s"
0 2 (face mood-line-status-warning))
(mood-line--get-glyph :vc-needs-update)
rev))
((memq state '(removed conflict unregistered))
(format #("%s %s"
0 2 (face mood-line-status-error))
(mood-line--get-glyph :vc-conflict)
rev))
(t
(format #("%s %s"
0 5 (face mood-line-status-neutral))
(mood-line--get-glyph :vc-good)
rev))))))
;; -------------------------------------------------------------------------- ;;
;;
;; Provide package
;;
;; -------------------------------------------------------------------------- ;;
(provide 'mood-line-segment-vc)
;;; mood-line-segment-vc.el ends here

View File

@ -14,15 +14,17 @@
;; some of the features of the more advanced doom-modeline package. ;; some of the features of the more advanced doom-modeline package.
;; ;;
;; Features offered: ;; Features offered:
;; * Clean, minimal design ;; * Clean, informative design
;; * Customizable, modular segment format
;; * Customizable glyph sets ;; * Customizable glyph sets
;; * Anzu and multiple-cursors counter ;; * Lazy-loaded extensions
;; * Version control status indicator ;; * Lightweight, no dependencies
;; * Custom Flycheck/Flymake indicator
;; * Lightweight with no dependencies
;; ;;
;; To activate mood-line: ;; To activate mood-line:
;; (mood-line-mode) ;; (mood-line-mode)
;;
;; For information on customizing mood-line:
;; M-x customize-group mood-line
;;; License: ;;; License:
;; ;;
@ -54,7 +56,7 @@
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(eval-when-compile (eval-when-compile
(require 'flymake)) (require 'cl-lib))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; External variable defs ;; External variable defs
@ -65,31 +67,13 @@
(defvar anzu--overflow-p) (defvar anzu--overflow-p)
(defvar anzu--total-matched) (defvar anzu--total-matched)
(defvar flycheck-current-errors)
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; External function decls ;; External function decls
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(declare-function cl-struct-slot-value "cl-macs" (struct-type slot-name inst)) (declare-function mc/num-cursors "multiple-cursors")
(declare-function flycheck-count-errors "flycheck" (errors)) (declare-function string-blank-p "subr-x")
(declare-function flymake-running-backends "flymake" ())
(declare-function flymake-reporting-backends "flymake" ())
(declare-function flymake--lookup-type-property "flymake" (type prop &optional default))
(declare-function mood-line-segment-indentation--segment "mood-line-segment-indentation" ())
(declare-function mood-line-segment-modal--evil "mood-line-segment-modal" ())
(declare-function mood-line-segment-modal--meow "mood-line-segment-modal" ())
(declare-function mood-line-segment-modal--god "mood-line-segment-modal" ())
(declare-function mc/num-cursors "multiple-cursors" ())
(declare-function string-blank-p "subr-x" (string))
(declare-function warning-numeric-level "warnings" (level))
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ;;
@ -160,6 +144,46 @@
(:count-separator . ?✕)) (:count-separator . ?✕))
"Set of Unicode glyphs for use with mood-line.") "Set of Unicode glyphs for use with mood-line.")
(defconst mood-line-format-default
'((" "
(mood-line-segment-modal) " "
(mood-line-segment-buffer-status) " "
(mood-line-segment-buffer-name) " "
(mood-line-segment-anzu) " "
(mood-line-segment-multiple-cursors) " "
(mood-line-segment-cursor-position) " "
(mood-line-segment-scroll))
((mood-line-segment-vc) " "
(mood-line-segment-major-mode) " "
(mood-line-segment-misc-info) " "
(mood-line-segment-checker) " "
(mood-line-segment-process) " "
" "))
"Default format for mood-line.")
(defconst mood-line-format-default-extended
'((" "
(mood-line-segment-modal) " "
(mood-line-segment-buffer-status) " "
(mood-line-segment-buffer-name) " "
(mood-line-segment-anzu) " "
(mood-line-segment-multiple-cursors) " "
(mood-line-segment-cursor-position) ""
#(":" 0 1 (face mood-line-unimportant))
(mood-line-segment-cursor-point) " "
(mood-line-segment-region) " "
(mood-line-segment-scroll))
((mood-line-segment-indentation) " "
(mood-line-segment-eol) " "
(mood-line-segment-encoding) " "
(mood-line-segment-vc) " "
(mood-line-segment-major-mode) " "
(mood-line-segment-misc-info) " "
(mood-line-segment-checker) " "
(mood-line-segment-process) " "
" "))
"Extended default format for mood-line showcasing all included segments.")
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ;;
;; Custom definitions ;; Custom definitions
@ -183,31 +207,6 @@
;; Variable definitions ;; Variable definitions
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defcustom mood-line-show-indentation-style nil
"When non-nil, show the indentation style of the current buffer."
:group 'mood-line
:type 'boolean)
(defcustom mood-line-show-eol-style nil
"When non-nil, show the EOL style of the current buffer."
:group 'mood-line
:type 'boolean)
(defcustom mood-line-show-encoding-information nil
"When non-nil, show the encoding format of the current buffer."
:group 'mood-line
:type 'boolean)
(defcustom mood-line-show-cursor-point nil
"When non-nil, show the `point' value as an integer."
:group 'mood-line
:type 'boolean)
(defcustom mood-line-show-major-mode t
"When non-nil, show the name of the major mode of the current buffer."
:group 'mood-line
:type 'boolean)
(defcustom mood-line-glyph-alist mood-line-glyphs-ascii (defcustom mood-line-glyph-alist mood-line-glyphs-ascii
"Alist mapping glyph names to characters used to draw some mode line segments. "Alist mapping glyph names to characters used to draw some mode line segments.
@ -225,32 +224,53 @@ or shrink.
Keys are names for different mode line glyphs, values are characters for that Keys are names for different mode line glyphs, values are characters for that
glyph. Glyphs used by mood-line include: glyph. Glyphs used by mood-line include:
`:checker-info' | Syntax checker reports notes :checker-info | Syntax checker reports notes
`:checker-issues' | Syntax checker reports issues :checker-issues | Syntax checker reports issues
`:checker-good' | Syntax checker reports no issues :checker-good | Syntax checker reports no issues
`:checker-checking' | Syntax checker is running :checker-checking | Syntax checker is running
`:checker-errored' | Syntax checker is stopped due to an error :checker-errored | Syntax checker is stopped due to an error
`:checker-interrupted' | Syntax checker is paused :checker-interrupted | Syntax checker is paused
`:vc-added' | VC backend reports additions/changes :vc-added | VC backend reports additions/changes
`:vc-needs-merge' | VC backend reports required merge :vc-needs-merge | VC backend reports required merge
`:vc-needs-update' | VC backend reports upstream is ahead of local :vc-needs-update | VC backend reports upstream is ahead of local
`:vc-conflict' | VC backend reports conflict :vc-conflict | VC backend reports conflict
`:vc-good' | VC backend has nothing to report :vc-good | VC backend has nothing to report
`:buffer-narrowed' | File-backed buffer is narrowed :buffer-narrowed | File-backed buffer is narrowed
`:buffer-modified' | File-backed buffer is modified :buffer-modified | File-backed buffer is modified
`:buffer-read-only' | File-backed buffer is read-only :buffer-read-only | File-backed buffer is read-only
`:count-separator' | Separates some indicator names from numerical counts :count-separator | Separates some indicator names from numerical counts
`mood-line-glyphs-ascii' will be used as a fallback wherever the a glyph may be `mood-line-glyphs-ascii' will be used as a fallback whenever a glyph is found
found to be missing in `mood-line-glyph-alist'." to be missing in `mood-line-glyph-alist'."
:group 'mood-line :group 'mood-line
:type `(alist :tag "Character map alist" :type '(alist :tag "Character map alist"
:key-type (symbol :tag "Glyph name") :key-type (symbol :tag "Glyph name")
:value-type (character :tag "Character to use"))) :value-type (character :tag "Character to use")))
(defcustom mood-line-format mood-line-format-default
"List providing left and right lists of segments to format as the mode line.
The list should be of the form (L-SEGMENTS R-SEGMENTS), where L-SEGMENTS is a
list of segments to be left-aligned, and R-SEGMENTS is a list of segments to
be right-aligned. Lists are processed from first to last, and segments are
displayed from left to right.
A segment may be any expression that evaluates to a string, or nil.
Segment expressions evaluating to nil are not displayed.
When a segment evaluates to nil, the following segment will be skipped and not
processed or displayed. This behavior may be used to, e.g., conditionally
display separating whitespace after a segment.
Examples: `mood-line-format-default' and `mood-line-format-default-extended'"
:group 'mood-line
:type '(list :tag "Mode line segments"
(repeat :tag "Left side" sexp)
(repeat :tag "Right side" sexp)))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Face definitions ;; Face definitions
;; ---------------------------------- ;; ;; ---------------------------------- ;;
@ -319,7 +339,10 @@ found to be missing in `mood-line-glyph-alist'."
;; Obsolete faces ;; Obsolete faces
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(define-obsolete-face-alias 'mood-line-modified 'mood-line-buffer-status-modified "2.1.0") (define-obsolete-face-alias
'mood-line-modified
'mood-line-buffer-status-modified
"2.1.0")
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ;;
@ -329,70 +352,114 @@ found to be missing in `mood-line-glyph-alist'."
(defun mood-line--get-glyph (glyph) (defun mood-line--get-glyph (glyph)
"Return character from `mood-line-glyph-alist' for GLYPH. "Return character from `mood-line-glyph-alist' for GLYPH.
If a character could not be found for the requested glyph, a fallback will be If a character could not be found for the requested glyph, a fallback will be
returned from `mood-line-glyphs-ascii'." returned from `mood-line-glyphs-ascii'."
(char-to-string (or (alist-get glyph (char-to-string (or (alist-get glyph mood-line-glyph-alist)
mood-line-glyph-alist) (alist-get glyph mood-line-glyphs-ascii))))
(alist-get glyph
mood-line-glyphs-ascii))))
(defun mood-line--format (left right) (defun mood-line--process-segments (segments)
"Format a mode line string with LEFT and RIGHT justified lists of segments. "Process list of segments SEGMENTS, returning a string.
Returned string will be padded in the center to fit `window-width'." Segments are processed according to the rules described in the documentation
(let* ((left-str (string-join left)) for `mood-line-format', which see."
(right-str (string-join right)) (cl-loop with last = t
(reserve (length right-str))) for seg in segments
if last do (setq last (eval seg)) and concat last
else do (setq last t)))
(defun mood-line--process-format (format)
"Format and return a mode line string according to FORMAT.
Returned string is padded in the center to fit the width of the window.
Left and right segment lists of FORMAT will be processed according to the rules
described in the documentation for `mood-line-format', which see."
(let ((left-str (mood-line--process-segments (car format)))
(right-str (mood-line--process-segments (cadr format))))
(concat left-str (concat left-str
" "
(propertize " " (propertize " "
'display `((space :align-to (- right 'display `((space :align-to (- right (- 0 right-margin)
(- 0 right-margin) ,(length right-str)))))
,reserve))))
right-str))) right-str)))
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ;;
;; Optional/lazy loaded segments ;; Optional/lazy-loaded segments
;; ;;
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;; (defmacro mood-line--deflazy (name)
;; Indentation style "Define dummy function NAME to `require' its module and call actual function.
;; ---------------------------------- ;; If NAME is already bound, this does nothing."
(when-let ((not-bound (not (fboundp name)))
(defun mood-line-segment-indentation () (module (intern (car (split-string (symbol-name name) "--")))))
"Display the indentation style of the current buffer (if enabled)." `(defun ,name (&rest args)
(when mood-line-show-indentation-style "Not yet loaded."
(require 'mood-line-segment-indentation) (fmakunbound (quote ,name))
(mood-line-segment-indentation--segment))) (require (quote ,module))
(apply (function ,name) args))))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Modal editing ;; Modal editing
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(mood-line--deflazy mood-line-segment-modal--evil-fn)
(mood-line--deflazy mood-line-segment-modal--meow-fn)
(mood-line--deflazy mood-line-segment-modal--god-fn)
(defun mood-line-segment-modal () (defun mood-line-segment-modal ()
"Return the correct mode line segment for the first active modal mode found. "Return the correct mode line segment for the first active modal mode found.
Modal modes checked, in order: `evil-mode', `meow-mode', `god-mode'." Modal modes checked, in order: `evil-mode', `meow-mode', `god-mode'."
(cond (cond
((bound-and-true-p evil-mode) ((bound-and-true-p evil-mode)
(require 'mood-line-segment-modal) (mood-line-segment-modal--evil-fn))
(mood-line-segment-modal--evil))
((bound-and-true-p meow-mode) ((bound-and-true-p meow-mode)
(require 'mood-line-segment-modal) (mood-line-segment-modal--meow-fn))
(mood-line-segment-modal--meow))
((featurep 'god-mode) ((featurep 'god-mode)
(require 'mood-line-segment-modal) (mood-line-segment-modal--god-fn))))
(mood-line-segment-modal--god))))
;; ---------------------------------- ;;
;; Indentation style
;; ---------------------------------- ;;
(mood-line--deflazy mood-line-segment-indentation)
;; ---------------------------------- ;;
;; Version control
;; ---------------------------------- ;;
(mood-line--deflazy mood-line-segment-vc--update)
(defvar-local mood-line-segment-vc--text nil)
(defun mood-line-segment-vc ()
"Return color-coded version control information."
mood-line-segment-vc--text)
;; ---------------------------------- ;;
;; Checker status
;; ---------------------------------- ;;
(mood-line--deflazy mood-line-segment-checker--flycheck-update)
(mood-line--deflazy mood-line-segment-checker--flymake-update)
(defvar-local mood-line-segment-checker--flycheck-text nil)
(defvar-local mood-line-segment-checker--flymake-text nil)
(defun mood-line-segment-checker ()
"Return status information for flycheck or flymake, if active."
(cond
((bound-and-true-p flycheck-mode)
mood-line-segment-checker--flycheck-text)
((bound-and-true-p flymake-mode)
mood-line-segment-checker--flymake-text)))
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ;;
;; Anzu segment ;; anzu segment
;; ;;
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
(defun mood-line-segment-anzu () (defun mood-line-segment-anzu ()
"Display color-coded anzu status information." "Return color-coded anzu status information."
(when (bound-and-true-p anzu--state) (when (bound-and-true-p anzu--state)
(cond (cond
((eq anzu--state 'replace-query) ((eq anzu--state 'replace-query)
@ -417,241 +484,13 @@ Modal modes checked, in order: `evil-mode', `meow-mode', `god-mode'."
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
(defun mood-line-segment-multiple-cursors () (defun mood-line-segment-multiple-cursors ()
"Display the number of active multiple-cursors." "Return the number of active multiple-cursors."
(when (bound-and-true-p multiple-cursors-mode) (when (bound-and-true-p multiple-cursors-mode)
(format #("MC%s%d" (format #("MC%s%d"
2 5 (face mood-line-status-info)) 2 5 (face mood-line-status-info))
(mood-line--get-glyph :count-separator) (mood-line--get-glyph :count-separator)
(mc/num-cursors)))) (mc/num-cursors))))
;; -------------------------------------------------------------------------- ;;
;;
;; VC segment
;;
;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; Update function
;; ---------------------------------- ;;
(defvar-local mood-line--vc-text nil)
(defun mood-line--vc-update-segment (&rest _)
"Update `mood-line--vc-text' against the current VCS state."
(setq mood-line--vc-text
(when (and vc-mode
buffer-file-name)
(let* ((backend (vc-backend buffer-file-name))
(branch (substring-no-properties vc-mode
(+ (if (eq backend 'Hg) 2 3)
2)))
(state (vc-state buffer-file-name
(vc-backend buffer-file-name))))
(cond
((memq state '(edited added))
(format #("%s %s "
0 2 (face mood-line-status-info))
(mood-line--get-glyph :vc-added)
branch))
((eq state 'needs-merge)
(format #("%s %s "
0 2 (face mood-line-status-warning))
(mood-line--get-glyph :vc-needs-merge)
branch))
((eq state 'needs-update)
(format #("%s %s "
0 2 (face mood-line-status-warning))
(mood-line--get-glyph :vc-needs-update)
branch))
((memq state '(removed conflict unregistered))
(format #("%s %s "
0 2 (face mood-line-status-error))
(mood-line--get-glyph :vc-conflict)
branch))
(t
(format #("%s %s "
0 5 (face mood-line-status-neutral))
(mood-line--get-glyph :vc-good)
branch)))))))
;; ---------------------------------- ;;
;; Segment function
;; ---------------------------------- ;;
(defun mood-line-segment-vc ()
"Display color-coded version control information."
mood-line--vc-text)
;; -------------------------------------------------------------------------- ;;
;;
;; Checker segment
;;
;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; Flycheck update function
;; ---------------------------------- ;;
(defvar-local mood-line--checker-flycheck-text nil)
(defun mood-line--checker-flycheck-count-errors ()
"Return alist with count of all error types in `flycheck-current-errors'.
Counts will be returned in an alist as the `cdr' of the following keys:
`'note-count' | All notes reported by checker
`'error-count' | All errors reported by checker
`'warning-count' | All warnings reported by checker
`'issue-count' | All errors and warnings reported by checker"
(let-alist (flycheck-count-errors flycheck-current-errors)
(let ((note-count (+ (or .info 0)))
(error-count (+ (or .error 0)))
(warning-count (+ (or .warning 0))))
`((note-count . ,note-count)
(error-count . ,error-count)
(warning-count . ,warning-count)
(issue-count . ,(+ warning-count
error-count))))))
(defun mood-line--checker-flycheck-update-segment (&optional status)
"Update `mood-line--checker-flycheck-text' against provided flycheck STATUS."
(setq mood-line--checker-flycheck-text
(pcase status
('finished
(let-alist (mood-line--checker-flycheck-count-errors)
(cond
((> .error-count 0)
(format #("%s %s Issue%s "
0 2 (face mood-line-status-error))
(mood-line--get-glyph :checker-issues)
.issue-count
(if (> .issue-count 1) "s" "")))
((> .warning-count 0)
(format #("%s %s Issue%s "
0 2 (face mood-line-status-warning))
(mood-line--get-glyph :checker-issues)
.issue-count
(if (> .issue-count 1) "s" "")))
((> .note-count 0)
(format #("%s %s Note%s "
0 2 (face mood-line-status-info))
(mood-line--get-glyph :checker-info)
.note-count
(if (> .note-count 1) "s" "")))
(t
(format #("%s No Issues "
0 12 (face mood-line-status-neutral))
(mood-line--get-glyph :checker-good))))))
('running
(format #("%s Checking "
0 12 (face mood-line-status-neutral))
(mood-line--get-glyph :checker-checking)))
('errored
(propertize (concat (mood-line--get-glyph :checker-errored)
" Error ")
'face 'mood-line-status-error))
('interrupted
(propertize (concat (mood-line--get-glyph :checker-interrupted)
" Paused ")
'face 'mood-line-status-neutral))
('no-checker ""))))
;; ---------------------------------- ;;
;; Flycheck segment function
;; ---------------------------------- ;;
(defun mood-line-segment-checker-flycheck ()
"Display the current status of flycheck."
mood-line--checker-flycheck-text)
;; ---------------------------------- ;;
;; Flymake update function
;; ---------------------------------- ;;
(defvar-local mood-line--checker-flymake-text nil)
(defun mood-line--checker-flymake-count-report-type (type)
"Return count of current flymake reports of TYPE."
(let ((count 0))
(dolist (d (flymake-diagnostics))
(when (eq (flymake--lookup-type-property (flymake-diagnostic-type d) 'severity)
(flymake--lookup-type-property type 'severity))
(cl-incf count)))
count))
(defun mood-line--checker-flymake-count-errors ()
"Return alist with count of all current flymake diagnostic reports.
Counts will be returned in an alist as the cdr of the following keys:
`'note-count' | All notes reported by checker
`'error-count' | All errors reported by checker
`'warning-count' | All warnings reported by checkero
`'issue-count' | All errors and warnings reported by checker"
(let ((note-count (mood-line--checker-flymake-count-report-type :note))
(error-count (mood-line--checker-flymake-count-report-type :error))
(warning-count (mood-line--checker-flymake-count-report-type :warning)))
`((note-count . ,note-count)
(error-count . ,error-count)
(warning-count . ,warning-count)
(issue-count . ,(+ warning-count
error-count)))))
(defun mood-line--checker-flymake-update-segment (&rest _)
"Update `mood-line--checker-flymake-text' against the state of flymake."
(setq mood-line--checker-flymake-text
(when (and (fboundp 'flymake-is-running)
(flymake-is-running))
(let-alist (mood-line--checker-flymake-count-errors)
(cond
((seq-difference (flymake-running-backends)
(flymake-reporting-backends))
(format #("%s Checking "
0 12 (face mood-line-status-neutral))
(mood-line--get-glyph :checker-checking)))
((> .error-count 0)
(format #("%s %s Issue%s "
0 2 (face mood-line-status-error))
(mood-line--get-glyph :checker-issues)
.issue-count
(if (> .issue-count 1) "s" "")))
((> .warning-count 0)
(format #("%s %s Issue%s "
0 2 (face mood-line-status-warning))
(mood-line--get-glyph :checker-issues)
.issue-count
(if (> .issue-count 1) "s" "")))
((> .note-count 0)
(format #("%s %s Note%s "
0 2 (face mood-line-status-info))
(mood-line--get-glyph :checker-info)
.note-count
(if (> .note-count 1) "s" "")))
(t
(format #("%s No Issues "
0 12 (face mood-line-status-neutral))
(mood-line--get-glyph :checker-good))))))))
;; ---------------------------------- ;;
;; Flymake segment function
;; ---------------------------------- ;;
(defun mood-line-segment-checker-flymake ()
"Display the current status of flymake."
mood-line--checker-flymake-text)
;; ---------------------------------- ;;
;; Checker segment function
;; ---------------------------------- ;;
(defun mood-line-segment-checker ()
"Return the correct mode line segment for the first active checker found.
Checkers checked, in order: `flycheck', `flymake'."
(cond
((bound-and-true-p flycheck-mode)
(mood-line-segment-checker-flycheck))
((bound-and-true-p flymake-mode)
(mood-line-segment-checker-flymake))))
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ;;
;; Buffer information segments ;; Buffer information segments
@ -664,7 +503,7 @@ Checkers checked, in order: `flycheck', `flymake'."
(defun mood-line-segment-buffer-status () (defun mood-line-segment-buffer-status ()
"Return an indicator representing the status of the current buffer." "Return an indicator representing the status of the current buffer."
(concat (if (buffer-file-name (buffer-base-buffer)) (if (buffer-file-name (buffer-base-buffer))
(cond (cond
((and (buffer-narrowed-p) ((and (buffer-narrowed-p)
(buffer-modified-p)) (buffer-modified-p))
@ -687,15 +526,14 @@ Checkers checked, in order: `flycheck', `flymake'."
(if (buffer-narrowed-p) (if (buffer-narrowed-p)
(propertize (mood-line--get-glyph :buffer-narrowed) (propertize (mood-line--get-glyph :buffer-narrowed)
'face 'mood-line-buffer-status-narrowed) 'face 'mood-line-buffer-status-narrowed)
" ")) " ")))
" "))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Buffer name segment ;; Buffer name segment
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-buffer-name () (defun mood-line-segment-buffer-name ()
"Display the name of the current buffer." "Return the name of the current buffer."
(format-mode-line "%b" 'mood-line-buffer-name)) (format-mode-line "%b" 'mood-line-buffer-name))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
@ -703,21 +541,47 @@ Checkers checked, in order: `flycheck', `flymake'."
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-cursor-position () (defun mood-line-segment-cursor-position ()
"Display the position of the cursor in the current buffer." "Return the position of the cursor in the current buffer."
(concat (format-mode-line "%l:%c") (format-mode-line "%l:%c"))
(when mood-line-show-cursor-point
(propertize (format ":%d" (point)) ;; ---------------------------------- ;;
'face 'mood-line-unimportant)) ;; Cursor point segment
(format-mode-line " %o%% " 'mood-line-unimportant))) ;; ---------------------------------- ;;
(defun mood-line-segment-cursor-point ()
"Return the value of `point' in the current buffer."
(format #("%d"
0 2 (face mood-line-unimportant))
(point)))
;; ---------------------------------- ;;
;; Region segment
;; ---------------------------------- ;;
(defun mood-line-segment-region ()
"Return the size of the active region in the current buffer, if any."
(when (use-region-p)
(format #("%sL:%sC"
0 7 (face mood-line-unimportant))
(count-lines (region-beginning)
(region-end))
(- (region-end) (region-beginning)))))
;; ---------------------------------- ;;
;; Scroll segment
;; ---------------------------------- ;;
(defun mood-line-segment-scroll ()
"Return the relative position of the viewport in the current buffer."
(format-mode-line "%o%%" 'mood-line-unimportant))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; EOL segment ;; EOL segment
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-eol () (defun mood-line-segment-eol ()
"Display the EOL type for the coding system of the current buffer." "Return the EOL type for the coding system of the current buffer."
(when (and mood-line-show-eol-style (when buffer-file-coding-system
buffer-file-coding-system)
(pcase (coding-system-eol-type buffer-file-coding-system) (pcase (coding-system-eol-type buffer-file-coding-system)
(0 "LF") (0 "LF")
(1 "CRLF") (1 "CRLF")
@ -728,151 +592,122 @@ Checkers checked, in order: `flycheck', `flymake'."
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-encoding () (defun mood-line-segment-encoding ()
"Display the name of the coding system of the current buffer." "Return the name of the coding system of the current buffer."
(when (and mood-line-show-encoding-information (when buffer-file-coding-system
buffer-file-coding-system) (let ((coding-system (coding-system-plist buffer-file-coding-system)))
(concat (let ((coding-system (coding-system-plist buffer-file-coding-system)))
(cond (cond
((memq (plist-get coding-system :category) ((memq (plist-get coding-system :category)
'(coding-category-undecided coding-category-utf-8)) '(coding-category-undecided coding-category-utf-8))
"UTF-8") "UTF-8")
(t (t
(upcase (symbol-name (plist-get coding-system :name)))))) (upcase (symbol-name (plist-get coding-system :name))))))))
" ")))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Major mode segment ;; Major mode segment
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-major-mode () (defun mood-line-segment-major-mode ()
"Display the name of the major mode of the current buffer." "Return the name of the major mode of the current buffer."
(when mood-line-show-major-mode (propertize (substring-no-properties (format-mode-line mode-name))
(concat (propertize (substring-no-properties (format-mode-line mode-name)) 'face 'mood-line-major-mode))
'face 'mood-line-major-mode)
" ")))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Misc. info segment ;; Misc. info segment
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-misc-info () (defun mood-line-segment-misc-info ()
"Display the current value of `mode-line-misc-info'." "Return the current value of `mode-line-misc-info'."
(let ((misc-info (format-mode-line mode-line-misc-info))) (let ((misc-info (format-mode-line mode-line-misc-info)))
(unless (string-blank-p misc-info) (unless (string-blank-p misc-info)
(concat (propertize (string-trim misc-info) (propertize (string-trim misc-info)
'face 'mood-line-unimportant) 'face 'mood-line-unimportant))))
" "))))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Process segment ;; Process segment
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line-segment-process () (defun mood-line-segment-process ()
"Display the current value of `mode-line-process'." "Return the current value of `mode-line-process'."
(let ((process-info (format-mode-line mode-line-process))) (let ((process-info (format-mode-line mode-line-process)))
(unless (string-blank-p process-info) (unless (string-blank-p process-info)
(concat (string-trim process-info) (string-trim process-info))))
" "))))
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
;; ;;
;; mood-line-mode definition ;; mood-line-mode
;; ;;
;; -------------------------------------------------------------------------- ;; ;; -------------------------------------------------------------------------- ;;
(defvar-local mood-line--default-mode-line mode-line-format)
(defvar-local mood-line--anzu-cons-mode-line-p nil)
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Activation function ;; Configuration
;; ---------------------------------- ;;
(defconst mood-line--hooks-alist
'((mood-line-segment-checker--flycheck-update
. (flycheck-mode-hook
flycheck-status-changed-functions))
(mood-line-segment-vc--update
. (find-file-hook
after-save-hook)))
"Alist of update functions and their corresponding hooks.")
(defconst mood-line--advice-alist
'((mood-line-segment-checker--flymake-update
. (flymake-start
flymake--handle-report))
(mood-line-segment-vc--update
. (vc-refresh-state)))
"Alist of update functions and their corresponding advised functions.")
(defconst mood-line--settings-alist
'((anzu-cons-mode-line-p
. nil)
(mode-line-format
. (:eval (mood-line--process-format mood-line-format))))
"Alist providing symbol names and their desired values.
These settings are applied by `mood-line--activate' when `mood-line-mode'
is activated. The original value of each symbol will be stored in
`mood-line--settings-backup-alist' until `mood-line--deactivate' is called.")
(defvar mood-line--settings-backup-alist nil
"Alist storing symbol names and their original values.
Populated by `mood-line--activate', and emptied by `mood-line--deactivate'.")
;; ---------------------------------- ;;
;; Activation
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line--activate () (defun mood-line--activate ()
"Activate mood-line, installing hooks and setting `mode-line-format'." "Activate mood-line, installing hooks and setting `mode-line-format'."
;; Install hooks and advice
;; Set up flycheck hooks (cl-loop for (update-fn . hooks) in mood-line--hooks-alist
(add-hook 'flycheck-status-changed-functions do (dolist (hook hooks)
#'mood-line--checker-flycheck-update-segment) (add-hook hook update-fn)))
(add-hook 'flycheck-mode-hook (cl-loop for (update-fn . advised-fns) in mood-line--advice-alist
#'mood-line--checker-flycheck-update-segment) do (dolist (advised-fn advised-fns)
(advice-add advised-fn :after update-fn)))
;; Set up flymake hooks ;; Install configuration, backing up original values
(advice-add 'flymake-start :after (cl-loop for (var . new-val) in mood-line--settings-alist
#'mood-line--checker-flymake-update-segment) when (boundp var) do (push (cons var (eval var))
(advice-add 'flymake--handle-report :after mood-line--settings-backup-alist)
#'mood-line--checker-flymake-update-segment) do (set-default (intern (symbol-name var)) new-val)))
;; Set up VC hooks
(add-hook 'find-file-hook
#'mood-line--vc-update-segment)
(add-hook 'after-save-hook
#'mood-line--vc-update-segment)
(advice-add 'vc-refresh-state :after
#'mood-line--vc-update-segment)
;; Disable anzu's mode line segment setting, saving the previous
;; setting to be restored later (if present)
(when (boundp 'anzu-cons-mode-line-p)
(setq mood-line--anzu-cons-mode-line-p anzu-cons-mode-line-p))
(setq-default anzu-cons-mode-line-p nil)
;; Save previous value of `mode-line-format' to be restored later
(setq mood-line--default-mode-line mode-line-format)
;; Set new value of `mode-line-format'
(setq-default mode-line-format
'(:eval (mood-line--format
;; Left
(list " "
(mood-line-segment-modal)
(mood-line-segment-buffer-status)
(mood-line-segment-buffer-name)
(mood-line-segment-anzu)
(mood-line-segment-multiple-cursors)
(mood-line-segment-cursor-position))
;; Right
(list (mood-line-segment-indentation)
(mood-line-segment-eol)
(mood-line-segment-encoding)
(mood-line-segment-vc)
(mood-line-segment-major-mode)
(mood-line-segment-misc-info)
(mood-line-segment-checker)
(mood-line-segment-process)
" ")))))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Deactivation function ;; Deactivation
;; ---------------------------------- ;; ;; ---------------------------------- ;;
(defun mood-line--deactivate () (defun mood-line--deactivate ()
"Deactivate mood-line, uninstalling hooks and restoring `mode-line-format'." "Deactivate mood-line, uninstalling hooks and restoring `mode-line-format'."
;; Destroy hooks and advice
;; Remove flycheck hooks (cl-loop for (update-fn . hooks) in mood-line--hooks-alist
(remove-hook 'flycheck-status-changed-functions do (dolist (hook hooks)
#'mood-line--checker-flycheck-update-segment) (remove-hook hook update-fn)))
(remove-hook 'flycheck-mode-hook (cl-loop for (update-fn . advised-fns) in mood-line--advice-alist
#'mood-line--checker-flycheck-update-segment) do (dolist (advised-fn advised-fns)
(advice-remove advised-fn update-fn)))
;; Remove flymake hooks ;; Restore original configuration values
(advice-remove 'flymake-start (cl-loop for (var . old-val) in mood-line--settings-backup-alist
#'mood-line--checker-flymake-update-segment) do (set-default (intern (symbol-name var)) old-val)))
(advice-remove 'flymake--handle-report
#'mood-line--checker-flymake-update-segment)
;; Remove VC hooks
(remove-hook 'file-find-hook
#'mood-line--vc-update-segment)
(remove-hook 'after-save-hook
#'mood-line--vc-update-segment)
(advice-remove #'vc-refresh-state
#'mood-line--vc-update-segment)
;; Restore anzu's mode line segment setting
(setq-default anzu-cons-mode-line-p mood-line--anzu-cons-mode-line-p)
;; Restore the original value of `mode-line-format'
(setq-default mode-line-format mood-line--default-mode-line))
;; ---------------------------------- ;; ;; ---------------------------------- ;;
;; Mode definition ;; Mode definition