diff options
Diffstat (limited to 'lisp/my-header-line.el')
| -rw-r--r-- | lisp/my-header-line.el | 162 |
1 files changed, 137 insertions, 25 deletions
diff --git a/lisp/my-header-line.el b/lisp/my-header-line.el index 0b0bc75..3d52f2c 100644 --- a/lisp/my-header-line.el +++ b/lisp/my-header-line.el @@ -2,6 +2,17 @@ (require 'mode-line-maker) +(defcustom my/header-line-height 35 + "Minimum graphical header-line height, before image scaling. +Matches the default height of Dirvish's full-frame header line." + :type 'natnum + :group 'mode-line) + +(defcustom my/header-line-show-major-mode nil + "Whether to show the major mode next to the clock in the header line." + :type 'boolean + :group 'mode-line) + (defface my/header-line-evil-normal '((t (:inherit font-lock-keyword-face :weight bold))) "Face for the evil normal state indicator.") @@ -35,16 +46,16 @@ "Face for the IRC activity indicator.") (defface my/header-line-clatter-face - '((t (:inherit font-lock-builtin-face :weight bold))) - "Face for the Clatter joined-channel indicator.") + '((t (:inherit success :weight bold))) + "Theme success color for Clatter's connected-channel indicator.") (defface my/header-line-mu4e-face - '((t (:inherit warning :weight bold))) - "Face for the unread mail indicator.") + '((t (:inherit font-lock-type-face :weight bold))) + "Theme type accent for the unread mail indicator.") (defface my/header-line-time-face - '((t (:inherit font-lock-constant-face))) - "Face for the time segment.") + '((t (:inherit mode-line-buffer-id :weight normal))) + "Theme buffer-name accent for the clock, in regular weight.") (defface my/header-line-state-saved-face '((t (:inherit success))) @@ -58,6 +69,30 @@ '((t (:inherit error))) "Face for the read-only buffer state icon.") +(defface my/header-line-position-face + '((t (:inherit shadow :weight normal :slant normal))) + "Quiet face for the scroll percentage and cursor position.") + +(defface my/header-line-workspace-active-face + '((t (:inherit my/header-line-position-face :inverse-video nil :box nil))) + "Current workspace, styled like the percentage and cursor position.") + +(defface my/header-line-workspace-inactive-face + '((t (:inherit shadow :weight normal :slant normal))) + "Quiet numbers for other open workspaces.") + +(defvar my/header-line-workspaces-expanded nil + "Whether the header line also shows the other open workspaces.") + +(defconst my/header-line-position + '(" " + (:propertize "%p" face my/header-line-position-face + help-echo "Window scroll position") + " " + (:propertize "%l:%c" face my/header-line-position-face + help-echo "Line : column (columns start at 0)")) + "Compact scroll percentage and line:column display.") + (defvar-local my/header-line--buffer-title nil) (defconst my/header-line--missing (make-symbol "missing") @@ -217,6 +252,56 @@ of a literal dash." (propertize (if icon (concat icon " " time) time) 'face 'my/header-line-time-face)))) +(defun my/toggle-header-line-workspaces () + "Toggle between the current workspace and all open workspace names." + (interactive) + (setq my/header-line-workspaces-expanded + (not my/header-line-workspaces-expanded)) + (force-mode-line-update t)) + +(defun my/header-line--workspace-number (index) + "Return an outlined Nerd Icon for workspace INDEX, with a text fallback." + (let ((fallback (format "[%d]" index))) + (if (<= 1 index 10) + (my/header-line--icon + (format "nf-md-numeric_%d_box_outline" index) + 'my/header-line-position-face fallback) + fallback))) + +(defun my/header-line-workspaces () + "Show the current workspace or all workspaces, each with its number icon." + (when (and (bound-and-true-p persp-mode) + (fboundp 'my/workspace-current-name) + (fboundp 'my/workspace-names)) + (let ((current (my/workspace-current-name)) + (names (my/workspace-names)) + (index 0)) + (when (member current names) + (string-join + (delq nil + (mapcar + (lambda (name) + ;; Keep the same numbering as workspace switching. + (setq index (1+ index)) + (let ((active (equal name current))) + (when (or active my/header-line-workspaces-expanded) + (propertize + ;; The maker expands this before the final header. + (string-replace + "%" "%%" + (concat (my/header-line--workspace-number index) + " " name)) + 'face (if active 'my/header-line-workspace-active-face + 'my/header-line-workspace-inactive-face) + 'help-echo + (format "%d: %s — t: toggle workspaces" index name))))) + names)) + " "))))) + +(defun my/header-line--refresh-workspaces (&rest _args) + "Refresh all headers after workspace changes." + (force-mode-line-update t)) + (defun my/header-line-sync-theme (&optional _theme) "Make helper padding inherit the live header-line theme face. Optional THEME is ignored so this function also fits @@ -231,6 +316,18 @@ Optional THEME is ignored so this function also fits :inverse-video nil :strike-through nil)) +(defun my/header-line--height-spacer () + "Return a transparent height spacer, using the same approach as Dirvish." + (when (and (display-graphic-p) + (image-type-available-p 'pbm) + (> my/header-line-height 0)) + (propertize + " " 'display + (create-image + (concat (format "P1\n1 %d\n" my/header-line-height) + (make-string my/header-line-height ?0) "\n") + 'pbm t :foreground "None" :ascent 'center)))) + (define-minor-mode my/global-header-line-mode "Show the custom header line globally. @@ -248,34 +345,49 @@ headings, remain visible." (interactive) (my/global-header-line-mode (if my/global-header-line-mode -1 1))) +(defun my/header-line--make (left right) + "Build a header from LEFT and RIGHT, preserving literal percent signs." + ;; The maker has already expanded %p, %l, etc. Escape its result before + ;; redisplay interprets it again, including percent signs in buffer names. + (let ((format (mode-line-maker left right))) + `(:eval (string-replace "%" "%%" + (apply #'concat ,(cadr format)))))) + (defun my/header-line-install () "Install the custom header line built with mode-line-maker." (setq global-mode-string (delq 'display-time-string global-mode-string)) (my/header-line-sync-theme) (add-hook 'enable-theme-functions #'my/header-line-sync-theme) (setq my/header-line--format - (mode-line-maker - '((:eval (my/header-line-evil-state)) " " - (:eval (my/header-line-buffer-state)) - (:eval (my/header-line-remote)) " " - (:eval (my/header-line-buffer-icon)) " " - (:eval (propertize (my/header-line-buffer-name) - 'face 'mode-line-buffer-id - 'mouse-face 'mode-line-highlight - 'help-echo (concat (or buffer-file-truename (buffer-name)) - "\nmouse-1: Previous buffer\nmouse-3: Next buffer") - 'local-map mode-line-buffer-identification-keymap)) " " - mode-line-position) - '("" (:eval (my/header-line-irc)) " " - (:eval (my/header-line-clatter)) " " - (:eval (my/header-line-mu4e)) " " - mode-line-process " " - (:eval (my/header-line-time)) " " - mode-name " "))) + (list + '(:eval (my/header-line--height-spacer)) + (my/header-line--make + '((:eval (my/header-line-evil-state)) " " + (:eval (my/header-line-buffer-state)) + (:eval (my/header-line-remote)) " " + (:eval (my/header-line-buffer-icon)) " " + (:eval (propertize (my/header-line-buffer-name) + 'face 'mode-line-buffer-id + 'mouse-face 'mode-line-highlight + 'help-echo (concat (or buffer-file-truename (buffer-name)) + "\nmouse-1: Previous buffer\nmouse-3: Next buffer") + 'local-map mode-line-buffer-identification-keymap)) + my/header-line-position) + '("" (:eval (my/header-line-irc)) " " + (:eval (my/header-line-clatter)) " " + (:eval (my/header-line-mu4e)) " " + mode-line-process " " + (:eval (my/header-line-time)) " " + (my/header-line-show-major-mode ("" mode-name " ")) + (:eval (my/header-line-workspaces)) " ")))) ;; The header line is visible on every startup, regardless of its previous ;; interactive state in a long-running session. (my/global-header-line-mode 1) - (add-hook 'before-save-hook #'my/header-line--invalidate-title-cache)) + (add-hook 'before-save-hook #'my/header-line--invalidate-title-cache) + (with-eval-after-load 'persp-mode + (add-hook 'persp-activated-functions #'my/header-line--refresh-workspaces) + (add-hook 'persp-names-cache-changed-functions + #'my/header-line--refresh-workspaces))) (provide 'my-header-line) ;;; my-header-line.el ends here |