aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1993-10-20 05:49:24 +0000
committerRichard M. Stallman1993-10-20 05:49:24 +0000
commitd8a200a762c58e874171983fd684093cac7abc69 (patch)
treec1bf480293c6d0bce6295d50db60285ea6243273
parentdefa77b5a6eba3d57008d97a01cf757a7ddca55c (diff)
downloademacs-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.el116
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.
1060 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.
106The diary is displayed in another window when the calendar is first displayed, 111The 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
1320is currently located, but indented INDENT spaces. The indentation is done 1325is currently located, but indented INDENT spaces. The indentation is done
1321from the first character on the line and does not disturb the first INDENT 1326from the first character on the line and does not disturb the first INDENT
1322characters on the line." 1327characters 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