1 |
;;; calendar.el --- calendar functions |
;;; calendar.el --- calendar functions |
2 |
|
|
3 |
;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997, |
;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997, |
4 |
;; 2000, 2001 Free Software Foundation, Inc. |
;; 2000, 2001, 2003 Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
7 |
;; Keywords: calendar |
;; Keywords: calendar |
381 |
(defcustom diary-file "~/diary" |
(defcustom diary-file "~/diary" |
382 |
"*Name of the file in which one's personal diary of dates is kept. |
"*Name of the file in which one's personal diary of dates is kept. |
383 |
|
|
384 |
The file's entries are lines in any of the forms |
The file's entries are lines beginning with any of the forms |
385 |
|
specified by the variable `american-date-diary-pattern', by default: |
386 |
|
|
387 |
MONTH/DAY |
MONTH/DAY |
388 |
MONTH/DAY/YEAR |
MONTH/DAY/YEAR |
390 |
MONTHNAME DAY, YEAR |
MONTHNAME DAY, YEAR |
391 |
DAYNAME |
DAYNAME |
392 |
|
|
393 |
at the beginning of the line; the remainder of the line is the diary entry |
with the remainder of the line being the diary entry string for |
394 |
string for that date. MONTH and DAY are one or two digit numbers, YEAR is |
that date. MONTH and DAY are one or two digit numbers, YEAR is a |
395 |
a number and may be written in full or abbreviated to the final two digits. |
number and may be written in full or abbreviated to the final two |
396 |
If the date does not contain a year, it is generic and applies to any year. |
digits (if `abbreviated-calendar-year' is non-nil). MONTHNAME |
397 |
DAYNAME entries apply to any date on which is on that day of the week. |
and DAYNAME can be spelled in full (as specified by the variables |
398 |
MONTHNAME and DAYNAME can be spelled in full, abbreviated to three |
`calendar-month-name-array' and `calendar-day-name-array'), |
399 |
characters (with or without a period), capitalized or not. Any of DAY, |
abbreviated (as specified by `calendar-month-abbrev-array' and |
400 |
MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year, |
`calendar-day-abbrev-array') with or without a period, |
401 |
respectively. |
capitalized or not. Any of DAY, MONTH, or MONTHNAME, YEAR can be |
402 |
|
`*' which matches any day, month, or year, respectively. If the |
403 |
The European style (in which the day precedes the month) can be used |
date does not contain a year, it is generic and applies to any |
404 |
instead, if you execute `european-calendar' when in the calendar, or set |
year. A DAYNAME entry applies to the appropriate day of the week |
405 |
`european-calendar-style' to t in your .emacs file. The European forms are |
in every week. |
406 |
|
|
407 |
|
The European style (in which the day precedes the month) can be |
408 |
|
used instead, if you execute `european-calendar' when in the |
409 |
|
calendar, or set `european-calendar-style' to t in your .emacs |
410 |
|
file. The European forms (see `european-date-diary-pattern') are |
411 |
|
|
412 |
DAY/MONTH |
DAY/MONTH |
413 |
DAY/MONTH/YEAR |
DAY/MONTH/YEAR |
513 |
:type 'regexp |
:type 'regexp |
514 |
:group 'diary) |
:group 'diary) |
515 |
|
|
516 |
(defcustom diary-face-attrs '( |
(defcustom diary-face-attrs |
517 |
(" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string) |
'((" *\\[foreground:\\([-a-z]+\\)\\]$" 1 :foreground string) |
518 |
(" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string) |
(" *\\[background:\\([-a-z]+\\)\\]$" 1 :background string) |
519 |
(" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol) |
(" *\\[width:\\([-a-z]+\\)\\]$" 1 :width symbol) |
520 |
(" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int) |
(" *\\[height:\\([-0-9a-z]+\\)\\]$" 1 :height int) |
521 |
(" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol) |
(" *\\[weight:\\([-a-z]+\\)\\]$" 1 :weight symbol) |
522 |
(" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol) |
(" *\\[slant:\\([-a-z]+\\)\\]$" 1 :slant symbol) |
523 |
(" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil) |
(" *\\[underline:\\([-a-z]+\\)\\]$" 1 :underline stringtnil) |
524 |
(" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil) |
(" *\\[overline:\\([-a-z]+\\)\\]$" 1 :overline stringtnil) |
525 |
(" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil) |
(" *\\[strike-through:\\([-a-z]+\\)\\]$" 1 :strike-through stringtnil) |
526 |
(" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil) |
(" *\\[inverse-video:\\([-a-z]+\\)\\]$" 1 :inverse-video tnil) |
527 |
(" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string) |
(" *\\[face:\\([-0-9a-z]+\\)\\]$" 1 :face string) |
528 |
(" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string) |
(" *\\[font:\\([-a-z0-9]+\\)\\]$" 1 :font string) |
529 |
;Unsupported (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box) |
;; Unsupported. |
530 |
;Unsupported (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple) |
;;; (" *\\[box:\\([-a-z]+\\)\\]$" 1 :box) |
531 |
) |
;;; (" *\\[stipple:\\([-a-z]+\\)\\]$" 1 :stipple) |
532 |
"*A list of (regexp regnum attr attrtype) lists where the regexp says how to find the tag, the regnum says which parenthetical sub-regexp this regexp looks for, and the attr says which attribute of the face (or that this _is_ a face) is being modified." |
) |
533 |
|
"*A list of (regexp regnum attr attrtype) lists where the |
534 |
|
regexp says how to find the tag, the regnum says which |
535 |
|
parenthetical sub-regexp this regexp looks for, and the attr says |
536 |
|
which attribute of the face (or that this _is_ a face) is being |
537 |
|
modified." |
538 |
:type 'sexp |
:type 'sexp |
539 |
:group 'diary) |
:group 'diary) |
540 |
|
|
541 |
(defcustom diary-file-name-prefix nil |
(defcustom diary-file-name-prefix nil |
542 |
"If non-nil then each entry in the diary list will be prefixed with the name of the file in which it was defined." |
"If non-nil each diary entry is prefixed with the name of the file where it is defined." |
543 |
:type 'boolean |
:type 'boolean |
544 |
:group 'diary) |
:group 'diary) |
545 |
|
|
562 |
(defcustom european-calendar-style nil |
(defcustom european-calendar-style nil |
563 |
"*Use the European style of dates in the diary and in any displays. |
"*Use the European style of dates in the diary and in any displays. |
564 |
If this variable is t, a date 1/2/1990 would be interpreted as February 1, |
If this variable is t, a date 1/2/1990 would be interpreted as February 1, |
565 |
1990. The accepted European date styles are |
1990. The default European date styles (see `european-date-diary-pattern') |
566 |
|
are |
567 |
|
|
568 |
DAY/MONTH |
DAY/MONTH |
569 |
DAY/MONTH/YEAR |
DAY/MONTH/YEAR |
571 |
DAY MONTHNAME YEAR |
DAY MONTHNAME YEAR |
572 |
DAYNAME |
DAYNAME |
573 |
|
|
574 |
Names can be capitalized or not, written in full, or abbreviated to three |
Names can be capitalized or not, written in full (as specified by the |
575 |
characters with or without a period." |
variable `calendar-day-name-array'), or abbreviated (as specified by |
576 |
|
`calendar-day-abbrev-array') with or without a period." |
577 |
:type 'boolean |
:type 'boolean |
578 |
:group 'diary) |
:group 'diary) |
579 |
|
|
627 |
|
|
628 |
A pseudo-pattern is a list of regular expressions and the keywords `month', |
A pseudo-pattern is a list of regular expressions and the keywords `month', |
629 |
`day', `year', `monthname', and `dayname'. The keyword `monthname' will |
`day', `year', `monthname', and `dayname'. The keyword `monthname' will |
630 |
match the name of the month, capitalized or not, or its three-letter |
match the name of the month (see `calendar-month-name-array'), capitalized |
631 |
abbreviation, followed by a period or not; it will also match `*'. |
or not, or its user-specified abbreviation (see `calendar-month-abbrev-array'), |
632 |
Similarly, `dayname' will match the name of the day, capitalized or not, or |
followed by a period or not; it will also match `*'. Similarly, `dayname' |
633 |
its three-letter abbreviation, followed by a period or not. The keywords |
will match the name of the day (see `calendar-day-name-array'), capitalized or |
634 |
`month', `day', and `year' will match those numerical values, preceded by |
not, or its user-specified abbreviation (see `calendar-day-abbrev-array'), |
635 |
arbitrarily many zeros; they will also match `*'. |
followed by a period or not. The keywords `month', `day', and `year' will |
636 |
|
match those numerical values, preceded by arbitrarily many zeros; they will |
637 |
|
also match `*'. |
638 |
|
|
639 |
The matching of the diary entries with the date forms is done with the |
The matching of the diary entries with the date forms is done with the |
640 |
standard syntax table from Fundamental mode, but with the `*' changed so |
standard syntax table from Fundamental mode, but with the `*' changed so |
1908 |
(list (format "%s %d" (calendar-month-name month) year)) ? 20) |
(list (format "%s %d" (calendar-month-name month) year)) ? 20) |
1909 |
indent t) |
indent t) |
1910 |
(calendar-insert-indented "" indent);; Go to proper spot |
(calendar-insert-indented "" indent);; Go to proper spot |
1911 |
|
;; Use the first two characters of each day to head the columns. |
1912 |
(calendar-for-loop i from 0 to 6 do |
(calendar-for-loop i from 0 to 6 do |
1913 |
(insert (calendar-day-name (mod (+ calendar-week-start-day i) 7) |
(insert |
1914 |
2 t)) |
(let ((string |
1915 |
(insert " ")) |
(calendar-day-name (mod (+ calendar-week-start-day i) 7) nil t))) |
1916 |
|
(if enable-multibyte-characters |
1917 |
|
(truncate-string-to-width string 2) |
1918 |
|
(substring string 0 2))) |
1919 |
|
" ")) |
1920 |
(calendar-insert-indented "" 0 t);; Force onto following line |
(calendar-insert-indented "" 0 t);; Force onto following line |
1921 |
(calendar-insert-indented "" indent);; Go to proper spot |
(calendar-insert-indented "" indent);; Go to proper spot |
1922 |
;; Add blank days before the first of the month |
;; Add blank days before the first of the month |
2517 |
(+ (* 12 (- yr2 yr1)) |
(+ (* 12 (- yr2 yr1)) |
2518 |
(- mon2 mon1))) |
(- mon2 mon1))) |
2519 |
|
|
2520 |
|
(defvar calendar-abbrev-length 3 |
2521 |
|
"*Length of abbreviations to be used for day and month names. |
2522 |
|
See also `calendar-day-abbrev-array' and `calendar-month-abbrev-array'.") |
2523 |
|
|
2524 |
(defvar calendar-day-name-array |
(defvar calendar-day-name-array |
2525 |
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] |
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"] |
2526 |
"Array of capitalized strings giving, in order, the day names.") |
"*Array of capitalized strings giving, in order, the day names. |
2527 |
|
The first two characters of each string will be used to head the |
2528 |
|
day columns in the calendar. See also the variable |
2529 |
|
`calendar-day-abbrev-array'.") |
2530 |
|
|
2531 |
|
(defvar calendar-day-abbrev-array |
2532 |
|
[nil nil nil nil nil nil nil] |
2533 |
|
"*Array of capitalized strings giving the abbreviated day names. |
2534 |
|
The order should be the same as that of the full names specified |
2535 |
|
in `calendar-day-name-array'. These abbreviations may be used |
2536 |
|
instead of the full names in the diary file. Do not include a |
2537 |
|
trailing `.' in the strings specified in this variable, though |
2538 |
|
you may use such in the diary file. If any element of this array |
2539 |
|
is nil, then the abbreviation will be constructed as the first |
2540 |
|
`calendar-abbrev-length' characters of the corresponding full name.") |
2541 |
|
|
2542 |
(defvar calendar-month-name-array |
(defvar calendar-month-name-array |
2543 |
["January" "February" "March" "April" "May" "June" |
["January" "February" "March" "April" "May" "June" |
2544 |
"July" "August" "September" "October" "November" "December"] |
"July" "August" "September" "October" "November" "December"] |
2545 |
"Array of capitalized strings giving, in order, the month names.") |
"*Array of capitalized strings giving, in order, the month names. |
2546 |
|
See also the variable `calendar-month-abbrev-array'.") |
2547 |
|
|
2548 |
|
(defvar calendar-month-abbrev-array |
2549 |
|
[nil nil nil nil nil nil nil nil nil nil nil nil] |
2550 |
|
"*Array of capitalized strings giving the abbreviated month names. |
2551 |
|
The order should be the same as that of the full names specified |
2552 |
|
in `calendar-month-name-array'. These abbreviations are used in |
2553 |
|
the calendar menu entries, and can also be used in the diary |
2554 |
|
file. Do not include a trailing `.' in the strings specified in |
2555 |
|
this variable, though you may use such in the diary file. If any |
2556 |
|
element of this array is nil, then the abbreviation will be |
2557 |
|
constructed as the first `calendar-abbrev-length' characters of the |
2558 |
|
corresponding full name.") |
2559 |
|
|
2560 |
|
(defun calendar-abbrev-construct (abbrev full &optional period) |
2561 |
|
"Internal calendar function to return a complete abbreviation array. |
2562 |
|
ABBREV is an array of abbreviations, FULL the corresponding array |
2563 |
|
of full names. The return value is the ABBREV array, with any nil |
2564 |
|
elements replaced by the first three characters taken from the |
2565 |
|
corresponding element of FULL. If optional argument PERIOD is non-nil, |
2566 |
|
each element returned has a final `.' character." |
2567 |
|
(let (elem array) |
2568 |
|
(dotimes (i (length full)) |
2569 |
|
(setq elem (or (aref abbrev i) |
2570 |
|
(substring (aref full i) 0 calendar-abbrev-length)) |
2571 |
|
elem (format "%s%s" elem (if period "." "")) |
2572 |
|
array (append array (list elem)))) |
2573 |
|
(vconcat array))) |
2574 |
|
|
2575 |
(defvar calendar-font-lock-keywords |
(defvar calendar-font-lock-keywords |
2576 |
`((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t) |
`((,(concat (regexp-opt (mapcar 'identity calendar-month-name-array) t) |
2581 |
(substring (aref calendar-day-name-array 0) 0 2))) |
(substring (aref calendar-day-name-array 0) 0 2))) |
2582 |
;; Saturdays and Sundays are hilited differently. |
;; Saturdays and Sundays are hilited differently. |
2583 |
. font-lock-comment-face) |
. font-lock-comment-face) |
2584 |
|
;; First two chars of each day are used in the calendar. |
2585 |
(,(regexp-opt (mapcar (lambda (x) (substring x 0 2)) calendar-day-name-array)) |
(,(regexp-opt (mapcar (lambda (x) (substring x 0 2)) calendar-day-name-array)) |
2586 |
. font-lock-reference-face)) |
. font-lock-reference-face)) |
2587 |
"Default keywords to highlight in Calendar mode.") |
"Default keywords to highlight in Calendar mode.") |
2588 |
|
|
2589 |
(defun calendar-day-name (date &optional width absolute) |
(defun calendar-day-name (date &optional abbrev absolute) |
2590 |
"Return a string with the name of the day of the week of DATE. |
"Return a string with the name of the day of the week of DATE. |
2591 |
If WIDTH is non-nil, return just the first WIDTH characters of the name. |
DATE should be a list in the format (MONTH DAY YEAR), unless the |
2592 |
If ABSOLUTE is non-nil, then DATE is actually the day-of-the-week |
optional argument ABSOLUTE is non-nil, in which case DATE should |
2593 |
rather than a date." |
be an integer in the range 0 to 6 corresponding to the day of the |
2594 |
(let ((string (aref calendar-day-name-array |
week. Day names are taken from the variable `calendar-day-name-array', |
2595 |
(if absolute date (calendar-day-of-week date))))) |
unless the optional argument ABBREV is non-nil, in which case |
2596 |
(cond ((null width) string) |
the variable `calendar-day-abbrev-array' is used." |
2597 |
(enable-multibyte-characters (truncate-string-to-width string width)) |
(aref (if abbrev |
2598 |
(t (substring string 0 width))))) |
(calendar-abbrev-construct calendar-day-abbrev-array |
2599 |
|
calendar-day-name-array) |
2600 |
|
calendar-day-name-array) |
2601 |
|
(if absolute date (calendar-day-of-week date)))) |
2602 |
|
|
2603 |
(defun calendar-make-alist (sequence &optional start-index filter) |
(defun calendar-make-alist (sequence &optional start-index filter abbrevs) |
2604 |
"Make an assoc list corresponding to SEQUENCE. |
"Make an assoc list corresponding to SEQUENCE. |
2605 |
Start at index 1, unless optional START-INDEX is provided. |
Each element of sequence will be associated with an integer, starting |
2606 |
If FILTER is provided, apply it to each item in the list." |
from 1, or from START-INDEX if that is non-nil. If a sequence ABBREVS |
2607 |
(let ((index (if start-index (1- start-index) 0))) |
is supplied, the function `calendar-abbrev-construct' is used to |
2608 |
(mapcar |
construct abbreviations corresponding to the elements in SEQUENCE. |
2609 |
(lambda (x) |
Each abbreviation is entered into the alist with the same |
2610 |
(setq index (1+ index)) |
association index as the full name it represents. |
2611 |
(cons (if filter (funcall filter x) x) |
If FILTER is provided, apply it to each key in the alist." |
2612 |
index)) |
(let ((index 0) |
2613 |
(append sequence nil)))) |
(offset (or start-index 1)) |
2614 |
|
(aseq (if abbrevs (calendar-abbrev-construct abbrevs sequence))) |
2615 |
(defun calendar-month-name (month &optional width) |
(aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence |
2616 |
"The name of MONTH. |
'period))) |
2617 |
If WIDTH is non-nil, return just the first WIDTH characters of the name." |
alist elem) |
2618 |
(let ((string (aref calendar-month-name-array (1- month)))) |
(dotimes (i (1- (length sequence)) (reverse alist)) |
2619 |
(if width |
(setq index (+ i offset) |
2620 |
(let ((i 0) (result "") (pos 0)) |
elem (elt sequence i) |
2621 |
(while (< i width) |
alist |
2622 |
(let ((chartext (char-to-string (aref string pos)))) |
(cons (cons (if filter (funcall filter elem) elem) index) alist)) |
2623 |
(setq pos (+ pos (length chartext))) |
(if aseq |
2624 |
(setq result (concat result chartext))) |
(setq elem (elt aseq i) |
2625 |
(setq i (1+ i))) |
alist (cons (cons (if filter (funcall filter elem) elem) |
2626 |
result) |
index) alist))) |
2627 |
string))) |
(if aseqp |
2628 |
|
(setq elem (elt aseqp i) |
2629 |
|
alist (cons (cons (if filter (funcall filter elem) elem) |
2630 |
|
index) alist)))))) |
2631 |
|
|
2632 |
|
(defun calendar-month-name (month &optional abbrev) |
2633 |
|
"Return a string with the name of month number MONTH. |
2634 |
|
Months are numbered from one. Month names are taken from the |
2635 |
|
variable `calendar-month-name-array', unless the optional |
2636 |
|
argument ABBREV is non-nil, in which case |
2637 |
|
`calendar-month-abbrev-array' is used." |
2638 |
|
(aref (if abbrev |
2639 |
|
(calendar-abbrev-construct calendar-month-abbrev-array |
2640 |
|
calendar-month-name-array) |
2641 |
|
calendar-month-name-array) |
2642 |
|
(1- month))) |
2643 |
|
|
2644 |
(defun calendar-day-of-week (date) |
(defun calendar-day-of-week (date) |
2645 |
"Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc." |
"Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc." |
2750 |
|
|
2751 |
(defun calendar-date-string (date &optional abbreviate nodayname) |
(defun calendar-date-string (date &optional abbreviate nodayname) |
2752 |
"A string form of DATE, driven by the variable `calendar-date-display-form'. |
"A string form of DATE, driven by the variable `calendar-date-display-form'. |
2753 |
An optional parameter ABBREVIATE, when t, causes the month and day names to be |
An optional parameter ABBREVIATE, when non-nil, causes the month |
2754 |
abbreviated to three characters. An optional parameter NODAYNAME, when t, |
and day names to be abbreviated as specified by |
2755 |
omits the name of the day of the week." |
`calendar-month-abbrev-array' and `calendar-day-abbrev-array', |
2756 |
|
respectively. An optional parameter NODAYNAME, when t, omits the |
2757 |
|
name of the day of the week." |
2758 |
(let* ((dayname |
(let* ((dayname |
2759 |
(if nodayname |
(unless nodayname |
2760 |
nil |
(calendar-day-name date abbreviate))) |
|
(if abbreviate |
|
|
(calendar-day-name date 3) |
|
|
(calendar-day-name date)))) |
|
2761 |
(month (extract-calendar-month date)) |
(month (extract-calendar-month date)) |
2762 |
(monthname |
(monthname (calendar-month-name month abbreviate)) |
|
(if abbreviate |
|
|
(calendar-month-name month 3) |
|
|
(calendar-month-name month))) |
|
2763 |
(day (int-to-string (extract-calendar-day date))) |
(day (int-to-string (extract-calendar-day date))) |
2764 |
(month (int-to-string month)) |
(month (int-to-string month)) |
2765 |
(year (int-to-string (extract-calendar-year date)))) |
(year (int-to-string (extract-calendar-year date)))) |