Commit | Line | Data |
---|---|---|
3afbc435 | 1 | ;;; cal-iso.el --- calendar functions for the ISO calendar |
0808d911 | 2 | |
c9549281 GM |
3 | ;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
4 | ;; 2008 Free Software Foundation, Inc. | |
0808d911 ER |
5 | |
6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
aff88519 | 7 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
0808d911 ER |
8 | ;; Keywords: calendar |
9 | ;; Human-Keywords: ISO calendar, calendar, diary | |
10 | ||
11 | ;; This file is part of GNU Emacs. | |
12 | ||
13 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
14 | ;; it under the terms of the GNU General Public License as published by | |
075969b4 | 15 | ;; the Free Software Foundation; either version 3, or (at your option) |
0808d911 ER |
16 | ;; any later version. |
17 | ||
18 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
b578f267 | 24 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
26 | ;; Boston, MA 02110-1301, USA. | |
0808d911 ER |
27 | |
28 | ;;; Commentary: | |
29 | ||
30 | ;; This collection of functions implements the features of calendar.el and | |
31 | ;; diary.el that deal with the ISO calendar. | |
32 | ||
a96a5fca | 33 | ;; Technical details of all the calendrical calculations can be found in |
fffaba77 PE |
34 | ;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold |
35 | ;; and Nachum Dershowitz, Cambridge University Press (2001). | |
a96a5fca | 36 | |
0808d911 ER |
37 | ;;; Code: |
38 | ||
39 | (require 'calendar) | |
40 | ||
41 | (defun calendar-absolute-from-iso (date) | |
42 | "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. | |
43 | The `ISO year' corresponds approximately to the Gregorian year, but | |
44 | weeks start on Monday and end on Sunday. The first week of the ISO year is | |
45 | the first such week in which at least 4 days are in a year. The ISO | |
46 | commercial DATE has the form (week day year) in which week is in the range | |
47 | 1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = | |
48 | Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary." | |
8ab36f55 | 49 | (let ((day (extract-calendar-day date))) |
0808d911 | 50 | (+ (calendar-dayname-on-or-before |
8ab36f55 GM |
51 | 1 (+ 3 (calendar-absolute-from-gregorian |
52 | (list 1 1 (extract-calendar-year date))))) | |
53 | ;; ISO date is (week day year); normally (month day year). | |
54 | (* 7 (1- (extract-calendar-month date))) | |
d383fd97 | 55 | (if (zerop day) 6 (1- day))))) |
0808d911 ER |
56 | |
57 | (defun calendar-iso-from-absolute (date) | |
58 | "Compute the `ISO commercial date' corresponding to the absolute DATE. | |
59 | The ISO year corresponds approximately to the Gregorian year, but weeks | |
60 | start on Monday and end on Sunday. The first week of the ISO year is the | |
61 | first such week in which at least 4 days are in a year. The ISO commercial | |
62 | date has the form (week day year) in which week is in the range 1..52 and | |
63 | day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = Sunday). The | |
64 | absolute date is the number of days elapsed since the (imaginary) Gregorian | |
65 | date Sunday, December 31, 1 BC." | |
66 | (let* ((approx (extract-calendar-year | |
67 | (calendar-gregorian-from-absolute (- date 3)))) | |
68 | (year (+ approx | |
69 | (calendar-sum y approx | |
70 | (>= date (calendar-absolute-from-iso (list 1 1 (1+ y)))) | |
71 | 1)))) | |
72 | (list | |
73 | (1+ (/ (- date (calendar-absolute-from-iso (list 1 1 year))) 7)) | |
74 | (% date 7) | |
75 | year))) | |
76 | ||
9e85002d | 77 | ;;;###cal-autoload |
0808d911 | 78 | (defun calendar-iso-date-string (&optional date) |
8ab36f55 | 79 | "String of ISO date of Gregorian DATE, default today." |
a1506d29 | 80 | (let* ((d (calendar-absolute-from-gregorian |
0808d911 ER |
81 | (or date (calendar-current-date)))) |
82 | (day (% d 7)) | |
83 | (iso-date (calendar-iso-from-absolute d))) | |
84 | (format "Day %s of week %d of %d" | |
85 | (if (zerop day) 7 day) | |
86 | (extract-calendar-month iso-date) | |
87 | (extract-calendar-year iso-date)))) | |
88 | ||
9e85002d | 89 | ;;;###cal-autoload |
0808d911 ER |
90 | (defun calendar-print-iso-date () |
91 | "Show equivalent ISO date for the date under the cursor." | |
92 | (interactive) | |
93 | (message "ISO date: %s" | |
94 | (calendar-iso-date-string (calendar-cursor-to-date t)))) | |
95 | ||
b76a84cd | 96 | (defun calendar-iso-read-args (&optional dayflag) |
8ab36f55 | 97 | "Interactively read the arguments for an ISO date command. |
46d69a52 GM |
98 | Reads a year and week, and if DAYFLAG is non-nil a day (otherwise |
99 | taken to be 1)." | |
8ab36f55 | 100 | (let* ((year (calendar-read |
b76a84cd | 101 | "ISO calendar year (>0): " |
d383fd97 | 102 | (lambda (x) (> x 0)) |
8ab36f55 GM |
103 | (int-to-string (extract-calendar-year |
104 | (calendar-current-date))))) | |
b76a84cd GM |
105 | (no-weeks (extract-calendar-month |
106 | (calendar-iso-from-absolute | |
107 | (1- | |
108 | (calendar-dayname-on-or-before | |
109 | 1 (calendar-absolute-from-gregorian | |
110 | (list 1 4 (1+ year)))))))) | |
111 | (week (calendar-read | |
112 | (format "ISO calendar week (1-%d): " no-weeks) | |
d383fd97 | 113 | (lambda (x) (and (> x 0) (<= x no-weeks))))) |
b76a84cd GM |
114 | (day (if dayflag (calendar-read |
115 | "ISO day (1-7): " | |
d383fd97 | 116 | (lambda (x) (and (<= 1 x) (<= x 7)))) |
b76a84cd GM |
117 | 1))) |
118 | (list (list week day year)))) | |
119 | ||
9e85002d | 120 | ;;;###cal-autoload |
0808d911 | 121 | (defun calendar-goto-iso-date (date &optional noecho) |
8ab36f55 | 122 | "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil." |
b76a84cd GM |
123 | (interactive (calendar-iso-read-args t)) |
124 | (calendar-goto-date (calendar-gregorian-from-absolute | |
125 | (calendar-absolute-from-iso date))) | |
126 | (or noecho (calendar-print-iso-date))) | |
127 | ||
9e85002d | 128 | ;;;###cal-autoload |
b76a84cd | 129 | (defun calendar-goto-iso-week (date &optional noecho) |
8ab36f55 | 130 | "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil. |
b76a84cd GM |
131 | Interactively, goes to the first day of the specified week." |
132 | (interactive (calendar-iso-read-args)) | |
0808d911 ER |
133 | (calendar-goto-date (calendar-gregorian-from-absolute |
134 | (calendar-absolute-from-iso date))) | |
135 | (or noecho (calendar-print-iso-date))) | |
136 | ||
d383fd97 GM |
137 | (defvar date) |
138 | ||
c9549281 | 139 | ;; To be called from list-sexp-diary-entries, where DATE is bound. |
9e85002d | 140 | ;;;###diary-autoload |
0808d911 ER |
141 | (defun diary-iso-date () |
142 | "ISO calendar equivalent of date diary entry." | |
143 | (format "ISO date: %s" (calendar-iso-date-string date))) | |
144 | ||
145 | (provide 'cal-iso) | |
146 | ||
d383fd97 | 147 | ;; arch-tag: 3c0154cc-d30f-4981-9f60-42bdf7a468f6 |
0808d911 | 148 | ;;; cal-iso.el ends here |