Lines Matching +defs:calendar +defs:beginning +defs:of +defs:year
1 ;;; cal-move.el --- calendar functions for movement in the calendar
8 ;; Keywords: calendar
9 ;; Human-Keywords: calendar
11 ;; This file is part of GNU Emacs.
14 ;; it under the terms of the GNU General Public License as published by
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
23 ;; You should have received a copy of the GNU General Public License
30 ;; This collection of functions implements movement in the calendar for
31 ;; calendar.el.
36 (defvar displayed-year)
38 (require 'calendar)
40 (defun calendar-goto-today ()
41 "Reposition the calendar window so the current date is visible."
43 (let ((today (calendar-current-date)));; The date might have changed.
44 (if (not (calendar-date-is-visible-p today))
45 (generate-calendar-window)
46 (update-calendar-mode-line)
47 (calendar-cursor-to-visible-date today)))
48 (run-hooks 'calendar-move-hook))
50 (defun calendar-forward-month (arg)
54 (calendar-cursor-to-nearest-date)
55 (let* ((cursor-date (calendar-cursor-to-date t))
56 (month (extract-calendar-month cursor-date))
57 (day (extract-calendar-day cursor-date))
58 (year (extract-calendar-year cursor-date)))
59 (increment-calendar-month month year arg)
60 (let ((last (calendar-last-day-of-month month year)))
64 (let ((new-cursor-date (list month day year)))
65 (if (not (calendar-date-is-visible-p new-cursor-date))
66 (calendar-other-month month year))
67 (calendar-cursor-to-visible-date new-cursor-date)))
68 (run-hooks 'calendar-move-hook))
70 (defun calendar-forward-year (arg)
74 (calendar-forward-month (* 12 arg)))
76 (defun calendar-backward-month (arg)
80 (calendar-forward-month (- arg)))
82 (defun calendar-backward-year (arg)
86 (calendar-forward-month (* -12 arg)))
88 (defun scroll-calendar-left (&optional arg)
89 "Scroll the displayed calendar left by ARG months.
90 If ARG is negative the calendar is scrolled right. Maintains the relative
91 position of the cursor with respect to the calendar as well as possible."
94 (calendar-cursor-to-nearest-date)
95 (let ((old-date (calendar-cursor-to-date))
96 (today (calendar-current-date)))
99 (year displayed-year))
100 (increment-calendar-month month year arg)
101 (generate-calendar-window month year)
102 (calendar-cursor-to-visible-date
104 ((calendar-date-is-visible-p old-date) old-date)
105 ((calendar-date-is-visible-p today) today)
106 (t (list month 1 year)))))))
107 (run-hooks 'calendar-move-hook))
109 (defun scroll-calendar-right (&optional arg)
110 "Scroll the displayed calendar window right by ARG months.
111 If ARG is negative the calendar is scrolled left. Maintains the relative
112 position of the cursor with respect to the calendar as well as possible."
114 (scroll-calendar-left (- (or arg 1))))
116 (defun scroll-calendar-left-three-months (arg)
117 "Scroll the displayed calendar window left by 3*ARG months.
118 If ARG is negative the calendar is scrolled right. Maintains the relative
119 position of the cursor with respect to the calendar as well as possible."
121 (scroll-calendar-left (* 3 arg)))
123 (defun scroll-calendar-right-three-months (arg)
124 "Scroll the displayed calendar window right by 3*ARG months.
125 If ARG is negative the calendar is scrolled left. Maintains the relative
126 position of the cursor with respect to the calendar as well as possible."
128 (scroll-calendar-left (* -3 arg)))
130 (defun calendar-cursor-to-nearest-date ()
132 The position of the cursor is unchanged if it is already on a date.
133 Returns the list (month day year) giving the cursor position."
134 (let ((date (calendar-cursor-to-date))
153 (calendar-cursor-to-date))))
155 (defun calendar-forward-day (arg)
161 ((cursor-date (calendar-cursor-to-date))
165 (calendar-cursor-to-nearest-date)))
167 (calendar-gregorian-from-absolute
168 (+ (calendar-absolute-from-gregorian cursor-date) arg)))
169 (new-display-month (extract-calendar-month new-cursor-date))
170 (new-display-year (extract-calendar-year new-cursor-date)))
172 (if (not (calendar-date-is-visible-p new-cursor-date))
173 (calendar-other-month new-display-month new-display-year))
174 (calendar-cursor-to-visible-date new-cursor-date)))
175 (run-hooks 'calendar-move-hook))
177 (defun calendar-backward-day (arg)
181 (calendar-forward-day (- arg)))
183 (defun calendar-forward-week (arg)
187 (calendar-forward-day (* arg 7)))
189 (defun calendar-backward-week (arg)
193 (calendar-forward-day (* arg -7)))
195 (defun calendar-beginning-of-week (arg)
196 "Move the cursor back ARG calendar-week-start-day's."
198 (calendar-cursor-to-nearest-date)
199 (let ((day (calendar-day-of-week (calendar-cursor-to-date))))
200 (calendar-backward-day
201 (if (= day calendar-week-start-day)
203 (+ (mod (- day calendar-week-start-day) 7)
206 (defun calendar-end-of-week (arg)
207 "Move the cursor forward ARG calendar-week-start-day+6's."
209 (calendar-cursor-to-nearest-date)
210 (let ((day (calendar-day-of-week (calendar-cursor-to-date))))
211 (calendar-forward-day
212 (if (= day (mod (1- calendar-week-start-day) 7))
214 (+ (- 6 (mod (- day calendar-week-start-day) 7))
217 (defun calendar-beginning-of-month (arg)
220 (calendar-cursor-to-nearest-date)
221 (let* ((date (calendar-cursor-to-date))
222 (month (extract-calendar-month date))
223 (day (extract-calendar-day date))
224 (year (extract-calendar-year date)))
226 (calendar-backward-month arg)
227 (calendar-cursor-to-visible-date (list month 1 year))
228 (calendar-backward-month (1- arg)))))
230 (defun calendar-end-of-month (arg)
233 (calendar-cursor-to-nearest-date)
234 (let* ((date (calendar-cursor-to-date))
235 (month (extract-calendar-month date))
236 (day (extract-calendar-day date))
237 (year (extract-calendar-year date))
238 (last-day (calendar-last-day-of-month month year)))
241 (calendar-cursor-to-visible-date (list month last-day year))
243 (increment-calendar-month month year arg)
246 (calendar-last-day-of-month month year)
247 year)))
248 (if (not (calendar-date-is-visible-p last-day))
249 (calendar-other-month month year)
250 (calendar-cursor-to-visible-date last-day))))
251 (run-hooks 'calendar-move-hook))
253 (defun calendar-beginning-of-year (arg)
254 "Move the cursor backward ARG year beginnings."
256 (calendar-cursor-to-nearest-date)
257 (let* ((date (calendar-cursor-to-date))
258 (month (extract-calendar-month date))
259 (day (extract-calendar-day date))
260 (year (extract-calendar-year date))
261 (jan-first (list 1 1 year))
262 (calendar-move-hook nil))
264 (calendar-backward-month (* 12 arg))
266 (calendar-date-is-visible-p jan-first))
267 (calendar-cursor-to-visible-date jan-first)
268 (calendar-other-month 1 (- year (1- arg)))
269 (calendar-cursor-to-visible-date (list 1 1 displayed-year)))))
270 (run-hooks 'calendar-move-hook))
272 (defun calendar-end-of-year (arg)
273 "Move the cursor forward ARG year beginnings."
275 (calendar-cursor-to-nearest-date)
276 (let* ((date (calendar-cursor-to-date))
277 (month (extract-calendar-month date))
278 (day (extract-calendar-day date))
279 (year (extract-calendar-year date))
280 (dec-31 (list 12 31 year))
281 (calendar-move-hook nil))
283 (calendar-forward-month (* 12 arg))
285 (calendar-date-is-visible-p dec-31))
286 (calendar-cursor-to-visible-date dec-31)
287 (calendar-other-month 12 (+ year (1- arg)))
288 (calendar-cursor-to-visible-date (list 12 31 displayed-year)))))
289 (run-hooks 'calendar-move-hook))
291 (defun calendar-cursor-to-visible-date (date)
293 (let* ((month (extract-calendar-month date))
294 (day (extract-calendar-day date))
295 (year (extract-calendar-year date))
296 (first-of-month-weekday (calendar-day-of-week (list month 1 year))))
300 (- (calendar-day-of-week (list month 1 year))
301 calendar-week-start-day)
306 (1+ (calendar-interval
307 displayed-month displayed-year month year)))
309 (- (calendar-day-of-week date)
310 calendar-week-start-day)
313 (defun calendar-goto-date (date)
315 (interactive (list (calendar-read-date)))
316 (let ((month (extract-calendar-month date))
317 (year (extract-calendar-year date)))
318 (if (not (calendar-date-is-visible-p date))
319 (calendar-other-month
320 (if (and (= month 1) (= year 1))
323 year)))
324 (calendar-cursor-to-visible-date date)
325 (run-hooks 'calendar-move-hook))
327 (defun calendar-goto-day-of-year (year day &optional noecho)
329 Negative DAY counts backward from end of year."
331 (let* ((year (calendar-read
334 (int-to-string (extract-calendar-year
335 (calendar-current-date)))))
336 (last (if (calendar-leap-year-p year) 366 365))
337 (day (calendar-read
340 (list year day)))
341 (calendar-goto-date
342 (calendar-gregorian-from-absolute
344 (+ -1 day (calendar-absolute-from-gregorian (list 1 1 year)))
345 (+ 1 day (calendar-absolute-from-gregorian (list 12 31 year))))))
346 (or noecho (calendar-print-day-of-year)))