# HG changeset patch # User Glenn Morris # Date 1290741016 28800 # Node ID b299531e6c809af141f70f8eb8d567752a98d089 # Parent f861f9db770afbc2929963c21a009992c0922b59 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. diff -r f861f9db770a -r b299531e6c80 lisp/ChangeLog --- a/lisp/ChangeLog Fri Nov 26 02:37:23 2010 +0000 +++ b/lisp/ChangeLog Thu Nov 25 19:10:16 2010 -0800 @@ -1,3 +1,13 @@ +2010-11-26 Glenn Morris + + * 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. + 2010-11-26 Lars Magne Ingebrigtsen * mail/rfc2368.el (rfc2368-parse-mailto-url): Unfold URLs before diff -r f861f9db770a -r b299531e6c80 lisp/calendar/diary-lib.el --- a/lisp/calendar/diary-lib.el Fri Nov 26 02:37:23 2010 +0000 +++ b/lisp/calendar/diary-lib.el Thu Nov 25 19:10:16 2010 -0800 @@ -305,28 +305,50 @@ :type 'boolean :group 'diary) +(defun diary-outlook-format-1 (body) + "Return a replace-match template for an element of `diary-outlook-formats'. +Returns a string using match elements 1-5, where: +1 = month name, 2 = day, 3 = year, 4 = time, 5 = location; also uses +%s = message subject. +The argument BODY is not used." + (let* ((monthname (match-string 1)) + (day (match-string 2)) + (year (match-string 3)) + ;; Blech. + (month (catch 'found + (dotimes (i (length calendar-month-name-array)) + (if (string-equal (aref calendar-month-name-array i) + monthname) + (throw 'found (1+ i)))) + nil))) + ;; If we could convert the monthname to a numeric month, we can + ;; use the standard function calendar-date-string. + (concat (if month + (calendar-date-string (list (string-to-number month) + (string-to-number day) + (string-to-number year))) + (cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD + ((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY + (t "\\1 \\2 \\3"))) ; MDY + "\n \\4 %s, \\5"))) +;; TODO Sometimes the time is in a different time-zone to the one you +;; are in. Eg in PST, you might still get an email referring to: +;; "7:00 PM-8:00 PM. Greenwich Standard Time". +;; Note that it doesn't use a standard abbreviation for the timezone, +;; or anything helpful like that. +;; Sigh, this could cause the meeting to even be on a different day +;; to that given in the When: string. +;; These things seem to come in a multipart mail with a calendar part, +;; it's probably better to use that rather than this whole thing. +;; So this is unlikely to get improved. + +;; TODO Is the format of these messages actually documented anywhere? (defcustom diary-outlook-formats - '( - ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ... - ;; [Current UK format? The timezone is meaningless. Sometimes the - ;; Where is missing.] - ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \ -\\([^ ]+\\) [^\n]+ -\[^\n]+ -\\(?:Where: \\([^\n]+\\)\n+\\)? -\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*" - . "\\1\n \\2 %s, \\3") - ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ... - ;; [Old UK format?] - ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \ -\\([^ ]+\\) [^\n]+ -\[^\n]+ -\\(?:Where: \\([^\n]+\\)\\)?\n+" - . "\\2 \\1 \\3\n \\4 %s, \\5") - ( - ;; German format, apparently. - "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$" - . "\\1 \\2 \\3\n \\4 %s")) + '(;; When: Tuesday, November 9, 2010 7:00 PM-8:00 PM. Greenwich Standard Time + ;; Where: Meeting room B + ("[ \t\n]*When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \ +\\([0-9]\\{4\\}\\),? \\(.+\\)\n\ +\\(?:Where: \\(.+\n\\)\n*\\)?" . diary-outlook-format-1)) "Alist of regexps matching message text and replacement text. The regexp must match the start of the message text containing an @@ -836,7 +858,7 @@ (kill-local-variable 'mode-line-format)) (defvar original-date) ; bound in diary-list-entries -(defvar number) +;(defvar number) ; already declared above (defun diary-include-other-diary-files () "Include the diary entries from other diary files with those of `diary-file'. @@ -2414,25 +2436,19 @@ ;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail', ;; could be run from hooks to notice appointments automatically (in ;; which case they will prompt about adding to the diary). The -;; message formats recognized are customizable through -;; `diary-outlook-formats'. +;; message formats recognized are customizable through `diary-outlook-formats'. -(defvar subject) ; bound in diary-from-outlook-gnus -(defvar body) - -(defun diary-from-outlook-internal (&optional test-only) +(defun diary-from-outlook-internal (subject body &optional test-only) "Snarf a diary entry from a message assumed to be from MS Outlook. -Assumes `body' is bound to a string comprising the body of the message and -`subject' is bound to a string comprising its subject. +SUBJECT and BODY are strings giving the message subject and body. Arg TEST-ONLY non-nil means return non-nil if and only if the message contains an appointment, don't make a diary entry." (catch 'finished (let (format-string) - (dotimes (i (length diary-outlook-formats)) - (when (eq 0 (string-match (car (nth i diary-outlook-formats)) - body)) + (dolist (fmt diary-outlook-formats) + (when (eq 0 (string-match (car fmt) body)) (unless test-only - (setq format-string (cdr (nth i diary-outlook-formats))) + (setq format-string (cdr fmt)) (save-excursion (save-window-excursion (diary-make-entry @@ -2440,8 +2456,7 @@ (funcall format-string body) format-string) t nil (match-string 0 body)) - subject)) - (save-buffer)))) + subject))))) (throw 'finished t)))) nil)) @@ -2469,9 +2484,9 @@ (save-restriction (gnus-narrow-to-body) (buffer-string))))) - (when (diary-from-outlook-internal t) + (when (diary-from-outlook-internal subject body t) (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) - (diary-from-outlook-internal) + (diary-from-outlook-internal subject body) (message "Diary entry added")))))) (custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus) @@ -2484,15 +2499,17 @@ this function is called interactively), then if an entry is found the user is asked to confirm its addition." (interactive "p") + ;; FIXME maybe the body needs rmail-mm decoding, in which case + ;; there is no single buffer with both body and subject, sigh. (with-current-buffer rmail-buffer (let ((subject (mail-fetch-field "subject")) (body (buffer-substring (save-excursion (rfc822-goto-eoh) (point)) (point-max)))) - (when (diary-from-outlook-internal t) + (when (diary-from-outlook-internal subject body t) (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) - (diary-from-outlook-internal) + (diary-from-outlook-internal subject body) (message "Diary entry added")))))) (defun diary-from-outlook (&optional noconfirm)