diff lisp/calendar/diary-lib.el @ 89943:4c90ffeb71c5

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-15 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-218 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-220 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-221 Restore deleted tagline in etc/TUTORIAL.ru * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-222 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-228 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-229 Remove TeX output files from the archive * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-230 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-247 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-248 src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-249 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-256 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-258 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-263 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-264 Update from CVS: lispref/display.texi: emacs -> Emacs. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-265 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-274 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-275 Update from CVS: man/makefile.w32-in: Revert last change * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-276 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-295 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-296 Allow restarting an existing debugger session that's exited * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-297 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-299 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-300 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-327 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-328 Update from CVS: src/.gdbinit (xsymbol): Fix last change. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-329 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-344 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-345 Tweak source regexps so that building in place won't cause problems * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-346 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-351 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-352 Update from CVS: lisp/flymake.el: New file. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-353 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-361 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-362 Support " [...]" style defaults in minibuffer-electric-default-mode * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-363 (read-number): Use canonical format for default in prompt. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-364 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-367 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-368 Improve display-supports-face-attributes-p on non-ttys * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-370 Move `display-supports-face-attributes-p' entirely into C code * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-371 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-372 Simplify face-differs-from-default-p; don't consider :stipple. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-373 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-374 (tty_supports_face_attributes_p): Ensure attributes differ from default * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-375 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-376 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-377 (Fdisplay_supports_face_attributes_p): Work around bootstrapping problem * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-378 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-380 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-381 Face merging cleanups * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-382 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-384 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-385 src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-386 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-395 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-396 Tweak arch tagging to make build/install-in-place less annoying * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-397 Work around vc-arch problems when building eshell * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-398 Tweak permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-399 Tweak directory permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-400 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-401 More build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-402 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-403 Yet more build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-404 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-409 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-410 Make sure image types are initialized for lookup too * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-411 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-416 Update from CVS

--- a/lisp/calendar/diary-lib.el	Sat May 29 02:17:09 2004 +0000
+++ b/lisp/calendar/diary-lib.el	Mon Jun 28 07:56:49 2004 +0000
@@ -123,6 +123,22 @@
 (autoload 'mark-islamic-calendar-date-pattern "cal-islam"
    "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.")
 
+(autoload 'diary-bahai-date "cal-bahai"
+  "Baha'i calendar equivalent of date diary entry."
+  t)
+
+(autoload 'list-bahai-diary-entries "cal-bahai"
+  "Add any Baha'i date entries from the diary file to `diary-entries-list'."
+  t)
+
+(autoload 'mark-bahai-diary-entries "cal-bahai"
+  "Mark days in the calendar window that have Baha'i date diary entries."
+  t)
+
+(autoload 'mark-bahai-calendar-date-pattern "cal-bahai"
+   "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR."
+  t)
+
 (autoload 'diary-hebrew-date "cal-hebrew"
   "Hebrew calendar equivalent of date diary entry.")
 
@@ -1129,6 +1145,8 @@
 		  0 1200)))
 	  (t diary-unknown-time)))) ; Unrecognizable
 
+;; Unrecognizable
+
 (defun list-sexp-diary-entries (date)
   "Add sexp entries for DATE from the diary file to `diary-entries-list'.
 Also, Make them visible in the diary file.  Returns t if any entries were
@@ -1859,6 +1877,155 @@
       "Forms to highlight in diary-mode")
 
 
+;; Following code from Dave Love <[e-mail]>.
+;; Import Outlook-format appointments from mail messages in Gnus or
+;; Rmail using command `diary-from-outlook'.  This, or the specialized
+;; 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'.
+
+(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"))
+  "Alist of regexps matching message text and replacement text.
+
+The regexp must match the start of the message text containing an
+appointment, but need not include a leading `^'.  If it matches the
+current message, a diary entry is made from the corresponding
+template.  If the template is a string, it should be suitable for
+passing to `replace-match', and so will have occurrences of `\\D' to
+substitute the match for the Dth subexpression.  It must also contain
+a single `%s' which will be replaced with the text of the message's
+Subject field.  Any other `%' characters must be doubled, so that the
+template can be passed to `format'.
+
+If the template is actually a function, it is called with the message
+body text as argument, and may use `match-string' etc. to make a
+template following the rules above."
+  :type '(alist :key-type (regexp :tag "Regexp matching time/place")
+		:value-type (choice
+			     (string :tag "Template for entry")
+			     (function :tag "Unary function providing template")))
+  :version "21.4"
+  :group 'diary)
+
+
+;; Dynamically bound.
+(defvar body)
+(defvar subject)
+
+(defun diary-from-outlook-internal (&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.
+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))
+	  (unless test-only
+	    (setq format-string (cdr (nth i diary-outlook-formats)))
+	    (save-excursion
+	      (save-window-excursion
+		;; Fixme: References to optional fields in the format
+		;; are treated literally, not replaced by the empty
+		;; string.  I think this is an Emacs bug.
+		(make-diary-entry
+		 (format (replace-match (if (functionp format-string)
+					    (funcall format-string body)
+					  format-string)
+					t nil (match-string 0 body))
+			 subject))
+		(save-buffer))))
+	  (throw 'finished t))))
+    nil))
+
+(defun diary-from-outlook ()
+  "Maybe snarf diary entry from current Outlook-generated message.
+Currently knows about Gnus and Rmail modes."
+  (interactive)
+  (let ((func (cond
+	       ((eq major-mode 'rmail-mode)
+		#'diary-from-outlook-rmail)
+	       ((memq major-mode '(gnus-summary-mode gnus-article-mode))
+		#'diary-from-outlook-gnus)
+	       (t (error "Don't know how to snarf in `%s'" major-mode)))))
+    (if (interactive-p)
+	(call-interactively func)
+      (funcall func))))
+
+
+(defvar gnus-article-mime-handles)
+(defvar gnus-article-buffer)
+
+(autoload 'gnus-fetch-field "gnus-util")
+(autoload 'gnus-narrow-to-body "gnus")
+(autoload 'mm-get-part "mm-decode")
+
+(defun diary-from-outlook-gnus ()
+  "Maybe snarf diary entry from Outlook-generated message in Gnus.
+Add this to `gnus-article-prepare-hook' to notice appointments
+automatically."
+  (interactive)
+  (with-current-buffer gnus-article-buffer
+    (let ((subject (gnus-fetch-field "subject"))
+	  (body (if gnus-article-mime-handles
+		    ;; We're multipart.  Don't get confused by part
+		    ;; buttons &c.  Assume info is in first part.
+		    (mm-get-part (nth 1 gnus-article-mime-handles))
+		  (save-restriction
+		    (gnus-narrow-to-body)
+		    (buffer-string)))))
+      (when (diary-from-outlook-internal t)
+	(when (or (interactive-p)
+                  (y-or-n-p "Snarf diary entry? "))
+	  (diary-from-outlook-internal)
+	  (message "Diary entry added"))))))
+
+(custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus)
+
+
+(defvar rmail-buffer)
+
+(defun diary-from-outlook-rmail ()
+  "Maybe snarf diary entry from Outlook-generated message in Rmail."
+  (interactive)
+  (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 (or (interactive-p)
+                  (y-or-n-p "Snarf diary entry? "))
+	  (diary-from-outlook-internal)
+	  (message "Diary entry added"))))))
+
+
 (provide 'diary-lib)
 
 ;;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010