aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/calendar/cal-move.el41
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.
38The position of the cursor is unchanged if it is already on a date. 41The position of the cursor is unchanged if it is already on a date.
39Returns the list (month day year) giving the cursor position." 42Returns 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