Skip to content

Instantly share code, notes, and snippets.

@telenieko
Last active April 30, 2024 20:03
Show Gist options
  • Save telenieko/c4109faa92f472a78fd800e61e8983e6 to your computer and use it in GitHub Desktop.
Save telenieko/c4109faa92f472a78fd800e61e8983e6 to your computer and use it in GitHub Desktop.
notmuch-delay.el -- Port of gnus-delay for notmuch
;;; notmuch-delay.el --- delay sending of mails in notmuch
;; Copyright (C) 2024 Marc Fargas <marc@marcfargas.com>
;; Author: Marc Fargas <marc@marcfargas.com>
;; Maintainer: Marc Fargas <marc@marcfargas.com>
;; Version: 20240311.0
;; URL: ???
;; This file is not part of GNU Emacs.
;;; Commentary:
;; Provide delayed sending of e-mails.
;; Heavily inspired by gnus-delay, mu4e-delay and mu4e-send-delay, but
;; made to work with notmuch. Thanks to Ben Maughen, Kai Großjohan and
;; Benjamin Andresen.
;;; Code:
(require 'notmuch)
(require 'notmuch-draft)
(autoload 'parse-time-string "parse-time" nil nil)
(defgroup notmuch-delay nil
"Arrange for sending e-emails later."
:group 'notmuch)
(defcustom notmuch-delay-tag "delayed"
"Tag applied to delayed messages."
:type 'string)
(defcustom notmuch-delay-header "X-Notmuch-Delayed"
"Header name for storing info about delayed messages."
:type 'string)
(defcustom notmuch-delay-default-delay "06:15"
"Default length of delay."
:type 'string)
(defcustom notmuch-delay-default-hour 6
"If deadline is given as date, then assume this time of day."
:type 'integer)
(defcustom notmuch-delay-disabled-message-send-hooks '(org-mime-confirm-when-no-multipart)
"`message-send-hook's that will be avoided during the delayed send.
But they would be run when postponing the message."
:type 'list)
(defvar notmuch-delay-timer-scheduled nil
"The current timer for the scheduled run.")
(defvar notmuch-delay-timer-idle nil
"The current timer for the idle run.")
(defun notmuch-delay-parse-delay (delay)
"Parse a delay string into a date. Possible values are:
* <digits><units> for <units> in minutes (`m'), hours (`h'), days (`d'),
weeks (`w'), months (`M'), or years (`Y');
* YYYY-MM-DD for a specific date. The time of day is given by the
variable `notmuch-delay-default-hour', minute and second are zero.
* hh:mm for a specific time. Use 24h format. If it is later than this
time, then the deadline is tomorrow, else today."
(let (num unit year month day hour minute deadline) ;; days
(cond ((string-match
"\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)"
delay)
(setq year (string-to-number (match-string 1 delay))
month (string-to-number (match-string 2 delay))
day (string-to-number (match-string 3 delay)))
(setq deadline
(message-make-date
(encode-time 0 0 ; second and minute
notmuch-delay-default-hour
day month year))))
((string-match "\\([0-9]+\\):\\([0-9]+\\)" delay)
(setq hour (string-to-number (match-string 1 delay))
minute (string-to-number (match-string 2 delay)))
;; Use current time, except...
(setq deadline (decode-time nil nil t))
;; ... for minute and hour.
(setq deadline (apply #'encode-time (car deadline) minute hour
(nthcdr 3 deadline)))
;; If this time has passed already, add a day.
(when (time-less-p deadline nil)
(setq deadline (time-add 86400 deadline))) ; 86400 secs/day
;; Convert seconds to date header.
(setq deadline (message-make-date deadline)))
((string-match "\\([0-9]+\\)\\s-*\\([mhdwMY]\\)" delay)
(setq num (match-string 1 delay))
(setq unit (match-string 2 delay))
;; Start from seconds, then multiply into needed units.
(setq num (string-to-number num))
(cond ((string= unit "Y")
(setq delay (* num 60 60 24 365)))
((string= unit "M")
(setq delay (* num 60 60 24 30)))
((string= unit "w")
(setq delay (* num 60 60 24 7)))
((string= unit "d")
(setq delay (* num 60 60 24)))
((string= unit "h")
(setq delay (* num 60 60)))
(t
(setq delay (* num 60))))
(setq deadline (message-make-date (time-add nil delay))))
(t (error "Malformed delay `%s'" delay)))))
;;;###autoload
(defun notmuch-delay-message (delay)
"Delay this article by some time.
DELAY is a string, giving the length of the time.
The value of `message-draft-headers' determines which headers are
generated when the article is delayed. Remaining headers are
generated when the article is sent."
(interactive (list (read-string
"Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): "
notmuch-delay-default-delay))
message-mode)
;; Allow spell checking etc.
(run-hooks 'message-send-hook)
(let ((deadline (notmuch-delay-parse-delay delay)))
(message (format "delay %s" deadline))
(message-add-header (format "%s: %s" notmuch-delay-header deadline)))
(set-buffer-modified-p t)
(let ((notmuch-draft-tags (cons (format "+%s" notmuch-delay-tag) notmuch-draft-tags)))
(notmuch-draft-save))
(kill-buffer)
(message-do-actions message-postpone-actions))
(defun notmuch-delay-get-delayed ()
"Get the Message-IDs of currently delayed messages.
If DEADLINE is provided, return only those on which `notmuch-delay-header' is overdue."
(let* ((query (format "is:%s" notmuch-delay-tag))
(delayed (notmuch-call-notmuch-sexp
"search" "--format=sexp" "--format-version=5" "--output=messages"
query)))
(cl-mapcar (lambda (el) (format "id:%s" el)) delayed)))
;;;###autoload
(defun notmuch-delay-send-queue ()
"Send all the delayed messages that are due now."
(interactive)
(let* ((delayed (notmuch-delay-get-delayed))
(message-send-hook (seq-difference message-send-hook
notmuch-delay-disabled-message-send-hooks))
(message-confirm-send nil))
(add-hook 'message-send-hook
(lambda () (message-remove-header notmuch-delay-header)) t)
(save-window-excursion
(killing-new-buffers
(while-let ((message (pop delayed)))
(notmuch-draft-resume message)
(goto-char (point-min))
(if (re-search-forward
(concat "^" (regexp-quote notmuch-delay-header) ":\\s-+")
nil t)
(progn
(setq deadline-str (buffer-substring (point) (line-end-position)))
(setq deadline (encode-time (parse-time-string deadline-str)))
(if (time-less-p deadline nil)
(progn
(message "Sending delayed message %s" message)
(notmuch-mua-send-and-exit)
(message "Sending delayed message %s...done" message))
(message "Not yet ready to send %s until %s" message deadline-str)
(kill-buffer)))
(message "Delay header missing for message %s" message)))))
))
(defun notmuch-delay-scheduled-runner ()
(unless (memq notmuch-delay-timer-idle timer-idle-list)
(setq notmuch-delay-timer-idle
(run-with-idle-timer 30 nil #'notmuch-delay-send-queue))))
;;;###autoload
(defun notmuch-delay-initialize ()
(unless (memq notmuch-delay-timer-scheduled timer-list)
(setq notmuch-delay-timer-scheduled
(run-at-time t 300 #'notmuch-delay-scheduled-runner))))
(provide 'notmuch-delay)
;; Local Variables:
;; coding: utf-8
;; End:
;;; notmuch-delay.el ends here
@telenieko
Copy link
Author

BEWARE of this bug you might need to apply this patch to notmuch. Or widen the buffer before scheduling (same applies to postponing).

@telenieko
Copy link
Author

You will also need to add a keymap, and initialize the timers:

  (require 'notmuch-delay)
  (notmuch-delay-initialize)

  (define-key notmuch-message-mode-map
              (kbd "C-c C-j") #'notmuch-delay-message)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment