summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--modeline.el435
1 files changed, 403 insertions, 32 deletions
diff --git a/modeline.el b/modeline.el
index a564a10..54bee5c 100644
--- a/modeline.el
+++ b/modeline.el
@@ -1,21 +1,142 @@
+;;; -*- 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-width)
- left-len
- right-len)
- 32))))
+ (let* ((left (modeline-format-left))
+ (right (modeline-format-right))
+ (left-len (length left))
+ (right-len (length right))
+ (middle (propertize " " 'display
+ (make-string (- (window-width)
+ left-len
+ right-len)
+ 32))))
(concat left middle right)))
+(setq-default mode-line-format '("%e" (:eval (modeline-format-main))))
+
;;;###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-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.")
+
+;;; Various sections of the mode line
+
+;;;###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
@@ -26,41 +147,291 @@
"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))
- (propertize
- " " 'display
- (let ((data (make-list modeline-bar-height
- (make-list modeline-bar-width 97)))
- (color (face-background 'modus-theme-active-blue nil t)))
- (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)))))))
+ (cond ((modeline-active-window-p) modeline-bar-img)
+ (t modeline-bar-img-inactive)))))
;;;###autoload
-(defun modeline-format-right ()
- "The right mode line format.")
+(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."
+ (modeline-propertize
+ (format-mode-line
+ (concat "%l:%C "
+ (let ((orig (format-mode-line "%p")))
+ (cond
+ ((memq (aref orig 0) (number-sequence 48 57))
+ (concat orig "%%%"))
+ (t (substring orig 0 3)))))
+ (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 ((orig
+ (format-mode-line
+ "%b" (cond ((modeline-active-window-p)
+ 'mode-line-buffer-id)
+ (t 'mode-line-inactive)))))
+ (cond
+ ((> (length orig) modeline-buffer-name-len-max)
+ (concat
+ (substring orig 0 (- modeline-buffer-name-len-max 3))
+ "..."))
+ (t orig)))
+ 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))
+ (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))
-(setq mode-line-format '("%e" (:eval (modeline-format-main))))
+;;;###autoload
+(defvar 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 t))
+ (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)))))