procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(calendar-scroll-left, calendar-scroll-right):

Browse source 
Behave like mouse-scroll-calendar-* when used from the mouse.
This commit is contained in:
Stefan Monnier 2007-07-27 06:23:45 +00:00
parent cca1dde04d
commit ab8950895b
2 changed files with 26 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
lisp/ChangeLog
View file

@ -1,5 +1,8 @@
2007-07-27 Stefan Monnier <monnier@iro.umontreal.ca>
* calendar/cal-move.el (calendar-scroll-left, calendar-scroll-right):
Behave like mouse-scroll-calendar-* when used from the mouse.
* calendar/cal-menu.el (cal-menu-scroll-menu)
(cal-menu-global-mouse-menu): Use new names.

42
lisp/calendar/cal-move.el
View file

@ -85,33 +85,37 @@ Movement is forward is ARG is negative."
(interactive "p")
(calendar-forward-month (* -12 arg)))
(defun calendar-scroll-left (&optional arg)
(defun calendar-scroll-left (&optional arg event)
"Scroll the displayed calendar left by 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")
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(unless arg (setq arg 1))
(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)))))))
(run-hooks 'calendar-move-hook))
(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)))))))
(run-hooks 'calendar-move-hook)))
(defun calendar-scroll-right (&optional arg)
(defun calendar-scroll-right (&optional arg event)
"Scroll the displayed calendar window right by 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 (- (or arg 1))))
(interactive (list (prefix-numeric-value current-prefix-arg)
last-nonmenu-event))
(calendar-scroll-left (- (or arg 1)) event))
(defun calendar-scroll-left-three-months (arg)
"Scroll the displayed calendar window left by 3*ARG months.