lisp/gnus/gnus-diary.el

0 ;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end
36 ;; gnus-diary is a utility toolkit used on top of the nndiary back end. It is
48 (require 'gnus-art)
50 (defgroup gnus-diary nil
53   :group 'gnus)
55 (defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n"
58   :group 'gnus-diary
59   :group 'gnus-summary-format)
61 (defcustom gnus-diary-time-format "%a, %b %e %y, %H:%M"
65   :group 'gnus-diary)
67 (defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english
68   "*Function called to format a diary delay string.
69 It is passed two arguments.  The first one is non-nil if the delay is in
76 `gnus-diary-delay-format-english' (the default)
77 `gnus-diary-delay-format-french'"
78   :type '(choice (const  :tag "english" gnus-diary-delay-format-english)
79 		 (const  :tag "french"  gnus-diary-delay-format-french)
81   :group 'gnus-diary)
83 (defconst gnus-diary-version nndiary-version
91       (defalias 'gnus-diary-kill-entire-line 'kill-entire-line)
92     (defun gnus-diary-kill-entire-line ()
100 (defun gnus-diary-delay-format-french (past delay)
101   (if (null delay)
104     (and (> (length delay) 1) (setcdr (cdr delay) nil))
108 	      (while (setq del (pop delay))
126 				  (if delay ", "))))
130 (defun gnus-diary-delay-format-english (past delay)
131   (if (null delay)
134     (and (> (length delay) 1) (setcdr (cdr delay) nil))
138 	      (while (setq del (pop delay))
143 				  (if delay ", "))))
148 (defun gnus-diary-header-schedule (headers)
162 (defun gnus-user-format-function-d (header)
163   ;; Returns an aproximative delay string for the next occurence of this
164   ;; message. The delay is given only in the first non zero unit.
167 	 (sched (gnus-diary-header-schedule extras))
175 	     delay)
190 		(setq delay (append delay `((,(floor num) . ,(car unit))))))
192 	(funcall gnus-diary-delay-format-function past delay)))
199 (defun gnus-user-format-function-D (header)
202 	 (sched (gnus-diary-header-schedule extras))
204     (format-time-string gnus-diary-time-format occur)))
209 (defun gnus-article-sort-by-schedule (h1 h2)
213 	 (s1 (gnus-diary-header-schedule e1))
214 	 (s2 (gnus-diary-header-schedule e2))
222 (defun gnus-thread-sort-by-schedule (h1 h2)
223   (gnus-article-sort-by-schedule (gnus-thread-header h1)
224 				 (gnus-thread-header h2)))
226 (defun gnus-summary-sort-by-schedule (&optional reverse)
230   (gnus-summary-sort 'schedule reverse))
232 (defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
233 (add-hook 'gnus-summary-menu-hook
235 	    (easy-menu-add-item gnus-summary-misc-menu
238 				 gnus-summary-sort-by-schedule
239 				 (eq (car (gnus-find-method-for-group
240 					   gnus-newsgroup-name))
248 (defun gnus-diary-update-group-parameters (group)
249   ;; Ensure that nndiary groups have convenient group parameters:
254   (let ((posting-style (gnus-group-get-parameter group 'posting-style t)))
263     (gnus-group-set-parameter group 'posting-style posting-style)
265     (unless (gnus-group-get-parameter group 'gnus-summary-line-format t)
266       (gnus-group-set-parameter group 'gnus-summary-line-format
267 				`(,gnus-diary-summary-line-format)))
269     (unless (gnus-group-get-parameter group 'gnus-article-sort-functions)
270       (gnus-group-set-parameter group 'gnus-article-sort-functions
271 				'((append gnus-article-sort-functions
273 					   'gnus-article-sort-by-schedule)))))
274     (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions)
275       (gnus-group-set-parameter group 'gnus-thread-sort-functions
276 				'((append gnus-thread-sort-functions
278 					   'gnus-thread-sort-by-schedule)))))
281 ;; Called when a group is subscribed. This is needed because groups created
283 ;; Thus, `nndiary-request-create-group-hooks' is inoperative.
284 (defun gnus-diary-maybe-update-group-parameters (group)
285   (when (eq (car (gnus-find-method-for-group group)) 'nndiary)
286     (gnus-diary-update-group-parameters group)))
288 (add-hook 'nndiary-request-create-group-hooks
289 	  'gnus-diary-update-group-parameters)
290 ;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed
293 	  'gnus-diary-update-group-parameters)
294 (add-hook 'gnus-subscribe-newsgroup-hooks
295 	  'gnus-diary-maybe-update-group-parameters)
300 (defvar gnus-diary-header-value-history nil
304 (defun gnus-diary-narrow-to-headers ()
317 (defun gnus-diary-add-header (str)
324 	   (gnus-diary-narrow-to-headers)
331 (defun gnus-diary-check-message (arg)
346 	   (gnus-diary-narrow-to-headers)
350 	     (setq value (buffer-substring (point) (gnus-point-at-eol)))
358 	     ;; #### NOTE: this (along with the `gnus-diary-add-header'
363 	       (gnus-diary-kill-entire-line))
375 					gnus-diary-header-value-history)
377 				  gnus-diary-header-value-history))))
385 	 (gnus-diary-add-header (concat header ": " value))
391 	  (lambda () (gnus-diary-check-message nil)))
393 (define-key message-mode-map "\C-cDc" 'gnus-diary-check-message)
394 (define-key gnus-article-edit-mode-map "\C-cDc" 'gnus-diary-check-message)
399 (defun gnus-diary-version ()
404 (define-key message-mode-map "\C-cDv" 'gnus-diary-version)
405 (define-key gnus-article-edit-mode-map "\C-cDv" 'gnus-diary-version)
408 (provide 'gnus-diary)
411 ;;; gnus-diary.el ends here