Mercurial > emacs
comparison lisp/calendar/cal-move.el @ 92590:8ef3d5355402
Unquote lambda functions. Add autoload cookies to functions formerly
autoloaded in calendar.el. Set `generated-autoload-file' to
"cal-loaddefs.el".
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Sat, 08 Mar 2008 03:45:27 +0000 |
| parents | 107ccd98fa12 |
| children | decf6dfe9876 |
comparison
equal
deleted
inserted
replaced
| 92589:c11e81a389cf | 92590:8ef3d5355402 |
|---|---|
| 35 (defvar displayed-month) | 35 (defvar displayed-month) |
| 36 (defvar displayed-year) | 36 (defvar displayed-year) |
| 37 | 37 |
| 38 (require 'calendar) | 38 (require 'calendar) |
| 39 | 39 |
| 40 ;;;###autoload | |
| 40 (defun calendar-goto-today () | 41 (defun calendar-goto-today () |
| 41 "Reposition the calendar window so the current date is visible." | 42 "Reposition the calendar window so the current date is visible." |
| 42 (interactive) | 43 (interactive) |
| 43 (let ((today (calendar-current-date)));; The date might have changed. | 44 (let ((today (calendar-current-date)));; The date might have changed. |
| 44 (if (not (calendar-date-is-visible-p today)) | 45 (if (not (calendar-date-is-visible-p today)) |
| 45 (generate-calendar-window) | 46 (generate-calendar-window) |
| 46 (update-calendar-mode-line) | 47 (update-calendar-mode-line) |
| 47 (calendar-cursor-to-visible-date today))) | 48 (calendar-cursor-to-visible-date today))) |
| 48 (run-hooks 'calendar-move-hook)) | 49 (run-hooks 'calendar-move-hook)) |
| 49 | 50 |
| 51 ;;;###autoload | |
| 50 (defun calendar-forward-month (arg) | 52 (defun calendar-forward-month (arg) |
| 51 "Move the cursor forward ARG months. | 53 "Move the cursor forward ARG months. |
| 52 Movement is backward if ARG is negative." | 54 Movement is backward if ARG is negative." |
| 53 (interactive "p") | 55 (interactive "p") |
| 54 (calendar-cursor-to-nearest-date) | 56 (calendar-cursor-to-nearest-date) |
| 65 (if (not (calendar-date-is-visible-p new-cursor-date)) | 67 (if (not (calendar-date-is-visible-p new-cursor-date)) |
| 66 (calendar-other-month month year)) | 68 (calendar-other-month month year)) |
| 67 (calendar-cursor-to-visible-date new-cursor-date))) | 69 (calendar-cursor-to-visible-date new-cursor-date))) |
| 68 (run-hooks 'calendar-move-hook)) | 70 (run-hooks 'calendar-move-hook)) |
| 69 | 71 |
| 72 ;;;###autoload | |
| 70 (defun calendar-forward-year (arg) | 73 (defun calendar-forward-year (arg) |
| 71 "Move the cursor forward by ARG years. | 74 "Move the cursor forward by ARG years. |
| 72 Movement is backward if ARG is negative." | 75 Movement is backward if ARG is negative." |
| 73 (interactive "p") | 76 (interactive "p") |
| 74 (calendar-forward-month (* 12 arg))) | 77 (calendar-forward-month (* 12 arg))) |
| 75 | 78 |
| 79 ;;;###autoload | |
| 76 (defun calendar-backward-month (arg) | 80 (defun calendar-backward-month (arg) |
| 77 "Move the cursor backward by ARG months. | 81 "Move the cursor backward by ARG months. |
| 78 Movement is forward if ARG is negative." | 82 Movement is forward if ARG is negative." |
| 79 (interactive "p") | 83 (interactive "p") |
| 80 (calendar-forward-month (- arg))) | 84 (calendar-forward-month (- arg))) |
| 81 | 85 |
| 86 ;;;###autoload | |
| 82 (defun calendar-backward-year (arg) | 87 (defun calendar-backward-year (arg) |
| 83 "Move the cursor backward ARG years. | 88 "Move the cursor backward ARG years. |
| 84 Movement is forward is ARG is negative." | 89 Movement is forward is ARG is negative." |
| 85 (interactive "p") | 90 (interactive "p") |
| 86 (calendar-forward-month (* -12 arg))) | 91 (calendar-forward-month (* -12 arg))) |
| 87 | 92 |
| 93 ;;;###autoload | |
| 88 (defun calendar-scroll-left (&optional arg event) | 94 (defun calendar-scroll-left (&optional arg event) |
| 89 "Scroll the displayed calendar left by ARG months. | 95 "Scroll the displayed calendar left by ARG months. |
| 90 If ARG is negative the calendar is scrolled right. Maintains the relative | 96 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." | 97 position of the cursor with respect to the calendar as well as possible." |
| 92 (interactive (list (prefix-numeric-value current-prefix-arg) | 98 (interactive (list (prefix-numeric-value current-prefix-arg) |
| 107 ((calendar-date-is-visible-p old-date) old-date) | 113 ((calendar-date-is-visible-p old-date) old-date) |
| 108 ((calendar-date-is-visible-p today) today) | 114 ((calendar-date-is-visible-p today) today) |
| 109 (t (list month 1 year))))))) | 115 (t (list month 1 year))))))) |
| 110 (run-hooks 'calendar-move-hook))) | 116 (run-hooks 'calendar-move-hook))) |
| 111 | 117 |
| 118 ;;;###autoload | |
| 112 (defun calendar-scroll-right (&optional arg event) | 119 (defun calendar-scroll-right (&optional arg event) |
| 113 "Scroll the displayed calendar window right by ARG months. | 120 "Scroll the displayed calendar window right by ARG months. |
| 114 If ARG is negative the calendar is scrolled left. Maintains the relative | 121 If ARG is negative the calendar is scrolled left. Maintains the relative |
| 115 position of the cursor with respect to the calendar as well as possible." | 122 position of the cursor with respect to the calendar as well as possible." |
| 116 (interactive (list (prefix-numeric-value current-prefix-arg) | 123 (interactive (list (prefix-numeric-value current-prefix-arg) |
| 117 last-nonmenu-event)) | 124 last-nonmenu-event)) |
| 118 (calendar-scroll-left (- (or arg 1)) event)) | 125 (calendar-scroll-left (- (or arg 1)) event)) |
| 119 | 126 |
| 127 ;;;###autoload | |
| 120 (defun calendar-scroll-left-three-months (arg) | 128 (defun calendar-scroll-left-three-months (arg) |
| 121 "Scroll the displayed calendar window left by 3*ARG months. | 129 "Scroll the displayed calendar window left by 3*ARG months. |
| 122 If ARG is negative the calendar is scrolled right. Maintains the relative | 130 If ARG is negative the calendar is scrolled right. Maintains the relative |
| 123 position of the cursor with respect to the calendar as well as possible." | 131 position of the cursor with respect to the calendar as well as possible." |
| 124 (interactive "p") | 132 (interactive "p") |
| 125 (calendar-scroll-left (* 3 arg))) | 133 (calendar-scroll-left (* 3 arg))) |
| 126 | 134 |
| 135 ;;;###autoload | |
| 127 (defun calendar-scroll-right-three-months (arg) | 136 (defun calendar-scroll-right-three-months (arg) |
| 128 "Scroll the displayed calendar window right by 3*ARG months. | 137 "Scroll the displayed calendar window right by 3*ARG months. |
| 129 If ARG is negative the calendar is scrolled left. Maintains the relative | 138 If ARG is negative the calendar is scrolled left. Maintains the relative |
| 130 position of the cursor with respect to the calendar as well as possible." | 139 position of the cursor with respect to the calendar as well as possible." |
| 131 (interactive "p") | 140 (interactive "p") |
| 132 (calendar-scroll-left (* -3 arg))) | 141 (calendar-scroll-left (* -3 arg))) |
| 133 | 142 |
| 143 ;;;###autoload | |
| 134 (defun calendar-cursor-to-nearest-date () | 144 (defun calendar-cursor-to-nearest-date () |
| 135 "Move the cursor to the closest date. | 145 "Move the cursor to the closest date. |
| 136 The position of the cursor is unchanged if it is already on a date. | 146 The position of the cursor is unchanged if it is already on a date. |
| 137 Returns the list (month day year) giving the cursor position." | 147 Returns the list (month day year) giving the cursor position." |
| 138 (let ((date (calendar-cursor-to-date)) | 148 (let ((date (calendar-cursor-to-date)) |
| 154 (re-search-forward "[0-9]" nil t) | 164 (re-search-forward "[0-9]" nil t) |
| 155 (backward-char 1)) | 165 (backward-char 1)) |
| 156 (re-search-backward "[0-9]" nil t))) | 166 (re-search-backward "[0-9]" nil t))) |
| 157 (calendar-cursor-to-date)))) | 167 (calendar-cursor-to-date)))) |
| 158 | 168 |
| 169 ;;;###autoload | |
| 159 (defun calendar-forward-day (arg) | 170 (defun calendar-forward-day (arg) |
| 160 "Move the cursor forward ARG days. | 171 "Move the cursor forward ARG days. |
| 161 Moves backward if ARG is negative." | 172 Moves backward if ARG is negative." |
| 162 (interactive "p") | 173 (interactive "p") |
| 163 (if (/= 0 arg) | 174 (if (/= 0 arg) |
| 176 (if (not (calendar-date-is-visible-p new-cursor-date)) | 187 (if (not (calendar-date-is-visible-p new-cursor-date)) |
| 177 (calendar-other-month new-display-month new-display-year)) | 188 (calendar-other-month new-display-month new-display-year)) |
| 178 (calendar-cursor-to-visible-date new-cursor-date))) | 189 (calendar-cursor-to-visible-date new-cursor-date))) |
| 179 (run-hooks 'calendar-move-hook)) | 190 (run-hooks 'calendar-move-hook)) |
| 180 | 191 |
| 192 ;;;###autoload | |
| 181 (defun calendar-backward-day (arg) | 193 (defun calendar-backward-day (arg) |
| 182 "Move the cursor back ARG days. | 194 "Move the cursor back ARG days. |
| 183 Moves forward if ARG is negative." | 195 Moves forward if ARG is negative." |
| 184 (interactive "p") | 196 (interactive "p") |
| 185 (calendar-forward-day (- arg))) | 197 (calendar-forward-day (- arg))) |
| 186 | 198 |
| 199 ;;;###autoload | |
| 187 (defun calendar-forward-week (arg) | 200 (defun calendar-forward-week (arg) |
| 188 "Move the cursor forward ARG weeks. | 201 "Move the cursor forward ARG weeks. |
| 189 Moves backward if ARG is negative." | 202 Moves backward if ARG is negative." |
| 190 (interactive "p") | 203 (interactive "p") |
| 191 (calendar-forward-day (* arg 7))) | 204 (calendar-forward-day (* arg 7))) |
| 192 | 205 |
| 206 ;;;###autoload | |
| 193 (defun calendar-backward-week (arg) | 207 (defun calendar-backward-week (arg) |
| 194 "Move the cursor back ARG weeks. | 208 "Move the cursor back ARG weeks. |
| 195 Moves forward if ARG is negative." | 209 Moves forward if ARG is negative." |
| 196 (interactive "p") | 210 (interactive "p") |
| 197 (calendar-forward-day (* arg -7))) | 211 (calendar-forward-day (* arg -7))) |
| 198 | 212 |
| 213 ;;;###autoload | |
| 199 (defun calendar-beginning-of-week (arg) | 214 (defun calendar-beginning-of-week (arg) |
| 200 "Move the cursor back ARG calendar-week-start-day's." | 215 "Move the cursor back ARG calendar-week-start-day's." |
| 201 (interactive "p") | 216 (interactive "p") |
| 202 (calendar-cursor-to-nearest-date) | 217 (calendar-cursor-to-nearest-date) |
| 203 (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) | 218 (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) |
| 205 (if (= day calendar-week-start-day) | 220 (if (= day calendar-week-start-day) |
| 206 (* 7 arg) | 221 (* 7 arg) |
| 207 (+ (mod (- day calendar-week-start-day) 7) | 222 (+ (mod (- day calendar-week-start-day) 7) |
| 208 (* 7 (1- arg))))))) | 223 (* 7 (1- arg))))))) |
| 209 | 224 |
| 225 ;;;###autoload | |
| 210 (defun calendar-end-of-week (arg) | 226 (defun calendar-end-of-week (arg) |
| 211 "Move the cursor forward ARG calendar-week-start-day+6's." | 227 "Move the cursor forward ARG calendar-week-start-day+6's." |
| 212 (interactive "p") | 228 (interactive "p") |
| 213 (calendar-cursor-to-nearest-date) | 229 (calendar-cursor-to-nearest-date) |
| 214 (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) | 230 (let ((day (calendar-day-of-week (calendar-cursor-to-date)))) |
| 216 (if (= day (mod (1- calendar-week-start-day) 7)) | 232 (if (= day (mod (1- calendar-week-start-day) 7)) |
| 217 (* 7 arg) | 233 (* 7 arg) |
| 218 (+ (- 6 (mod (- day calendar-week-start-day) 7)) | 234 (+ (- 6 (mod (- day calendar-week-start-day) 7)) |
| 219 (* 7 (1- arg))))))) | 235 (* 7 (1- arg))))))) |
| 220 | 236 |
| 237 ;;;###autoload | |
| 221 (defun calendar-beginning-of-month (arg) | 238 (defun calendar-beginning-of-month (arg) |
| 222 "Move the cursor backward ARG month beginnings." | 239 "Move the cursor backward ARG month beginnings." |
| 223 (interactive "p") | 240 (interactive "p") |
| 224 (calendar-cursor-to-nearest-date) | 241 (calendar-cursor-to-nearest-date) |
| 225 (let* ((date (calendar-cursor-to-date)) | 242 (let* ((date (calendar-cursor-to-date)) |
| 229 (if (= day 1) | 246 (if (= day 1) |
| 230 (calendar-backward-month arg) | 247 (calendar-backward-month arg) |
| 231 (calendar-cursor-to-visible-date (list month 1 year)) | 248 (calendar-cursor-to-visible-date (list month 1 year)) |
| 232 (calendar-backward-month (1- arg))))) | 249 (calendar-backward-month (1- arg))))) |
| 233 | 250 |
| 251 ;;;###autoload | |
| 234 (defun calendar-end-of-month (arg) | 252 (defun calendar-end-of-month (arg) |
| 235 "Move the cursor forward ARG month ends." | 253 "Move the cursor forward ARG month ends." |
| 236 (interactive "p") | 254 (interactive "p") |
| 237 (calendar-cursor-to-nearest-date) | 255 (calendar-cursor-to-nearest-date) |
| 238 (let* ((date (calendar-cursor-to-date)) | 256 (let* ((date (calendar-cursor-to-date)) |
| 252 (if (not (calendar-date-is-visible-p last-day)) | 270 (if (not (calendar-date-is-visible-p last-day)) |
| 253 (calendar-other-month month year) | 271 (calendar-other-month month year) |
| 254 (calendar-cursor-to-visible-date last-day)))) | 272 (calendar-cursor-to-visible-date last-day)))) |
| 255 (run-hooks 'calendar-move-hook)) | 273 (run-hooks 'calendar-move-hook)) |
| 256 | 274 |
| 275 ;;;###autoload | |
| 257 (defun calendar-beginning-of-year (arg) | 276 (defun calendar-beginning-of-year (arg) |
| 258 "Move the cursor backward ARG year beginnings." | 277 "Move the cursor backward ARG year beginnings." |
| 259 (interactive "p") | 278 (interactive "p") |
| 260 (calendar-cursor-to-nearest-date) | 279 (calendar-cursor-to-nearest-date) |
| 261 (let* ((date (calendar-cursor-to-date)) | 280 (let* ((date (calendar-cursor-to-date)) |
| 271 (calendar-cursor-to-visible-date jan-first) | 290 (calendar-cursor-to-visible-date jan-first) |
| 272 (calendar-other-month 1 (- year (1- arg))) | 291 (calendar-other-month 1 (- year (1- arg))) |
| 273 (calendar-cursor-to-visible-date (list 1 1 displayed-year))))) | 292 (calendar-cursor-to-visible-date (list 1 1 displayed-year))))) |
| 274 (run-hooks 'calendar-move-hook)) | 293 (run-hooks 'calendar-move-hook)) |
| 275 | 294 |
| 295 ;;;###autoload | |
| 276 (defun calendar-end-of-year (arg) | 296 (defun calendar-end-of-year (arg) |
| 277 "Move the cursor forward ARG year beginnings." | 297 "Move the cursor forward ARG year beginnings." |
| 278 (interactive "p") | 298 (interactive "p") |
| 279 (calendar-cursor-to-nearest-date) | 299 (calendar-cursor-to-nearest-date) |
| 280 (let* ((date (calendar-cursor-to-date)) | 300 (let* ((date (calendar-cursor-to-date)) |
| 290 (calendar-cursor-to-visible-date dec-31) | 310 (calendar-cursor-to-visible-date dec-31) |
| 291 (calendar-other-month 12 (+ year (1- arg))) | 311 (calendar-other-month 12 (+ year (1- arg))) |
| 292 (calendar-cursor-to-visible-date (list 12 31 displayed-year))))) | 312 (calendar-cursor-to-visible-date (list 12 31 displayed-year))))) |
| 293 (run-hooks 'calendar-move-hook)) | 313 (run-hooks 'calendar-move-hook)) |
| 294 | 314 |
| 315 ;;;###autoload | |
| 295 (defun calendar-cursor-to-visible-date (date) | 316 (defun calendar-cursor-to-visible-date (date) |
| 296 "Move the cursor to DATE that is on the screen." | 317 "Move the cursor to DATE that is on the screen." |
| 297 (let* ((month (extract-calendar-month date)) | 318 (let* ((month (extract-calendar-month date)) |
| 298 (day (extract-calendar-day date)) | 319 (day (extract-calendar-day date)) |
| 299 (year (extract-calendar-year date)) | 320 (year (extract-calendar-year date)) |
| 311 displayed-month displayed-year month year))) | 332 displayed-month displayed-year month year))) |
| 312 (* 3 (mod | 333 (* 3 (mod |
| 313 (- (calendar-day-of-week date) | 334 (- (calendar-day-of-week date) |
| 314 calendar-week-start-day) | 335 calendar-week-start-day) |
| 315 7)))))) | 336 7)))))) |
| 316 | 337 ;;;###autoload |
| 317 (defun calendar-goto-date (date) | 338 (defun calendar-goto-date (date) |
| 318 "Move cursor to DATE." | 339 "Move cursor to DATE." |
| 319 (interactive (list (calendar-read-date))) | 340 (interactive (list (calendar-read-date))) |
| 320 (let ((month (extract-calendar-month date)) | 341 (let ((month (extract-calendar-month date)) |
| 321 (year (extract-calendar-year date))) | 342 (year (extract-calendar-year date))) |
| 326 month) | 347 month) |
| 327 year))) | 348 year))) |
| 328 (calendar-cursor-to-visible-date date) | 349 (calendar-cursor-to-visible-date date) |
| 329 (run-hooks 'calendar-move-hook)) | 350 (run-hooks 'calendar-move-hook)) |
| 330 | 351 |
| 352 ;;;###autoload | |
| 331 (defun calendar-goto-day-of-year (year day &optional noecho) | 353 (defun calendar-goto-day-of-year (year day &optional noecho) |
| 332 "Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is t. | 354 "Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is t. |
| 333 Negative DAY counts backward from end of year." | 355 Negative DAY counts backward from end of year." |
| 334 (interactive | 356 (interactive |
| 335 (let* ((year (calendar-read | 357 (let* ((year (calendar-read |
| 338 (int-to-string (extract-calendar-year | 360 (int-to-string (extract-calendar-year |
| 339 (calendar-current-date))))) | 361 (calendar-current-date))))) |
| 340 (last (if (calendar-leap-year-p year) 366 365)) | 362 (last (if (calendar-leap-year-p year) 366 365)) |
| 341 (day (calendar-read | 363 (day (calendar-read |
| 342 (format "Day number (+/- 1-%d): " last) | 364 (format "Day number (+/- 1-%d): " last) |
| 343 '(lambda (x) (and (<= 1 (abs x)) (<= (abs x) last)))))) | 365 (lambda (x) (and (<= 1 (abs x)) (<= (abs x) last)))))) |
| 344 (list year day))) | 366 (list year day))) |
| 345 (calendar-goto-date | 367 (calendar-goto-date |
| 346 (calendar-gregorian-from-absolute | 368 (calendar-gregorian-from-absolute |
| 347 (if (< 0 day) | 369 (if (< 0 day) |
| 348 (+ -1 day (calendar-absolute-from-gregorian (list 1 1 year))) | 370 (+ -1 day (calendar-absolute-from-gregorian (list 1 1 year))) |
| 359 (define-obsolete-function-alias | 381 (define-obsolete-function-alias |
| 360 'scroll-calendar-right-three-months 'calendar-scroll-right-three-months "23.1") | 382 'scroll-calendar-right-three-months 'calendar-scroll-right-three-months "23.1") |
| 361 | 383 |
| 362 (provide 'cal-move) | 384 (provide 'cal-move) |
| 363 | 385 |
| 386 ;; Local Variables: | |
| 387 ;; generated-autoload-file: "cal-loaddefs.el" | |
| 388 ;; End: | |
| 389 | |
| 364 ;; arch-tag: d0883c46-7e16-4914-8ff8-8f67e699b781 | 390 ;; arch-tag: d0883c46-7e16-4914-8ff8-8f67e699b781 |
| 365 ;;; cal-move.el ends here | 391 ;;; cal-move.el ends here |