calendar interface for gnus-delay.el

calendar interface for gnus-delay.el

[Benjamin Rutt]

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

Re: calendar interface for gnus-delay.el

[Kai Großjohann]

Benjamin Rutt <rutt+news@cis.ohio-state.edu> writes:

> Feedback appreciated.  Here begins the patch:

I'm a little worried that you are changing the calendar-mode-map.  I
wonder if it is possible to do it another way.

Maybe by entering recursive edit?

Another possibility is to create a _new_ calendar buffer (is this
possible?), and then do (use-local-map (copy-keymap
calendar-mode-map)) in the new buffer and then (local-set-key ...).
Then "q" would kill the new buffer.

Thoughts?

kai
-- 
Silence is foo!

Re: calendar interface for gnus-delay.el

[Benjamin Rutt]

Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Großjohann) writes:

> I'm a little worried that you are changing the calendar-mode-map.  I
> wonder if it is possible to do it another way.

Good point.  I restore the old keybindings when 'RET' or 'q' are
pressed, but in the meantime, I have changed calendar-mode-map, which
is probably bad.

> Another possibility is to create a _new_ calendar buffer (is this
> possible?), and then do (use-local-map (copy-keymap
> calendar-mode-map)) in the new buffer and then (local-set-key ...).
> Then "q" would kill the new buffer.

Maybe I should try using define-derived-mode.  I could invent a new
mode called gnus-delay-calendar-mode.  The buffer could start out in
calendar mode, but then switch to gnus-delay-calendar-mode and only
change the keybindings in that mode.

I'll try something like that instead, so I don't change
calendar-mode-map, even temporarily.
-- 
Benjamin

Re: calendar interface for gnus-delay.el

[Kai Großjohann]

Benjamin Rutt <rutt+news@cis.ohio-state.edu> writes:

> Maybe I should try using define-derived-mode.  I could invent a new
> mode called gnus-delay-calendar-mode.  The buffer could start out in
> calendar mode, but then switch to gnus-delay-calendar-mode and only
> change the keybindings in that mode.

This sounds like a good plan.

kai
-- 
Silence is foo!