[Emacs-diffs] Changes to emacs/lisp/calendar/diary-lib.el [emacs-unicode-2]

[Miles Bader]

Index: emacs/lisp/calendar/diary-lib.el
diff -c emacs/lisp/calendar/diary-lib.el:1.69.2.1 
emacs/lisp/calendar/diary-lib.el:1.69.2.2
*** emacs/lisp/calendar/diary-lib.el:1.69.2.1   Fri Apr 16 12:50:12 2004
--- emacs/lisp/calendar/diary-lib.el    Mon Jun 28 07:29:41 2004
***************
*** 123,128 ****
--- 123,144 ----
  (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,1134 ****
--- 1145,1152 ----
                  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,1864 ****
--- 1877,2031 ----
        "Forms to highlight in diary-mode")
  
  
+ ;; Following code from Dave Love <address@hidden>.
+ ;; 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