mood-line/mood-line.el

820 lines
28 KiB
EmacsLisp
Raw Normal View History

2022-12-22 11:12:01 +00:00
;;; mood-line.el --- A minimal mode line inspired by doom-modeline -*- lexical-binding: t; -*-
2023-12-09 10:51:54 +00:00
;;
2019-04-11 07:39:48 +00:00
;; Author: Jessie Hildebrandt <jessieh.net>
;; Homepage: https://gitlab.com/jessieh/mood-line
2019-04-11 06:31:21 +00:00
;; Keywords: mode-line faces
2023-12-09 10:52:27 +00:00
;; Version: 3.1.0
2023-10-13 21:08:11 +00:00
;; Package-Requires: ((emacs "26.1"))
2023-12-09 10:51:54 +00:00
;;
2019-04-11 06:31:21 +00:00
;; This file is not part of GNU Emacs.
;;; Commentary:
;;
;; mood-line is a lightweight, drop-in replacement for the default mode line.
2019-04-11 06:31:21 +00:00
;;
;; Features offered:
;; * Clean, informative design
;; * Customizable, modular segment format
2022-12-22 11:12:01 +00:00
;; * Customizable glyph sets
;; * Lazy-loaded extensions
;; * Lightweight, no dependencies
2019-04-12 07:37:02 +00:00
;;
2022-12-22 11:12:01 +00:00
;; To activate mood-line:
;; (mood-line-mode)
;;
;; For information on customizing mood-line:
;; M-x customize-group mood-line
2019-04-11 06:31:21 +00:00
;;; 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:
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
;;
2022-12-22 11:12:01 +00:00
;; Byte-compiler declarations
;;
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; Required features
;; ---------------------------------- ;;
(eval-when-compile
(require 'cl-lib))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; External variable defs
;; ---------------------------------- ;;
(eval-when-compile
(defvar anzu--cached-count)
(defvar anzu--current-position)
(defvar anzu--overflow-p)
(defvar anzu--total-matched))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; External function decls
;; ---------------------------------- ;;
(eval-when-compile
(declare-function mc/num-cursors "multiple-cursors")
(declare-function string-blank-p "subr-x"))
2022-12-22 11:12:01 +00:00
2023-11-20 22:40:27 +00:00
;; -------------------------------------------------------------------------- ;;
;;
;; 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) "--")))))
2023-11-20 22:40:27 +00:00
`(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'.
2023-11-20 22:40:27 +00:00
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)))))
2023-11-20 22:40:27 +00:00
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
;;
;; Constants
;;
;; -------------------------------------------------------------------------- ;;
(defconst mood-line-glyphs-ascii
'((:checker-info . ?i)
(:checker-issues . ?+)
(:checker-good . ?-)
(:checker-checking . ?~)
2022-12-22 11:12:01 +00:00
(: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 . ?@)
2022-12-22 11:12:01 +00:00
(: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 . ?◢)
2022-12-22 11:12:01 +00:00
(:buffer-modified . ?●)
(:buffer-read-only . ?■)
(:frame-client . ?)
2022-12-22 11:12:01 +00:00
(: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 . ?⇅)
2022-12-22 11:12:01 +00:00
(:count-separator . ?✕))
"Set of Unicode glyphs for use with mood-line.")
(defconst mood-line-format-default
2023-11-20 22:40:27 +00:00
(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) . " ")
2023-11-20 22:40:27 +00:00
(mood-line-segment-scroll))
:right
2023-11-20 22:40:27 +00:00
(((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
2023-11-20 22:40:27 +00:00
(mood-line-defformat
:left
(((mood-line-segment-modal) . " ")
((or (mood-line-segment-buffer-status)
(mood-line-segment-client)
" ") . " ")
2023-12-10 13:08:46 +00:00
((mood-line-segment-project) . "/")
2023-11-20 22:40:27 +00:00
((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
2023-11-20 22:40:27 +00:00
(((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.")
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
2019-04-11 06:31:21 +00:00
;;
2022-12-22 11:12:01 +00:00
;; Custom definitions
2019-04-11 06:31:21 +00:00
;;
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; Group definitions
;; ---------------------------------- ;;
2019-04-11 06:31:21 +00:00
(defgroup mood-line nil
2022-12-22 11:12:01 +00:00
"A minimal mode line configuration."
2019-04-11 06:31:21 +00:00
:group 'mode-line)
2022-12-22 11:12:01 +00:00
(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
2022-12-22 11:12:01 +00:00
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.
2022-12-22 11:12:01 +00:00
Keys are names for different mode line glyphs, values are characters for that
glyph. Glyphs used by mood-line include:
2022-12-22 11:12:01 +00:00
: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
2022-12-22 11:12:01 +00:00
: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
2022-12-22 11:12:01 +00:00
:buffer-narrowed | File-backed buffer is narrowed
:buffer-modified | File-backed buffer is modified
:buffer-read-only | File-backed buffer is read-only
2022-12-22 11:12:01 +00:00
:frame-client | Frame is a client for an Emacs daemon
:count-separator | Separates some indicator names from numerical counts
2022-12-22 11:12:01 +00:00
`mood-line-glyphs-ascii' will be used as a fallback whenever a glyph is found
to be missing in `mood-line-glyph-alist'."
2022-12-22 11:12:01 +00:00
:group 'mood-line
:type '(alist :tag "Character map alist"
2022-12-22 11:12:01 +00:00
: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.
2023-11-20 22:40:27 +00:00
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)))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Face definitions
;; ---------------------------------- ;;
(defface mood-line-buffer-name
2023-01-26 07:02:34 +00:00
'((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
2023-01-26 07:02:34 +00:00
'((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
2023-01-26 07:02:34 +00:00
'((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
2023-01-26 07:02:34 +00:00
'((t (:inherit font-lock-doc-face :weight normal)))
"Face used for the ':buffer-narrowed' buffer status indicator."
2022-12-22 11:12:01 +00:00
: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
2023-01-26 07:02:34 +00:00
'((t (:inherit bold)))
"Face used for the major mode indicator."
2022-12-22 11:12:01 +00:00
:group 'mood-line-faces)
2019-09-30 09:34:56 +00:00
(defface mood-line-status-neutral
2023-01-26 07:02:34 +00:00
'((t (:inherit mood-line-unimportant)))
"Face used for neutral or inactive status indicators."
2022-12-22 11:12:01 +00:00
:group 'mood-line-faces)
2019-04-11 06:31:21 +00:00
(defface mood-line-status-info
2023-01-26 07:02:34 +00:00
'((t (:inherit font-lock-keyword-face :weight normal)))
"Face used for generic status indicators."
2022-12-22 11:12:01 +00:00
:group 'mood-line-faces)
2019-04-11 06:31:21 +00:00
2019-05-10 23:47:50 +00:00
(defface mood-line-status-success
2023-01-26 07:02:34 +00:00
'((t (:inherit success :weight normal)))
"Face used for success status indicators."
2022-12-22 11:12:01 +00:00
:group 'mood-line-faces)
2019-04-11 06:31:21 +00:00
(defface mood-line-status-warning
2023-01-26 07:02:34 +00:00
'((t (:inherit warning :weight normal)))
"Face for warning status indicators."
2022-12-22 11:12:01 +00:00
:group 'mood-line-faces)
2019-04-11 06:31:21 +00:00
(defface mood-line-status-error
2023-01-26 07:02:34 +00:00
'((t (:inherit error :weight normal)))
"Face for error status indicators."
2022-12-22 11:12:01 +00:00
:group 'mood-line-faces)
2019-04-11 06:31:21 +00:00
(defface mood-line-encoding
2023-01-26 07:02:34 +00:00
'((t (:inherit mood-line-unimportant)))
"Face used for buffer/file encoding information."
:group 'mood-line-faces)
2019-04-11 06:31:21 +00:00
(defface mood-line-unimportant
2023-01-26 07:02:34 +00:00
'((t (:inherit shadow :weight normal)))
2022-12-22 11:12:01 +00:00
"Face used for less important mode line elements."
:group 'mood-line-faces)
2019-04-11 06:31:21 +00:00
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
2019-04-11 06:31:21 +00:00
;;
;; Helper functions
;;
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
(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)))
2022-12-22 11:12:01 +00:00
(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)))
2022-12-22 11:12:01 +00:00
2022-12-30 06:00:31 +00:00
;; -------------------------------------------------------------------------- ;;
;;
;; Optional/lazy-loaded segments
2022-12-30 06:00:31 +00:00
;;
;; -------------------------------------------------------------------------- ;;
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Modal editing
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
(mood-line--deflazy mood-line-segment-modal--evil-fn)
(mood-line--deflazy mood-line-segment-modal--meow-fn)
2023-12-09 11:10:01 +00:00
(mood-line--deflazy mood-line-segment-modal--xah-fn)
(mood-line--deflazy mood-line-segment-modal--god-fn)
2022-12-22 11:12:01 +00:00
(defun mood-line-segment-modal ()
"Return the correct mode line segment for the first active modal mode found.
2023-12-09 11:10:01 +00:00
Modal editing modes checked, in order:
`evil-mode', `meow-mode', `xah-fly-keys', `god-mode'"
2022-12-22 11:12:01 +00:00
(cond
((bound-and-true-p evil-mode)
(mood-line-segment-modal--evil-fn))
2022-12-22 11:12:01 +00:00
((bound-and-true-p meow-mode)
(mood-line-segment-modal--meow-fn))
2023-03-16 19:54:27 +00:00
((bound-and-true-p xah-fly-keys)
2023-12-09 11:10:01 +00:00
(mood-line-segment-modal--xah-fn))
2023-12-10 12:57:02 +00:00
((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)))
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
;;
;; 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)))
2023-12-10 13:08:46 +00:00
;; -------------------------------------------------------------------------- ;;
;;
;; 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))))
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
;;
;; anzu segment
2022-12-22 11:12:01 +00:00
;;
;; -------------------------------------------------------------------------- ;;
(defun mood-line-segment-anzu ()
"Return color-coded anzu status information."
2022-12-22 11:12:01 +00:00
(when (bound-and-true-p anzu--state)
(cond
((eq anzu--state 'replace-query)
(format #("Replace%s%d"
2022-12-22 11:12:01 +00:00
7 10 (face mood-line-status-info))
(mood-line--get-glyph :count-separator)
anzu--cached-count))
(anzu--overflow-p
(format #("%d/%d+"
2022-12-22 11:12:01 +00:00
0 2 (face mood-line-status-info)
3 6 (face mood-line-status-error))
anzu--current-position anzu--total-matched))
(t
(format #("%d/%d"
2022-12-22 11:12:01 +00:00
0 2 (face mood-line-status-info))
anzu--current-position anzu--total-matched)))))
;; -------------------------------------------------------------------------- ;;
2019-04-11 06:31:21 +00:00
;;
2022-12-22 11:12:01 +00:00
;; multiple-cursors segment
2019-04-11 06:31:21 +00:00
;;
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
(defun mood-line-segment-multiple-cursors ()
"Return the number of active multiple-cursors."
2022-12-22 11:12:01 +00:00
(when (bound-and-true-p multiple-cursors-mode)
(format #("MC%s%d"
2022-12-22 11:12:01 +00:00
2 5 (face mood-line-status-info))
(mood-line--get-glyph :count-separator)
(mc/num-cursors))))
;; -------------------------------------------------------------------------- ;;
;;
;; Buffer information segments
2022-12-22 11:12:01 +00:00
;;
;; -------------------------------------------------------------------------- ;;
;; ---------------------------------- ;;
;; Buffer status segment
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
(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))))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Buffer name segment
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
(defun mood-line-segment-buffer-name ()
"Return the name of the current buffer."
(format-mode-line "%b" 'mood-line-buffer-name))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Cursor position segment
;; ---------------------------------- ;;
2022-12-22 11:12:01 +00:00
(defun mood-line-segment-cursor-position ()
"Return the position of the cursor in the current buffer."
(format-mode-line "%l:%c"))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Cursor point segment
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
(defun mood-line-segment-cursor-point ()
"Return the value of `point' in the current buffer."
(format #("%d"
0 2 (face mood-line-unimportant))
(point)))
2019-04-11 06:31:21 +00:00
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Region segment
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
(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)))))
2019-04-11 06:31:21 +00:00
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Scroll segment
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
2019-04-11 06:31:21 +00:00
(defun mood-line-segment-scroll ()
"Return the relative position of the viewport in the current buffer."
(format-mode-line "%o" 'mood-line-unimportant))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; EOL segment
;; ---------------------------------- ;;
2019-09-30 09:34:56 +00:00
(defun mood-line-segment-eol ()
"Return the EOL type for the coding system of the current buffer."
(when buffer-file-coding-system
2019-09-30 09:34:56 +00:00
(pcase (coding-system-eol-type buffer-file-coding-system)
(0 "LF")
(1 "CRLF")
(2 "CR"))))
2019-04-11 06:31:21 +00:00
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Encoding segment
;; ---------------------------------- ;;
2019-04-11 06:31:21 +00:00
(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))))))))
2019-04-11 06:31:21 +00:00
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Major mode segment
;; ---------------------------------- ;;
2019-04-11 06:31:21 +00:00
(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))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Misc. info segment
;; ---------------------------------- ;;
2019-04-11 06:31:21 +00:00
2019-09-30 09:34:56 +00:00
(defun mood-line-segment-misc-info ()
"Return the current value of `mode-line-misc-info'."
2022-12-22 11:12:01 +00:00
(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))))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Process segment
;; ---------------------------------- ;;
2019-09-30 09:34:56 +00:00
(defun mood-line-segment-process ()
"Return the current value of `mode-line-process'."
(let ((process-info (format-mode-line mode-line-process)))
2022-12-22 11:12:01 +00:00
(unless (string-blank-p process-info)
(string-trim process-info))))
2022-12-20 21:35:59 +00:00
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
2019-04-11 06:31:21 +00:00
;;
;; mood-line-mode
2019-04-11 06:31:21 +00:00
;;
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
2019-04-11 06:31:21 +00:00
(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'.")
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Activation
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
(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)))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Deactivation
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
(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)))
2022-12-22 11:12:01 +00:00
;; ---------------------------------- ;;
;; Mode definition
;; ---------------------------------- ;;
2019-04-12 07:30:28 +00:00
;;;###autoload
(define-minor-mode mood-line-mode
"Toggle mood-line on or off."
:group 'mood-line
:global t
:lighter nil
(if mood-line-mode
2022-12-22 11:12:01 +00:00
(mood-line--activate)
(mood-line--deactivate)))
2019-04-11 06:31:21 +00:00
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
2019-04-11 06:31:21 +00:00
;;
2022-12-22 11:12:01 +00:00
;; Provide package
2019-04-11 06:31:21 +00:00
;;
2022-12-22 11:12:01 +00:00
;; -------------------------------------------------------------------------- ;;
2019-04-11 06:31:21 +00:00
(provide 'mood-line)
;;; mood-line.el ends here