Mercurial > emacs
comparison lisp/calendar/diary-lib.el @ 70728:27c11738a0c4
(diary-bahai-date)
(list-bahai-diary-entries, mark-bahai-diary-entries)
(mark-bahai-calendar-date-pattern): Not interactive.
(add-to-diary-list): New optional arg LITERAL. Doc fix.
(diary-entries-list): Change format of 4th element in each entry.
(diary-list-entries): Use add-to-diary-list.
(diary-goto-entry): Handle the case where the buffer visiting the
diary has been killed.
(fancy-diary-display): Add 'locator to button rather than 'marker.
Only generate temp-face when there are marks to apply.
(list-sexp-diary-entries): Pass literal to add-to-diary-list.
(diary-fancy-date-pattern): New variable.
(diary-time-regexp): Doc fix.
(diary-anniversary, diary-time): New faces.
(fancy-diary-font-lock-keywords): Use diary-fancy-date-pattern and
diary-time-regexp. Add font-lock-multiline property where needed.
Use new faces diary-anniversary and diary-time.
(diary-fancy-font-lock-fontify-region-function): New function, to
handle multiline font-lock pattern in fancy diary.
(fancy-diary-display-mode): Set font-lock-fontify-region-function.
(diary-font-lock-keywords): Tweak time regexp. Use new face
diary-time.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Fri, 19 May 2006 08:24:51 +0000 |
parents | dcac2668b45d |
children | 9a90863c52b1 |
comparison
equal
deleted
inserted
replaced
70727:7b9306389285 | 70728:27c11738a0c4 |
---|---|
119 | 119 |
120 (autoload 'mark-islamic-calendar-date-pattern "cal-islam" | 120 (autoload 'mark-islamic-calendar-date-pattern "cal-islam" |
121 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.") | 121 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.") |
122 | 122 |
123 (autoload 'diary-bahai-date "cal-bahai" | 123 (autoload 'diary-bahai-date "cal-bahai" |
124 "Baha'i calendar equivalent of date diary entry." | 124 "Baha'i calendar equivalent of date diary entry.") |
125 t) | |
126 | 125 |
127 (autoload 'list-bahai-diary-entries "cal-bahai" | 126 (autoload 'list-bahai-diary-entries "cal-bahai" |
128 "Add any Baha'i date entries from the diary file to `diary-entries-list'." | 127 "Add any Baha'i date entries from the diary file to `diary-entries-list'.") |
129 t) | |
130 | 128 |
131 (autoload 'mark-bahai-diary-entries "cal-bahai" | 129 (autoload 'mark-bahai-diary-entries "cal-bahai" |
132 "Mark days in the calendar window that have Baha'i date diary entries." | 130 "Mark days in the calendar window that have Baha'i date diary entries.") |
133 t) | |
134 | 131 |
135 (autoload 'mark-bahai-calendar-date-pattern "cal-bahai" | 132 (autoload 'mark-bahai-calendar-date-pattern "cal-bahai" |
136 "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR." | 133 "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.") |
137 t) | |
138 | 134 |
139 (autoload 'diary-hebrew-date "cal-hebrew" | 135 (autoload 'diary-hebrew-date "cal-hebrew" |
140 "Hebrew calendar equivalent of date diary entry.") | 136 "Hebrew calendar equivalent of date diary entry.") |
141 | 137 |
142 (autoload 'diary-omer "cal-hebrew" | 138 (autoload 'diary-omer "cal-hebrew" |
320 (integer :tag "Wednesday") | 316 (integer :tag "Wednesday") |
321 (integer :tag "Thursday") | 317 (integer :tag "Thursday") |
322 (integer :tag "Friday") | 318 (integer :tag "Friday") |
323 (integer :tag "Saturday"))) | 319 (integer :tag "Saturday"))) |
324 :group 'diary) | 320 :group 'diary) |
321 | |
322 | |
323 (defvar diary-modify-entry-list-string-function nil | |
324 "Function applied to entry string before putting it into the entries list. | |
325 Can be used by programs integrating a diary list into other buffers (e.g. | |
326 org.el and planner.el) to modify the string or add properties to it. | |
327 The function takes a string argument and must return a string.") | |
328 | |
329 (defun add-to-diary-list (date string specifier &optional marker | |
330 globcolor literal) | |
331 "Add an entry to `diary-entries-list'. | |
332 Do nothing if DATE or STRING is nil. DATE is the (MONTH DAY | |
333 YEAR) for which the entry applies; STRING is the text of the | |
334 entry as it will appear in the diary (i.e. with any format | |
335 strings such as \%d\" expanded); SPECIFIER is the date part of | |
336 the entry as it appears in the diary-file; LITERAL is the entry | |
337 as it appears in the diary-file (i.e. before expansion). If | |
338 LITERAL is nil, it is taken to be the same as STRING. | |
339 | |
340 The entry is added to the list as (DATE STRING SPECIFIER LOCATOR | |
341 GLOBCOLOR), where LOCATOR has the form (MARKER FILENAME LITERAL), | |
342 FILENAME being the file containing the diary entry." | |
343 (when (and date string) | |
344 (if diary-file-name-prefix | |
345 (let ((prefix (funcall diary-file-name-prefix-function | |
346 (buffer-file-name)))) | |
347 (or (string= prefix "") | |
348 (setq string (format "[%s] %s" prefix string))))) | |
349 (and diary-modify-entry-list-string-function | |
350 (setq string (funcall diary-modify-entry-list-string-function | |
351 string))) | |
352 (setq diary-entries-list | |
353 (append diary-entries-list | |
354 (list (list date string specifier | |
355 (list marker (buffer-file-name) literal) | |
356 globcolor)))))) | |
325 | 357 |
326 (define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) | 358 (define-obsolete-function-alias 'list-diary-entries 'diary-list-entries) |
327 (defun diary-list-entries (date number &optional list-only) | 359 (defun diary-list-entries (date number &optional list-only) |
328 "Create and display a buffer containing the relevant lines in `diary-file'. | 360 "Create and display a buffer containing the relevant lines in `diary-file'. |
329 The arguments are DATE and NUMBER; the entries selected are those | 361 The arguments are DATE and NUMBER; the entries selected are those |
466 (buffer-substring | 498 (buffer-substring |
467 (1+ date-start) (1- entry-start)) | 499 (1+ date-start) (1- entry-start)) |
468 (copy-marker entry-start) (nth 1 temp))))))) | 500 (copy-marker entry-start) (nth 1 temp))))))) |
469 (or entry-found | 501 (or entry-found |
470 (not diary-list-include-blanks) | 502 (not diary-list-include-blanks) |
471 (setq diary-entries-list | 503 (add-to-diary-list date "" "" "" "")) |
472 (append diary-entries-list | |
473 (list (list date "" "" "" ""))))) | |
474 (setq date | 504 (setq date |
475 (calendar-gregorian-from-absolute | 505 (calendar-gregorian-from-absolute |
476 (1+ (calendar-absolute-from-gregorian date)))) | 506 (1+ (calendar-absolute-from-gregorian date)))) |
477 (setq entry-found nil))))) | 507 (setq entry-found nil))))) |
478 (goto-char (point-min)) | 508 (goto-char (point-min)) |
575 (define-button-type 'diary-entry | 605 (define-button-type 'diary-entry |
576 'action #'diary-goto-entry | 606 'action #'diary-goto-entry |
577 'face 'diary-button) | 607 'face 'diary-button) |
578 | 608 |
579 (defun diary-goto-entry (button) | 609 (defun diary-goto-entry (button) |
580 (let ((marker (button-get button 'marker))) | 610 (let* ((locator (button-get button 'locator)) |
581 (when marker | 611 (marker (car locator)) |
582 (pop-to-buffer (marker-buffer marker)) | 612 markbuf file) |
583 (goto-char (marker-position marker))))) | 613 ;; If marker pointing to diary location is valid, use that. |
614 (if (and marker (setq markbuf (marker-buffer marker))) | |
615 (progn | |
616 (pop-to-buffer markbuf) | |
617 (goto-char (marker-position marker))) | |
618 ;; Marker is invalid (eg buffer has been killed). | |
619 (or (and (setq file (cadr locator)) | |
620 (file-exists-p file) | |
621 (find-file-other-window file) | |
622 (progn | |
623 (when (eq major-mode default-major-mode) (diary-mode)) | |
624 (goto-char (point-min)) | |
625 (if (re-search-forward (format "%s.*\\(%s\\)" | |
626 (regexp-quote (nth 2 locator)) | |
627 (regexp-quote (nth 3 locator))) | |
628 nil t) | |
629 (goto-char (match-beginning 1))))) | |
630 (message "Unable to locate this diary entry"))))) | |
584 | 631 |
585 (defun fancy-diary-display () | 632 (defun fancy-diary-display () |
586 "Prepare a diary buffer with relevant entries in a fancy, noneditable form. | 633 "Prepare a diary buffer with relevant entries in a fancy, noneditable form. |
587 This function is provided for optional use as the `diary-display-hook'." | 634 This function is provided for optional use as the `diary-display-hook'." |
588 (with-current-buffer ;; Turn off selective-display in the diary file's buffer. | 635 (with-current-buffer ;; Turn off selective-display in the diary file's buffer. |
664 (concat "\n" (make-string l ? )))) | 711 (concat "\n" (make-string l ? )))) |
665 (insert ?\n (make-string (+ l longest) ?=) ?\n))))) | 712 (insert ?\n (make-string (+ l longest) ?=) ?\n))))) |
666 | 713 |
667 (setq entry (car (cdr (car entry-list)))) | 714 (setq entry (car (cdr (car entry-list)))) |
668 (if (< 0 (length entry)) | 715 (if (< 0 (length entry)) |
669 (progn | 716 (let ((this-entry (car entry-list)) |
670 (if (nth 3 (car entry-list)) | 717 this-loc) |
718 (if (setq this-loc (nth 3 this-entry)) | |
671 (insert-button (concat entry "\n") | 719 (insert-button (concat entry "\n") |
672 'marker (nth 3 (car entry-list)) | 720 ;; (MARKER FILENAME SPECIFIER LITERAL) |
721 'locator (list (car this-loc) | |
722 (cadr this-loc) | |
723 (nth 2 this-entry) | |
724 (or (nth 2 this-loc) | |
725 (nth 1 this-entry))) | |
673 :type 'diary-entry) | 726 :type 'diary-entry) |
674 (insert entry ?\n)) | 727 (insert entry ?\n)) |
675 (save-excursion | 728 (save-excursion |
676 (let* ((marks (nth 4 (car entry-list))) | 729 (let* ((marks (nth 4 this-entry)) |
677 (temp-face (make-symbol | 730 (faceinfo marks) |
678 (apply | 731 temp-face) |
679 'concat "temp-face-" | 732 (when marks |
680 (mapcar (lambda (sym) | 733 (setq temp-face (make-symbol |
681 (if (stringp sym) | 734 (apply |
682 sym | 735 'concat "temp-face-" |
683 (symbol-name sym))) | 736 (mapcar (lambda (sym) |
684 marks)))) | 737 (if (stringp sym) |
685 (faceinfo marks)) | 738 sym |
686 (make-face temp-face) | 739 (symbol-name sym))) |
687 ;; Remove :face info from the marks, | 740 marks)))) |
688 ;; copy the face info into temp-face | 741 (make-face temp-face) |
689 (while (setq faceinfo (memq :face faceinfo)) | 742 ;; Remove :face info from the marks, |
690 (copy-face (read (nth 1 faceinfo)) temp-face) | 743 ;; copy the face info into temp-face |
691 (setcar faceinfo nil) | 744 (while (setq faceinfo (memq :face faceinfo)) |
692 (setcar (cdr faceinfo) nil)) | 745 (copy-face (read (nth 1 faceinfo)) temp-face) |
693 (setq marks (delq nil marks)) | 746 (setcar faceinfo nil) |
694 ;; Apply the font aspects. | 747 (setcar (cdr faceinfo) nil)) |
695 (apply 'set-face-attribute temp-face nil marks) | 748 (setq marks (delq nil marks)) |
696 (search-backward entry) | 749 ;; Apply the font aspects. |
697 (overlay-put | 750 (apply 'set-face-attribute temp-face nil marks) |
698 (make-overlay (match-beginning 0) (match-end 0)) | 751 (search-backward entry) |
699 'face temp-face))))) | 752 (overlay-put |
753 (make-overlay (match-beginning 0) (match-end 0)) | |
754 'face temp-face)))))) | |
700 (setq entry-list (cdr entry-list)))) | 755 (setq entry-list (cdr entry-list)))) |
701 (set-buffer-modified-p nil) | 756 (set-buffer-modified-p nil) |
702 (goto-char (point-min)) | 757 (goto-char (point-min)) |
703 (setq buffer-read-only t) | 758 (setq buffer-read-only t) |
704 (display-buffer fancy-diary-buffer) | 759 (display-buffer fancy-diary-buffer) |
1348 (save-excursion | 1403 (save-excursion |
1349 (re-search-backward "\^M\\|\n\\|\\`") | 1404 (re-search-backward "\^M\\|\n\\|\\`") |
1350 (setq line-start (point))) | 1405 (setq line-start (point))) |
1351 (setq specifier | 1406 (setq specifier |
1352 (buffer-substring-no-properties (1+ line-start) (point)) | 1407 (buffer-substring-no-properties (1+ line-start) (point)) |
1353 entry-start (1+ line-start)) | 1408 entry-start (1+ line-start)) |
1354 (forward-char 1) | 1409 (forward-char 1) |
1355 (if (and (or (char-equal (preceding-char) ?\^M) | 1410 (if (and (or (char-equal (preceding-char) ?\^M) |
1356 (char-equal (preceding-char) ?\n)) | 1411 (char-equal (preceding-char) ?\n)) |
1357 (not (looking-at " \\|\^I"))) | 1412 (not (looking-at " \\|\^I"))) |
1358 (progn;; Diary entry consists only of the sexp | 1413 (progn;; Diary entry consists only of the sexp |
1365 (backward-char 1) | 1420 (backward-char 1) |
1366 (setq entry (buffer-substring-no-properties entry-start (point))) | 1421 (setq entry (buffer-substring-no-properties entry-start (point))) |
1367 (while (string-match "[\^M]" entry) | 1422 (while (string-match "[\^M]" entry) |
1368 (aset entry (match-beginning 0) ?\n ))) | 1423 (aset entry (match-beginning 0) ?\n ))) |
1369 (let ((diary-entry (diary-sexp-entry sexp entry date)) | 1424 (let ((diary-entry (diary-sexp-entry sexp entry date)) |
1370 temp) | 1425 temp literal) |
1371 (setq entry (if (consp diary-entry) | 1426 (setq literal entry ; before evaluation |
1372 (cdr diary-entry) | 1427 entry (if (consp diary-entry) |
1373 diary-entry)) | 1428 (cdr diary-entry) |
1429 diary-entry)) | |
1374 (if diary-entry | 1430 (if diary-entry |
1375 (progn | 1431 (progn |
1376 (remove-overlays line-start (point) 'invisible 'diary) | 1432 (remove-overlays line-start (point) 'invisible 'diary) |
1377 (if (< 0 (length entry)) | 1433 (if (< 0 (length entry)) |
1378 (setq temp (diary-pull-attrs entry file-glob-attrs) | 1434 (setq temp (diary-pull-attrs entry file-glob-attrs) |
1379 entry (nth 0 temp) | 1435 entry (nth 0 temp) |
1380 marks (nth 1 temp))))) | 1436 marks (nth 1 temp))))) |
1381 (add-to-diary-list date | 1437 (add-to-diary-list date |
1382 entry | 1438 entry |
1383 specifier | 1439 specifier |
1384 (if entry-start (copy-marker entry-start) | 1440 (if entry-start (copy-marker entry-start) |
1385 nil) | 1441 nil) |
1386 marks) | 1442 marks |
1387 (setq entry-found (or entry-found diary-entry))))) | 1443 literal) |
1444 (setq entry-found (or entry-found diary-entry))))) | |
1388 entry-found)) | 1445 entry-found)) |
1389 | 1446 |
1390 (defun diary-sexp-entry (sexp entry date) | 1447 (defun diary-sexp-entry (sexp entry date) |
1391 "Process a SEXP diary ENTRY for DATE." | 1448 "Process a SEXP diary ENTRY for DATE." |
1392 (let ((result (if calendar-debug-sexp | 1449 (let ((result (if calendar-debug-sexp |
1634 ;; Diary entry may apply to one of a list of days before date | 1691 ;; Diary entry may apply to one of a list of days before date |
1635 ((and (listp days) days) | 1692 ((and (listp days) days) |
1636 (or (diary-remind sexp (car days) marking) | 1693 (or (diary-remind sexp (car days) marking) |
1637 (diary-remind sexp (cdr days) marking)))))) | 1694 (diary-remind sexp (cdr days) marking)))))) |
1638 | 1695 |
1639 (defvar diary-modify-entry-list-string-function nil | |
1640 "Function applied to entry string before putting it into the entries list. | |
1641 Can be used by programs integrating a diary list into other buffers (e.g. | |
1642 org.el and planner.el) to modify the string or add properties to it. | |
1643 The function takes a string argument and must return a string.") | |
1644 | |
1645 (defun add-to-diary-list (date string specifier &optional marker globcolor) | |
1646 "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'. | |
1647 Do nothing if DATE or STRING is nil." | |
1648 (when (and date string) | |
1649 (if diary-file-name-prefix | |
1650 (let ((prefix (funcall diary-file-name-prefix-function | |
1651 (buffer-file-name)))) | |
1652 (or (string= prefix "") | |
1653 (setq string (format "[%s] %s" prefix string))))) | |
1654 (and diary-modify-entry-list-string-function | |
1655 (setq string (funcall diary-modify-entry-list-string-function | |
1656 string))) | |
1657 (setq diary-entries-list | |
1658 (append diary-entries-list | |
1659 (list (list date string specifier marker globcolor)))))) | |
1660 | |
1661 (defun diary-redraw-calendar () | 1696 (defun diary-redraw-calendar () |
1662 "If `calendar-buffer' is live and diary entries are marked, redraw it." | 1697 "If `calendar-buffer' is live and diary entries are marked, redraw it." |
1663 (and mark-diary-entries-in-calendar | 1698 (and mark-diary-entries-in-calendar |
1664 (save-excursion | 1699 (save-excursion |
1665 (redraw-calendar))) | 1700 (redraw-calendar))) |
1794 (add-to-invisibility-spec '(diary . nil)) | 1829 (add-to-invisibility-spec '(diary . nil)) |
1795 (add-hook 'after-save-hook 'diary-redraw-calendar nil t) | 1830 (add-hook 'after-save-hook 'diary-redraw-calendar nil t) |
1796 (if diary-header-line-flag | 1831 (if diary-header-line-flag |
1797 (setq header-line-format diary-header-line-format))) | 1832 (setq header-line-format diary-header-line-format))) |
1798 | 1833 |
1834 | |
1835 (defvar diary-fancy-date-pattern | |
1836 (concat | |
1837 (let ((dayname (diary-name-pattern calendar-day-name-array nil t)) | |
1838 (monthname (diary-name-pattern calendar-month-name-array nil t)) | |
1839 (day "[0-9]+") | |
1840 (month "[0-9]+") | |
1841 (year "-?[0-9]+")) | |
1842 (mapconcat 'eval calendar-date-display-form "")) | |
1843 ;; Optional ": holiday name" after the date. | |
1844 "\\(: .*\\)?") | |
1845 "Regular expression matching a date header in Fancy Diary.") | |
1846 | |
1847 (defconst diary-time-regexp | |
1848 ;; Accepted formats: 10:00 10.00 10h00 10h 10am 10:00am 10.00am | |
1849 ;; Use of "." as a separator annoyingly matches numbers, eg "123.45". | |
1850 ;; Hence often prefix this with "\\(^\\|\\s-\\)." | |
1851 (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\(" | |
1852 "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]" | |
1853 "\\)\\([AaPp][Mm]\\)?\\)") | |
1854 "Regular expression matching a time of day.") | |
1855 | |
1856 (defface diary-anniversary '((t :inherit font-lock-keyword-face)) | |
1857 "Face used for anniversaries in the diary." | |
1858 :version "22.1" | |
1859 :group 'diary) | |
1860 | |
1861 (defface diary-time '((t :inherit font-lock-variable-name-face)) | |
1862 "Face used for times of day in the diary." | |
1863 :version "22.1" | |
1864 :group 'diary) | |
1865 | |
1866 (defvar fancy-diary-font-lock-keywords | |
1867 (list | |
1868 (list | |
1869 ;; Any number of " other holiday name" lines, followed by "==" line. | |
1870 (concat diary-fancy-date-pattern "\\(\n +.*\\)*\n=+$") | |
1871 '(0 (progn (put-text-property (match-beginning 0) (match-end 0) | |
1872 'font-lock-multiline t) | |
1873 diary-face))) | |
1874 '("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary) | |
1875 '("^.*Yahrzeit.*$" . font-lock-reference-face) | |
1876 '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face) | |
1877 '("^Day.*omer.*$" . font-lock-builtin-face) | |
1878 '("^Parashat.*$" . font-lock-comment-face) | |
1879 `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp | |
1880 diary-time-regexp) . 'diary-time)) | |
1881 "Keywords to highlight in fancy diary display") | |
1882 | |
1883 ;; If region looks like it might start or end in the middle of a | |
1884 ;; multiline pattern, extend the region to encompass the whole pattern. | |
1885 (defun diary-fancy-font-lock-fontify-region-function (beg end &optional verbose) | |
1886 "Function to use for `font-lock-fontify-region-function' in Fancy Diary. | |
1887 Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'." | |
1888 (goto-char beg) | |
1889 (forward-line 0) | |
1890 (if (looking-at "=+$") (forward-line -1)) | |
1891 (while (and (looking-at " +[^ ]") | |
1892 (zerop (forward-line -1)))) | |
1893 ;; This check not essential. | |
1894 (if (looking-at diary-fancy-date-pattern) | |
1895 (setq beg (line-beginning-position))) | |
1896 (goto-char end) | |
1897 (forward-line 0) | |
1898 (while (and (looking-at " +[^ ]") | |
1899 (zerop (forward-line 1)))) | |
1900 (if (looking-at "=+$") | |
1901 (setq end (line-beginning-position 2))) | |
1902 (font-lock-default-fontify-region beg end verbose)) | |
1903 | |
1799 (define-derived-mode fancy-diary-display-mode fundamental-mode | 1904 (define-derived-mode fancy-diary-display-mode fundamental-mode |
1800 "Diary" | 1905 "Diary" |
1801 "Major mode used while displaying diary entries using Fancy Display." | 1906 "Major mode used while displaying diary entries using Fancy Display." |
1802 (set (make-local-variable 'font-lock-defaults) | 1907 (set (make-local-variable 'font-lock-defaults) |
1803 '(fancy-diary-font-lock-keywords t)) | 1908 '(fancy-diary-font-lock-keywords |
1909 t nil nil nil | |
1910 (font-lock-fontify-region-function | |
1911 . diary-fancy-font-lock-fontify-region-function))) | |
1804 (local-set-key "q" 'quit-window)) | 1912 (local-set-key "q" 'quit-window)) |
1805 | |
1806 | |
1807 (defvar fancy-diary-font-lock-keywords | |
1808 (list | |
1809 (cons | |
1810 (concat | |
1811 (let ((dayname (diary-name-pattern calendar-day-name-array nil t)) | |
1812 (monthname (diary-name-pattern calendar-month-name-array nil t)) | |
1813 (day "[0-9]+") | |
1814 (month "[0-9]+") | |
1815 (year "-?[0-9]+")) | |
1816 (mapconcat 'eval calendar-date-display-form "")) | |
1817 "\\(\\(: .*\\)\\|\\(\n +.*\\)\\)*\n=+$") | |
1818 'diary-face) | |
1819 '("^.*anniversary.*$" . font-lock-keyword-face) | |
1820 '("^.*birthday.*$" . font-lock-keyword-face) | |
1821 '("^.*Yahrzeit.*$" . font-lock-reference-face) | |
1822 '("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face) | |
1823 '("^Day.*omer.*$" . font-lock-builtin-face) | |
1824 '("^Parashat.*$" . font-lock-comment-face) | |
1825 '("^[ \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\\)?\\)?" | |
1826 . font-lock-variable-name-face)) | |
1827 "Keywords to highlight in fancy diary display") | |
1828 | 1913 |
1829 | 1914 |
1830 (defun diary-font-lock-sexps (limit) | 1915 (defun diary-font-lock-sexps (limit) |
1831 "Recognize sexp diary entry for font-locking." | 1916 "Recognize sexp diary entry for font-locking." |
1832 (if (re-search-forward | 1917 (if (re-search-forward |
1874 '(1 diary-face))) | 1959 '(1 diary-face))) |
1875 diary-date-forms))) | 1960 diary-date-forms))) |
1876 | 1961 |
1877 (eval-when-compile (require 'cal-hebrew) | 1962 (eval-when-compile (require 'cal-hebrew) |
1878 (require 'cal-islam)) | 1963 (require 'cal-islam)) |
1879 | |
1880 (defconst diary-time-regexp | |
1881 ;; Formats that should be accepted: | |
1882 ;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am | |
1883 (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\(" | |
1884 "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]" | |
1885 "\\)\\([AaPp][Mm]\\)?\\)")) | |
1886 | 1964 |
1887 (defvar diary-font-lock-keywords | 1965 (defvar diary-font-lock-keywords |
1888 (append | 1966 (append |
1889 (diary-font-lock-date-forms calendar-month-name-array | 1967 (diary-font-lock-date-forms calendar-month-name-array |
1890 nil calendar-month-abbrev-array) | 1968 nil calendar-month-abbrev-array) |
1922 (cons | 2000 (cons |
1923 (concat "^" (regexp-quote diary-nonmarking-symbol) | 2001 (concat "^" (regexp-quote diary-nonmarking-symbol) |
1924 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") | 2002 "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)") |
1925 '(1 font-lock-reference-face)) | 2003 '(1 font-lock-reference-face)) |
1926 '(diary-font-lock-sexps . font-lock-keyword-face) | 2004 '(diary-font-lock-sexps . font-lock-keyword-face) |
1927 (cons | 2005 `(,(concat "\\(^\\|\\s-\\)" |
1928 (concat ;; "^[ \t]+" | 2006 diary-time-regexp "\\(-" diary-time-regexp "\\)?") |
1929 diary-time-regexp "\\(-" diary-time-regexp "\\)?") | 2007 . 'diary-time))) |
1930 'font-lock-function-name-face))) | |
1931 "Forms to highlight in `diary-mode'.") | 2008 "Forms to highlight in `diary-mode'.") |
1932 | 2009 |
1933 | 2010 |
1934 ;; Following code from Dave Love <fx@gnu.org>. | 2011 ;; Following code from Dave Love <fx@gnu.org>. |
1935 ;; Import Outlook-format appointments from mail messages in Gnus or | 2012 ;; Import Outlook-format appointments from mail messages in Gnus or |