Lines Matching +defs:old +defs:date
77 (defun calc-date-notation (fmt arg)
83 (setq fmt (nth (string-to-number fmt) calc-standard-date-formats)))
85 (error "Bad date format specifier"))
89 (setq calc-standard-date-formats
90 (copy-sequence calc-standard-date-formats))
91 (setcar (nthcdr arg calc-standard-date-formats) fmt))
153 (calc-change-mode 'calc-date-format (nreverse fullfmt) t))))
165 (calc-date-zero-args "now" 'calcFunc-now arg))
167 (defun calc-date-part (arg)
182 (defun calc-date (arg)
187 (calc-enter-result arg "date" (cons 'calcFunc-date (calc-top-list-n arg)))))
191 (calc-date-one-arg "juln" 'calcFunc-julian arg))
195 (calc-date-one-arg "unix" 'calcFunc-unixtime arg))
199 (calc-date-zero-args "zone" 'calcFunc-tzone arg))
201 (defun calc-convert-time-zones (old &optional new)
204 (if (equal old "$")
206 (if (equal old "") (setq old "local"))
208 (setq new (read-string (concat "From time zone: " old
210 (if (stringp old) (setq old (math-read-expr old)))
211 (if (eq (car-safe old) 'error)
212 (error "Error in expression: %S" (nth 1 old)))
218 (calc-top-n 1) old new)))))
222 (calc-date-one-arg "nwwk" 'calcFunc-newweek arg))
226 (calc-date-one-arg "nwmn" 'calcFunc-newmonth arg))
230 (calc-date-one-arg "nwyr" 'calcFunc-newyear arg))
234 (calc-date-one-arg "incm" 'calcFunc-incmonth arg))
246 (defun calc-date-zero-args (prefix func arg)
254 (defun calc-date-one-arg (prefix func arg)
372 ;;; A numerical date is the number of days since midnight on
373 ;;; the morning of January 1, 1 A.D. If the date is a non-integer,
374 ;;; it represents a specific date and time.
379 (defun math-date-to-dt (value)
380 (if (eq (car-safe value) 'date)
384 (let* ((parts (math-date-parts value))
385 (date (car parts))
389 (year (math-quotient (math-add date (if (Math-lessp date 711859)
395 (while (Math-lessp date (setq temp (math-absolute-from-date year 1 1)))
398 (setq date (1+ (math-sub date temp)))
399 (and (eq year 1752) (>= date 247)
400 (setq date (+ date 11)))
404 (while (>= date (aref temp month))
406 (setq day (1+ (- date (aref temp (1- month)))))
414 (defun math-dt-to-date (dt)
423 (let ((date (math-absolute-from-date (car dt) (nth 1 dt) (nth 2 dt))))
425 (math-add (math-float date)
430 date)))
432 (defun math-date-parts (value &optional offset)
433 (let* ((date (math-floor value))
434 (time (math-round (math-mul (math-sub value (or offset date)) 86400)
438 (list date
473 (defun math-absolute-from-date (year month day)
509 (defvar math-format-date-cache nil)
511 ;; The variables math-fd-date, math-fd-dt, math-fd-year,
514 ;; to math-format-date, but are used by math-format-date-part,
515 ;; which is called by math-format-date.
516 (defvar math-fd-date)
527 (defun math-format-date (math-fd-date)
528 (if (eq (car-safe math-fd-date) 'date)
529 (setq math-fd-date (nth 1 math-fd-date)))
530 (let ((entry (list math-fd-date calc-internal-prec calc-date-format)))
531 (or (cdr (assoc entry math-format-date-cache))
539 (fmt (apply 'concat (mapcar 'math-format-date-part
540 calc-date-format))))
541 (setq math-format-date-cache (cons (cons entry fmt)
542 math-format-date-cache))
543 (and (setq math-fd-dt (nthcdr 10 math-format-date-cache))
547 (defun math-format-date-part (x)
551 (if (math-integerp math-fd-date)
553 (apply 'concat (mapcar 'math-format-date-part x))))
557 (math-format-number math-fd-date))
559 (math-format-number (math-floor math-fd-date)))
561 (math-format-number (math-add math-fd-date '(float (bigpos 235 214 17) -1))))
563 (math-format-number (math-add (math-floor math-fd-date) '(bigpos 424 721 1))))
565 (math-format-number (nth 1 (math-date-parts math-fd-date 719164))))
569 (setq math-fd-dt (math-date-to-dt math-fd-date)
574 (math-add (math-floor math-fd-date) 6) 7)
578 (and (memq 'b calc-date-format)
713 ;; The variable math-pd-str is local to math-parse-date and
714 ;; math-parse-standard-date, but is used by math-parse-date-word,
715 ;; which is called by math-parse-date and math-parse-standard-date.
718 (defun math-parse-date (math-pd-str)
720 (or (math-parse-standard-date math-pd-str t)
721 (math-parse-standard-date math-pd-str nil)
723 (list 'date (math-read-number (math-match-substring math-pd-str 1))))
767 (setq month (math-parse-date-word math-long-month-names))
768 (setq weekday (math-parse-date-word math-long-weekday-names))
770 (math-parse-date-word math-short-month-names)))
771 (or weekday (math-parse-date-word math-short-weekday-names))
773 (if (setq temp (math-parse-date-word
776 (or (math-parse-date-word '( "ad" "a.d." ))
777 (if (math-parse-date-word '( "bc" "b.c." ))
780 (throw 'syntax (format "Bad word in date: \"%s\""
803 (and c (throw 'syntax "Too many numbers in date"))
813 (throw 'syntax "Too many numbers in date")
815 (throw 'syntax "Not enough numbers in date")
844 (setq temp calc-date-format)
863 (math-parse-date-validate year bigyear month day
866 (defun math-parse-date-validate (year bigyear month day hour minute second)
883 (list 'date (math-dt-to-date (append (list year month day)
886 (defun math-parse-date-word (names &optional front)
902 (defun math-parse-standard-date (math-pd-str with-time)
905 (fmt calc-date-format) this next (gnext nil)
932 num (math-date-to-dt (math-read-number num))
951 num (math-date-to-dt
962 (setq month (math-parse-date-word math-short-month-names t)))
964 (setq month (math-parse-date-word math-long-month-names t)))
966 (math-parse-date-word math-short-weekday-names t))
968 (math-parse-date-word math-long-weekday-names t))
1054 (setq day (math-parse-date-validate year bigyear month day
1062 (let ((date (let ((calc-date-format nil))
1063 (math-parse-date (current-time-string)))))
1064 (if (consp date)
1066 (math-add date (math-div (math-sub (calcFunc-tzone nil date)
1067 (calcFunc-tzone zone date))
1069 date)
1070 (calc-record-why "*Unable to interpret current date from system")
1073 (defun calcFunc-year (date)
1074 (car (math-date-to-dt date)))
1076 (defun calcFunc-month (date)
1077 (nth 1 (math-date-to-dt date)))
1079 (defun calcFunc-day (date)
1080 (nth 2 (math-date-to-dt date)))
1082 (defun calcFunc-weekday (date)
1083 (if (eq (car-safe date) 'date)
1084 (setq date (nth 1 date)))
1085 (or (math-realp date)
1086 (math-reject-arg date 'datep))
1087 (math-mod (math-add (math-floor date) 6) 7))
1089 (defun calcFunc-yearday (date)
1090 (let ((dt (math-date-to-dt date)))
1093 (defun calcFunc-hour (date)
1094 (if (eq (car-safe date) 'hms)
1095 (nth 1 date)
1096 (or (nth 3 (math-date-to-dt date)) 0)))
1098 (defun calcFunc-minute (date)
1099 (if (eq (car-safe date) 'hms)
1100 (nth 2 date)
1101 (or (nth 4 (math-date-to-dt date)) 0)))
1103 (defun calcFunc-second (date)
1104 (if (eq (car-safe date) 'hms)
1105 (nth 3 date)
1106 (or (nth 5 (math-date-to-dt date)) 0)))
1108 (defun calcFunc-time (date)
1109 (let ((dt (math-date-to-dt date)))
1114 (defun calcFunc-date (date &optional month day hour minute second)
1131 (and (math-messy-integerp date) (setq date (math-trunc date)))
1132 (and date (not (math-integerp date)) (math-reject-arg date 'integerp))
1135 (list 'date (math-dt-to-date (list date month day hour
1138 (list 'date (math-dt-to-date (list date month day))))
1139 (list 'date (math-dt-to-date (list (math-this-year) date month)))))
1140 (if (math-realp date)
1141 (list 'date date)
1142 (if (eq (car date) 'date)
1143 (nth 1 date)
1144 (math-reject-arg date 'datep)))))
1146 (defun calcFunc-julian (date &optional zone)
1147 (if (math-realp date)
1148 (list 'date (if (math-integerp date)
1149 (math-sub date '(bigpos 424 721 1))
1150 (setq date (math-sub date '(float (bigpos 235 214 17) -1)))
1151 (math-sub date (math-div (calcFunc-tzone zone date)
1153 (if (eq (car date) 'date)
1154 (math-add (nth 1 date) (if (math-integerp (nth 1 date))
1157 (math-div (calcFunc-tzone zone date)
1159 (math-reject-arg date 'datep))))
1161 (defun calcFunc-unixtime (date &optional zone)
1162 (if (math-realp date)
1164 (setq date (math-add 719164 (math-div date '(float 864 2))))
1165 (list 'date (math-sub date (math-div (calcFunc-tzone zone date)
1167 (if (eq (car date) 'date)
1168 (math-add (nth 1 (math-date-parts (nth 1 date) 719164))
1169 (calcFunc-tzone zone date))
1170 (math-reject-arg date 'datep))))
1196 (defun calcFunc-tzone (&optional zone date)
1203 (math-add (calcFunc-tzone (nth 1 zone) date)
1204 (calcFunc-tzone (nth 2 zone) date)))
1206 (math-sub (calcFunc-tzone (nth 1 zone) date)
1207 (calcFunc-tzone (nth 2 zone) date)))
1217 date (car found))
1219 date)
1221 (calcFunc-tzone nil date)
1225 (calcFunc-tzone (calc-var-value 'var-TimeZone) date)
1232 (call-process "date" nil t)
1272 (calcFunc-tzone tz date)))))
1276 (defun math-daylight-savings-adjust (date zone &optional dt)
1277 (or date (setq date (nth 1 (calcFunc-now))))
1279 (if (eq (car-safe date) 'date)
1281 date (nth 1 date))
1282 (if (and date (math-realp date))
1285 date (math-sub date (math-div (nth 1 zadj)
1287 (math-reject-arg date 'datep)))
1288 (setq date (math-float date))
1289 (or dt (setq dt (math-date-to-dt date)))
1291 (funcall math-daylight-savings-hook date dt zone bump))))
1293 (defun calcFunc-dsadj (date &optional zone)
1307 (math-daylight-savings-adjust date zone))))
1309 (defun calcFunc-tzconv (date z1 z2)
1310 (if (math-realp date)
1311 (nth 1 (calcFunc-tzconv (list 'date date) z1 z2))
1312 (calcFunc-unixtime (calcFunc-unixtime date z1) z2)))
1314 (defun math-std-daylight-savings (date dt zone bump)
1316 Before 2007, this uses `math-std-daylight-savings-old', where
1323 (math-std-daylight-savings-old date dt zone bump)
1324 (math-std-daylight-savings-new date dt zone bump)))
1326 (defun math-std-daylight-savings-new (date dt zone bump)
1333 (let ((sunday (math-prev-weekday-in-month date dt 14 0)))
1340 (let ((sunday (math-prev-weekday-in-month date dt 7 0)))
1347 (defun math-std-daylight-savings-old (date dt zone bump)
1354 (let ((sunday (math-prev-weekday-in-month date dt 7 0)))
1361 (let ((sunday (math-prev-weekday-in-month date dt 31 0)))
1370 (defun math-prev-weekday-in-month (date dt day wday)
1374 (let ((zeroth (math-sub (math-floor date) (nth 2 dt))))
1377 (defun calcFunc-pwday (date &optional day weekday)
1378 (if (eq (car-safe date) 'date)
1379 (setq date (nth 1 date)))
1380 (or (math-realp date)
1381 (math-reject-arg date 'datep))
1386 (math-prev-weekday-in-month date (math-date-to-dt date) day (or weekday 0)))
1389 (defun calcFunc-newweek (date &optional weekday)
1390 (if (eq (car-safe date) 'date)
1391 (setq date (nth 1 date)))
1392 (or (math-realp date)
1393 (math-reject-arg date 'datep))
1398 (setq date (math-floor date))
1399 (list 'date (math-sub date (calcFunc-weekday (math-sub date weekday)))))
1401 (defun calcFunc-newmonth (date &optional day)
1406 (let ((dt (math-date-to-dt date)))
1411 (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1))
1414 (defun calcFunc-newyear (date &optional day)
1418 (let ((dt (math-date-to-dt date)))
1423 (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
1426 (list 'date (math-dt-to-date (list (car dt) (- day) 1)))
1429 (defun calcFunc-incmonth (date &optional step)
1433 (let* ((dt (math-date-to-dt date))
1445 (list 'date (math-dt-to-date
1448 (defun calcFunc-incyear (date &optional step)
1449 (calcFunc-incmonth date (math-mul (or step 1) 12)))
1454 (or (eq (car-safe a) 'date)
1456 (if (eq (car-safe b) 'date)
1469 (if (eq (car-safe b) 'date)
1470 (if (eq (car-safe a) 'date)
1471 (math-reject-arg nil "*Invalid combination in date arithmetic")
1473 (if (eq (car-safe a) 'date)
1489 (math-reject-arg nil "*Invalid combination in date arithmetic")))
1497 (defun math-to-business-day (date &optional need-year)
1498 (if (eq (car-safe date) 'date)
1499 (setq date (nth 1 date)))
1500 (or (Math-realp date)
1501 (math-reject-arg date 'datep))
1502 (let* ((day (math-floor date))
1503 (time (math-sub date day))
1504 (dt (math-date-to-dt day))
1508 (math-reject-arg (list 'date day) "*Generated holiday has wrong year"))
1509 (math-setup-holidays date)
1536 ;;; Compute the date a certain number of business days since Jan 1, 1 AD.
1564 (list 'date (math-add day time))))))
1571 (defun math-setup-holidays (&optional date)
1580 (cond ((or (and (eq (car-safe (car h)) 'date)
1583 (eq (car-safe (nth 2 (car h))) 'date))
1633 (if date
1634 (let ((year (calcFunc-year date))
1639 (or (eq (car-safe date) 'date) (setq date (list 'date date)))
1640 (math-reject-arg date "*Date is outside valid range")))
1700 ((eq (car-safe days) 'date)
1715 (math-reject-arg (list 'date days) "*Invalid holiday value"))
1726 (if (memq (car-safe x) '(date mod sdev intv vec))
1728 (if (memq (car-safe sigma) '(date mod sdev intv vec))
1785 (or (eq (eq (car-safe lo) 'date) (eq (car-safe hi) 'date))
1786 (math-reject-arg (if (eq (car-safe lo) 'date) hi lo) 'datep))
1787 (if (and (or (Math-realp lo) (eq (car lo) 'date))
1788 (or (Math-realp hi) (eq (car hi) 'date)))
1882 (math-parse-date str)))))