aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorÓscar Nájera <hi@oscarnajera.com>2022-05-06 13:41:17 +0200
committerÓscar Nájera <hi@oscarnajera.com>2022-05-06 13:56:08 +0200
commit206db42b91577677e61f9128653a8e81af3a5d80 (patch)
tree70e7388c0dadb2fbcbaab08c0cb66ea9b71673cc
parentda2085ffd87c0354de2396a06c855cfd76113ae1 (diff)
downloaddotfiles-206db42b91577677e61f9128653a8e81af3a5d80.tar.gz
dotfiles-206db42b91577677e61f9128653a8e81af3a5d80.tar.bz2
dotfiles-206db42b91577677e61f9128653a8e81af3a5d80.zip
Review tagmail
-rwxr-xr-xbin/tagmail45
-rw-r--r--lib/guile/mail-tools.scm20
2 files changed, 31 insertions, 34 deletions
diff --git a/bin/tagmail b/bin/tagmail
index 02e5d6e..611d2f6 100755
--- a/bin/tagmail
+++ b/bin/tagmail
@@ -18,7 +18,6 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
(ice-9 ftw)
(ice-9 format)
(ice-9 getopt-long)
- (ice-9 match)
(ice-9 popen)
(ice-9 ports)
(ice-9 rdelim)
@@ -31,26 +30,20 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
(system foreign)
(term ansi-color))
-(define (pcmd dry-run str)
- (apply colorize-string
- (if dry-run
- `(,str BOLD)
- `(,str RED BOLD))))
-
-(define (on-all-messages-filenames query proc proc-name dry-run)
+(define (on-all-messages-filenames query proc)
(nm-iter messages (nm-result-messages query)
(lambda (message*)
- (let ((subject (nm-header message* "subject"))
- (files (nm-iter filenames (notmuch_message_get_filenames message*)
- pointer->string)))
- (simple-format #t "~a~a~%"
- (pcmd dry-run (simple-format #f " [~a] " proc-name))
- subject)
- (unless dry-run
- (map proc files))
- (list subject files)))))
+ (simple-format #t " ~a~%" (nm-header message* "subject"))
+ (map proc (nm-iter filenames (notmuch_message_get_filenames message*)
+ pointer->string)))))
(define (delete-email-files! options)
+ (define (logged-delete file-path)
+ (let ((do? (not (option-ref options 'dry-run #f))))
+ (simple-format #t " [~a] ~a~%"
+ (colorize-string "rm" 'BOLD (if do? 'RED 'NONE))
+ file-path)
+ (if do? (delete-file file-path))))
(with-nm-database
(ffi-db (assq-ref options 'mail-repo) 0)
(with-nm-query
@@ -59,14 +52,15 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
(colorize-string "[DELETE] " 'BOLD 'YELLOW)
(number->string (nm-count-messages to-delete))
" files marked\n"))
- (on-all-messages-filenames to-delete delete-file "rm" (option-ref options 'dry-run #f)))))
+ (on-all-messages-filenames to-delete logged-delete))))
(define (move-mail! options account query start-dir end-dir)
(define (move-file uidvalidity target-folder)
(lambda (file)
(let* ((target-file (new-path (rename-higher file uidvalidity) target-folder))
(sub-len (string-prefix-length file target-file)))
- (simple-format #t " ~a -> ~a~%"
+ (simple-format #t " [~a] ~a -> ~a~%"
+ (colorize-string "mv" 'BOLD (if do? 'RED 'NONE))
(substring file sub-len)
(substring target-file sub-len))
(unless (option-ref options 'dry-run #f)
@@ -85,8 +79,7 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
" messages marked in "
(colorize-string account 'GREEN 'BOLD)
"\n"))
- (on-all-messages-filenames to-move (move-file uidvalidity target-folder) "mv"
- (option-ref options 'dry-run #f)))))))
+ (on-all-messages-filenames to-move (move-file uidvalidity target-folder)))))))
(define (apply-tags-to-message options tags)
(lambda (message)
@@ -96,8 +89,9 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
(define (notmuch-tag options ffi-db rules new)
(map (lambda (rule)
- (match-let* (((tags query-str) (with-new rule new))
- (info (if (null? (cddr rule)) query-str (caddr rule))))
+ (let* ((query-str (query-with-new rule new))
+ (tags (tags-with-new rule new))
+ (info (if (null? (cddr rule)) query-str (caddr rule))))
(with-nm-query
(ffi-db query query-str)
(simple-format #t " ~a messages: ~a~a~%"
@@ -110,8 +104,9 @@ LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
(define (list-tag options ffi-db new)
(display (colorize-string "[LISTS filters]\n" 'BOLD 'YELLOW))
- (match-let* (((tags-str query-str) (with-new '("+lists" "not tag:lists") new))
- (reg (make-regexp "<([a-z0-9=_-]+)\\." regexp/icase)))
+ (let ((query-str (query-with-new '("+lists" "not tag:lists") new))
+ (tags-str (tags-with-new '("+lists" "not tag:lists") new))
+ (reg (make-regexp "<([a-z0-9=_-]+)\\." regexp/icase)))
(with-nm-query
(ffi-db query query-str)
(->> (lambda (msg*)
diff --git a/lib/guile/mail-tools.scm b/lib/guile/mail-tools.scm
index d496c5b..b158d93 100644
--- a/lib/guile/mail-tools.scm
+++ b/lib/guile/mail-tools.scm
@@ -9,7 +9,8 @@
get-uidvalidity
get-folder-uidvalidity
new-path
- with-new
+ tags-with-new
+ query-with-new
nm-open-database
nm-query-db
nm-result-messages
@@ -39,14 +40,15 @@
(string-join (list destination submaildir filename)
file-name-separator-string)))
-(define (with-new rule new)
- (list
- (if new (string-append (car rule) " -new") (car rule))
- (if new
- (if (string=? (cadr rule) "*")
- "tag:new"
- (simple-format #f "(~a) and ~a" (cadr rule) "tag:new"))
- (cadr rule))))
+(define (tags-with-new rule new)
+ (if new (string-append (car rule) " -new") (car rule)))
+
+(define (query-with-new rule new)
+ (if new
+ (if (string=? (cadr rule) "*")
+ "tag:new"
+ (simple-format #f "(~a) and ~a" (cadr rule) "tag:new"))
+ (cadr rule)))
;; NOTMUCH interface
(define (nm-open-database path mode)