Mercurial > emacs

changeset 92916:f296fd96bd7c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Glenn Morris <rgm@gnu.org>
date Fri, 14 Mar 2008 06:44:47 +0000
parents 587dd0bd578f
children 8aa5577094ae
files lisp/calendar/cal-move.el
diffstat 1 files changed, 88 insertions(+), 90 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/calendar/cal-move.el	Fri Mar 14 03:38:38 2008 +0000
+++ b/lisp/calendar/cal-move.el	Fri Mar 14 06:44:47 2008 +0000
@@ -32,16 +32,63 @@
 
 ;;; Code:
 
-(defvar displayed-month)
+(require 'calendar)
+
+;;;###cal-autoload
+(defun calendar-cursor-to-nearest-date ()
+  "Move the cursor to the closest date.
+The position of the cursor is unchanged if it is already on a date.
+Returns the list (month day year) giving the cursor position."
+  (let ((date (calendar-cursor-to-date))
+        (column (current-column)))
+    (or date
+        (when (> 3 (count-lines (point-min) (point)))
+          (goto-line 3)
+          (move-to-column column))
+        (if (not (looking-at "[0-9]"))
+            (if (and (not (looking-at " *$"))
+                     (or (< column 25)
+                         (and (> column 27)
+                              (< column 50))
+                         (and (> column 52)
+                              (< column 75))))
+                (progn
+                  (re-search-forward "[0-9]" nil t)
+                  (backward-char 1))
+              (re-search-backward "[0-9]" nil t)))
+        (calendar-cursor-to-date))))
+
+(defvar displayed-month)                ; from generate-calendar
 (defvar displayed-year)
 
-(require 'calendar)
+;;;###cal-autoload
+(defun calendar-cursor-to-visible-date (date)
+  "Move the cursor to DATE that is on the screen."
+  (let* ((month (extract-calendar-month date))
+         (day (extract-calendar-day date))
+         (year (extract-calendar-year date))
+         (first-of-month-weekday (calendar-day-of-week (list month 1 year))))
+    (goto-line (+ 3
+                  (/ (+ day  -1
+                        (mod
+                         (- (calendar-day-of-week (list month 1 year))
+                            calendar-week-start-day)
+                         7))
+                     7)))
+    (move-to-column (+ 6
+                       (* 25
+                          (1+ (calendar-interval
+                               displayed-month displayed-year month year)))
+                       (* 3 (mod
+                             (- (calendar-day-of-week date)
+                                calendar-week-start-day)
+                             7))))))
 
 ;;;###cal-autoload
 (defun calendar-goto-today ()
   "Reposition the calendar window so the current date is visible."
   (interactive)
-  (let ((today (calendar-current-date)));; The date might have changed.
+  (let ((today (calendar-current-date))) ; the date might have changed
     (if (not (calendar-date-is-visible-p today))
         (generate-calendar-window)
       (update-calendar-mode-line)
@@ -61,7 +108,7 @@
     (increment-calendar-month month year arg)
     (let ((last (calendar-last-day-of-month month year)))
       (if (< last day)
-        (setq day last)))
+          (setq day last)))
     ;; Put the new month on the screen, if needed, and go to the new date.
     (let ((new-cursor-date (list month day year)))
       (if (not (calendar-date-is-visible-p new-cursor-date))
@@ -102,20 +149,23 @@
   (save-selected-window
     (select-window (posn-window (event-start event)))
     (calendar-cursor-to-nearest-date)
-    (let ((old-date (calendar-cursor-to-date))
-          (today (calendar-current-date)))
-      (if (/= arg 0)
-          (let ((month displayed-month)
-                (year displayed-year))
-            (increment-calendar-month month year arg)
-            (generate-calendar-window month year)
-            (calendar-cursor-to-visible-date
-             (cond
-              ((calendar-date-is-visible-p old-date) old-date)
-              ((calendar-date-is-visible-p today) today)
-              (t (list month 1 year)))))))
+    (unless (zerop arg)
+      (let ((old-date (calendar-cursor-to-date))
+            (today (calendar-current-date))
+            (month displayed-month)
+            (year displayed-year))
+        (increment-calendar-month month year arg)
+        (generate-calendar-window month year)
+        (calendar-cursor-to-visible-date
+         (cond
+          ((calendar-date-is-visible-p old-date) old-date)
+          ((calendar-date-is-visible-p today) today)
+          (t (list month 1 year))))))
     (run-hooks 'calendar-move-hook)))
 
+(define-obsolete-function-alias
+  'scroll-calendar-left 'calendar-scroll-left "23.1")
+
 ;;;###cal-autoload
 (defun calendar-scroll-right (&optional arg event)
   "Scroll the displayed calendar window right by ARG months.
@@ -126,6 +176,9 @@
                      last-nonmenu-event))
   (calendar-scroll-left (- (or arg 1)) event))
 
+(define-obsolete-function-alias
+  'scroll-calendar-right 'calendar-scroll-right "23.1")
+
 ;;;###cal-autoload
 (defun calendar-scroll-left-three-months (arg)
   "Scroll the displayed calendar window left by 3*ARG months.
@@ -134,6 +187,9 @@
   (interactive "p")
   (calendar-scroll-left (* 3 arg)))
 
+(define-obsolete-function-alias 'scroll-calendar-left-three-months
+  'calendar-scroll-left-three-months "23.1")
+
 ;;;###cal-autoload
 (defun calendar-scroll-right-three-months (arg)
   "Scroll the displayed calendar window right by 3*ARG months.
@@ -142,53 +198,28 @@
   (interactive "p")
   (calendar-scroll-left (* -3 arg)))
 
-;;;###cal-autoload
-(defun calendar-cursor-to-nearest-date ()
-  "Move the cursor to the closest date.
-The position of the cursor is unchanged if it is already on a date.
-Returns the list (month day year) giving the cursor position."
-  (let ((date (calendar-cursor-to-date))
-        (column (current-column)))
-    (if date
-        date
-      (if (> 3 (count-lines (point-min) (point)))
-          (progn
-            (goto-line 3)
-            (move-to-column column)))
-      (if (not (looking-at "[0-9]"))
-          (if (and (not (looking-at " *$"))
-                   (or (< column 25)
-                       (and (> column 27)
-                            (< column 50))
-                       (and (> column 52)
-                            (< column 75))))
-              (progn
-                (re-search-forward "[0-9]" nil t)
-                (backward-char 1))
-            (re-search-backward "[0-9]" nil t)))
-      (calendar-cursor-to-date))))
+(define-obsolete-function-alias 'scroll-calendar-right-three-months
+  'calendar-scroll-right-three-months "23.1")
 
 ;;;###cal-autoload
 (defun calendar-forward-day (arg)
   "Move the cursor forward ARG days.
 Moves backward if ARG is negative."
   (interactive "p")
-  (if (/= 0 arg)
-      (let*
-          ((cursor-date (calendar-cursor-to-date))
-           (cursor-date (if cursor-date
-                            cursor-date
-                          (if (> arg 0) (setq arg (1- arg)))
-                          (calendar-cursor-to-nearest-date)))
+  (unless (zerop arg)
+    (let* ((cursor-date (or (calendar-cursor-to-date)
+                            (progn
+                              (if (> arg 0) (setq arg (1- arg)))
+                              (calendar-cursor-to-nearest-date))))
            (new-cursor-date
             (calendar-gregorian-from-absolute
              (+ (calendar-absolute-from-gregorian cursor-date) arg)))
            (new-display-month (extract-calendar-month new-cursor-date))
            (new-display-year (extract-calendar-year new-cursor-date)))
-        ;; Put the new month on the screen, if needed, and go to the new date.
-        (if (not (calendar-date-is-visible-p new-cursor-date))
-            (calendar-other-month new-display-month new-display-year))
-        (calendar-cursor-to-visible-date new-cursor-date)))
+      ;; Put the new month on the screen, if needed, and go to the new date.
+      (if (not (calendar-date-is-visible-p new-cursor-date))
+          (calendar-other-month new-display-month new-display-year))
+      (calendar-cursor-to-visible-date new-cursor-date)))
   (run-hooks 'calendar-move-hook))
 
 ;;;###cal-autoload
@@ -260,10 +291,9 @@
          (day (extract-calendar-day date))
          (year (extract-calendar-year date))
          (last-day (calendar-last-day-of-month month year)))
-    (if (/= day last-day)
-        (progn
-          (calendar-cursor-to-visible-date (list month last-day year))
-          (setq arg (1- arg))))
+    (unless (= day last-day)
+      (calendar-cursor-to-visible-date (list month last-day year))
+      (setq arg (1- arg)))
     (increment-calendar-month month year arg)
     (let ((last-day (list
                      month
@@ -271,7 +301,7 @@
                      year)))
       (if (not (calendar-date-is-visible-p last-day))
           (calendar-other-month month year)
-      (calendar-cursor-to-visible-date last-day))))
+        (calendar-cursor-to-visible-date last-day))))
   (run-hooks 'calendar-move-hook))
 
 ;;;###cal-autoload
@@ -315,28 +345,6 @@
   (run-hooks 'calendar-move-hook))
 
 ;;;###cal-autoload
-(defun calendar-cursor-to-visible-date (date)
-  "Move the cursor to DATE that is on the screen."
-  (let* ((month (extract-calendar-month date))
-         (day (extract-calendar-day date))
-         (year (extract-calendar-year date))
-         (first-of-month-weekday (calendar-day-of-week (list month 1 year))))
-    (goto-line (+ 3
-                  (/ (+ day  -1
-                        (mod
-                         (- (calendar-day-of-week (list month 1 year))
-                            calendar-week-start-day)
-                         7))
-                     7)))
-    (move-to-column (+ 6
-                       (* 25
-                          (1+ (calendar-interval
-                               displayed-month displayed-year month year)))
-                       (* 3 (mod
-                             (- (calendar-day-of-week date)
-                                calendar-week-start-day)
-                             7))))))
-;;;###cal-autoload
 (defun calendar-goto-date (date)
   "Move cursor to DATE."
   (interactive (list (calendar-read-date)))
@@ -353,7 +361,7 @@
 
 ;;;###cal-autoload
 (defun calendar-goto-day-of-year (year day &optional noecho)
-  "Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is t.
+  "Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is non-nil.
 Negative DAY counts backward from end of year."
   (interactive
    (let* ((year (calendar-read
@@ -373,16 +381,6 @@
       (+ 1 day (calendar-absolute-from-gregorian (list 12 31 year))))))
   (or noecho (calendar-print-day-of-year)))
 
-;; Backward compatibility.
-(define-obsolete-function-alias
-  'scroll-calendar-left 'calendar-scroll-left "23.1")
-(define-obsolete-function-alias
-  'scroll-calendar-right 'calendar-scroll-right "23.1")
-(define-obsolete-function-alias
-  'scroll-calendar-left-three-months 'calendar-scroll-left-three-months "23.1")
-(define-obsolete-function-alias
-  'scroll-calendar-right-three-months 'calendar-scroll-right-three-months "23.1")
-
 (provide 'cal-move)
 
 ;; arch-tag: d0883c46-7e16-4914-8ff8-8f67e699b781