notmuch-delay.el -- Port of gnus-delay for notmuch

notmuch-delay.el

;;; 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

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

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)