Ruslan Bekenev
f14c6da457
This change should help mood-line to update displayed vs status when branch is switched using vc-switch-branch
820 lines
28 KiB
EmacsLisp
820 lines
28 KiB
EmacsLisp
;;; mood-line.el --- A minimal mode line inspired by doom-modeline -*- lexical-binding: t; -*-
|
||
;;
|
||
;; Author: Jessie Hildebrandt <jessieh.net>
|
||
;; Homepage: https://gitlab.com/jessieh/mood-line
|
||
;; Keywords: mode-line faces
|
||
;; Version: 3.1.0
|
||
;; Package-Requires: ((emacs "26.1"))
|
||
;;
|
||
;; This file is not part of GNU Emacs.
|
||
|
||
;;; Commentary:
|
||
;;
|
||
;; mood-line is a lightweight, drop-in replacement for the default mode line.
|
||
;;
|
||
;; Features offered:
|
||
;; * Clean, informative design
|
||
;; * Customizable, modular segment format
|
||
;; * Customizable glyph sets
|
||
;; * 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:
|
||
;;
|
||
;; 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
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
;; ---------------------------------- ;;
|
||
;; Required features
|
||
;; ---------------------------------- ;;
|
||
|
||
(eval-when-compile
|
||
(require 'cl-lib))
|
||
|
||
;; ---------------------------------- ;;
|
||
;; External variable defs
|
||
;; ---------------------------------- ;;
|
||
|
||
(eval-when-compile
|
||
(defvar anzu--cached-count)
|
||
(defvar anzu--current-position)
|
||
(defvar anzu--overflow-p)
|
||
(defvar anzu--total-matched))
|
||
|
||
;; ---------------------------------- ;;
|
||
;; External function decls
|
||
;; ---------------------------------- ;;
|
||
|
||
(eval-when-compile
|
||
(declare-function mc/num-cursors "multiple-cursors")
|
||
(declare-function string-blank-p "subr-x"))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; Macros
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
(defmacro mood-line--deflazy (name)
|
||
"Define dummy function NAME to `require' its module and call actual function."
|
||
(let ((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))))
|
||
|
||
(defmacro mood-line-defformat (&rest spec)
|
||
"Format :left and :right segment lists of plist SPEC for `mood-line-format'.
|
||
|
||
A segment may be a string, a cons cell of the form (FUNCTION . SEPARATOR),
|
||
or any expression that evaluates to a string or nil.
|
||
|
||
Strings will be collected into the format sequence unaltered.
|
||
|
||
Cons cells of the form (FUNCTION . SEPARATOR) will expand into the format
|
||
sequence as FUNCTION, followed by SEPARATOR.
|
||
|
||
All other expressions will expand into the format sequence unaltered,
|
||
followed by an empty string. This prevents accidental elision of the
|
||
following segment should the expression evaluate to nil.
|
||
|
||
An optional key :padding may be provided, the value of which will be used as
|
||
the padding for either side of the mode line. If :padding is nil, \"\s\" will
|
||
be used as a default."
|
||
(let* ((padding (or (plist-get spec :padding) "\s"))
|
||
(left (append (list padding) (plist-get spec :left)))
|
||
(right (append (plist-get spec :right) (list padding))))
|
||
`(quote ,(mapcar
|
||
(lambda (segments)
|
||
(cl-loop for seg in segments
|
||
if (nlistp (cdr-safe seg)) append (list (car seg)
|
||
(cdr seg))
|
||
else if (stringp seg) collect seg
|
||
else append (list seg "")))
|
||
(list left right)))))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; Constants
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
(defconst mood-line-glyphs-ascii
|
||
'((:checker-info . ?i)
|
||
(:checker-issues . ?+)
|
||
(:checker-good . ?-)
|
||
(:checker-checking . ?~)
|
||
(:checker-errored . ?x)
|
||
(:checker-interrupted . ?=)
|
||
|
||
(:vc-added . ?+)
|
||
(:vc-needs-merge . ?>)
|
||
(:vc-needs-update . ?v)
|
||
(:vc-conflict . ?x)
|
||
(:vc-good . ?-)
|
||
|
||
(:buffer-narrowed . ?v)
|
||
(:buffer-modified . ?*)
|
||
(:buffer-read-only . ?#)
|
||
|
||
(:frame-client . ?@)
|
||
|
||
(:count-separator . ?*))
|
||
"Set of ASCII glyphs for use with mood-line.")
|
||
|
||
(defconst mood-line-glyphs-fira-code
|
||
'((:checker-info . ?↳)
|
||
(:checker-issues . ?→)
|
||
(:checker-good . ?✓)
|
||
(:checker-checking . ?⟳)
|
||
(:checker-errored . ?x)
|
||
(:checker-interrupted . ?=)
|
||
|
||
(:vc-added . ?+)
|
||
(:vc-needs-merge . ?⟷)
|
||
(:vc-needs-update . ?↓)
|
||
(:vc-conflict . ?x)
|
||
(:vc-good . ?✓)
|
||
|
||
(:buffer-narrowed . ?◢)
|
||
(:buffer-modified . ?●)
|
||
(:buffer-read-only . ?■)
|
||
|
||
(:frame-client . ?)
|
||
|
||
(:count-separator . ?×))
|
||
"Set of Fira Code-compatible glyphs for use with mood-line.")
|
||
|
||
(defconst mood-line-glyphs-unicode
|
||
'((:checker-info . ?🛈)
|
||
(:checker-issues . ?⚑)
|
||
(:checker-good . ?✔)
|
||
(:checker-checking . ?🗘)
|
||
(:checker-errored . ?✖)
|
||
(:checker-interrupted . ?⏸)
|
||
|
||
(:vc-added . ?🞤)
|
||
(:vc-needs-merge . ?⟷)
|
||
(:vc-needs-update . ?↓)
|
||
(:vc-conflict . ?✖)
|
||
(:vc-good . ?✔)
|
||
|
||
(:buffer-narrowed . ?▼)
|
||
(:buffer-modified . ?●)
|
||
(:buffer-read-only . ?■)
|
||
|
||
(:frame-client . ?⇅)
|
||
|
||
(:count-separator . ?✕))
|
||
"Set of Unicode glyphs for use with mood-line.")
|
||
|
||
(defconst mood-line-format-default
|
||
(mood-line-defformat
|
||
:left
|
||
(((mood-line-segment-modal) . " ")
|
||
((or (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))
|
||
:right
|
||
(((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-defformat
|
||
:left
|
||
(((mood-line-segment-modal) . " ")
|
||
((or (mood-line-segment-buffer-status)
|
||
(mood-line-segment-client)
|
||
" ") . " ")
|
||
((mood-line-segment-project) . "/")
|
||
((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))
|
||
:right
|
||
(((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
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
;; ---------------------------------- ;;
|
||
;; Group definitions
|
||
;; ---------------------------------- ;;
|
||
|
||
(defgroup mood-line nil
|
||
"A minimal mode line configuration."
|
||
:group 'mode-line)
|
||
|
||
(defgroup mood-line-faces nil
|
||
"Faces used by mood-line."
|
||
:group 'mood-line
|
||
:group 'faces)
|
||
|
||
;; ---------------------------------- ;;
|
||
;; Variable definitions
|
||
;; ---------------------------------- ;;
|
||
|
||
(defcustom mood-line-glyph-alist mood-line-glyphs-ascii
|
||
"Alist mapping glyph names to characters used to draw some mode line segments.
|
||
|
||
mood-line includes several sets of glyphs by default:
|
||
|
||
`mood-line-glyphs-ascii' | Basic ASCII character glyphs
|
||
`mood-line-glyphs-fira-code' | Fira Code-compatible glyphs
|
||
`mood-line-glyphs-unicode' | Fancy unicode glyphs
|
||
|
||
Note that if a character provided by a glyph set is not included in your default
|
||
font, the editor will render it with a fallback font. If your fallback font is
|
||
not the same height as your default font, the mode line may unexpectedly grow
|
||
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
|
||
|
||
: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
|
||
|
||
:frame-client | Frame is a client for an Emacs daemon
|
||
|
||
:count-separator | Separates some indicator names from numerical counts
|
||
|
||
`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"
|
||
: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'
|
||
|
||
See `mood-line-defformat' for a helpful formatting macro."
|
||
:group 'mood-line
|
||
:type '(list :tag "Mode line segments"
|
||
(repeat :tag "Left side" sexp)
|
||
(repeat :tag "Right side" sexp)))
|
||
|
||
;; ---------------------------------- ;;
|
||
;; Face definitions
|
||
;; ---------------------------------- ;;
|
||
|
||
(defface mood-line-buffer-name
|
||
'((t (:inherit mode-line-buffer-id)))
|
||
"Face used for displaying the value of `buffer-name'."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-buffer-status-modified
|
||
'((t (:inherit error :weight normal)))
|
||
"Face used for the ':buffer-modified' buffer status indicator."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-buffer-status-read-only
|
||
'((t (:inherit shadow :weight normal)))
|
||
"Face used for the ':buffer-read-only' buffer status indicator."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-buffer-status-narrowed
|
||
'((t (:inherit font-lock-doc-face :weight normal)))
|
||
"Face used for the ':buffer-narrowed' buffer status indicator."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-frame-status-client
|
||
'((t (:inherit mood-line-unimportant)))
|
||
"Face used for the :frame-client frame status indicator.")
|
||
|
||
(defface mood-line-major-mode
|
||
'((t (:inherit bold)))
|
||
"Face used for the major mode indicator."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-status-neutral
|
||
'((t (:inherit mood-line-unimportant)))
|
||
"Face used for neutral or inactive status indicators."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-status-info
|
||
'((t (:inherit font-lock-keyword-face :weight normal)))
|
||
"Face used for generic status indicators."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-status-success
|
||
'((t (:inherit success :weight normal)))
|
||
"Face used for success status indicators."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-status-warning
|
||
'((t (:inherit warning :weight normal)))
|
||
"Face for warning status indicators."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-status-error
|
||
'((t (:inherit error :weight normal)))
|
||
"Face for error status indicators."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-encoding
|
||
'((t (:inherit mood-line-unimportant)))
|
||
"Face used for buffer/file encoding information."
|
||
:group 'mood-line-faces)
|
||
|
||
(defface mood-line-unimportant
|
||
'((t (:inherit shadow :weight normal)))
|
||
"Face used for less important mode line elements."
|
||
:group 'mood-line-faces)
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; Helper functions
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
(defvar mood-line--escape-buffer (get-buffer-create " *mood-line*")
|
||
"Buffer used by `mood-line--escape'.")
|
||
|
||
(defun mood-line--escape (&rest strings)
|
||
"Escape all mode line constructs in STRINGS."
|
||
(with-current-buffer mood-line--escape-buffer
|
||
(erase-buffer)
|
||
(apply #'insert strings)
|
||
(while (search-backward "%" nil t)
|
||
(goto-char (match-beginning 0))
|
||
(insert-char ?% 1 t)
|
||
(goto-char (- (point) 1)))
|
||
(buffer-string)))
|
||
|
||
(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))))
|
||
|
||
(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 ((right-str (mood-line--process-segments (cadr format))))
|
||
(mood-line--escape
|
||
(mood-line--process-segments (car format))
|
||
" "
|
||
(propertize " "
|
||
'display `((space :align-to (- right (- 0 right-margin)
|
||
,(length right-str)))))
|
||
right-str)))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; Optional/lazy-loaded segments
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
;; ---------------------------------- ;;
|
||
;; 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--xah-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 editing modes checked, in order:
|
||
`evil-mode', `meow-mode', `xah-fly-keys', `god-mode'"
|
||
(cond
|
||
((bound-and-true-p evil-mode)
|
||
(mood-line-segment-modal--evil-fn))
|
||
((bound-and-true-p meow-mode)
|
||
(mood-line-segment-modal--meow-fn))
|
||
((bound-and-true-p xah-fly-keys)
|
||
(mood-line-segment-modal--xah-fn))
|
||
((or (bound-and-true-p god-local-mode)
|
||
(bound-and-true-p god-global-mode))
|
||
(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)))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; Client segment
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
(defun mood-line-segment-client ()
|
||
"Return an indicator representing the client status of the current frame."
|
||
(when (frame-parameter nil 'client)
|
||
(propertize (mood-line--get-glyph :frame-client)
|
||
'face 'mood-line-frame-status-client)))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; Project segment
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
(defun mood-line-segment-project ()
|
||
"Return project name from project.el or Projectile, if any."
|
||
(or
|
||
(and (fboundp 'project-name)
|
||
(project-current)
|
||
(project-name (project-current)))
|
||
(and (fboundp 'projectile-project-name)
|
||
(projectile-project-name))))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; anzu segment
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
(defun mood-line-segment-anzu ()
|
||
"Return color-coded anzu status information."
|
||
(when (bound-and-true-p anzu--state)
|
||
(cond
|
||
((eq anzu--state 'replace-query)
|
||
(format #("Replace%s%d"
|
||
7 10 (face mood-line-status-info))
|
||
(mood-line--get-glyph :count-separator)
|
||
anzu--cached-count))
|
||
(anzu--overflow-p
|
||
(format #("%d/%d+"
|
||
0 2 (face mood-line-status-info)
|
||
3 6 (face mood-line-status-error))
|
||
anzu--current-position anzu--total-matched))
|
||
(t
|
||
(format #("%d/%d"
|
||
0 2 (face mood-line-status-info))
|
||
anzu--current-position anzu--total-matched)))))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; multiple-cursors segment
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
(defun mood-line-segment-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))))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; Buffer information segments
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
;; ---------------------------------- ;;
|
||
;; Buffer status segment
|
||
;; ---------------------------------- ;;
|
||
|
||
(defun mood-line-segment-buffer-status ()
|
||
"Return an indicator representing the status of the current buffer."
|
||
(if (buffer-file-name (buffer-base-buffer))
|
||
(cond
|
||
((and (buffer-narrowed-p)
|
||
(buffer-modified-p))
|
||
(propertize (mood-line--get-glyph :buffer-narrowed)
|
||
'face 'mood-line-buffer-status-modified))
|
||
((and (buffer-narrowed-p)
|
||
buffer-read-only)
|
||
(propertize (mood-line--get-glyph :buffer-narrowed)
|
||
'face 'mood-line-buffer-status-read-only))
|
||
((buffer-narrowed-p)
|
||
(propertize (mood-line--get-glyph :buffer-narrowed)
|
||
'face 'mood-line-buffer-status-narrowed))
|
||
((buffer-modified-p)
|
||
(propertize (mood-line--get-glyph :buffer-modified)
|
||
'face 'mood-line-buffer-status-modified))
|
||
(buffer-read-only
|
||
(propertize (mood-line--get-glyph :buffer-read-only)
|
||
'face 'mood-line-buffer-status-read-only)))
|
||
(when (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 ()
|
||
"Return the name of the current buffer."
|
||
(format-mode-line "%b" 'mood-line-buffer-name))
|
||
|
||
;; ---------------------------------- ;;
|
||
;; Cursor position segment
|
||
;; ---------------------------------- ;;
|
||
|
||
(defun mood-line-segment-cursor-position ()
|
||
"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 ()
|
||
"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")
|
||
(2 "CR"))))
|
||
|
||
;; ---------------------------------- ;;
|
||
;; Encoding segment
|
||
;; ---------------------------------- ;;
|
||
|
||
(defun mood-line-segment-encoding ()
|
||
"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))))))))
|
||
|
||
;; ---------------------------------- ;;
|
||
;; Major mode segment
|
||
;; ---------------------------------- ;;
|
||
|
||
(defun mood-line-segment-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 ()
|
||
"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)
|
||
(propertize (string-trim misc-info)
|
||
'face 'mood-line-unimportant))))
|
||
|
||
;; ---------------------------------- ;;
|
||
;; Process segment
|
||
;; ---------------------------------- ;;
|
||
|
||
(defun mood-line-segment-process ()
|
||
"Return the current value of `mode-line-process'."
|
||
(let ((process-info (format-mode-line mode-line-process)))
|
||
(unless (string-blank-p process-info)
|
||
(string-trim process-info))))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; mood-line-mode
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
(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
|
||
vc-retrieve-tag-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'."
|
||
;; 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
|
||
;; ---------------------------------- ;;
|
||
|
||
(defun mood-line--deactivate ()
|
||
"Deactivate mood-line, uninstalling hooks and restoring `mode-line-format'."
|
||
;; 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
|
||
;; ---------------------------------- ;;
|
||
|
||
;;;###autoload
|
||
(define-minor-mode mood-line-mode
|
||
"Toggle mood-line on or off."
|
||
:group 'mood-line
|
||
:global t
|
||
:lighter nil
|
||
(if mood-line-mode
|
||
(mood-line--activate)
|
||
(mood-line--deactivate)))
|
||
|
||
;; -------------------------------------------------------------------------- ;;
|
||
;;
|
||
;; Provide package
|
||
;;
|
||
;; -------------------------------------------------------------------------- ;;
|
||
|
||
(provide 'mood-line)
|
||
|
||
;;; mood-line.el ends here
|