;; -*- lexical-binding: t; -*-

(require 'cl-lib)
(require 'subr-x)

(defvar my/ml-icons t
  "Non-nil uses Nerd Font glyphs, nil falls back to ASCII.")

;; Transparent background, white text
(set-face-attribute 'mode-line nil
                    :background "unspecified-bg" :foreground "white"
                    :box nil :inverse-video nil :underline nil :overline nil)
(set-face-attribute 'mode-line-inactive nil
                    :background "unspecified-bg" :foreground "brightblack"
                    :box nil :inverse-video nil :underline nil :overline nil)

;;;; git diff counts (+added ~modified -removed), refreshed on open and save
(defvar-local my/ml-diff-stat nil)

(defun my/ml-diff-update ()
  (setq my/ml-diff-stat nil)
  (when (and buffer-file-name
             (not (file-remote-p buffer-file-name))
             (eq (vc-backend buffer-file-name) 'Git))
    (let ((file buffer-file-name)
          (default-directory (file-name-directory buffer-file-name))
          (a 0) (m 0) (r 0))
      (with-temp-buffer
        (when (eq 0 (process-file "git" nil t nil "diff" "-U0" "--no-color"
                                  "--no-ext-diff" "--" file))
          (goto-char (point-min))
          (while (re-search-forward
                  "^@@ -[0-9]+\\(?:,\\([0-9]+\\)\\)? \\+[0-9]+\\(?:,\\([0-9]+\\)\\)? @@"
                  nil t)
            (let ((o (if (match-string 1) (string-to-number (match-string 1)) 1))
                  (n (if (match-string 2) (string-to-number (match-string 2)) 1)))
              (cond ((= o 0) (cl-incf a n))
                    ((= n 0) (cl-incf r o))
                    (t (cl-incf m (min o n))
                       (cl-incf a (max 0 (- n o)))
                       (cl-incf r (max 0 (- o n)))))))))
      (setq my/ml-diff-stat (list a m r)))))

(add-hook 'find-file-hook #'my/ml-diff-update)
(add-hook 'after-save-hook #'my/ml-diff-update)
(add-hook 'after-revert-hook #'my/ml-diff-update)

;;;; components
(defun my/ml-state ()
  (if (bound-and-true-p evil-local-mode) evil-state 'emacs))

(defun my/ml-block (text)
  (propertize text 'face '(:foreground "black" :background "white" :weight bold)))

(defun my/ml-mode ()
  (my/ml-block
   (format " %s "
           (pcase (my/ml-state)
             ('normal "NORMAL")
             ('insert "INSERT")
             ('visual (pcase (bound-and-true-p evil-visual-selection)
                        ('line "V-LINE") ('block "V-BLOCK") (_ "VISUAL")))
             ('replace "REPLACE")
             ('operator "O-PENDING")
             ('motion "MOTION")
             (_ "EMACS")))))

(defun my/ml-branch ()
  (when (and vc-mode (stringp vc-mode))
    (concat (if my/ml-icons "\ue0a0 " "")
            (replace-regexp-in-string "\\`[ ]*[A-Za-z]+[-:@!?]" "" vc-mode))))

(defun my/ml-diff ()
  (when my/ml-diff-stat
    (pcase-let ((`(,a ,m ,r) my/ml-diff-stat))
      (let ((parts (delq nil (list (and (> a 0) (format "+%d" a))
                                   (and (> m 0) (format "~%d" m))
                                   (and (> r 0) (format "-%d" r))))))
        (when parts (string-join parts " "))))))

(defun my/ml-diag ()
  (when (bound-and-true-p flymake-mode)
    (let ((e 0) (w 0) (i 0))
      (dolist (d (flymake-diagnostics))
        (let ((ty (flymake-diagnostic-type d)))
          (cond ((memq ty '(:error eglot-error))     (cl-incf e))
                ((memq ty '(:warning eglot-warning)) (cl-incf w))
                ((memq ty '(:note eglot-note))       (cl-incf i)))))
      (let ((parts (delq nil
                         (list (and (> e 0) (format "%s%d" (if my/ml-icons "\U000F015A " "E:") e))
                               (and (> w 0) (format "%s%d" (if my/ml-icons "\U000F002A " "W:") w))
                               (and (> i 0) (format "%s%d" (if my/ml-icons "\U000F02FD " "I:") i))))))
        (when parts (string-join parts " "))))))

(defun my/ml-file ()
  (concat (buffer-name)
          (cond (buffer-read-only " [-]")
                ((buffer-modified-p) " [+]")
                (t ""))))

(defun my/ml-encoding ()
  (replace-regexp-in-string "-\\(unix\\|dos\\|mac\\)\\'" ""
                            (symbol-name (or buffer-file-coding-system 'utf-8))))

(defun my/ml-eol ()
  (pcase (coding-system-eol-type (or buffer-file-coding-system 'utf-8-unix))
    (1 (if my/ml-icons "\ue70f" "dos"))
    (2 (if my/ml-icons "\uf179" "mac"))
    (_ (if my/ml-icons "\uf17c" "unix"))))

(defun my/ml-filetype ()
  (string-remove-suffix "-mode" (symbol-name major-mode)))

(defun my/ml-loc (block)
  (let ((s (format " %s:%-2d " (format-mode-line "%3l") (1+ (current-column)))))
    (if block (my/ml-block s) s)))

(defun my/ml-section (items)
  (let ((items (cl-remove-if (lambda (s) (or (null s) (string-empty-p s))) items)))
    (if items (concat " " (string-join items " | ") " ") "")))

;;;; assembly
(defun my/ml-format ()
  (let* ((active (mode-line-window-selected-p))
         (left (if active
                   (concat (my/ml-mode)
                           (my/ml-section (list (my/ml-branch) (my/ml-diff) (my/ml-diag)))
                           (my/ml-section (list (my/ml-file))))
                 (my/ml-section (list (my/ml-file)))))
         (right (if active
                    (concat (my/ml-section (list (my/ml-encoding) (my/ml-eol) (my/ml-filetype)))
                            (my/ml-loc t))
                  (my/ml-loc nil)))
         (fill (propertize " " 'display
                           `((space :align-to (- right ,(string-width right)))))))
    (concat left fill right)))

(setq-default mode-line-format '((:eval (my/ml-format))))

(provide 'modeline)