diff options
| author | Glenn Morris | 2008-03-14 06:45:16 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-14 06:45:16 +0000 |
| commit | cfcc468faac65a8e21abd90d62937bf3254ad491 (patch) | |
| tree | 85eb8acf4a61ee91bc1f22079c8c05b17ed58220 | |
| parent | 4b8683c7c5bc3bcdf1c976d5f90ecfc1f3103966 (diff) | |
| download | emacs-cfcc468faac65a8e21abd90d62937bf3254ad491.tar.gz emacs-cfcc468faac65a8e21abd90d62937bf3254ad491.zip | |
(calendar-cursor-to-nearest-date): Use or, when. Move definition before use.
(calendar-cursor-to-visible-date): Move definition before use.
(calendar-scroll-left): Use unless and zerop. Combine lets into one,
and place inside the conditional.
(calendar-forward-day): Simplify.
(calendar-end-of-month): Use unless.
(calendar-goto-day-of-year): Doc fix.
Relocate obsolete aliases after their replacements.
| -rw-r--r-- | lisp/ChangeLog | 10 | ||||
| -rw-r--r-- | lisp/calendar/cal-move.el | 178 |
2 files changed, 98 insertions, 90 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 836bdb42866..82a09876b3d 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -53,6 +53,16 @@ | |||
| 53 | Doc fix. | 53 | Doc fix. |
| 54 | (calendar-mouse-goto-date): Move definition before use. | 54 | (calendar-mouse-goto-date): Move definition before use. |
| 55 | 55 | ||
| 56 | * calendar/cal-move.el (calendar-cursor-to-nearest-date): Use or, when. | ||
| 57 | Move definition before use. | ||
| 58 | (calendar-cursor-to-visible-date): Move definition before use. | ||
| 59 | (calendar-scroll-left): Use unless and zerop. Combine lets into one, | ||
| 60 | and place inside the conditional. | ||
| 61 | (calendar-forward-day): Simplify. | ||
| 62 | (calendar-end-of-month): Use unless. | ||
| 63 | (calendar-goto-day-of-year): Doc fix. | ||
| 64 | Relocate obsolete aliases after their replacements. | ||
| 65 | |||
| 56 | * calendar/cal-persia.el (calendar-goto-persian-date): Doc fix. | 66 | * calendar/cal-persia.el (calendar-goto-persian-date): Doc fix. |
| 57 | 67 | ||
| 58 | * calendar/diary-lib.el (mark-diary-entries): Move some constant | 68 | * calendar/diary-lib.el (mark-diary-entries): Move some constant |
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el index 92e569e0a59..2aef750db68 100644 --- a/lisp/calendar/cal-move.el +++ b/lisp/calendar/cal-move.el | |||
| @@ -32,16 +32,63 @@ | |||
| 32 | 32 | ||
| 33 | ;;; Code: | 33 | ;;; Code: |
| 34 | 34 | ||
| 35 | (defvar displayed-month) | 35 | (require 'calendar) |
| 36 | |||
| 37 | ;;;###cal-autoload | ||
| 38 | (defun calendar-cursor-to-nearest-date () | ||
| 39 | "Move the cursor to the closest date. | ||
| 40 | The position of the cursor is unchanged if it is already on a date. | ||
| 41 | Returns the list (month day year) giving the cursor position." | ||
| 42 | (let ((date (calendar-cursor-to-date)) | ||
| 43 | (column (current-column))) | ||
| 44 | (or date | ||
| 45 | (when (> 3 (count-lines (point-min) (point))) | ||
| 46 | (goto-line 3) | ||
| 47 | (move-to-column column)) | ||
| 48 | (if (not (looking-at "[0-9]")) | ||
| 49 | (if (and (not (looking-at " *$")) | ||
| 50 | (or (< column 25) | ||
| 51 | (and (> column 27) | ||
| 52 | (< column 50)) | ||
| 53 | (and (> column 52) | ||
| 54 | (< column 75)))) | ||
| 55 | (progn | ||
| 56 | (re-search-forward "[0-9]" nil t) | ||
| 57 | (backward-char 1)) | ||
| 58 | (re-search-backward "[0-9]" nil t))) | ||
| 59 | (calendar-cursor-to-date)))) | ||
| 60 | |||
| 61 | (defvar displayed-month) ; from generate-calendar | ||
| 36 | (defvar displayed-year) | 62 | (defvar displayed-year) |
| 37 | 63 | ||
| 38 | (require 'calendar) | 64 | ;;;###cal-autoload |
| 65 | (defun calendar-cursor-to-visible-date (date) | ||
| 66 | "Move the cursor to DATE that is on the screen." | ||
| 67 | (let* ((month (extract-calendar-month date)) | ||
| 68 | (day (extract-calendar-day date)) | ||
| 69 | (year (extract-calendar-year date)) | ||
| 70 | (first-of-month-weekday (calendar-day-of-week (list month 1 year)))) | ||
| 71 | (goto-line (+ 3 | ||
| 72 | (/ (+ day -1 | ||
| 73 | (mod | ||
| 74 | (- (calendar-day-of-week (list month 1 year)) | ||
| 75 | calendar-week-start-day) | ||
| 76 | 7)) | ||
| 77 | 7))) | ||
| 78 | (move-to-column (+ 6 | ||
| 79 | (* 25 | ||
| 80 | (1+ (calendar-interval | ||
| 81 | displayed-month displayed-year month year))) | ||
| 82 | (* 3 (mod | ||
| 83 | (- (calendar-day-of-week date) | ||
| 84 | calendar-week-start-day) | ||
| 85 | 7)))))) | ||
| 39 | 86 | ||
| 40 | ;;;###cal-autoload | 87 | ;;;###cal-autoload |
| 41 | (defun calendar-goto-today () | 88 | (defun calendar-goto-today () |
| 42 | "Reposition the calendar window so the current date is visible." | 89 | "Reposition the calendar window so the current date is visible." |
| 43 | (interactive) | 90 | (interactive) |
| 44 | (let ((today (calendar-current-date)));; The date might have changed. | 91 | (let ((today (calendar-current-date))) ; the date might have changed |
| 45 | (if (not (calendar-date-is-visible-p today)) | 92 | (if (not (calendar-date-is-visible-p today)) |
| 46 | (generate-calendar-window) | 93 | (generate-calendar-window) |
| 47 | (update-calendar-mode-line) | 94 | (update-calendar-mode-line) |
| @@ -61,7 +108,7 @@ Movement is backward if ARG is negative." | |||
| 61 | (increment-calendar-month month year arg) | 108 | (increment-calendar-month month year arg) |
| 62 | (let ((last (calendar-last-day-of-month month year))) | 109 | (let ((last (calendar-last-day-of-month month year))) |
| 63 | (if (< last day) | 110 | (if (< last day) |
| 64 | (setq day last))) | 111 | (setq day last))) |
| 65 | ;; Put the new month on the screen, if needed, and go to the new date. | 112 | ;; Put the new month on the screen, if needed, and go to the new date. |
| 66 | (let ((new-cursor-date (list month day year))) | 113 | (let ((new-cursor-date (list month day year))) |
| 67 | (if (not (calendar-date-is-visible-p new-cursor-date)) | 114 | (if (not (calendar-date-is-visible-p new-cursor-date)) |
| @@ -102,20 +149,23 @@ EVENT is an event like `last-nonmenu-event'." | |||
| 102 | (save-selected-window | 149 | (save-selected-window |
| 103 | (select-window (posn-window (event-start event))) | 150 | (select-window (posn-window (event-start event))) |
| 104 | (calendar-cursor-to-nearest-date) | 151 | (calendar-cursor-to-nearest-date) |
| 105 | (let ((old-date (calendar-cursor-to-date)) | 152 | (unless (zerop arg) |
| 106 | (today (calendar-current-date))) | 153 | (let ((old-date (calendar-cursor-to-date)) |
| 107 | (if (/= arg 0) | 154 | (today (calendar-current-date)) |
| 108 | (let ((month displayed-month) | 155 | (month displayed-month) |
| 109 | (year displayed-year)) | 156 | (year displayed-year)) |
| 110 | (increment-calendar-month month year arg) | 157 | (increment-calendar-month month year arg) |
| 111 | (generate-calendar-window month year) | 158 | (generate-calendar-window month year) |
| 112 | (calendar-cursor-to-visible-date | 159 | (calendar-cursor-to-visible-date |
| 113 | (cond | 160 | (cond |
| 114 | ((calendar-date-is-visible-p old-date) old-date) | 161 | ((calendar-date-is-visible-p old-date) old-date) |
| 115 | ((calendar-date-is-visible-p today) today) | 162 | ((calendar-date-is-visible-p today) today) |
| 116 | (t (list month 1 year))))))) | 163 | (t (list month 1 year)))))) |
| 117 | (run-hooks 'calendar-move-hook))) | 164 | (run-hooks 'calendar-move-hook))) |
| 118 | 165 | ||
| 166 | (define-obsolete-function-alias | ||
| 167 | 'scroll-calendar-left 'calendar-scroll-left "23.1") | ||
| 168 | |||
| 119 | ;;;###cal-autoload | 169 | ;;;###cal-autoload |
| 120 | (defun calendar-scroll-right (&optional arg event) | 170 | (defun calendar-scroll-right (&optional arg event) |
| 121 | "Scroll the displayed calendar window right by ARG months. | 171 | "Scroll the displayed calendar window right by ARG months. |
| @@ -126,6 +176,9 @@ EVENT is an event like `last-nonmenu-event'." | |||
| 126 | last-nonmenu-event)) | 176 | last-nonmenu-event)) |
| 127 | (calendar-scroll-left (- (or arg 1)) event)) | 177 | (calendar-scroll-left (- (or arg 1)) event)) |
| 128 | 178 | ||
| 179 | (define-obsolete-function-alias | ||
| 180 | 'scroll-calendar-right 'calendar-scroll-right "23.1") | ||
| 181 | |||
| 129 | ;;;###cal-autoload | 182 | ;;;###cal-autoload |
| 130 | (defun calendar-scroll-left-three-months (arg) | 183 | (defun calendar-scroll-left-three-months (arg) |
| 131 | "Scroll the displayed calendar window left by 3*ARG months. | 184 | "Scroll the displayed calendar window left by 3*ARG months. |
| @@ -134,6 +187,9 @@ position of the cursor with respect to the calendar as well as possible." | |||
| 134 | (interactive "p") | 187 | (interactive "p") |
| 135 | (calendar-scroll-left (* 3 arg))) | 188 | (calendar-scroll-left (* 3 arg))) |
| 136 | 189 | ||
| 190 | (define-obsolete-function-alias 'scroll-calendar-left-three-months | ||
| 191 | 'calendar-scroll-left-three-months "23.1") | ||
| 192 | |||
| 137 | ;;;###cal-autoload | 193 | ;;;###cal-autoload |
| 138 | (defun calendar-scroll-right-three-months (arg) | 194 | (defun calendar-scroll-right-three-months (arg) |
| 139 | "Scroll the displayed calendar window right by 3*ARG months. | 195 | "Scroll the displayed calendar window right by 3*ARG months. |
| @@ -142,53 +198,28 @@ position of the cursor with respect to the calendar as well as possible." | |||
| 142 | (interactive "p") | 198 | (interactive "p") |
| 143 | (calendar-scroll-left (* -3 arg))) | 199 | (calendar-scroll-left (* -3 arg))) |
| 144 | 200 | ||
| 145 | ;;;###cal-autoload | 201 | (define-obsolete-function-alias 'scroll-calendar-right-three-months |
| 146 | (defun calendar-cursor-to-nearest-date () | 202 | 'calendar-scroll-right-three-months "23.1") |
| 147 | "Move the cursor to the closest date. | ||
| 148 | The position of the cursor is unchanged if it is already on a date. | ||
| 149 | Returns the list (month day year) giving the cursor position." | ||
| 150 | (let ((date (calendar-cursor-to-date)) | ||
| 151 | (column (current-column))) | ||
| 152 | (if date | ||
| 153 | date | ||
| 154 | (if (> 3 (count-lines (point-min) (point))) | ||
| 155 | (progn | ||
| 156 | (goto-line 3) | ||
| 157 | (move-to-column column))) | ||
| 158 | (if (not (looking-at "[0-9]")) | ||
| 159 | (if (and (not (looking-at " *$")) | ||
| 160 | (or (< column 25) | ||
| 161 | (and (> column 27) | ||
| 162 | (< column 50)) | ||
| 163 | (and (> column 52) | ||
| 164 | (< column 75)))) | ||
| 165 | (progn | ||
| 166 | (re-search-forward "[0-9]" nil t) | ||
| 167 | (backward-char 1)) | ||
| 168 | (re-search-backward "[0-9]" nil t))) | ||
| 169 | (calendar-cursor-to-date)))) | ||
| 170 | 203 | ||
| 171 | ;;;###cal-autoload | 204 | ;;;###cal-autoload |
| 172 | (defun calendar-forward-day (arg) | 205 | (defun calendar-forward-day (arg) |
| 173 | "Move the cursor forward ARG days. | 206 | "Move the cursor forward ARG days. |
| 174 | Moves backward if ARG is negative." | 207 | Moves backward if ARG is negative." |
| 175 | (interactive "p") | 208 | (interactive "p") |
| 176 | (if (/= 0 arg) | 209 | (unless (zerop arg) |
| 177 | (let* | 210 | (let* ((cursor-date (or (calendar-cursor-to-date) |
| 178 | ((cursor-date (calendar-cursor-to-date)) | 211 | (progn |
| 179 | (cursor-date (if cursor-date | 212 | (if (> arg 0) (setq arg (1- arg))) |
| 180 | cursor-date | 213 | (calendar-cursor-to-nearest-date)))) |
| 181 | (if (> arg 0) (setq arg (1- arg))) | ||
| 182 | (calendar-cursor-to-nearest-date))) | ||
| 183 | (new-cursor-date | 214 | (new-cursor-date |
| 184 | (calendar-gregorian-from-absolute | 215 | (calendar-gregorian-from-absolute |
| 185 | (+ (calendar-absolute-from-gregorian cursor-date) arg))) | 216 | (+ (calendar-absolute-from-gregorian cursor-date) arg))) |
| 186 | (new-display-month (extract-calendar-month new-cursor-date)) | 217 | (new-display-month (extract-calendar-month new-cursor-date)) |
| 187 | (new-display-year (extract-calendar-year new-cursor-date))) | 218 | (new-display-year (extract-calendar-year new-cursor-date))) |
| 188 | ;; Put the new month on the screen, if needed, and go to the new date. | 219 | ;; Put the new month on the screen, if needed, and go to the new date. |
| 189 | (if (not (calendar-date-is-visible-p new-cursor-date)) | 220 | (if (not (calendar-date-is-visible-p new-cursor-date)) |
| 190 | (calendar-other-month new-display-month new-display-year)) | 221 | (calendar-other-month new-display-month new-display-year)) |
| 191 | (calendar-cursor-to-visible-date new-cursor-date))) | 222 | (calendar-cursor-to-visible-date new-cursor-date))) |
| 192 | (run-hooks 'calendar-move-hook)) | 223 | (run-hooks 'calendar-move-hook)) |
| 193 | 224 | ||
| 194 | ;;;###cal-autoload | 225 | ;;;###cal-autoload |
| @@ -260,10 +291,9 @@ Moves forward if ARG is negative." | |||
| 260 | (day (extract-calendar-day date)) | 291 | (day (extract-calendar-day date)) |
| 261 | (year (extract-calendar-year date)) | 292 | (year (extract-calendar-year date)) |
| 262 | (last-day (calendar-last-day-of-month month year))) | 293 | (last-day (calendar-last-day-of-month month year))) |
| 263 | (if (/= day last-day) | 294 | (unless (= day last-day) |
| 264 | (progn | 295 | (calendar-cursor-to-visible-date (list month last-day year)) |
| 265 | (calendar-cursor-to-visible-date (list month last-day year)) | 296 | (setq arg (1- arg))) |
| 266 | (setq arg (1- arg)))) | ||
| 267 | (increment-calendar-month month year arg) | 297 | (increment-calendar-month month year arg) |
| 268 | (let ((last-day (list | 298 | (let ((last-day (list |
| 269 | month | 299 | month |
| @@ -271,7 +301,7 @@ Moves forward if ARG is negative." | |||
| 271 | year))) | 301 | year))) |
| 272 | (if (not (calendar-date-is-visible-p last-day)) | 302 | (if (not (calendar-date-is-visible-p last-day)) |
| 273 | (calendar-other-month month year) | 303 | (calendar-other-month month year) |
| 274 | (calendar-cursor-to-visible-date last-day)))) | 304 | (calendar-cursor-to-visible-date last-day)))) |
| 275 | (run-hooks 'calendar-move-hook)) | 305 | (run-hooks 'calendar-move-hook)) |
| 276 | 306 | ||
| 277 | ;;;###cal-autoload | 307 | ;;;###cal-autoload |
| @@ -315,28 +345,6 @@ Moves forward if ARG is negative." | |||
| 315 | (run-hooks 'calendar-move-hook)) | 345 | (run-hooks 'calendar-move-hook)) |
| 316 | 346 | ||
| 317 | ;;;###cal-autoload | 347 | ;;;###cal-autoload |
| 318 | (defun calendar-cursor-to-visible-date (date) | ||
| 319 | "Move the cursor to DATE that is on the screen." | ||
| 320 | (let* ((month (extract-calendar-month date)) | ||
| 321 | (day (extract-calendar-day date)) | ||
| 322 | (year (extract-calendar-year date)) | ||
| 323 | (first-of-month-weekday (calendar-day-of-week (list month 1 year)))) | ||
| 324 | (goto-line (+ 3 | ||
| 325 | (/ (+ day -1 | ||
| 326 | (mod | ||
| 327 | (- (calendar-day-of-week (list month 1 year)) | ||
| 328 | calendar-week-start-day) | ||
| 329 | 7)) | ||
| 330 | 7))) | ||
| 331 | (move-to-column (+ 6 | ||
| 332 | (* 25 | ||
| 333 | (1+ (calendar-interval | ||
| 334 | displayed-month displayed-year month year))) | ||
| 335 | (* 3 (mod | ||
| 336 | (- (calendar-day-of-week date) | ||
| 337 | calendar-week-start-day) | ||
| 338 | 7)))))) | ||
| 339 | ;;;###cal-autoload | ||
| 340 | (defun calendar-goto-date (date) | 348 | (defun calendar-goto-date (date) |
| 341 | "Move cursor to DATE." | 349 | "Move cursor to DATE." |
| 342 | (interactive (list (calendar-read-date))) | 350 | (interactive (list (calendar-read-date))) |
| @@ -353,7 +361,7 @@ Moves forward if ARG is negative." | |||
| 353 | 361 | ||
| 354 | ;;;###cal-autoload | 362 | ;;;###cal-autoload |
| 355 | (defun calendar-goto-day-of-year (year day &optional noecho) | 363 | (defun calendar-goto-day-of-year (year day &optional noecho) |
| 356 | "Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is t. | 364 | "Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is non-nil. |
| 357 | Negative DAY counts backward from end of year." | 365 | Negative DAY counts backward from end of year." |
| 358 | (interactive | 366 | (interactive |
| 359 | (let* ((year (calendar-read | 367 | (let* ((year (calendar-read |
| @@ -373,16 +381,6 @@ Negative DAY counts backward from end of year." | |||
| 373 | (+ 1 day (calendar-absolute-from-gregorian (list 12 31 year)))))) | 381 | (+ 1 day (calendar-absolute-from-gregorian (list 12 31 year)))))) |
| 374 | (or noecho (calendar-print-day-of-year))) | 382 | (or noecho (calendar-print-day-of-year))) |
| 375 | 383 | ||
| 376 | ;; Backward compatibility. | ||
| 377 | (define-obsolete-function-alias | ||
| 378 | 'scroll-calendar-left 'calendar-scroll-left "23.1") | ||
| 379 | (define-obsolete-function-alias | ||
| 380 | 'scroll-calendar-right 'calendar-scroll-right "23.1") | ||
| 381 | (define-obsolete-function-alias | ||
| 382 | 'scroll-calendar-left-three-months 'calendar-scroll-left-three-months "23.1") | ||
| 383 | (define-obsolete-function-alias | ||
| 384 | 'scroll-calendar-right-three-months 'calendar-scroll-right-three-months "23.1") | ||
| 385 | |||
| 386 | (provide 'cal-move) | 384 | (provide 'cal-move) |
| 387 | 385 | ||
| 388 | ;; arch-tag: d0883c46-7e16-4914-8ff8-8f67e699b781 | 386 | ;; arch-tag: d0883c46-7e16-4914-8ff8-8f67e699b781 |