Modeline stuff!

5 files changed, 234 insertions, 100 deletions

@@ -2021,6 +2021,11 @@
   (add-hook 'modus-themes-after-load-theme-hook
             (defun +modus-themes-mostly-monochrome ()
               "Set up mdous-themes to be mostly monochrome."
+              ;; Major mode in the mode-line
+              (defface +modeline-text-mode-face nil
+                "Text-mode major mode face.")
+              (defface +modeline-prog-mode-face nil
+                "Prog-mode major mode face.")
               (modus-themes-with-colors
                 (custom-set-faces
                  `(font-lock-builtin-face ((,class :inherit modus-themes-bold
@@ -2050,14 +2055,11 @@
                                                    :foreground ,red-nuanced-fg)))
                  `(font-lock-todo-face ((,class :inherit font-lock-comment-face
                                                 :foreground ,fg-header
-                                                :background ,yellow-intense-bg))))
-                ;; Major mode in the mode-line
-                (defface +modeline-text-mode-face `((,class ( :foreground ,blue
-                                                              :inherit modus-themes-bold)))
-                  "Text-mode major mode face.")
-                (defface +modeline-prog-mode-face `((,class ( :foreground ,magenta
-                                                              :inherit modus-themes-bold)))
-                  "Prog-mode major mode face.")
+                                                :background ,yellow-intense-bg)))
+                 `(+modeline-text-mode-face ((,class :foreground ,blue
+                                                     :inherit modus-themes-bold)))
+                 `(+modeline-prog-mode-face ((,class :foreground ,magenta
+                                                     :inherit modus-themes-bold))))
                 (:option +modeline-major-mode-faces `((text-mode . +modeline-text-mode-face)
                                                       (prog-mode . +modeline-prog-mode-face)
                                                       (t . bold))))))
@@ -2161,6 +2163,11 @@
            org-visibility-include-regexps '("\\.org\\'"))
   (org-visibility-enable-hooks))
 
+(setup (:straight org-wc)
+  (:load-after org simple-modeline)
+  (:also-load +org-wc)
+  (add-hook 'org-mode-hook #'+org-wc-mode))
+
 (setup (:straight orglink)
   (:option orglink-activate-in-modes '(text-mode prog-mode))
   (global-orglink-mode +1)
@@ -2273,18 +2280,17 @@
                   (+modeline-concat
                    '(+modeline-track
                      simple-modeline-segment-misc-info))))
+              +modeline-position
               simple-modeline-segment-process
-              +modeline-text-scale
               ,(+modeline-concat
                 '(+modeline-god-mode
                   +modeline-kmacro-indicator
                   +modeline-reading-mode
-                  +modeline-narrowed)
+                  +modeline-narrowed
+                  +modeline-text-scale
+                  +modeline-input-method)
                 ",")
-              +modeline-input-method
-              +modeline-position
               +modeline-major-mode
-              +modeline-file-percentage
               +modeline-spacer)))
   (simple-modeline-mode +1))
 
@@ -190,7 +190,8 @@ Do this only if the buffer is not visiting a file."
                        file-name-shadow-mode
                        minibuffer-electric-default-mode
                        delete-selection-mode
-                       column-number-mode))
+                       ;; column-number-mode
+                       ))
   (when (fboundp enable-mode)
     (funcall enable-mode +1)))
 
@@ -25,35 +25,27 @@ will default to this string.")
 ;;; Combinators
 
 (defun +modeline-concat (segments &optional separator)
-  "Concatenate multiple `simple-modeline'-style SEGMENTS.
-SEGMENTS is a list of either modeline segment-functions (see
-`simple-modeline' functions for an example of types of
-functions), though it can also contain cons cells of the
-form (SEGMENT . PREDICATE).
-
-Segments are separated from each other using SEPARATOR, which
-defaults to a \" \".  Only segments that evaluate to a
-non-trivial string (that is, a string not equal to \"\") will be
-separated, for a cleaner look.
-
-This function makes a lambda, so you can throw it straight into
-`simple-modeline-segments'."
-  (setq separator (or separator +modeline-default-spacer))
-  (lambda ()
-    (apply #'concat
-           (let (this-sep result-list)
-             (dolist (segment segments)
-               (push (funcall (or (car-safe segment) segment)
-                              this-sep)
-                     result-list)
-               (if (or (cdr-safe segment)
-                       (and (car result-list)
-                            (not (equal (car result-list) ""))))
-                   (setq this-sep separator)
-                 (setq this-sep nil)))
-             ;; (unless (seq-some #'null result-list)
-             ;;   (push +modeline-default-spacer result-list))
-             (nreverse result-list)))))
+  "Concatenate multiple functional modeline SEGMENTS.
+Each segment in SEGMENTS is a function returning a mode-line
+construct.
+
+Segments are separated using SEPARATOR, which defaults to
+`+modeline-default-spacer'.  Only segments that evaluate to a
+non-zero-length string will be separated, for a cleaner look.
+
+This function returns a lambda that should be `:eval'd or
+`funcall'd in a mode-line context."
+  (let ((separator (or separator +modeline-default-spacer)))
+    (lambda ()
+      (let (this-sep result)
+        (dolist (segment segments)
+          (let ((segstr (funcall segment this-sep)))
+            (when (and segstr
+                       (not (equal segstr "")))
+              (push segstr result)
+              (setq this-sep separator))))
+        (apply #'concat
+               (nreverse result))))))
 
 (defun +modeline-spacer (&optional n spacer &rest strings)
   "Make an N-length SPACER, or prepend SPACER to STRINGS.
@@ -152,7 +144,7 @@ in the cdr will be applied to the major-mode in the mode line."
     "("
     (propertize ;; (+string-truncate (format-mode-line mode-name) 16)
      (format-mode-line mode-name)
-     'face (if (actually-selected-window-p)
+     'face (when (actually-selected-window-p)
                ;; XXX: This is probably really inefficient.  I need to
                ;; simply detect which mode it's in when I change major
                ;; modes (`change-major-mode-hook') and change the face
@@ -160,8 +152,7 @@ in the cdr will be applied to the major-mode in the mode line."
                (catch :done (dolist (cel +modeline-major-mode-faces)
                               (when (derived-mode-p (car cel))
                                 (throw :done (cdr cel))))
-                      (alist-get t +modeline-major-mode-faces))
-             'unspecified)
+                      (alist-get t +modeline-major-mode-faces)))
      'keymap (let ((map (make-sparse-keymap)))
                (bindings--define-key map [mode-line down-mouse-1]
                  `(menu-item "Menu Bar" ignore
@@ -293,13 +284,26 @@ The order of elements matters: whichever one matches first is applied."
     ;;                        (t (format "%d%%%%%%%%%%" perc))))
     ;;               ;; TODO: add scroll-up and scroll-down bindings.
     ;;               ))
-    (let ((perc (format-mode-line '(-3 "%p"))))
+    (let ((perc (format-mode-line '(-2 "%p"))))
       (+modeline-spacer nil spacer
+        "/"
         (pcase perc
-          ("Top" ".^^")
-          ("Bot" ".__")
-          ("All" ".::")
-          (_ (format ".%02d" (string-to-number (substring perc 0 2)))))))))
+          ("To" "Top")
+          ("Bo" "Bot")
+          ("Al" "All")
+          (_ (format ".%02d" (string-to-number perc))))))))
+
+(defun +modeline-file-percentage-ascii-icon (&optional spacer)
+  (when file-percentage-mode
+    (+modeline-spacer nil spacer
+      (let ((perc (format-mode-line '(-2 "%p"))))
+       (pcase perc
+         ("To" "/\\")
+         ("Bo" "\\/")
+         ("Al" "[]")
+         (_ (let ((vec (vector "/|" "//" "||" "\\\\" "\\|" "\\|"))
+                  (perc (string-to-number perc)))
+              (aref vec (floor (/ perc 17))))))))))
 
 (defun +modeline-file-percentage-icon (&optional spacer)
   "Display the position in the current file as an icon."
@@ -307,14 +311,14 @@ The order of elements matters: whichever one matches first is applied."
     (let ((perc (+modeline--percentage)))
       (propertize (+modeline-spacer nil spacer
                     (cond
-                     ((+modeline--buffer-contained-in-window-p) "⏹")
-                     ((= perc 0)   "▇")
-                     ((< perc 20)  "▆")
-                     ((< perc 40)  "▅")
-                     ((< perc 60)  "▄")
-                     ((< perc 80)  "▃")
-                     ((< perc 100) "▂")
-                     ((>= perc 100) "▁")))
+                     ((+modeline--buffer-contained-in-window-p) "111")
+                     ((= perc 0)   "000")
+                     ((< perc 20)  "001")
+                     ((< perc 40)  "010")
+                     ((< perc 60)  "011")
+                     ((< perc 80)  "100")
+                     ((< perc 100) "101")
+                     ((>= perc 100) "110")))
                   'help-echo (format "Point is %d%% through the buffer."
                                      perc)))))
 
@@ -327,30 +331,25 @@ The order of elements matters: whichever one matches first is applied."
   (when (and region-indicator-mode
              (region-active-p))
     (+modeline-spacer nil spacer
-      (propertize (format "%s%d"
-                          (if (and (< (point) (mark))) "-" "+")
+      (propertize (format "%d%s"
                           (apply '+ (mapcar (lambda (pos)
                                               (- (cdr pos)
                                                  (car pos)))
-                                            (region-bounds))))
+                                            (region-bounds)))
+                          (if (and (< (point) (mark))) "-" "+"))
                   'font-lock-face 'font-lock-variable-name-face))))
 
 (defun +modeline-line (&optional spacer)
   (when line-number-mode
-    (+modeline-spacer nil spacer "%2l")))
+    (+modeline-spacer nil spacer
+      "%l")))
 
 (defun +modeline-column (&optional spacer)
   (when column-number-mode
     (+modeline-spacer nil spacer
+      "|"
       (if column-number-indicator-zero-based "%2c" "%2C"))))
 
-(defun +modeline-line-column (&optional spacer) ; adapted from `simple-modeline'
-  "Display the current cursor line and column depending on modes."
-  (+modeline-spacer nil spacer
-    (+modeline-line "")
-    "|"
-    (+modeline-column "")))
-
 (defcustom +modeline-position-function nil
   "Function to use instead of `+modeline-position' in modeline."
   :type '(choice (const :tag "Default" nil)
@@ -362,11 +361,14 @@ The order of elements matters: whichever one matches first is applied."
 See `line-number-mode', `column-number-mode', and
 `file-percentage-mode'.  If `+modeline-position-function' is set
 to a function in the current buffer, call that function instead."
-  (+modeline-spacer nil spacer
-    (cond ((functionp +modeline-position-function)
-           (funcall +modeline-position-function))
-          (t (concat (+modeline-region)
-                     (+modeline-line-column))))))
+  (cond ((functionp +modeline-position-function)
+         (+modeline-spacer nil spacer
+           (funcall +modeline-position-function)))
+        (t (funcall (+modeline-concat '(+modeline-region
+                                        +modeline-line
+                                        +modeline-column
+                                        +modeline-file-percentage)
+                                      "")))))
 
 (defun +modeline-vc (&optional spacer)
   "Display the version control branch of the current buffer in the modeline."
@@ -0,0 +1,97 @@
+;;; +org-wc.el --- org-wc in the modeline -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'org-wc)
+(require '+modeline)
+(require 'cl-lib)
+
+(defgroup +org-wc nil
+  "Extra fast word-counting in `org-mode'"
+  :group 'org-wc
+  :group 'org)
+
+(defvar-local +org-wc-word-count nil
+  "Running total of words in this buffer.")
+
+(defcustom +org-wc-update-after-funcs '(org-narrow-to-subtree
+                                        org-narrow-to-block
+                                        org-narrow-to-element
+                                        org-capture-narrow
+                                        org-taskwise-narrow-to-task)
+  "Functions after which to update the word count."
+  :type '(repeat function))
+
+(defcustom +org-wc-deletion-idle-timer 0.25
+  "Length of time, in seconds, to wait before updating word-count."
+  :type 'number)
+
+(defcustom +org-wc-huge-change 5000
+  "Number of characters that constitute a \"huge\" insertion."
+  :type 'number)
+
+(defvar-local +org-wc-update-timer nil)
+
+(defun +org-wc-delayed-update (&rest _)
+  (if +org-wc-update-timer
+      (setq +org-wc-update-timer nil)
+    (setq +org-wc-update-timer
+          (run-with-idle-timer +org-wc-deletion-idle-timer nil #'+org-wc-update))))
+
+(defun +org-wc-force-update ()
+  (interactive)
+  (message "Counting words...")
+  (when (timerp +org-wc-update-timer)
+    (cancel-timer +org-wc-update-timer))
+  (+org-wc-update)
+  (message "Counting words...done"))
+
+(defun +org-wc-update ()
+  (dlet ((+org-wc-counting t))
+    (+org-wc-buffer)
+    (force-mode-line-update)
+    (setq +org-wc-update-timer nil)))
+
+(defun +org-wc-changed (start end length)
+  (+org-wc-delayed-update))
+
+(defun +org-wc-buffer ()
+  "Count the words in the buffer."
+  (when (derived-mode-p 'org-mode)
+    (setq +org-wc-word-count
+         (org-word-count-aux (point-min) (point-max)))))
+
+(defvar +org-wc-counting nil
+  "Are we currently counting?")
+
+(defun +org-wc-recount-widen (&rest _)
+  (when (and (not +org-wc-counting))
+    (+org-wc-update)))
+
+(defun +org-wc-modeline ()
+  (when +org-wc-word-count
+    (format " %sw" +org-wc-word-count)))
+
+(define-minor-mode +org-wc-mode
+  "Count words in `org-mode' buffers in the mode-line."
+  :lighter ""
+  :keymap (let ((map (make-sparse-keymap)))
+            (define-key map (kbd "C-c C-.") #'+org-wc-force-update)
+            map)
+  (if +org-wc-mode
+      (progn                            ; turn on
+        (+org-wc-buffer)
+        (add-hook 'after-change-functions #'+org-wc-delayed-update nil t)
+        (setq-local +modeline-position-function #'+org-wc-modeline)
+        (dolist (fn +org-wc-update-after-funcs)
+          (advice-add fn :after #'+org-wc-update)))
+    (progn                              ; turn off
+      (remove-hook 'after-change-functions #'+org-wc-delayed-update t)
+      (kill-local-variable '+modeline-position-function)
+      (dolist (fn +org-wc-update-after-funcs)
+        (advice-remove fn #'+org-wc-update)))))
+
+(provide '+org-wc)
+;;; +org-wc.el ends here
@@ -47,12 +47,40 @@
                                    (when-let ((help (plist-get item 'help-echo)))
                                      (list :help help)))))))
 
+(defun +tab-bar-timer ()
+  "Display `+timer-string' in the tab-bar."
+  (when +timer-string
+    `((timer-string menu-item
+                    ,(concat " " +timer-string)
+                    (lambda (ev)
+                      (interactive "e")
+                      (cond ((not +timer-timer) nil)
+                            ((equal +timer-string +timer-running-string)
+                             (popup-menu
+                              '("Running timer"
+                                ["Cancel timer" +timer-cancel t])
+                              ev))
+                            (t (setq +timer-string ""))))))))
+
 (defun +tab-bar-date ()
   "Display `display-time-string' in the tab-bar."
   (when display-time-mode
     `((date-time-string menu-item
                         ,(propertize (concat " " display-time-string))
-                        ignore
+                        (lambda (ev)
+                          (interactive "e")
+                          (popup-menu
+                           (append '("Timer")
+                                   (let (r)
+                                     (dolist (time '(3 5 10))
+                                       (push (vector (format "Timer for %d minutes" time)
+                                                     `(lambda () (interactive)
+                                                       (+timer ,time))
+                                                     :active t)
+                                             r))
+                                     (nreverse r))
+                                   '(["Timer for ..." +timer t]))
+                           ev))
                         :help (discord-date-string)))))
 
 (defun +tab-bar-notmuch-count ()
@@ -220,7 +248,7 @@ name to the left."
                    (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max)
                      ellipsis)
                    (truncate-string-to-width tab-name l-name
-                         (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell))))
+                                             (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell))))
                   'help-echo tab-name))))
 
 (defun +tab-bar-format-align-right ()
@@ -267,27 +295,27 @@ Used by `tab-bar-format-menu-bar'."
 (el-patch-feature tab-bar)
 (with-eval-after-load 'tab-bar
   (el-patch-defun tab-bar--format-tab (tab i)
-          "Format TAB using its index I and return the result as a keymap."
-          (append
-           (el-patch-remove
-            `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)))
-           (cond
-            ((eq (car tab) 'current-tab)
-             `((current-tab
-            menu-item
-            ,(funcall tab-bar-tab-name-format-function tab i)
-            ignore
-            :help "Current tab")))
-            (t
-             `((,(intern (format "tab-%i" i))
-            menu-item
-            ,(funcall tab-bar-tab-name-format-function tab i)
-            ,(alist-get 'binding tab)
-            :help "Click to visit tab"))))
-           (when (alist-get 'close-binding tab)
-             `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
-            menu-item ""
-            ,(alist-get 'close-binding tab)))))))
+    "Format TAB using its index I and return the result as a keymap."
+    (append
+     (el-patch-remove
+       `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)))
+     (cond
+      ((eq (car tab) 'current-tab)
+       `((current-tab
+          menu-item
+          ,(funcall tab-bar-tab-name-format-function tab i)
+          ignore
+          :help "Current tab")))
+      (t
+       `((,(intern (format "tab-%i" i))
+          menu-item
+          ,(funcall tab-bar-tab-name-format-function tab i)
+          ,(alist-get 'binding tab)
+          :help "Click to visit tab"))))
+     (when (alist-get 'close-binding tab)
+       `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
+          menu-item ""
+          ,(alist-get 'close-binding tab)))))))
 
 
 ;; Emacs 27
@@ -300,8 +328,8 @@ This is :filter-return advice for `tab-bar-make-keymap-1'."
                           'display `(space :align-to (- right (- 0 right-margin)
                                                         ,reserve)))))
     (prog1 (append output
-           `((align-right menu-item ,str nil))
-           (+tab-bar-misc-info)))))
+                   `((align-right menu-item ,str nil))
+                   (+tab-bar-misc-info)))))
 
 
 ;; Emacs 28