diff options
| -rw-r--r-- | lisp/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/calendar/diary-lib.el | 97 |
2 files changed, 67 insertions, 40 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3e322800b8f..9d5394fed6c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,13 @@ | |||
| 1 | 2010-11-26 Glenn Morris <rgm@gnu.org> | ||
| 2 | |||
| 3 | * calendar/diary-lib.el (diary-outlook-format-1): New function, so that | ||
| 4 | diary-outlook-formats can be sensitive to calendar-date-style. | ||
| 5 | (diary-outlook-formats): Simplify the default setting. | ||
| 6 | (diary-from-outlook-internal): Pass subject and body as arguments. | ||
| 7 | Use dolist rather than dotimes. Don't save the diary buffer. | ||
| 8 | (diary-from-outlook-gnus, diary-from-outlook-rmail): | ||
| 9 | Pass subject and body as explicit arguments to the -internal function. | ||
| 10 | |||
| 1 | 2010-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org> | 11 | 2010-11-26 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 2 | 12 | ||
| 3 | * mail/rfc2368.el (rfc2368-parse-mailto-url): Unfold URLs before | 13 | * mail/rfc2368.el (rfc2368-parse-mailto-url): Unfold URLs before |
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 31fd9897b56..9551174558d 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el | |||
| @@ -305,28 +305,50 @@ 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 |
| @@ -836,7 +858,7 @@ LIST-ONLY is non-nil, in which case it just returns the list." | |||
| 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'. |
| @@ -2414,25 +2436,19 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." | |||
| 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'. | ||
| 2419 | |||
| 2420 | (defvar subject) ; bound in diary-from-outlook-gnus | ||
| 2421 | (defvar body) | ||
| 2422 | 2440 | ||
| 2423 | (defun diary-from-outlook-internal (&optional test-only) | 2441 | (defun diary-from-outlook-internal (subject body &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 |
| @@ -2440,8 +2456,7 @@ message contains an appointment, don't make a diary entry." | |||
| 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 | ||
| @@ -2469,9 +2484,9 @@ automatically." | |||
| 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) |
| @@ -2484,15 +2499,17 @@ 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) |