calendar interface for gnus-delay.el

[Benjamin Rutt <rutt+news@cis.ohio-state.edu>]

I like to use gnus-delay.el to send myself reminders of stuff I need
to work on in the future.

Unfortunately, I often find myself consulting the output of /bin/cal
in order to figure out the right delay string to pass to the prompt.
(e.g. try to figure out the right delay string for Thursday in a week.
It's not easy to do without a calendar in front of you).  So, I
decided to try and interface gnus-delay to the emacs calendar
facility.  It seems to work o.k.  It depends on the emacs calendar and
makes use of recursive edits (maybe there's a cleaner way?).

Here's how it works.  Instead of entering "3d" or "2002-04-10" or
similar at the C-c C-j prompt, enter "cal".  This will take you to the
emacs calendar, where a help message appears, telling you to select a
day with RET or abort and go back to message mode with 'q'.  You are
by default placed on the current day, so in most cases you probably
need to navigate forward at least a few days in order to reach a time
greater than the current time.  (It will not let you select a delay
time in the past).  Based on the day you select, it will use the
`gnus-delay-default-hour' to send your message out on that day and
hour.  That's all there is to it.

Feedback appreciated.  Here begins the patch:

*** gnus-delay.el.~6.16.~	Sat Jan  5 20:15:45 2002
--- gnus-delay.el	Tue Apr  9 00:07:05 2002
***************
*** 75,87 ****
    variable `gnus-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."
    (interactive
!    (list (read-string
! 	  "Target date (YYYY-MM-DD) or length of delay (units in [mhdwMY]): "
! 	  gnus-delay-default-delay)))
    (let (num unit days year month day hour minute deadline)
!     (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))
--- 75,98 ----
    variable `gnus-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.
! 
! * cal uses the calendar facility to pick a specific date.  The time of
!   day is given by the variable `gnus-delay-default-hour', minute and
!   second are zero.  Type RET on a day in the calendar to choose a
!   particular day, or q to abort."
    (interactive
!    (list
!     (read-string
!      "Target date (YYYY-MM-DD), length of delay (units [mhdwMY]), or cal: "
!      gnus-delay-default-delay)))
    (let (num unit days year month day hour minute deadline)
!     (cond ((string-match "^cal$" delay)
! 	   (gnus-delay-calendar-choose-day)
! 	   (if (null gnus-delay-calendar-time)
! 	       (error "Aborted calendar choice")
! 	     (setq deadline (message-make-date gnus-delay-calendar-time))))
! 	  ((string-match
  	    "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)"
  	    delay)
  	   (setq year  (string-to-number (match-string 1 delay))
***************
*** 89,97 ****
  		 day   (string-to-number (match-string 3 delay)))
  	   (setq deadline
  		 (message-make-date
! 		  (encode-time 0 0      ; second and minute
! 			       gnus-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)))
--- 100,108 ----
  		 day   (string-to-number (match-string 3 delay)))
  	   (setq deadline
  		 (message-make-date
! 		  (encode-time 0 0		; second and minute
! 			gnus-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)))
***************
*** 128,134 ****
  		  (setq delay (* num 60))))
  	   (setq deadline (message-make-date
  			   (seconds-to-time (+ (time-to-seconds (current-time))
! 					       delay)))))
  	  (t (error "Malformed delay `%s'" delay)))
      (message-add-header (format "%s: %s" gnus-delay-header deadline)))
    (set-buffer-modified-p t)
--- 139,145 ----
  		  (setq delay (* num 60))))
  	   (setq deadline (message-make-date
  			   (seconds-to-time (+ (time-to-seconds (current-time))
! 				       delay)))))
  	  (t (error "Malformed delay `%s'" delay)))
      (message-add-header (format "%s: %s" gnus-delay-header deadline)))
    (set-buffer-modified-p t)
***************
*** 139,144 ****
--- 150,199 ----
    (kill-buffer (current-buffer))
    (message-do-actions message-postpone-actions))
  
