mood-line/mood-line.el

360 lines
13 KiB
EmacsLisp
Raw Normal View History

2019-04-11 06:31:21 +00:00
;;; mood-line.el --- A minimal mode-line inspired by doom-modeline. -*- lexical-binding: t; -*-
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
2019-09-30 09:59:29 +00:00
;; Version: 1.2.1
2019-04-11 07:39:48 +00:00
;; Package-Requires: ((emacs "24.4"))
2019-04-11 06:31:21 +00:00
;; This file is not part of GNU Emacs.
;;; Commentary:
;;
;; mood-line is a minimal mode-line configuration that aims to replicate
;; some of the features of the doom-modeline package.
;;
;; Features offered:
;; * Clean, minimal design
;; * Anzu and multiple-cursors counter
;; * Version control status indicator
;; * Flycheck status indicator
2019-09-30 09:34:56 +00:00
;; * Flymake support
2019-04-11 06:31:21 +00:00
;; * Lightweight with no dependencies
2019-04-12 07:37:02 +00:00
;;
;; To enable mood-line:
;; (mood-line-mode)
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:
;;
;; Variable declarations
;;
(defvar flycheck-current-errors)
2019-09-30 09:34:56 +00:00
(defvar flymake--mode-line-format)
(defvar anzu--state)
2019-09-30 09:34:56 +00:00
(defvar anzu--cached-count)
(defvar anzu--overflow-p)
(defvar anzu--current-position)
(defvar anzu--total-matched)
(defvar multiple-cursors-mode)
;;
;; Function prototypes
;;
(declare-function flycheck-count-errors "flycheck" (errors))
(declare-function mc/num-cursors "multiple-cursors" ())
2019-04-11 06:31:21 +00:00
;;
;; Config
;;
(defgroup mood-line nil
"A minimal mode-line configuration inspired by doom-modeline."
:group 'mode-line)
2019-09-30 09:34:56 +00:00
(defcustom mood-line-show-eol-style nil
"If t, the EOL style of the current buffer will be displayed in the mode-line."
:group 'mood-line
:type 'boolean)
(defcustom mood-line-show-encoding-information nil
"If t, the encoding format of the current buffer will be displayed in the mode-line."
:group 'mood-line
:type 'boolean)
(defcustom mood-line-show-cursor-point nil
2019-06-06 10:44:27 +00:00
"If t, the value of `point' will be displayed next to the cursor position in the mode-line."
:group 'mood-line
:type 'boolean)
2019-09-30 09:34:56 +00:00
(defface mood-line-status-neutral
'((t (:inherit (shadow))))
2019-04-11 06:31:21 +00:00
"Face used for neutral or inactive status indicators in the mode-line."
:group 'mood-line)
(defface mood-line-status-info
'((t (:inherit (font-lock-keyword-face))))
"Face used for generic status indicators in the mode-line."
:group 'mood-line)
2019-05-10 23:47:50 +00:00
(defface mood-line-status-success
2019-04-11 06:31:21 +00:00
'((t (:inherit (success))))
"Face used for success status indicators in the mode-line."
:group 'mood-line)
(defface mood-line-status-warning
'((t (:inherit (warning))))
"Face for warning status indicators in the mode-line."
:group 'mood-line)
(defface mood-line-status-error
'((t (:inherit (error))))
"Face for error stauts indicators in the mode-line."
:group 'mood-line)
(defface mood-line-unimportant
2019-09-30 09:34:56 +00:00
'((t (:inherit (shadow))))
2019-04-11 06:31:21 +00:00
"Face used for less important mode-line elements."
:group 'mood-line)
(defface mood-line-modified
'((t (:inherit (error))))
"Face used for the 'modified' indicator symbol in the mode-line."
:group 'mood-line)
;;
;; Helper functions
;;
2019-09-30 09:34:56 +00:00
(defun --string-trim-left (string)
"Remove whitespace at the beginning of STRING."
(if (string-match "\\`[ \t\n\r]+" string)
(replace-match "" t t string)
string))
(defun --string-trim-right (string)
"Remove whitespace at the end of STRING."
(if (string-match "[ \t\n\r]+\\'" string)
(replace-match "" t t string)
string))
(defun --string-trim (string)
"Remove whitespace at the beginning and end of STRING."
(--string-trim-left (--string-trim-right string)))
(defun --format-mood-line (left right)
2019-04-11 06:31:21 +00:00
"Return a string of `window-width' length containing LEFT and RIGHT, aligned respectively."
(let ((reserve (length right)))
2019-09-30 09:34:56 +00:00
(concat left
" "
(propertize " "
'display `((space :align-to (- right ,reserve))))
right)))
2019-04-11 06:31:21 +00:00
;;
;; Update functions
;;
(defvar-local mood-line--vc-text nil)
(defun mood-line--update-vc-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))
(state (vc-state buffer-file-name (vc-backend buffer-file-name))))
2019-09-30 09:34:56 +00:00
(let ((face 'mode-line-neutral))
2019-04-11 06:31:21 +00:00
(concat (cond ((memq state '(edited added))
2019-09-30 09:34:56 +00:00
(setq face 'mood-line-status-info)
(propertize "+ " 'face face))
2019-04-11 06:31:21 +00:00
((eq state 'needs-merge)
2019-09-30 09:34:56 +00:00
(setq face 'mood-line-status-warning)
(propertize "" 'face face))
2019-04-11 06:31:21 +00:00
((eq state 'needs-update)
2019-09-30 09:34:56 +00:00
(setq face 'mood-line-status-warning)
(propertize "" 'face face))
2019-04-11 06:31:21 +00:00
((memq state '(removed conflict unregistered))
2019-09-30 09:34:56 +00:00
(setq face 'mood-line-status-error)
(propertize "" 'face face))
2019-04-11 06:31:21 +00:00
(t
2019-09-30 09:34:56 +00:00
(setq face 'mood-line-status-neutral)
(propertize "" 'face face)))
2019-04-11 06:31:21 +00:00
(propertize (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))
2019-09-30 09:34:56 +00:00
'face face
'mouse-face face)
2019-04-11 06:31:21 +00:00
" "))))))
(defvar-local mood-line--flycheck-text nil)
(defun mood-line--update-flycheck-segment (&optional status)
"Update `mood-line--flycheck-text' against the reported flycheck STATUS."
(setq mood-line--flycheck-text
(pcase status
('finished (if flycheck-current-errors
(let-alist (flycheck-count-errors flycheck-current-errors)
(let ((sum (+ (or .error 0) (or .warning 0))))
2019-09-30 09:34:56 +00:00
(propertize (concat "⚑ Issues: "
2019-04-11 06:31:21 +00:00
(number-to-string sum)
" ")
'face (if .error
'mood-line-status-error
'mood-line-status-warning))))
2019-05-10 23:47:50 +00:00
(propertize "✔ Good " 'face 'mood-line-status-success)))
('running (propertize "Δ Checking " 'face 'mood-line-status-info))
2019-04-11 06:31:21 +00:00
('errored (propertize "✖ Error " 'face 'mood-line-status-error))
2019-09-30 09:34:56 +00:00
('interrupted (propertize "⏸ Paused " 'face 'mood-line-status-neutral))
('no-checker ""))))
2019-04-11 06:31:21 +00:00
;;
;; Segments
;;
(defun mood-line-segment-modified ()
2019-09-30 09:34:56 +00:00
"Displays a color-coded buffer modification/read-only indicator in the mode-line."
(if (not (string-match-p "\\*.*\\*" (buffer-name)))
(if (buffer-modified-p)
(propertize "" 'face 'mood-line-modified)
(if (and buffer-read-only (buffer-file-name))
2019-09-30 09:34:56 +00:00
(propertize "" 'face 'mood-line-unimportant)
" "))
" "))
2019-04-11 06:31:21 +00:00
(defun mood-line-segment-buffer-name ()
"Displays the name of the current buffer in the mode-line."
2019-09-30 09:34:56 +00:00
(propertize "%b " 'face 'mode-line-buffer-id))
2019-04-11 06:31:21 +00:00
(defun mood-line-segment-anzu ()
"Displays color-coded anzu status information in the mode-line (if available)."
2019-06-06 09:47:25 +00:00
(when (and (boundp 'anzu--state) anzu--state)
2019-09-30 09:34:56 +00:00
(cond ((eq anzu--state 'replace-query)
(format #("Replace: %d " 0 11 (face mood-line-status-warning)) anzu--cached-count))
(anzu--overflow-p
(format #("%d/%d+ " 0 3 (face mood-line-status-info) 3 6 (face mood-line-status-error)) anzu--current-position anzu--total-matched))
(t
(format #("%d/%d " 0 5 (face mood-line-status-info)) anzu--current-position anzu--total-matched)))))
2019-04-11 06:31:21 +00:00
(defun mood-line-segment-multiple-cursors ()
"Displays the number of active multiple-cursors in the mode-line (if available)."
2019-06-06 09:47:25 +00:00
(when (and (boundp 'multiple-cursors-mode) multiple-cursors-mode)
2019-09-30 09:34:56 +00:00
(concat "MC"
(format #("×%d " 0 3 (face mood-line-status-warning)) (mc/num-cursors)))))
2019-04-11 06:31:21 +00:00
(defun mood-line-segment-position ()
"Displays the current cursor position in the mode-line."
2019-06-06 10:44:27 +00:00
(concat "%l:%c"
2019-09-30 09:34:56 +00:00
(when mood-line-show-cursor-point (propertize (format ":%d" (point)) 'face))
(propertize " %p%% " 'face 'mood-line-unimportant)))
(defun mood-line-segment-eol ()
"Displays the EOL style of the current buffer in the mode-line."
(when mood-line-show-eol-style
(pcase (coding-system-eol-type buffer-file-coding-system)
(0 "LF ")
(1 "CRLF ")
(2 "CR "))))
2019-04-11 06:31:21 +00:00
(defun mood-line-segment-encoding ()
"Displays the encoding and EOL style of the buffer in the mode-line."
2019-09-30 09:34:56 +00:00
(when mood-line-show-encoding-information
(concat (let ((sys (coding-system-plist buffer-file-coding-system)))
(cond ((memq (plist-get sys :category) '(coding-category-undecided coding-category-utf-8))
"UTF-8")
(t (upcase (symbol-name (plist-get sys :name))))))
" ")))
2019-04-11 06:31:21 +00:00
(defun mood-line-segment-vc ()
"Displays color-coded version control information in the mode-line."
mood-line--vc-text)
(defun mood-line-segment-major-mode ()
"Displays the current major mode in the mode-line."
2019-09-30 09:34:56 +00:00
(propertize "%m " 'face 'bold))
2019-04-11 06:31:21 +00:00
2019-09-30 09:34:56 +00:00
(defun mood-line-segment-misc-info ()
"Displays the current value of `mode-line-misc-info' in the mode-line."
(let ((misc-info (format-mode-line mode-line-misc-info 'mood-line-unimportant)))
(unless (string= misc-info "")
(concat (--string-trim misc-info) " "))))
2019-05-11 00:35:11 +00:00
2019-04-11 06:31:21 +00:00
(defun mood-line-segment-flycheck ()
"Displays color-coded flycheck information in the mode-line (if available)."
mood-line--flycheck-text)
2019-09-30 09:34:56 +00:00
(defun mood-line-segment-flymake ()
"Displays information about the current status of flymake in the mode-line (if available)."
(when (and (boundp 'flymake-mode) flymake-mode)
(concat (--string-trim (format-mode-line flymake--mode-line-format)) " ")))
(defun mood-line-segment-process ()
"Displays the current value of `mode-line-process' in the mode-line."
(when mode-line-process
2019-09-30 09:34:56 +00:00
(concat (--string-trim (format-mode-line mode-line-process)) " ")))
2019-04-11 06:31:21 +00:00
;;
;; Activation function
;;
;; Store the default mode-line format
(defvar mood-line--default-mode-line mode-line-format)
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
(progn
;; Setup flycheck hooks
(add-hook 'flycheck-status-changed-functions #'mood-line--update-flycheck-segment)
(add-hook 'flycheck-mode-hook #'mood-line--update-flycheck-segment)
;; Setup VC hooks
(add-hook 'find-file-hook #'mood-line--update-vc-segment)
(add-hook 'after-save-hook #'mood-line--update-vc-segment)
(advice-add #'vc-refresh-state :after #'mood-line--update-vc-segment)
;; Set the new mode-line-format
(setq-default mode-line-format
'((:eval
2019-09-30 09:34:56 +00:00
(--format-mood-line
;; Left
(format-mode-line
2019-09-30 09:34:56 +00:00
'(" "
(:eval (mood-line-segment-modified))
(:eval (mood-line-segment-buffer-name))
(:eval (mood-line-segment-anzu))
(:eval (mood-line-segment-multiple-cursors))
(:eval (mood-line-segment-position))))
;; Right
(format-mode-line
2019-09-30 09:34:56 +00:00
'((:eval (mood-line-segment-eol))
(:eval (mood-line-segment-encoding))
(:eval (mood-line-segment-vc))
(:eval (mood-line-segment-major-mode))
2019-09-30 09:34:56 +00:00
(:eval (mood-line-segment-misc-info))
(:eval (mood-line-segment-flycheck))
2019-09-30 09:34:56 +00:00
(:eval (mood-line-segment-flymake))
(:eval (mood-line-segment-process))
" ")))))))
(progn
;; Remove flycheck hooks
(remove-hook 'flycheck-status-changed-functions #'mood-line--update-flycheck-segment)
(remove-hook 'flycheck-mode-hook #'mood-line--update-flycheck-segment)
;; Remove VC hooks
(remove-hook 'file-find-hook #'mood-line--update-vc-segment)
(remove-hook 'after-save-hook #'mood-line--update-vc-segment)
(advice-remove #'vc-refresh-state #'mood-line--update-vc-segment)
;; Restore the original mode-line format
(setq-default mode-line-format mood-line--default-mode-line))))
2019-04-11 06:31:21 +00:00
;;
;; Provide mood-line
;;
(provide 'mood-line)
;;; mood-line.el ends here