Changeset 4091 for trunk/lisp/calendar/diary-lib.el

Timestamp:

05/27/06 10:35:24 (2 years ago)

Author:

miyoshi

Message:

Sync up with Emacs CVS HEAD.

Files:

• trunk/lisp/calendar/diary-lib.el (modified) (11 diffs)

trunk/lisp/calendar/diary-lib.el

@@ -122 +122 @@
-
-(autoload 'diary-bahai-date "cal-bahai"
-
-
+
-
-(autoload 'list-bahai-diary-entries "cal-bahai"
-
-
+
-
-(autoload 'mark-bahai-diary-entries "cal-bahai"
-
-
+
-
-(autoload 'mark-bahai-calendar-date-pattern "cal-bahai"
-
-
+
-
-(autoload 'diary-hebrew-date "cal-hebrew"
@@ -323 +319 @@
-                         (integer :tag "Saturday")))
-  :group 'diary)
+
+
+(defvar diary-modify-entry-list-string-function nil
+  "Function applied to entry string before putting it into the entries list.
+Can be used by programs integrating a diary list into other buffers (e.g.
+org.el and planner.el) to modify the string or add properties to it.
+The function takes a string argument and must return a string.")
+
+(defun add-to-diary-list (date string specifier &optional marker
+                               globcolor literal)
+  "Add an entry to `diary-entries-list'.
+Do nothing if DATE or STRING is nil.  DATE is the (MONTH DAY
+YEAR) for which the entry applies; STRING is the text of the
+entry as it will appear in the diary (i.e. with any format
+strings such as \"%d\" expanded); SPECIFIER is the date part of
+the entry as it appears in the diary-file; LITERAL is the entry
+as it appears in the diary-file (i.e. before expansion).  If
+LITERAL is nil, it is taken to be the same as STRING.
+
+The entry is added to the list as (DATE STRING SPECIFIER LOCATOR
+GLOBCOLOR), where LOCATOR has the form (MARKER FILENAME LITERAL),
+FILENAME being the file containing the diary entry."
+  (when (and date string)
+    (if diary-file-name-prefix
+        (let ((prefix (funcall diary-file-name-prefix-function
+                               (buffer-file-name))))
+          (or (string= prefix "")
+              (setq string (format "[%s] %s" prefix string)))))
+    (and diary-modify-entry-list-string-function
+         (setq string (funcall diary-modify-entry-list-string-function
+                               string)))
+    (setq diary-entries-list
+          (append diary-entries-list
+                  (list (list date string specifier
+                              (list marker (buffer-file-name) literal)
+                              globcolor))))))
-
-(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries)
@@ -469 +501 @@
-                   (or entry-found
-                       (not diary-list-include-blanks)
-
-
-
+
-                   (setq date
-                         (calendar-gregorian-from-absolute
@@ -578 +608 @@
-
-(defun diary-goto-entry (button)
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-(defun fancy-diary-display ()
@@ -667 +714 @@
-          (setq entry (car (cdr (car entry-list))))
-          (if (< 0 (length entry))
-
-
+
+
+
-                    (insert-button (concat entry "\n")
-
+
+
+
+
+
+
-                                   :type 'diary-entry)
-                  (insert entry ?\n))
-                (save-excursion
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-          (setq entry-list (cdr entry-list))))
-      (set-buffer-modified-p nil)
@@ -1351 +1406 @@
-        (setq specifier
-              (buffer-substring-no-properties (1+ line-start) (point))
-       
+        
-        (forward-char 1)
-        (if (and (or (char-equal (preceding-char) ?\^M)
@@ -1368 +1423 @@
-            (aset entry (match-beginning 0) ?\n )))
-        (let ((diary-entry (diary-sexp-entry sexp entry date))
-
-
-
-
+
+
+
+
+
-          (if diary-entry
-       
+        
-                (remove-overlays line-start (point) 'invisible 'diary)
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-    entry-found))
-
@@ -1637 +1694 @@
-          (diary-remind sexp (cdr days) marking))))))
-
-(defvar diary-modify-entry-list-string-function nil
-  "Function applied to entry string before putting it into the entries list.
-Can be used by programs integrating a diary list into other buffers (e.g.
-org.el and planner.el) to modify the string or add properties to it.
-The function takes a string argument and must return a string.")
-
-(defun add-to-diary-list (date string specifier &optional marker globcolor)
-  "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'.
-Do nothing if DATE or STRING is nil."
-  (when (and date string)
-    (if diary-file-name-prefix
-        (let ((prefix (funcall diary-file-name-prefix-function
-                               (buffer-file-name))))
-          (or (string= prefix "")
-              (setq string (format "[%s] %s" prefix string)))))
-    (and diary-modify-entry-list-string-function
-         (setq string (funcall diary-modify-entry-list-string-function
-                               string)))
-    (setq diary-entries-list
-          (append diary-entries-list
-                  (list (list date string specifier marker globcolor))))))
-
-(defun diary-redraw-calendar ()
-  "If `calendar-buffer' is live and diary entries are marked, redraw it."
@@ -1797 +1832 @@
-      (setq header-line-format diary-header-line-format)))
-
+
+(defvar diary-fancy-date-pattern
+  (concat
+   (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
+         (monthname (diary-name-pattern calendar-month-name-array nil t))
+         (day "[0-9]+")
+         (month "[0-9]+")
+         (year "-?[0-9]+"))
+     (mapconcat 'eval calendar-date-display-form ""))
+   ;; Optional ": holiday name" after the date.
+   "\\(: .*\\)?")
+  "Regular expression matching a date header in Fancy Diary.")
+
+(defconst diary-time-regexp
+  ;; Accepted formats: 10:00 10.00 10h00 10h 10am 10:00am 10.00am
+  ;; Use of "." as a separator annoyingly matches numbers, eg "123.45".
+  ;; Hence often prefix this with "\\(^\\|\\s-\\)."
+  (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
+          "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
+          "\\)\\([AaPp][Mm]\\)?\\)")
+  "Regular expression matching a time of day.")
+
+(defface diary-anniversary '((t :inherit font-lock-keyword-face))
+  "Face used for anniversaries in the diary."
+  :version "22.1"
+  :group 'diary)
+
+(defface diary-time '((t :inherit font-lock-variable-name-face))
+  "Face used for times of day in the diary."
+  :version "22.1"
+  :group 'diary)
+
+(defvar fancy-diary-font-lock-keywords
+  (list
+   (list
+    ;; Any number of " other holiday name" lines, followed by "==" line.
+    (concat diary-fancy-date-pattern "\\(\n +.*\\)*\n=+$")
+    '(0 (progn (put-text-property (match-beginning 0) (match-end 0)
+                                  'font-lock-multiline t)
+               diary-face)))
+   '("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
+   '("^.*Yahrzeit.*$" . font-lock-reference-face)
+   '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
+   '("^Day.*omer.*$" . font-lock-builtin-face)
+   '("^Parashat.*$" . font-lock-comment-face)
+   `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
+              diary-time-regexp) . 'diary-time))
+  "Keywords to highlight in fancy diary display")
+
+;; If region looks like it might start or end in the middle of a
+;; multiline pattern, extend the region to encompass the whole pattern.
+(defun diary-fancy-font-lock-fontify-region-function (beg end &optional verbose)
+  "Function to use for `font-lock-fontify-region-function' in Fancy Diary.
+Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'."
+  (goto-char beg)
+  (forward-line 0)
+  (if (looking-at "=+$") (forward-line -1))
+  (while (and (looking-at " +[^ ]")
+              (zerop (forward-line -1))))
+  ;; This check not essential.
+  (if (looking-at diary-fancy-date-pattern)
+      (setq beg (line-beginning-position)))
+  (goto-char end)
+  (forward-line 0)
+  (while (and (looking-at " +[^ ]")
+              (zerop (forward-line 1))))
+  (if (looking-at "=+$")
+      (setq end (line-beginning-position 2)))
+  (font-lock-default-fontify-region beg end verbose))
+
-(define-derived-mode fancy-diary-display-mode fundamental-mode
-  "Diary"
-  "Major mode used while displaying diary entries using Fancy Display."
-  (set (make-local-variable 'font-lock-defaults)
-
+
+
+
+
-  (local-set-key "q" 'quit-window))
-
-
-(defvar fancy-diary-font-lock-keywords
-  (list
-   (cons
-    (concat
-     (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
-           (monthname (diary-name-pattern calendar-month-name-array nil t))
-           (day "[0-9]+")
-           (month "[0-9]+")
-           (year "-?[0-9]+"))
-       (mapconcat 'eval calendar-date-display-form ""))
-     "\\(\\(: .*\\)\\|\\(\n +.*\\)\\)*\n=+$")
-    'diary-face)
-   '("^.*anniversary.*$" . font-lock-keyword-face)
-   '("^.*birthday.*$" . font-lock-keyword-face)
-   '("^.*Yahrzeit.*$" . font-lock-reference-face)
-   '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
-   '("^Day.*omer.*$" . font-lock-builtin-face)
-   '("^Parashat.*$" . font-lock-comment-face)
-   '("^[ \t]*[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\)?"
-     . font-lock-variable-name-face))
-  "Keywords to highlight in fancy diary display")
-
-
@@ -1877 +1962 @@
-(eval-when-compile (require 'cal-hebrew)
-                   (require 'cal-islam))
-
-(defconst diary-time-regexp
-  ;; Formats that should be accepted:
-  ;;   10:00 10.00 10h00 10h 10am 10:00am 10.00am
-  (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
-          "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
-          "\\)\\([AaPp][Mm]\\)?\\)"))
-
-(defvar diary-font-lock-keywords
@@ -1925 +2003 @@
-         '(1 font-lock-reference-face))
-        '(diary-font-lock-sexps . font-lock-keyword-face)
-
-
-
-
+
+
+
-      "Forms to highlight in `diary-mode'.")
-