path: root/modeline.el

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

;;;###autoload
(defun modeline-format-main ()
  "The main mode line format."
  (let* ((left (modeline-format-left))
         (right (modeline-format-right))
         (left-len (length left))
         (right-len (length right))
         (middle (propertize " " 'display
                             (make-string (- (window-total-width)
                                             left-len
                                             right-len)
                                          32))))
    (concat left middle right)))

(setq-default mode-line-format '("%e" (:eval (modeline-format-main))))

;;;###autoload
(defun modeline-format-dashboard ()
  "The mode line format for the dashboard."
  (concat
   ;; (modeline-format-bar)
   (modeline-spc)
   (modeline-format-directory)))

;;;###autoload
(defun modeline-format-left ()
  "The left mode line format."
  (concat
   ;; (modeline-format-bar)
   (modeline-spc)
   (modeline-format-buffer-status)
   (modeline-spc)
   (modeline-format-buffer-name)
   (modeline-spc)
   (modeline-format-position)
   (modeline-spc)
   (modeline-format-buffer-size)))

;;;###autoload
(defun modeline-format-right ()
  "The right mode line format."
  (concat
   (modeline-format-input-method)
   (modeline-format-major-mode)
   (modeline-format-vc-mode)))

;;; Conveniently add text properties

;;;###autoload
(defmacro modeline-propertize (str &optional mouse-face help-echo map)
  "Give STR appropriate text properties.
MOUSE-FACE is used when the mouse is over the text.
HELP-ECHO is the additional information displayed when the mouse is over the text.
MAP is the local keymap of the text."
  (let ((mouse-face (or mouse-face 'mode-line-highlight)))
    `(propertize ,str
      'mouse-face ',mouse-face
      'help-echo ,help-echo
      'local-map ,map)))

;;; Determination of the active mode-line

;; NOTE: I tried to avoid this, but it turns out that this is the most
;; reliable way to do so.

;;;###autoload
(defun modeline-get-active-window (&optional frame)
  "The active window excluding the child windows."
  (if (and (fboundp 'frame-parent) (frame-parent frame))
      (frame-selected-window (frame-parent frame))
    (frame-selected-window frame)))

;;;###autoload
(defvar modeline-active-window (modeline-get-active-window)
  "The active window excluding the child windows.")

;;;###autoload
(defun modeline-active-window-p ()
  "Whether we are in the active window."
  (and modeline-active-window
       (eq modeline-active-window (selected-window))))

;;;###autoload
(defun modeline-set-active-window (&rest _)
  "Update `modeline-active-window'."
  (let ((active-wn (modeline-get-active-window)))
    (cond
     ((minibuffer-window-active-p active-wn))
     (t (setq modeline-active-window active-wn))))
  (force-mode-line-update t))

;;;###autoload
(defsubst modeline-unset-active-window (&rest _)
  "Set `modeline-active-window' to `nil'."
  (setq modeline-active-window nil))

;;;###autoload
(defun modeline-refresh-modeline ()
  "Refresh the focus state of the mode line."
  (setq modeline-active-window nil)
  (mapc (lambda (frame)
          (cond ((eq (frame-focus-state frame) t)
                 (setq modeline-active-window (modeline-get-active-window frame)))))
        (frame-list)))

(add-hook 'window-configuration-change-hook #'modeline-set-active-window)
(add-hook 'buffer-list-update-hook #'modeline-set-active-window)
(add-hook 'after-make-frame-functions #'modeline-set-active-window)
(add-hook 'delete-frame-functions #'modeline-set-active-window)
(advice-add #'handle-switch-frame :after #'modeline-set-active-window)
(add-function :after after-focus-change-function #'modeline-refresh-modeline)

;;; Faces

;; NOTE: These faces are not actually defined here.
;;       They are found here simply because they need to have a formal declaration to work.

;;;###autoload
(defface doom-modeline-buffer-modified nil
  "The face for mode line buffer identification.")

;;;###autoload
(defface doom-modeline-warning nil
  "The face for mode line warning.")

;;;###autoload
(defface doom-modeline-urgent nil
  "The face for mode line urgent.")

;;;###autoload
(defface doom-modeline-info nil
  "The face for mode line info.")

;;;###autoload
(defface doom-modeline-buffer-major-mode nil
  "The face for mode line major mode.")

;;;###autoload
(defface doom-modeline-input-method nil
  "The face for mode line input method.")

;;;###autoload
(defface doom-modeline-input-method-alt nil
  "The alternative face for mode line input method.")

;;; Various sections of the mode line

;;;###autoload
(defun modeline-format-directory ()
  "Display the default directory on the mode line."
  (modeline-propertize
   (propertize
    default-directory
    'face (cond ((modeline-active-window-p) 'mode-line)
                (t 'mode-line-inactive)))
   nil "The current directory\nmouse-1: Open that directory"
   (let ((map '(keymap)))
     (define-key map (vector 'mode-line 'down-mouse-1)
       (lambda () (interactive) (dired default-directory)))
     map)))

;;;###autoload
(defun modeline-spc ()
  "A space with the appropriate face."
  (format-mode-line " "
                    (cond ((modeline-active-window-p)
                           'mode-line)
                          (t 'mode-line-inactive))))

;;;###autoload
(defvar modeline-bar-width 3
  "The width of the mode line bar")

;;;###autoload
(defvar modeline-bar-height 27
  "The height of the mode line bar")

;;;###autoload
(defvar modeline-bar-color (face-background 'modus-theme-active-blue nil t)
  "The color for the bar of the mode line.")

;;;###autoload
(defvar modeline-bar-color-inactive (face-foreground 'mode-line-inactive)
  "The color for the bar of inactive mode lines.")

;;;###autoload
(defvar modeline-bar-img
  (propertize
   " " 'display
   (let ((data (make-list modeline-bar-height
                          (make-list modeline-bar-width 97)))
         (color modeline-bar-color))
     (ignore-errors
       (create-image
        (concat
         "/* XPM */\nstatic char * bar[]={\n"
         (format "\"%d %d 1 1\",\n\"a c %s\",\n"
                 modeline-bar-width modeline-bar-height
                 color)
         (mapconcat
          (lambda (row)
            (format "\"%s\""
                    (apply #'string row)))
          data ",\n")
         "\n};")
        'xpm t :ascent 'center))))
  "The image for the bar in the mode line.")

;;;###autoload
(defvar modeline-bar-img-inactive
  (propertize
   " " 'display
   (let ((data (make-list modeline-bar-height
                          (make-list modeline-bar-width 97)))
         (color modeline-bar-color-inactive))
     (ignore-errors
       (create-image
        (concat
         "/* XPM */\nstatic char * bar[]={\n"
         (format "\"%d %d 1 1\",\n\"a c %s\",\n"
                 modeline-bar-width modeline-bar-height
                 color)
         (mapconcat
          (lambda (row)
            (format "\"%s\""
                    (apply #'string row)))
          data ",\n")
         "\n};")
        'xpm t :ascent 'center))))
  "The image for the bar in inactive mode lines.")

;;;###autoload
(defun modeline-refresh-bars (&optional w h)
  "Refresh the bar images.
W is the width, H is the height of the bar."
  (setq modeline-bar-width (or w modeline-bar-width)
        modeline-bar-height (or h modeline-bar-height)
        modeline-bar-img
          (propertize
           " " 'display
           (let ((data (make-list modeline-bar-height
                                  (make-list modeline-bar-width 97)))
                 (color modeline-bar-color))
             (ignore-errors
               (create-image
                (concat
                 "/* XPM */\nstatic char * bar[]={\n"
                 (format "\"%d %d 1 1\",\n\"a c %s\",\n"
                         modeline-bar-width modeline-bar-height
                         color)
                 (mapconcat
                  (lambda (row)
                    (format "\"%s\""
                            (apply #'string row)))
                  data ",\n")
                 "\n};")
                'xpm t :ascent 'center))))
          modeline-bar-img-inactive
          (propertize
           " " 'display
           (let ((data (make-list modeline-bar-height
                                  (make-list modeline-bar-width 97)))
                 (color modeline-bar-color-inactive))
             (ignore-errors
               (create-image
                (concat
                 "/* XPM */\nstatic char * bar[]={\n"
                 (format "\"%d %d 1 1\",\n\"a c %s\",\n"
                         modeline-bar-width modeline-bar-height
                         color)
                 (mapconcat
                  (lambda (row)
                    (format "\"%s\""
                            (apply #'string row)))
                  data ",\n")
                 "\n};")
                'xpm t :ascent 'center))))))

;;;###autoload
(defun modeline-format-bar ()
  "We need a bar to ensure the mode line has the specified height."
  (cond
   ((and (display-graphic-p)
         (image-type-available-p 'xpm))
    (cond ((modeline-active-window-p) modeline-bar-img)
          (t modeline-bar-img-inactive)))))

;;;###autoload
(defun modeline-format-buffer-status ()
  "The status of the buffer displayed on the mode-line."
  (let ((active-p (modeline-active-window-p)))
    (concat
     ;; modified or not
     (cond ((and buffer-file-name (buffer-modified-p))
            (format-mode-line "M" (cond
                                   (active-p
                                    'doom-modeline-buffer-modified)
                                   (t 'mode-line-inactive)))))
     ;; read-only?
     (cond
      (buffer-read-only
       (format-mode-line "R" (cond
                              (active-p
                               'doom-modeline-urgent)
                              (t 'mode-line-inactive)))))
     ;; narrow?
     (cond
      ((buffer-narrowed-p)
       (format-mode-line "N" (cond
                              (active-p
                               'doom-modeline-warning)
                              (t 'mode-line-inactive))))))))

;;;###autoload
(defun modeline-format-position ()
  "The position of the cursor to be displayed in the mode line."
  (cond
   ((derived-mode-p 'pdf-view-mode)
    (modeline-propertize
     (propertize
      (let ((current (pdf-view-current-page))
            (total (pdf-info-number-of-pages)))
        (concat
         "P."
         (number-to-string current)
         "/"
         (number-to-string total)))
      'face (cond
             ((modeline-active-window-p) 'mode-line)
             (t 'mode-line-inactive)))
     nil "Current page / Total pages"))
   (t
    (modeline-propertize
     (propertize
      (let* ((lc (format-mode-line "%l:%C "))
	     (percent (format-mode-line "%p")))
        (concat
         lc
         (cond
	  ((eq (aref percent 0) 32)
	   (concat (substring percent 1) "%"))
	  ((memq (aref percent 0) (number-sequence 48 57))
	   (concat percent "%"))
	  ((> (length percent) 3)
	   (substring percent 0 3))
	  (t  percent))))
      'face (cond
	     ((modeline-active-window-p) 'mode-line)
	     (t 'mode-line-inactive)))
     nil
     "Buffer position\nmouse-1: Display Line and Column Mode Menu"
     mode-line-column-line-number-mode-map))))

;;;###autoload
(defun modeline-format-buffer-size ()
  "The size of the buffer to be displayed in the mode line."
  (modeline-propertize
   (format-mode-line
    (file-size-human-readable (string-to-number (format-mode-line "%i")))
    (cond
     ((modeline-active-window-p)
      'mode-line)
     (t 'mode-line-inactive)))
   nil
   "Buffer size\nmouse-1: Display Line and Column Mode Menu"
   mode-line-column-line-number-mode-map))

;;;###autoload
(defvar modeline-buffer-name-len-max 50
  "The maximal length of the name of the buffer to be displayed in the mode line.")

(let ((map (make-sparse-keymap)))
  (define-key map [mode-line mouse-1] #'ibuffer)
  (setq mode-line-buffer-identification-keymap
        map))

;;;###autoload
(defun modeline-format-buffer-name ()
  "The name of the buffer truncated to `modeline-buffer-name-len-max'.
This will be displayed in the mode line."
  (declare (pure t) (side-effect-free t))
  (modeline-propertize
   (let* ((face (cond ((modeline-active-window-p) 'mode-line-buffer-id)
		      (t 'mode-line-inactive)))
	  (orig (format-mode-line "%b" face)))
     (concat
      (format-mode-line "%[" face)
      (cond
       ((> (length orig) modeline-buffer-name-len-max)
	(concat
         (substring orig 0 (- modeline-buffer-name-len-max 3))
         "..."))
       (t orig))
      (format-mode-line "%]" face)))
   nil
   (concat (buffer-file-name)
           "\n"
           "mouse-1: ibuffer")
   mode-line-buffer-identification-keymap))

;;;###autoload
(defun modeline-format-major-mode ()
  "The major mode to display in the mode line."
  (declare (pure t) (side-effect-free t))
  (concat
   (modeline-propertize
    (format-mode-line
     "%m"
     (cond ((modeline-active-window-p)
            'doom-modeline-buffer-major-mode)
           (t 'mode-line-inactive)))
    nil
    "Major mode\nmouse-1: Display major mode menu\nmouse-2: Show help for major mode\nmouse-3: Toggle minor modes"
    mode-line-major-mode-keymap)
   (modeline-spc)))

;;;###autoload
(defvar-local modeline-vcs-str ""
  "Display the version control system information on the mode line.")
;;;###autoload
(defvar modeline-vcs-length-max 12
  "The maximum displayed length of the branch name of version control.")

;;;###autoload
(defun modeline-update-vcs-str (&rest _)
  "Update the version control system information to be displayed on the mode line."
  (let ((bfn (buffer-file-name)))
    (setq
     modeline-vcs-str
     (cond
      ((and vc-mode bfn)
       (let* ((backend (vc-backend bfn))
              (state (vc-state bfn backend))
              (indicator (cond
                          ((memq state '(added edited))
                           (format-mode-line
                            "* " 'doom-modeline-info))
                          ((eq state 'needs-merge)
                           (format-mode-line
                            "? " 'doom-modeline-info))
                          ((eq state 'needs-update)
                           (format-mode-line
                            "! " 'doom-modeline-warning))
                          ((memq state '(removed conflict unregistered))
                           (format-mode-line
                            "! " 'doom-modeline-urgent))
                          (t (format-mode-line
                              "@ " 'doom-modeline-info))))
              (str (cond (vc-display-status
                          (substring vc-mode (+ (cond ((eq backend 'Hg) 2)
                                                      (t 3))
                                                2)))
                         (t ""))))
         (concat
          indicator
          (propertize
           (cond
            ((> (length str) modeline-vcs-length-max)
             (concat (substring str 0 (- modeline-vcs-length-max 3))
                     "..."))
            (t str))
           'face (cond
                  ((eq state 'needs-update)
                   'doom-modeline-warning)
                  ((memq state '(removed conflict unregistered))
                   'doom-modeline-urgent)
                  (t 'doom-modeline-info))))))
      (t "")))))

(add-hook 'find-file-hook #'modeline-update-vcs-str)
(add-hook 'after-save-hook #'modeline-update-vcs-str)
(advice-add #'vc-refresh-state :after #'modeline-update-vcs-str)

;;;###autoload
(defun modeline-format-vc-mode ()
  "Display version control system information on the mode line."
  (declare (pure t) (side-effect-free 'error-free))
  (cond
   ((and (stringp modeline-vcs-str)
         (not (string= modeline-vcs-str "")))
    (concat
     ;; (modeline-spc)
     (modeline-propertize
      (cond
       ((modeline-active-window-p) modeline-vcs-str)
       (t (propertize modeline-vcs-str 'face 'mode-line-inactive)))
      nil
      (get-text-property 1 'help-echo vc-mode)
      (get-text-property 1 'local-map vc-mode))
     (modeline-spc)))))

;;;###autoload
(defun modeline-format-input-method ()
  "Display the current input method on the mode line."
  (cond
   (current-input-method
    (concat
     (modeline-spc)
     (modeline-propertize
      (propertize
       current-input-method-title
       'face (cond ((modeline-active-window-p) 'doom-modeline-input-method)
                   (t 'mode-line-inactive)))
      nil
      (format "Current input method: %s\nmouse-2: Disable input method\nmouse-3: Describe current input method"
              current-input-method)
      mode-line-input-method-map)
     (modeline-spc))
    )
   (t "")))