Function: calcFunc-newyear

calcFunc-newyear is an autoloaded and byte-compiled function defined in calc-forms.el.gz.

Signature

(calcFunc-newyear DATE &optional DAY)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-forms.el.gz
(defun calcFunc-newyear (date &optional day)
  (if (eq (car-safe date) 'date) (setq date (nth 1 date)))
  (or day (setq day 1))
  (and (math-messy-integerp day) (setq day (math-trunc day)))
  (or (integerp day) (math-reject-arg day 'fixnump))
  (let* ((dt (math-date-to-dt date))
         (gregbeg (if calc-gregorian-switch
                      (or (nth 3 calc-gregorian-switch)
                          (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))))
         (julianend (if calc-gregorian-switch (math-sub gregbeg 1)))
         (julian (if calc-gregorian-switch
                     (math-date-to-dt julianend))))
    (if (and (>= day 0) (<= day 366))
	(let ((max (if (math-leap-year-p (car dt)) 366 365)))
	  (if (or (= day 0) (> day max)) (setq day max))
          (if calc-gregorian-switch
              ;; Now to break this down into cases
              (cond
               ((and (math-dt-before-p (list (car dt) 1 1) calc-gregorian-switch)
                     (math-dt-before-p julian (list (car dt) 1 1)))
                ;; In this case, CALC-GREGORIAN-SWITCH is the first day of the year
                (list 'date (math-min (math-add gregbeg (1- day))
                                      (math-dt-to-date (list (car calc-gregorian-switch) 12 31)))))
               ((eq (car dt) (car julian))
                ;; In this case, the switch to the Gregorian calendar occurs in the given year
                (if (Math-lessp (car julian) (car calc-gregorian-switch))
                    ;; Here, the last Julian day is the last day of the year.
                    (list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day))
                                          julianend))
                  ;; Otherwise, just make sure the date doesn't go past the end of the year
                  (list 'date (math-min (math-add (math-dt-to-date (list (car dt) 1 1)) (1- day))
                                        (math-dt-to-date (list (car dt) 12 31))))))
               (t
                (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
                                      (1- day)))))
            (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
                                  (1- day)))))
      (if (and (>= day -12) (<= day -1))
          (if (and calc-gregorian-switch
                   (math-dt-before-p (list (car dt) (- day) 1) calc-gregorian-switch)
                   (math-dt-before-p julian (list (car dt) (- day) 1)))
              (list 'date gregbeg)
            (list 'date (math-dt-to-date (list (car dt) (- day) 1))))
        (math-reject-arg day 'range)))))