From 6c7d55707e3432d6c76480fff248cfea804cafd5 Mon Sep 17 00:00:00 2001 From: jao Date: Fri, 27 Nov 2020 05:06:07 +0000 Subject: more jao-maildir tweaks (no dups) --- net/jao-maildir.el | 97 ++++++++++++++++++++++++++++++++---------------------- 1 file changed, 58 insertions(+), 39 deletions(-) diff --git a/net/jao-maildir.el b/net/jao-maildir.el index 6a6bd6e..2e15980 100644 --- a/net/jao-maildir.el +++ b/net/jao-maildir.el @@ -30,64 +30,82 @@ (require 'seq) (require 'jao-minibuffer) -(defvar jao-maildirs nil) -(defvar jao-maildir-counts nil) (defvar jao-maildir-debug-p nil) (defvar jao-maildir-echo-p t) (defvar jao-maildir-tracked-maildirs nil) +(defvar jao-maildir-info-string "") +(defgroup jao-maildir-faces nil "Faces" + :group 'faces) (defun jao-maildir--maildir-new (mbox) (expand-file-name "new" mbox)) (defun jao-maildir--maildir-new-count (mbox) (- (length (directory-files (jao-maildir--maildir-new mbox))) 2)) -(defun jao-maildir--update-counts () - (dolist (mbox jao-maildirs) - (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir-counts))) +(defface jao-maildir-emph '((t :inherit font-lock-keyword-face)) + "Face used to highlihgt non-boring tracked maildirs" + :group 'jao-maildir-faces) -(defun jao-maildir--init-counts (maildirs) - (setq jao-maildir-counts (make-hash-table :test 'equal)) - (setq jao-maildirs maildirs) - (jao-maildir--update-counts) - (jao-maildir--update-info-string t)) +(defvar jao-maildir--maildirs nil) +(defvar jao-maildir--counts nil) +(defvar jao-maildir--label-mboxes nil) +(defvar jao-maildir--trackers nil) +(defvar jao-maildir--maildirs nil) +(defvar jao-maildir--track-strings ()) -(defvar jao-maildir-tracked-maildirs) -(defvar jao-maildir-info-string "") +(defun jao-maildir--update-counts () + (dolist (mbox jao-maildir--maildirs) + (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir--counts))) -(defgroup jao-maildir-faces nil "Faces" - :group 'faces) +(defun jao-maildir--init-counts (maildirs) + (setq jao-maildir--counts (make-hash-table :test 'equal)) + (setq jao-maildir--maildirs maildirs) + (jao-maildir--update-counts)) -(defface jao-maildir-emph '((t :inherit font-lock-keyword-face)) - "Face used to highlihgt non-boring tracked maildirs" - :group 'jao-maildir-faces) +(defun jao-maildir--set-trackers (maildirs tracked-maildirs) + (jao-maildir--init-counts maildirs) + (let* ((label-mboxes (make-hash-table :test 'equal)) + (trackers (mapcar (lambda (track) + (puthash (car track) () label-mboxes) + (let ((tr (seq-take track 2)) + (l (elt track 2))) + (append tr + (cond ((eq l t) '(jao-maildir-emph)) + ((null l) '(default)) + (t (list l)))))) + tracked-maildirs))) + (dolist (mbox maildirs) + (let ((lb (seq-find (lambda (lb) (string-match-p lb mbox)) + (hash-table-keys label-mboxes)))) + (puthash lb (cons mbox (gethash lb label-mboxes)) label-mboxes) + (puthash mbox lb mboxes-label))) + (setq jao-maildir--label-mboxes label-mboxes) + (setq jao-maildir--trackers trackers))) (defun jao-maildir--tracked-count (track) - (let ((rx (car track))) - (seq-reduce (lambda (c k) - (if (string-match-p rx k) (+ c (gethash k jao-maildir-counts 0)) c)) - (hash-table-keys jao-maildir-counts) - 0))) - -(defvar jao-maildir--track-strings ()) + (seq-reduce (lambda (c k) (+ c (gethash k jao-maildir--counts 0))) + (gethash (car track) jao-maildir--label-mboxes) + 0)) (defun jao-maildir--update-track-string (mbox) - (when-let ((track (seq-find (lambda (td) - (string-match-p (car td) mbox)) - jao-maildir-tracked-maildirs))) + (when-let ((track (seq-find (lambda (td) (string-match-p (car td) mbox)) + jao-maildir--trackers))) (let* ((label (cadr track)) (other (assoc-delete-all label jao-maildir--track-strings)) (cnt (jao-maildir--tracked-count track))) (if (> cnt 0) - (let* ((face (caddr track)) - (am (format "%s%s" label cnt)) - (face1 (if (eq t face) 'jao-maildir-emph face)) - (str (cons label (if face (propertize am 'face face1) am)))) + (let* ((face (last track)) + (str (cons label + (propertize (format "%s%s" label cnt) 'face face)))) (setq jao-maildir--track-strings - (if face (cons str other) (append other (list str))))) + (if (eq face 'default) + (append other (list str)) + (cons str other)))) (setq jao-maildir--track-strings other))))) (defun jao-maildir--update-info-string (&optional mbox) - (cond ((eq mbox t) (seq-do 'jao-maildir--update-track-string jao-maildirs)) + (cond ((eq mbox t) + (seq-do 'jao-maildir--update-track-string jao-maildir--maildirs)) ((stringp mbox) (jao-maildir--update-track-string mbox))) (let ((s (mapconcat 'identity (mapcar 'cdr jao-maildir--track-strings) " "))) (setq jao-maildir-info-string (if (string-blank-p s) "" (concat s " ")))) @@ -107,7 +125,7 @@ (lambda (e) (jao-maildir--log-watch e mbox) (when (memq (cadr e) '(created deleted)) - (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir-counts) + (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir--counts) (jao-maildir--update-info-string mbox) (when cb (funcall cb mbox))))) @@ -118,16 +136,17 @@ (file-notify-add-watch (jao-maildir--maildir-new mbox) '(change attribute-change) (jao-maildir--watcher mbox cb))) - jao-maildirs))) + jao-maildir--maildirs))) ;;;###autoload -(defun jao-maildir-setup (maildirs mode-line &optional cb) - (jao-maildir--init-counts maildirs) +(defun jao-maildir-setup (maildirs trackers mode-line &optional cb) + (jao-maildir--set-trackers maildirs trackers) (cond ((eq 'mode-line mode-line) (add-to-list 'global-mode-string 'jao-maildir-info-string t)) - (mode-line + ((eq 'minibuffer mode-line) (jao-minibuffer-add-variable 'jao-maildir-info-string) - (jao-maildir--update-info-string))) + (jao-maildir--update-info-string t)) + (t (error "Invalid mode-line value"))) (jao-maildir--setup-watches cb)) -- cgit v1.2.3