diff options
| -rw-r--r-- | gnus.org | 5 | ||||
| -rw-r--r-- | lib/net/nnnotmuch.el | 276 |
2 files changed, 280 insertions, 1 deletions
@@ -4,7 +4,7 @@ * Feature switching vars #+begin_src emacs-lisp - (defvar jao-gnus-use-local-imap t) + (defvar jao-gnus-use-local-imap nil) (defvar jao-gnus-use-leafnode nil) (defvar jao-gnus-use-gandi-imap nil) (defvar jao-gnus-use-pm-imap nil) @@ -199,6 +199,9 @@ (gnus-search-engine gnus-search-notmuch (remove-prefix "/home/jao/var/mail/"))))) + + (when (require 'nnnotmuch nil t) + (add-to-list 'gnus-secondary-select-methods '(nnnotmuch "nm"))) #+end_src * Demons and notifications #+begin_src emacs-lisp diff --git a/lib/net/nnnotmuch.el b/lib/net/nnnotmuch.el new file mode 100644 index 0000000..7aa62eb --- /dev/null +++ b/lib/net/nnnotmuch.el @@ -0,0 +1,276 @@ +;;; nnnotmuch.el --- Gnus backend for notmuch -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 jao + +;; Author: jao <mail@jao.io> +;; 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; A Gnus mail backend using notmuch. + +;;; Code: + +(require 'gnus) +(require 'nnheader) +(require 'nnmail) +(require 'nnoo) +(require 'notmuch) + +(nnoo-declare nnnotmuch) + +(defvoo nnnotmuch-directory message-directory + "Spool directory for the nnnotmuch mail backend.") + +(defvoo nnnotmuch-inhibit-expiry nil + "If non-nil, inhibit expiry.") + +(defvoo nnnotmuch-saved-searches nil) + + + +;;; Interface functions. + +(nnoo-define-basics nnnotmuch) + +(deffoo nnnotmuch-retrieve-headers (sequence &optional group server fetch-old) + (when (nnnotmuch-set-group-context group server) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (let* ((file nil) + (number (length sequence)) + (count 0) + (file-name-coding-system nnmail-pathname-coding-system) + beg article) + (if (stringp (car sequence)) + 'headers + (while sequence + (setq article (car sequence)) + (setq file (nnnotmuch-article-to-file article)) + (when (and file + (file-exists-p file) + (not (file-directory-p file))) + (insert (format "221 %d Article retrieved.\n" article)) + (setq beg (point)) + (nnheader-insert-head file) + (goto-char beg) + (if (re-search-forward "\n\r?\n" nil t) + (forward-char -1) + (goto-char (point-max)) + (insert "\n\n")) + (insert ".\n") + (delete-region (point) (point-max))) + (setq sequence (cdr sequence)) + (setq count (1+ count)) + (and (numberp nnmail-large-newsgroup) + (> number nnmail-large-newsgroup) + (zerop (% count 20)) + (nnheader-message 6 "nnnotmuch: Receiving headers... %d%%" + (floor (* count 100.0) number)))) + (and (numberp nnmail-large-newsgroup) + (> number nnmail-large-newsgroup) + (nnheader-message 6 "nnml: Receiving headers...done")) + (nnheader-fold-continuation-lines) + 'headers))))) + +(deffoo nnnotmuch-open-server (server &optional defs) + (nnoo-change-server 'nnnotmuch server defs) + (cond + ((not (file-exists-p nnnotmuch-directory)) + (nnnotmuch-close-server) + (nnheader-report 'nnnotmuch "Directory doesn't exist: %s" nnnotmuch-directory)) + ((not (file-directory-p (file-truename nnnotmuch-directory))) + (nnnotmuch-close-server) + (nnheader-report 'nnnotmuch "Not a directory: %s" nnnotmuch-directory)) + (t + (nnheader-report 'nnnotmuch "Opened server %s using directory %s" + server nnnotmuch-directory) + t))) + +(deffoo nnnotmuch-request-regenerate (server) + (nnnotmuch-set-group-context nil server) + t) + +(deffoo nnnotmuch-request-article (id &optional group server buffer) + (nnnotmuch-set-group-context group server) + (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) + (file-name-coding-system nnmail-pathname-coding-system) + (path (if (stringp id) + (nnnotmuch--find-message-file id) + (nnnotmuch-article-to-file id)))) + (cond + ((not path) + (nnheader-report 'nnnotmuch "No such article: %s" id)) + ((not (file-exists-p path)) + (nnheader-report 'nnnotmuch "No such file: %s" path)) + ((file-directory-p path) + (nnheader-report 'nnnotmuch "File is a directory: %s" path)) + ((not (save-excursion (nnmail-find-file path))) + (nnheader-report 'nnnotmuch "Couldn't read file: %s" path)) + (t + (nnheader-report 'nnnotmuch "Article %s retrieved" id) + (cons group id))))) + +(deffoo nnnotmuch-request-group (group &optional server _dont-check info) + (cond + ((not (nnnotmuch-set-group-context group server)) + (nnheader-report 'nnnotmuch "Invalid group")) + (t + (let* ((info (or info (gnus-get-info group))) + (num-headers (length nnnotmuch-article-files)) + (status (format "211 %d %d %d %s" num-headers 1 num-headers group))) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (nnheader-insert "%s\n" status) + ;; (when info + ;; (gnus-info-set-marks + ;; info + ;; (append (assq-delete-all 'seen (gnus-info-marks info)) + ;; (list `(seen (1 . ,num-headers)))) + ;; t)) + )) + t))) + +(deffoo nnnotmuch-request-group-scan (group &optional server info) + (setq nnnotmuch-article-files nil) + (nnnotmuch-set-group-context group server) + (gnus-get-unread-articles-in-group + (or info (gnus-get-info gnus-newsgroup-name)) + (gnus-active (gnus-info-group info)))) + +(deffoo nnnotmuch-request-scan (&optional group server) + (nnnotmuch-set-group-context group server)) + +(deffoo nnnotmuch-close-group (_group &optional _server) + (setq nnnotmuch-article-files nil) + t) + +(deffoo nnnotmuch-request-create-group (group &optional server _args) + (nnnotmuch-set-group-context nil server) + (nnmail-activate 'nnnotmuch) + (error "Not implemented yet")) + +(deffoo nnnotmuch-request-list (&optional _server) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (dolist (s nnnotmuch-saved-searches) + (when-let (q (plist-get s :query)) + (let* ((name (plist-get s :name)) + (total (nnnotmuch--count-files q)) + (new (nnnotmuch--count-files q t)) + (first (1+ (- total new)))) + (insert (format "%s %d %d y\n" name total first)))))) + t) + +(deffoo nnnotmuch-request-newgroups (_date &optional server) + (nnnotmuch-request-list server)) + +(deffoo nnnotmuch-request-list-newsgroups (&optional _server) + nil) + +(deffoo nnnotmuch-request-expire-articles (articles group &optional server force) + (nnnotmuch-set-group-context group server) + (when (eq 'delete nnmail-expiry-target) + (error "Not implemented yet"))) + +(deffoo nnnotmuch-request-move-article + (article group server accept-form &optional last _move-is-internal) + (error "Not implemented yet")) + +(deffoo nnnotmuch-request-accept-article (group &optional server last) + (error "Not implemented yet")) + +(deffoo nnnotmuch-request-post (&optional server) + (nnmail-do-request-post 'nnnotmuch-request-accept-article server)) + +(deffoo nnnotmuch-request-update-info (group info &optional server) + (when-let (n (nnnotmuch--count-files (nnnotmuch--find-query group))) + (gnus-set-active (gnus-group-prefixed-name group `(nnnotmuch ,server)) + (cons 1 n)))) + +(deffoo nnnotmuch-request-replace-article (article group buffer) + (error "Not implemented yet")) + +(deffoo nnnotmuch-request-delete-group (group &optional force server) + (error "Not implemented yet")) + +(deffoo nnnotmuch-request-rename-group (group new-name &optional server) + (error "Not implemented yet")) + +(deffoo nnnotmuch-set-status (article name value &optional group server) + (nnnotmuch-set-group-context group server) + (let ((file (nnnotmuch-article-to-file article))) + (cond + ((not (file-exists-p file)) + (nnheader-report 'nnnotmuch "File %s does not exist" file)) + (t + (message "Setting status %s to %s" name value) + ;; (with-temp-file file + ;; (nnheader-insert-file-contents file) + ;; (nnmail-replace-status name value)) + t)))) + + + +(defvar nnnotmuch-article-files nil) + +(defun nnnotmuch-article-to-file (article) + (when (numberp article) + (elt nnnotmuch-article-files (1- article)))) + +(defun nnnotmuch--find-query (name) + (when-let (s (seq-find (lambda (s) (string= (plist-get s :name) name)) + nnnotmuch-saved-searches)) + (plist-get s :query))) + +(defun nnnotmuch--find-group-message-ids (group &optional search) + (when-let (q (or search (nnnotmuch--find-query group))) + (notmuch-query-get-message-ids q))) + +(defun nnnotmuch--find-message-file (id) + (let ((q (notmuch-id-to-query id))) + (string-trim + (shell-command-to-string + (format "notmuch search --output=files %s" q))))) + +(defun nnnotmuch--count-files (query &optional unread) + (let ((cmd (format "notmuch count --output=files -- %s%s" + (shell-quote-argument (format "(%s)" query)) + (if unread " AND tag:unread" "")))) + (string-to-number (shell-command-to-string cmd)))) + +(defun nnnotmuch--query-files (query) + (let ((cmd (format "notmuch search --sort=oldest-first --output=files -- %s" + (shell-quote-argument query)))) + (split-string (shell-command-to-string cmd)))) + +(defun nnnotmuch--find-group-files (group) + (when-let (q (nnnotmuch--find-query group)) + (nnnotmuch--query-files q))) + +(defun nnnotmuch-set-group-context (group &optional server) + (when (and server + (not (nnnotmuch-server-opened server))) + (nnnotmuch-open-server server)) + (setq nnnotmuch-current-group group + nnnotmuch-article-files (nnnotmuch--find-group-files group)) + t) + + + + +(provide 'nnnotmuch) +;;; nnnotmuch.el ends here |