Lines Matching +defs:scroll +defs:calendar +defs:left +defs:three +defs:months
1 ;;; cal-move.el --- calendar functions for movement in the calendar
8 ;; Keywords: calendar
9 ;; Human-Keywords: calendar
30 ;; This collection of functions implements movement in the calendar for
31 ;; calendar.el.
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)
51 "Move the cursor forward ARG months.
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)))
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)
77 "Move the cursor backward by ARG months.
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)))
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)
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 ()
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)
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)
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))
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)
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))
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
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
324 (calendar-cursor-to-visible-date date)
325 (run-hooks 'calendar-move-hook))
327 (defun calendar-goto-day-of-year (year day &optional noecho)
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
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)))