;; Most of the code in this file is based on:
;;   https://git.sr.ht/~protesilaos/dotfiles/tree/cf26bc34/item/emacs/.emacs.d/prot-lisp/prot-modeline.el
;;
;; All Kudos to Prot.

;;;; Faces
(defface rul-modeline-indicator-red
  '((default :inherit bold)
    (((class color) (min-colors 88) (background light))
     :foreground "#880000")
    (((class color) (min-colors 88) (background dark))
     :foreground "#ff9f9f")
    (t :foreground "red"))
  "Face for modeline indicators.")

;;;; Common helper functions
(defcustom rul-modeline-string-truncate-length 9
  "String length after which truncation should be done in small windows."
  :type 'natnum)

(defun rul-modeline--string-truncate-p (str)
  "Return non-nil if STR should be truncated."
  (and (< (window-total-width) split-width-threshold)
       (> (length str) rul-modeline-string-truncate-length)
       (not (one-window-p :no-minibuffer))))

(defun rul-modeline-string-truncate (str)
  "Return truncated STR, if appropriate, else return STR.
Truncation is done up to `rul-modeline-string-truncate-length'."
  (if (rul-modeline--string-truncate-p str)
      (concat (substring str 0 rul-modeline-string-truncate-length) "...")
    str))

;;;; Major mode
(defun rul-modeline-major-mode-indicator ()
  "Return appropriate propertized mode line indicator for the major mode."
  (let ((indicator (cond
                    ((derived-mode-p 'text-mode) "§")
                    ((derived-mode-p 'prog-mode) "λ")
                    ((derived-mode-p 'comint-mode) ">_")
                    (t "◦"))))
    (propertize indicator 'face 'shadow)))

(defun rul-modeline-major-mode-name ()
  "Return capitalized `major-mode' without the -mode suffix."
  (capitalize (string-replace "-mode" "" (symbol-name major-mode))))

(defun rul-modeline-major-mode-help-echo ()
  "Return `help-echo' value for `rul-modeline-major-mode'."
  (if-let ((parent (get major-mode 'derived-mode-parent)))
      (format "Symbol: `%s'.  Derived from: `%s'" major-mode parent)
    (format "Symbol: `%s'." major-mode)))

(defvar-local rul-modeline-major-mode
    (list
     (propertize "%[" 'face 'rul-modeline-indicator-red)
     '(:eval
       (concat
        (rul-modeline-major-mode-indicator)
        " "
        (propertize
         (rul-modeline-string-truncate
          (rul-modeline-major-mode-name))
         'mouse-face 'mode-line-highlight
         'help-echo (rul-modeline-major-mode-help-echo))))
     (propertize "%]" 'face 'rul-modeline-indicator-red))
  "Mode line construct for displaying major modes.")

;(makunbound 'rul-modeline-major-mode)

;;;; Align right
(defun prot-modeline--right-align-rest ()
  "Return string if everything after `prot-modeline-align-right'."
  (format-mode-line
   `(""
     ,@(cdr (memq 'prot-modeline-align-right mode-line-format)))))

(defun prot-modeline--right-align-width ()
  "Return pixel width of `prot-modeline--right-align-rest'."
  (string-pixel-width (prot-modeline--right-align-rest)))

(defun prot-modeline--box-p ()
  "Return non-nil if the `mode-line' has a box attribute."
  (and (face-attribute 'mode-line :box)
       (null (eq (face-attribute 'mode-line :box) 'unspecified))))

(defun prot-modeline--variable-pitch-p ()
  "Return non-nil if the `mode-line' inherits `variable-pitch'."
  (when-let* ((mode-line-inherit (face-attribute 'mode-line :inherit))
              ((string-match-p "variable-pitch" (symbol-name mode-line-inherit)))
              (family-face (face-attribute mode-line-inherit :inherit))
              (variable-pitch
               (if (listp family-face)
                   (memq 'variable-pitch family-face)
                 (eq 'variable-pitch family-face))))
    variable-pitch))

(defun prot-modeline--magic-number ()
  "Return constant for use in `prot-modeline-align-right'."
  (let ((height (face-attribute 'mode-line :height nil 'default))
        (m-width (string-pixel-width (propertize "m" 'face 'mode-line))))
    (round height (* m-width (* height m-width 0.001)))))

(defvar-local prot-modeline-align-right
    '(:eval
      (propertize
       " "
       'display
       (let ((box-p (prot-modeline--box-p))
             (variable-pitch-p (prot-modeline--variable-pitch-p))
             (magic-number (prot-modeline--magic-number)))
         `(space
           :align-to
           (- right
              right-fringe
              right-margin
              ,(ceiling
                (prot-modeline--right-align-width)
                (string-pixel-width (propertize "m" 'face 'mode-line)))
              ,(cond
                ((and variable-pitch-p box-p)
                 (* magic-number 0.5))
                ((and (not variable-pitch-p) box-p)
                 (* magic-number 0.25))
                ((and variable-pitch-p (not box-p))
                 (* magic-number -0.05))
                (t (* magic-number -0.1))))))))
  "Mode line construct to align following elements to the right.
Read Info node `(elisp) Pixel Specification'.")


;;;; Variables used in the modeline need to be in `risky-local-variable'.
(dolist (construct '(
                     rul-modeline-major-mode
                     rul-modeline-misc-info
                     prot-modeline-align-right
                     ))
  (put construct 'risky-local-variable t))

;;;; Miscellaneous
(defvar-local rul-modeline-misc-info
    '(:eval
      (when (mode-line-window-selected-p)
        mode-line-misc-info))
  "Mode line construct displaying `mode-line-misc-info'.
Specific to the current window's mode line.")

;;;; Finally, define the modeline format
(setq-default mode-line-format
              '("%e"
                mode-line-front-space
                mode-line-buffer-identification
                mode-line-front-space
                rul-modeline-major-mode
                prot-modeline-align-right
                rul-modeline-misc-info
                ))

(provide 'rul-modeline)