comparison lisp/calendar/calendar.el @ 96047:65c4c935e492

* calendar/calendar.el (calendar-cursor-to-date): Add argument `event'. (calendar-set-mark): * calendar/diary-lib.el (diary-insert-entry): * calendar/solar.el (calendar-sunrise-sunset): Use it. * calendar/cal-menu.el (calendar-mouse-sunrise/sunset) (calendar-mouse-insert-diary-entry, calendar-mouse-set-mark): Delete. (cal-menu-context-mouse-menu): Use calendar-set-mark, diary-insert-entry, and calendar-sunrise-sunset instead, to get proper key-shortcuts.

96046:422d57d537d7

(defun calendar-current-date ()
  "Return the current date in a list (month day year)."
  (let ((now (decode-time)))
    (list (nth 4 now) (nth 3 now) (nth 5 now))))

(defun calendar-cursor-to-date (&optional error)
  "Return a list (month day year) of current cursor position.
If cursor is not on a specific date, signals an error if optional parameter
ERROR is non-nil, otherwise just returns nil."
  (let* ((segment (/ (current-column) 25))
         (month (% (+ displayed-month segment -1) 12))
         (month (if (zerop month) 12 month))
         (year
          (cond
           ((and (=  12 month) (zerop segment)) (1- displayed-year))
           ((and (=   1 month) (= segment 2)) (1+ displayed-year))
           (t displayed-year))))
    (if (and (looking-at "[ 0-9]?[0-9][^0-9]")
             (< 2 (count-lines (point-min) (point))))
        (save-excursion
          (if (not (looking-at " "))
              (re-search-backward "[^0-9]"))
          (list month
                (string-to-number (buffer-substring (1+ (point)) (+ 4 (point))))
                year))
      (if error (error "Not on a date!")))))

(add-to-list 'debug-ignored-errors "Not on a date!")

;; The following version of calendar-gregorian-from-absolute is preferred for
;; reasons of clarity, BUT it's much slower than the version that follows it.

         (cond
          ((calendar-date-is-visible-p old-date) old-date)
          ((calendar-date-is-visible-p today) today)
          (t (list month 1 year))))))))

(defun calendar-set-mark (arg)
  "Mark the date under the cursor, or jump to marked date.
With no prefix argument, push current date onto marked date ring.
With argument ARG, jump to mark, pop it, and put point at end of ring."
  (interactive "P")
  (let ((date (calendar-cursor-to-date t)))
    (if arg
        (if (null calendar-mark-ring)
            (error "No mark set in this buffer")
          (calendar-goto-date (car calendar-mark-ring))
          (setq calendar-mark-ring

96047:65c4c935e492

(defun calendar-current-date ()
  "Return the current date in a list (month day year)."
  (let ((now (decode-time)))
    (list (nth 4 now) (nth 3 now) (nth 5 now))))

(defun calendar-cursor-to-date (&optional error event)
  "Return a list (month day year) of current cursor position.
If cursor is not on a specific date, signals an error if optional parameter
ERROR is non-nil, otherwise just returns nil.
If EVENT is non-nil, it's an event indicating the buffer position to
use instead of point."
  (with-current-buffer
      (if event (window-buffer (posn-window (event-start event)))
        (current-buffer))
    (save-excursion
      (if event (goto-char (posn-point (event-start event))))
  (let* ((segment (/ (current-column) 25))
         (month (% (+ displayed-month segment -1) 12))
         (month (if (zerop month) 12 month))
         (year
          (cond
           ((and (=  12 month) (zerop segment)) (1- displayed-year))
           ((and (=   1 month) (= segment 2)) (1+ displayed-year))
           (t displayed-year))))
        (if (not (and (looking-at "[ 0-9]?[0-9][^0-9]")
                      (< 2 (count-lines (point-min) (point)))))
            (if error (error "Not on a date!"))
          (if (not (looking-at " "))
              (re-search-backward "[^0-9]"))
          (list month
                (string-to-number (buffer-substring (1+ (point)) (+ 4 (point))))
                year))))))

(add-to-list 'debug-ignored-errors "Not on a date!")

;; The following version of calendar-gregorian-from-absolute is preferred for
;; reasons of clarity, BUT it's much slower than the version that follows it.

         (cond
          ((calendar-date-is-visible-p old-date) old-date)
          ((calendar-date-is-visible-p today) today)
          (t (list month 1 year))))))))

(defun calendar-set-mark (arg &optional event)
  "Mark the date under the cursor, or jump to marked date.
With no prefix argument, push current date onto marked date ring.
With argument ARG, jump to mark, pop it, and put point at end of ring."
  (interactive
   (list current-prefix-arg last-nonmenu-event))
  (let ((date (calendar-cursor-to-date t event)))
    (if arg
        (if (null calendar-mark-ring)
            (error "No mark set in this buffer")
          (calendar-goto-date (car calendar-mark-ring))
          (setq calendar-mark-ring