aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-03-14 06:45:16 +0000
committerGlenn Morris2008-03-14 06:45:16 +0000
commitcfcc468faac65a8e21abd90d62937bf3254ad491 (patch)
tree85eb8acf4a61ee91bc1f22079c8c05b17ed58220
parent4b8683c7c5bc3bcdf1c976d5f90ecfc1f3103966 (diff)
downloademacs-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/ChangeLog10
-rw-r--r--lisp/calendar/cal-move.el178
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.
40The position of the cursor is unchanged if it is already on a date.
41Returns 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.
148The position of the cursor is unchanged if it is already on a date.
149Returns 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.
174Moves backward if ARG is negative." 207Moves 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.
357Negative DAY counts backward from end of year." 365Negative 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