/[emacs]/emacs/lisp/calendar/cal-iso.el
ViewVC logotype

Diff of /emacs/lisp/calendar/cal-iso.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5.6.1 by handa, Fri Apr 16 12:50:12 2004 UTC revision 1.5.6.2 by miles, Thu Oct 14 08:50:09 2004 UTC
# Line 1  Line 1 
1  ;;; cal-iso.el --- calendar functions for the ISO calendar  ;;; cal-iso.el --- calendar functions for the ISO calendar
2    
3  ;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.  ;; Copyright (C) 1995, 1997, 2004 Free Software Foundation, Inc.
4    
5  ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>  ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
6    ;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
7  ;; Keywords: calendar  ;; Keywords: calendar
8  ;; Human-Keywords: ISO calendar, calendar, diary  ;; Human-Keywords: ISO calendar, calendar, diary
9    
# Line 96  Defaults to today's date if DATE is not Line 97  Defaults to today's date if DATE is not
97    (message "ISO date: %s"    (message "ISO date: %s"
98             (calendar-iso-date-string (calendar-cursor-to-date t))))             (calendar-iso-date-string (calendar-cursor-to-date t))))
99    
100    (defun calendar-iso-read-args (&optional dayflag)
101      "Interactively read the arguments for an iso date command."
102      (let* ((today (calendar-current-date))
103             (year (calendar-read
104                    "ISO calendar year (>0): "
105                    '(lambda (x) (> x 0))
106                    (int-to-string (extract-calendar-year today))))
107             (no-weeks (extract-calendar-month
108                        (calendar-iso-from-absolute
109                         (1-
110                          (calendar-dayname-on-or-before
111                           1 (calendar-absolute-from-gregorian
112                              (list 1 4 (1+ year))))))))
113             (week (calendar-read
114                    (format "ISO calendar week (1-%d): " no-weeks)
115                    '(lambda (x) (and (> x 0) (<= x no-weeks)))))
116             (day (if dayflag (calendar-read
117                               "ISO day (1-7): "
118                               '(lambda (x) (and (<= 1 x) (<= x 7))))
119                    1)))
120        (list (list week day year))))
121    
122  (defun calendar-goto-iso-date (date &optional noecho)  (defun calendar-goto-iso-date (date &optional noecho)
123    "Move cursor to ISO DATE; echo ISO date unless NOECHO is t."    "Move cursor to ISO DATE; echo ISO date unless NOECHO is t."
124    (interactive    (interactive (calendar-iso-read-args t))
125     (let* ((today (calendar-current-date))    (calendar-goto-date (calendar-gregorian-from-absolute
126            (year (calendar-read                         (calendar-absolute-from-iso date)))
127                   "ISO calendar year (>0): "    (or noecho (calendar-print-iso-date)))
128                   '(lambda (x) (> x 0))  
129                   (int-to-string (extract-calendar-year today))))  (defun calendar-goto-iso-week (date &optional noecho)
130            (no-weeks (extract-calendar-month    "Move cursor to ISO DATE; echo ISO date unless NOECHO is t.
131                       (calendar-iso-from-absolute  Interactively, goes to the first day of the specified week."
132                        (1-    (interactive (calendar-iso-read-args))
                        (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))))  
133    (calendar-goto-date (calendar-gregorian-from-absolute    (calendar-goto-date (calendar-gregorian-from-absolute
134                         (calendar-absolute-from-iso date)))                         (calendar-absolute-from-iso date)))
135    (or noecho (calendar-print-iso-date)))    (or noecho (calendar-print-iso-date)))

Legend:
Removed from v.1.5.6.1  
changed lines
  Added in v.1.5.6.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26