acdw/emacs
acdw
/
emacs
1
2
Fork 0
Code Issues 4 Pull Requests Releases Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
init.el
View File

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

3
lisp/+emacs.el
View File

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

120
lisp/+modeline.el
View File

@ -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).
"Concatenate multiple functional modeline SEGMENTS.
Each segment in SEGMENTS is a function returning a mode-line
construct.
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.
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 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)))))
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."

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

78
lisp/+tab-bar.el
View File

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