;; jao-minibuffer-tracking.el --- Tracking notifications -*- lexical-binding: t; -*- ;; Copyright (C) 2021, 2022, 2024 jao ;; Author: jao ;; Keywords: convenience ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; require (require 'tracking) (require 'shorten) (require 'jao-minibuffer) (require 'jao-afio) ;;; shorten ;;;###autoload (defun jao-shorten-modes (&rest modes) (dolist (m modes) (add-to-list 'tracking-shorten-modes m))) (defvar jao-tracking-cleaners '(("^[^a-zA-Z#@]+" . "#"))) ;;;###autoload (defun jao-tracking-cleaner (rx subst) (add-to-list 'jao-tracking-cleaners (cons rx subst))) (defun jao-tracking-shorten-aggressively (lst tail-count) (let ((s (shorten-join-sans-tail lst tail-count))) (if (string-match-p "^#" s) (substring s 1 nil) s))) (defun jao-tracking-split-clean (s) (dolist (cln jao-tracking-cleaners) (when (string-match (car cln) s) (setq s (replace-match (cdr cln) nil nil s)))) (shorten-split s)) (defun jao-tracking-shorten (old-func &rest args) (let ((shorten-join-function #'jao-tracking-shorten-aggressively) (shorten-split-function #'jao-tracking-split-clean)) (apply old-func args))) (advice-add #'tracking-shorten :around #'jao-tracking-shorten) ;;; additional highlighting (defvar jao-tracking-highlight-rx "$^") ;;;###autoload (defun jao-tracking-faces (&rest faces) (dolist (face faces) (add-to-list 'tracking-faces-priorities face))) ;;;###autoload (defun jao-tracking-add-buffer (old-func &rest args) (let* ((buffer (car args)) (faces (if (and buffer (string-match-p jao-tracking-highlight-rx (buffer-name buffer))) (cons 'lui-highlight-face (cadr args)) (cadr args)))) (funcall old-func buffer faces))) (advice-add 'tracking-add-buffer :around #'jao-tracking-add-buffer) (jao-tracking-faces 'lui-highlight-face) ;;; minibuffer (defvar jao-tracking-string "") (defvar jao-tracking-bkg "grey93") (defface jao-tracking-minibuffer `((t :background ,jao-tracking-bkg)) "" :group 'faces) (defface jao-tracking-minibuffer-sep `((t :foreground ,jao-tracking-bkg :background ,jao-tracking-bkg)) "" :group 'faces) (defvar jao-tracking--pipe (let ((name "/tmp/emacs.status")) (unless (file-exists-p name) (shell-command (format "mkfifo %s" name name))) name)) (defun jao-tracking-set-log (v) (when (member window-system '(x)) (x-change-window-property "_EMACS_LOG" v nil nil nil nil 0)) (if jao-wayland-enabled (let ((inhibit-message t)) (shell-command (format "echo \"%s\" > %s" v jao-tracking--pipe))) (let* ((action (if (string-blank-p v) "remove" "add")) (cmd (format "wmctrl -r emacs -b %s,demands_attention" action))) (shell-command-to-string cmd)))) (defun jao-tracking--buffer-str (s) (if (listp s) `(:propertize ,(plist-get s :propertize) face (jao-tracking-minibuffer ,@(when-let* ((f (plist-get s 'face))) (jao-tracking-set-log " * ") (list f)))) `(:propertize "|" face jao-tracking-minibuffer-sep))) (defun jao-tracking-build-str (new-val) (jao-tracking-set-log "") (if (listp new-val) (mapcar #'jao-tracking--buffer-str new-val) new-val)) (defun jao-tracking-update-minibuffer (&rest _) (setq jao-tracking-string (jao-tracking-build-str (tracking-status))) (jao-minibuffer-refresh)) (defun jao-tracking-echo (_sym new-val _op _where) (setq jao-tracking-string (jao-tracking-build-str new-val)) (jao-minibuffer-refresh)) (defvar jao-tracking-use-scratch 5) (defvar jao-tracking--start-frame nil) (defun jao-tracking--remove-visible-buffers () (unless (and jao-afio-use-frames jao-tracking-use-scratch) (tracking-remove-visible-buffers))) ;;; package setup ;;;###autoload (defun jao-tracking-go-to-chats () (interactive) (when jao-tracking-use-scratch (jao-afio-goto-nth jao-tracking-use-scratch))) ;;;###autoload (defun jao-tracking-next-buffer () (interactive) (if jao-tracking-use-scratch (let ((k (if (numberp jao-tracking-use-scratch) jao-tracking-use-scratch 0)) (n (jao-afio-frame-no))) (unless (eq k n) (setq jao-tracking--start-frame n)) (cond (tracking-buffers (let ((bs tracking-buffers)) (if (eq k n) (tracking-next-buffer) (jao-afio-goto-nth k) (when (and (car bs) (not (memq (current-buffer) bs))) (pop-to-buffer (car bs))) (tracking-remove-visible-buffers)))) (jao-tracking--start-frame (jao-afio-goto-nth jao-tracking--start-frame) (setq jao-tracking--start-frame nil)))) (tracking-next-buffer)) (jao-tracking-update-minibuffer)) (defun jao-tracking-add-to-minibuffer () (interactive) (jao-minibuffer-add-variable 'jao-tracking-string -10) (add-variable-watcher 'tracking-mode-line-buffers #'jao-tracking-echo) (advice-add #'tracking-mode :override (lambda (&optional _) (interactive)))) (defun jao-tracking-remove-from-minibuffer () (interactive) (jao-minibuffer-remove-variable 'jao-tracking-string) (remove-variable-watcher 'tracking-mode-line-buffers #'jao-tracking-echo) (advice-remove #'tracking-mode (lambda (&optional _) (interactive)))) ;;;###autoload (defun jao-tracking-setup (&optional minibuffer) (when minibuffer (jao-tracking-add-to-minibuffer)) (add-hook 'jao-afio-switch-hook #'jao-tracking--remove-visible-buffers) (global-set-key (kbd "C-c C-SPC") #'jao-tracking-next-buffer) (define-key tracking-mode-map (kbd "C-c C-SPC") #'jao-tracking-next-buffer)) (provide 'jao-tracking) ;;; jao-minibuffer-tracking.el ends here