Mercurial > emacs

comparison lisp/calendar/cal-iso.el @ 93643:e6a9bdb70ed7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(calendar-iso-to-absolute): Rename calendar-absolute-from-iso. Update callers, keep old name as alias. (calendar-iso-print-date): Rename calendar-print-iso-date. Update callers, keep old name as alias. (calendar-iso-goto-date): Rename calendar-goto-iso-date. Keep old name as alias. (calendar-iso-goto-week): Rename calendar-goto-iso-week. Keep old name as alias.
author Glenn Morris <rgm@gnu.org>
date Fri, 04 Apr 2008 07:14:38 +0000
parents b3e69c64ac95
children a7aaeba2c2bc
comparison
equal deleted inserted replaced
93642:d01118f40990 93643:e6a9bdb70ed7
31 31
32 ;;; Code: 32 ;;; Code:
33 33
34 (require 'calendar) 34 (require 'calendar)
35 35
36 (defun calendar-absolute-from-iso (date) 36 (defun calendar-iso-to-absolute (date)
37 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE. 37 "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
38 The `ISO year' corresponds approximately to the Gregorian year, but 38 The `ISO year' corresponds approximately to the Gregorian year, but
39 weeks start on Monday and end on Sunday. The first week of the ISO year is 39 weeks start on Monday and end on Sunday. The first week of the ISO year is
40 the first such week in which at least 4 days are in a year. The ISO 40 the first such week in which at least 4 days are in a year. The ISO
41 commercial DATE has the form (week day year) in which week is in the range 41 commercial DATE has the form (week day year) in which week is in the range
47 (list 1 1 (extract-calendar-year date))))) 47 (list 1 1 (extract-calendar-year date)))))
48 ;; ISO date is (week day year); normally (month day year). 48 ;; ISO date is (week day year); normally (month day year).
49 (* 7 (1- (extract-calendar-month date))) 49 (* 7 (1- (extract-calendar-month date)))
50 (if (zerop day) 6 (1- day))))) 50 (if (zerop day) 6 (1- day)))))
51 51
52 (define-obsolete-function-alias 'calendar-absolute-from-iso
53 'calendar-iso-to-absolute "23.1")
54
52 (defun calendar-iso-from-absolute (date) 55 (defun calendar-iso-from-absolute (date)
53 "Compute the `ISO commercial date' corresponding to the absolute DATE. 56 "Compute the `ISO commercial date' corresponding to the absolute DATE.
54 The ISO year corresponds approximately to the Gregorian year, but weeks 57 The ISO year corresponds approximately to the Gregorian year, but weeks
55 start on Monday and end on Sunday. The first week of the ISO year is the 58 start on Monday and end on Sunday. The first week of the ISO year is the
56 first such week in which at least 4 days are in a year. The ISO commercial 59 first such week in which at least 4 days are in a year. The ISO commercial
60 date Sunday, December 31, 1 BC." 63 date Sunday, December 31, 1 BC."
61 (let* ((approx (extract-calendar-year 64 (let* ((approx (extract-calendar-year
62 (calendar-gregorian-from-absolute (- date 3)))) 65 (calendar-gregorian-from-absolute (- date 3))))
63 (year (+ approx 66 (year (+ approx
64 (calendar-sum y approx 67 (calendar-sum y approx
65 (>= date (calendar-absolute-from-iso 68 (>= date (calendar-iso-to-absolute
66 (list 1 1 (1+ y)))) 69 (list 1 1 (1+ y))))
67 1)))) 70 1))))
68 (list 71 (list
69 (1+ (/ (- date (calendar-absolute-from-iso (list 1 1 year))) 7)) 72 (1+ (/ (- date (calendar-iso-to-absolute (list 1 1 year))) 7))
70 (% date 7) 73 (% date 7)
71 year))) 74 year)))
72 75
73 ;;;###cal-autoload 76 ;;;###cal-autoload
74 (defun calendar-iso-date-string (&optional date) 77 (defun calendar-iso-date-string (&optional date)
81 (if (zerop day) 7 day) 84 (if (zerop day) 7 day)
82 (extract-calendar-month iso-date) 85 (extract-calendar-month iso-date)
83 (extract-calendar-year iso-date)))) 86 (extract-calendar-year iso-date))))
84 87
85 ;;;###cal-autoload 88 ;;;###cal-autoload
86 (defun calendar-print-iso-date () 89 (defun calendar-iso-print-date ()
87 "Show equivalent ISO date for the date under the cursor." 90 "Show equivalent ISO date for the date under the cursor."
88 (interactive) 91 (interactive)
89 (message "ISO date: %s" 92 (message "ISO date: %s"
90 (calendar-iso-date-string (calendar-cursor-to-date t)))) 93 (calendar-iso-date-string (calendar-cursor-to-date t))))
94
95 (define-obsolete-function-alias 'calendar-print-iso-date
96 'calendar-iso-print-date "23.1")
91 97
92 (defun calendar-iso-read-date (&optional dayflag) 98 (defun calendar-iso-read-date (&optional dayflag)
93 "Interactively read the arguments for an ISO date command. 99 "Interactively read the arguments for an ISO date command.
94 Reads a year and week, and if DAYFLAG is non-nil a day (otherwise 100 Reads a year and week, and if DAYFLAG is non-nil a day (otherwise
95 taken to be 1)." 101 taken to be 1)."
111 "ISO day (1-7): " 117 "ISO day (1-7): "
112 (lambda (x) (and (<= 1 x) (<= x 7)))) 118 (lambda (x) (and (<= 1 x) (<= x 7))))
113 1))) 119 1)))
114 (list (list week day year)))) 120 (list (list week day year))))
115 121
116 (define-obsolete-function-alias 122 (define-obsolete-function-alias 'calendar-iso-read-args
117 'calendar-iso-read-args 'calendar-iso-read-date "23.1") 123 'calendar-iso-read-date "23.1")
118 124
119 ;;;###cal-autoload 125 ;;;###cal-autoload
120 (defun calendar-goto-iso-date (date &optional noecho) 126 (defun calendar-iso-goto-date (date &optional noecho)
121 "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil." 127 "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil."
122 (interactive (calendar-iso-read-date t)) 128 (interactive (calendar-iso-read-date t))
123 (calendar-goto-date (calendar-gregorian-from-absolute 129 (calendar-goto-date (calendar-gregorian-from-absolute
124 (calendar-absolute-from-iso date))) 130 (calendar-iso-to-absolute date)))
125 (or noecho (calendar-print-iso-date))) 131 (or noecho (calendar-iso-print-date)))
132
133 (define-obsolete-function-alias 'calendar-goto-iso-date
134 'calendar-iso-goto-date "23.1")
126 135
127 ;;;###cal-autoload 136 ;;;###cal-autoload
128 (defun calendar-goto-iso-week (date &optional noecho) 137 (defun calendar-iso-goto-week (date &optional noecho)
129 "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil. 138 "Move cursor to ISO DATE; echo ISO date unless NOECHO is non-nil.
130 Interactively, goes to the first day of the specified week." 139 Interactively, goes to the first day of the specified week."
131 (interactive (calendar-iso-read-date)) 140 (interactive (calendar-iso-read-date))
132 (calendar-goto-date (calendar-gregorian-from-absolute 141 (calendar-goto-date (calendar-gregorian-from-absolute
133 (calendar-absolute-from-iso date))) 142 (calendar-iso-to-absolute date)))
134 (or noecho (calendar-print-iso-date))) 143 (or noecho (calendar-iso-print-date)))
144
145 (define-obsolete-function-alias 'calendar-goto-iso-week
146 'calendar-iso-goto-week "23.1")
135 147
136 (defvar date) 148 (defvar date)
137 149
138 ;; To be called from list-sexp-diary-entries, where DATE is bound. 150 ;; To be called from list-sexp-diary-entries, where DATE is bound.
139 ;;;###diary-autoload 151 ;;;###diary-autoload