md: 2026-09-03T15:50:32+02:00

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