emacs: lisp/calendar/calendar.el comparison

comparison lisp/calendar/calendar.el @ 4861:924486090b27

(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.

author	Richard M. Stallman <rms@gnu.org>
date	Wed, 20 Oct 1993 05:49:24 +0000
parents	a34bd3ee36ef
children	bf77303bd714

comparison

equal deleted inserted replaced

-:ff23fe23f58c
+:924486090b27
 ;; Keywords: calendar
 ;; Human-Keywords: calendar, Gregorian calendar, Julian calendar,
 ;;	Hebrew calendar, Islamic calendar, ISO calendar, Julian day number,
 ;;	diary, holidays
-(defconst calendar-version "Version 5.1, released June 18, 1993")
+(defconst calendar-version "Version 5.2, released October 20, 1993")
 ;; This file is part of GNU Emacs.
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY.  No author or distributor
 ;; Hard copies of these two papers can be obtained by sending email to
 ;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
 ;; the message BODY containing your mailing address (snail).
 ;;; Code:
+;;;###autoload
+(defvar calendar-week-start-day 0
+"*The day of the week on which a week in the calendar begins.
+0 means Sunday (default), 1 means Monday, and so on.")
 ;;;###autoload
 (defvar view-diary-entries-initially nil
 "*If t, the diary entries for the current date will be displayed on entry.
 The diary is displayed in another window when the calendar is first displayed,
 "Produce a calendar for MONTH, YEAR on the Gregorian calendar.
 The calendar is inserted in the buffer starting at the line on which point
 is currently located, but indented INDENT spaces.  The indentation is done
 from the first character on the line and does not disturb the first INDENT
 characters on the line."
-(let* ((first-day-of-month (calendar-day-of-week (list month 1 year)))
+(let* ((blank-days;; at start of month
-(first-saturday (- 7 first-day-of-month))
+(calendar-mod
-(last (calendar-last-day-of-month month year))
+(- (calendar-day-of-week (list month 1 year))
-(heading (format "%s %d" (calendar-month-name month) year)))
+calendar-week-start-day)
-(goto-char (point-min))
+7))
-(calendar-insert-indented
+	 (last (calendar-last-day-of-month month year)))
-heading (+ indent (/ (- 20 (length heading)) 2)) t)
+(goto-char (point-min))
-(calendar-insert-indented " S  M Tu  W Th  F  S" indent t)
+(calendar-insert-indented
-(calendar-insert-indented "" indent);; Move to appropriate spot on line
+(calendar-string-spread
-;; Add blank days before the first of the month
+(list "" (format "%s %d" (calendar-month-name month) year) "") ?  20)
-(calendar-for-loop i from 1 to first-day-of-month do
+indent t)
-(insert "   "))
+(calendar-insert-indented "" indent);; Go to proper spot
-;; Put in the days of the month
+(calendar-for-loop i from 0 to 6 do
-(calendar-for-loop i from 1 to last do
+(insert (substring (aref calendar-day-name-array
-(insert (format "%2d " i))
+(calendar-mod (+ calendar-week-start-day i) 7))
-(and (= (% i 7) (% first-saturday 7))
+0 2))
-(/= i last)
+(insert " "))
-(calendar-insert-indented "" 0 t)    ;; Force onto following line
+(calendar-insert-indented "" 0 t);; Force onto following line
-(calendar-insert-indented "" indent)))));; Go to proper spot
+(calendar-insert-indented "" indent);; Go to proper spot
+;; Add blank days before the first of the month
+(calendar-for-loop i from 1 to blank-days do (insert "   "))
+;; Put in the days of the month
+(calendar-for-loop i from 1 to last do
+(insert (format "%2d " i))
+(and (zerop (calendar-mod (+ i blank-days) 7))
+(/= i last)
+(calendar-insert-indented "" 0 t)    ;; Force onto following line
+(calendar-insert-indented "" indent)))));; Go to proper spot
 (defun calendar-insert-indented (string indent &optional newline)
 "Insert STRING at column INDENT.
 If the optional parameter NEWLINE is t, leave point at start of next line,
 inserting a newline if there was no next line; otherwise, leave point after
 Moves forward if ARG is negative."
 (interactive "p")
 (calendar-forward-day (* arg -7)))
 (defun calendar-beginning-of-week (arg)
-"Move the cursor back ARG Sundays."
+"Move the cursor back ARG calendar-week-start-day's."
 (interactive "p")
 (calendar-cursor-to-nearest-date)
 (let ((day (calendar-day-of-week (calendar-cursor-to-date))))
 (calendar-backward-day
-(if (= day 0) (* 7 arg) (+ day (* 7 (1- arg)))))))
+(if (= day calendar-week-start-day)
+(* 7 arg)
+(+ (calendar-mod (- day calendar-week-start-day) 7)
+(* 7 (1- arg)))))))
 (defun calendar-end-of-week (arg)
-"Move the cursor forward ARG Saturdays."
+"Move the cursor forward ARG calendar-week-start-day+6's."
 (interactive "p")
 (calendar-cursor-to-nearest-date)
 (let ((day (calendar-day-of-week (calendar-cursor-to-date))))
 (calendar-forward-day
-(if (= day 6) (* 7 arg) (+ (- 6 day) (* 7 (1- arg)))))))
+(if (= day (calendar-mod (1- calendar-week-start-day) 7))
+(* 7 arg)
+(+ (- 6 (calendar-mod (- day calendar-week-start-day) 7))
+(* 7 (1- arg)))))))
 (defun calendar-beginning-of-month (arg)
 "Move the cursor backward ARG month beginnings."
 (interactive "p")
 (calendar-cursor-to-nearest-date)
 (and (< mdays day)
 (setq day (- day mdays))))
 (setq month (1+ month)))
 (list month day year)))))
