;;; cal-move.el --- calendar functions for movement in the calendar
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2005 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
;; Keywords: calendar
;; Human-Keywords: calendar
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
+(defvar displayed-month)
+(defvar displayed-year)
+
(require 'calendar)
(defun calendar-goto-today ()
(if (not (calendar-date-is-visible-p today))
(generate-calendar-window)
(update-calendar-mode-line)
- (calendar-cursor-to-visible-date today))))
+ (calendar-cursor-to-visible-date today)))
+ (run-hooks 'calendar-move-hook))
(defun calendar-forward-month (arg)
"Move the cursor forward ARG months.
(let ((new-cursor-date (list month day year)))
(if (not (calendar-date-is-visible-p new-cursor-date))
(calendar-other-month month year))
- (calendar-cursor-to-visible-date new-cursor-date))))
+ (calendar-cursor-to-visible-date new-cursor-date)))
+ (run-hooks 'calendar-move-hook))
(defun calendar-forward-year (arg)
"Move the cursor forward by ARG years.
(interactive "p")
(calendar-forward-month (* -12 arg)))
-(defun scroll-calendar-left (arg)
+(defun scroll-calendar-left (&optional arg)
"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")
+ (unless arg (setq arg 1))
(calendar-cursor-to-nearest-date)
(let ((old-date (calendar-cursor-to-date))
(today (calendar-current-date)))
(if (/= arg 0)
- (progn
- (increment-calendar-month displayed-month displayed-year arg)
- (generate-calendar-window displayed-month displayed-year)
+ (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 displayed-month 1 displayed-year))))))))
+ (t (list month 1 year)))))))
+ (run-hooks 'calendar-move-hook))
-(defun scroll-calendar-right (arg)
+(defun scroll-calendar-right (&optional arg)
"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")
- (scroll-calendar-left (- arg)))
+ (scroll-calendar-left (- (or arg 1))))
(defun scroll-calendar-left-three-months (arg)
"Scroll the displayed calendar window left by 3*ARG months.
;; 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))))
+ (calendar-cursor-to-visible-date new-cursor-date)))
+ (run-hooks 'calendar-move-hook))
(defun calendar-backward-day (arg)
"Move the cursor back ARG days.
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))
(defun calendar-beginning-of-year (arg)
"Move the cursor backward ARG year beginnings."
(month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
- (jan-first (list 1 1 year)))
+ (jan-first (list 1 1 year))
+ (calendar-move-hook nil))
(if (and (= day 1) (= 1 month))
(calendar-backward-month (* 12 arg))
(if (and (= arg 1)
(calendar-date-is-visible-p jan-first))
(calendar-cursor-to-visible-date jan-first)
- (calendar-other-month 1 (- year (1- arg)))))))
+ (calendar-other-month 1 (- year (1- arg)))
+ (calendar-cursor-to-visible-date (list 1 1 displayed-year)))))
+ (run-hooks 'calendar-move-hook))
(defun calendar-end-of-year (arg)
"Move the cursor forward ARG year beginnings."
(month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
- (dec-31 (list 12 31 year)))
+ (dec-31 (list 12 31 year))
+ (calendar-move-hook nil))
(if (and (= day 31) (= 12 month))
(calendar-forward-month (* 12 arg))
(if (and (= arg 1)
(calendar-date-is-visible-p dec-31))
(calendar-cursor-to-visible-date dec-31)
- (calendar-other-month 12 (- year (1- arg)))
- (calendar-cursor-to-visible-date (list 12 31 displayed-year))))))
+ (calendar-other-month 12 (+ year (1- arg)))
+ (calendar-cursor-to-visible-date (list 12 31 displayed-year)))))
+ (run-hooks 'calendar-move-hook))
(defun calendar-cursor-to-visible-date (date)
"Move the cursor to DATE that is on the screen."
2
month)
year)))
- (calendar-cursor-to-visible-date date))
+ (calendar-cursor-to-visible-date date)
+ (run-hooks 'calendar-move-hook))
+
+(defun calendar-goto-day-of-year (year day &optional noecho)
+ "Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is t.
+Negative DAY counts backward from end of year."
+ (interactive
+ (let* ((year (calendar-read
+ "Year (>0): "
+ (lambda (x) (> x 0))
+ (int-to-string (extract-calendar-year
+ (calendar-current-date)))))
+ (last (if (calendar-leap-year-p year) 366 365))
+ (day (calendar-read
+ (format "Day number (+/- 1-%d): " last)
+ '(lambda (x) (and (<= 1 (abs x)) (<= (abs x) last))))))
+ (list year day)))
+ (calendar-goto-date
+ (calendar-gregorian-from-absolute
+ (if (< 0 day)
+ (+ -1 day (calendar-absolute-from-gregorian (list 1 1 year)))
+ (+ 1 day (calendar-absolute-from-gregorian (list 12 31 year))))))
+ (or noecho (calendar-print-day-of-year)))
(provide 'cal-move)
+;;; arch-tag: d0883c46-7e16-4914-8ff8-8f67e699b781
;;; cal-move.el ends here