diff options
| -rw-r--r-- | modeline.el | 435 |
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))))) |