+ (defvar gnus-delay-calendar-time nil) ; internal variable
+ (defun gnus-delay-calendar-choose-day ()
+   "Choose the delay day interactively using the calendar facility and
+ recursive edits."
+   (require 'calendar)
+   (setq gnus-delay-calendar-time nil)
+   (let ((old-q-key (lookup-key calendar-mode-map (kbd "q")))
+ 	(old-ret-key (lookup-key calendar-mode-map (kbd "RET"))))
+     (define-key calendar-mode-map (kbd "q")
+       (lambda ()
+ 	(interactive)
+ 	(setq gnus-delay-calendar-time nil)
+ 	(bury-buffer calendar-buffer)
+ 	;; restore key maps
+ 	(define-key calendar-mode-map (kbd "q") old-q-key)
+ 	(define-key calendar-mode-map (kbd "RET") old-ret-key)
+ 	(exit-calendar)
+ 	(abort-recursive-edit)))
+     (define-key calendar-mode-map (kbd "RET")
+       (lambda ()
+ 	(interactive)
+ 	(let* ((cursor-date (calendar-cursor-to-date))
+ 	       (year (nth 2 cursor-date))
+ 	       (month (nth 0 cursor-date))
+ 	       (day (nth 1 cursor-date))
+ 	       (delay-time
+ 		(encode-time 0 0	; second and minute
+ 			     gnus-delay-default-hour
+ 			     day month year)))
+ 	  ;; make sure the user didn't choose a time in the past
+ 	  (if (time-less-p delay-time (current-time))
+ 	      (error "Delay target time would be in the past")
+ 	    (setq gnus-delay-calendar-time delay-time)
+ 	    (bury-buffer calendar-buffer)
+ 	    ;; restore key maps
+ 	    (define-key calendar-mode-map (kbd "q") old-q-key)
+ 	    (define-key calendar-mode-map (kbd "RET") old-ret-key)
+ 	    (exit-calendar)
+ 	    (exit-recursive-edit)))))
+     (let ((calendar-setup nil)) ; stick the calendar into the current frame
+       (calendar))
+     (message "RET chooses day, 'q' aborts")
+     (recursive-edit)))
+ 
  ;;;###autoload
  (defun gnus-delay-send-queue ()
    "Send all the delayed messages that are due now."
***************
*** 151,173 ****
  	(gnus-activate-group group)
  	(setq articles (nndraft-articles))
  	(while (setq article (pop articles))
! 	  (gnus-request-head article group)
! 	  (set-buffer nntp-server-buffer)
! 	  (goto-char (point-min))
! 	  (if (re-search-forward
! 	       (concat "^" (regexp-quote gnus-delay-header) ":\\s-+")
! 	       nil t)
! 	      (progn
! 		(setq deadline (nnheader-header-value))
! 		(setq deadline (apply 'encode-time
! 				      (parse-time-string deadline)))
! 		(setq deadline (time-since deadline))
! 		(when (and (>= (nth 0 deadline) 0)
! 			   (>= (nth 1 deadline) 0))
! 		  (message "Sending delayed article %d" article)
! 		  (gnus-draft-send article group)
! 		  (message "Sending delayed article %d...done" article)))
! 	    (message "Delay header missing for article %d" article)))))))
  
  ;;;###autoload
  (defun gnus-delay-initialize (&optional no-keymap no-check)
--- 206,228 ----
  	(gnus-activate-group group)
  	(setq articles (nndraft-articles))
  	(while (setq article (pop articles))
! 	   (gnus-request-head article group)
! 	   (set-buffer nntp-server-buffer)
! 	   (goto-char (point-min))
! 	   (if (re-search-forward
! 		(concat "^" (regexp-quote gnus-delay-header) ":\\s-+")
! 		nil t)
! 	       (progn
! 		 (setq deadline (nnheader-header-value))
! 		 (setq deadline (apply 'encode-time
! 				(parse-time-string deadline)))
! 		 (setq deadline (time-since deadline))
! 		 (when (and (>= (nth 0 deadline) 0)
! 		     (>= (nth 1 deadline) 0))
! 	    (message "Sending delayed article %d" article)
! 	    (gnus-draft-send article group)
! 	    (message "Sending delayed article %d...done" article)))
! 	     (message "Delay header missing for article %d" article)))))))
  
  ;;;###autoload
  (defun gnus-delay-initialize (&optional no-keymap no-check)

-- 
Benjamin