Function: calcFunc-newmonth

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

Signature

(calcFunc-newmonth DATE &optional DAY)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-forms.el.gz
(defun calcFunc-newmonth (date &optional day)
  (or day (setq day 1))
  (and (math-messy-integerp day) (setq day (math-trunc day)))
  (or (integerp day) (math-reject-arg day 'fixnump))
  (and (or (< day 0) (> day 31)) (math-reject-arg day 'range))
  (let* ((dt (math-date-to-dt date))
         (dim (math-days-in-month (car dt) (nth 1 dt)))
         (julian (if calc-gregorian-switch
                     (math-date-to-dt (math-sub
                                       (or (nth 3 calc-gregorian-switch)
                                           (apply 'math-absolute-from-gregorian-dt calc-gregorian-switch))
                                       1)))))
    (if (or (= day 0) (> day dim))
	(setq day (1- dim))
      (setq day (1- day)))
    ;; Adjust if this occurs near the switch to the Gregorian calendar
    (if calc-gregorian-switch
        (cond
         ((and (math-dt-before-p (list (car dt) (nth 1 dt) 1) calc-gregorian-switch)
               (math-dt-before-p julian (list (car dt) (nth 1 dt) 1)))
          ;; In this case, CALC-GREGORIAN-SWITCH is the first day of the month
          (list 'date
                (math-dt-to-date (list (car calc-gregorian-switch)
                                       (nth 1 calc-gregorian-switch)
                                       (if (> (+ (nth 2 calc-gregorian-switch) day) dim)
                                           dim
                                         (+ (nth 2 calc-gregorian-switch) day))))))
         ((and (eq (car dt) (car calc-gregorian-switch))
               (= (nth 1 dt) (nth 1 calc-gregorian-switch)))
          ;; In this case, the switch to the Gregorian calendar occurs in the given month
          (if (< (+ (nth 2 julian) day) (nth 2 calc-gregorian-switch))
              ;; If the DAYth day occurs before the switch, use it
              (list 'date (math-dt-to-date (list (car dt) (nth 1 dt) (1+ day))))
            ;; Otherwise do some computations
            (let ((tm (+ day (- (nth 2 calc-gregorian-switch) (nth 2 julian)))))
              (list 'date (math-dt-to-date
                           (list (car dt)
                                 (nth 1 dt)
                                 ;;
                                 (if (> tm dim) dim tm)))))))
         ((and (eq (car dt) (car julian))
               (= (nth 1 dt) (nth 1 julian)))
          ;; In this case, the current month is truncated because of the switch
          ;; to the Gregorian calendar
          (list 'date (math-dt-to-date
                       (list (car dt)
                             (nth 1 dt)
                             (if (>= day (nth 2 julian))
                                 (nth 2 julian)
                               (1+ day))))))
         (t
          ;; The default
          (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day))))
      (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1)) day)))))