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 | ||
551c8f1a | 30 | ;; See calendar.el. |
a96a5fca | 31 | |
0808d911 ER |
32 | ;;; Code: |
33 | ||
34 | (require 'calendar) | |
35 | ||
216a3e25 | 36 | (defun calendar-iso-to-absolute (date) |
0808d911 ER |
37 | "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. |
38 | The `ISO year' corresponds approximately to the Gregorian year, but | |
39 | weeks start on Monday and end on Sunday. The first week of the ISO year is | |
40 | the first such week in which at least 4 days are in a year. The ISO | |
41 | commercial DATE has the form (week day year) in which week is in the range | |
42 | 1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = | |
43 | Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary." | |
e803eab7 | 44 | (let ((day (calendar-extract-day date))) |
0808d911 | 45 | (+ (calendar-dayname-on-or-before |
8ab36f55 | 46 | 1 (+ 3 (calendar-absolute-from-gregorian |
e803eab7 | 47 | (list 1 1 (calendar-extract-year date))))) |
8ab36f55 | 48 | ;; ISO date is (week day year); normally (month day year). |
e803eab7 | 49 | (* 7 (1- (calendar-extract-month date))) |
d383fd97 | 50 | (if (zerop day) 6 (1- day))))) |
0808d911 | 51 | |
216a3e25 GM |
52 | (define-obsolete-function-alias 'calendar-absolute-from-iso |
53 | 'calendar-iso-to-absolute "23.1") | |
54 | ||
0808d911 ER |
55 | (defun calendar-iso-from-absolute (date) |
56 | "Compute the `ISO commercial date' corresponding to the absolute DATE. | |
57 | The ISO year corresponds approximately to the Gregorian year, but weeks | |
58 | start on Monday and end on Sunday. The first week of the ISO year is the | |
59 | first such week in which at least 4 days are in a year. The ISO commercial | |
60 | date has the form (week day year) in which week is in the range 1..52 and | |
61 | day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = Sunday). The | |
62 | absolute date is the number of days elapsed since the (imaginary) Gregorian | |
63 | date Sunday, December 31, 1 BC." | |
e803eab7 | 64 | (let* ((approx (calendar-extract-year |
0808d911 ER |
65 | (calendar-gregorian-from-absolute (- date 3)))) |
66 | (year (+ approx | |
67 | (calendar-sum y approx | |
216a3e25 | 68 | (>= date (calendar-iso-to-absolute |
ad2903ec GM |
69 | (list 1 1 (1+ y)))) |
70 | 1)))) | |
0808d911 | 71 | (list |
216a3e25 | 72 | (1+ (/ (- date (calendar-iso-to-absolute (list 1 1 year))) 7)) |
0808d911 ER |
73 | (% date 7) |
74 | year))) | |
75 | ||
9e85002d | 76 | ;;;###cal-autoload |
0808d911 | 77 | (defun calendar-iso-date-string (&optional date) |
8ab36f55 | 78 | "String of ISO date of Gregorian DATE, default today." |
a1506d29 | 79 | (let* ((d (calendar-absolute-from-gregorian |
0808d911 ER |
80 | (or date (calendar-current-date)))) |
81 | (day (% d 7)) | |
82 | (iso-date (calendar-iso-from-absolute d))) | |
83 | (format "Day %s of week %d of %d" | |
84 | (if (zerop day) 7 day) | |
e803eab7 GM |
85 | (calendar-extract-month iso-date) |
86 | (calendar-extract-year iso-date)))) | |
0808d911 | 87 | |
9e85002d | 88 | ;;;###cal-autoload |
216a3e25 | 89 | (defun calendar-iso-print-date () |
0808d911 ER |
90 | "Show equivalent ISO date for the date under the cursor." |
91 | (interactive) | |
92 | (message "ISO date: %s" | |
93 | (calendar-iso-date-string (calendar-cursor-to-date t)))) | |
94 | ||
216a3e25 GM |
95 | (define-obsolete-function-alias 'calendar-print-iso-date |
96 | 'calendar-iso-print-date "23.1") | |
97 | ||
7b710be1 | 98 | (defun calendar-iso-read-date (&optional dayflag) |
8ab36f55 | 99 | "Interactively read the arguments for an ISO date command. |
46d69a52 GM |
100 | Reads a year and week, and if DAYFLAG is non-nil a day (otherwise |
101 | taken to be 1)." | |
8ab36f55 | 102 | (let* ((year (calendar-read |
b76a84cd | 103 | "ISO calendar year (>0): " |
d383fd97 | 104 | (lambda (x) (> x 0)) |
d92bcf94 | 105 | (number-to-string (calendar-extract-year |
8ab36f55 | 106 | (calendar-current-date))))) |
e803eab7 | 107 | (no-weeks (calendar-extract-month |
b76a84cd GM |
108 | (calendar-iso-from-absolute |
109 | (1- | |
110 | (calendar-dayname-on-or-before | |
111 | 1 (calendar-absolute-from-gregorian | |
112 | (list 1 4 (1+ year)))))))) | |
113 | (week (calendar-read | |
114 | (format "ISO calendar week (1-%d): " no-weeks) | |
d383fd97 | 115 | (lambda (x) (and (> x 0) (<= x no-weeks))))) |
b76a84cd GM |
116 | (day (if dayflag (calendar-read |
117 | "ISO day (1-7): " | |
d383fd97 | 118 | (lambda (x) (and (<= 1 x) (<= x 7)))) |
b76a84cd GM |
119 | 1))) |
120 | (list (list week day year)))) | |
121 | ||
216a3e25 GM |
122 | (define-obsolete-function-alias 'calendar-iso-read-args |
123 | 'calendar-iso-read-date "23.1") | |
7b710be1 | 124 | |
9e85002d | 125 | ;;;###cal-autoload |
216a3e25 | 126 | (defun calendar-iso-goto-date (date &optional noecho) |
8ab36f55 | 127 | "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil." |
7b710be1 | 128 | (interactive (calendar-iso-read-date t)) |
b76a84cd | 129 | (calendar-goto-date (calendar-gregorian-from-absolute |
216a3e25 GM |
130 | (calendar-iso-to-absolute date))) |
131 | (or noecho (calendar-iso-print-date))) | |
132 | ||
133 | (define-obsolete-function-alias 'calendar-goto-iso-date | |
134 | 'calendar-iso-goto-date "23.1") | |
b76a84cd | 135 | |
9e85002d | 136 | ;;;###cal-autoload |
216a3e25 | 137 | (defun calendar-iso-goto-week (date &optional noecho) |
8ab36f55 | 138 | "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil. |
b76a84cd | 139 | Interactively, goes to the first day of the specified week." |
7b710be1 | 140 | (interactive (calendar-iso-read-date)) |
0808d911 | 141 | (calendar-goto-date (calendar-gregorian-from-absolute |
216a3e25 GM |
142 | (calendar-iso-to-absolute date))) |
143 | (or noecho (calendar-iso-print-date))) | |
144 | ||
145 | (define-obsolete-function-alias 'calendar-goto-iso-week | |
146 | 'calendar-iso-goto-week "23.1") | |
0808d911 | 147 | |
d383fd97 GM |
148 | (defvar date) |
149 | ||
8c34d83e | 150 | ;; To be called from diary-list-sexp-entries, where DATE is bound. |
9e85002d | 151 | ;;;###diary-autoload |
0808d911 ER |
152 | (defun diary-iso-date () |
153 | "ISO calendar equivalent of date diary entry." | |
154 | (format "ISO date: %s" (calendar-iso-date-string date))) | |
155 | ||
156 | (provide 'cal-iso) | |
157 | ||
d383fd97 | 158 | ;; arch-tag: 3c0154cc-d30f-4981-9f60-42bdf7a468f6 |
0808d911 | 159 | ;;; cal-iso.el ends here |