From 134409aa670be39e676f093f5aa5b5b941126375 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Thu, 12 May 2022 22:37:16 -0500 Subject: Modeline stuff! --- lisp/+emacs.el | 3 +- lisp/+modeline.el | 124 +++++++++++++++++++++++++++--------------------------- lisp/+org-wc.el | 97 ++++++++++++++++++++++++++++++++++++++++++ lisp/+tab-bar.el | 78 +++++++++++++++++++++++----------- 4 files changed, 215 insertions(+), 87 deletions(-) create mode 100644 lisp/+org-wc.el (limited to 'lisp') diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 7851c43..3c5d383 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el @@ -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))) diff --git a/lisp/+modeline.el b/lisp/+modeline.el index f408757..86dbad4 100644 --- a/lisp/+modeline.el +++ b/lisp/+modeline.el @@ -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." diff --git a/lisp/+org-wc.el b/lisp/+org-wc.el new file mode 100644 index 0000000..7ab0050 --- /dev/null +++ b/lisp/+org-wc.el @@ -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 diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el index dce84d8..95f657d 100644 --- a/lisp/+tab-bar.el +++ b/lisp/+tab-bar.el @@ -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 -- cgit 1.4.1-21-gabe81