diff options
| author | Jay Belanger | 2004-11-24 17:59:37 +0000 |
|---|---|---|
| committer | Jay Belanger | 2004-11-24 17:59:37 +0000 |
| commit | 98223359965fcd64de1d4d08329e7f614680a993 (patch) | |
| tree | b05d7c6c41c008d692ea1adfb9f3eb75a22c2e6a | |
| parent | 0e7acedf7b7777ffc845b504579cef1e5ca1c0fd (diff) | |
| download | emacs-98223359965fcd64de1d4d08329e7f614680a993.tar.gz emacs-98223359965fcd64de1d4d08329e7f614680a993.zip | |
(math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
(math-fd-day, math-fd-weekday, math-fd-hour, math-fd-minute)
(math-fd-second, math-fd-bc-flag): New variables.
(math-format-date, math-format-date-part): Replace variables
date, dt, year, month, day, weekday, hour, minute, second and
bc-flag by declared variables.
(math-pd-str): New variable.
(math-parse-date, math-parse-date-word, math-parse-standard-date):
Replace variable str by declared variable.
(math-daylight-savings-hook, math-tzone-names): Move definitions
to earlier in the file.
(var-TimeZone): Declare it.
(math-exp-str, math-exp-pos): Declare them.
(math-sh-year): New variable.
(math-setup-add-holidays, math-setup-holidays)
(math-setup-year-holiday): Replace variable `year'
by declared variable.
| -rw-r--r-- | lisp/calc/calc-forms.el | 424 |
1 files changed, 230 insertions, 194 deletions
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index e64983ad33d..146427b761c 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el | |||
| @@ -510,181 +510,200 @@ | |||
| 510 | 510 | ||
| 511 | 511 | ||
| 512 | (defvar math-format-date-cache nil) | 512 | (defvar math-format-date-cache nil) |
| 513 | (defun math-format-date (date) | 513 | |
| 514 | (if (eq (car-safe date) 'date) | 514 | ;; The variables math-fd-date, math-fd-dt, math-fd-year, |
| 515 | (setq date (nth 1 date))) | 515 | ;; math-fd-month, math-fd-day, math-fd-weekday, math-fd-hour, |
| 516 | (let ((entry (list date calc-internal-prec calc-date-format))) | 516 | ;; math-fd-minute, math-fd-second, math-fd-bc-flag are local |
| 517 | ;; to math-format-date, but are used by math-format-date-part, | ||
| 518 | ;; which is called by math-format-date. | ||
| 519 | (defvar math-fd-date) | ||
| 520 | (defvar math-fd-dt) | ||
| 521 | (defvar math-fd-year) | ||
| 522 | (defvar math-fd-month) | ||
| 523 | (defvar math-fd-day) | ||
| 524 | (defvar math-fd-weekday) | ||
| 525 | (defvar math-fd-hour) | ||
| 526 | (defvar math-fd-minute) | ||
| 527 | (defvar math-fd-second) | ||
| 528 | (defvar math-fd-bc-flag) | ||
| 529 | |||
| 530 | (defun math-format-date (math-fd-date) | ||
| 531 | (if (eq (car-safe math-fd-date) 'date) | ||
| 532 | (setq math-fd-date (nth 1 math-fd-date))) | ||
| 533 | (let ((entry (list math-fd-date calc-internal-prec calc-date-format))) | ||
| 517 | (or (cdr (assoc entry math-format-date-cache)) | 534 | (or (cdr (assoc entry math-format-date-cache)) |
| 518 | (let* ((dt nil) | 535 | (let* ((math-fd-dt nil) |
| 519 | (calc-group-digits nil) | 536 | (calc-group-digits nil) |
| 520 | (calc-leading-zeros nil) | 537 | (calc-leading-zeros nil) |
| 521 | (calc-number-radix 10) | 538 | (calc-number-radix 10) |
| 522 | year month day weekday hour minute second | 539 | math-fd-year math-fd-month math-fd-day math-fd-weekday |
| 523 | (bc-flag nil) | 540 | math-fd-hour math-fd-minute math-fd-second |
| 541 | (math-fd-bc-flag nil) | ||
| 524 | (fmt (apply 'concat (mapcar 'math-format-date-part | 542 | (fmt (apply 'concat (mapcar 'math-format-date-part |
| 525 | calc-date-format)))) | 543 | calc-date-format)))) |
| 526 | (setq math-format-date-cache (cons (cons entry fmt) | 544 | (setq math-format-date-cache (cons (cons entry fmt) |
| 527 | math-format-date-cache)) | 545 | math-format-date-cache)) |
| 528 | (and (setq dt (nthcdr 10 math-format-date-cache)) | 546 | (and (setq math-fd-dt (nthcdr 10 math-format-date-cache)) |
| 529 | (setcdr dt nil)) | 547 | (setcdr math-fd-dt nil)) |
| 530 | fmt)))) | 548 | fmt)))) |
| 531 | 549 | ||
| 532 | (defun math-format-date-part (x) | 550 | (defun math-format-date-part (x) |
| 533 | (cond ((stringp x) | 551 | (cond ((stringp x) |
| 534 | x) | 552 | x) |
| 535 | ((listp x) | 553 | ((listp x) |
| 536 | (if (math-integerp date) | 554 | (if (math-integerp math-fd-date) |
| 537 | "" | 555 | "" |
| 538 | (apply 'concat (mapcar 'math-format-date-part x)))) | 556 | (apply 'concat (mapcar 'math-format-date-part x)))) |
| 539 | ((eq x 'X) | 557 | ((eq x 'X) |
| 540 | "") | 558 | "") |
| 541 | ((eq x 'N) | 559 | ((eq x 'N) |
| 542 | (math-format-number date)) | 560 | (math-format-number math-fd-date)) |
| 543 | ((eq x 'n) | 561 | ((eq x 'n) |
| 544 | (math-format-number (math-floor date))) | 562 | (math-format-number (math-floor math-fd-date))) |
| 545 | ((eq x 'J) | 563 | ((eq x 'J) |
| 546 | (math-format-number (math-add date '(float (bigpos 235 214 17) -1)))) | 564 | (math-format-number (math-add math-fd-date '(float (bigpos 235 214 17) -1)))) |
| 547 | ((eq x 'j) | 565 | ((eq x 'j) |
| 548 | (math-format-number (math-add (math-floor date) '(bigpos 424 721 1)))) | 566 | (math-format-number (math-add (math-floor math-fd-date) '(bigpos 424 721 1)))) |
| 549 | ((eq x 'U) | 567 | ((eq x 'U) |
| 550 | (math-format-number (nth 1 (math-date-parts date 719164)))) | 568 | (math-format-number (nth 1 (math-date-parts math-fd-date 719164)))) |
| 551 | ((progn | 569 | ((progn |
| 552 | (or dt | 570 | (or math-fd-dt |
| 553 | (progn | 571 | (progn |
| 554 | (setq dt (math-date-to-dt date) | 572 | (setq math-fd-dt (math-date-to-dt math-fd-date) |
| 555 | year (car dt) | 573 | math-fd-year (car math-fd-dt) |
| 556 | month (nth 1 dt) | 574 | math-fd-month (nth 1 math-fd-dt) |
| 557 | day (nth 2 dt) | 575 | math-fd-day (nth 2 math-fd-dt) |
| 558 | weekday (math-mod (math-add (math-floor date) 6) 7) | 576 | math-fd-weekday (math-mod |
| 559 | hour (nth 3 dt) | 577 | (math-add (math-floor math-fd-date) 6) 7) |
| 560 | minute (nth 4 dt) | 578 | math-fd-hour (nth 3 math-fd-dt) |
| 561 | second (nth 5 dt)) | 579 | math-fd-minute (nth 4 math-fd-dt) |
| 580 | math-fd-second (nth 5 math-fd-dt)) | ||
| 562 | (and (memq 'b calc-date-format) | 581 | (and (memq 'b calc-date-format) |
| 563 | (math-negp year) | 582 | (math-negp math-fd-year) |
| 564 | (setq year (math-neg year) | 583 | (setq math-fd-year (math-neg math-fd-year) |
| 565 | bc-flag t)))) | 584 | math-fd-bc-flag t)))) |
| 566 | (memq x '(Y YY BY))) | 585 | (memq x '(Y YY BY))) |
| 567 | (if (and (integerp year) (> year 1940) (< year 2040)) | 586 | (if (and (integerp math-fd-year) (> math-fd-year 1940) (< math-fd-year 2040)) |
| 568 | (format (cond ((eq x 'YY) "%02d") | 587 | (format (cond ((eq x 'YY) "%02d") |
| 569 | ((eq x 'BYY) "%2d") | 588 | ((eq x 'BYY) "%2d") |
| 570 | (t "%d")) | 589 | (t "%d")) |
| 571 | (% year 100)) | 590 | (% math-fd-year 100)) |
| 572 | (if (and (natnump year) (< year 100)) | 591 | (if (and (natnump math-fd-year) (< math-fd-year 100)) |
| 573 | (format "+%d" year) | 592 | (format "+%d" math-fd-year) |
| 574 | (math-format-number year)))) | 593 | (math-format-number math-fd-year)))) |
| 575 | ((eq x 'YYY) | 594 | ((eq x 'YYY) |
| 576 | (math-format-number year)) | 595 | (math-format-number math-fd-year)) |
| 577 | ((eq x 'YYYY) | 596 | ((eq x 'YYYY) |
| 578 | (if (and (natnump year) (< year 100)) | 597 | (if (and (natnump math-fd-year) (< math-fd-year 100)) |
| 579 | (format "+%d" year) | 598 | (format "+%d" math-fd-year) |
| 580 | (math-format-number year))) | 599 | (math-format-number math-fd-year))) |
| 581 | ((eq x 'b) "") | 600 | ((eq x 'b) "") |
| 582 | ((eq x 'aa) | 601 | ((eq x 'aa) |
| 583 | (and (not bc-flag) "ad")) | 602 | (and (not math-fd-bc-flag) "ad")) |
| 584 | ((eq x 'AA) | 603 | ((eq x 'AA) |
| 585 | (and (not bc-flag) "AD")) | 604 | (and (not math-fd-bc-flag) "AD")) |
| 586 | ((eq x 'aaa) | 605 | ((eq x 'aaa) |
| 587 | (and (not bc-flag) "ad ")) | 606 | (and (not math-fd-bc-flag) "ad ")) |
| 588 | ((eq x 'AAA) | 607 | ((eq x 'AAA) |
| 589 | (and (not bc-flag) "AD ")) | 608 | (and (not math-fd-bc-flag) "AD ")) |
| 590 | ((eq x 'aaaa) | 609 | ((eq x 'aaaa) |
| 591 | (and (not bc-flag) "a.d.")) | 610 | (and (not math-fd-bc-flag) "a.d.")) |
| 592 | ((eq x 'AAAA) | 611 | ((eq x 'AAAA) |
| 593 | (and (not bc-flag) "A.D.")) | 612 | (and (not math-fd-bc-flag) "A.D.")) |
| 594 | ((eq x 'bb) | 613 | ((eq x 'bb) |
| 595 | (and bc-flag "bc")) | 614 | (and math-fd-bc-flag "bc")) |
| 596 | ((eq x 'BB) | 615 | ((eq x 'BB) |
| 597 | (and bc-flag "BC")) | 616 | (and math-fd-bc-flag "BC")) |
| 598 | ((eq x 'bbb) | 617 | ((eq x 'bbb) |
| 599 | (and bc-flag " bc")) | 618 | (and math-fd-bc-flag " bc")) |
| 600 | ((eq x 'BBB) | 619 | ((eq x 'BBB) |
| 601 | (and bc-flag " BC")) | 620 | (and math-fd-bc-flag " BC")) |
| 602 | ((eq x 'bbbb) | 621 | ((eq x 'bbbb) |
| 603 | (and bc-flag "b.c.")) | 622 | (and math-fd-bc-flag "b.c.")) |
| 604 | ((eq x 'BBBB) | 623 | ((eq x 'BBBB) |
| 605 | (and bc-flag "B.C.")) | 624 | (and math-fd-bc-flag "B.C.")) |
| 606 | ((eq x 'M) | 625 | ((eq x 'M) |
| 607 | (format "%d" month)) | 626 | (format "%d" math-fd-month)) |
| 608 | ((eq x 'MM) | 627 | ((eq x 'MM) |
| 609 | (format "%02d" month)) | 628 | (format "%02d" math-fd-month)) |
| 610 | ((eq x 'BM) | 629 | ((eq x 'BM) |
| 611 | (format "%2d" month)) | 630 | (format "%2d" math-fd-month)) |
| 612 | ((eq x 'mmm) | 631 | ((eq x 'mmm) |
| 613 | (downcase (nth (1- month) math-short-month-names))) | 632 | (downcase (nth (1- math-fd-month) math-short-month-names))) |
| 614 | ((eq x 'Mmm) | 633 | ((eq x 'Mmm) |
| 615 | (nth (1- month) math-short-month-names)) | 634 | (nth (1- math-fd-month) math-short-month-names)) |
| 616 | ((eq x 'MMM) | 635 | ((eq x 'MMM) |
| 617 | (upcase (nth (1- month) math-short-month-names))) | 636 | (upcase (nth (1- math-fd-month) math-short-month-names))) |
| 618 | ((eq x 'Mmmm) | 637 | ((eq x 'Mmmm) |
| 619 | (nth (1- month) math-long-month-names)) | 638 | (nth (1- math-fd-month) math-long-month-names)) |
| 620 | ((eq x 'MMMM) | 639 | ((eq x 'MMMM) |
| 621 | (upcase (nth (1- month) math-long-month-names))) | 640 | (upcase (nth (1- math-fd-month) math-long-month-names))) |
| 622 | ((eq x 'D) | 641 | ((eq x 'D) |
| 623 | (format "%d" day)) | 642 | (format "%d" math-fd-day)) |
| 624 | ((eq x 'DD) | 643 | ((eq x 'DD) |
| 625 | (format "%02d" day)) | 644 | (format "%02d" math-fd-day)) |
| 626 | ((eq x 'BD) | 645 | ((eq x 'BD) |
| 627 | (format "%2d" day)) | 646 | (format "%2d" math-fd-day)) |
| 628 | ((eq x 'W) | 647 | ((eq x 'W) |
| 629 | (format "%d" weekday)) | 648 | (format "%d" math-fd-weekday)) |
| 630 | ((eq x 'www) | 649 | ((eq x 'www) |
| 631 | (downcase (nth weekday math-short-weekday-names))) | 650 | (downcase (nth math-fd-weekday math-short-weekday-names))) |
| 632 | ((eq x 'Www) | 651 | ((eq x 'Www) |
| 633 | (nth weekday math-short-weekday-names)) | 652 | (nth math-fd-weekday math-short-weekday-names)) |
| 634 | ((eq x 'WWW) | 653 | ((eq x 'WWW) |
| 635 | (upcase (nth weekday math-short-weekday-names))) | 654 | (upcase (nth math-fd-weekday math-short-weekday-names))) |
| 636 | ((eq x 'Wwww) | 655 | ((eq x 'Wwww) |
| 637 | (nth weekday math-long-weekday-names)) | 656 | (nth math-fd-weekday math-long-weekday-names)) |
| 638 | ((eq x 'WWWW) | 657 | ((eq x 'WWWW) |
| 639 | (upcase (nth weekday math-long-weekday-names))) | 658 | (upcase (nth math-fd-weekday math-long-weekday-names))) |
| 640 | ((eq x 'd) | 659 | ((eq x 'd) |
| 641 | (format "%d" (math-day-number year month day))) | 660 | (format "%d" (math-day-number math-fd-year math-fd-month math-fd-day))) |
| 642 | ((eq x 'ddd) | 661 | ((eq x 'ddd) |
| 643 | (format "%03d" (math-day-number year month day))) | 662 | (format "%03d" (math-day-number math-fd-year math-fd-month math-fd-day))) |
| 644 | ((eq x 'bdd) | 663 | ((eq x 'bdd) |
| 645 | (format "%3d" (math-day-number year month day))) | 664 | (format "%3d" (math-day-number math-fd-year math-fd-month math-fd-day))) |
| 646 | ((eq x 'h) | 665 | ((eq x 'h) |
| 647 | (and hour (format "%d" hour))) | 666 | (and math-fd-hour (format "%d" math-fd-hour))) |
| 648 | ((eq x 'hh) | 667 | ((eq x 'hh) |
| 649 | (and hour (format "%02d" hour))) | 668 | (and math-fd-hour (format "%02d" math-fd-hour))) |
| 650 | ((eq x 'bh) | 669 | ((eq x 'bh) |
| 651 | (and hour (format "%2d" hour))) | 670 | (and math-fd-hour (format "%2d" math-fd-hour))) |
| 652 | ((eq x 'H) | 671 | ((eq x 'H) |
| 653 | (and hour (format "%d" (1+ (% (+ hour 11) 12))))) | 672 | (and math-fd-hour (format "%d" (1+ (% (+ math-fd-hour 11) 12))))) |
| 654 | ((eq x 'HH) | 673 | ((eq x 'HH) |
| 655 | (and hour (format "%02d" (1+ (% (+ hour 11) 12))))) | 674 | (and math-fd-hour (format "%02d" (1+ (% (+ math-fd-hour 11) 12))))) |
| 656 | ((eq x 'BH) | 675 | ((eq x 'BH) |
| 657 | (and hour (format "%2d" (1+ (% (+ hour 11) 12))))) | 676 | (and math-fd-hour (format "%2d" (1+ (% (+ math-fd-hour 11) 12))))) |
| 658 | ((eq x 'p) | 677 | ((eq x 'p) |
| 659 | (and hour (if (< hour 12) "a" "p"))) | 678 | (and math-fd-hour (if (< math-fd-hour 12) "a" "p"))) |
| 660 | ((eq x 'P) | 679 | ((eq x 'P) |
| 661 | (and hour (if (< hour 12) "A" "P"))) | 680 | (and math-fd-hour (if (< math-fd-hour 12) "A" "P"))) |
| 662 | ((eq x 'pp) | 681 | ((eq x 'pp) |
| 663 | (and hour (if (< hour 12) "am" "pm"))) | 682 | (and math-fd-hour (if (< math-fd-hour 12) "am" "pm"))) |
| 664 | ((eq x 'PP) | 683 | ((eq x 'PP) |
| 665 | (and hour (if (< hour 12) "AM" "PM"))) | 684 | (and math-fd-hour (if (< math-fd-hour 12) "AM" "PM"))) |
| 666 | ((eq x 'pppp) | 685 | ((eq x 'pppp) |
| 667 | (and hour (if (< hour 12) "a.m." "p.m."))) | 686 | (and math-fd-hour (if (< math-fd-hour 12) "a.m." "p.m."))) |
| 668 | ((eq x 'PPPP) | 687 | ((eq x 'PPPP) |
| 669 | (and hour (if (< hour 12) "A.M." "P.M."))) | 688 | (and math-fd-hour (if (< math-fd-hour 12) "A.M." "P.M."))) |
| 670 | ((eq x 'm) | 689 | ((eq x 'm) |
| 671 | (and minute (format "%d" minute))) | 690 | (and math-fd-minute (format "%d" math-fd-minute))) |
| 672 | ((eq x 'mm) | 691 | ((eq x 'mm) |
| 673 | (and minute (format "%02d" minute))) | 692 | (and math-fd-minute (format "%02d" math-fd-minute))) |
| 674 | ((eq x 'bm) | 693 | ((eq x 'bm) |
| 675 | (and minute (format "%2d" minute))) | 694 | (and math-fd-minute (format "%2d" math-fd-minute))) |
| 676 | ((eq x 'C) | 695 | ((eq x 'C) |
| 677 | (and second (not (math-zerop second)) | 696 | (and math-fd-second (not (math-zerop math-fd-second)) |
| 678 | ":")) | 697 | ":")) |
| 679 | ((memq x '(s ss bs SS BS)) | 698 | ((memq x '(s ss bs SS BS)) |
| 680 | (and second | 699 | (and math-fd-second |
| 681 | (not (and (memq x '(SS BS)) (math-zerop second))) | 700 | (not (and (memq x '(SS BS)) (math-zerop math-fd-second))) |
| 682 | (if (integerp second) | 701 | (if (integerp math-fd-second) |
| 683 | (format (cond ((memq x '(ss SS)) "%02d") | 702 | (format (cond ((memq x '(ss SS)) "%02d") |
| 684 | ((memq x '(bs BS)) "%2d") | 703 | ((memq x '(bs BS)) "%2d") |
| 685 | (t "%d")) | 704 | (t "%d")) |
| 686 | second) | 705 | math-fd-second) |
| 687 | (concat (if (Math-lessp second 10) | 706 | (concat (if (Math-lessp math-fd-second 10) |
| 688 | (cond ((memq x '(ss SS)) "0") | 707 | (cond ((memq x '(ss SS)) "0") |
| 689 | ((memq x '(bs BS)) " ") | 708 | ((memq x '(bs BS)) " ") |
| 690 | (t "")) | 709 | (t "")) |
| @@ -692,29 +711,33 @@ | |||
| 692 | (let ((calc-float-format | 711 | (let ((calc-float-format |
| 693 | (list 'fix (min (- 12 calc-internal-prec) | 712 | (list 'fix (min (- 12 calc-internal-prec) |
| 694 | 0)))) | 713 | 0)))) |
| 695 | (math-format-number second)))))))) | 714 | (math-format-number math-fd-second)))))))) |
| 696 | 715 | ||
| 716 | ;; The variable math-pd-str is local to math-parse-date and | ||
| 717 | ;; math-parse-standard-date, but is used by math-parse-date-word, | ||
| 718 | ;; which is called by math-parse-date and math-parse-standard-date. | ||
| 719 | (defvar math-pd-str) | ||
| 697 | 720 | ||
| 698 | (defun math-parse-date (str) | 721 | (defun math-parse-date (math-pd-str) |
| 699 | (catch 'syntax | 722 | (catch 'syntax |
| 700 | (or (math-parse-standard-date str t) | 723 | (or (math-parse-standard-date math-pd-str t) |
| 701 | (math-parse-standard-date str nil) | 724 | (math-parse-standard-date math-pd-str nil) |
| 702 | (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" str) | 725 | (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" math-pd-str) |
| 703 | (list 'date (math-read-number (math-match-substring str 1)))) | 726 | (list 'date (math-read-number (math-match-substring math-pd-str 1)))) |
| 704 | (let ((case-fold-search t) | 727 | (let ((case-fold-search t) |
| 705 | (year nil) (month nil) (day nil) (weekday nil) | 728 | (year nil) (month nil) (day nil) (weekday nil) |
| 706 | (hour nil) (minute nil) (second nil) (bc-flag nil) | 729 | (hour nil) (minute nil) (second nil) (bc-flag nil) |
| 707 | (a nil) (b nil) (c nil) (bigyear nil) temp) | 730 | (a nil) (b nil) (c nil) (bigyear nil) temp) |
| 708 | 731 | ||
| 709 | ;; Extract the time, if any. | 732 | ;; Extract the time, if any. |
| 710 | (if (or (string-match "\\([0-9][0-9]?\\):\\([0-9][0-9]?\\)\\(:\\([0-9][0-9]?\\(\\.[0-9]+\\)?\\)\\)? *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)?" str) | 733 | (if (or (string-match "\\([0-9][0-9]?\\):\\([0-9][0-9]?\\)\\(:\\([0-9][0-9]?\\(\\.[0-9]+\\)?\\)\\)? *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)?" math-pd-str) |
| 711 | (string-match "\\([0-9][0-9]?\\)\\(\\)\\(\\(\\(\\)\\)\\) *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)" str)) | 734 | (string-match "\\([0-9][0-9]?\\)\\(\\)\\(\\(\\(\\)\\)\\) *\\([ap]m?\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)" math-pd-str)) |
| 712 | (let ((ampm (math-match-substring str 6))) | 735 | (let ((ampm (math-match-substring math-pd-str 6))) |
| 713 | (setq hour (string-to-int (math-match-substring str 1)) | 736 | (setq hour (string-to-int (math-match-substring math-pd-str 1)) |
| 714 | minute (math-match-substring str 2) | 737 | minute (math-match-substring math-pd-str 2) |
| 715 | second (math-match-substring str 4) | 738 | second (math-match-substring math-pd-str 4) |
| 716 | str (concat (substring str 0 (match-beginning 0)) | 739 | math-pd-str (concat (substring math-pd-str 0 (match-beginning 0)) |
| 717 | (substring str (match-end 0)))) | 740 | (substring math-pd-str (match-end 0)))) |
| 718 | (if (equal minute "") | 741 | (if (equal minute "") |
| 719 | (setq minute 0) | 742 | (setq minute 0) |
| 720 | (setq minute (string-to-int minute))) | 743 | (setq minute (string-to-int minute))) |
| @@ -736,13 +759,13 @@ | |||
| 736 | (setq hour (% (+ hour 12) 24))))))) | 759 | (setq hour (% (+ hour 12) 24))))))) |
| 737 | 760 | ||
| 738 | ;; Rewrite xx-yy-zz to xx/yy/zz to avoid seeing "-" as a minus sign. | 761 | ;; Rewrite xx-yy-zz to xx/yy/zz to avoid seeing "-" as a minus sign. |
| 739 | (while (string-match "[0-9a-zA-Z]\\(-\\)[0-9a-zA-Z]" str) | 762 | (while (string-match "[0-9a-zA-Z]\\(-\\)[0-9a-zA-Z]" math-pd-str) |
| 740 | (progn | 763 | (progn |
| 741 | (setq str (copy-sequence str)) | 764 | (setq math-pd-str (copy-sequence math-pd-str)) |
| 742 | (aset str (match-beginning 1) ?\/))) | 765 | (aset math-pd-str (match-beginning 1) ?\/))) |
| 743 | 766 | ||
| 744 | ;; Extract obvious month or weekday names. | 767 | ;; Extract obvious month or weekday names. |
| 745 | (if (string-match "[a-zA-Z]" str) | 768 | (if (string-match "[a-zA-Z]" math-pd-str) |
| 746 | (progn | 769 | (progn |
| 747 | (setq month (math-parse-date-word math-long-month-names)) | 770 | (setq month (math-parse-date-word math-long-month-names)) |
| 748 | (setq weekday (math-parse-date-word math-long-weekday-names)) | 771 | (setq weekday (math-parse-date-word math-long-weekday-names)) |
| @@ -756,31 +779,32 @@ | |||
| 756 | (or (math-parse-date-word '( "ad" "a.d." )) | 779 | (or (math-parse-date-word '( "ad" "a.d." )) |
| 757 | (if (math-parse-date-word '( "bc" "b.c." )) | 780 | (if (math-parse-date-word '( "bc" "b.c." )) |
| 758 | (setq bc-flag t))) | 781 | (setq bc-flag t))) |
| 759 | (if (string-match "[a-zA-Z]+" str) | 782 | (if (string-match "[a-zA-Z]+" math-pd-str) |
| 760 | (throw 'syntax (format "Bad word in date: \"%s\"" | 783 | (throw 'syntax (format "Bad word in date: \"%s\"" |
| 761 | (math-match-substring str 0)))))) | 784 | (math-match-substring math-pd-str 0)))))) |
| 762 | 785 | ||
| 763 | ;; If there is a huge number other than the year, ignore it. | 786 | ;; If there is a huge number other than the year, ignore it. |
| 764 | (while (and (string-match "[-+]?0*[1-9][0-9][0-9][0-9][0-9]+" str) | 787 | (while (and (string-match "[-+]?0*[1-9][0-9][0-9][0-9][0-9]+" math-pd-str) |
| 765 | (setq temp (concat (substring str 0 (match-beginning 0)) | 788 | (setq temp (concat (substring math-pd-str 0 (match-beginning 0)) |
| 766 | (substring str (match-end 0)))) | 789 | (substring math-pd-str (match-end 0)))) |
| 767 | (string-match "[4-9][0-9]\\|[0-9][0-9][0-9]\\|[-+][0-9]+[^-]*\\'" temp)) | 790 | (string-match |
| 768 | (setq str temp)) | 791 | "[4-9][0-9]\\|[0-9][0-9][0-9]\\|[-+][0-9]+[^-]*\\'" temp)) |
| 792 | (setq math-pd-str temp)) | ||
| 769 | 793 | ||
| 770 | ;; If there is a number with a sign or a large number, it is a year. | 794 | ;; If there is a number with a sign or a large number, it is a year. |
| 771 | (if (or (string-match "\\([-+][0-9]+\\)[^-]*\\'" str) | 795 | (if (or (string-match "\\([-+][0-9]+\\)[^-]*\\'" math-pd-str) |
| 772 | (string-match "\\(0*[1-9][0-9][0-9]+\\)" str)) | 796 | (string-match "\\(0*[1-9][0-9][0-9]+\\)" math-pd-str)) |
| 773 | (setq year (math-match-substring str 1) | 797 | (setq year (math-match-substring math-pd-str 1) |
| 774 | str (concat (substring str 0 (match-beginning 1)) | 798 | math-pd-str (concat (substring math-pd-str 0 (match-beginning 1)) |
| 775 | (substring str (match-end 1))) | 799 | (substring math-pd-str (match-end 1))) |
| 776 | year (math-read-number year) | 800 | year (math-read-number year) |
| 777 | bigyear t)) | 801 | bigyear t)) |
| 778 | 802 | ||
| 779 | ;; Collect remaining numbers. | 803 | ;; Collect remaining numbers. |
| 780 | (setq temp 0) | 804 | (setq temp 0) |
| 781 | (while (string-match "[0-9]+" str temp) | 805 | (while (string-match "[0-9]+" math-pd-str temp) |
| 782 | (and c (throw 'syntax "Too many numbers in date")) | 806 | (and c (throw 'syntax "Too many numbers in date")) |
| 783 | (setq c (string-to-int (math-match-substring str 0))) | 807 | (setq c (string-to-int (math-match-substring math-pd-str 0))) |
| 784 | (or b (setq b c c nil)) | 808 | (or b (setq b c c nil)) |
| 785 | (or a (setq a b b nil)) | 809 | (or a (setq a b b nil)) |
| 786 | (setq temp (match-end 0))) | 810 | (setq temp (match-end 0))) |
| @@ -867,18 +891,18 @@ | |||
| 867 | (while (and names (not (string-match (if (equal (car names) "Sep") | 891 | (while (and names (not (string-match (if (equal (car names) "Sep") |
| 868 | "Sept?" | 892 | "Sept?" |
| 869 | (regexp-quote (car names))) | 893 | (regexp-quote (car names))) |
| 870 | str))) | 894 | math-pd-str))) |
| 871 | (setq names (cdr names) | 895 | (setq names (cdr names) |
| 872 | n (1+ n))) | 896 | n (1+ n))) |
| 873 | (and names | 897 | (and names |
| 874 | (or (not front) (= (match-beginning 0) 0)) | 898 | (or (not front) (= (match-beginning 0) 0)) |
| 875 | (progn | 899 | (progn |
| 876 | (setq str (concat (substring str 0 (match-beginning 0)) | 900 | (setq math-pd-str (concat (substring math-pd-str 0 (match-beginning 0)) |
| 877 | (if front "" " ") | 901 | (if front "" " ") |
| 878 | (substring str (match-end 0)))) | 902 | (substring math-pd-str (match-end 0)))) |
| 879 | n)))) | 903 | n)))) |
| 880 | 904 | ||
| 881 | (defun math-parse-standard-date (str with-time) | 905 | (defun math-parse-standard-date (math-pd-str with-time) |
| 882 | (let ((case-fold-search t) | 906 | (let ((case-fold-search t) |
| 883 | (okay t) num | 907 | (okay t) num |
| 884 | (fmt calc-date-format) this next (gnext nil) | 908 | (fmt calc-date-format) this next (gnext nil) |
| @@ -898,16 +922,16 @@ | |||
| 898 | (setq gnext fmt | 922 | (setq gnext fmt |
| 899 | fmt this))) | 923 | fmt this))) |
| 900 | ((stringp this) | 924 | ((stringp this) |
| 901 | (if (and (<= (length this) (length str)) | 925 | (if (and (<= (length this) (length math-pd-str)) |
| 902 | (equal this | 926 | (equal this |
| 903 | (substring str 0 (length this)))) | 927 | (substring math-pd-str 0 (length this)))) |
| 904 | (setq str (substring str (length this))))) | 928 | (setq math-pd-str (substring math-pd-str (length this))))) |
| 905 | ((eq this 'X) | 929 | ((eq this 'X) |
| 906 | t) | 930 | t) |
| 907 | ((memq this '(n N j J)) | 931 | ((memq this '(n N j J)) |
| 908 | (and (string-match "\\`[-+]?[0-9.]+\\([eE][-+]?[0-9]+\\)?" str) | 932 | (and (string-match "\\`[-+]?[0-9.]+\\([eE][-+]?[0-9]+\\)?" math-pd-str) |
| 909 | (setq num (math-match-substring str 0) | 933 | (setq num (math-match-substring math-pd-str 0) |
| 910 | str (substring str (match-end 0)) | 934 | math-pd-str (substring math-pd-str (match-end 0)) |
| 911 | num (math-date-to-dt (math-read-number num)) | 935 | num (math-date-to-dt (math-read-number num)) |
| 912 | num (math-sub num | 936 | num (math-sub num |
| 913 | (if (memq this '(n N)) | 937 | (if (memq this '(n N)) |
| @@ -924,9 +948,9 @@ | |||
| 924 | month (nth 1 num) | 948 | month (nth 1 num) |
| 925 | day (nth 2 num)))) | 949 | day (nth 2 num)))) |
| 926 | ((eq this 'U) | 950 | ((eq this 'U) |
| 927 | (and (string-match "\\`[-+]?[0-9]+" str) | 951 | (and (string-match "\\`[-+]?[0-9]+" math-pd-str) |
| 928 | (setq num (math-match-substring str 0) | 952 | (setq num (math-match-substring math-pd-str 0) |
| 929 | str (substring str (match-end 0)) | 953 | math-pd-str (substring math-pd-str (match-end 0)) |
| 930 | num (math-date-to-dt | 954 | num (math-date-to-dt |
| 931 | (math-add 719164 | 955 | (math-add 719164 |
| 932 | (math-div (math-read-number num) | 956 | (math-div (math-read-number num) |
| @@ -946,63 +970,63 @@ | |||
| 946 | ((memq this '(Wwww WWWW)) | 970 | ((memq this '(Wwww WWWW)) |
| 947 | (math-parse-date-word math-long-weekday-names t)) | 971 | (math-parse-date-word math-long-weekday-names t)) |
| 948 | ((memq this '(p P)) | 972 | ((memq this '(p P)) |
| 949 | (if (string-match "\\`a" str) | 973 | (if (string-match "\\`a" math-pd-str) |
| 950 | (setq hour (if (= hour 12) 0 hour) | 974 | (setq hour (if (= hour 12) 0 hour) |
| 951 | str (substring str 1)) | 975 | math-pd-str (substring math-pd-str 1)) |
| 952 | (if (string-match "\\`p" str) | 976 | (if (string-match "\\`p" math-pd-str) |
| 953 | (setq hour (if (= hour 12) 12 (% (+ hour 12) 24)) | 977 | (setq hour (if (= hour 12) 12 (% (+ hour 12) 24)) |
| 954 | str (substring str 1))))) | 978 | math-pd-str (substring math-pd-str 1))))) |
| 955 | ((memq this '(pp PP pppp PPPP)) | 979 | ((memq this '(pp PP pppp PPPP)) |
| 956 | (if (string-match "\\`am\\|a\\.m\\." str) | 980 | (if (string-match "\\`am\\|a\\.m\\." math-pd-str) |
| 957 | (setq hour (if (= hour 12) 0 hour) | 981 | (setq hour (if (= hour 12) 0 hour) |
| 958 | str (substring str (match-end 0))) | 982 | math-pd-str (substring math-pd-str (match-end 0))) |
| 959 | (if (string-match "\\`pm\\|p\\.m\\." str) | 983 | (if (string-match "\\`pm\\|p\\.m\\." math-pd-str) |
| 960 | (setq hour (if (= hour 12) 12 (% (+ hour 12) 24)) | 984 | (setq hour (if (= hour 12) 12 (% (+ hour 12) 24)) |
| 961 | str (substring str (match-end 0)))))) | 985 | math-pd-str (substring math-pd-str (match-end 0)))))) |
| 962 | ((memq this '(Y YY BY YYY YYYY)) | 986 | ((memq this '(Y YY BY YYY YYYY)) |
| 963 | (and (if (memq next '(MM DD ddd hh HH mm ss SS)) | 987 | (and (if (memq next '(MM DD ddd hh HH mm ss SS)) |
| 964 | (if (memq this '(Y YY BYY)) | 988 | (if (memq this '(Y YY BYY)) |
| 965 | (string-match "\\` *[0-9][0-9]" str) | 989 | (string-match "\\` *[0-9][0-9]" math-pd-str) |
| 966 | (string-match "\\`[0-9][0-9][0-9][0-9]" str)) | 990 | (string-match "\\`[0-9][0-9][0-9][0-9]" math-pd-str)) |
| 967 | (string-match "\\`[-+]?[0-9]+" str)) | 991 | (string-match "\\`[-+]?[0-9]+" math-pd-str)) |
| 968 | (setq year (math-match-substring str 0) | 992 | (setq year (math-match-substring math-pd-str 0) |
| 969 | bigyear (or (eq this 'YYY) | 993 | bigyear (or (eq this 'YYY) |
| 970 | (memq (aref str 0) '(?\+ ?\-))) | 994 | (memq (aref math-pd-str 0) '(?\+ ?\-))) |
| 971 | str (substring str (match-end 0)) | 995 | math-pd-str (substring math-pd-str (match-end 0)) |
| 972 | year (math-read-number year)))) | 996 | year (math-read-number year)))) |
| 973 | ((eq this 'b) | 997 | ((eq this 'b) |
| 974 | t) | 998 | t) |
| 975 | ((memq this '(aa AA aaaa AAAA)) | 999 | ((memq this '(aa AA aaaa AAAA)) |
| 976 | (if (string-match "\\` *\\(ad\\|a\\.d\\.\\)" str) | 1000 | (if (string-match "\\` *\\(ad\\|a\\.d\\.\\)" math-pd-str) |
| 977 | (setq str (substring str (match-end 0))))) | 1001 | (setq math-pd-str (substring math-pd-str (match-end 0))))) |
| 978 | ((memq this '(aaa AAA)) | 1002 | ((memq this '(aaa AAA)) |
| 979 | (if (string-match "\\` *ad *" str) | 1003 | (if (string-match "\\` *ad *" math-pd-str) |
| 980 | (setq str (substring str (match-end 0))))) | 1004 | (setq math-pd-str (substring math-pd-str (match-end 0))))) |
| 981 | ((memq this '(bb BB bbb BBB bbbb BBBB)) | 1005 | ((memq this '(bb BB bbb BBB bbbb BBBB)) |
| 982 | (if (string-match "\\` *\\(bc\\|b\\.c\\.\\)" str) | 1006 | (if (string-match "\\` *\\(bc\\|b\\.c\\.\\)" math-pd-str) |
| 983 | (setq str (substring str (match-end 0)) | 1007 | (setq math-pd-str (substring math-pd-str (match-end 0)) |
| 984 | bc-flag t))) | 1008 | bc-flag t))) |
| 985 | ((memq this '(s ss bs SS BS)) | 1009 | ((memq this '(s ss bs SS BS)) |
| 986 | (and (if (memq next '(YY YYYY MM DD hh HH mm)) | 1010 | (and (if (memq next '(YY YYYY MM DD hh HH mm)) |
| 987 | (string-match "\\` *[0-9][0-9]\\(\\.[0-9]+\\)?" str) | 1011 | (string-match "\\` *[0-9][0-9]\\(\\.[0-9]+\\)?" math-pd-str) |
| 988 | (string-match "\\` *[0-9][0-9]?\\(\\.[0-9]+\\)?" str)) | 1012 | (string-match "\\` *[0-9][0-9]?\\(\\.[0-9]+\\)?" math-pd-str)) |
| 989 | (setq second (math-match-substring str 0) | 1013 | (setq second (math-match-substring math-pd-str 0) |
| 990 | str (substring str (match-end 0)) | 1014 | math-pd-str (substring math-pd-str (match-end 0)) |
| 991 | second (math-read-number second)))) | 1015 | second (math-read-number second)))) |
| 992 | ((eq this 'C) | 1016 | ((eq this 'C) |
| 993 | (if (string-match "\\`:[0-9][0-9]" str) | 1017 | (if (string-match "\\`:[0-9][0-9]" math-pd-str) |
| 994 | (setq str (substring str 1)) | 1018 | (setq math-pd-str (substring math-pd-str 1)) |
| 995 | t)) | 1019 | t)) |
| 996 | ((or (not (if (and (memq this '(ddd MM DD hh HH mm)) | 1020 | ((or (not (if (and (memq this '(ddd MM DD hh HH mm)) |
| 997 | (memq next '(YY YYYY MM DD ddd | 1021 | (memq next '(YY YYYY MM DD ddd |
| 998 | hh HH mm ss SS))) | 1022 | hh HH mm ss SS))) |
| 999 | (if (eq this 'ddd) | 1023 | (if (eq this 'ddd) |
| 1000 | (string-match "\\` *[0-9][0-9][0-9]" str) | 1024 | (string-match "\\` *[0-9][0-9][0-9]" math-pd-str) |
| 1001 | (string-match "\\` *[0-9][0-9]" str)) | 1025 | (string-match "\\` *[0-9][0-9]" math-pd-str)) |
| 1002 | (string-match "\\` *[0-9]+" str))) | 1026 | (string-match "\\` *[0-9]+" math-pd-str))) |
| 1003 | (and (setq num (string-to-int | 1027 | (and (setq num (string-to-int |
| 1004 | (math-match-substring str 0)) | 1028 | (math-match-substring math-pd-str 0)) |
| 1005 | str (substring str (match-end 0))) | 1029 | math-pd-str (substring math-pd-str (match-end 0))) |
| 1006 | nil)) | 1030 | nil)) |
| 1007 | nil) | 1031 | nil) |
| 1008 | ((eq this 'W) | 1032 | ((eq this 'W) |
| @@ -1022,7 +1046,7 @@ | |||
| 1022 | (if (and month day) | 1046 | (if (and month day) |
| 1023 | (setq yearday nil) | 1047 | (setq yearday nil) |
| 1024 | (setq month 1 day 1))) | 1048 | (setq month 1 day 1))) |
| 1025 | (if (and okay (equal str "")) | 1049 | (if (and okay (equal math-pd-str "")) |
| 1026 | (and month day (or (not (or hour minute second)) | 1050 | (and month day (or (not (or hour minute second)) |
| 1027 | (and hour minute)) | 1051 | (and hour minute)) |
| 1028 | (progn | 1052 | (progn |
| @@ -1148,6 +1172,30 @@ | |||
| 1148 | (calcFunc-tzone zone date)) | 1172 | (calcFunc-tzone zone date)) |
| 1149 | (math-reject-arg date 'datep)))) | 1173 | (math-reject-arg date 'datep)))) |
| 1150 | 1174 | ||
| 1175 | |||
| 1176 | ;;; Note: Longer names must appear before shorter names which are | ||
| 1177 | ;;; substrings of them. | ||
| 1178 | (defvar math-tzone-names | ||
| 1179 | '(( "UTC" 0 0) | ||
| 1180 | ( "MEGT" -1 "MET" "METDST" ) ; Middle Europe | ||
| 1181 | ( "METDST" -1 -1 ) ( "MET" -1 0 ) | ||
| 1182 | ( "MEGZ" -1 "MEZ" "MESZ" ) ( "MEZ" -1 0 ) ( "MESZ" -1 -1 ) | ||
| 1183 | ( "WEGT" 0 "WET" "WETDST" ) ; Western Europe | ||
| 1184 | ( "WETDST" 0 -1 ) ( "WET" 0 0 ) | ||
| 1185 | ( "BGT" 0 "GMT" "BST" ) ( "GMT" 0 0 ) ( "BST" 0 -1 ) ; Britain | ||
| 1186 | ( "NGT" (float 35 -1) "NST" "NDT" ) ; Newfoundland | ||
| 1187 | ( "NST" (float 35 -1) 0 ) ( "NDT" (float 35 -1) -1 ) | ||
| 1188 | ( "AGT" 4 "AST" "ADT" ) ( "AST" 4 0 ) ( "ADT" 4 -1 ) ; Atlantic | ||
| 1189 | ( "EGT" 5 "EST" "EDT" ) ( "EST" 5 0 ) ( "EDT" 5 -1 ) ; Eastern | ||
| 1190 | ( "CGT" 6 "CST" "CDT" ) ( "CST" 6 0 ) ( "CDT" 6 -1 ) ; Central | ||
| 1191 | ( "MGT" 7 "MST" "MDT" ) ( "MST" 7 0 ) ( "MDT" 7 -1 ) ; Mountain | ||
| 1192 | ( "PGT" 8 "PST" "PDT" ) ( "PST" 8 0 ) ( "PDT" 8 -1 ) ; Pacific | ||
| 1193 | ( "YGT" 9 "YST" "YDT" ) ( "YST" 9 0 ) ( "YDT" 9 -1 ) ; Yukon | ||
| 1194 | ) | ||
| 1195 | "No doc yet. See calc manual for now. ") | ||
| 1196 | |||
| 1197 | (defvar var-TimeZone) | ||
| 1198 | |||
| 1151 | (defun calcFunc-tzone (&optional zone date) | 1199 | (defun calcFunc-tzone (&optional zone date) |
| 1152 | (if zone | 1200 | (if zone |
| 1153 | (cond ((math-realp zone) | 1201 | (cond ((math-realp zone) |
| @@ -1226,27 +1274,7 @@ | |||
| 1226 | (calc-refresh-evaltos 'var-TimeZone) | 1274 | (calc-refresh-evaltos 'var-TimeZone) |
| 1227 | (calcFunc-tzone tz date))))) | 1275 | (calcFunc-tzone tz date))))) |
| 1228 | 1276 | ||
| 1229 | ;;; Note: Longer names must appear before shorter names which are | 1277 | (defvar math-daylight-savings-hook 'math-std-daylight-savings) |
| 1230 | ;;; substrings of them. | ||
| 1231 | (defvar math-tzone-names | ||
| 1232 | '(( "UTC" 0 0) | ||
| 1233 | ( "MEGT" -1 "MET" "METDST" ) ; Middle Europe | ||
| 1234 | ( "METDST" -1 -1 ) ( "MET" -1 0 ) | ||
| 1235 | ( "MEGZ" -1 "MEZ" "MESZ" ) ( "MEZ" -1 0 ) ( "MESZ" -1 -1 ) | ||
| 1236 | ( "WEGT" 0 "WET" "WETDST" ) ; Western Europe | ||
| 1237 | ( "WETDST" 0 -1 ) ( "WET" 0 0 ) | ||
| 1238 | ( "BGT" 0 "GMT" "BST" ) ( "GMT" 0 0 ) ( "BST" 0 -1 ) ; Britain | ||
| 1239 | ( "NGT" (float 35 -1) "NST" "NDT" ) ; Newfoundland | ||
| 1240 | ( "NST" (float 35 -1) 0 ) ( "NDT" (float 35 -1) -1 ) | ||
| 1241 | ( "AGT" 4 "AST" "ADT" ) ( "AST" 4 0 ) ( "ADT" 4 -1 ) ; Atlantic | ||
| 1242 | ( "EGT" 5 "EST" "EDT" ) ( "EST" 5 0 ) ( "EDT" 5 -1 ) ; Eastern | ||
| 1243 | ( "CGT" 6 "CST" "CDT" ) ( "CST" 6 0 ) ( "CDT" 6 -1 ) ; Central | ||
| 1244 | ( "MGT" 7 "MST" "MDT" ) ( "MST" 7 0 ) ( "MDT" 7 -1 ) ; Mountain | ||
| 1245 | ( "PGT" 8 "PST" "PDT" ) ( "PST" 8 0 ) ( "PDT" 8 -1 ) ; Pacific | ||
| 1246 | ( "YGT" 9 "YST" "YDT" ) ( "YST" 9 0 ) ( "YDT" 9 -1 ) ; Yukon | ||
| 1247 | ) | ||
| 1248 | "No doc yet. See calc manual for now. ") | ||
| 1249 | |||
| 1250 | 1278 | ||
| 1251 | (defun math-daylight-savings-adjust (date zone &optional dt) | 1279 | (defun math-daylight-savings-adjust (date zone &optional dt) |
| 1252 | (or date (setq date (nth 1 (calcFunc-now)))) | 1280 | (or date (setq date (nth 1 (calcFunc-now)))) |
| @@ -1286,8 +1314,6 @@ | |||
| 1286 | (nth 1 (calcFunc-tzconv (list 'date date) z1 z2)) | 1314 | (nth 1 (calcFunc-tzconv (list 'date date) z1 z2)) |
| 1287 | (calcFunc-unixtime (calcFunc-unixtime date z1) z2))) | 1315 | (calcFunc-unixtime (calcFunc-unixtime date z1) z2))) |
| 1288 | 1316 | ||
| 1289 | (defvar math-daylight-savings-hook 'math-std-daylight-savings) | ||
| 1290 | |||
| 1291 | (defun math-std-daylight-savings (date dt zone bump) | 1317 | (defun math-std-daylight-savings (date dt zone bump) |
| 1292 | "Standard North American daylight savings algorithm. | 1318 | "Standard North American daylight savings algorithm. |
| 1293 | This implements the rules for the U.S. and Canada as of 1987. | 1319 | This implements the rules for the U.S. and Canada as of 1987. |
| @@ -1507,6 +1533,10 @@ and ends on the last Sunday of October at 2 a.m." | |||
| 1507 | (and (not (math-setup-holidays day)) | 1533 | (and (not (math-setup-holidays day)) |
| 1508 | (list 'date (math-add day time)))))) | 1534 | (list 'date (math-add day time)))))) |
| 1509 | 1535 | ||
| 1536 | ;; The variable math-sh-year is local to math-setup-holidays | ||
| 1537 | ;; and math-setup-year-holiday, but is used by math-setup-add-holidays, | ||
| 1538 | ;; which is called by math-setup-holidays and math-setup-year-holiday. | ||
| 1539 | (defvar math-sh-year) | ||
| 1510 | 1540 | ||
| 1511 | (defun math-setup-holidays (&optional date) | 1541 | (defun math-setup-holidays (&optional date) |
| 1512 | (or (eq (calc-var-value 'var-Holidays) math-holidays-cache-tag) | 1542 | (or (eq (calc-var-value 'var-Holidays) math-holidays-cache-tag) |
| @@ -1581,7 +1611,7 @@ and ends on the last Sunday of October at 2 a.m." | |||
| 1581 | (unwind-protect | 1611 | (unwind-protect |
| 1582 | (let ((days (nth 6 math-holidays-cache))) | 1612 | (let ((days (nth 6 math-holidays-cache))) |
| 1583 | (if days | 1613 | (if days |
| 1584 | (let ((year nil)) ; see below | 1614 | (let ((math-sh-year nil)) ; see below |
| 1585 | (setcar (nthcdr 6 math-holidays-cache) nil) | 1615 | (setcar (nthcdr 6 math-holidays-cache) nil) |
| 1586 | (math-setup-add-holidays (cons 'vec (cdr days))) | 1616 | (math-setup-add-holidays (cons 'vec (cdr days))) |
| 1587 | (setcar (nthcdr 2 math-holidays-cache) (car days)))) | 1617 | (setcar (nthcdr 2 math-holidays-cache) (car days)))) |
| @@ -1613,10 +1643,10 @@ and ends on the last Sunday of October at 2 a.m." | |||
| 1613 | nil))) | 1643 | nil))) |
| 1614 | (or done (setq math-holidays-cache-tag t)))))) | 1644 | (or done (setq math-holidays-cache-tag t)))))) |
| 1615 | 1645 | ||
| 1616 | (defun math-setup-year-holidays (year) | 1646 | (defun math-setup-year-holidays (math-sh-year) |
| 1617 | (let ((exprs (nth 2 math-holidays-cache))) | 1647 | (let ((exprs (nth 2 math-holidays-cache))) |
| 1618 | (while exprs | 1648 | (while exprs |
| 1619 | (let* ((var-y year) | 1649 | (let* ((var-y math-sh-year) |
| 1620 | (var-m nil) | 1650 | (var-m nil) |
| 1621 | (expr (math-evaluate-expr (car exprs)))) | 1651 | (expr (math-evaluate-expr (car exprs)))) |
| 1622 | (if (math-expr-contains expr '(var m var-m)) | 1652 | (if (math-expr-contains expr '(var m var-m)) |
| @@ -1626,7 +1656,7 @@ and ends on the last Sunday of October at 2 a.m." | |||
| 1626 | (math-setup-add-holidays expr))) | 1656 | (math-setup-add-holidays expr))) |
| 1627 | (setq exprs (cdr exprs))))) | 1657 | (setq exprs (cdr exprs))))) |
| 1628 | 1658 | ||
| 1629 | (defun math-setup-add-holidays (days) ; uses "year" | 1659 | (defun math-setup-add-holidays (days) ; uses "math-sh-year" |
| 1630 | (cond ((eq (car-safe days) 'vec) | 1660 | (cond ((eq (car-safe days) 'vec) |
| 1631 | (while (setq days (cdr days)) | 1661 | (while (setq days (cdr days)) |
| 1632 | (math-setup-add-holidays (car days)))) | 1662 | (math-setup-add-holidays (car days)))) |
| @@ -1641,7 +1671,7 @@ and ends on the last Sunday of October at 2 a.m." | |||
| 1641 | (math-setup-add-holidays (nth 1 days))) | 1671 | (math-setup-add-holidays (nth 1 days))) |
| 1642 | ((eq days 0)) | 1672 | ((eq days 0)) |
| 1643 | ((integerp days) | 1673 | ((integerp days) |
| 1644 | (let ((b (math-to-business-day days year))) | 1674 | (let ((b (math-to-business-day days math-sh-year))) |
| 1645 | (or (cdr b) ; don't register holidays twice! | 1675 | (or (cdr b) ; don't register holidays twice! |
| 1646 | (let ((prev (car math-holidays-cache)) | 1676 | (let ((prev (car math-holidays-cache)) |
| 1647 | (iprev (nth 1 math-holidays-cache))) | 1677 | (iprev (nth 1 math-holidays-cache))) |
| @@ -1789,6 +1819,12 @@ and ends on the last Sunday of October at 2 a.m." | |||
| 1789 | (t | 1819 | (t |
| 1790 | (math-make-intv 2 0 b))))) | 1820 | (math-make-intv 2 0 b))))) |
| 1791 | 1821 | ||
| 1822 | ;; The variables math-exp-str and math-exp-pos are local to | ||
| 1823 | ;; math-read-exprs in math-aent.el, but are used by | ||
| 1824 | ;; math-read-angle-brackets, which is called (indirectly) by | ||
| 1825 | ;; math-read-exprs. | ||
| 1826 | (defvar math-exp-str) | ||
| 1827 | (defvar math-exp-pos) | ||
| 1792 | 1828 | ||
| 1793 | (defun math-read-angle-brackets () | 1829 | (defun math-read-angle-brackets () |
| 1794 | (let* ((last (or (math-check-for-commas t) (length math-exp-str))) | 1830 | (let* ((last (or (math-check-for-commas t) (length math-exp-str))) |