;;; cal-iso.el --- calendar functions for the ISO calendar
-;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006
+;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Keywords: calendar
;; Human-Keywords: ISO calendar, calendar, diary
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; diary.el that deal with the ISO calendar.
;; Technical details of all the calendrical calculations can be found in
-;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
-;; Cambridge University Press (1997).
+;; ``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
;;; Code:
+(defvar date)
+
(require 'calendar)
(defun calendar-absolute-from-iso (date)
(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
+ "ISO calendar year (>0): "
+ '(lambda (x) (> x 0))
+ (int-to-string (extract-calendar-year today))))
+ (no-weeks (extract-calendar-month
+ (calendar-iso-from-absolute
+ (1-
+ (calendar-dayname-on-or-before
+ 1 (calendar-absolute-from-gregorian
+ (list 1 4 (1+ year))))))))
+ (week (calendar-read
+ (format "ISO calendar week (1-%d): " 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))))
+ 1)))
+ (list (list week day year))))
+
(defun calendar-goto-iso-date (date &optional noecho)
"Move cursor to ISO DATE; echo ISO date unless NOECHO is t."
- (interactive
- (let* ((today (calendar-current-date))
- (year (calendar-read
- "ISO calendar year (>0): "
- '(lambda (x) (> x 0))
- (int-to-string (extract-calendar-year today))))
- (no-weeks (extract-calendar-month
- (calendar-iso-from-absolute
- (1-
- (calendar-dayname-on-or-before
- 1 (calendar-absolute-from-gregorian
- (list 1 4 (1+ year))))))))
- (week (calendar-read
- (format "ISO calendar week (1-%d): " no-weeks)
- '(lambda (x) (and (> x 0) (<= x no-weeks)))))
- (day (calendar-read
- "ISO day (1-7): "
- '(lambda (x) (and (<= 1 x) (<= x 7))))))
- (list (list week day year))))
+ (interactive (calendar-iso-read-args t))
+ (calendar-goto-date (calendar-gregorian-from-absolute
+ (calendar-absolute-from-iso date)))
+ (or noecho (calendar-print-iso-date)))
+
+(defun calendar-goto-iso-week (date &optional noecho)
+ "Move cursor to ISO DATE; echo ISO date unless NOECHO is t.
+Interactively, goes to the first day of the specified week."
+ (interactive (calendar-iso-read-args))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-iso date)))
(or noecho (calendar-print-iso-date)))
(provide 'cal-iso)
+;;; arch-tag: 3c0154cc-d30f-4981-9f60-42bdf7a468f6
;;; cal-iso.el ends here