Skip to content

Instantly share code, notes, and snippets.

@guitmz
Forked from clemera/mode-line+.el
Created August 9, 2022 20:41
Show Gist options
  • Save guitmz/4cbf8bc77f5619e38f73c4b45b15fcf1 to your computer and use it in GitHub Desktop.
Save guitmz/4cbf8bc77f5619e38f73c4b45b15fcf1 to your computer and use it in GitHub Desktop.
mode-line+
;;; -*- lexical-binding: t; -*-
;; doom-mode-line > mood-line > mode-line+
;; * Deps
(defvar anzu--state nil)
(defvar multiple-cursors-mode nil)
(declare-function flycheck-count-errors "ext:flycheck" (errors))
(declare-function anzu--update-mode-line "ext:anzu" ())
(declare-function mc/num-cursors "ext:multiple-cursors" ())
;; ** All the icons
(package! 'all-the-icons t)
;; > all-the-icons-install-fonts
;; ** Minions
(package! 'minions t)
(setq minions-mode-line-delimiters
(cons "" ""))
(setq minions-mode-line-lighter "⚙")
;; remove trailing space and guard
(let ((minions nil))
(dolist (m minions-mode-line-modes)
(push m minions))
(when (string= " " (car minions))
(pop minions))
(setq minions-mode-line-modes (nreverse minions)))
;; * Config
(defgroup mode-line+ nil
"A minimal mode-line configuration inspired by doom-modeline."
:group 'mode-line)
(defface mode-line-status-info+
'((t (:inherit (font-lock-keyword-face))))
"Face used for generic status indicators in the mode-line."
:group 'mode-line+)
(defface mode-line-status-good+
'((t (:inherit (success))))
"Face used for success status indicators in the mode-line."
:group 'mode-line+)
(defface mode-line-status-warning+
'((t (:inherit (warning))))
"Face for warning status indicators in the mode-line."
:group 'mode-line+)
(defface mode-line-status-error+
'((t (:inherit (error))))
"Face for error stauts indicators in the mode-line."
:group 'mode-line+)
(defface mode-line-status-grayed-out+
'((t (:inherit (font-lock-doc-face))))
"Face used for neutral or inactive status indicators in the mode-line."
:group 'mode-line+)
(defface mode-line-unimportant+
'((t (:inherit (font-lock-doc-face))))
"Face used for less important mode-line elements."
:group 'mode-line+)
(defface mode-line-modified+
'((t (:inherit (error))))
"Face used for the 'modified' indicator symbol in the mode-line."
:group 'mode-line+)
;; * Helper functions
(defvar mode-line--current-window+ (frame-selected-window))
(defun mode-line--update-selected-window+ (&rest _)
"Keep track of active window.
Store the active window in `mode-line--current-window+' variable."
(let ((window (frame-selected-window)))
(when (and (windowp window)
(not (minibuffer-window-active-p window)))
(setq mode-line--current-window+ window))))
;; Define a helper function to determine whether or not the current window is active.
(defun mode-line-face-if-active+ (active &optional inactive)
"Return FACE for current window."
(if (mode-line-is-active+)
active
inactive))
(defsubst mode-line-is-active+ ()
"Return non-nil if the current window is active."
(eq (selected-window) mode-line--current-window+))
(defun mode-line-format+ (left right)
"Return a string of `window-width' length containing LEFT and RIGHT, aligned respectively."
(let ((left (concat left " "))
(reserve (length right)))
(concat
left
(propertize " " 'display `((space :align-to (- right ,reserve))))
right)))
;; * Update functions
;; VC update function
(defvar-local mode-line--vc-text+ nil)
(defun mode-line--update-vc-segment+ (&rest _)
"Update `mode-line--vc-text+' against the current VCS state."
(setq mode-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))))
(let ((face 'mode-line-inactive)
(active (mode-line-is-active+)))
(concat (cond ((memq state '(edited added))
(if active (setq face 'mode-line-status-info+))
(propertize "✚" 'face face))
((eq state 'needs-merge)
(if active (setq face 'mode-line-status-warning+))
(propertize "●" 'face face))
((eq state 'needs-update)
(if active (setq face 'mode-line-status-warning+))
(propertize "⬆" 'face face))
((memq state '(removed conflict unregistered))
(if active (setq face 'mode-line-status-error+))
(propertize "✖" 'face face))
(t
(if active (setq face 'mode-line-status-grayed-out+))
(propertize "✔" 'face face)))
" "
(propertize (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2))
'face (if active face))
" "))))))
;; * Segments
(defvar all-the-icons-scale-factor)
(defun mode-line-segment-buffer-name+ ()
"Displays the name of the current buffer in the mode-line."
(concat " "
(cond ((eq major-mode 'shell-mode)
(shorten-directory+ default-directory 20))
(t
(if (and (buffer-modified-p)
(buffer-file-name))
(propertize "%b"
'face 'bold
'mouse-face 'mode-line-highlight
'local-map (make-mode-line-mouse-map
'mouse-1
'save-buffer))
(propertize "%b"
;;'face 'mode-line-buffer-id
'mouse-face 'mode-line-highlight
'local-map (make-mode-line-mouse-map
'mouse-1
'dired-here-please)))))))
(defun mode-line-segment-mode-icon+ ()
(if (eq major-mode 'fundamental-mode)
(all-the-icons-octicon
;; dash
"question"
:height (/ all-the-icons-scale-factor 1.4)
:v-adjust 0.0)
(all-the-icons-icon-for-mode
major-mode
:height (/ all-the-icons-scale-factor 1.4)
:v-adjust (if (derived-mode-p 'emacs-lisp-mode)
-0.1 0.0))))
(defun mode-line-segment-buffer-status+ ()
"Return buffer status."
(let ((icons ()))
(when (and buffer-file-name
(file-remote-p buffer-file-name))
(push (all-the-icons-octicon "radio-tower" :v-adjust -0.02)
icons))
(cond (buffer-read-only
(push (all-the-icons-octicon "lock" :v-adjust -0.05)
icons))
((and buffer-file-name
(not (file-exists-p buffer-file-name)))
(push (all-the-icons-octicon "circle-slash" :v-adjust -0.01)
icons)))
(when (buffer-narrowed-p)
(push (propertize
(all-the-icons-octicon
"fold"
:height (/ all-the-icons-scale-factor 1.4)
:v-adjust 0.0))
icons))
(when icons
(concat " "
(mapconcat 'identity
(nreverse icons) " ")))))
(defun mode-line-segment-anzu+ ()
"Displays color-coded anzu status information in the mode-line (if available)."
(when anzu--state
(concat (anzu--update-mode-line) " ")))
(defun mode-line-segment-multiple-cursors+ ()
"Displays the number of active multiple-cursors in the mode-line (if available)."
(when multiple-cursors-mode
(concat "MC:"
(format #("%d" 0 2 (face font-lock-warning-face)) (mc/num-cursors))
" ")))
(defun mode-line-segment-position+ ()
"Displays the current cursor position in the mode-line."
;; %C for column 1 based
(let ((col (format-mode-line "%C"))
(line (format-mode-line "%l")))
;; comint modes fail to display it
(if (string= line "??")
(setq line (number-to-string (line-number-at-pos (point)))))
(concat " "
line
":"
;; avoid bumping in mode line
(if (< (length col) 2)
"0" "")
col
(format " %s" (point))
" %p%%"
)))
(defun mode-line-segment-encoding+ ()
"Displays the encoding and EOL style of the buffer in the mode-line."
(concat (pcase (coding-system-eol-type buffer-file-coding-system)
(0 "LF ")
(1 "CRLF ")
(2 "CR "))
(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))))))
" "))
(defun mode-line-segment-vc+ ()
"Displays color-coded version control information in the mode-line."
;; (:eval
;; (if vc-mode
;; (let* ((noback (replace-regexp-in-string
;; (format "^ %s" (vc-backend buffer-file-name)) " " vc-mode))
;; (face (cond ((string-match "^ -" noback) 'mode-line-vc)
;; ((string-match "^ [:@]" noback) 'mode-line-vc-edit)
;; ((string-match "^ [!\\?]" noback) 'mode-line-vc-modified))))
;; (format "[git:%s]" (substring noback 2)))))))
mode-line--vc-text+)
(defun mode-line-segment-flycheck+ ()
"Return the status of flycheck to be displayed in the mode-line."
(when (bound-and-true-p flycheck-mode)
(let* ((text
(pcase flycheck-last-status-change
(`finished
(if flycheck-current-errors
(let ((count (let-alist (flycheck-count-errors
flycheck-current-errors)
(+ (or .warning 0) (or .error 0)))))
(propertize
(format "✖ %s Issue%s" count (if (eq 1 count) "" "s"))
'face (mode-line-face-if-active+ 'font-lock-keyword-face)))
(propertize
"✔ No Issues"
'face (mode-line-face-if-active+ 'success))))
(`running
(propertize
"⟲ Running"
'face (mode-line-face-if-active+ 'warning)))
(`no-checker
(propertize
"✖ No Checker"
'face (mode-line-face-if-active+ 'warning)))
(`not-checked
"● Disabled")
(`errored (propertize
"⚠ Error"
'face
(mode-line-face-if-active+ 'error)))
(`interrupted
(propertize
"⛔ Interrupted"
'face (mode-line-face-if-active+ 'error)))
(`suspicious ""))))
(propertize text
'help-echo "Show Flycheck Errors"
'local-map (make-mode-line-mouse-map
'mouse-1 #'flycheck-list-errors)))))
(defun mode-line-segement-auto-compile ()
(let ((src (buffer-file-name))
dst)
(when (and src (setq dst (byte-compile-dest-file src)))
(list
" "
(when (and auto-compile-mode-line-counter
(> auto-compile-warnings 0))
(propertize
(format "%s" auto-compile-warnings)
'help-echo (format "%s compile warnings\nmouse-1 display compile log"
auto-compile-warnings)
'face 'error
'mouse-face 'mode-line-highlight
'local-map (purecopy (make-mode-line-mouse-map
'mouse-1
#'auto-compile-display-log))))
(cond
((and auto-compile-pretend-byte-compiled
(not (file-exists-p dst)))
(propertize
"!"
'help-echo "Failed to byte-compile updating\nmouse-1 retry"
'mouse-face 'mode-line-highlight
'local-map (purecopy (make-mode-line-mouse-map
'mouse-1
#'auto-compile-mode-line-byte-compile))))
((not (file-exists-p dst))
(propertize
"%%"
'help-echo "Byte-compiled file doesn't exist\nmouse-1 create"
'mouse-face 'mode-line-highlight
'local-map (purecopy (make-mode-line-mouse-map
'mouse-1
#'mode-line-toggle-auto-compile))))
((file-newer-than-file-p src dst)
(propertize
"*"
'help-echo "Byte-compiled file needs updating\nmouse-1 update"
'mouse-face 'mode-line-highlight
'local-map (purecopy (make-mode-line-mouse-map
'mouse-1
#'auto-compile-mode-line-byte-compile))))
;; bc is up to date
(t ""))))))
(defun mode-line-segment-front-space+ ()
"Setup mode line padding."
;; (if (zerodark--active-window-p)
;; ;;(list :line-width 4 :color "grey90"))
;; :box
(if (and (not (window-dedicated-p))
(display-graphic-p))
(propertize " " 'display
'((raise -0.2) (height 1.4)))
mode-line-front-space))
;; * Main
;; (moody-replace-vc-mode)
(defvar-local mode-line-remap-cookies+ nil)
(defvar-local window-side+ nil
"Record the side of window showing buffer.")
(defun mode-line-color+ ()
(prog1 nil
(if (window-dedicated-p)
(setq mode-line-remap-cookies+
(list (face-remap-add-relative 'mode-line
'(:background "seashell"))
(face-remap-add-relative 'mode-line-inactive
'(:background "seashell")))
window-side+ (window-parameter nil 'window-side))
(mapcar #'face-remap-remove-relative mode-line-remap-cookies+))))
;; Default mode line:
;; ("%e"
;; mode-line-front-space
;; mode-line-mule-info
;; mode-line-client
;; mode-line-modified
;; mode-line-auto-compile
;; mode-line-remote
;; mode-line-frame-identification
;; mode-line-buffer-identification
;; " "
;; mode-line-position
;; (vc-mode vc-mode)
;; " "
;; mode-line-modes
;; mode-line-misc-info
;; mode-line-end-spaces
;; )
(defvar mode-line--saved-default+ nil)
(defvar mode-line-format+
'(""
(:eval (mode-line-color+))
(:eval
(mode-line-format+
;; Left
(format-mode-line
'("%e"
(:eval (mode-line-segment-front-space+)) ;mode-line-front-space
(:eval (mode-line-segment-mode-icon+))
;; mode-line-mule-info
;; mode-line-client
;; mode-line-modified
(:eval (mode-line-segment-buffer-status+))
;; mode-line-remote
;; mode-line-frame-identification
(:eval (mode-line-segment-buffer-name+)) ;mode-line-buffer-identification
(:eval (mode-line-segment-anzu+))
(:eval (mode-line-segment-multiple-cursors+))
(:eval (mode-line-segment-position+))))
;; Right
(format-mode-line
'((:eval (mode-line-segment-vc+)) ;(vc-mode vc-mode)
(:eval (mode-line-segment-flycheck+))
(:eval (mode-line-segement-auto-compile))
" "
mode-line-misc-info
minions-mode-line-modes ;mode-line-modes
mode-line-end-spaces))))))
;;;###autoload
(define-minor-mode mode-line-mode+
"Replace the current mode-line with mode-line.+"
:global t
:lighter ""
(cond (mode-line-mode+
;; Save old format
(setq mode-line--saved-default+ (default-value 'mode-line-format))
;; Set the new mode-line-format
(setq-default mode-line-format mode-line-format+)
(dolist (buf (buffer-list))
(setf (buffer-local-value 'mode-line-format (current-buffer))
mode-line-format+))
;; Setup flycheck hooks (if available)
;;(add-hook 'flycheck-status-changed-functions #'mode-line-segment-flycheck+)
;;(add-hook 'flycheck-mode-hook #'mode-line-segment-flycheck+)
;; Setup VC hooks (if available)
(add-hook 'find-file-hook #'mode-line--update-vc-segment+)
(add-hook 'after-save-hook #'mode-line--update-vc-segment+)
(advice-add #'vc-refresh-state :after #'mode-line--update-vc-segment+)
;; Setup remembering active window
(add-hook 'window-configuration-change-hook #'mode-line--update-selected-window+)
(add-hook 'focus-in-hook #'mode-line--update-selected-window+)
(advice-add #'handle-switch-frame :after #'mode-line--update-selected-window+)
(advice-add #'select-window :after #'mode-line--update-selected-window+))
(t
;; Set the old mode-line-format
(setq-default mode-line-format mode-line--saved-default+)
(dolist (buf (buffer-list))
(setf (buffer-local-value 'mode-line-format (current-buffer))
(default-value 'mode-line-format)))
;; Setup flycheck hooks (if available)
;;(remove-hook 'flycheck-status-changed-functions #'mode-line-segment-flycheck+)
;;(remove-hook 'flycheck-mode-hook #'mode-line-segment-flycheck+)
;; Setup VC hooks (if available)
(remove-hook 'find-file-hook #'mode-line--update-vc-segment+)
(remove-hook 'after-save-hook #'mode-line--update-vc-segment+)
(advice-remove #'vc-refresh-state #'mode-line--update-vc-segment+)
;; Setup remembering active window
(remove-hook 'window-configuration-change-hook #'mode-line--update-selected-window+)
(remove-hook 'focus-in-hook #'mode-line--update-selected-window+)
(advice-remove #'handle-switch-frame #'mode-line--update-selected-window+)
(advice-remove #'select-window #'mode-line--update-selected-window+))))
(provide 'mode-line+)
;;; mode-line+.el ends here
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment