Mercurial > emacs
comparison lisp/calendar/cal-move.el @ 25411:0d68ae69cd8c
Call the new hook in every movement function.
| author | Richard M. Stallman <rms@gnu.org> |
|---|---|
| date | Sat, 28 Aug 1999 15:20:18 +0000 |
| parents | d9aef2d7c503 |
| children | 4560c1d5e629 |
comparison
equal
deleted
inserted
replaced
| 25410:3ab4413f7549 | 25411:0d68ae69cd8c |
|---|---|
| 43 (interactive) | 43 (interactive) |
| 44 (let ((today (calendar-current-date)));; The date might have changed. | 44 (let ((today (calendar-current-date)));; The date might have changed. |
| 45 (if (not (calendar-date-is-visible-p today)) | 45 (if (not (calendar-date-is-visible-p today)) |
| 46 (generate-calendar-window) | 46 (generate-calendar-window) |
| 47 (update-calendar-mode-line) | 47 (update-calendar-mode-line) |
| 48 (calendar-cursor-to-visible-date today)))) | 48 (calendar-cursor-to-visible-date today))) |
| 49 (run-hooks 'calendar-move-hook)) | |
| 49 | 50 |
| 50 (defun calendar-forward-month (arg) | 51 (defun calendar-forward-month (arg) |
| 51 "Move the cursor forward ARG months. | 52 "Move the cursor forward ARG months. |
| 52 Movement is backward if ARG is negative." | 53 Movement is backward if ARG is negative." |
| 53 (interactive "p") | 54 (interactive "p") |
| 62 (setq day last))) | 63 (setq day last))) |
| 63 ;; Put the new month on the screen, if needed, and go to the new date. | 64 ;; Put the new month on the screen, if needed, and go to the new date. |
| 64 (let ((new-cursor-date (list month day year))) | 65 (let ((new-cursor-date (list month day year))) |
| 65 (if (not (calendar-date-is-visible-p new-cursor-date)) | 66 (if (not (calendar-date-is-visible-p new-cursor-date)) |
| 66 (calendar-other-month month year)) | 67 (calendar-other-month month year)) |
| 67 (calendar-cursor-to-visible-date new-cursor-date)))) | 68 (calendar-cursor-to-visible-date new-cursor-date))) |
| 69 (run-hooks 'calendar-move-hook)) | |
| 68 | 70 |
| 69 (defun calendar-forward-year (arg) | 71 (defun calendar-forward-year (arg) |
| 70 "Move the cursor forward by ARG years. | 72 "Move the cursor forward by ARG years. |
| 71 Movement is backward if ARG is negative." | 73 Movement is backward if ARG is negative." |
| 72 (interactive "p") | 74 (interactive "p") |
| 99 (generate-calendar-window month year) | 101 (generate-calendar-window month year) |
| 100 (calendar-cursor-to-visible-date | 102 (calendar-cursor-to-visible-date |
| 101 (cond | 103 (cond |
| 102 ((calendar-date-is-visible-p old-date) old-date) | 104 ((calendar-date-is-visible-p old-date) old-date) |
| 103 ((calendar-date-is-visible-p today) today) | 105 ((calendar-date-is-visible-p today) today) |
| 104 (t (list month 1 year)))))))) | 106 (t (list month 1 year))))))) |
| 107 (run-hooks 'calendar-move-hook)) | |
| 105 | 108 |
| 106 (defun scroll-calendar-right (arg) | 109 (defun scroll-calendar-right (arg) |
| 107 "Scroll the displayed calendar window right by ARG months. | 110 "Scroll the displayed calendar window right by ARG months. |
| 108 If ARG is negative the calendar is scrolled left. Maintains the relative | 111 If ARG is negative the calendar is scrolled left. Maintains the relative |
| 109 position of the cursor with respect to the calendar as well as possible." | 112 position of the cursor with respect to the calendar as well as possible." |
| 166 (new-display-month (extract-calendar-month new-cursor-date)) | 169 (new-display-month (extract-calendar-month new-cursor-date)) |
| 167 (new-display-year (extract-calendar-year new-cursor-date))) | 170 (new-display-year (extract-calendar-year new-cursor-date))) |
| 168 ;; Put the new month on the screen, if needed, and go to the new date. | 171 ;; Put the new month on the screen, if needed, and go to the new date. |
| 169 (if (not (calendar-date-is-visible-p new-cursor-date)) | 172 (if (not (calendar-date-is-visible-p new-cursor-date)) |
| 170 (calendar-other-month new-display-month new-display-year)) | 173 (calendar-other-month new-display-month new-display-year)) |
| 171 (calendar-cursor-to-visible-date new-cursor-date)))) | 174 (calendar-cursor-to-visible-date new-cursor-date))) |
| 175 (run-hooks 'calendar-move-hook)) | |
| 172 | 176 |
| 173 (defun calendar-backward-day (arg) | 177 (defun calendar-backward-day (arg) |
| 174 "Move the cursor back ARG days. | 178 "Move the cursor back ARG days. |
| 175 Moves forward if ARG is negative." | 179 Moves forward if ARG is negative." |
| 176 (interactive "p") | 180 (interactive "p") |
| 241 month | 245 month |
| 242 (calendar-last-day-of-month month year) | 246 (calendar-last-day-of-month month year) |
| 243 year))) | 247 year))) |
| 244 (if (not (calendar-date-is-visible-p last-day)) | 248 (if (not (calendar-date-is-visible-p last-day)) |
| 245 (calendar-other-month month year) | 249 (calendar-other-month month year) |
| 246 (calendar-cursor-to-visible-date last-day))))) | 250 (calendar-cursor-to-visible-date last-day)))) |
| 251 (run-hooks 'calendar-move-hook)) | |
| 247 | 252 |
| 248 (defun calendar-beginning-of-year (arg) | 253 (defun calendar-beginning-of-year (arg) |
| 249 "Move the cursor backward ARG year beginnings." | 254 "Move the cursor backward ARG year beginnings." |
| 250 (interactive "p") | 255 (interactive "p") |
| 251 (calendar-cursor-to-nearest-date) | 256 (calendar-cursor-to-nearest-date) |
| 252 (let* ((date (calendar-cursor-to-date)) | 257 (let* ((date (calendar-cursor-to-date)) |
| 253 (month (extract-calendar-month date)) | 258 (month (extract-calendar-month date)) |
| 254 (day (extract-calendar-day date)) | 259 (day (extract-calendar-day date)) |
| 255 (year (extract-calendar-year date)) | 260 (year (extract-calendar-year date)) |
| 256 (jan-first (list 1 1 year))) | 261 (jan-first (list 1 1 year)) |
| 262 (calendar-move-hook nil)) | |
| 257 (if (and (= day 1) (= 1 month)) | 263 (if (and (= day 1) (= 1 month)) |
| 258 (calendar-backward-month (* 12 arg)) | 264 (calendar-backward-month (* 12 arg)) |
| 259 (if (and (= arg 1) | 265 (if (and (= arg 1) |
| 260 (calendar-date-is-visible-p jan-first)) | 266 (calendar-date-is-visible-p jan-first)) |
| 261 (calendar-cursor-to-visible-date jan-first) | 267 (calendar-cursor-to-visible-date jan-first) |
| 262 (calendar-other-month 1 (- year (1- arg))))))) | 268 (calendar-other-month 1 (- year (1- arg)))))) |
| 269 (run-hooks 'calendar-move-hook)) | |
| 263 | 270 |
| 264 (defun calendar-end-of-year (arg) | 271 (defun calendar-end-of-year (arg) |
| 265 "Move the cursor forward ARG year beginnings." | 272 "Move the cursor forward ARG year beginnings." |
| 266 (interactive "p") | 273 (interactive "p") |
| 267 (calendar-cursor-to-nearest-date) | 274 (calendar-cursor-to-nearest-date) |
| 268 (let* ((date (calendar-cursor-to-date)) | 275 (let* ((date (calendar-cursor-to-date)) |
| 269 (month (extract-calendar-month date)) | 276 (month (extract-calendar-month date)) |
| 270 (day (extract-calendar-day date)) | 277 (day (extract-calendar-day date)) |
| 271 (year (extract-calendar-year date)) | 278 (year (extract-calendar-year date)) |
| 272 (dec-31 (list 12 31 year))) | 279 (dec-31 (list 12 31 year)) |
| 280 (calendar-move-hook nil)) | |
| 273 (if (and (= day 31) (= 12 month)) | 281 (if (and (= day 31) (= 12 month)) |
| 274 (calendar-forward-month (* 12 arg)) | 282 (calendar-forward-month (* 12 arg)) |
| 275 (if (and (= arg 1) | 283 (if (and (= arg 1) |
| 276 (calendar-date-is-visible-p dec-31)) | 284 (calendar-date-is-visible-p dec-31)) |
| 277 (calendar-cursor-to-visible-date dec-31) | 285 (calendar-cursor-to-visible-date dec-31) |
| 278 (calendar-other-month 12 (- year (1- arg))) | 286 (calendar-other-month 12 (- year (1- arg))) |
| 279 (calendar-cursor-to-visible-date (list 12 31 displayed-year)))))) | 287 (calendar-cursor-to-visible-date (list 12 31 displayed-year))))) |
| 288 (run-hooks 'calendar-move-hook)) | |
| 280 | 289 |
| 281 (defun calendar-cursor-to-visible-date (date) | 290 (defun calendar-cursor-to-visible-date (date) |
| 282 "Move the cursor to DATE that is on the screen." | 291 "Move the cursor to DATE that is on the screen." |
| 283 (let* ((month (extract-calendar-month date)) | 292 (let* ((month (extract-calendar-month date)) |
| 284 (day (extract-calendar-day date)) | 293 (day (extract-calendar-day date)) |
| 309 (calendar-other-month | 318 (calendar-other-month |
| 310 (if (and (= month 1) (= year 1)) | 319 (if (and (= month 1) (= year 1)) |
| 311 2 | 320 2 |
| 312 month) | 321 month) |
| 313 year))) | 322 year))) |
| 314 (calendar-cursor-to-visible-date date)) | 323 (calendar-cursor-to-visible-date date) |
| 324 (run-hooks 'calendar-move-hook)) | |
| 315 | 325 |
| 316 (provide 'cal-move) | 326 (provide 'cal-move) |
| 317 | 327 |
| 318 ;;; cal-move.el ends here | 328 ;;; cal-move.el ends here |