comparison lisp/calendar/diary-lib.el @ 92664:e7052a7b4ab1

(diary-list-entries, include-other-diary-files, mark-diary-entries) (mark-sexp-diary-entries, mark-included-diary-files) (diary-entry-time, list-sexp-diary-entries): Remove the special handling of ^M that dates back to the use of selective-display. (simple-diary-display): Obey setting of pop-up-frames. (body, entry): Remove unnecessary declarations.

92663:b3b2c224528e

as part of the list-diary-entries-hook, you will probably also want to use the
function `mark-included-diary-files' as part of `mark-diary-entries-hook'.

For example, you could use

     (setq list-diary-entries-hook
       '(include-other-diary-files sort-diary-entries))
     (setq diary-display-hook 'fancy-diary-display)

in your `.emacs' file to cause the fancy diary buffer to be displayed with
diary entries from various included files, each day's entries sorted into
lexicographic order."
  :type 'hook

syntax of `*' and `:' changed to be word constituents.")

(defvar diary-entries-list)
(defvar displayed-year)
(defvar displayed-month)
(defvar entry)
(defvar date)
(defvar number)
(defvar date-string)
(defvar original-date)

                             (if abbreviated-calendar-year
                                 (concat "\\|" (format "%02d" (% year 100)))
                               "")))
                           (regexp
                            (concat
                             "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
                             (mapconcat 'eval date-form "\\)\\(?:")
                             "\\)"))
                           (case-fold-search t))
                        (goto-char (point-min))
                        (while (re-search-forward regexp nil t)
                          (if backup (re-search-backward "\\<" nil t))
                          (if (and (or (char-equal (preceding-char) ?\^M)
                                       (char-equal (preceding-char) ?\n))
                                   (not (looking-at " \\|\^I")))
                              ;;  Diary entry that consists only of date.
                              (backward-char 1)
                            ;; Found a nonempty diary entry--make it
                            ;; visible and add it to the list.
                            (setq entry-found t)
                            (let ((entry-start (point))
                                  date-start temp)
                              (re-search-backward "\^M\\|\n\\|\\`")
                              (setq date-start (point))
                              ;; When selective display (rather than
                              ;; overlays) was used, diary file used to
                              ;; start in a blank line and end in a
                              ;; newline. Now that neither of these
                              ;; need be true, 'move handles the latter
                              ;; and 1/2 kludge the former.
                              (re-search-forward
                               "\^M\\|\n" nil 'move
                               (if (and (bobp) (not (looking-at "\^M\\|\n")))
                                   1
                                 2))
                              (while (looking-at " \\|\^I")
                                (re-search-forward "\^M\\|\n" nil 'move))
                              (unless (and (eobp) (not (bolp)))
                                (backward-char 1))
                              (unless list-only
                                (remove-overlays date-start (point)
                                                 'invisible 'diary))

are obeyed.  You can change the `#include' to some other string by
changing the variable `diary-include-string'."
  (goto-char (point-min))
  (while (re-search-forward
          (concat
           "\\(?:\\`\\|\^M\\|\n\\)"
           (regexp-quote diary-include-string)
           " \"\\([^\"]*\\)\"")
          nil t)
    (let* ((diary-file (substitute-in-file-name
                        (match-string-no-properties 1)))

                             (if holiday-list ": " "")
                             (mapconcat 'identity holiday-list "; ")))
         (msg (format "No diary entries for %s" hol-string))
         ;; If selected window is dedicated (to the calendar),
         ;; need a new one to display the diary.
         (pop-up-frames (window-dedicated-p (selected-window))))
    (calendar-set-mode-line (format "Diary for %s" hol-string))
    (if (or (not diary-entries-list)
            (and (not (cdr diary-entries-list))
                 (string-equal (car (cdr (car diary-entries-list))) "")))
        (if (< (length msg) (frame-width))

                   (month "[0-9]+\\|\\*")
                   (day "[0-9]+\\|\\*")
                   (year "[0-9]+\\|\\*")
                   (l (length date-form))
                   (d-name-pos (- l (length (memq 'dayname date-form))))
                   (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
                   (m-name-pos (- l (length (memq 'monthname date-form))))
                   (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
                   (d-pos (- l (length (memq 'day date-form))))
                   (d-pos (if (/= l d-pos) (+ 2 d-pos)))
                   (m-pos (- l (length (memq 'month date-form))))
                   (m-pos (if (/= l m-pos) (+ 2 m-pos)))
                   (y-pos (- l (length (memq 'year date-form))))
                   (y-pos (if (/= l y-pos) (+ 2 y-pos)))
                   (regexp
                    (concat
                     "\\(\\`\\|\^M\\|\n\\)\\("
                     (mapconcat 'eval date-form "\\)\\(")
                     "\\)"))
                   (case-fold-search t))
              (goto-char (point-min))
              (while (re-search-forward regexp nil t)

(defun mark-sexp-diary-entries ()
  "Mark days in the calendar window that have sexp diary entries.
Each entry in the diary file (or included files) visible in the calendar window
is marked.  See the documentation for the function `list-sexp-diary-entries'."
  (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol))
         (s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\("
                          sexp-mark "(\\)\\|\\("
                          (regexp-quote diary-nonmarking-symbol)
                          sexp-mark "(diary-remind\\)"))
         (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
         m y first-date last-date mark file-glob-attrs)

    (goto-char (point-min))
    (while (re-search-forward s-entry nil t)
      (setq marking-diary-entry (char-equal (preceding-char) ?\())
      (re-search-backward "(")
      (let ((sexp-start (point))
            sexp entry entry-start line-start marks)
        (forward-sexp)
        (setq sexp (buffer-substring-no-properties sexp-start (point)))
        (save-excursion
          (re-search-backward "\^M\\|\n\\|\\`")
          (setq line-start (point)))
        (forward-char 1)
        (if (and (or (char-equal (preceding-char) ?\^M)
                     (char-equal (preceding-char) ?\n))
                 (not (looking-at " \\|\^I")))
            (progn;; Diary entry consists only of the sexp
              (backward-char 1)
              (setq entry ""))
          (setq entry-start (point))
          ;; Find end of entry
          (re-search-forward "\^M\\|\n" nil t)
          (while (looking-at " \\|\^I")
 	    (or (re-search-forward "\^M\\|\n" nil t)
 		(re-search-forward "$" nil t)))
          (if (or (char-equal (preceding-char) ?\^M)
 		  (char-equal (preceding-char) ?\n))
 	      (backward-char 1))
          (setq entry (buffer-substring-no-properties entry-start (point)))
          (while (string-match "[\^M]" entry)
            (aset entry (match-beginning 0) ?\n )))
        (calendar-for-loop date from first-date to last-date do
          (if (setq mark (diary-sexp-entry sexp entry
                                (calendar-gregorian-from-absolute date)))
	      (progn
		(setq marks (diary-pull-attrs entry file-glob-attrs)

are obeyed.  You can change the `#include' to some other string by
changing the variable `diary-include-string'."
  (goto-char (point-min))
  (while (re-search-forward
          (concat
           "\\(?:\\`\\|\^M\\|\n\\)"
           (regexp-quote diary-include-string)
           " \"\\([^\"]*\\)\"")
          nil t)
    (let* ((diary-file (substitute-in-file-name
                        (match-string-no-properties 1)))

The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam,
XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM.  A period (.) can
be used instead of a colon (:) to separate the hour and minute parts."
  (let ((case-fold-search nil))
    (cond ((string-match        ; Military time
	    "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
            s)
	   (+ (* 100 (string-to-number (match-string 1 s)))
	      (string-to-number (match-string 2 s))))
	  ((string-match        ; Hour only  XXam or XXpm
	    "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
	   (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
	      (if (equal ?a (downcase (aref s (match-beginning 2))))
		  0 1200)))
	  ((string-match        ; Hour and minute  XX:XXam or XX:XXpm
	    "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
	   (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
	      (string-to-number (match-string 2 s))
	      (if (equal ?a (downcase (aref s (match-beginning 3))))
		  0 1200)))
	  (t diary-unknown-time)))) ; Unrecognizable

                  from Passover to Shavuot.  Note that since there is no text,
                  it makes sense only if the fancy diary display is used.

Marking these entries is *extremely* time consuming, so these entries are
best if they are nonmarking."
  (let ((s-entry (concat "\\(\\`\\|\^M\\|\n\\)"
                         (regexp-quote diary-nonmarking-symbol)
                         "?"
                         (regexp-quote sexp-diary-entry-symbol)
                         "("))
        entry-found file-glob-attrs marks)

      (backward-char 1)
      (let ((sexp-start (point))
            sexp entry specifier entry-start line-start)
        (forward-sexp)
        (setq sexp (buffer-substring-no-properties sexp-start (point)))
        (save-excursion
          (re-search-backward "\^M\\|\n\\|\\`")
          (setq line-start (point)))
        (setq specifier
              (buffer-substring-no-properties (1+ line-start) (point))
              entry-start (1+ line-start))
        (forward-char 1)
        (if (and (or (char-equal (preceding-char) ?\^M)
                     (char-equal (preceding-char) ?\n))
                 (not (looking-at " \\|\^I")))
            (progn;; Diary entry consists only of the sexp
              (backward-char 1)
              (setq entry ""))
          (setq entry-start (point))
          (re-search-forward "\^M\\|\n" nil t)
          (while (looking-at " \\|\^I")
            (re-search-forward "\^M\\|\n" nil t))
          (backward-char 1)
          (setq entry (buffer-substring-no-properties entry-start (point)))
          (while (string-match "[\^M]" entry)
            (aset entry (match-beginning 0) ?\n )))
        (let ((diary-entry (diary-sexp-entry sexp entry date))
              temp literal)
          (setq literal entry           ; before evaluation
                entry (if (consp diary-entry)
                          (cdr diary-entry)

;; which case they will prompt about adding to the diary).  The
;; message formats recognized are customizable through
;; `diary-outlook-formats'.

;; 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

92664:e7052a7b4ab1

as part of the list-diary-entries-hook, you will probably also want to use the
function `mark-included-diary-files' as part of `mark-diary-entries-hook'.

For example, you could use

     (add-hook 'list-diary-entries-hook 'include-other-diary-files)
     (add-hook 'list-diary-entries-hook 'sort-diary-entries)
     (add-hook 'diary-display-hook 'fancy-diary-display)

in your `.emacs' file to cause the fancy diary buffer to be displayed with
diary entries from various included files, each day's entries sorted into
lexicographic order."
  :type 'hook

syntax of `*' and `:' changed to be word constituents.")

(defvar diary-entries-list)
(defvar displayed-year)
(defvar displayed-month)
(defvar date)
(defvar number)
(defvar date-string)
(defvar original-date)

                             (if abbreviated-calendar-year
                                 (concat "\\|" (format "%02d" (% year 100)))
                               "")))
                           (regexp
                            (concat
                             "^" mark "?\\("
                             (mapconcat 'eval date-form "\\)\\(?:")
                             "\\)"))
                           (case-fold-search t))
                        (goto-char (point-min))
                        (while (re-search-forward regexp nil t)
                          (if backup (re-search-backward "\\<" nil t))
                         (if (and (bolp) (not (looking-at "[ \t]")))
                              ;;  Diary entry that consists only of date.
                              (backward-char 1)
                            ;; Found a nonempty diary entry--make it
                            ;; visible and add it to the list.
                            (setq entry-found t)
                           (if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
                            (let ((entry-start (point))
                                  date-start temp)
                             (setq date-start
                                   (line-end-position
                                    (if (and (bolp) (> number 1)) -1 0)))
                             (forward-line 1)
                             (while (looking-at "[ \t]")
                               (forward-line 1))
                              (unless (and (eobp) (not (bolp)))
                                (backward-char 1))
                              (unless list-only
                                (remove-overlays date-start (point)
                                                 'invisible 'diary))

are obeyed.  You can change the `#include' to some other string by
changing the variable `diary-include-string'."
  (goto-char (point-min))
  (while (re-search-forward
          (concat
           "^"
           (regexp-quote diary-include-string)
           " \"\\([^\"]*\\)\"")
          nil t)
    (let* ((diary-file (substitute-in-file-name
                        (match-string-no-properties 1)))

                             (if holiday-list ": " "")
                             (mapconcat 'identity holiday-list "; ")))
         (msg (format "No diary entries for %s" hol-string))
         ;; If selected window is dedicated (to the calendar),
         ;; need a new one to display the diary.
         (pop-up-frames (or pop-up-frames
                            (window-dedicated-p (selected-window)))))
    (calendar-set-mode-line (format "Diary for %s" hol-string))
    (if (or (not diary-entries-list)
            (and (not (cdr diary-entries-list))
                 (string-equal (car (cdr (car diary-entries-list))) "")))
        (if (< (length msg) (frame-width))

                   (month "[0-9]+\\|\\*")
                   (day "[0-9]+\\|\\*")
                   (year "[0-9]+\\|\\*")
                   (l (length date-form))
                   (d-name-pos (- l (length (memq 'dayname date-form))))
                   (d-name-pos (if (/= l d-name-pos) (+ 1 d-name-pos)))
                   (m-name-pos (- l (length (memq 'monthname date-form))))
                   (m-name-pos (if (/= l m-name-pos) (+ 1 m-name-pos)))
                   (d-pos (- l (length (memq 'day date-form))))
                   (d-pos (if (/= l d-pos) (+ 1 d-pos)))
                   (m-pos (- l (length (memq 'month date-form))))
                   (m-pos (if (/= l m-pos) (+ 1 m-pos)))
                   (y-pos (- l (length (memq 'year date-form))))
                   (y-pos (if (/= l y-pos) (+ 1 y-pos)))
                   (regexp
                    (concat
                     "^\\("
                     (mapconcat 'eval date-form "\\)\\(")
                     "\\)"))
                   (case-fold-search t))
              (goto-char (point-min))
              (while (re-search-forward regexp nil t)

(defun mark-sexp-diary-entries ()
  "Mark days in the calendar window that have sexp diary entries.
Each entry in the diary file (or included files) visible in the calendar window
is marked.  See the documentation for the function `list-sexp-diary-entries'."
  (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol))
         (s-entry (concat "^\\("
                          sexp-mark "(\\)\\|\\("
                          (regexp-quote diary-nonmarking-symbol)
                          sexp-mark "(diary-remind\\)"))
         (file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
         m y first-date last-date mark file-glob-attrs)

    (goto-char (point-min))
    (while (re-search-forward s-entry nil t)
      (setq marking-diary-entry (char-equal (preceding-char) ?\())
      (re-search-backward "(")
      (let ((sexp-start (point))
            sexp entry entry-start marks)
        (forward-sexp)
        (setq sexp (buffer-substring-no-properties sexp-start (point)))
        (forward-char 1)
        (if (and (bolp) (not (looking-at "[ \t]")))
            (progn;; Diary entry consists only of the sexp
              (backward-char 1)
              (setq entry ""))
          (setq entry-start (point))
          ;; Find end of entry
          (forward-line 1)
          (while (looking-at "[ \t]")
            (forward-line 1))
          (if (bolp) (backward-char 1))
          (setq entry (buffer-substring-no-properties entry-start (point))))
        (calendar-for-loop date from first-date to last-date do
          (if (setq mark (diary-sexp-entry sexp entry
                                (calendar-gregorian-from-absolute date)))
	      (progn
		(setq marks (diary-pull-attrs entry file-glob-attrs)

are obeyed.  You can change the `#include' to some other string by
changing the variable `diary-include-string'."
  (goto-char (point-min))
  (while (re-search-forward
          (concat
           "^"
           (regexp-quote diary-include-string)
           " \"\\([^\"]*\\)\"")
          nil t)
    (let* ((diary-file (substitute-in-file-name
                        (match-string-no-properties 1)))

The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam,
XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM.  A period (.) can
be used instead of a colon (:) to separate the hour and minute parts."
  (let ((case-fold-search nil))
    (cond ((string-match        ; Military time
	    "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)"
            s)
	   (+ (* 100 (string-to-number (match-string 1 s)))
	      (string-to-number (match-string 2 s))))
	  ((string-match        ; Hour only  XXam or XXpm
	    "\\`[ \t\n]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
	   (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
	      (if (equal ?a (downcase (aref s (match-beginning 2))))
		  0 1200)))
	  ((string-match        ; Hour and minute  XX:XXam or XX:XXpm
	    "\\`[ \t\n]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
	   (+ (* 100 (% (string-to-number (match-string 1 s)) 12))
	      (string-to-number (match-string 2 s))
	      (if (equal ?a (downcase (aref s (match-beginning 3))))
		  0 1200)))
	  (t diary-unknown-time)))) ; Unrecognizable

                  from Passover to Shavuot.  Note that since there is no text,
                  it makes sense only if the fancy diary display is used.

Marking these entries is *extremely* time consuming, so these entries are
best if they are nonmarking."
  (let ((s-entry (concat "^"
                         (regexp-quote diary-nonmarking-symbol)
                         "?"
                         (regexp-quote sexp-diary-entry-symbol)
                         "("))
        entry-found file-glob-attrs marks)

      (backward-char 1)
      (let ((sexp-start (point))
            sexp entry specifier entry-start line-start)
        (forward-sexp)
        (setq sexp (buffer-substring-no-properties sexp-start (point)))
        (setq line-start (line-end-position 0))
        (setq specifier
              (buffer-substring-no-properties (1+ line-start) (point))
              entry-start (1+ line-start))
        (forward-char 1)
        (if (and (bolp) (not (looking-at "[ \t]")))
            (progn;; Diary entry consists only of the sexp
              (backward-char 1)
              (setq entry ""))
          (setq entry-start (point))
          (forward-line 1)
          (while (looking-at "[ \t]")
            (forward-line 1))
          (backward-char 1)
          (setq entry (buffer-substring-no-properties entry-start (point))))
        (let ((diary-entry (diary-sexp-entry sexp entry date))
              temp literal)
          (setq literal entry           ; before evaluation
                entry (if (consp diary-entry)
                          (cdr diary-entry)

;; which case they will prompt about adding to the diary).  The
;; message formats recognized are customizable through
;; `diary-outlook-formats'.

;; Dynamically bound.
(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