diff options
Diffstat (limited to 'lib/net/nnnotmuch.el')
-rw-r--r-- | lib/net/nnnotmuch.el | 269 |
1 files changed, 0 insertions, 269 deletions
diff --git a/lib/net/nnnotmuch.el b/lib/net/nnnotmuch.el deleted file mode 100644 index a5fe09d..0000000 --- a/lib/net/nnnotmuch.el +++ /dev/null @@ -1,269 +0,0 @@ -;;; 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-open-server (server &optional defs) - (nnoo-change-server 'nnnotmuch server defs) - (setq nnnotmuch-article-files nil) - (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-close-server (server) - (setq nnnotmuch-article-files nil)) - -(deffoo nnnotmuch-request-regenerate (server) - (setq nnnotmuch-article-files nil) - (nnnotmuch--tag "*" "-nnnotmuch") - t) - -(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 q))) - (insert (format "%s %d 1 y\n" name total)))))) - t) - -(deffoo nnnotmuch-retrieve-headers (sequence &optional group server _fetch-old) - (message "retrieving headers for sequence %s" sequence) - (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 group)) - (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-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) - (d (nnnotmuch--article-data id group)) - (id (car d)) - (file (or (cadr d) (nnnotmuch--find-message-file id)))) - (cond - ((not file) - (nnheader-report 'nnnotmuch "No such article: %s" id)) - ((not (file-exists-p file)) - (nnheader-report 'nnnotmuch "No such file: %s" file)) - ((file-directory-p file) - (nnheader-report 'nnnotmuch "File is a directory: %s" file)) - ((not (save-excursion (nnmail-find-file file))) - (nnheader-report 'nnnotmuch "Couldn't read file: %s" file)) - (t - (nnnotmuch--tag id "+nnnotmuch") - (nnheader-report 'nnnotmuch "Article %s retrieved" id) - (cons group id))))) - -(deffoo nnnotmuch-request-expire-articles (articles group &optional _server _force) - (let ((excluded) (ids)) - (dolist (a articles) - (if-let (id (car (nnnotmuch--article-data a group))) - (push id ids) - (push a excluded))) - (when ids - (nnnotmuch--tag (mapconcat #'identity ids " OR ") "+deleted +nnnotmuch")) - excluded)) - -;; (deffoo nnnotmuch-request-move-article -;; (article group server accept-form &optional last _move-is-internal) -;; (error "Not implemented yet")) - -(deffoo nnnotmuch-request-group (group &optional server _dont-check _info) - (message "opening %s" group) - (if (nnnotmuch-set-group-context group server) - (let ((n (length (cdr (assoc group nnnotmuch-article-files))))) - (message "we found here %s articles" n) - (with-current-buffer nntp-server-buffer - (erase-buffer) - (nnheader-insert "211 %d %d %d %s\n" n 1 n group) - n)) - (message "we didn't find anything!!") - (nnheader-report 'nnnotmuch "Invalid group"))) - -(deffoo nnnotmuch-request-group-scan (group &optional server _info) - (nnnotmuch-set-group-context group server)) - -(deffoo nnnotmuch-request-scan (&optional group server) - (nnnotmuch-set-group-context group server)) - -(deffoo nnnotmuch-close-group (_group &optional _server) - t) - -(deffoo nnnotmuch-request-create-group (group &optional _server _args) - (let ((query (read-string "Query: "))) - (add-to-list 'nnnotmuch-saved-searches `(:name ,group :query ,query)))) - -(deffoo nnnotmuch-request-newgroups (_date &optional server) - (nnnotmuch-request-list server)) - -;; (deffoo nnnotmuch-request-rename-group (group new-name &optional _server) -;; (error "Not implemented yet")) - - - -(defvar nnnotmuch-article-files nil) - -(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-message-file (id) - (car (split-string - (shell-command-to-string - (format "notmuch search --output=files %s" - (if (string-prefix-p "id:" id) id (concat "id:" id))))))) - -(defun nnnotmuch--article-data (article group) - (cond ((stringp article) (list article)) - ((numberp article) - (when-let (data (cdr (assoc group nnnotmuch-article-files))) - (elt data (1- article)))))) - -(defun nnnotmuch-article-to-file (article group) - (when-let (d (nnnotmuch--article-data article group)) - (or (cadr d) (nnnotmuch--find-message-file (car d))))) - -(defun nnnotmuch--count (query &optional context) - (let ((cmd (format "notmuch count -- '(%s)%s'" - query - (if context (concat " AND " context) "")))) - (string-to-number (shell-command-to-string cmd)))) - -(defun nnnotmuch--search (query &optional context) - (let ((cmd (format "notmuch search --sort=oldest-first --output=messages -- %s%s" - (shell-quote-argument (format "(%s)" query)) - (if context (concat " AND " context) "")))) - (split-string (shell-command-to-string cmd)))) - -(defun nnnotmuch--tag (query tags) - (let ((cmd (format "notmuch tag %s -- '(%s)'" tags query))) - (shell-command-to-string cmd))) - -(defun nnnotmuch--ids-query (ids) (mapconcat #'identity ids " OR ")) - -(defun nnnotmuch--init-data (full-group query) - (nnnotmuch--tag (concat query " AND NOT tag:new AND not tag:nnnotmuch") - "+nnnotmuch") - (let* ((ids (nnnotmuch--search query "tag:nnnotmuch")) - (info (gnus-get-info full-group)) - (read (when (> (length ids) 0) (list (cons 1 (length ids))))) - (marks (list (cons 'seen read)))) - (gnus-info-set-marks info marks) - (setf (gnus-info-read info) read) - (gnus-set-info full-group info) - (message "group %s - %s" full-group (gnus-get-info full-group)) - (mapcar #'list ids))) - -(defun nnnotmuch--set-group-data (group data) - (setf (alist-get group nnnotmuch-article-files nil t #'string=) data)) - -(defun nnnotmuch-set-group-context (group &optional server) - (when (and server (not (nnnotmuch-server-opened server))) - (nnnotmuch-open-server server)) - (when-let (query (nnnotmuch--find-query group)) - (setq nnnotmuch-current-group group) - (let* ((full-group (gnus-group-prefixed-name group `(nnnotmuch ,server))) - (data (or (cdr (assoc group nnnotmuch-article-files)) - (nnnotmuch--init-data full-group query))) - (ids (nnnotmuch--search query "tag:new AND NOT tag:nnnotmuch")) - (new-data (mapcar (lambda (id) - (list id (nnnotmuch--find-message-file id))) - ids))) - (when (> (length ids) 0) - (nnnotmuch--tag (nnnotmuch--ids-query ids) "-new")) - (nnnotmuch--set-group-data group (append data new-data)) - (gnus-set-active (gnus-group-prefixed-name group `(nnnotmuch ,server)) - (cons 1 (+ (length new-data) (length data))))))) - - - -(provide 'nnnotmuch) -;;; nnnotmuch.el ends here |