Mercurial > emacs
comparison lisp/calendar/diary-lib.el @ 111726:b299531e6c80
diary-lib.el diary-outlook* changes.
* lisp/calendar/diary-lib.el (diary-outlook-format-1): New function, so that
diary-outlook-formats can be sensitive to calendar-date-style.
(diary-outlook-formats): Simplify the default setting.
(diary-from-outlook-internal): Pass subject and body as arguments.
Use dolist rather than dotimes. Don't save the diary buffer.
(diary-from-outlook-gnus, diary-from-outlook-rmail):
Pass subject and body as explicit arguments to the -internal function.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Thu, 25 Nov 2010 19:10:16 -0800 |
parents | f2bfd501f578 |
children | 997260859cca |
comparison
equal
deleted
inserted
replaced
111725:f861f9db770a | 111726:b299531e6c80 |
---|---|
303 If the result is more than 50 years in the past, the next century is assumed. | 303 If the result is more than 50 years in the past, the next century is assumed. |
304 If this variable is nil, years must be written in full." | 304 If this variable is nil, years must be written in full." |
305 :type 'boolean | 305 :type 'boolean |
306 :group 'diary) | 306 :group 'diary) |
307 | 307 |
308 (defun diary-outlook-format-1 (body) | |
309 "Return a replace-match template for an element of `diary-outlook-formats'. | |
310 Returns a string using match elements 1-5, where: | |
311 1 = month name, 2 = day, 3 = year, 4 = time, 5 = location; also uses | |
312 %s = message subject. | |
313 The argument BODY is not used." | |
314 (let* ((monthname (match-string 1)) | |
315 (day (match-string 2)) | |
316 (year (match-string 3)) | |
317 ;; Blech. | |
318 (month (catch 'found | |
319 (dotimes (i (length calendar-month-name-array)) | |
320 (if (string-equal (aref calendar-month-name-array i) | |
321 monthname) | |
322 (throw 'found (1+ i)))) | |
323 nil))) | |
324 ;; If we could convert the monthname to a numeric month, we can | |
325 ;; use the standard function calendar-date-string. | |
326 (concat (if month | |
327 (calendar-date-string (list (string-to-number month) | |
328 (string-to-number day) | |
329 (string-to-number year))) | |
330 (cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD | |
331 ((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY | |
332 (t "\\1 \\2 \\3"))) ; MDY | |
333 "\n \\4 %s, \\5"))) | |
334 ;; TODO Sometimes the time is in a different time-zone to the one you | |
335 ;; are in. Eg in PST, you might still get an email referring to: | |
336 ;; "7:00 PM-8:00 PM. Greenwich Standard Time". | |
337 ;; Note that it doesn't use a standard abbreviation for the timezone, | |
338 ;; or anything helpful like that. | |
339 ;; Sigh, this could cause the meeting to even be on a different day | |
340 ;; to that given in the When: string. | |
341 ;; These things seem to come in a multipart mail with a calendar part, | |
342 ;; it's probably better to use that rather than this whole thing. | |
343 ;; So this is unlikely to get improved. | |
344 | |
345 ;; TODO Is the format of these messages actually documented anywhere? | |
308 (defcustom diary-outlook-formats | 346 (defcustom diary-outlook-formats |
309 '( | 347 '(;; When: Tuesday, November 9, 2010 7:00 PM-8:00 PM. Greenwich Standard Time |
310 ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ... | 348 ;; Where: Meeting room B |
311 ;; [Current UK format? The timezone is meaningless. Sometimes the | 349 ("[ \t\n]*When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \ |
312 ;; Where is missing.] | 350 \\([0-9]\\{4\\}\\),? \\(.+\\)\n\ |
313 ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \ | 351 \\(?:Where: \\(.+\n\\)\n*\\)?" . diary-outlook-format-1)) |
314 \\([^ ]+\\) [^\n]+ | |
315 \[^\n]+ | |
316 \\(?:Where: \\([^\n]+\\)\n+\\)? | |
317 \\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*" | |
318 . "\\1\n \\2 %s, \\3") | |
319 ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ... | |
320 ;; [Old UK format?] | |
321 ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \ | |
322 \\([^ ]+\\) [^\n]+ | |
323 \[^\n]+ | |
324 \\(?:Where: \\([^\n]+\\)\\)?\n+" | |
325 . "\\2 \\1 \\3\n \\4 %s, \\5") | |
326 ( | |
327 ;; German format, apparently. | |
328 "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$" | |
329 . "\\1 \\2 \\3\n \\4 %s")) | |
330 "Alist of regexps matching message text and replacement text. | 352 "Alist of regexps matching message text and replacement text. |
331 | 353 |
332 The regexp must match the start of the message text containing an | 354 The regexp must match the start of the message text containing an |
333 appointment, but need not include a leading `^'. If it matches the | 355 appointment, but need not include a leading `^'. If it matches the |
334 current message, a diary entry is made from the corresponding | 356 current message, a diary entry is made from the corresponding |
834 (widen) | 856 (widen) |
835 (remove-overlays (point-min) (point-max) 'invisible 'diary)) | 857 (remove-overlays (point-min) (point-max) 'invisible 'diary)) |
836 (kill-local-variable 'mode-line-format)) | 858 (kill-local-variable 'mode-line-format)) |
837 | 859 |
838 (defvar original-date) ; bound in diary-list-entries | 860 (defvar original-date) ; bound in diary-list-entries |
839 (defvar number) | 861 ;(defvar number) ; already declared above |
840 | 862 |
841 (defun diary-include-other-diary-files () | 863 (defun diary-include-other-diary-files () |
842 "Include the diary entries from other diary files with those of `diary-file'. | 864 "Include the diary entries from other diary files with those of `diary-file'. |
843 This function is suitable for use with `diary-list-entries-hook'; | 865 This function is suitable for use with `diary-list-entries-hook'; |
844 it enables you to use shared diary files together with your own. | 866 it enables you to use shared diary files together with your own. |
2412 ;; Import Outlook-format appointments from mail messages in Gnus or | 2434 ;; Import Outlook-format appointments from mail messages in Gnus or |
2413 ;; Rmail using command `diary-from-outlook'. This, or the specialized | 2435 ;; Rmail using command `diary-from-outlook'. This, or the specialized |
2414 ;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail', | 2436 ;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail', |
2415 ;; could be run from hooks to notice appointments automatically (in | 2437 ;; could be run from hooks to notice appointments automatically (in |
2416 ;; which case they will prompt about adding to the diary). The | 2438 ;; which case they will prompt about adding to the diary). The |
2417 ;; message formats recognized are customizable through | 2439 ;; message formats recognized are customizable through `diary-outlook-formats'. |
2418 ;; `diary-outlook-formats'. | 2440 |
2419 | 2441 (defun diary-from-outlook-internal (subject body &optional test-only) |
2420 (defvar subject) ; bound in diary-from-outlook-gnus | |
2421 (defvar body) | |
2422 | |
2423 (defun diary-from-outlook-internal (&optional test-only) | |
2424 "Snarf a diary entry from a message assumed to be from MS Outlook. | 2442 "Snarf a diary entry from a message assumed to be from MS Outlook. |
2425 Assumes `body' is bound to a string comprising the body of the message and | 2443 SUBJECT and BODY are strings giving the message subject and body. |
2426 `subject' is bound to a string comprising its subject. | |
2427 Arg TEST-ONLY non-nil means return non-nil if and only if the | 2444 Arg TEST-ONLY non-nil means return non-nil if and only if the |
2428 message contains an appointment, don't make a diary entry." | 2445 message contains an appointment, don't make a diary entry." |
2429 (catch 'finished | 2446 (catch 'finished |
2430 (let (format-string) | 2447 (let (format-string) |
2431 (dotimes (i (length diary-outlook-formats)) | 2448 (dolist (fmt diary-outlook-formats) |
2432 (when (eq 0 (string-match (car (nth i diary-outlook-formats)) | 2449 (when (eq 0 (string-match (car fmt) body)) |
2433 body)) | |
2434 (unless test-only | 2450 (unless test-only |
2435 (setq format-string (cdr (nth i diary-outlook-formats))) | 2451 (setq format-string (cdr fmt)) |
2436 (save-excursion | 2452 (save-excursion |
2437 (save-window-excursion | 2453 (save-window-excursion |
2438 (diary-make-entry | 2454 (diary-make-entry |
2439 (format (replace-match (if (functionp format-string) | 2455 (format (replace-match (if (functionp format-string) |
2440 (funcall format-string body) | 2456 (funcall format-string body) |
2441 format-string) | 2457 format-string) |
2442 t nil (match-string 0 body)) | 2458 t nil (match-string 0 body)) |
2443 subject)) | 2459 subject))))) |
2444 (save-buffer)))) | |
2445 (throw 'finished t)))) | 2460 (throw 'finished t)))) |
2446 nil)) | 2461 nil)) |
2447 | 2462 |
2448 (defvar gnus-article-mime-handles) | 2463 (defvar gnus-article-mime-handles) |
2449 (defvar gnus-article-buffer) | 2464 (defvar gnus-article-buffer) |
2467 ;; buttons &c. Assume info is in first part. | 2482 ;; buttons &c. Assume info is in first part. |
2468 (mm-get-part (nth 1 gnus-article-mime-handles)) | 2483 (mm-get-part (nth 1 gnus-article-mime-handles)) |
2469 (save-restriction | 2484 (save-restriction |
2470 (gnus-narrow-to-body) | 2485 (gnus-narrow-to-body) |
2471 (buffer-string))))) | 2486 (buffer-string))))) |
2472 (when (diary-from-outlook-internal t) | 2487 (when (diary-from-outlook-internal subject body t) |
2473 (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) | 2488 (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) |
2474 (diary-from-outlook-internal) | 2489 (diary-from-outlook-internal subject body) |
2475 (message "Diary entry added")))))) | 2490 (message "Diary entry added")))))) |
2476 | 2491 |
2477 (custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus) | 2492 (custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus) |
2478 | 2493 |
2479 (defvar rmail-buffer) | 2494 (defvar rmail-buffer) |
2482 "Maybe snarf diary entry from Outlook-generated message in Rmail. | 2497 "Maybe snarf diary entry from Outlook-generated message in Rmail. |
2483 Unless the optional argument NOCONFIRM is non-nil (which is the case when | 2498 Unless the optional argument NOCONFIRM is non-nil (which is the case when |
2484 this function is called interactively), then if an entry is found the | 2499 this function is called interactively), then if an entry is found the |
2485 user is asked to confirm its addition." | 2500 user is asked to confirm its addition." |
2486 (interactive "p") | 2501 (interactive "p") |
2502 ;; FIXME maybe the body needs rmail-mm decoding, in which case | |
2503 ;; there is no single buffer with both body and subject, sigh. | |
2487 (with-current-buffer rmail-buffer | 2504 (with-current-buffer rmail-buffer |
2488 (let ((subject (mail-fetch-field "subject")) | 2505 (let ((subject (mail-fetch-field "subject")) |
2489 (body (buffer-substring (save-excursion | 2506 (body (buffer-substring (save-excursion |
2490 (rfc822-goto-eoh) | 2507 (rfc822-goto-eoh) |
2491 (point)) | 2508 (point)) |
2492 (point-max)))) | 2509 (point-max)))) |
2493 (when (diary-from-outlook-internal t) | 2510 (when (diary-from-outlook-internal subject body t) |
2494 (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) | 2511 (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) |
2495 (diary-from-outlook-internal) | 2512 (diary-from-outlook-internal subject body) |
2496 (message "Diary entry added")))))) | 2513 (message "Diary entry added")))))) |
2497 | 2514 |
2498 (defun diary-from-outlook (&optional noconfirm) | 2515 (defun diary-from-outlook (&optional noconfirm) |
2499 "Maybe snarf diary entry from current Outlook-generated message. | 2516 "Maybe snarf diary entry from current Outlook-generated message. |
2500 Currently knows about Gnus and Rmail modes. Unless the optional | 2517 Currently knows about Gnus and Rmail modes. Unless the optional |