[Emacs-diffs] /srv/bzr/emacs/trunk r102526: diary-lib.el diary-outlook* changes.

[Glenn Morris]

------------------------------------------------------------
revno: 102526
committer: Glenn Morris <address@hidden>
branch nick: trunk
timestamp: Thu 2010-11-25 19:10:16 -0800
message:
  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.
modified:
  lisp/ChangeLog
  lisp/calendar/diary-lib.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-11-26 02:28:03 +0000
+++ b/lisp/ChangeLog    2010-11-26 03:10:16 +0000
@@ -1,3 +1,13 @@
+2010-11-26  Glenn Morris  <address@hidden>
+
+       * 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  <address@hidden>
 
        * mail/rfc2368.el (rfc2368-parse-mailto-url): Unfold URLs before

=== modified file 'lisp/calendar/diary-lib.el'
--- a/lisp/calendar/diary-lib.el        2010-11-20 22:29:35 +0000
+++ b/lisp/calendar/diary-lib.el        2010-11-26 03:10:16 +0000
@@ -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'.
-
-(defvar subject)                        ; bound in diary-from-outlook-gnus
-(defvar body)
-
-(defun diary-from-outlook-internal (&optional test-only)
+;; message formats recognized are customizable through `diary-outlook-formats'.
+
+(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)