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 |
|
|
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))) |