]> code.delx.au - gnu-emacs/blobdiff - lisp/calendar/cal-iso.el
New file, from: Anna M. Bigatti <bigatti at dima.unige.it>.
[gnu-emacs] / lisp / calendar / cal-iso.el
index b80441885080613b52946d3b9d49caa0298d6862..c11968e8421a4dbce240054094e0f352311e91e2 100644 (file)
@@ -1,8 +1,10 @@
-;;; cal-iso.el --- calendar functions for the ISO calendar.
+;;; cal-iso.el --- calendar functions for the ISO calendar
 
-;; Copyright (C) 1995 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
 
 ;; GNU General Public License for more details.
 
 ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; 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
@@ -35,6 +42,8 @@
 
 ;;; Code:
 
+(defvar date)
+
 (require 'calendar)
 
 (defun calendar-absolute-from-iso (date)
@@ -76,7 +85,7 @@ date Sunday, December 31, 1 BC."
 (defun calendar-iso-date-string (&optional date)
   "String of ISO date of Gregorian DATE.
 Defaults to today's date if DATE is not given."
-  (let* ((d (calendar-absolute-from-gregorian 
+  (let* ((d (calendar-absolute-from-gregorian
              (or date (calendar-current-date))))
          (day (% d 7))
          (iso-date (calendar-iso-from-absolute d)))
@@ -91,27 +100,39 @@ Defaults to today's date if DATE is not given."
   (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)))
@@ -122,4 +143,5 @@ Defaults to today's date if DATE is not given."
 
 (provide 'cal-iso)
 
+;;; arch-tag: 3c0154cc-d30f-4981-9f60-42bdf7a468f6
 ;;; cal-iso.el ends here