diff options
Diffstat (limited to 'lib/net')
| -rw-r--r-- | lib/net/nnnotmuch.el | 289 |
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))))))) |