github/doom-modeline
1
0
Fork 0
mirror of https://github.com/correl/doom-modeline.git synced 2024-11-27 11:09:52 +00:00
Code Issues Projects Releases Packages Wiki Activity

Fix issues according to feedbacks from mepla.

Browse source
This commit is contained in:
Vincent Zhang 2018-07-01 02:19:54 +08:00
parent bd097590a2
commit ae9d073377
1 changed files with 130 additions and 108 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

238
doom-modeline.el
View file

@ -1,12 +1,12 @@
;;; doom-modeline.el --- A minimal modeline from DOOM Emacs. -*- lexical-binding: t; -*- ;;; doom-modeline.el --- A minimal modeline from DOOM. -*- lexical-binding: t; -*-
;; Copyright (C) 2018 Vincent Zhang ;; Copyright (C) 2018 Vincent Zhang
;; Author: Vincent Zhang <seagle0128@gmail.com> ;; Author: Vincent Zhang <seagle0128@gmail.com>
;; URL: https://github.com/seagle0128/doom-modeline ;; URL: https://github.com/seagle0128/doom-modeline
;; Version: 0.2.0 ;; Version: 0.2.0
;; Package-Requires: ((emacs "25.1") (all-the-icons "1.0.0") (projectile "0.10.0") (shrink-path "0.2.0") (eldoc-eval "0.1")) ;; Package-Requires: ((emacs "25.1") (all-the-icons "1.0.0") (projectile "0.10.0") (shrink-path "0.2.0") (eldoc-eval "0.1") (dash "2.11.0"))
;; Keywords: modeline mode-line doom ;; Keywords: faces
;; This file is not part of GNU Emacs. ;; This file is not part of GNU Emacs.
@ -62,104 +62,92 @@
(defvar doom-modeline-buffer-file-name-style 'truncate-upto-project (defvar doom-modeline-buffer-file-name-style 'truncate-upto-project
"Determines the style used by `doom-modeline-buffer-file-name'. "Determines the style used by `doom-modeline-buffer-file-name'.
Given ~/Projects/FOSS/emacs/lisp/comint.el Given ~/Projects/FOSS/emacs/lisp/comint.el
truncate-upto-project => ~/P/F/emacs/lisp/comint.el truncate-upto-project => ~/P/F/emacs/lisp/comint.el
truncate-upto-root => ~/P/F/e/lisp/comint.el truncate-upto-root => ~/P/F/e/lisp/comint.el
truncate-all => ~/P/F/e/l/comint.el truncate-all => ~/P/F/e/l/comint.el
relative-from-project => emacs/lisp/comint.el relative-from-project => emacs/lisp/comint.el
relative-to-project => lisp/comint.el relative-to-project => lisp/comint.el
file-name => comint.el") file-name => comint.el")
;; externs ;; externs
(defvar anzu--current-position 0) (defvar anzu--current-position)
(defvar anzu--overflow-p nil) (defvar anzu--overflow-p)
(defvar anzu--state nil) (defvar anzu--state)
(defvar anzu--total-matched 0) (defvar anzu--total-matched)
(defvar evil-ex-active-highlights-alist nil) (defvar anzu-cons-mode-line-p)
(defvar evil-ex-argument nil) (defvar anzu-minimum-input-length)
(defvar evil-ex-range nil) (defvar anzu-search-threshold)
(defvar evil-mode nil) (defvar evil-ex-active-highlights-alist)
(defvar evil-state nil) (defvar evil-ex-argument)
(defvar evil-visual-beginning nil) (defvar evil-ex-range)
(defvar evil-visual-end nil) (defvar evil-mode)
(defvar evil-visual-selection nil) (defvar evil-state)
(defvar iedit-mode nil) (defvar evil-visual-beginning)
(defvar iedit-occurrences-overlays nil) (defvar evil-visual-end)
(defvar evil-visual-selection)
(defvar flycheck-current-errors)
(defvar iedit-mode)
(defvar iedit-occurrences-overlays)
(defvar text-scale-mode-amount) (defvar text-scale-mode-amount)
(defvar-local flycheck-current-errors nil)
;; ;;
;; Custom faces ;; Custom faces
;; ;;
(defgroup doom-modeline nil (defgroup doom-modeline nil
"TODO" "Doom mode-line faces."
:group 'faces) :group 'faces)
(defface doom-modeline-buffer-path (defface doom-modeline-buffer-path
'((t (:inherit (mode-line-emphasis bold)))) '((t (:inherit (mode-line-emphasis bold))))
"Face used for the dirname part of the buffer path." "Face used for the dirname part of the buffer path.")
:group 'doom-modeline)
(defface doom-modeline-buffer-file (defface doom-modeline-buffer-file
'((t (:inherit (mode-line-buffer-id bold)))) '((t (:inherit (mode-line-buffer-id bold))))
"Face used for the filename part of the mode-line buffer path." "Face used for the filename part of the mode-line buffer path.")
:group 'doom-modeline)
(defface doom-modeline-buffer-modified (defface doom-modeline-buffer-modified
'((t (:inherit (error bold) :background nil))) '((t (:inherit (error bold) :background nil)))
"Face used for the 'unsaved' symbol in the mode-line." "Face used for the 'unsaved' symbol in the mode-line.")
:group 'doom-modeline)
(defface doom-modeline-buffer-major-mode (defface doom-modeline-buffer-major-mode
'((t (:inherit (mode-line-emphasis bold)))) '((t (:inherit (mode-line-emphasis bold))))
"Face used for the major-mode segment in the mode-line." "Face used for the major-mode segment in the mode-line.")
:group 'doom-modeline)
(defface doom-modeline-highlight (defface doom-modeline-highlight
'((t (:inherit mode-line-emphasis))) '((t (:inherit mode-line-emphasis)))
"Face for bright segments of the mode-line." "Face for bright segments of the mode-line.")
:group 'doom-modeline)
(defface doom-modeline-panel (defface doom-modeline-panel
'((t (:inherit mode-line-highlight))) '((t (:inherit mode-line-highlight)))
"Face for 'X out of Y' segments, such as `doom-modeline--anzu', `doom-modeline--evil-substitute' and "Face for 'X out of Y' segments, such as `doom-modeline--anzu', `doom-modeline--evil-substitute' and
`iedit'" `iedit'")
:group 'doom-modeline)
(defface doom-modeline-info (defface doom-modeline-info
`((t (:inherit (success bold)))) `((t (:inherit (success bold))))
"Face for info-level messages in the modeline. Used by `*vc'." "Face for info-level messages in the modeline. Used by `*vc'.")
:group 'doom-modeline)
(defface doom-modeline-warning (defface doom-modeline-warning
`((t (:inherit (warning bold)))) `((t (:inherit (warning bold))))
"Face for warnings in the modeline. Used by `*flycheck'" "Face for warnings in the modeline. Used by `*flycheck'")
:group 'doom-modeline)
(defface doom-modeline-urgent (defface doom-modeline-urgent
`((t (:inherit (error bold)))) `((t (:inherit (error bold))))
"Face for errors in the modeline. Used by `*flycheck'" "Face for errors in the modeline. Used by `*flycheck'")
:group 'doom-modeline)
;; Bar ;; Bar
(defface doom-modeline-bar '((t (:inherit highlight))) (defface doom-modeline-bar '((t (:inherit highlight)))
"The face used for the left-most bar on the mode-line of an active window." "The face used for the left-most bar on the mode-line of an active window.")
:group 'doom-modeline)
(defface doom-modeline-eldoc-bar '((t (:inherit shadow))) (defface doom-modeline-eldoc-bar '((t (:inherit shadow)))
"The face used for the left-most bar on the mode-line when eldoc-eval is "The face used for the left-most bar on the mode-line when eldoc-eval is
active." active.")
:group 'doom-modeline)
(defface doom-modeline-inactive-bar '((t (:inherit warning :inverse-video t))) (defface doom-modeline-inactive-bar '((t (:inherit warning :inverse-video t)))
"The face used for the left-most bar on the mode-line of an inactive window." "The face used for the left-most bar on the mode-line of an inactive window.")
:group 'doom-modeline)
(defface doom-modeline-eyebrowse '((t ())) (defface doom-modeline-eyebrowse '((t ()))
"The face used for eyebrowse." "The face used for eyebrowse.")
:group 'doom-modeline)
(eval-and-compile (eval-and-compile
(defun doom-modeline--resolve-hook-forms (hooks) (defun doom-modeline--resolve-hook-forms (hooks)
@ -193,7 +181,7 @@ active."
(defvar doom-modeline-var-alist ())) (defvar doom-modeline-var-alist ()))
(defmacro doom-modeline-def-segment (name &rest body) (defmacro doom-modeline-def-segment (name &rest body)
"Defines a modeline segment and byte compiles it." "Defines a modeline segment NAME with BODY and byte compiles it."
(declare (indent defun) (doc-string 2)) (declare (indent defun) (doc-string 2))
(let ((sym (intern (format "doom-modeline-segment--%s" name))) (let ((sym (intern (format "doom-modeline-segment--%s" name)))
(docstring (if (stringp (car body)) (docstring (if (stringp (car body))
@ -229,10 +217,11 @@ active."
(defmacro doom-modeline-def-modeline (name lhs &optional rhs) (defmacro doom-modeline-def-modeline (name lhs &optional rhs)
"Defines a modeline format and byte-compiles it. "Defines a modeline format and byte-compiles it.
NAME is a symbol to identify it (used by `doom-modeline' for retrieval).
LHS and RHS are lists of symbols of modeline segments defined with NAME is a symbol to identify it (used by `doom-modeline' for retrieval).
`doom-modeline-def-segment'. LHS and RHS are lists of symbols of modeline segments defined with
Example: `doom-modeline-def-segment'.
Example:
(doom-modeline-def-modeline minimal (doom-modeline-def-modeline minimal
(bar matches \" \" buffer-info) (bar matches \" \" buffer-info)
(media-info major-mode)) (media-info major-mode))
@ -262,14 +251,16 @@ Example:
(defun doom-modeline (key) (defun doom-modeline (key)
"Return a mode-line configuration associated with KEY (a symbol). "Return a mode-line configuration associated with KEY (a symbol).
Throws an error if it doesn't exist."
Throws an error if it doesn't exist."
(let ((fn (intern (format "doom-modeline-format--%s" key)))) (let ((fn (intern (format "doom-modeline-format--%s" key))))
(when (functionp fn) (when (functionp fn)
`(:eval (,fn))))) `(:eval (,fn)))))
(defun doom-modeline-set-modeline (key &optional default) (defun doom-modeline-set-modeline (key &optional default)
"Set the modeline format. Does nothing if the modeline KEY doesn't exist. "Set the modeline format. Does nothing if the modeline KEY doesn't exist.
If DEFAULT is non-nil, set the default mode-line for all buffers."
If DEFAULT is non-nil, set the default mode-line for all buffers."
(let ((modeline (doom-modeline key))) (let ((modeline (doom-modeline key)))
(setf (if default (setf (if default
(default-value 'mode-line-format) (default-value 'mode-line-format)
@ -278,7 +269,8 @@ If DEFAULT is non-nil, set the default mode-line for all buffers."
(defun doom-modeline-project-root () (defun doom-modeline-project-root ()
"Get the path to the root of your project. "Get the path to the root of your project.
If STRICT-P, return nil if no project was found, otherwise return
If STRICT-P, return nil if no project was found, otherwise return
`default-directory'." `default-directory'."
(let (projectile-require-project-root) (let (projectile-require-project-root)
(projectile-project-root))) (projectile-project-root)))
@ -404,7 +396,7 @@ If STRICT-P, return nil if no project was found, otherwise return
(eq (selected-window) doom-modeline-current-window)) (eq (selected-window) doom-modeline-current-window))
(defun doom-modeline--make-xpm (face width height) (defun doom-modeline--make-xpm (face width height)
"Create an XPM bitmap. Inspired by `powerline''s `pl/make-xpm'." "Create an XPM bitmap via FACE, WIDTH and HEIGHT. Inspired by `powerline''s `pl/make-xpm'."
(propertize (propertize
" " 'display " " 'display
(let ((data (make-list height (make-list width 1))) (let ((data (make-list height (make-list width 1)))
@ -452,7 +444,8 @@ If STRICT-P, return nil if no project was found, otherwise return
(defun doom-modeline--buffer-file-name-truncate (&optional truncate-tail) (defun doom-modeline--buffer-file-name-truncate (&optional truncate-tail)
"Propertized variable `buffer-file-name' that truncates every dir along path. "Propertized variable `buffer-file-name' that truncates every dir along path.
If TRUNCATE-TAIL is t also truncate the parent directory of the file."
If TRUNCATE-TAIL is t also truncate the parent directory of the file."
(let ((dirs (shrink-path-prompt (file-name-directory buffer-file-truename))) (let ((dirs (shrink-path-prompt (file-name-directory buffer-file-truename)))
(active (doom-modeline--active))) (active (doom-modeline--active)))
(if (null dirs) (if (null dirs)
@ -470,7 +463,7 @@ If TRUNCATE-TAIL is t also truncate the parent directory of the file."
'face (if file-faces `(:inherit ,file-faces))))))))) 'face (if file-faces `(:inherit ,file-faces)))))))))
(defun doom-modeline--buffer-file-name-relative (&optional include-project) (defun doom-modeline--buffer-file-name-relative (&optional include-project)
"Propertized variable `buffer-file-name' showing directories relative to project's root only." "Propertized variable `buffer-file-name' showing directories relative to INCLUDE-PROJECT root only."
(let ((root (doom-modeline-project-root)) (let ((root (doom-modeline-project-root))
(active (doom-modeline--active))) (active (doom-modeline--active)))
(if (null root) (if (null root)
@ -488,11 +481,12 @@ If TRUNCATE-TAIL is t also truncate the parent directory of the file."
(defun doom-modeline--buffer-file-name (truncate-project-root-parent) (defun doom-modeline--buffer-file-name (truncate-project-root-parent)
"Propertized variable `buffer-file-name'. "Propertized variable `buffer-file-name'.
If TRUNCATE-PROJECT-ROOT-PARENT is t space will be saved by truncating it down
fish-shell style.
Example: If TRUNCATE-PROJECT-ROOT-PARENT is t space will be saved by truncating it down
~/Projects/FOSS/emacs/lisp/comint.el => ~/P/F/emacs/lisp/comint.el" fish-shell style.
Example:
~/Projects/FOSS/emacs/lisp/comint.el => ~/P/F/emacs/lisp/comint.el"
(let* ((project-root (doom-modeline-project-root)) (let* ((project-root (doom-modeline-project-root))
(file-name-split (shrink-path-file-mixed project-root (file-name-split (shrink-path-file-mixed project-root
(file-name-directory buffer-file-name) (file-name-directory buffer-file-name)
@ -613,40 +607,61 @@ directory, the file name, and its state (modified, read-only or non-existent)."
;; vcs ;; vcs
;; ;;
(defvar-local doom-modeline--vcs nil)
(defun doom-modeline--update-vcs ()
"Update vsc state in mode-line."
(setq doom-modeline--vcs
(when (and vc-mode buffer-file-name)
(let* ((backend (vc-backend buffer-file-name))
(state (vc-state buffer-file-name backend)))
(let ((face 'mode-line-inactive)
(active (doom-modeline--active))
(all-the-icons-default-adjust -0.1))
(concat (if (display-graphic-p) " ")
(cond ((memq state '(edited added))
(if active (setq face 'doom-modeline-info))
(doom-modeline-maybe-icon-octicon
"git-compare"
:face face
:v-adjust -0.05))
((eq state 'needs-merge)
(if active (setq face 'doom-modeline-info))
(doom-modeline-maybe-icon-octicon "git-merge" :face face))
((eq state 'needs-update)
(if active (setq face 'doom-modeline-warning))
(doom-modeline-maybe-icon-octicon "arrow-down" :face face))
((memq state '(removed conflict unregistered))
(if active (setq face 'doom-modeline-urgent))
(doom-modeline-maybe-icon-octicon "alert" :face face))
(t
(if active (setq face 'font-lock-doc-face))
(doom-modeline-maybe-icon-octicon
"git-branch"
:face face
:v-adjust -0.05)))
" "
(propertize (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))
'face (if active face))
" "))))))
(add-hook 'after-save-hook #'doom-modeline--update-vcs)
(add-hook 'find-file-hook #'doom-modeline--update-vcs t)
(declare-function magit-toplevel "magit-git")
(defun doom-modeline-magit-post-refresh ()
"Update vcs state in mode-line after refreshing in magit."
(dolist (buf (buffer-list))
(when (and (not (buffer-modified-p buf))
(buffer-file-name buf)
(file-exists-p (buffer-file-name buf))
(file-in-directory-p (buffer-file-name buf) (magit-toplevel)))
(with-current-buffer buf
(vc-refresh-state)
(doom-modeline--update-vcs)))))
(add-hook 'magit-post-refresh-hook #'doom-modeline-magit-post-refresh)
(doom-modeline-def-segment vcs (doom-modeline-def-segment vcs
"Displays the current branch, colored based on its state." "Displays the current branch, colored based on its state."
(when (and vc-mode buffer-file-name) doom-modeline--vcs)
(let* ((backend (vc-backend buffer-file-name))
(state (vc-state buffer-file-name backend)))
(let ((face 'mode-line-inactive)
(active (doom-modeline--active))
(all-the-icons-default-adjust -0.1))
(concat (if (display-graphic-p) " ")
(cond ((memq state '(edited added))
(if active (setq face 'doom-modeline-info))
(doom-modeline-maybe-icon-octicon
"git-compare"
:face face
:v-adjust -0.05))
((eq state 'needs-merge)
(if active (setq face 'doom-modeline-info))
(doom-modeline-maybe-icon-octicon "git-merge" :face face))
((eq state 'needs-update)
(if active (setq face 'doom-modeline-warning))
(doom-modeline-maybe-icon-octicon "arrow-down" :face face))
((memq state '(removed conflict unregistered))
(if active (setq face 'doom-modeline-urgent))
(doom-modeline-maybe-icon-octicon "alert" :face face))
(t
(if active (setq face 'font-lock-doc-face))
(doom-modeline-maybe-icon-octicon
"git-branch"
:face face
:v-adjust -0.05)))
" "
(propertize (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))
'face (if active face))
" ")))))
;; ;;
@ -713,17 +728,19 @@ segment.")
lines are selected, or the NxM dimensions of a block selection." lines are selected, or the NxM dimensions of a block selection."
(when (and mark-active (doom-modeline--active)) (when (and mark-active (doom-modeline--active))
(cl-destructuring-bind (beg . end) (cl-destructuring-bind (beg . end)
(if (eq evil-state 'visual) (if (and (bound-and-true-p evil-state) (eq evil-state 'visual))
(cons evil-visual-beginning evil-visual-end) (cons evil-visual-beginning evil-visual-end)
(cons (region-beginning) (region-end))) (cons (region-beginning) (region-end)))
(propertize (propertize
(let ((lines (count-lines beg (min end (point-max))))) (let ((lines (count-lines beg (min end (point-max)))))
(concat (cond ((or (bound-and-true-p rectangle-mark-mode) (concat (cond ((or (bound-and-true-p rectangle-mark-mode)
(eq 'block evil-visual-selection)) (and (bound-and-true-p evil-visual-selection)
(eq 'block evil-visual-selection)))
(let ((cols (abs (- (doom-modeline-column end) (let ((cols (abs (- (doom-modeline-column end)
(doom-modeline-column beg))))) (doom-modeline-column beg)))))
(format "%dx%dB" lines cols))) (format "%dx%dB" lines cols)))
((eq evil-visual-selection 'line) ((and (bound-and-true-p evil-visual-selection)
(eq evil-visual-selection 'line))
(format "%dL" lines)) (format "%dL" lines))
((> lines 1) ((> lines 1)
(format "%dC %dL" (- end beg) lines)) (format "%dC %dL" (- end beg) lines))
@ -753,10 +770,13 @@ lines are selected, or the NxM dimensions of a block selection."
(defsubst doom-modeline--anzu () (defsubst doom-modeline--anzu ()
"Show the match index and total number thereof. "Show the match index and total number thereof.
Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
`evil-search'." `evil-search'."
(setq anzu-cons-mode-line-p nil) (setq anzu-cons-mode-line-p nil)
(when (and anzu--state (not iedit-mode)) (when (and (featurep 'anzu)
anzu--state
(not (bound-and-true-p iedit-mode)))
(propertize (propertize
(let ((here anzu--current-position) (let ((here anzu--current-position)
(total anzu--total-matched)) (total anzu--total-matched))
@ -772,7 +792,8 @@ Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
(defsubst doom-modeline--evil-substitute () (defsubst doom-modeline--evil-substitute ()
"Show number of matches for evil-ex substitutions and highlights in real time." "Show number of matches for evil-ex substitutions and highlights in real time."
(when (and evil-mode (when (and (featurep 'evil)
evil-mode
(or (assq 'evil-ex-substitute evil-ex-active-highlights-alist) (or (assq 'evil-ex-substitute evil-ex-active-highlights-alist)
(assq 'evil-ex-global-match evil-ex-active-highlights-alist) (assq 'evil-ex-global-match evil-ex-active-highlights-alist)
(assq 'evil-ex-buffer-match evil-ex-active-highlights-alist))) (assq 'evil-ex-buffer-match evil-ex-active-highlights-alist)))
@ -787,11 +808,12 @@ Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with
'face (if (doom-modeline--active) 'doom-modeline-panel)))) 'face (if (doom-modeline--active) 'doom-modeline-panel))))
(defun doom-modeline-themes--overlay-sort (a b) (defun doom-modeline-themes--overlay-sort (a b)
"Sort overlay A and B."
(< (overlay-start a) (overlay-start b))) (< (overlay-start a) (overlay-start b)))
(defsubst doom-modeline--iedit () (defsubst doom-modeline--iedit ()
"Show the number of iedit regions matches + what match you're on." "Show the number of iedit regions matches + what match you're on."
(when (and iedit-mode iedit-occurrences-overlays) (when (and (featurep 'iedit) iedit-mode iedit-occurrences-overlays)
(propertize (propertize
(let ((this-oc (or (let ((inhibit-message t)) (let ((this-oc (or (let ((inhibit-message t))
(iedit-find-current-occurrence-overlay)) (iedit-find-current-occurrence-overlay))