From bc591dcedf45b80f70661f33c42c68dbd581e901 Mon Sep 17 00:00:00 2001 From: jdlugosz963 Date: Mon, 11 Aug 2025 17:36:57 +0200 Subject: Migrate to RDE --- src/jd/features/mail.scm | 115 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 115 insertions(+) create mode 100644 src/jd/features/mail.scm (limited to 'src/jd/features/mail.scm') diff --git a/src/jd/features/mail.scm b/src/jd/features/mail.scm new file mode 100644 index 0000000..f5c3536 --- /dev/null +++ b/src/jd/features/mail.scm @@ -0,0 +1,115 @@ +(define-module (jd features mail) + #:use-module (rde packages) + #:use-module (rde exceptions) + #:use-module (rde features) + #:use-module (rde predicates) + #:use-module (rde features emacs) + #:use-module (rde features mail) + #:use-module ((rde features mail providers) #:prefix mail-providers:) + #:use-module (gnu packages mail) + #:use-module (gnu packages emacs-xyz) + #:use-module (rde packages emacs-xyz) + #:use-module (rde packages mail) + #:use-module (rde serializers elisp) + #:use-module (rde home services mail) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu home services) + #:use-module (gnu home-services mail) + #:use-module (gnu home services mcron) + #:use-module (gnu home-services version-control) + #:use-module (gnu home services xdg) + + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (guix gexp) + #:use-module (guix deprecation) + #:use-module (guix diagnostics) + #:use-module (guix i18n) + + #:export (feature-l2md* feature-mail-mcron)) + +(define* (feature-l2md* + #:key + (l2md l2md)) + "Configure l2md MDA." + (ensure-pred file-like? l2md) + + (define (get-home-services config) + (require-value 'mail-directory-fn config) + (require-value 'mailing-lists config) + (define mail-dir ((get-value 'mail-directory-fn config) config)) + (define mls (filter (lambda (x) (eq? (mailing-list-synchronizer x) 'l2md)) + (get-value 'mailing-lists config))) + (define (get-repo-config ml) + (let ((repo-config (mailing-list-config ml))) + (if (eq? %unset-value (l2md-repo-maildir repo-config)) + (l2md-repo + (inherit repo-config) + (maildir (string-append + mail-dir "/lists/" (mailing-list-fqda ml) "/archive"))) + repo-config))) + ;; + ;; Applying patches + + (define add-ml-tag + (map (lambda (x) + (format + #f "notmuch tag +~a -- path:lists/~a/**" + ;; TODO: Use new tag not to retag already existing entities. + ;; Do it before new tag will be romved + ;; TODO: Fix order of items in post-new hook + (mailing-list-id x) (mailing-list-fqda x))) + mls)) + + (list + (simple-service + 'l2md-add-tags-to-mailing-list + home-notmuch-service-type + (home-notmuch-extension + (post-new + (list + #~(begin (for-each system '#$add-ml-tag)))))) + + (service + home-l2md-service-type + (home-l2md-configuration + (l2md l2md) + (oneshot 1) + (repos (map get-repo-config mls)))))) + + (feature + (name 'l2md) + (home-services-getter get-home-services) + (values `((l2md . ,l2md))))) + +(define* (feature-mail-mcron + #:key + (time-spec '(next-minute + (range 0 60 20)))) + "Configure mcron to invoke other email commands based on the other +features that have been enabled." + (define (get-home-services config) + (list + (when (get-value 'isync config) + (let* ((sync-cmd (list `(,((get-value 'mbsync config) config) "-a"))) + (notmuch-cmd (if (get-value 'notmuch config) + (list `(,(file-append (get-value 'notmuch config) "/bin/notmuch") + "new")) + (list))) + (l2md-cmd (if (get-value 'l2md config) + (list `(,(file-append (get-value 'l2md config) "/bin/l2md"))) + (list)))) + (simple-service + 'isync-mcron-job + home-mcron-service-type + (list + #~(job '#$time-spec + (lambda () + (setenv "DISPLAY" ":0") + #$@(map (lambda (x) `(system* ,@x)) + (append sync-cmd l2md-cmd notmuch-cmd)))))))))) + + (feature + (name 'mail-mcron) + (home-services-getter get-home-services))) -- cgit v1.2.3