diff options
author | jao <jao@gnu.org> | 2021-02-02 05:16:17 +0000 |
---|---|---|
committer | jao <jao@gnu.org> | 2021-02-02 05:16:17 +0000 |
commit | 771abb84830678455de4625ac7f082d8100f0ea0 (patch) | |
tree | 0d303c2cb0861b949ca73a9705954f6a69c4f877 /net/jao-maildir.el | |
parent | 81eceb5507aa0659e9f0c9761e54e9102085c4ac (diff) | |
download | elibs-771abb84830678455de4625ac7f082d8100f0ea0.tar.gz elibs-771abb84830678455de4625ac7f082d8100f0ea0.tar.bz2 |
libs -> lib/
Diffstat (limited to 'net/jao-maildir.el')
-rw-r--r-- | net/jao-maildir.el | 155 |
1 files changed, 0 insertions, 155 deletions
diff --git a/net/jao-maildir.el b/net/jao-maildir.el deleted file mode 100644 index 76a9f9e..0000000 --- a/net/jao-maildir.el +++ /dev/null @@ -1,155 +0,0 @@ -;; jao-maildir.el -- Utilities for reading maildirs -*- lexical-binding: t; -*- - -;; Copyright (c) 2019, 2020, 2021 jao - -;; Author: jao <mail@jao.io> -;; Start date: Sun Dec 01, 2019 15:48 -;; Keywords: mail - -;; This file 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, or (at your option) -;; any later version. - -;; This file 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 GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Comentary: - -;; Inspecting the contents of maildirs and reporting it. - -;;; Code: - -(require 'seq) -(require 'jao-minibuffer) - -(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)) - -(defface jao-maildir-emph '((t :inherit font-lock-keyword-face)) - "Face used to highlihgt non-boring tracked maildirs" - :group 'jao-maildir-faces) - -(defvar jao-maildir--maildirs nil) -(defvar jao-maildir--counts nil) -(defvar jao-maildir--label-mboxes nil) -(defvar jao-maildir--trackers nil) -(defvar jao-maildir--track-strings ()) - -(defun jao-maildir--update-counts () - (dolist (mbox jao-maildir--maildirs) - (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir--counts))) - -(defun jao-maildir--init-counts (maildirs) - (setq jao-maildir--counts (make-hash-table :test 'equal)) - (setq jao-maildir--maildirs maildirs) - (jao-maildir--update-counts)) - -(defun jao-maildir--set-trackers (maildirs tracked-maildirs) - (jao-maildir--init-counts maildirs) - (let* ((label-mboxes (make-hash-table :test 'equal)) - (trackers (seq-map-indexed - (lambda (track idx) - (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))) - (list (or (elt track 3) idx))))) - tracked-maildirs))) - (dolist (mbox maildirs) - (let ((lb (seq-find (lambda (lb) (when lb (string-match-p lb mbox))) - (hash-table-keys label-mboxes)))) - (puthash lb (cons mbox (gethash lb label-mboxes)) label-mboxes))) - (setq jao-maildir--label-mboxes label-mboxes) - (setq jao-maildir--trackers trackers))) - -(defun jao-maildir--tracked-count (track) - (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--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 (car (last (butlast track)))) - (order (car (last track))) - (str (propertize (format "%s%s" label cnt) 'face face)) - (str (cons label (cons order str)))) - (setq jao-maildir--track-strings (cons str other))) - (setq jao-maildir--track-strings other))))) - -;;;###autoload -(defun jao-maildir-update-info-string (&optional mbox) - (cond ((eq mbox t) - (seq-do 'jao-maildir--update-track-string jao-maildir--maildirs)) - ((stringp mbox) - (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir--counts) - (jao-maildir--update-track-string mbox))) - (let* ((s (seq-sort-by #'cadr #'< jao-maildir--track-strings)) - (s (mapconcat 'identity (mapcar 'cddr s) " "))) - (setq jao-maildir-info-string (if (string-blank-p s) "" (concat s " ")))) - (when jao-maildir-echo-p (jao-minibuffer-refresh))) - -(defvar jao-maildir--watches nil) - -(defun jao-maildir-cancel-watchers () - (dolist (w jao-maildir--watches) (file-notify-rm-watch w)) - (setq jao-maildir--watches nil)) - -(defun jao-maildir--log-watch (mbox e) - (when jao-maildir-debug-p - (message "[%s] watch: %s: %s" (current-time-string) mbox e))) - -(defun jao-maildir--watcher (mbox cb) - (lambda (e) - (jao-maildir--log-watch e mbox) - (when (memq (cadr e) '(created deleted)) - (jao-maildir-update-info-string mbox) - (when cb (funcall cb mbox))))) - -(defun jao-maildir--setup-watches (cb) - (jao-maildir-cancel-watchers) - (setq jao-maildir--watches - (mapcar (lambda (mbox) - (file-notify-add-watch (jao-maildir--maildir-new mbox) - '(change attribute-change) - (jao-maildir--watcher mbox cb))) - jao-maildir--maildirs))) - -;;;###autoload -(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)) - ((numberp mode-line) - (jao-minibuffer-add-variable 'jao-maildir-info-string mode-line) - (jao-maildir-update-info-string t)) - (t (error "Invalid mode-line value"))) - (jao-maildir--setup-watches cb)) - - -(provide 'jao-maildir) -;;; jao-maildir.el ends here |