Mercurial > emacs

comparison lisp/calendar/cal-iso.el @ 92818:3ed51c637a80

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(calendar-absolute-from-iso, calendar-iso-read-args): Simplify. (calendar-iso-date-string, calendar-iso-read-args) (calendar-goto-iso-date, calendar-goto-iso-week): Doc fixes.
author Glenn Morris <rgm@gnu.org>
date Thu, 13 Mar 2008 03:53:02 +0000
parents e26350e23411
children 272f566348a7
comparison
equal deleted inserted replaced
92817:1b8224570e5f 92818:3ed51c637a80
44 weeks start on Monday and end on Sunday. The first week of the ISO year is 44 weeks start on Monday and end on Sunday. The first week of the ISO year is
45 the first such week in which at least 4 days are in a year. The ISO 45 the first such week in which at least 4 days are in a year. The ISO
46 commercial DATE has the form (week day year) in which week is in the range 46 commercial DATE has the form (week day year) in which week is in the range
47 1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = 47 1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 =
48 Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary." 48 Sunday). The Gregorian date Sunday, December 31, 1 BC is imaginary."
49 (let* ((week (extract-calendar-month date)) 49 (let ((day (extract-calendar-day date)))
50 (day (extract-calendar-day date))
51 (year (extract-calendar-year date)))
52 (+ (calendar-dayname-on-or-before 50 (+ (calendar-dayname-on-or-before
53 1 (+ 3 (calendar-absolute-from-gregorian (list 1 1 year)))) 51 1 (+ 3 (calendar-absolute-from-gregorian
54 (* 7 (1- week)) 52 (list 1 1 (extract-calendar-year date)))))
53 ;; ISO date is (week day year); normally (month day year).
54 (* 7 (1- (extract-calendar-month date)))
55 (if (zerop day) 6 (1- day))))) 55 (if (zerop day) 6 (1- day)))))
56 56
57 (defun calendar-iso-from-absolute (date) 57 (defun calendar-iso-from-absolute (date)
58 "Compute the `ISO commercial date' corresponding to the absolute DATE. 58 "Compute the `ISO commercial date' corresponding to the absolute DATE.
59 The ISO year corresponds approximately to the Gregorian year, but weeks 59 The ISO year corresponds approximately to the Gregorian year, but weeks
74 (% date 7) 74 (% date 7)
75 year))) 75 year)))
76 76
77 ;;;###autoload 77 ;;;###autoload
78 (defun calendar-iso-date-string (&optional date) 78 (defun calendar-iso-date-string (&optional date)
79 "String of ISO date of Gregorian DATE. 79 "String of ISO date of Gregorian DATE, default today."
80 Defaults to today's date if DATE is not given."
81 (let* ((d (calendar-absolute-from-gregorian 80 (let* ((d (calendar-absolute-from-gregorian
82 (or date (calendar-current-date)))) 81 (or date (calendar-current-date))))
83 (day (% d 7)) 82 (day (% d 7))
84 (iso-date (calendar-iso-from-absolute d))) 83 (iso-date (calendar-iso-from-absolute d)))
85 (format "Day %s of week %d of %d" 84 (format "Day %s of week %d of %d"
93 (interactive) 92 (interactive)
94 (message "ISO date: %s" 93 (message "ISO date: %s"
95 (calendar-iso-date-string (calendar-cursor-to-date t)))) 94 (calendar-iso-date-string (calendar-cursor-to-date t))))
96 95
97 (defun calendar-iso-read-args (&optional dayflag) 96 (defun calendar-iso-read-args (&optional dayflag)
98 "Interactively read the arguments for an iso date command. 97 "Interactively read the arguments for an ISO date command.
99 Reads a year and week, and if DAYFLAG is non-nil a day (otherwise 98 Reads a year and week, and if DAYFLAG is non-nil a day (otherwise
100 taken to be 1)." 99 taken to be 1)."
101 (let* ((today (calendar-current-date)) 100 (let* ((year (calendar-read
102 (year (calendar-read
103 "ISO calendar year (>0): " 101 "ISO calendar year (>0): "
104 (lambda (x) (> x 0)) 102 (lambda (x) (> x 0))
105 (int-to-string (extract-calendar-year today)))) 103 (int-to-string (extract-calendar-year
104 (calendar-current-date)))))
106 (no-weeks (extract-calendar-month 105 (no-weeks (extract-calendar-month
107 (calendar-iso-from-absolute 106 (calendar-iso-from-absolute
108 (1- 107 (1-
109 (calendar-dayname-on-or-before 108 (calendar-dayname-on-or-before
110 1 (calendar-absolute-from-gregorian 109 1 (calendar-absolute-from-gregorian
118 1))) 117 1)))
119 (list (list week day year)))) 118 (list (list week day year))))
120 119
121 ;;;###autoload 120 ;;;###autoload
122 (defun calendar-goto-iso-date (date &optional noecho) 121 (defun calendar-goto-iso-date (date &optional noecho)
123 "Move cursor to ISO DATE; echo ISO date unless NOECHO is t." 122 "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil."
124 (interactive (calendar-iso-read-args t)) 123 (interactive (calendar-iso-read-args t))
125 (calendar-goto-date (calendar-gregorian-from-absolute 124 (calendar-goto-date (calendar-gregorian-from-absolute
126 (calendar-absolute-from-iso date))) 125 (calendar-absolute-from-iso date)))
127 (or noecho (calendar-print-iso-date))) 126 (or noecho (calendar-print-iso-date)))
128 127
129 ;;;###autoload 128 ;;;###autoload
130 (defun calendar-goto-iso-week (date &optional noecho) 129 (defun calendar-goto-iso-week (date &optional noecho)
131 "Move cursor to ISO DATE; echo ISO date unless NOECHO is t. 130 "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil.
132 Interactively, goes to the first day of the specified week." 131 Interactively, goes to the first day of the specified week."
133 (interactive (calendar-iso-read-args)) 132 (interactive (calendar-iso-read-args))
134 (calendar-goto-date (calendar-gregorian-from-absolute 133 (calendar-goto-date (calendar-gregorian-from-absolute
135 (calendar-absolute-from-iso date))) 134 (calendar-absolute-from-iso date)))
136 (or noecho (calendar-print-iso-date))) 135 (or noecho (calendar-print-iso-date)))