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

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)