summaryrefslogtreecommitdiffhomepage
path: root/lib/net
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2021-08-13 19:57:24 +0100
committerjao <jao@gnu.org>2021-08-13 19:57:24 +0100
commitd89337416769bcd0a1fdf2735ae20821106fe8dd (patch)
treeab3a1283c000e7f363b7a1a39cf62211c076ada5 /lib/net
parent3f29339692179382b7762a939618b7d60309bd3c (diff)
downloadelibs-d89337416769bcd0a1fdf2735ae20821106fe8dd.tar.gz
elibs-d89337416769bcd0a1fdf2735ae20821106fe8dd.tar.bz2
a not-quite-working (yet?) experiment: nnnotmuch
Diffstat (limited to 'lib/net')
-rw-r--r--lib/net/nnnotmuch.el276
1 files changed, 276 insertions, 0 deletions
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