Modeline stuff!

This commit is contained in:
Case Duckworth 2022-05-12 22:37:16 -05:00
parent 1375113b0e
commit 134409aa67
5 changed files with 232 additions and 98 deletions

30
init.el
View File

@ -2021,6 +2021,11 @@
(add-hook 'modus-themes-after-load-theme-hook (add-hook 'modus-themes-after-load-theme-hook
(defun +modus-themes-mostly-monochrome () (defun +modus-themes-mostly-monochrome ()
"Set up mdous-themes to be 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 (modus-themes-with-colors
(custom-set-faces (custom-set-faces
`(font-lock-builtin-face ((,class :inherit modus-themes-bold `(font-lock-builtin-face ((,class :inherit modus-themes-bold
@ -2050,14 +2055,11 @@
:foreground ,red-nuanced-fg))) :foreground ,red-nuanced-fg)))
`(font-lock-todo-face ((,class :inherit font-lock-comment-face `(font-lock-todo-face ((,class :inherit font-lock-comment-face
:foreground ,fg-header :foreground ,fg-header
:background ,yellow-intense-bg)))) :background ,yellow-intense-bg)))
;; Major mode in the mode-line `(+modeline-text-mode-face ((,class :foreground ,blue
(defface +modeline-text-mode-face `((,class ( :foreground ,blue
:inherit modus-themes-bold))) :inherit modus-themes-bold)))
"Text-mode major mode face.") `(+modeline-prog-mode-face ((,class :foreground ,magenta
(defface +modeline-prog-mode-face `((,class ( :foreground ,magenta :inherit modus-themes-bold))))
:inherit modus-themes-bold)))
"Prog-mode major mode face.")
(:option +modeline-major-mode-faces `((text-mode . +modeline-text-mode-face) (:option +modeline-major-mode-faces `((text-mode . +modeline-text-mode-face)
(prog-mode . +modeline-prog-mode-face) (prog-mode . +modeline-prog-mode-face)
(t . bold)))))) (t . bold))))))
@ -2161,6 +2163,11 @@
org-visibility-include-regexps '("\\.org\\'")) org-visibility-include-regexps '("\\.org\\'"))
(org-visibility-enable-hooks)) (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) (setup (:straight orglink)
(:option orglink-activate-in-modes '(text-mode prog-mode)) (:option orglink-activate-in-modes '(text-mode prog-mode))
(global-orglink-mode +1) (global-orglink-mode +1)
@ -2273,18 +2280,17 @@
(+modeline-concat (+modeline-concat
'(+modeline-track '(+modeline-track
simple-modeline-segment-misc-info)))) simple-modeline-segment-misc-info))))
+modeline-position
simple-modeline-segment-process simple-modeline-segment-process
+modeline-text-scale
,(+modeline-concat ,(+modeline-concat
'(+modeline-god-mode '(+modeline-god-mode
+modeline-kmacro-indicator +modeline-kmacro-indicator
+modeline-reading-mode +modeline-reading-mode
+modeline-narrowed) +modeline-narrowed
+modeline-text-scale
+modeline-input-method)
",") ",")
+modeline-input-method
+modeline-position
+modeline-major-mode +modeline-major-mode
+modeline-file-percentage
+modeline-spacer))) +modeline-spacer)))
(simple-modeline-mode +1)) (simple-modeline-mode +1))

View File

@ -190,7 +190,8 @@ Do this only if the buffer is not visiting a file."
file-name-shadow-mode file-name-shadow-mode
minibuffer-electric-default-mode minibuffer-electric-default-mode
delete-selection-mode delete-selection-mode
column-number-mode)) ;; column-number-mode
))
(when (fboundp enable-mode) (when (fboundp enable-mode)
(funcall enable-mode +1))) (funcall enable-mode +1)))

View File

