path: root/modally.el

;;; modally.el --- An Emacs mode-line                -*- lexical-binding: t; -*-

;; Copyright (C) 2024  Blake Romero

;; Author: Blake Romero <codeblake@outlook.com>
;; Keywords: extensions

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;

;;; Code:
;; (require 'subr-x)
;; (require 'cl-lib)
;; (require 'vc-git)
;; (require 'flymake)
;; (require 'org-timer)
(autoload 'org-timer-start "org-timer")

(require 'modally-faces)

;; FUNCTIONS
(defun modally--separator ()
  "Return a propertized separator."
  (propertize "┃" 'face (if (mode-line-window-selected-p)
                            'modally-separator-active
                          'modally-separator-inactive)))

(defun modally--read-only-status ()
  "Return a string to display read-only status."
  (format " %s %s"
          (propertize
           (if buffer-read-only "RO" "RW")
           'face (when (and (mode-line-window-selected-p)
                            buffer-read-only)
                   'modally-buffer-readonly))
          (modally--separator)))

(defun modally--buffer-name ()
  "Return a propertized buffer name string."
  (let* ((buffer-face (cond
                        ((not (mode-line-window-selected-p)) 'mode-line-inactive)
                        ((buffer-modified-p) 'modally-buffer-modified)
                        ('modally-buffer)))
         (buffer-name
          (if buffer-file-name
              (if (string-match "^\\(/home/[^/]+\\)\\(.+\\)"
                                buffer-file-name)
                  (concat "~" (match-string 2 buffer-file-name))
                buffer-file-name)
            (buffer-name (current-buffer))))
         (spath (string-split buffer-name "/")))
    ;; Format
    (if (> (length spath) 1)
        ;; if buffer has a path
        (let ((path (string-join (butlast spath) "/"))
              (filename (car (last spath))))
          (format "\s%s/%s"
                  (propertize path 'face 'modally-buffer-path)
                  (propertize filename 'face buffer-face)))
      ;; if a buffer
      (format "\s%s" (propertize buffer-name 'face buffer-face))
      )))

;; TODO: make cond into hashmap search
(defun modally--major-mode ()
  "Return a propertized major mode string."
  (let ((mode (string-remove-suffix "-mode" (symbol-name major-mode))))
    (format-mode-line (format " %s"
                              (cond
                                ((equal mode "emacs-lisp") "elisp")
                                ((equal mode "lisp-interaction") "lisp")
                                ((equal mode "messages-buffer") "messages")
                                (mode)))
                      (if (mode-line-window-selected-p)
                          'modally-major-mode
                        'mode-line-inactive))))

(defun modally--line-column ()
  "Return a propertized line column position."
  (format "%s %s"
          (format-mode-line
           " C%C"
           `(,(let ((column (current-column)))
                (cond
                  ((not (mode-line-window-selected-p)) 'mode-line-inactive)
                  ((>= column fill-column) 'error)
                  ((>= column (- fill-column 10)) 'warning)))))
          (modally--separator)))

(defun modally--git-branch ()
  "Return a propertized Git branch string."
  (when-let* ((buffer (buffer-file-name))
              (branch (vc-git--symbolic-ref buffer)))
    (format " %s %s"
            (propertize branch 'face (if (not (mode-line-window-selected-p))
                                         'mode-line-inactive
                                       'modally-git-branch))
            (modally--separator)
            )))

(defun modally--flymake-diagnostics ()
  "Return `flymake-mode' alert counts."
  (let ((errors 0) (warnings 0) (notes 0) (alerts))
    (dolist (d (flymake-diagnostics))
      (pcase (flymake-diagnostic-type d)
        (':error (cl-incf errors))
        (':warning (cl-incf warnings))
        (':note (cl-incf notes))))
    (when (or (> errors 0) (> warnings 0) (> notes 0))
      (when (> notes 0)
        (cl-pushnew
         (propertize (format "i%s" notes) 'face 'modus-themes-fg-blue) alerts))
      (when (> warnings 0)
        (cl-pushnew
         (propertize (format "w%s" warnings) 'face 'warning) alerts))
      (when (> errors 0)
        (cl-pushnew
         (propertize (format "e%s" errors) 'face 'error) alerts))
      (format " %s %s"
              (string-join alerts "\s")
              (modally--separator)
              ))))

(defun modally--approx-time (time)
  "Return an approximation of TIME."
  (let ((time (replace-regexp-in-string "<\\|>" "" time))
        (h (string-to-number
            (nth 0 (string-split time ":"))))
        (m (string-to-number
            (nth 1 (string-split time ":"))))
        (s (string-to-number
            (nth 2 (string-split time ":")))))
    (cond
     ((and (eq h 0) (eq m 0))
      (format "%ds" s))
     ((and (eq h 0) (> m 0))
      (format "~%dm" m))
     ((and (> h 0) (> m 0))
      (format "~%dh:%dm" h m)))))

(defun modally--org-timer ()
  "Return a timer from `org-timer'."
  (when (and
         (featurep 'org-timer)
         (or org-timer-mode-line-timer
             org-timer-pause-time)
         (mode-line-window-selected-p))
    (let ((face
           (cond
             (org-timer-pause-time 'modally-org-timer-pause)
             ('modally-org-timer)))
          )
      (format "\s%s %s "
              (propertize
               (modally--approx-time org-timer-mode-line-string)
               'face face)
              (modally--separator)
              ))))

;; VARIABLES
(defvar modally-display-read-only
  '(:eval (modally--read-only-status))
  "Modeline construct to display the read-only status.")

(defvar modally-display-buffer-name
  '(:eval (modally--buffer-name))
  "Modeline construct to display the buffer name.")

(defvar modally-display-major-mode
  '(:eval (modally--major-mode))
  "Modeline construct to display the major mode.")

(defvar modally-display-git-branch
  '(:eval (modally--git-branch))
  "Modeline construct to display the Git branch name.")

(defvar modally-display-line-column
  '(:eval (modally--line-column))
  "Modeline construct to display line & column position.")

(defvar modally-display-line-row
  '(:eval (format-mode-line "L%l"))
  "Modeline construct to display line & column position.")

(defvar modally-display-file-size
  '(:eval (format "%s %s"
           (format-mode-line "\s%I")
           (modally--separator)))
  "Modeline construct to display file size of buffer.")

(defvar modally-display-flymake
  '(:eval (modally--flymake-diagnostics))
  "Modeline construct to display flymake info.")

(defvar modally-display-org-timer
  '(:eval (modally--org-timer))
  "Modeline construct to display `org-timer' info.")

;; set as risky local variable
(dolist (construct '(modally-display-read-only
                     modally-display-buffer-name
                     modally-display-major-mode
                     modally-display-git-branch
                     modally-display-line-row
                     modally-display-line-column
                     modally-display-file-size
                     modally-display-flymake
                     modally-display-org-timer))
  (put construct 'risky-local-variable #'stringp))

;; FORMATS
(defvar modally-format-default
  `("%e"
    modally-display-read-only
    modally-display-buffer-name
    mode-line-format-right-align
    modally-display-org-timer
    modally-display-line-row
    modally-display-line-column
    modally-display-git-branch
    modally-display-file-size
    modally-display-flymake
    modally-display-major-mode
    "   ")
  "Default modally format for the mode-line.")

(setq-default mode-line-right-align-edge 'right-fringe)

;; HELPERS
(defun modally-set-theme ()
  "Set mode-line face."
  (interactive)
  (if (eq 'dark (frame-parameter nil 'background-mode))
      (modally-set-dark-theme)
    (modally-set-light-theme)))

(defun modally--reset-face()
  "Reset mode-line face."
  (set-face-attribute
   'mode-line nil
   :background "black"
   :foreground "white"
   :box t))

(defun modally--reset-mode-line ()
  "Reset mode-line."
  (setq-default mode-line-format (car (get 'mode-line-format 'standard-value)))
  (modally--reset-face))

(defun modally--set-mode-line ()
  "Set modally mode-line."
  (setq-default mode-line-format modally-format-default)
  (with-eval-after-load 'keycast
    (setq-default keycast-mode-line-insert-after 'modally-display-buffer-name))
  (modally-set-theme))

;; MODE
;;;###autoload
(define-minor-mode modally-mode
  "An Emacs mode-line."
  :group 'modally
  :global t
  :require '(subr-x vc-git flymake cl-lib)
  :lighter " MDLY"
  (if modally-mode
      (modally--set-mode-line)
    (modally--reset-mode-line)))

(defun modally-set-dark-theme()
  "Modally dark mode theme."
  (let ((fg "#ffffff")
        (mg "#444444")
        (dm "#222222")
        (bg "#000000"))
    (set-face-attribute 'modally-separator-active nil :foreground mg)
    (set-face-attribute 'modally-separator-inactive nil :foreground dm)
    (set-face-attribute 'vertical-border nil :foreground mg)
(set-face-attribute
     'mode-line-active nil
     :foreground fg
     :background bg
     :box `(:line-width (20 . 2) :color ,mg))
    (set-face-attribute
     'mode-line-inactive nil
     :foreground dm
     :background bg
     :box `(:line-width (20 . 2) :color ,dm))))

(defun modally-set-light-theme()
  "Modally dark mode theme."
  (let ((fg "#000000")
        (mg "#dddddd")
        (dm "#ffffff")
        (bg "#eeeeee"))
    (set-face-attribute 'modally-separator-active nil :foreground mg)
    (set-face-attribute 'modally-separator-inactive nil :foreground bg)
    (set-face-attribute 'vertical-border nil :foreground mg)
    (set-face-attribute
     'mode-line-active nil
     :foreground fg
     :background dm
     :box `(:line-width (20 . 2) :color ,mg))
    (set-face-attribute
     'mode-line-inactive nil
     :foreground mg
     :background dm
     :box `(:line-width (20 . 2) :color ,bg))))

;; Theme update on toggle
(advice-add 'modus-themes-toggle :after 'modally-set-theme)

(provide 'modally)
;;; modally.el ends here