Mercurial > emacs
comparison lisp/calendar/calendar.el @ 54128:520476f3222d
*** empty log message ***
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Mon, 23 Feb 2004 00:11:12 +0000 |
parents | 8089fbb082b9 |
children | 934d92d8b496 |
comparison
equal
deleted
inserted
replaced
54127:35aa728a0635 | 54128:520476f3222d |
---|---|
1922 (if today-visible | 1922 (if today-visible |
1923 (run-hooks 'today-visible-calendar-hook) | 1923 (run-hooks 'today-visible-calendar-hook) |
1924 (run-hooks 'today-invisible-calendar-hook))))) | 1924 (run-hooks 'today-invisible-calendar-hook))))) |
1925 | 1925 |
1926 (defun generate-calendar (month year) | 1926 (defun generate-calendar (month year) |
1927 "Generate a three-month Gregorian calendar centered around MONTH, YEAR. | 1927 "Generate a three-month Gregorian calendar centered around MONTH, YEAR." |
1928 A negative YEAR is interpreted as BC; -1 being 1 BC, and so on. | 1928 ;;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on. |
1929 Note that while calendars can be displayed for years BC, some functions (eg | 1929 ;;; Note that while calendars for years BC could be displayed as it |
1930 motion, complex holiday functions) will not work correctly for such dates." | 1930 ;;; stands, almost all other calendar functions (eg holidays) would |
1931 (setq displayed-month month) | 1931 ;;; at best have unpredictable results for such dates. |
1932 (setq displayed-year year) | 1932 (if (< (+ month (* 12 (1- year))) 2) |
1933 (error "Months before February, 1 AD are not available")) | |
1934 (setq displayed-month month | |
1935 displayed-year year) | |
1933 (erase-buffer) | 1936 (erase-buffer) |
1934 (increment-calendar-month month year -1) | 1937 (increment-calendar-month month year -1) |
1935 (calendar-for-loop i from 0 to 2 do | 1938 (calendar-for-loop i from 0 to 2 do |
1936 (generate-calendar-month month year (+ 5 (* 25 i))) | 1939 (generate-calendar-month month year (+ 5 (* 25 i))) |
1937 (increment-calendar-month month year 1))) | 1940 (increment-calendar-month month year 1))) |
1939 (defun generate-calendar-month (month year indent) | 1942 (defun generate-calendar-month (month year indent) |
1940 "Produce a calendar for MONTH, YEAR on the Gregorian calendar. | 1943 "Produce a calendar for MONTH, YEAR on the Gregorian calendar. |
1941 The calendar is inserted at the top of the buffer in which point is currently | 1944 The calendar is inserted at the top of the buffer in which point is currently |
1942 located, but indented INDENT spaces. The indentation is done from the first | 1945 located, but indented INDENT spaces. The indentation is done from the first |
1943 character on the line and does not disturb the first INDENT characters on the | 1946 character on the line and does not disturb the first INDENT characters on the |
1944 line. A negative YEAR is interpreted as BC; -1 being 1 BC, and so on." | 1947 line." |
1945 (let* ((blank-days;; at start of month | 1948 (let* ((blank-days;; at start of month |
1946 (mod | 1949 (mod |
1947 (- (calendar-day-of-week (list month 1 year)) | 1950 (- (calendar-day-of-week (list month 1 year)) |
1948 calendar-week-start-day) | 1951 calendar-week-start-day) |
1949 7)) | 1952 7)) |
2536 "Prompt for Gregorian date. Return a list (month day year). | 2539 "Prompt for Gregorian date. Return a list (month day year). |
2537 If optional NODAY is t, does not ask for day, but just returns | 2540 If optional NODAY is t, does not ask for day, but just returns |
2538 \(month nil year); if NODAY is any other non-nil value the value returned is | 2541 \(month nil year); if NODAY is any other non-nil value the value returned is |
2539 \(month year)" | 2542 \(month year)" |
2540 (let* ((year (calendar-read | 2543 (let* ((year (calendar-read |
2541 "Year: " | 2544 "Year (>0): " |
2542 (lambda (x) (not (zerop x))) | 2545 (lambda (x) (> x 0)) |
2543 (int-to-string (extract-calendar-year | 2546 (int-to-string (extract-calendar-year |
2544 (calendar-current-date))))) | 2547 (calendar-current-date))))) |
2545 (month-array calendar-month-name-array) | 2548 (month-array calendar-month-name-array) |
2546 (completion-ignore-case t) | 2549 (completion-ignore-case t) |
2547 (month (cdr (assoc-string | 2550 (month (cdr (assoc-string |