@ -25,35 +25,27 @@ will default to this string.")
;;; Combinators ;;; Combinators
(defun +modeline-concat (segments &optional separator) (defun +modeline-concat (segments &optional separator)
"Concatenate multiple `simple-modeline'-style SEGMENTS. "Concatenate multiple functional modeline SEGMENTS.
SEGMENTS is a list of either modeline segment-functions (see Each segment in SEGMENTS is a function returning a mode-line
`simple-modeline' functions for an example of types of construct.
functions), though it can also contain cons cells of the
form (SEGMENT . PREDICATE).
Segments are separated from each other using SEPARATOR, which Segments are separated using SEPARATOR, which defaults to
defaults to a \" \". Only segments that evaluate to a `+modeline-default-spacer'. Only segments that evaluate to a
non-trivial string (that is, a string not equal to \"\") will be non-zero-length string will be separated, for a cleaner look.
separated, for a cleaner look.
This function makes a lambda, so you can throw it straight into This function returns a lambda that should be `:eval'd or
`simple-modeline-segments'." `funcall'd in a mode-line context."
(setq separator (or separator +modeline-default-spacer)) (let ((separator (or separator +modeline-default-spacer)))
(lambda () (lambda ()
(apply #'concat (let (this-sep result)
(let (this-sep result-list)
(dolist (segment segments) (dolist (segment segments)
(push (funcall (or (car-safe segment) segment) (let ((segstr (funcall segment this-sep)))
this-sep) (when (and segstr
result-list) (not (equal segstr "")))
(if (or (cdr-safe segment) (push segstr result)
(and (car result-list) (setq this-sep separator))))
(not (equal (car result-list) "")))) (apply #'concat
(setq this-sep separator) (nreverse result))))))
(setq this-sep nil)))
;; (unless (seq-some #'null result-list)
;; (push +modeline-default-spacer result-list))
(nreverse result-list)))))
(defun +modeline-spacer (&optional n spacer &rest strings) (defun +modeline-spacer (&optional n spacer &rest strings)
"Make an N-length SPACER, or prepend SPACER to 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) (propertize ;; (+string-truncate (format-mode-line mode-name) 16)
(format-mode-line mode-name) (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 ;; XXX: This is probably really inefficient. I need to
;; simply detect which mode it's in when I change major ;; simply detect which mode it's in when I change major
;; modes (`change-major-mode-hook') and change the face ;; 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) (catch :done (dolist (cel +modeline-major-mode-faces)
(when (derived-mode-p (car cel)) (when (derived-mode-p (car cel))
(throw :done (cdr cel)))) (throw :done (cdr cel))))
(alist-get t +modeline-major-mode-faces)) (alist-get t +modeline-major-mode-faces)))
'unspecified)
'keymap (let ((map (make-sparse-keymap))) 'keymap (let ((map (make-sparse-keymap)))
(bindings--define-key map [mode-line down-mouse-1] (bindings--define-key map [mode-line down-mouse-1]
`(menu-item "Menu Bar" ignore `(menu-item "Menu Bar" ignore
@ -293,13 +284,26 @@ The order of elements matters: whichever one matches first is applied."
;; (t (format "%d%%%%%%%%%%" perc)))) ;; (t (format "%d%%%%%%%%%%" perc))))
;; ;; TODO: add scroll-up and scroll-down bindings. ;; ;; 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 (+modeline-spacer nil spacer
"/"
(pcase perc (pcase perc
("Top" ".^^") ("To" "Top")
("Bot" ".__") ("Bo" "Bot")
("All" ".::") ("Al" "All")
(_ (format ".%02d" (string-to-number (substring perc 0 2))))))))) (_ (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) (defun +modeline-file-percentage-icon (&optional spacer)
"Display the position in the current file as an icon." "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))) (let ((perc (+modeline--percentage)))
(propertize (+modeline-spacer nil spacer (propertize (+modeline-spacer nil spacer
(cond (cond
((+modeline--buffer-contained-in-window-p) "") ((+modeline--buffer-contained-in-window-p) "111")
((= perc 0) "") ((= perc 0) "000")
((< perc 20) "") ((< perc 20) "001")
((< perc 40) "") ((< perc 40) "010")
((< perc 60) "") ((< perc 60) "011")
((< perc 80) "") ((< perc 80) "100")
((< perc 100) "") ((< perc 100) "101")
((>= perc 100) ""))) ((>= perc 100) "110")))
'help-echo (format "Point is %d%% through the buffer." 'help-echo (format "Point is %d%% through the buffer."
perc))))) perc)))))
@ -327,29 +331,24 @@ The order of elements matters: whichever one matches first is applied."
(when (and region-indicator-mode (when (and region-indicator-mode
(region-active-p)) (region-active-p))
(+modeline-spacer nil spacer (+modeline-spacer nil spacer
(propertize (format "%s%d" (propertize (format "%d%s"
(if (and (< (point) (mark))) "-" "+")
(apply '+ (mapcar (lambda (pos) (apply '+ (mapcar (lambda (pos)
(- (cdr pos) (- (cdr pos)
(car pos))) (car pos)))
(region-bounds)))) (region-bounds)))
(if (and (< (point) (mark))) "-" "+"))
'font-lock-face 'font-lock-variable-name-face)))) 'font-lock-face 'font-lock-variable-name-face))))
(defun +modeline-line (&optional spacer) (defun +modeline-line (&optional spacer)
(when line-number-mode (when line-number-mode
(+modeline-spacer nil spacer "%2l"))) (+modeline-spacer nil spacer
"%l")))
(defun +modeline-column (&optional spacer) (defun +modeline-column (&optional spacer)
(when column-number-mode (when column-number-mode
(+modeline-spacer nil spacer (+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 ""))) (if column-number-indicator-zero-based "%2c" "%2C"))))
(defcustom +modeline-position-function nil (defcustom +modeline-position-function nil
"Function to use instead of `+modeline-position' in modeline." "Function to use instead of `+modeline-position' in modeline."
@ -362,11 +361,14 @@ The order of elements matters: whichever one matches first is applied."
See `line-number-mode', `column-number-mode', and See `line-number-mode', `column-number-mode', and
`file-percentage-mode'. If `+modeline-position-function' is set `file-percentage-mode'. If `+modeline-position-function' is set
to a function in the current buffer, call that function instead." to a function in the current buffer, call that function instead."
(+modeline-spacer nil spacer
(cond ((functionp +modeline-position-function) (cond ((functionp +modeline-position-function)
(funcall +modeline-position-function)) (+modeline-spacer nil spacer
(t (concat (+modeline-region) (funcall +modeline-position-function)))
(+modeline-line-column)))))) (t (funcall (+modeline-concat '(+modeline-region
+modeline-line
+modeline-column
+modeline-file-percentage)
"")))))
(defun +modeline-vc (&optional spacer) (defun +modeline-vc (&optional spacer)
"Display the version control branch of the current buffer in the modeline." "Display the version control branch of the current buffer in the modeline."

97
lisp/+org-wc.el Normal file
View File

@ -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

View File

@ -47,12 +47,40 @@
(when-let ((help (plist-get item 'help-echo))) (when-let ((help (plist-get item 'help-echo)))
(list :help help))))))) (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 () (defun +tab-bar-date ()
"Display `display-time-string' in the tab-bar." "Display `display-time-string' in the tab-bar."
(when display-time-mode (when display-time-mode
`((date-time-string menu-item `((date-time-string menu-item
,(propertize (concat " " display-time-string)) ,(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))))) :help (discord-date-string)))))
(defun +tab-bar-notmuch-count () (defun +tab-bar-notmuch-count ()