mode-line+

mode-line+.el

;;; -*- 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