diff options
| -rw-r--r-- | lisp/calendar/cal-move.el | 41 |
1 files changed, 26 insertions, 15 deletions
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el index 1a489d4577f..55603fda3c0 100644 --- a/lisp/calendar/cal-move.el +++ b/lisp/calendar/cal-move.el | |||
| @@ -32,28 +32,39 @@ | |||
| 32 | ;; FIXME should calendar just require this? | 32 | ;; FIXME should calendar just require this? |
| 33 | (require 'calendar) | 33 | (require 'calendar) |
| 34 | 34 | ||
| 35 | |||
| 36 | ;; Note that this is not really the "closest" date. | ||
| 37 | ;; In most cases, it just searches forwards for the next day. | ||
| 35 | ;;;###cal-autoload | 38 | ;;;###cal-autoload |
| 36 | (defun calendar-cursor-to-nearest-date () | 39 | (defun calendar-cursor-to-nearest-date () |
| 37 | "Move the cursor to the closest date. | 40 | "Move the cursor to the closest date. |
| 38 | The position of the cursor is unchanged if it is already on a date. | 41 | The position of the cursor is unchanged if it is already on a date. |
| 39 | Returns the list (month day year) giving the cursor position." | 42 | Returns the list (month day year) giving the cursor position." |
| 40 | (or (calendar-cursor-to-date) | 43 | (or (calendar-cursor-to-date) |
| 41 | (let ((column (current-column))) | 44 | (let* ((col (current-column)) |
| 42 | (when (> calendar-first-date-row (count-lines (point-min) (point))) | 45 | (edges (cdr (assoc (calendar-column-to-segment) |
| 46 | calendar-month-edges))) | ||
| 47 | (last (nth 2 edges)) | ||
| 48 | (right (nth 3 edges))) | ||
| 49 | (when (< (count-lines (point-min) (point)) calendar-first-date-row) | ||
| 43 | (goto-line calendar-first-date-row) | 50 | (goto-line calendar-first-date-row) |
| 44 | (move-to-column column)) | 51 | (move-to-column col)) |
| 45 | ;; FIXME the date positions are fixed and computable, | 52 | ;; The date positions are fixed and computable, but searching |
| 46 | ;; but searching is probably more flexible. | 53 | ;; is probably more flexible. Need to consider blank days at |
| 47 | ;; Note also that this may not be the "nearest" date. | 54 | ;; start and end of month if computing positions. |
| 48 | ;; Eg with cursor just after end of month, can skip to next month. | 55 | ;; 'date text-property is used to exclude intermonth text. |
| 49 | (or (looking-at "[0-9]") | 56 | (unless (and (looking-at "[0-9]") |
| 50 | ;; We search forwards for a number, except close to the RH | 57 | (get-text-property (point) 'date)) |
| 51 | ;; margin of a month, where we search backwards. | 58 | ;; We search forwards for a number, except close to the RH |
| 52 | (if (or (looking-at " *$") | 59 | ;; margin of a month, where we search backwards. |
| 53 | (< (calendar-column-to-month) 0)) | 60 | ;; Note that the searches can go to other lines. |
| 54 | (re-search-backward "[0-9]" nil t) | 61 | (if (or (looking-at " *$") |
| 55 | (re-search-forward "[0-9]" nil t) | 62 | (and (> col last) (< col right))) |
| 56 | (backward-char 1))) | 63 | (while (and (re-search-backward "[0-9]" nil t) |
| 64 | (not (get-text-property (point) 'date)))) | ||
| 65 | (while (and (re-search-forward "[0-9]" nil t) | ||
| 66 | (not (get-text-property (1- (point)) 'date)))) | ||
| 67 | (backward-char 1))) | ||
| 57 | (calendar-cursor-to-date)))) | 68 | (calendar-cursor-to-date)))) |
| 58 | 69 | ||
| 59 | (defvar displayed-month) ; from calendar-generate | 70 | (defvar displayed-month) ; from calendar-generate |