nnnotmuch -> nnnm

2 files changed, 269 insertions, 269 deletions

diff --git a/lib/net/nnnm.el b/lib/net/nnnm.el
new file mode 100644
index 0000000..173c975
--- /dev/null
+++ b/lib/net/nnnm.el
@@ -0,0 +1,269 @@
+;;; nnnm.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 nnnm)
+
+(defvoo nnnm-directory message-directory
+  "Spool directory for the nnnm mail backend.")
+
+(defvoo nnnm-inhibit-expiry nil
+  "If non-nil, inhibit expiry.")
+
+(defvoo nnnm-saved-searches nil)
+
+
+
+;;; Interface functions.
+
+(nnoo-define-basics nnnm)
+
+(deffoo nnnm-open-server (server &optional defs)
+  (nnoo-change-server 'nnnm server defs)
+  (setq nnnm-article-files nil)
+  (cond
+   ((not (file-exists-p nnnm-directory))
+    (nnnm-close-server)
+    (nnheader-report 'nnnm "Directory doesn't exist: %s" nnnm-directory))
+   ((not (file-directory-p (file-truename nnnm-directory)))
+    (nnnm-close-server)
+    (nnheader-report 'nnnm "Not a directory: %s" nnnm-directory))
+   (t
+    (nnheader-report 'nnnm "Opened server %s using directory %s"
+		     server nnnm-directory)
+    t)))
+
+(deffoo nnnm-close-server (server)
+  (setq nnnm-article-files nil))
+
+(deffoo nnnm-request-regenerate (server)
+  (setq nnnm-article-files nil)
+  (nnnm--tag "*" "-nnnm")
+  t)
+
+(deffoo nnnm-request-list (&optional _server)
+  (with-current-buffer nntp-server-buffer
+    (erase-buffer)
+    (dolist (s nnnm-saved-searches)
+      (when-let (q (plist-get s :query))
+        (let ((name (plist-get s :name))
+              (total (nnnm--count q)))
+          (insert (format "%s %d 1 y\n" name total))))))
+  t)
+
+(deffoo nnnm-retrieve-headers (sequence &optional group server _fetch-old)
+  (message "retrieving headers for sequence %s" sequence)
+  (when (nnnm-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 (nnnm-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 "nnnm: 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 nnnm-request-article (id &optional group _server buffer)
+  ;; (nnnm-set-group-context group server)
+  (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
+	 (file-name-coding-system nnmail-pathname-coding-system)
+	 (d (nnnm--article-data id group))
+         (id (car d))
+         (file (or (cadr d) (nnnm--find-message-file id))))
+    (cond
+     ((not file)
+      (nnheader-report 'nnnm "No such article: %s" id))
+     ((not (file-exists-p file))
+      (nnheader-report 'nnnm "No such file: %s" file))
+     ((file-directory-p file)
+      (nnheader-report 'nnnm "File is a directory: %s" file))
+     ((not (save-excursion (nnmail-find-file file)))
+      (nnheader-report 'nnnm "Couldn't read file: %s" file))
+     (t
+      (nnnm--tag id "+nnnm")
+      (nnheader-report 'nnnm "Article %s retrieved" id)
+      (cons group id)))))
+
+(deffoo nnnm-request-expire-articles (articles group &optional _server _force)
+  (let ((excluded) (ids))
+    (dolist (a articles)
+      (if-let (id (car (nnnm--article-data a group)))
+          (push id ids)
+        (push a excluded)))
+    (when ids
+      (nnnm--tag (mapconcat #'identity ids " OR ") "+deleted +nnnm"))
+    excluded))
+
+;; (deffoo nnnm-request-move-article
+;;     (article group server accept-form &optional last _move-is-internal)
+;;   (error "Not implemented yet"))
+
+(deffoo nnnm-request-group (group &optional server _dont-check _info)
+  (message "opening %s" group)
+  (if (nnnm-set-group-context group server)
+      (let ((n (length (cdr (assoc group nnnm-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 'nnnm "Invalid group")))
+
+(deffoo nnnm-request-group-scan (group &optional server _info)
+  (nnnm-set-group-context group server))
+
+(deffoo nnnm-request-scan (&optional group server)
+  (nnnm-set-group-context group server))
+
+(deffoo nnnm-close-group (_group &optional _server)
+  t)
+
+(deffoo nnnm-request-create-group (group &optional _server _args)
+  (let ((query (read-string "Query: ")))
+    (add-to-list 'nnnm-saved-searches `(:name ,group :query ,query))))
+
+(deffoo nnnm-request-newgroups (_date &optional server)
+  (nnnm-request-list server))
+
+;; (deffoo nnnm-request-rename-group (group new-name &optional _server)
+;;   (error "Not implemented yet"))
+
+
+
+(defvar nnnm-article-files nil)
+
+(defun nnnm--find-query (name)
+  (when-let (s (seq-find (lambda (s) (string= (plist-get s :name) name))
+                         nnnm-saved-searches))
+    (plist-get s :query)))
+
+(defun nnnm--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 nnnm--article-data (article group)
+  (cond ((stringp article) (list article))
+        ((numberp article)
+         (when-let (data (cdr (assoc group nnnm-article-files)))
+           (elt data (1- article))))))
+
+(defun nnnm-article-to-file (article group)
+  (when-let (d (nnnm--article-data article group))
+    (or (cadr d) (nnnm--find-message-file (car d)))))
+
+(defun nnnm--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 nnnm--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 nnnm--tag (query tags)
+  (let ((cmd (format "notmuch tag %s -- '(%s)'" tags query)))
+    (shell-command-to-string cmd)))
+
+(defun nnnm--ids-query (ids) (mapconcat #'identity ids " OR "))
+
+(defun nnnm--init-data (full-group query)
+  (nnnm--tag (concat query " AND NOT tag:new AND not tag:nnnm")
+                  "+nnnm")
+  (let* ((ids (nnnm--search query "tag:nnnm"))
+         (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 nnnm--set-group-data (group data)
+  (setf (alist-get group nnnm-article-files nil t #'string=) data))
+
+(defun nnnm-set-group-context (group &optional server)
+  (when (and server (not (nnnm-server-opened server)))
+    (nnnm-open-server server))
+  (when-let (query (nnnm--find-query group))
+    (setq nnnm-current-group group)
+    (let* ((full-group (gnus-group-prefixed-name group `(nnnm ,server)))
+           (data (or (cdr (assoc group nnnm-article-files))
+                     (nnnm--init-data full-group query)))
+           (ids (nnnm--search query "tag:new AND NOT tag:nnnm"))
+           (new-data (mapcar (lambda (id)
+                               (list id (nnnm--find-message-file id)))
+                             ids)))
+      (when (> (length ids) 0)
+        (nnnm--tag (nnnm--ids-query ids) "-new"))
+      (nnnm--set-group-data group (append data new-data))
+      (gnus-set-active (gnus-group-prefixed-name group `(nnnm ,server))
+                       (cons 1 (+ (length new-data) (length data)))))))
+
+
+
+(provide 'nnnm)
+;;; nnnm.el ends here
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