diff options
Diffstat (limited to 'src/jd/features/mail.scm')
| -rw-r--r-- | src/jd/features/mail.scm | 147 |
1 files changed, 147 insertions, 0 deletions
diff --git a/src/jd/features/mail.scm b/src/jd/features/mail.scm new file mode 100644 index 0000000..bf137e9 --- /dev/null +++ b/src/jd/features/mail.scm | |||
| @@ -0,0 +1,147 @@ | |||
| 1 | (define-module (jd features mail) | ||
| 2 | #:use-module (rde packages) | ||
| 3 | #:use-module (rde exceptions) | ||
| 4 | #:use-module (rde features) | ||
| 5 | #:use-module (rde predicates) | ||
| 6 | #:use-module (rde features emacs) | ||
| 7 | #:use-module (rde features mail) | ||
| 8 | #:use-module ((rde features mail providers) #:prefix mail-providers:) | ||
| 9 | #:use-module (gnu packages mail) | ||
| 10 | #:use-module (gnu packages emacs-xyz) | ||
| 11 | #:use-module (rde packages emacs-xyz) | ||
| 12 | #:use-module (rde packages mail) | ||
| 13 | #:use-module (rde serializers elisp) | ||
| 14 | #:use-module (rde home services mail) | ||
| 15 | #:use-module (gnu services) | ||
| 16 | #:use-module (gnu services configuration) | ||
| 17 | #:use-module (gnu home services) | ||
| 18 | #:use-module (gnu home-services mail) | ||
| 19 | #:use-module (gnu home services mcron) | ||
| 20 | #:use-module (gnu home-services version-control) | ||
| 21 | #:use-module (gnu home services xdg) | ||
| 22 | |||
| 23 | #:use-module (ice-9 match) | ||
| 24 | #:use-module (srfi srfi-1) | ||
| 25 | #:use-module (guix gexp) | ||
| 26 | #:use-module (guix deprecation) | ||
| 27 | #:use-module (guix diagnostics) | ||
| 28 | #:use-module (guix i18n) | ||
| 29 | |||
| 30 | #:export (feature-l2md* feature-mail-mcron feature-octave)) | ||
| 31 | |||
| 32 | (define* (feature-l2md* | ||
| 33 | #:key | ||
| 34 | (l2md l2md)) | ||
| 35 | "Configure l2md MDA." | ||
| 36 | (ensure-pred file-like? l2md) | ||
| 37 | |||
| 38 | (define (get-home-services config) | ||
| 39 | (require-value 'mail-directory-fn config) | ||
| 40 | (require-value 'mailing-lists config) | ||
| 41 | (define mail-dir ((get-value 'mail-directory-fn config) config)) | ||
| 42 | (define mls (filter (lambda (x) (eq? (mailing-list-synchronizer x) 'l2md)) | ||
| 43 | (get-value 'mailing-lists config))) | ||
| 44 | (define (get-repo-config ml) | ||
| 45 | (let ((repo-config (mailing-list-config ml))) | ||
| 46 | (if (eq? %unset-value (l2md-repo-maildir repo-config)) | ||
| 47 | (l2md-repo | ||
| 48 | (inherit repo-config) | ||
| 49 | (maildir (string-append | ||
| 50 | mail-dir "/lists/" (mailing-list-fqda ml) "/archive"))) | ||
| 51 | repo-config))) | ||
| 52 | ;; <https://git.kernel.org/pub/scm/linux/kernel/git/dborkman/l2md.git/about/> | ||
| 53 | ;; Applying patches <https://git.kyleam.com/piem/about/> | ||
| 54 | |||
| 55 | (define add-ml-tag | ||
| 56 | (map (lambda (x) | ||
| 57 | (format | ||
| 58 | #f "notmuch tag +~a -- path:lists/~a/**" | ||
| 59 | ;; TODO: Use new tag not to retag already existing entities. | ||
| 60 | ;; Do it before new tag will be romved | ||
| 61 | ;; TODO: Fix order of items in post-new hook | ||
| 62 | (mailing-list-id x) (mailing-list-fqda x))) | ||
| 63 | mls)) | ||
| 64 | |||
| 65 | (list | ||
| 66 | (simple-service | ||
| 67 | 'l2md-add-tags-to-mailing-list | ||
| 68 | home-notmuch-service-type | ||
| 69 | (home-notmuch-extension | ||
| 70 | (post-new | ||
| 71 | (list | ||
| 72 | #~(begin (for-each system '#$add-ml-tag)))))) | ||
| 73 | |||
| 74 | (service | ||
| 75 | home-l2md-service-type | ||
| 76 | (home-l2md-configuration | ||
| 77 | (l2md l2md) | ||
| 78 | (oneshot 1) | ||
| 79 | (repos (map get-repo-config mls)))))) | ||
| 80 | |||
| 81 | (feature | ||
| 82 | (name 'l2md) | ||
| 83 | (home-services-getter get-home-services) | ||
| 84 | (values `((l2md . ,l2md))))) | ||
| 85 | |||
| 86 | (define* (feature-mail-mcron | ||
| 87 | #:key | ||
| 88 | (time-spec '(next-minute | ||
| 89 | (range 0 60 20)))) | ||
| 90 | "Configure mcron to invoke other email commands based on the other | ||
| 91 | features that have been enabled." | ||
| 92 | (define (get-home-services config) | ||
| 93 | (list | ||
| 94 | (when (get-value 'isync config) | ||
| 95 | (let* ((sync-cmd (list `(,((get-value 'mbsync config) config) "-a"))) | ||
| 96 | (notmuch-cmd (if (get-value 'notmuch config) | ||
| 97 | (list `(,(file-append (get-value 'notmuch config) "/bin/notmuch") | ||
| 98 | "new")) | ||
| 99 | (list))) | ||
| 100 | (l2md-cmd (if (get-value 'l2md config) | ||
| 101 | (list `(,(file-append (get-value 'l2md config) "/bin/l2md"))) | ||
| 102 | (list)))) | ||
| 103 | (simple-service | ||
| 104 | 'isync-mcron-job | ||
| 105 | home-mcron-service-type | ||
| 106 | (list | ||
| 107 | #~(job '#$time-spec | ||
| 108 | (lambda () | ||
| 109 | (setenv "DISPLAY" ":0") | ||
| 110 | #$@(map (lambda (x) `(system* ,@x)) | ||
| 111 | (append sync-cmd l2md-cmd notmuch-cmd)))))))))) | ||
| 112 | |||
| 113 | (feature | ||
| 114 | (name 'mail-mcron) | ||
| 115 | (home-services-getter get-home-services))) | ||
| 116 | |||
| 117 | (define* (feature-octave | ||
| 118 | #:key (octave (@ (gnu packages maths) octave-cli))) | ||
| 119 | (define f-name 'octave) | ||
| 120 | (define (get-home-services config) | ||
| 121 | (list | ||
| 122 | (rde-elisp-configuration-service | ||
| 123 | f-name | ||
| 124 | config | ||
| 125 | `((with-eval-after-load 'org | ||
| 126 | (require 'ob-octave) | ||
| 127 | (add-to-list 'org-structure-template-alist | ||
| 128 | '("octave" . "src octave")) | ||
| 129 | (org-babel-do-load-languages | ||
| 130 | 'org-babel-load-languages | ||
| 131 | '((octave . t))) | ||
| 132 | (setq org-babel-default-header-args:octave | ||
| 133 | '((:results . "output") | ||
| 134 | (:session . "octave") | ||
| 135 | (:exports . "both") | ||
| 136 | (:eval . "no-export")))))) | ||
| 137 | (simple-service | ||
| 138 | 'octave-packages | ||
| 139 | home-profile-service-type | ||
| 140 | (append (or (and (get-value 'python config) | ||
| 141 | (list (@ (gnu packages python-xyz) python-sympy))) | ||
| 142 | '()) | ||
| 143 | (list octave))))) | ||
| 144 | (feature | ||
| 145 | (name f-name) | ||
| 146 | (values `((,f-name . #t))) | ||
| 147 | (home-services-getter get-home-services))) | ||
