diff options
| author | Richard M. Stallman | 1993-10-20 05:49:24 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1993-10-20 05:49:24 +0000 |
| commit | d8a200a762c58e874171983fd684093cac7abc69 (patch) | |
| tree | c1bf480293c6d0bce6295d50db60285ea6243273 | |
| parent | defa77b5a6eba3d57008d97a01cf757a7ddca55c (diff) | |
| download | emacs-d8a200a762c58e874171983fd684093cac7abc69.tar.gz emacs-d8a200a762c58e874171983fd684093cac7abc69.zip | |
(calendar-week-start-day): New var (autoloaded) to
allow the calendar week to start on any day, not just Sunday.
(calendar-mod): New support function.
(calendar-cursor-to-visible-date, generate-calendar-month,
calendar-beginning-of-week, calendar-end-of-week):
Use new var calendar-week-start-day.
(calendar-day-name-array, calendar-month-name-array,
calendar-islamic-month-name-array,
calendar-hebrew-month-name-array-common-year,
calendar-hebrew-month-name-array-leap-year): Change to defvar.
| -rw-r--r-- | lisp/calendar/calendar.el | 116 |
1 files changed, 75 insertions, 41 deletions
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 906def77f90..a1b112252e1 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el | |||
| @@ -8,7 +8,7 @@ | |||
| 8 | ;; Hebrew calendar, Islamic calendar, ISO calendar, Julian day number, | 8 | ;; Hebrew calendar, Islamic calendar, ISO calendar, Julian day number, |
| 9 | ;; diary, holidays | 9 | ;; diary, holidays |
| 10 | 10 | ||
| 11 | (defconst calendar-version "Version 5.1, released June 18, 1993") | 11 | (defconst calendar-version "Version 5.2, released October 20, 1993") |
| 12 | 12 | ||
| 13 | ;; This file is part of GNU Emacs. | 13 | ;; This file is part of GNU Emacs. |
| 14 | 14 | ||
| @@ -101,6 +101,11 @@ | |||
| 101 | ;;; Code: | 101 | ;;; Code: |
| 102 | 102 | ||
| 103 | ;;;###autoload | 103 | ;;;###autoload |
| 104 | (defvar calendar-week-start-day 0 | ||
| 105 | "*The day of the week on which a week in the calendar begins. | ||
| 106 | 0 means Sunday (default), 1 means Monday, and so on.") | ||
| 107 | |||
| 108 | ;;;###autoload | ||
| 104 | (defvar view-diary-entries-initially nil | 109 | (defvar view-diary-entries-initially nil |
| 105 | "*If t, the diary entries for the current date will be displayed on entry. | 110 | "*If t, the diary entries for the current date will be displayed on entry. |
| 106 | The diary is displayed in another window when the calendar is first displayed, | 111 | The diary is displayed in another window when the calendar is first displayed, |
| @@ -1320,25 +1325,34 @@ The calendar is inserted in the buffer starting at the line on which point | |||
| 1320 | is currently located, but indented INDENT spaces. The indentation is done | 1325 | is currently located, but indented INDENT spaces. The indentation is done |
| 1321 | from the first character on the line and does not disturb the first INDENT | 1326 | from the first character on the line and does not disturb the first INDENT |
| 1322 | characters on the line." | 1327 | characters on the line." |
| 1323 | (let* ((first-day-of-month (calendar-day-of-week (list month 1 year))) | 1328 | (let* ((blank-days;; at start of month |
| 1324 | (first-saturday (- 7 first-day-of-month)) | 1329 | (calendar-mod |
| 1325 | (last (calendar-last-day-of-month month year)) | 1330 | (- (calendar-day-of-week (list month 1 year)) |
| 1326 | (heading (format "%s %d" (calendar-month-name month) year))) | 1331 | calendar-week-start-day) |
| 1327 | (goto-char (point-min)) | 1332 | 7)) |
| 1328 | (calendar-insert-indented | 1333 | (last (calendar-last-day-of-month month year))) |
| 1329 | heading (+ indent (/ (- 20 (length heading)) 2)) t) | 1334 | (goto-char (point-min)) |
| 1330 | (calendar-insert-indented " S M Tu W Th F S" indent t) | 1335 | (calendar-insert-indented |
| 1331 | (calendar-insert-indented "" indent);; Move to appropriate spot on line | 1336 | (calendar-string-spread |
| 1332 | ;; Add blank days before the first of the month | 1337 | (list "" (format "%s %d" (calendar-month-name month) year) "") ? 20) |
| 1333 | (calendar-for-loop i from 1 to first-day-of-month do | 1338 | indent t) |
| 1334 | (insert " ")) | 1339 | (calendar-insert-indented "" indent);; Go to proper spot |
| 1335 | ;; Put in the days of the month | 1340 | (calendar-for-loop i from 0 to 6 do |
| 1336 | (calendar-for-loop i from 1 to last do | 1341 | (insert (substring (aref calendar-day-name-array |
| 1337 | (insert (format "%2d " i)) | 1342 | (calendar-mod (+ calendar-week-start-day i) 7)) |
| 1338 | (and (= (% i 7) (% first-saturday 7)) | 1343 | 0 2)) |
| 1339 | (/= i last) | 1344 | (insert " ")) |
| 1340 | (calendar-insert-indented "" 0 t) ;; Force onto following line | 1345 | (calendar-insert-indented "" 0 t);; Force onto following line |
| 1341 | (calendar-insert-indented "" indent)))));; Go to proper spot | 1346 | (calendar-insert-indented "" indent);; Go to proper spot |
| 1347 | ;; Add blank days before the first of the month | ||
| 1348 | (calendar-for-loop i from 1 to blank-days do (insert " ")) | ||
| 1349 | ;; Put in the days of the month | ||
| 1350 | (calendar-for-loop i from 1 to last do | ||
| 1351 | (insert (format "%2d " i)) | ||
| 1352 | (and (zerop (calendar-mod (+ i blank-days) 7)) | ||
| 1353 | (/= i last) | ||
| 1354 | (calendar-insert-indented "" 0 t) ;; Force onto following line | ||
| 1355 | (calendar-insert-indented "" indent)))));; Go to proper spot | ||
| 1342 | 1356 | ||
| 1343 | (defun calendar-insert-indented (string indent &optional newline) | 1357 | (defun calendar-insert-indented (string indent &optional newline) |
| 1344 | "Insert STRING at column INDENT. | 1358 | "Insert STRING at column INDENT. |
| @@ -1973,20 +1987,26 @@ Moves forward if ARG is negative." | |||
| 1973 | (calendar-forward-day (* arg -7))) | 1987 | (calendar-forward-day (* arg -7))) |
| 1974 | 1988 | ||
| 1975 | (defun calendar-beginning-of-week (arg) | 1989 | (defun calendar-beginning-of-week (arg) |
| 1976 | "Move the cursor back ARG Sundays." | 1990 | "Move the cursor back ARG calendar-week-start-day's." |
| 1977 | (interactive "p") | 1991 | (interactive "p") |
| 1978 | (calendar-cursor-to-nearest-date) | 1992 | (calendar-cursor-to-nearest-date) |
| 1979 | (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) | 1993 | (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) |
| 1980 | (calendar-backward-day | 1994 | (calendar-backward-day |
| 1981 | (if (= day 0) (* 7 arg) (+ day (* 7 (1- arg))))))) | 1995 | (if (= day calendar-week-start-day) |
| 1996 | (* 7 arg) | ||
| 1997 | (+ (calendar-mod (- day calendar-week-start-day) 7) | ||
| 1998 | (* 7 (1- arg))))))) | ||
| 1982 | 1999 | ||
| 1983 | (defun calendar-end-of-week (arg) | 2000 | (defun calendar-end-of-week (arg) |
| 1984 | "Move the cursor forward ARG Saturdays." | 2001 | "Move the cursor forward ARG calendar-week-start-day+6's." |
| 1985 | (interactive "p") | 2002 | (interactive "p") |
| 1986 | (calendar-cursor-to-nearest-date) | 2003 | (calendar-cursor-to-nearest-date) |
| 1987 | (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) | 2004 | (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) |
| 1988 | (calendar-forward-day | 2005 | (calendar-forward-day |
| 1989 | (if (= day 6) (* 7 arg) (+ (- 6 day) (* 7 (1- arg))))))) | 2006 | (if (= day (calendar-mod (1- calendar-week-start-day) 7)) |
| 2007 | (* 7 arg) | ||
| 2008 | (+ (- 6 (calendar-mod (- day calendar-week-start-day) 7)) | ||
| 2009 | (* 7 (1- arg))))))) | ||
| 1990 | 2010 | ||
| 1991 | (defun calendar-beginning-of-month (arg) | 2011 | (defun calendar-beginning-of-month (arg) |
| 1992 | "Move the cursor backward ARG month beginnings." | 2012 | "Move the cursor backward ARG month beginnings." |
| @@ -2108,20 +2128,34 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 2108 | (setq month (1+ month))) | 2128 | (setq month (1+ month))) |
| 2109 | (list month day year))))) | 2129 | (list month day year))))) |
| 2110 | 2130 | ||
| 2131 | (defun calendar-mod (x y) | ||
| 2132 | "Returns X % Y; value is *always* non-negative." | ||
| 2133 | (let ((v (mod x y))) | ||
| 2134 | (if (> 0 v) | ||
| 2135 | (+ v y) | ||
| 2136 | v))) | ||
| 2137 | |||
| 2111 | (defun calendar-cursor-to-visible-date (date) | 2138 | (defun calendar-cursor-to-visible-date (date) |
| 2112 | "Move the cursor to DATE that is on the screen." | 2139 | "Move the cursor to DATE that is on the screen." |
| 2113 | (let ((month (extract-calendar-month date)) | 2140 | (let* ((month (extract-calendar-month date)) |
| 2114 | (day (extract-calendar-day date)) | 2141 | (day (extract-calendar-day date)) |
| 2115 | (year (extract-calendar-year date))) | 2142 | (year (extract-calendar-year date)) |
| 2116 | (goto-line (+ 3 | 2143 | (first-of-month-weekday (calendar-day-of-week (list month 1 year)))) |
| 2117 | (/ (+ day -1 | 2144 | (goto-line (+ 3 |
| 2118 | (calendar-day-of-week (list month 1 year))) | 2145 | (/ (+ day -1 |
| 2119 | 7))) | 2146 | (calendar-mod |
| 2120 | (move-to-column (+ 6 | 2147 | (- (calendar-day-of-week (list month 1 year)) |
| 2121 | (* 25 | 2148 | calendar-week-start-day) |
| 2122 | (1+ (calendar-interval | 2149 | 7)) |
| 2123 | displayed-month displayed-year month year))) | 2150 | 7))) |
| 2124 | (* 3 (calendar-day-of-week date)))))) | 2151 | (move-to-column (+ 6 |
| 2152 | (* 25 | ||
| 2153 | (1+ (calendar-interval | ||
| 2154 | displayed-month displayed-year month year))) | ||
| 2155 | (* 3 (calendar-mod | ||
| 2156 | (- (calendar-day-of-week date) | ||
| 2157 | calendar-week-start-day) | ||
| 2158 | 7)))))) | ||
| 2125 | 2159 | ||
| 2126 | (defun calendar-other-month (month year) | 2160 | (defun calendar-other-month (month year) |
| 2127 | "Display a three-month calendar centered around MONTH and YEAR." | 2161 | "Display a three-month calendar centered around MONTH and YEAR." |
| @@ -2396,10 +2430,10 @@ is a string to insert in the minibuffer before reading." | |||
| 2396 | "Returns a string with the name of the day of the week of DATE." | 2430 | "Returns a string with the name of the day of the week of DATE." |
| 2397 | (aref calendar-day-name-array (calendar-day-of-week date))) | 2431 | (aref calendar-day-name-array (calendar-day-of-week date))) |
| 2398 | 2432 | ||
| 2399 | (defconst calendar-day-name-array | 2433 | (defvar calendar-day-name-array |
| 2400 | ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]) | 2434 | ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]) |
| 2401 | 2435 | ||
| 2402 | (defconst calendar-month-name-array | 2436 | (defvar calendar-month-name-array |
| 2403 | ["January" "February" "March" "April" "May" "June" | 2437 | ["January" "February" "March" "April" "May" "June" |
| 2404 | "July" "August" "September" "October" "November" "December"]) | 2438 | "July" "August" "September" "October" "November" "December"]) |
| 2405 | 2439 | ||
| @@ -2761,7 +2795,7 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 2761 | (1- (calendar-absolute-from-islamic (list month 1 year)))))) | 2795 | (1- (calendar-absolute-from-islamic (list month 1 year)))))) |
| 2762 | (list month day year)))) | 2796 | (list month day year)))) |
| 2763 | 2797 | ||
| 2764 | (defconst calendar-islamic-month-name-array | 2798 | (defvar calendar-islamic-month-name-array |
| 2765 | ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II" | 2799 | ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II" |
| 2766 | "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"]) | 2800 | "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"]) |
| 2767 | 2801 | ||
| @@ -2891,11 +2925,11 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 2891 | (hebrew-calendar-elapsed-days year);; Days in prior years. | 2925 | (hebrew-calendar-elapsed-days year);; Days in prior years. |
| 2892 | -1373429))) ;; Days elapsed before absolute date 1. | 2926 | -1373429))) ;; Days elapsed before absolute date 1. |
| 2893 | 2927 | ||
| 2894 | (defconst calendar-hebrew-month-name-array-common-year | 2928 | (defvar calendar-hebrew-month-name-array-common-year |
| 2895 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" | 2929 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" |
| 2896 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"]) | 2930 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"]) |
| 2897 | 2931 | ||
| 2898 | (defconst calendar-hebrew-month-name-array-leap-year | 2932 | (defvar calendar-hebrew-month-name-array-leap-year |
| 2899 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" | 2933 | ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri" |
| 2900 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"]) | 2934 | "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"]) |
| 2901 | 2935 | ||