From af3eb37c8e51084261f2ad4bfe1d36fffbcfaebf Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 8 Jun 2022 17:59:53 -0500 Subject: blep --- lisp/+tab-bar.el | 314 +++++++++++++++++++++++++++---------------------------- 1 file changed, 157 insertions(+), 157 deletions(-) (limited to 'lisp/+tab-bar.el') diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el index 3e6968e..7ff991c 100644 --- a/lisp/+tab-bar.el +++ b/lisp/+tab-bar.el @@ -12,8 +12,8 @@ (defface +tab-bar-extra '((t :inherit (tab-bar font-lock-comment-face))) - "Tab bar face for extra information, like the menu-bar and time." - :group 'basic-faces) + "Tab bar face for extra information, like the menu-bar and time." + :group 'basic-faces) ;; Common @@ -35,97 +35,97 @@ (defun +tab-bar-tracking-mode () "Display `tracking-mode-line-buffers' in the tab-bar." ;; TODO: write something to convert a mode-line construct to a tab-bar - ;; construct. - (when (and (bound-and-true-p tracking-mode) - (not (and +tracking-hide-when-org-clocking - (bound-and-true-p org-clock-current-task)))) - (cons (when (> (length tracking-mode-line-buffers) 0) - '(track-mode-line-separator menu-item " " ignore)) - (cl-loop for i from 0 below (length tracking-mode-line-buffers) - as item = (nth i tracking-mode-line-buffers) - collect (append (list (intern (format "tracking-mode-line-%s" i)) - 'menu-item - (string-trim (format-mode-line item))) - (if-let ((keymap (plist-get item 'keymap))) - (list (alist-get 'down-mouse-1 (cdadr keymap))) - (list #'ignore)) - (when-let ((help (plist-get item 'help-echo))) - (list :help help))))))) + ;; construct. + (when (and (bound-and-true-p tracking-mode) + (not (and +tracking-hide-when-org-clocking + (bound-and-true-p org-clock-current-task)))) + (cons (when (> (length tracking-mode-line-buffers) 0) + '(track-mode-line-separator menu-item " " ignore)) + (cl-loop for i from 0 below (length tracking-mode-line-buffers) + as item = (nth i tracking-mode-line-buffers) + collect (append (list (intern (format "tracking-mode-line-%s" i)) + 'menu-item + (string-trim (format-mode-line item))) + (if-let ((keymap (plist-get item 'keymap))) + (list (alist-get 'down-mouse-1 (cdadr keymap))) + (list #'ignore)) + (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 + (when (> (length (bound-and-true-p +timer-string)) 0) `((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 "")))))))) + (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 ,(substring-no-properties (concat " " (string-trim display-time-string))) - (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))))) + (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 () "Display a notmuch count in the tab-bar." (when (and (executable-find "notmuch") (featurep 'notmuch)) (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches))) - (next (cl-find "inbox" counts :key (lambda (l) (plist-get l :name)) :test 'equal)) + (next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal)) (next-count (plist-get next :count))) (when (and next-count (> next-count 0)) `((notmuch-count menu-item ,(format " |%s|" next-count) - ignore - :help ,(format "%s mails requiring attention." next-count))))))) + ignore + :help ,(format "%s mails requiring attention." next-count))))))) (defun +tab-bar-org-clock () "Display `org-mode-line-string' in the tab-bar." (when (and (fboundp 'org-clocking-p) (org-clocking-p)) ;; org-mode-line-string - `((org-clocking menu-item - ,org-mode-line-string - (lambda (ev) - (interactive "e") - (let ((menu (make-sparse-keymap - (or org-clock-current-task "Org-Clock")))) - (map-keymap (lambda (key binding) - (when (consp binding) - (define-key-after menu (vector key) - (copy-sequence binding)))) - (org-clock-menu)) - (message "%S" ev) - (popup-menu menu ev))) - :help ,(or (replace-regexp-in-string - (rx "[[" (group (* (not "]"))) - "][" (group (* (not "]"))) - "]]") - "\\2" - org-clock-current-task) - "Org-Clock"))))) + `((org-clocking menu-item + ,org-mode-line-string + (lambda (ev) + (interactive "e") + (let ((menu (make-sparse-keymap + (or org-clock-current-task "Org-Clock")))) + (map-keymap (lambda (key binding) + (when (consp binding) + (define-key-after menu (vector key) + (copy-sequence binding)))) + (org-clock-menu)) + (message "%S" ev) + (popup-menu menu ev))) + :help ,(or (replace-regexp-in-string + (rx "[[" (group (* (not "]"))) + "][" (group (* (not "]"))) + "]]") + "\\2" + org-clock-current-task) + "Org-Clock"))))) (defcustom +tab-bar-emms-max-length 24 "Maximum length of `+tab-bar-emms'." @@ -139,8 +139,8 @@ (- +tab-bar-emms-max-length 2)))) `(emms-now-playing menu-item ,(concat "{" now-playing "}" " ") - emms-pause - ( :help ,(emms-mode-line-playlist-current)))))) + emms-pause + ( :help ,(emms-mode-line-playlist-current)))))) (defun +tab-bar-bongo () "Display Bongo now playing information." @@ -160,22 +160,22 @@ "\\1: \\3" (bongo-formatted-infoset)) ;; This isn't right - (- (min 50 (/ (frame-width) 3 )) 2))) + (- (min 50 (/ (frame-width) 3 )) 2))) "}") - (lambda () (interactive) - (let ((bongo-playlist-buffer - ;; XXX: I'm sure this is terribly inefficient - (cl-some (lambda (b) - (with-current-buffer b - (when-let* ((modep (derived-mode-p - 'bongo-playlist-mode)) - (bongo-playlist-buffer b) - (playingp (bongo-playing-p))) - b))) - (buffer-list)))) - (with-bongo-playlist-buffer - (bongo-pause/resume)))) - :help ,(funcall bongo-header-line-function))))) + (lambda () (interactive) + (let ((bongo-playlist-buffer + ;; XXX: I'm sure this is terribly inefficient + (cl-some (lambda (b) + (with-current-buffer b + (when-let* ((modep (derived-mode-p + 'bongo-playlist-mode)) + (bongo-playlist-buffer b) + (playingp (bongo-playing-p))) + b))) + (buffer-list)))) + (with-bongo-playlist-buffer + (bongo-pause/resume)))) + :help ,(funcall bongo-header-line-function))))) (defvar +tab-bar-show-original nil "Original value of `tab-bar-show'.") @@ -192,49 +192,49 @@ ;;; FIXME this doesn't work... ;; (defvar +tab-bar-tab-min-width 8 -;; "Minimum width of a tab on the tab bar.") + ;; "Minimum width of a tab on the tab bar.") ;; (defvar +tab-bar-tab-max-width 24 -;; "Maximum width of a tab on the tab bar.") + ;; "Maximum width of a tab on the tab bar.") ;; (defun +tab-bar-fluid-calculate-width () -;; "Calculate the width of each tab in the tab-bar." -;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1))) -;; (tab-bar-avail-width (frame-width)) -;; (tab-bar-tab-count (length (tab-bar-tabs))) -;; (tab-bar-close-button-char-width 1) -;; (tab-bar-add-tab-button-char-width 1) -;; (tab-bar-total-width -;; (length (mapconcat -;; (lambda (el) -;; (when-let ((str (car-safe (cdr-safe (cdr-safe el))))) -;; (substring-no-properties (eval str)))) -;; tab-bar-list))) -;; (tab-bar-total-tab-width -;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width) -;; tab-bar-add-tab-button-char-width -;; (length (mapconcat -;; (lambda (el) -;; (substring-no-properties (alist-get 'name el))) -;; (tab-bar-tabs))))) -;; (tab-bar-total-nontab-width (- tab-bar-total-width -;; tab-bar-total-tab-width))) -;; (min +tab-bar-tab-max-width -;; (max +tab-bar-tab-min-width -;; (/ (- tab-bar-avail-width -;; tab-bar-total-tab-width -;; tab-bar-total-nontab-width) -;; tab-bar-tab-count))))) + ;; "Calculate the width of each tab in the tab-bar." + ;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1))) + ;; (tab-bar-avail-width (frame-width)) + ;; (tab-bar-tab-count (length (tab-bar-tabs))) + ;; (tab-bar-close-button-char-width 1) + ;; (tab-bar-add-tab-button-char-width 1) + ;; (tab-bar-total-width + ;; (length (mapconcat + ;; (lambda (el) + ;; (when-let ((str (car-safe (cdr-safe (cdr-safe el))))) + ;; (substring-no-properties (eval str)))) + ;; tab-bar-list))) + ;; (tab-bar-total-tab-width + ;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width) + ;; tab-bar-add-tab-button-char-width + ;; (length (mapconcat + ;; (lambda (el) + ;; (substring-no-properties (alist-get 'name el))) + ;; (tab-bar-tabs))))) + ;; (tab-bar-total-nontab-width (- tab-bar-total-width + ;; tab-bar-total-tab-width))) + ;; (min +tab-bar-tab-max-width + ;; (max +tab-bar-tab-min-width + ;; (/ (- tab-bar-avail-width + ;; tab-bar-total-tab-width + ;; tab-bar-total-nontab-width) + ;; tab-bar-tab-count))))) ;; (defun +tab-bar-fluid-width () -;; "Generate the tab name to fluidly fit in the given space." -;; (let* ((tab-file-name (buffer-file-name (window-buffer -;; (minibuffer-selected-window))))) -;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width)) -;; (if tab-file-name -;; (file-name-nondirectory tab-file-name) -;; (+tab-bar-tab-name-truncated-left)) -;; " "))) + ;; "Generate the tab name to fluidly fit in the given space." + ;; (let* ((tab-file-name (buffer-file-name (window-buffer + ;; (minibuffer-selected-window))))) + ;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width)) + ;; (if tab-file-name + ;; (file-name-nondirectory tab-file-name) + ;; (+tab-bar-tab-name-truncated-left)) + ;; " "))) (defun +tab-bar-tab-name-truncated-left () "Generate the tab name from the buffer of the selected window. @@ -259,13 +259,13 @@ name to the left." (defun +tab-bar-format-align-right () "Align the rest of tab bar items to the right, pixel-wise." ;; XXX: ideally, wouldn't require `shr' here - (require 'shr) ; `shr-string-pixel-width' - (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format))) - (rest (tab-bar-format-list rest)) - (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) - (hpos (shr-string-pixel-width rest)) - (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) - `((align-right menu-item ,str ignore)))) + (require 'shr) ; `shr-string-pixel-width' + (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format))) + (rest (tab-bar-format-list rest)) + (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) + (hpos (shr-string-pixel-width rest)) + (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) + `((align-right menu-item ,str ignore)))) ;;; Menu bar @@ -309,18 +309,18 @@ Used by `tab-bar-format-menu-bar'." `((current-tab menu-item ,(funcall tab-bar-tab-name-format-function tab i) - ignore - :help "Current tab"))) + 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")))) + 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))))))) + menu-item "" + ,(alist-get 'close-binding tab))))))) ;; Emacs 27 @@ -334,7 +334,7 @@ This is :filter-return advice for `tab-bar-make-keymap-1'." ,reserve))))) (prog1 (append output `((align-right menu-item ,str nil)) - (+tab-bar-misc-info))))) + (+tab-bar-misc-info))))) ;; Emacs 28 @@ -353,27 +353,27 @@ This is :filter-return advice for `tab-bar-make-keymap-1'." (define-minor-mode +tab-bar-misc-info-mode "Show the `mode-line-misc-info' in the `tab-bar'." :lighter "" - :global t - (if +tab-bar-misc-info-mode - (progn ; Enable - (setq +tab-bar-show-original tab-bar-show) - (cond - ((boundp 'tab-bar-format) ; Emacs 28 - (setq +tab-bar-format-original tab-bar-format) - (unless (memq '+tab-bar-misc-info tab-bar-format) - (setq tab-bar-format - (append tab-bar-format (+tab-bar-misc-info-28))))) - ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 - (advice-add 'tab-bar-make-keymap-1 :filter-return - '+tab-bar-misc-info-27))) - (setq tab-bar-show t)) - (progn ; Disable - (setq tab-bar-show +tab-bar-show-original) - (cond - ((boundp 'tab-bar-format) ; Emacs 28 - (setq tab-bar-format +tab-bar-format-original)) - ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 - (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27)))))) + :global t + (if +tab-bar-misc-info-mode + (progn ; Enable + (setq +tab-bar-show-original tab-bar-show) + (cond + ((boundp 'tab-bar-format) ; Emacs 28 + (setq +tab-bar-format-original tab-bar-format) + (unless (memq '+tab-bar-misc-info tab-bar-format) + (setq tab-bar-format + (append tab-bar-format (+tab-bar-misc-info-28))))) + ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 + (advice-add 'tab-bar-make-keymap-1 :filter-return + '+tab-bar-misc-info-27))) + (setq tab-bar-show t)) + (progn ; Disable + (setq tab-bar-show +tab-bar-show-original) + (cond + ((boundp 'tab-bar-format) ; Emacs 28 + (setq tab-bar-format +tab-bar-format-original)) + ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27 + (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27)))))) -- cgit 1.4.1-21-gabe81