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