From c44f4a5447cce0c94d0cf054545979cb200428a8 Mon Sep 17 00:00:00 2001 From: jao Date: Wed, 2 Mar 2022 03:33:51 +0000 Subject: attic: jao-maildir --- lib/net/jao-maildir.el | 189 -------------------------------------------- lib/net/jao-notmuch-move.el | 75 ------------------ 2 files changed, 264 deletions(-) delete mode 100644 lib/net/jao-maildir.el delete mode 100644 lib/net/jao-notmuch-move.el (limited to 'lib/net') diff --git a/lib/net/jao-maildir.el b/lib/net/jao-maildir.el deleted file mode 100644 index 18a1725..0000000 --- a/lib/net/jao-maildir.el +++ /dev/null @@ -1,189 +0,0 @@ -;; jao-maildir.el -- Utilities for reading maildirs -*- lexical-binding: t; -*- - -;; Copyright (c) 2019, 2020, 2021 jao - -;; Author: jao -;; 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 "") -(defvar jao-maildir-home (expand-file-name "~/var/mail")) -(defvar jao-maildir-news-home (expand-file-name "~/var/news")) - -(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) - (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)) - -;;;###autoload -(defun jao-maildir-file-to-group (file &optional maildir newsdir) - "Calculate the Gnus group name from the given file name. -Example: - - IN: /home/jao/var/mail/jao/foo/cur/1259184569.M4818P3384.localhost,W=6921:2,S - OUT: nnml:jao.foo - - IN: /home/jao/.emacs.d/gnus/Mail/jao.trove/32570, /home/jao/.emacs.d/gnus/Mail/ - OUT: nnml:jao.trove - - IN: /home/jao/var/mail/gmane/foo/bar/100 - OUT: nntp:gmane.foo.bar - - IN: /home/jao/var/mail/bigml/cur/1259176906.M17483P24679.localhost,W=2488:2,S - OUT:nnimap:bigml/inbox" - (let* ((g (directory-file-name (file-name-directory file))) - (g (replace-regexp-in-string - (file-name-as-directory (or maildir jao-maildir-home)) "" g)) - (g (replace-regexp-in-string - (file-name-as-directory (or newsdir jao-maildir-news-home)) "" g)) - (nntp (string-match-p "^\\(gmane\\|gwene\\)/" g)) - (g (cond (nntp (concat "nntp:" g)) - ((file-name-directory g) - (replace-regexp-in-string "^\\([^/]+\\)/" "nnml:\\1/" - (file-name-directory g) t)) - (t (concat "nnml:" g)))) - (g (replace-regexp-in-string "/" "." g)) - (g (replace-regexp-in-string "[/.]$" "" g))) - (cond ((string-match ":$" g) (concat g "inbox")) - (nntp g) - (t (replace-regexp-in-string ":\\." ":" g))))) - -(provide 'jao-maildir) -;;; jao-maildir.el ends here diff --git a/lib/net/jao-notmuch-move.el b/lib/net/jao-notmuch-move.el deleted file mode 100644 index eb7ea4c..0000000 --- a/lib/net/jao-notmuch-move.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; jao-notmuch-move.el --- Move messages around in notmuch -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 jao - -;; Author: jao -;; Keywords: mail - -;; 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 . - -;;; Commentary: - -;; Moving messages around - -;;; Code: - -(require 'notmuch) - -(defvar jao-notmuch-mailboxes nil) -(defvar jao-notmuch-mailboxes-rx nil) - -(defun jao-notmuch--path-to-mailbox (full-path) - (unless jao-notmuch-mailboxes-rx - (setq jao-notmuch-mailboxes-rx (regexp-opt jao-notmuch-mailboxes))) - (if (string-match jao-notmuch-mailboxes-rx full-path) - (match-string 0 full-path) - (user-error "Message not in any registered mailbox!"))) - -(defun jao-notmuch--msg-props () - (if-let ((p (save-excursion - (beginning-of-line) - (text-property-search-forward :notmuch-message-properties)))) - (prop-match-value p) - (user-error "No message at point"))) - -(defun jao-notmuch--full-path () - (seq-find #'file-exists-p (plist-get (jao-notmuch--msg-props) :filename))) - -(defun jao-notmuch--move (&optional full-path d) - (let* ((full-path (or full-path (jao-notmuch--full-path))) - (ff (jao-notmuch--path-to-mailbox full-path)) - (d (or d (completing-read (format "From %s to: " ff) - (remove ff jao-notmuch-mailboxes) nil t))) - (dest (string-replace ff d full-path)) - (dest (replace-regexp-in-string ",U=.+$" "m:2,S" dest)) - (ftags (split-string ff "/")) - (ttags (split-string d "/"))) - (when (y-or-n-p (format "%s -> %s? " ftags ttags)) - (notmuch-tree-close-message-window) - (notmuch-tree-tag (append (notmuch-tag-change-list ftags t) - (notmuch-tag-change-list ttags))) - (rename-file (jao-notmuch--full-path) dest) - (shell-command-to-string "notmuch new") - (notmuch-refresh-this-buffer)))) - -(defun jao-notmuch-move-message () - "Move message at point to another folder." - (interactive) - (jao-notmuch--move)) - - - - -(provide 'jao-notmuch-move) -;;; jao-notmuch-move.el ends here -- cgit v1.2.3