;;; cal-iso.el --- calendar functions for the ISO calendar
-;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;; 2008 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;;; Commentary:
-;; This collection of functions implements the features of calendar.el and
-;; diary.el that deal with the ISO calendar.
-
-;; Technical details of all the calendrical calculations can be found in
-;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
-;; and Nachum Dershowitz, Cambridge University Press (2001).
-
-;; Comments, corrections, and improvements should be sent to
-;; Edward M. Reingold Department of Computer Science
-;; (217) 333-6733 University of Illinois at Urbana-Champaign
-;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
-;; Urbana, Illinois 61801
+;; See calendar.el.
;;; Code:
-(defvar date)
-
(require 'calendar)
(defun calendar-absolute-from-iso (date)
commercial DATE has the form (week day year) in which week is in the range
1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 =
Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary."
- (let* ((week (extract-calendar-month date))
- (day (extract-calendar-day date))
- (year (extract-calendar-year date)))
+ (let ((day (extract-calendar-day date)))
(+ (calendar-dayname-on-or-before
- 1 (+ 3 (calendar-absolute-from-gregorian (list 1 1 year))))
- (* 7 (1- week))
- (if (= day 0) 6 (1- day)))))
+ 1 (+ 3 (calendar-absolute-from-gregorian
+ (list 1 1 (extract-calendar-year date)))))
+ ;; ISO date is (week day year); normally (month day year).
+ (* 7 (1- (extract-calendar-month date)))
+ (if (zerop day) 6 (1- day)))))
(defun calendar-iso-from-absolute (date)
"Compute the `ISO commercial date' corresponding to the absolute DATE.
(calendar-gregorian-from-absolute (- date 3))))
(year (+ approx
(calendar-sum y approx
- (>= date (calendar-absolute-from-iso (list 1 1 (1+ y))))
- 1))))
+ (>= date (calendar-absolute-from-iso
+ (list 1 1 (1+ y))))
+ 1))))
(list
(1+ (/ (- date (calendar-absolute-from-iso (list 1 1 year))) 7))
(% date 7)
year)))
+;;;###cal-autoload
(defun calendar-iso-date-string (&optional date)
- "String of ISO date of Gregorian DATE.
-Defaults to today's date if DATE is not given."
+ "String of ISO date of Gregorian DATE, default today."
(let* ((d (calendar-absolute-from-gregorian
(or date (calendar-current-date))))
(day (% d 7))
(extract-calendar-month iso-date)
(extract-calendar-year iso-date))))
+;;;###cal-autoload
(defun calendar-print-iso-date ()
"Show equivalent ISO date for the date under the cursor."
(interactive)
(message "ISO date: %s"
(calendar-iso-date-string (calendar-cursor-to-date t))))
-(defun calendar-iso-read-args (&optional dayflag)
- "Interactively read the arguments for an iso date command."
- (let* ((today (calendar-current-date))
- (year (calendar-read
+(defun calendar-iso-read-date (&optional dayflag)
+ "Interactively read the arguments for an ISO date command.
+Reads a year and week, and if DAYFLAG is non-nil a day (otherwise
+taken to be 1)."
+ (let* ((year (calendar-read
"ISO calendar year (>0): "
- '(lambda (x) (> x 0))
- (int-to-string (extract-calendar-year today))))
+ (lambda (x) (> x 0))
+ (int-to-string (extract-calendar-year
+ (calendar-current-date)))))
(no-weeks (extract-calendar-month
(calendar-iso-from-absolute
(1-
(list 1 4 (1+ year))))))))
(week (calendar-read
(format "ISO calendar week (1-%d): " no-weeks)
- '(lambda (x) (and (> x 0) (<= x no-weeks)))))
+ (lambda (x) (and (> x 0) (<= x no-weeks)))))
(day (if dayflag (calendar-read
"ISO day (1-7): "
- '(lambda (x) (and (<= 1 x) (<= x 7))))
+ (lambda (x) (and (<= 1 x) (<= x 7))))
1)))
(list (list week day year))))
+(define-obsolete-function-alias
+ 'calendar-iso-read-args 'calendar-iso-read-date "23.1")
+
+;;;###cal-autoload
(defun calendar-goto-iso-date (date &optional noecho)
- "Move cursor to ISO DATE; echo ISO date unless NOECHO is t."
- (interactive (calendar-iso-read-args t))
+ "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil."
+ (interactive (calendar-iso-read-date t))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-iso date)))
(or noecho (calendar-print-iso-date)))
+;;;###cal-autoload
(defun calendar-goto-iso-week (date &optional noecho)
- "Move cursor to ISO DATE; echo ISO date unless NOECHO is t.
+ "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil.
Interactively, goes to the first day of the specified week."
- (interactive (calendar-iso-read-args))
+ (interactive (calendar-iso-read-date))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-iso date)))
(or noecho (calendar-print-iso-date)))
+(defvar date)
+
+;; To be called from list-sexp-diary-entries, where DATE is bound.
+;;;###diary-autoload
(defun diary-iso-date ()
"ISO calendar equivalent of date diary entry."
(format "ISO date: %s" (calendar-iso-date-string date)))
(provide 'cal-iso)
-;;; arch-tag: 3c0154cc-d30f-4981-9f60-42bdf7a468f6
+;; arch-tag: 3c0154cc-d30f-4981-9f60-42bdf7a468f6
;;; cal-iso.el ends here