Update copyright year to 2014 by running admin/update-copyright.

[gnu-emacs] / lisp / calendar / cal-move.el

diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index 55603fda3c01c799164c650cc733093a611a6f26..5410ff79ff47d25dfc4029af725f41cbafdddf0b 100644 (file)
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -1,12 +1,12 @@
 ;;; cal-move.el --- calendar functions for movement in the calendar
 
-;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2001-2014 Free Software Foundation, Inc.
 
 ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
 ;; Maintainer: Glenn Morris <rgm@gnu.org>
 ;; Keywords: calendar
 ;; Human-Keywords: calendar
+;; Package: calendar
 
 ;; This file is part of GNU Emacs.
 
@@ -47,7 +47,8 @@ Returns the list (month day year) giving the cursor position."
              (last (nth 2 edges))
              (right (nth 3 edges)))
         (when (< (count-lines (point-min) (point)) calendar-first-date-row)
-          (goto-line calendar-first-date-row)
+          (goto-char (point-min))
+          (forward-line (1- calendar-first-date-row))
           (move-to-column col))
         ;; The date positions are fixed and computable, but searching
         ;; is probably more flexible.  Need to consider blank days at
@@ -76,13 +77,14 @@ Returns the list (month day year) giving the cursor position."
   (let ((month (calendar-extract-month date))
         (day (calendar-extract-day date))
         (year (calendar-extract-year date)))
-    (goto-line (+ calendar-first-date-row
-                  (/ (+ day  -1
-                        (mod
-                         (- (calendar-day-of-week (list month 1 year))
-                            calendar-week-start-day)
-                         7))
-                     7)))
+    (goto-char (point-min))
+    (forward-line (+ calendar-first-date-row -1
+                     (/ (+ day -1
+                           (mod
+                            (- (calendar-day-of-week (list month 1 year))
+                               calendar-week-start-day)
+                            7))
+                        7)))
     (move-to-column (+ calendar-left-margin (1- calendar-day-digit-width)
                        (* calendar-month-width
                           (1+ (calendar-interval
@@ -190,23 +192,39 @@ EVENT is an event like `last-nonmenu-event'."
   'scroll-calendar-right 'calendar-scroll-right "23.1")
 
 ;;;###cal-autoload
-(defun calendar-scroll-left-three-months (arg)
+(defun calendar-scroll-left-three-months (arg &optional event)
   "Scroll the displayed calendar window left by 3*ARG months.
 If ARG is negative the calendar is scrolled right.  Maintains the relative
-position of the cursor with respect to the calendar as well as possible."
-  (interactive "p")
-  (calendar-scroll-left (* 3 arg)))
+position of the cursor with respect to the calendar as well as possible.
+EVENT is an event like `last-nonmenu-event'."
+  (interactive (list (prefix-numeric-value current-prefix-arg)
+                     last-nonmenu-event))
+  (calendar-scroll-left (* 3 arg) event))
 
 (define-obsolete-function-alias 'scroll-calendar-left-three-months
   'calendar-scroll-left-three-months "23.1")
 
+;; cf scroll-bar-toolkit-scroll
+;;;###cal-autoload
+(defun calendar-scroll-toolkit-scroll (event)
+  "Function to scroll the calendar after a toolkit scroll-bar click."
+  (interactive "e")
+  (let ((part (nth 4 (event-end event))))
+    ;; Not bothering with drag events (handle, end-scroll).
+    (cond ((memq part '(above-handle up top))
+           (calendar-scroll-right nil event))
+          ((memq part '(below-handle down bottom))
+           (calendar-scroll-left nil event)))))
+
 ;;;###cal-autoload
-(defun calendar-scroll-right-three-months (arg)
+(defun calendar-scroll-right-three-months (arg &optional event)
   "Scroll the displayed calendar window right by 3*ARG months.
 If ARG is negative the calendar is scrolled left.  Maintains the relative
-position of the cursor with respect to the calendar as well as possible."
-  (interactive "p")
-  (calendar-scroll-left (* -3 arg)))
+position of the cursor with respect to the calendar as well as possible.
+EVENT is an event like `last-nonmenu-event'."
+  (interactive (list (prefix-numeric-value current-prefix-arg)
+                     last-nonmenu-event))
+  (calendar-scroll-left (* -3 arg) event))
 
 (define-obsolete-function-alias 'scroll-calendar-right-three-months
   'calendar-scroll-right-three-months "23.1")
@@ -226,14 +244,15 @@ Moves backward if ARG is negative."
              (+ (calendar-absolute-from-gregorian cursor-date) arg)))
            (new-display-month (calendar-extract-month new-cursor-date))
            (new-display-year (calendar-extract-year new-cursor-date)))
-      ;; Put the new month on the screen, if needed, and go to the new date.
-      (if (calendar-date-is-visible-p new-cursor-date)
-          (calendar-cursor-to-visible-date new-cursor-date)
+      ;; Put the new month on the screen, if needed.
+      (unless (calendar-date-is-visible-p new-cursor-date)
         ;; The next line gives smoother scrolling IMO (one month at a
         ;; time rather than two).
         (calendar-increment-month new-display-month new-display-year
                                   (if (< arg 0) 1 -1))
-        (calendar-other-month new-display-month new-display-year))))
+        (calendar-other-month new-display-month new-display-year))
+      ;; Go to the new date.
+      (calendar-cursor-to-visible-date new-cursor-date)))
   (run-hooks 'calendar-move-hook))
 
 ;;;###cal-autoload
@@ -398,5 +417,4 @@ Negative DAY counts backward from end of year."
 
 (provide 'cal-move)
 
-;; arch-tag: d0883c46-7e16-4914-8ff8-8f67e699b781
 ;;; cal-move.el ends here