Commit | Line | Data |
---|---|---|
3afbc435 | 1 | ;;; cal-iso.el --- calendar functions for the ISO calendar |
0808d911 | 2 | |
ba318903 | 3 | ;; Copyright (C) 1995, 1997, 2001-2014 Free Software Foundation, Inc. |
0808d911 ER |
4 | |
5 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | |
aff88519 | 6 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
0808d911 ER |
7 | ;; Keywords: calendar |
8 | ;; Human-Keywords: ISO calendar, calendar, diary | |
bd78fa1d | 9 | ;; Package: calendar |
0808d911 ER |
10 | |
11 | ;; This file is part of GNU Emacs. | |
12 | ||
2ed66575 | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
0808d911 | 14 | ;; it under the terms of the GNU General Public License as published by |
2ed66575 GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
0808d911 ER |
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 | |
2ed66575 | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
0808d911 ER |
25 | |
26 | ;;; Commentary: | |
27 | ||
551c8f1a | 28 | ;; See calendar.el. |
a96a5fca | 29 | |
0808d911 ER |
30 | ;;; Code: |
31 | ||
32 | (require 'calendar) | |
33 | ||
216a3e25 | 34 | (defun calendar-iso-to-absolute (date) |
0808d911 ER |
35 | "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. |
36 | The `ISO year' corresponds approximately to the Gregorian year, but | |
37 | weeks start on Monday and end on Sunday. The first week of the ISO year is | |
38 | the first such week in which at least 4 days are in a year. The ISO | |
39 | commercial DATE has the form (week day year) in which week is in the range | |
40 | 1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = | |
41 | Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary." | |
e803eab7 | 42 | (let ((day (calendar-extract-day date))) |
0808d911 | 43 | (+ (calendar-dayname-on-or-before |
8ab36f55 | 44 | 1 (+ 3 (calendar-absolute-from-gregorian |
e803eab7 | 45 | (list 1 1 (calendar-extract-year date))))) |
8ab36f55 | 46 | ;; ISO date is (week day year); normally (month day year). |
e803eab7 | 47 | (* 7 (1- (calendar-extract-month date))) |
d383fd97 | 48 | (if (zerop day) 6 (1- day))))) |
0808d911 | 49 | |
216a3e25 GM |
50 | (define-obsolete-function-alias 'calendar-absolute-from-iso |
51 | 'calendar-iso-to-absolute "23.1") | |
52 | ||
e889393b | 53 | ;;;###cal-autoload |
0808d911 ER |
54 | (defun calendar-iso-from-absolute (date) |
55 | "Compute the `ISO commercial date' corresponding to the absolute DATE. | |
56 | The ISO year corresponds approximately to the Gregorian year, but weeks | |
57 | start on Monday and end on Sunday. The first week of the ISO year is the | |
58 | first such week in which at least 4 days are in a year. The ISO commercial | |
59 | date has the form (week day year) in which week is in the range 1..52 and | |
60 | day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = Sunday). The | |
61 | absolute date is the number of days elapsed since the (imaginary) Gregorian | |
62 | date Sunday, December 31, 1 BC." | |
e803eab7 | 63 | (let* ((approx (calendar-extract-year |
0808d911 ER |
64 | (calendar-gregorian-from-absolute (- date 3)))) |
65 | (year (+ approx | |
66 | (calendar-sum y approx | |
216a3e25 | 67 | (>= date (calendar-iso-to-absolute |
ad2903ec GM |
68 | (list 1 1 (1+ y)))) |
69 | 1)))) | |
0808d911 | 70 | (list |
216a3e25 | 71 | (1+ (/ (- date (calendar-iso-to-absolute (list 1 1 year))) 7)) |
0808d911 ER |
72 | (% date 7) |
73 | year))) | |
74 | ||
9e85002d | 75 | ;;;###cal-autoload |
0808d911 | 76 | (defun calendar-iso-date-string (&optional date) |
8ab36f55 | 77 | "String of ISO date of Gregorian DATE, default today." |
a1506d29 | 78 | (let* ((d (calendar-absolute-from-gregorian |
0808d911 ER |
79 | (or date (calendar-current-date)))) |
80 | (day (% d 7)) | |
81 | (iso-date (calendar-iso-from-absolute d))) | |
82 | (format "Day %s of week %d of %d" | |
83 | (if (zerop day) 7 day) | |
e803eab7 GM |
84 | (calendar-extract-month iso-date) |
85 | (calendar-extract-year iso-date)))) | |
0808d911 | 86 | |
9e85002d | 87 | ;;;###cal-autoload |
216a3e25 | 88 | (defun calendar-iso-print-date () |
0808d911 ER |
89 | "Show equivalent ISO date for the date under the cursor." |
90 | (interactive) | |
91 | (message "ISO date: %s" | |
92 | (calendar-iso-date-string (calendar-cursor-to-date t)))) | |
93 | ||
216a3e25 GM |
94 | (define-obsolete-function-alias 'calendar-print-iso-date |
95 | 'calendar-iso-print-date "23.1") | |
96 | ||
7b710be1 | 97 | (defun calendar-iso-read-date (&optional dayflag) |
8ab36f55 | 98 | "Interactively read the arguments for an ISO date command. |
46d69a52 GM |
99 | Reads a year and week, and if DAYFLAG is non-nil a day (otherwise |
100 | taken to be 1)." | |
8ab36f55 | 101 | (let* ((year (calendar-read |
b76a84cd | 102 | "ISO calendar year (>0): " |
d383fd97 | 103 | (lambda (x) (> x 0)) |
d92bcf94 | 104 | (number-to-string (calendar-extract-year |
8ab36f55 | 105 | (calendar-current-date))))) |
e803eab7 | 106 | (no-weeks (calendar-extract-month |
b76a84cd GM |
107 | (calendar-iso-from-absolute |
108 | (1- | |
109 | (calendar-dayname-on-or-before | |
110 | 1 (calendar-absolute-from-gregorian | |
111 | (list 1 4 (1+ year)))))))) | |
112 | (week (calendar-read | |
113 | (format "ISO calendar week (1-%d): " no-weeks) | |
d383fd97 | 114 | (lambda (x) (and (> x 0) (<= x no-weeks))))) |
b76a84cd GM |
115 | (day (if dayflag (calendar-read |
116 | "ISO day (1-7): " | |
d383fd97 | 117 | (lambda (x) (and (<= 1 x) (<= x 7)))) |
b76a84cd GM |
118 | 1))) |
119 | (list (list week day year)))) | |
120 | ||
216a3e25 GM |
121 | (define-obsolete-function-alias 'calendar-iso-read-args |
122 | 'calendar-iso-read-date "23.1") | |
7b710be1 | 123 | |
9e85002d | 124 | ;;;###cal-autoload |
216a3e25 | 125 | (defun calendar-iso-goto-date (date &optional noecho) |
8ab36f55 | 126 | "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil." |
7b710be1 | 127 | (interactive (calendar-iso-read-date t)) |
b76a84cd | 128 | (calendar-goto-date (calendar-gregorian-from-absolute |
216a3e25 GM |
129 | (calendar-iso-to-absolute date))) |
130 | (or noecho (calendar-iso-print-date))) | |
131 | ||
132 | (define-obsolete-function-alias 'calendar-goto-iso-date | |
133 | 'calendar-iso-goto-date "23.1") | |
b76a84cd | 134 | |
9e85002d | 135 | ;;;###cal-autoload |
216a3e25 | 136 | (defun calendar-iso-goto-week (date &optional noecho) |
8ab36f55 | 137 | "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil. |
b76a84cd | 138 | Interactively, goes to the first day of the specified week." |
7b710be1 | 139 | (interactive (calendar-iso-read-date)) |
0808d911 | 140 | (calendar-goto-date (calendar-gregorian-from-absolute |
216a3e25 GM |
141 | (calendar-iso-to-absolute date))) |
142 | (or noecho (calendar-iso-print-date))) | |
143 | ||
144 | (define-obsolete-function-alias 'calendar-goto-iso-week | |
145 | 'calendar-iso-goto-week "23.1") | |
0808d911 | 146 | |
d383fd97 GM |
147 | (defvar date) |
148 | ||
8c34d83e | 149 | ;; To be called from diary-list-sexp-entries, where DATE is bound. |
9e85002d | 150 | ;;;###diary-autoload |
0808d911 ER |
151 | (defun diary-iso-date () |
152 | "ISO calendar equivalent of date diary entry." | |
153 | (format "ISO date: %s" (calendar-iso-date-string date))) | |
154 | ||
155 | (provide 'cal-iso) | |
156 | ||
157 | ;;; cal-iso.el ends here |