summaryrefslogtreecommitdiffhomepage
path: root/lib/net
diff options
context:
space:
mode:
Diffstat (limited to 'lib/net')
-rw-r--r--lib/net/nnnotmuch.el289
1 files changed, 141 insertions, 148 deletions
diff --git a/lib/net/nnnotmuch.el b/lib/net/nnnotmuch.el
index 7aa62eb..a5fe09d 100644
--- a/lib/net/nnnotmuch.el
+++ b/lib/net/nnnotmuch.el
@@ -46,7 +46,41 @@
(nnoo-define-basics nnnotmuch)
-(deffoo nnnotmuch-retrieve-headers (sequence &optional group server fetch-old)
+(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)
@@ -59,7 +93,7 @@
'headers
(while sequence
(setq article (car sequence))
- (setq file (nnnotmuch-article-to-file article))
+ (setq file (nnnotmuch-article-to-file article group))
(when (and file
(file-exists-p file)
(not (file-directory-p file)))
@@ -86,189 +120,148 @@
(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)
+(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))))
+ (d (nnnotmuch--article-data id group))
+ (id (car d))
+ (file (or (cadr d) (nnnotmuch--find-message-file id))))
(cond
- ((not path)
+ ((not file)
(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))
+ ((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-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-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)
- (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-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-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))))
+;; (deffoo nnnotmuch-request-rename-group (group new-name &optional _server)
+;; (error "Not implemented yet"))
(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" ""))))
+ (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--query-files (query)
- (let ((cmd (format "notmuch search --sort=oldest-first --output=files -- %s"
- (shell-quote-argument query))))
+(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--find-group-files (group)
- (when-let (q (nnnotmuch--find-query group))
- (nnnotmuch--query-files q)))
+(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)))
+ (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)
-
+ (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)))))))