comparison lisp/calendar/cal-move.el @ 93809:3ff2b47de8f2

Update for calendar.el name changes.

93808:2c72483f42c9

                  (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)

;;;###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)))
    (goto-line (+ 3
                  (/ (+ day  -1
                        (mod
                         (- (calendar-day-of-week (list month 1 year))
                            calendar-week-start-day)

(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
    (if (not (calendar-date-is-visible-p today))
        (generate-calendar-window)
      (update-calendar-mode-line)
      (calendar-cursor-to-visible-date today)))
  (run-hooks 'calendar-move-hook))

;;;###cal-autoload
(defun calendar-forward-month (arg)
  "Move the cursor forward ARG months.
Movement is backward if ARG is negative."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((cursor-date (calendar-cursor-to-date t))
         (month (extract-calendar-month cursor-date))
         (day (extract-calendar-day cursor-date))
         (year (extract-calendar-year cursor-date))
         (last (progn
                 (increment-calendar-month month year arg)
                 (calendar-last-day-of-month month year)))
         (day (min last day))
         ;; Put the new month on the screen, if needed, and go to the new date.
         (new-cursor-date (list month day year)))
    (if (not (calendar-date-is-visible-p new-cursor-date))

    (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))))))

                              (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)))
  (run-hooks 'calendar-move-hook))

(defun calendar-beginning-of-month (arg)
  "Move the cursor backward ARG month beginnings."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((date (calendar-cursor-to-date))
         (month (extract-calendar-month date))
         (day (extract-calendar-day date))
         (year (extract-calendar-year date)))
    (if (= day 1)
        (calendar-backward-month arg)
      (calendar-cursor-to-visible-date (list month 1 year))
      (calendar-backward-month (1- arg)))))

(defun calendar-end-of-month (arg)
  "Move the cursor forward ARG month ends."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((date (calendar-cursor-to-date))
         (month (extract-calendar-month date))
         (day (extract-calendar-day date))
         (year (extract-calendar-year date))
         (last-day (calendar-last-day-of-month month year))
         (last-day (progn
                     (unless (= day last-day)
                       (calendar-cursor-to-visible-date
                        (list month last-day year))
                       (setq arg (1- arg)))
                     (increment-calendar-month month year arg)
                     (list month
                           (calendar-last-day-of-month month year)
                           year))))
    (if (not (calendar-date-is-visible-p last-day))
        (calendar-other-month month year)

(defun calendar-beginning-of-year (arg)
  "Move the cursor backward ARG year beginnings."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((date (calendar-cursor-to-date))
         (month (extract-calendar-month date))
         (day (extract-calendar-day date))
         (year (extract-calendar-year date))
         (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)

(defun calendar-end-of-year (arg)
  "Move the cursor forward ARG year beginnings."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((date (calendar-cursor-to-date))
         (month (extract-calendar-month date))
         (day (extract-calendar-day date))
         (year (extract-calendar-year date))
         (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)

;;;###cal-autoload
(defun calendar-goto-date (date)
  "Move cursor to DATE."
  (interactive (list (calendar-read-date)))
  (let ((month (extract-calendar-month date))
        (year (extract-calendar-year date)))
    (if (not (calendar-date-is-visible-p date))
        (calendar-other-month
         (if (and (= month 1) (= year 1))
             2
           month)

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))))))

93809:3ff2b47de8f2

                  (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 calendar-generate
(defvar displayed-year)

;;;###cal-autoload
(defun calendar-cursor-to-visible-date (date)
  "Move the cursor to DATE that is on the screen."
  (let ((month (calendar-extract-month date))
        (day (calendar-extract-day date))
        (year (calendar-extract-year date)))
    (goto-line (+ 3
                  (/ (+ day  -1
                        (mod
                         (- (calendar-day-of-week (list month 1 year))
                            calendar-week-start-day)

(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
    (if (not (calendar-date-is-visible-p today))
        (calendar-generate-window)
      (calendar-update-mode-line)
      (calendar-cursor-to-visible-date today)))
  (run-hooks 'calendar-move-hook))

;;;###cal-autoload
(defun calendar-forward-month (arg)
  "Move the cursor forward ARG months.
Movement is backward if ARG is negative."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((cursor-date (calendar-cursor-to-date t))
         (month (calendar-extract-month cursor-date))
         (day (calendar-extract-day cursor-date))
         (year (calendar-extract-year cursor-date))
         (last (progn
                 (calendar-increment-month month year arg)
                 (calendar-last-day-of-month month year)))
         (day (min last day))
         ;; Put the new month on the screen, if needed, and go to the new date.
         (new-cursor-date (list month day year)))
    (if (not (calendar-date-is-visible-p new-cursor-date))

    (unless (zerop arg)
      (let ((old-date (calendar-cursor-to-date))
            (today (calendar-current-date))
            (month displayed-month)
            (year displayed-year))
        (calendar-increment-month month year arg)
        (calendar-generate-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))))))

                              (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 (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 (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))

(defun calendar-beginning-of-month (arg)
  "Move the cursor backward ARG month beginnings."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((date (calendar-cursor-to-date))
         (month (calendar-extract-month date))
         (day (calendar-extract-day date))
         (year (calendar-extract-year date)))
    (if (= day 1)
        (calendar-backward-month arg)
      (calendar-cursor-to-visible-date (list month 1 year))
      (calendar-backward-month (1- arg)))))

(defun calendar-end-of-month (arg)
  "Move the cursor forward ARG month ends."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((date (calendar-cursor-to-date))
         (month (calendar-extract-month date))
         (day (calendar-extract-day date))
         (year (calendar-extract-year date))
         (last-day (calendar-last-day-of-month month year))
         (last-day (progn
                     (unless (= day last-day)
                       (calendar-cursor-to-visible-date
                        (list month last-day year))
                       (setq arg (1- arg)))
                     (calendar-increment-month month year arg)
                     (list month
                           (calendar-last-day-of-month month year)
                           year))))
    (if (not (calendar-date-is-visible-p last-day))
        (calendar-other-month month year)

(defun calendar-beginning-of-year (arg)
  "Move the cursor backward ARG year beginnings."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((date (calendar-cursor-to-date))
         (month (calendar-extract-month date))
         (day (calendar-extract-day date))
         (year (calendar-extract-year date))
         (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)

(defun calendar-end-of-year (arg)
  "Move the cursor forward ARG year beginnings."
  (interactive "p")
  (calendar-cursor-to-nearest-date)
  (let* ((date (calendar-cursor-to-date))
         (month (calendar-extract-month date))
         (day (calendar-extract-day date))
         (year (calendar-extract-year date))
         (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)

;;;###cal-autoload
(defun calendar-goto-date (date)
  "Move cursor to DATE."
  (interactive (list (calendar-read-date)))
  (let ((month (calendar-extract-month date))
        (year (calendar-extract-year date)))
    (if (not (calendar-date-is-visible-p date))
        (calendar-other-month
         (if (and (= month 1) (= year 1))
             2
           month)

Negative DAY counts backward from end of year."
  (interactive
   (let* ((year (calendar-read
                 "Year (>0): "
                 (lambda (x) (> x 0))
                 (int-to-string (calendar-extract-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))))))