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
;; ---------------------------------- ;;
(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
;; ---------------------------------- ;;
@ -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
value cannot be found for the current mode, a \"?\" character will be displayed
alongside `tab-width'."
:group 'mood-line
:group 'mood-line-segment-indentation
:type 'boolean)
;; 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.
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
order provided)."
:group 'mood-line
be retrieved from the first variable that resolves to a value, evaluated in the
order provided."
:group 'mood-line-segment-indentation
:type '(alist :key-type symbol :value-type sexp))
;; -------------------------------------------------------------------------- ;;
@ -188,8 +196,8 @@ order provided)."
;; Segment function
;; ---------------------------------- ;;
(defun mood-line-segment-indentation--segment ()
"Display the indentation style of the current buffer."
(defun mood-line-segment-indentation ()
"Return the indentation style of the current buffer."
(let* ((mode-offset (symbol-value
(seq-some #'identity
(cdr (assoc major-mode
@ -202,8 +210,7 @@ order provided)."
tab-width)
(number-to-string (if indent-tabs-mode
tab-width
(or mode-offset tab-width))))
" ")
(or mode-offset tab-width)))))
'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>
;; 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
;; ---------------------------------- ;;
(defcustom mood-line-evil-state-alist
(defcustom mood-line-segment-modal-evil-state-alist
'((normal . ("<N>" . font-lock-variable-name-face))
(insert . ("<I>" . font-lock-string-face))
(visual . ("<V>" . font-lock-keyword-face))
@ -47,71 +55,66 @@
(motion . ("<M>" . font-lock-constant-face))
(operator . ("<O>" . font-lock-function-name-face))
(emacs . ("<E>" . font-lock-builtin-face)))
"Set the string and corresponding face for any `evil-mode' state.
The `Face' may be either a face symbol or a property list of key-value pairs
e.g. (:foreground \"red\")."
:group 'mood-line
:type '(alist
:key-type symbol
:value-type
(cons (string :tag "Display Text") (choice :tag "Face" face plist))))
"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;
e.g., (:foreground \"red\")."
:group 'mood-line-segment-modal
:type '(alist :key-type symbol
:value-type (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))
(insert . ("<I>" . font-lock-string-face))
(keypad . ("<K>" . font-lock-keyword-face))
(beacon . ("<B>" . font-lock-type-face))
(motion . ("<M>" . font-lock-constant-face)))
"Set the string and corresponding face for any `meow-mode' state.
The `Face' may be either a face symbol or a property list of key-value pairs
e.g. (:foreground \"red\")."
:group 'mood-line
:type '(alist
:key-type symbol
:value-type
(cons (string :tag "Display Text") (choice :tag "Face" face plist))))
"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;
e.g., (:foreground \"red\")."
:group 'mood-line-segment-modal
:type '(alist :key-type symbol
:value-type (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 ()
"Display the current evil-mode state."
(defun mood-line-segment-modal--evil-fn ()
"Return the current `evil-mode' 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)
'face (cdr mode-cons))
" "))))
'face (cdr mode-cons))))))
;; ---------------------------------- ;;
;; Meow segment function
;; Meow segment
;; ---------------------------------- ;;
(defun mood-line-segment-modal--meow ()
"Display the current meow-mode state."
(defun mood-line-segment-modal--meow-fn ()
"Return the current `meow-mode' state."
(when (boundp 'meow--current-state)
(let ((mode-cons (alist-get
meow--current-state
mood-line-meow-state-alist)))
(let ((mode-cons (alist-get meow--current-state
mood-line-segment-modal-meow-state-alist)))
(concat (propertize (car mode-cons)
'face (cdr mode-cons))
" "))))
'face (cdr mode-cons))))))
;; ---------------------------------- ;;
;; God segment function
;; God segment
;; ---------------------------------- ;;
(defun mood-line-segment-modal--god ()
"Indicate whether or not god-mode is active."
(defun mood-line-segment-modal--god-fn ()
"Return an indicator of whether or not `god-mode' is active."
(if (bound-and-true-p god-local-mode)
'(:propertize "<G> "
face (:inherit mood-line-status-warning))
(propertize "<G>" 'face '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.
;;
;; Features offered:
;; * Clean, minimal design
;; * Clean, informative design
;; * Customizable, modular segment format
;; * Customizable glyph sets
;; * Anzu and multiple-cursors counter
;; * Version control status indicator
;; * Custom Flycheck/Flymake indicator
;; * Lightweight with no dependencies
;; * Lazy-loaded extensions
;; * Lightweight, no dependencies
;;
;; To activate mood-line:
;; (mood-line-mode)
;;
;; For information on customizing mood-line:
;; M-x customize-group mood-line
;;; License:
;;
@ -54,7 +56,7 @@
;; ---------------------------------- ;;
(eval-when-compile
(require 'flymake))
(require 'cl-lib))
;; ---------------------------------- ;;
;; External variable defs
@ -65,31 +67,13 @@
(defvar anzu--overflow-p)
(defvar anzu--total-matched)
(defvar flycheck-current-errors)
;; ---------------------------------- ;;
;; 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 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))
(declare-function string-blank-p "subr-x")
;; -------------------------------------------------------------------------- ;;
;;
@ -160,6 +144,46 @@
(:count-separator . ?✕))
"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
@ -183,31 +207,6 @@
;; 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
"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
glyph. Glyphs used by mood-line include:
`:checker-info' | Syntax checker reports notes
`:checker-issues' | Syntax checker reports issues
`:checker-good' | Syntax checker reports no issues
`:checker-checking' | Syntax checker is running
`:checker-errored' | Syntax checker is stopped due to an error
`:checker-interrupted' | Syntax checker is paused
:checker-info | Syntax checker reports notes
:checker-issues | Syntax checker reports issues
:checker-good | Syntax checker reports no issues
:checker-checking | Syntax checker is running
:checker-errored | Syntax checker is stopped due to an error
:checker-interrupted | Syntax checker is paused
`:vc-added' | VC backend reports additions/changes
`:vc-needs-merge' | VC backend reports required merge
`:vc-needs-update' | VC backend reports upstream is ahead of local
`:vc-conflict' | VC backend reports conflict
`:vc-good' | VC backend has nothing to report
:vc-added | VC backend reports additions/changes
:vc-needs-merge | VC backend reports required merge
:vc-needs-update | VC backend reports upstream is ahead of local
:vc-conflict | VC backend reports conflict
:vc-good | VC backend has nothing to report
`:buffer-narrowed' | File-backed buffer is narrowed
`:buffer-modified' | File-backed buffer is modified
`:buffer-read-only' | File-backed buffer is read-only
:buffer-narrowed | File-backed buffer is narrowed
:buffer-modified | File-backed buffer is modified
: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
found to be missing in `mood-line-glyph-alist'."
`mood-line-glyphs-ascii' will be used as a fallback whenever a glyph is found
to be missing in `mood-line-glyph-alist'."
:group 'mood-line
:type `(alist :tag "Character map alist"
:type '(alist :tag "Character map alist"
:key-type (symbol :tag "Glyph name")
: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
;; ---------------------------------- ;;
@ -319,7 +339,10 @@ found to be missing in `mood-line-glyph-alist'."
;; 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)
"Return character from `mood-line-glyph-alist' for GLYPH.
If a character could not be found for the requested glyph, a fallback will be
returned from `mood-line-glyphs-ascii'."
(char-to-string (or (alist-get glyph
mood-line-glyph-alist)
(alist-get glyph
mood-line-glyphs-ascii))))
(char-to-string (or (alist-get glyph mood-line-glyph-alist)
(alist-get glyph mood-line-glyphs-ascii))))
(defun mood-line--format (left right)
"Format a mode line string with LEFT and RIGHT justified lists of segments.
Returned string will be padded in the center to fit `window-width'."
(let* ((left-str (string-join left))
(right-str (string-join right))
(reserve (length right-str)))
(defun mood-line--process-segments (segments)
"Process list of segments SEGMENTS, returning a string.
Segments are processed according to the rules described in the documentation
for `mood-line-format', which see."
(cl-loop with last = t
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
" "
(propertize " "
'display `((space :align-to (- right
(- 0 right-margin)
,reserve))))
'display `((space :align-to (- right (- 0 right-margin)
,(length right-str)))))
right-str)))
;; -------------------------------------------------------------------------- ;;
;;
;; Optional/lazy loaded segments
;; Optional/lazy-loaded segments
;;
;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; Indentation style
;; ---------------------------------- ;;
(defun mood-line-segment-indentation ()
"Display the indentation style of the current buffer (if enabled)."
(when mood-line-show-indentation-style
(require 'mood-line-segment-indentation)
(mood-line-segment-indentation--segment)))
(defmacro mood-line--deflazy (name)
"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)))
(module (intern (car (split-string (symbol-name name) "--")))))
`(defun ,name (&rest args)
"Not yet loaded."
(fmakunbound (quote ,name))
(require (quote ,module))
(apply (function ,name) args))))
;; ---------------------------------- ;;
;; 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 ()
"Return the correct mode line segment for the first active modal mode found.
Modal modes checked, in order: `evil-mode', `meow-mode', `god-mode'."
(cond
((bound-and-true-p evil-mode)
(require 'mood-line-segment-modal)
(mood-line-segment-modal--evil))
(mood-line-segment-modal--evil-fn))
((bound-and-true-p meow-mode)
(require 'mood-line-segment-modal)
(mood-line-segment-modal--meow))
(mood-line-segment-modal--meow-fn))
((featurep 'god-mode)
(require 'mood-line-segment-modal)
(mood-line-segment-modal--god))))
(mood-line-segment-modal--god-fn))))
;; ---------------------------------- ;;
;; 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 ()
"Display color-coded anzu status information."
"Return color-coded anzu status information."
(when (bound-and-true-p anzu--state)
(cond
((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 ()
"Display the number of active multiple-cursors."
"Return the number of active multiple-cursors."
(when (bound-and-true-p multiple-cursors-mode)
(format #("MC%s%d"
2 5 (face mood-line-status-info))
(mood-line--get-glyph :count-separator)
(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
@ -664,7 +503,7 @@ Checkers checked, in order: `flycheck', `flymake'."
(defun mood-line-segment-buffer-status ()
"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
((and (buffer-narrowed-p)
(buffer-modified-p))
@ -687,15 +526,14 @@ Checkers checked, in order: `flycheck', `flymake'."
(if (buffer-narrowed-p)
(propertize (mood-line--get-glyph :buffer-narrowed)
'face 'mood-line-buffer-status-narrowed)
" "))
" "))
" ")))
;; ---------------------------------- ;;
;; Buffer name segment
;; ---------------------------------- ;;
(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))
;; ---------------------------------- ;;
@ -703,21 +541,47 @@ Checkers checked, in order: `flycheck', `flymake'."
;; ---------------------------------- ;;
(defun mood-line-segment-cursor-position ()
"Display the position of the cursor in the current buffer."
(concat (format-mode-line "%l:%c")
(when mood-line-show-cursor-point
(propertize (format ":%d" (point))
'face 'mood-line-unimportant))
(format-mode-line " %o%% " 'mood-line-unimportant)))
"Return the position of the cursor in the current buffer."
(format-mode-line "%l:%c"))
;; ---------------------------------- ;;
;; Cursor point segment
;; ---------------------------------- ;;
(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
;; ---------------------------------- ;;
(defun mood-line-segment-eol ()
"Display the EOL type for the coding system of the current buffer."
(when (and mood-line-show-eol-style
buffer-file-coding-system)
"Return the EOL type for the coding system of the current buffer."
(when buffer-file-coding-system
(pcase (coding-system-eol-type buffer-file-coding-system)
(0 "LF")
(1 "CRLF")
@ -728,151 +592,122 @@ Checkers checked, in order: `flycheck', `flymake'."
;; ---------------------------------- ;;
(defun mood-line-segment-encoding ()
"Display the name of the coding system of the current buffer."
(when (and mood-line-show-encoding-information
buffer-file-coding-system)
(concat (let ((coding-system (coding-system-plist buffer-file-coding-system)))
"Return the name of the coding system of the current buffer."
(when buffer-file-coding-system
(let ((coding-system (coding-system-plist buffer-file-coding-system)))
(cond
((memq (plist-get coding-system :category)
'(coding-category-undecided coding-category-utf-8))
"UTF-8")
(t
(upcase (symbol-name (plist-get coding-system :name))))))
" ")))
(upcase (symbol-name (plist-get coding-system :name))))))))
;; ---------------------------------- ;;
;; Major mode segment
;; ---------------------------------- ;;
(defun mood-line-segment-major-mode ()
"Display the name of the major mode of the current buffer."
(when mood-line-show-major-mode
(concat (propertize (substring-no-properties (format-mode-line mode-name))
'face 'mood-line-major-mode)
" ")))
"Return the name of the major mode of the current buffer."
(propertize (substring-no-properties (format-mode-line mode-name))
'face 'mood-line-major-mode))
;; ---------------------------------- ;;
;; Misc. info segment
;; ---------------------------------- ;;
(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)))
(unless (string-blank-p misc-info)
(concat (propertize (string-trim misc-info)
'face 'mood-line-unimportant)
" "))))
(propertize (string-trim misc-info)
'face 'mood-line-unimportant))))
;; ---------------------------------- ;;
;; Process segment
;; ---------------------------------- ;;
(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)))
(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 ()
"Activate mood-line, installing hooks and setting `mode-line-format'."
;; Set up flycheck hooks
(add-hook 'flycheck-status-changed-functions
#'mood-line--checker-flycheck-update-segment)
(add-hook 'flycheck-mode-hook
#'mood-line--checker-flycheck-update-segment)
;; Set up flymake hooks
(advice-add 'flymake-start :after
#'mood-line--checker-flymake-update-segment)
(advice-add 'flymake--handle-report :after
#'mood-line--checker-flymake-update-segment)
;; 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)
" ")))))
;; Install hooks and advice
(cl-loop for (update-fn . hooks) in mood-line--hooks-alist
do (dolist (hook hooks)
(add-hook hook update-fn)))
(cl-loop for (update-fn . advised-fns) in mood-line--advice-alist
do (dolist (advised-fn advised-fns)
(advice-add advised-fn :after update-fn)))
;; Install configuration, backing up original values
(cl-loop for (var . new-val) in mood-line--settings-alist
when (boundp var) do (push (cons var (eval var))
mood-line--settings-backup-alist)
do (set-default (intern (symbol-name var)) new-val)))
;; ---------------------------------- ;;
;; Deactivation function
;; Deactivation
;; ---------------------------------- ;;
(defun mood-line--deactivate ()
"Deactivate mood-line, uninstalling hooks and restoring `mode-line-format'."
;; Remove flycheck hooks
(remove-hook 'flycheck-status-changed-functions
#'mood-line--checker-flycheck-update-segment)
(remove-hook 'flycheck-mode-hook
#'mood-line--checker-flycheck-update-segment)
;; Remove flymake hooks
(advice-remove 'flymake-start
#'mood-line--checker-flymake-update-segment)
(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))
;; Destroy hooks and advice
(cl-loop for (update-fn . hooks) in mood-line--hooks-alist
do (dolist (hook hooks)
(remove-hook hook update-fn)))
(cl-loop for (update-fn . advised-fns) in mood-line--advice-alist
do (dolist (advised-fn advised-fns)
(advice-remove advised-fn update-fn)))
;; Restore original configuration values
(cl-loop for (var . old-val) in mood-line--settings-backup-alist
do (set-default (intern (symbol-name var)) old-val)))
;; ---------------------------------- ;;
;; Mode definition