+(defun calendar-mod (x y)
+"Returns X % Y; value is *always* non-negative."
+(let ((v (mod x y)))
+(if (> 0 v)
+	(+ v y)
+v)))
 (defun calendar-cursor-to-visible-date (date)
 "Move the cursor to DATE that is on the screen."
-(let ((month (extract-calendar-month date))
+(let* ((month (extract-calendar-month date))
-(day (extract-calendar-day date))
+	 (day (extract-calendar-day date))
-(year (extract-calendar-year date)))
+	 (year (extract-calendar-year date))
-(goto-line (+ 3
+	 (first-of-month-weekday (calendar-day-of-week (list month 1 year))))
-(/ (+ day -1
+(goto-line (+ 3
-(calendar-day-of-week (list month 1 year)))
+		  (/ (+ day  -1
-7)))
+(calendar-mod
-(move-to-column (+ 6
+(- (calendar-day-of-week (list month 1 year))
-(* 25
+calendar-week-start-day)
-(1+ (calendar-interval
+7))
-displayed-month displayed-year month year)))
+7)))
-(* 3 (calendar-day-of-week date))))))
+(move-to-column (+ 6
+		       (* 25
+			  (1+ (calendar-interval
+			       displayed-month displayed-year month year)))
+		       (* 3 (calendar-mod
+(- (calendar-day-of-week date)
+calendar-week-start-day)
+7))))))
 (defun calendar-other-month (month year)
 "Display a three-month calendar centered around MONTH and YEAR."
 (interactive
 (let* ((completion-ignore-case t)
 (defun calendar-day-name (date)
 "Returns a string with the name of the day of the week of DATE."
 (aref calendar-day-name-array (calendar-day-of-week date)))
-(defconst calendar-day-name-array
+(defvar calendar-day-name-array
 ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"])
-(defconst calendar-month-name-array
+(defvar calendar-month-name-array
 ["January" "February" "March"     "April"   "May"      "June"
 "July"    "August"   "September" "October" "November" "December"])
 (defun calendar-make-alist (sequence &optional start-index filter)
 "Make an assoc list corresponding to SEQUENCE.
 (day            ;; Calculate the day by subtraction.
 (- date
 (1- (calendar-absolute-from-islamic (list month 1 year))))))
 (list month day year))))
-(defconst calendar-islamic-month-name-array
+(defvar calendar-islamic-month-name-array
 ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
 "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"])
 (defun calendar-print-islamic-date ()
 "Show the Islamic calendar equivalent of the date under the cursor."
 m 7 (< m month)
 (hebrew-calendar-last-day-of-month m year)))
 (hebrew-calendar-elapsed-days year);; Days in prior years.
 -1373429)))                        ;; Days elapsed before absolute date 1.
-(defconst calendar-hebrew-month-name-array-common-year
+(defvar calendar-hebrew-month-name-array-common-year
 ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"])
-(defconst calendar-hebrew-month-name-array-leap-year
+(defvar calendar-hebrew-month-name-array-leap-year
 ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
 "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
 (defun calendar-print-hebrew-date ()
 "Show the Hebrew calendar equivalent of the date under the cursor."

Mercurial > emacs

comparison lisp/calendar/calendar.el @ 4861:924486090b27