annotate lisp/calc/calc-forms.el @ 106677:f147ed43b1d5

Make vc-dir work on subdirectories of the bzr root. * vc-bzr.el (vc-bzr-after-dir-status): Add new argument. Return file names relative to it. (vc-bzr-dir-status, vc-bzr-dir-status-files): Pass the bzr root relative directory to vc-bzr-after-dir-status.
author Dan Nicolaescu <dann@ics.uci.edu>
date Mon, 28 Dec 2009 22:46:08 -0800
parents dbd3331d305f
children 1d1d5d9bd884
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
1 ;;; calc-forms.el --- data format conversion functions for Calc
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
2
64325
1db49616ce05 Update copyright information.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 62442
diff changeset
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
100908
a9dc0e7c3f2b Add 2009 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 94654
diff changeset
4 ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
5
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
6 ;; Author: David Gillespie <daveg@synaptics.com>
77465
1154f082efd9 Update maintainer's address.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76595
diff changeset
7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
8
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
10
94654
6c9af2bfcfee Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
76595
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 76569
diff changeset
12 ;; it under the terms of the GNU General Public License as published by
94654
6c9af2bfcfee Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
13 ;; the Free Software Foundation, either version 3 of the License, or
6c9af2bfcfee Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
14 ;; (at your option) any later version.
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
15
76595
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 76569
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 76569
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 76569
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 76569
diff changeset
19 ;; GNU General Public License for more details.
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 76569
diff changeset
20
497d17a80bb8 Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents: 76569
diff changeset
21 ;; You should have received a copy of the GNU General Public License
94654
6c9af2bfcfee Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 93975
diff changeset
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
23
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
24 ;;; Commentary:
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
25
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
26 ;;; Code:
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
27
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
28 ;; This file is autoloaded from calc-ext.el.
58654
bd70627265a0 Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58474
diff changeset
29
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
30 (require 'calc-ext)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
31 (require 'calc-macs)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
32
86472
a74cf765a500 (calendar-current-time-zone)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82829
diff changeset
33 ;; Declare functions which are defined elsewhere.
a74cf765a500 (calendar-current-time-zone)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82829
diff changeset
34 (declare-function calendar-current-time-zone "cal-dst" ())
a74cf765a500 (calendar-current-time-zone)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82829
diff changeset
35 (declare-function calendar-absolute-from-gregorian "calendar" (date))
a74cf765a500 (calendar-current-time-zone)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82829
diff changeset
36 (declare-function dst-in-effect "cal-dst" (date))
a74cf765a500 (calendar-current-time-zone)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82829
diff changeset
37
a74cf765a500 (calendar-current-time-zone)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82829
diff changeset
38
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
39 (defun calc-time ()
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
40 (interactive)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
41 (calc-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
42 (let ((time (current-time-string)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
43 (calc-enter-result 0 "time"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
44 (list 'mod
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
45 (list 'hms
62035
0e0c15279b4e (calc-time, calc-date-notation, math-this-year, math-parse-date)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 60908
diff changeset
46 (string-to-number (substring time 11 13))
0e0c15279b4e (calc-time, calc-date-notation, math-this-year, math-parse-date)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 60908
diff changeset
47 (string-to-number (substring time 14 16))
0e0c15279b4e (calc-time, calc-date-notation, math-this-year, math-parse-date)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 60908
diff changeset
48 (string-to-number (substring time 17 19)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
49 (list 'hms 24 0 0))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
50
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
51 (defun calc-to-hms (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
52 (interactive "P")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
53 (calc-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
54 (if (calc-is-inverse)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
55 (if (eq calc-angle-mode 'rad)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
56 (calc-unary-op ">rad" 'calcFunc-rad arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
57 (calc-unary-op ">deg" 'calcFunc-deg arg))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
58 (calc-unary-op ">hms" 'calcFunc-hms arg))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
59
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
60 (defun calc-from-hms (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
61 (interactive "P")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
62 (calc-invert-func)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
63 (calc-to-hms arg))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
64
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
65
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
66 (defun calc-hms-notation (fmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
67 (interactive "sHours-minutes-seconds format (hms, @ ' \", etc.): ")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
68 (calc-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
69 (if (string-match "\\`\\([^,; ]+\\)\\([,; ]*\\)\\([^,; ]\\)\\([,; ]*\\)\\([^,; ]\\)\\'" fmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
70 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
71 (calc-change-mode 'calc-hms-format
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
72 (concat "%s" (math-match-substring fmt 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
73 (math-match-substring fmt 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
74 "%s" (math-match-substring fmt 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
75 (math-match-substring fmt 4)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
76 "%s" (math-match-substring fmt 5))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
77 t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
78 (setq-default calc-hms-format calc-hms-format)) ; for minibuffer
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
79 (error "Bad hours-minutes-seconds format"))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
80
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
81 (defun calc-date-notation (fmt arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
82 (interactive "sDate format (e.g., M/D/YY h:mm:ss): \nP")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
83 (calc-wrapper
105826
0842ff8d686f (calc-date-notation): Check to see if the format is whitespace
Jay Belanger <jay.p.belanger@gmail.com>
parents: 100908
diff changeset
84 (if (string-match-p "\\`\\s-*\\'" fmt)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
85 (setq fmt "1"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
86 (if (string-match "\\` *[0-9] *\\'" fmt)
62035
0e0c15279b4e (calc-time, calc-date-notation, math-this-year, math-parse-date)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 60908
diff changeset
87 (setq fmt (nth (string-to-number fmt) calc-standard-date-formats)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
88 (or (string-match "[a-zA-Z]" fmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
89 (error "Bad date format specifier"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
90 (and arg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
91 (>= (setq arg (prefix-numeric-value arg)) 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
92 (<= arg 9)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
93 (setq calc-standard-date-formats
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
94 (copy-sequence calc-standard-date-formats))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
95 (setcar (nthcdr arg calc-standard-date-formats) fmt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
96 (let ((case-fold-search nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
97 (and (not (string-match "<.*>" fmt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
98 (string-match "\\`[^hHspP]*\\([^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*[bBhHmpPsS]+[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*\\)[^hHspP]*\\'" fmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
99 (string-match (concat "[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
100 (regexp-quote (math-match-substring fmt 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
101 "[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*") fmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
102 (setq fmt (concat (substring fmt 0 (match-beginning 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
103 "<"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
104 (substring fmt (match-beginning 0) (match-end 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
105 ">"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
106 (substring fmt (match-end 0))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
107 (let ((lfmt nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
108 (fullfmt nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
109 (time nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
110 pos pos2 sym temp)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
111 (let ((case-fold-search nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
112 (and (setq temp (string-match ":[BS]S" fmt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
113 (aset fmt temp ?C)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
114 (while (setq pos (string-match "[<>a-zA-Z]" fmt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
115 (if (> pos 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
116 (setq lfmt (cons (substring fmt 0 pos) lfmt)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
117 (setq pos2 (1+ pos))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
118 (cond ((= (aref fmt pos) ?\<)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
119 (and time (error "Nested <'s not allowed"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
120 (and lfmt (setq fullfmt (nconc lfmt fullfmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
121 lfmt nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
122 (setq time t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
123 ((= (aref fmt pos) ?\>)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
124 (or time (error "Misplaced > in format"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
125 (and lfmt (setq fullfmt (cons (nreverse lfmt) fullfmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
126 lfmt nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
127 (setq time nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
128 (t
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
129 (if (string-match "\\`[^a-zA-Z]*[bB][a-zA-Z]" fmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
130 (setq pos2 (1+ pos2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
131 (while (and (< pos2 (length fmt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
132 (= (upcase (aref fmt pos2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
133 (upcase (aref fmt (1- pos2)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
134 (setq pos2 (1+ pos2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
135 (setq sym (intern (substring fmt pos pos2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
136 (or (memq sym '(Y YY BY YYY YYYY
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
137 aa AA aaa AAA aaaa AAAA
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
138 bb BB bbb BBB bbbb BBBB
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
139 M MM BM mmm Mmm Mmmm MMM MMMM
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
140 D DD BD d ddd bdd
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
141 W www Www Wwww WWW WWWW
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
142 h hh bh H HH BH
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
143 p P pp PP pppp PPPP
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
144 m mm bm s ss bss SS BS C
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
145 N n J j U b))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
146 (and (eq sym 'X) (not lfmt) (not fullfmt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
147 (error "Bad format code: %s" sym))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
148 (and (memq sym '(bb BB bbb BBB bbbb BBBB))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
149 (setq lfmt (cons 'b lfmt)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
150 (setq lfmt (cons sym lfmt))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
151 (setq fmt (substring fmt pos2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
152 (or (equal fmt "")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
153 (setq lfmt (cons fmt lfmt)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
154 (and lfmt (if time
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
155 (setq fullfmt (cons (nreverse lfmt) fullfmt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
156 (setq fullfmt (nconc lfmt fullfmt))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
157 (calc-change-mode 'calc-date-format (nreverse fullfmt) t))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
158
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
159
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
160 (defun calc-hms-mode ()
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
161 (interactive)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
162 (calc-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
163 (calc-change-mode 'calc-angle-mode 'hms)
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
164 (message "Angles measured in degrees-minutes-seconds")))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
165
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
166
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
167 (defun calc-now (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
168 (interactive "P")
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
169 (calc-date-zero-args "now" 'calcFunc-now arg))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
170
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
171 (defun calc-date-part (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
172 (interactive "NPart code (1-9 = Y,M,D,H,M,S,Wd,Yd,Hms): ")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
173 (if (or (< arg 1) (> arg 9))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
174 (error "Part code out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
175 (calc-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
176 (calc-enter-result 1
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
177 (nth arg '(nil "year" "mnth" "day" "hour" "minu"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
178 "sec" "wday" "yday" "hmst"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
179 (list (nth arg '(nil calcFunc-year calcFunc-month
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
180 calcFunc-day calcFunc-hour
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
181 calcFunc-minute calcFunc-second
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
182 calcFunc-weekday calcFunc-yearday
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
183 calcFunc-time))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
184 (calc-top-n 1)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
185
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
186 (defun calc-date (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
187 (interactive "p")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
188 (if (or (< arg 1) (> arg 6))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
189 (error "Between one and six arguments are allowed"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
190 (calc-wrapper
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
191 (calc-enter-result arg "date" (cons 'calcFunc-date (calc-top-list-n arg)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
192
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
193 (defun calc-julian (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
194 (interactive "P")
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
195 (calc-date-one-arg "juln" 'calcFunc-julian arg))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
196
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
197 (defun calc-unix-time (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
198 (interactive "P")
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
199 (calc-date-one-arg "unix" 'calcFunc-unixtime arg))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
200
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
201 (defun calc-time-zone (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
202 (interactive "P")
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
203 (calc-date-zero-args "zone" 'calcFunc-tzone arg))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
204
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
205 (defun calc-convert-time-zones (old &optional new)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
206 (interactive "sFrom time zone: ")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
207 (calc-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
208 (if (equal old "$")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
209 (calc-enter-result 3 "tzcv" (cons 'calcFunc-tzconv (calc-top-list-n 3)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
210 (if (equal old "") (setq old "local"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
211 (or new
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
212 (setq new (read-string (concat "From time zone: " old
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
213 ", to zone: "))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
214 (if (stringp old) (setq old (math-read-expr old)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
215 (if (eq (car-safe old) 'error)
53868
58be271f8d96 (calc-convert-time-zones): Fix format string.
Andreas Schwab <schwab@suse.de>
parents: 52401
diff changeset
216 (error "Error in expression: %S" (nth 1 old)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
217 (if (equal new "") (setq new "local"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
218 (if (stringp new) (setq new (math-read-expr new)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
219 (if (eq (car-safe new) 'error)
53868
58be271f8d96 (calc-convert-time-zones): Fix format string.
Andreas Schwab <schwab@suse.de>
parents: 52401
diff changeset
220 (error "Error in expression: %S" (nth 1 new)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
221 (calc-enter-result 1 "tzcv" (list 'calcFunc-tzconv
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
222 (calc-top-n 1) old new)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
223
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
224 (defun calc-new-week (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
225 (interactive "P")
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
226 (calc-date-one-arg "nwwk" 'calcFunc-newweek arg))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
227
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
228 (defun calc-new-month (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
229 (interactive "P")
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
230 (calc-date-one-arg "nwmn" 'calcFunc-newmonth arg))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
231
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
232 (defun calc-new-year (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
233 (interactive "P")
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
234 (calc-date-one-arg "nwyr" 'calcFunc-newyear arg))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
235
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
236 (defun calc-inc-month (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
237 (interactive "p")
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
238 (calc-date-one-arg "incm" 'calcFunc-incmonth arg))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
239
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
240 (defun calc-business-days-plus (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
241 (interactive "P")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
242 (calc-wrapper
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
243 (calc-binary-op "bus+" 'calcFunc-badd arg)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
244
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
245 (defun calc-business-days-minus (arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
246 (interactive "P")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
247 (calc-wrapper
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
248 (calc-binary-op "bus-" 'calcFunc-bsub arg)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
249
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
250 (defun calc-date-zero-args (prefix func arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
251 (calc-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
252 (if (consp arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
253 (calc-enter-result 1 prefix (list func (calc-top-n 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
254 (calc-enter-result 0 prefix (if arg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
255 (list func (prefix-numeric-value arg))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
256 (list func))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
257
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
258 (defun calc-date-one-arg (prefix func arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
259 (calc-wrapper
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
260 (if (consp arg)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
261 (calc-enter-result 2 prefix (cons func (calc-top-list-n 2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
262 (calc-enter-result 1 prefix (if arg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
263 (list func (calc-top-n 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
264 (prefix-numeric-value arg))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
265 (list func (calc-top-n 1)))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
266
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
267
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
268 ;;;; Hours-minutes-seconds forms.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
269
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
270 (defun math-normalize-hms (a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
271 (let ((h (math-normalize (nth 1 a)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
272 (m (math-normalize (nth 2 a)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
273 (s (let ((calc-internal-prec (max (- calc-internal-prec 4) 3)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
274 (math-normalize (nth 3 a)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
275 (if (math-negp h)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
276 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
277 (if (math-posp s)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
278 (setq s (math-add s -60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
279 m (math-add m 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
280 (if (math-posp m)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
281 (setq m (math-add m -60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
282 h (math-add h 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
283 (if (not (Math-lessp -60 s))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
284 (setq s (math-add s 60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
285 m (math-add m -1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
286 (if (not (Math-lessp -60 m))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
287 (setq m (math-add m 60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
288 h (math-add h -1))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
289 (if (math-negp s)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
290 (setq s (math-add s 60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
291 m (math-add m -1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
292 (if (math-negp m)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
293 (setq m (math-add m 60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
294 h (math-add h -1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
295 (if (not (Math-lessp s 60))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
296 (setq s (math-add s -60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
297 m (math-add m 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
298 (if (not (Math-lessp m 60))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
299 (setq m (math-add m -60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
300 h (math-add h 1))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
301 (if (and (eq (car-safe s) 'float)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
302 (<= (+ (math-numdigs (nth 1 s)) (nth 2 s))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
303 (- 2 calc-internal-prec)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
304 (setq s 0))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
305 (list 'hms h m s)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
306
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
307 ;;; Convert A from ANG or current angular mode to HMS format.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
308 (defun math-to-hms (a &optional ang) ; [X R] [Public]
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
309 (cond ((eq (car-safe a) 'hms) a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
310 ((eq (car-safe a) 'sdev)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
311 (math-make-sdev (math-to-hms (nth 1 a))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
312 (math-to-hms (nth 2 a))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
313 ((not (Math-numberp a))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
314 (list 'calcFunc-hms a))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
315 ((math-negp a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
316 (math-neg (math-to-hms (math-neg a) ang)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
317 ((eq (or ang calc-angle-mode) 'rad)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
318 (math-to-hms (math-div a (math-pi-over-180)) 'deg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
319 ((memq (car-safe a) '(cplx polar)) a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
320 (t
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
321 ;(setq a (let ((calc-internal-prec (max (1- calc-internal-prec) 3)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
322 ; (math-normalize a)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
323 (math-normalize
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
324 (let* ((b (math-mul a 3600))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
325 (hm (math-trunc (math-div b 60)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
326 (hmd (math-idivmod hm 60)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
327 (list 'hms
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
328 (car hmd)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
329 (cdr hmd)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
330 (math-sub b (math-mul hm 60))))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
331 (defun calcFunc-hms (h &optional m s)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
332 (or (Math-realp h) (math-reject-arg h 'realp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
333 (or m (setq m 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
334 (or (Math-realp m) (math-reject-arg m 'realp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
335 (or s (setq s 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
336 (or (Math-realp s) (math-reject-arg s 'realp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
337 (if (and (not (Math-lessp m 0)) (Math-lessp m 60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
338 (not (Math-lessp s 0)) (Math-lessp s 60))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
339 (math-add (math-to-hms h)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
340 (list 'hms 0 m s))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
341 (math-to-hms (math-add h
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
342 (math-add (math-div (or m 0) 60)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
343 (math-div (or s 0) 3600)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
344 'deg)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
345
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
346 ;;; Convert A from HMS format to ANG or current angular mode.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
347 (defun math-from-hms (a &optional ang) ; [R X] [Public]
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
348 (cond ((not (eq (car-safe a) 'hms))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
349 (if (Math-numberp a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
350 a
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
351 (if (eq (car-safe a) 'sdev)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
352 (math-make-sdev (math-from-hms (nth 1 a) ang)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
353 (math-from-hms (nth 2 a) ang))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
354 (if (eq (or ang calc-angle-mode) 'rad)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
355 (list 'calcFunc-rad a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
356 (list 'calcFunc-deg a)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
357 ((math-negp a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
358 (math-neg (math-from-hms (math-neg a) ang)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
359 ((eq (or ang calc-angle-mode) 'rad)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
360 (math-mul (math-from-hms a 'deg) (math-pi-over-180)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
361 (t
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
362 (math-add (math-div (math-add (math-div (nth 3 a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
363 '(float 6 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
364 (nth 2 a))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
365 60)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
366 (nth 1 a)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
367
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
368 ;;;; Date forms.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
369
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
370
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
371 ;;; Some of these functions are adapted from Edward Reingold's "calendar.el".
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
372 ;;; These versions are rewritten to use arbitrary-size integers.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
373 ;;; The Julian calendar is used up to 9/2/1752, after which the Gregorian
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
374 ;;; calendar is used; the first day after 9/2/1752 is 9/14/1752.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
375
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
376 ;;; A numerical date is the number of days since midnight on
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
377 ;;; the morning of January 1, 1 A.D. If the date is a non-integer,
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
378 ;;; it represents a specific date and time.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
379 ;;; A "dt" is a list of the form, (year month day), corresponding to
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
380 ;;; an integer code, or (year month day hour minute second), corresponding
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
381 ;;; to a non-integer code.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
382
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
383 (defun math-date-to-dt (value)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
384 (if (eq (car-safe value) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
385 (setq value (nth 1 value)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
386 (or (math-realp value)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
387 (math-reject-arg value 'datep))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
388 (let* ((parts (math-date-parts value))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
389 (date (car parts))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
390 (time (nth 1 parts))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
391 (month 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
392 day
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
393 (year (math-quotient (math-add date (if (Math-lessp date 711859)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
394 365 ; for speed, we take
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
395 -108)) ; >1950 as a special case
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
396 (if (math-negp value) 366 365)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
397 ; this result may be an overestimate
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
398 temp)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
399 (while (Math-lessp date (setq temp (math-absolute-from-date year 1 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
400 (setq year (math-add year -1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
401 (if (eq year 0) (setq year -1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
402 (setq date (1+ (math-sub date temp)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
403 (and (eq year 1752) (>= date 247)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
404 (setq date (+ date 11)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
405 (setq temp (if (math-leap-year-p year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
406 [1 32 61 92 122 153 183 214 245 275 306 336 999]
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
407 [1 32 60 91 121 152 182 213 244 274 305 335 999]))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
408 (while (>= date (aref temp month))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
409 (setq month (1+ month)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
410 (setq day (1+ (- date (aref temp (1- month)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
411 (if (math-integerp value)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
412 (list year month day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
413 (list year month day
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
414 (/ time 3600)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
415 (% (/ time 60) 60)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
416 (math-add (% time 60) (nth 2 parts))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
417
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
418 (defun math-dt-to-date (dt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
419 (or (integerp (nth 1 dt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
420 (math-reject-arg (nth 1 dt) 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
421 (if (or (< (nth 1 dt) 1) (> (nth 1 dt) 12))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
422 (math-reject-arg (nth 1 dt) "Month value is out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
423 (or (integerp (nth 2 dt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
424 (math-reject-arg (nth 2 dt) 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
425 (if (or (< (nth 2 dt) 1) (> (nth 2 dt) 31))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
426 (math-reject-arg (nth 2 dt) "Day value is out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
427 (let ((date (math-absolute-from-date (car dt) (nth 1 dt) (nth 2 dt))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
428 (if (nth 3 dt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
429 (math-add (math-float date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
430 (math-div (math-add (+ (* (nth 3 dt) 3600)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
431 (* (nth 4 dt) 60))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
432 (nth 5 dt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
433 '(float 864 2)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
434 date)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
435
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
436 (defun math-date-parts (value &optional offset)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
437 (let* ((date (math-floor value))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
438 (time (math-round (math-mul (math-sub value (or offset date)) 86400)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
439 (and (> calc-internal-prec 12)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
440 (- calc-internal-prec 12))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
441 (ftime (math-floor time)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
442 (list date
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
443 ftime
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
444 (math-sub time ftime))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
445
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
446
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
447 (defun math-this-year ()
62035
0e0c15279b4e (calc-time, calc-date-notation, math-this-year, math-parse-date)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 60908
diff changeset
448 (string-to-number (substring (current-time-string) -4)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
449
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
450 (defun math-leap-year-p (year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
451 (if (Math-lessp year 1752)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
452 (if (math-negp year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
453 (= (math-imod (math-neg year) 4) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
454 (= (math-imod year 4) 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
455 (setq year (math-imod year 400))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
456 (or (and (= (% year 4) 0) (/= (% year 100) 0))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
457 (= year 0))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
458
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
459 (defun math-days-in-month (year month)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
460 (if (and (= month 2) (math-leap-year-p year))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
461 29
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
462 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
463
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
464 (defun math-day-number (year month day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
465 (let ((day-of-year (+ day (* 31 (1- month)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
466 (if (> month 2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
467 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
468 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
469 (if (math-leap-year-p year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
470 (setq day-of-year (1+ day-of-year)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
471 (and (eq year 1752)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
472 (or (> month 9)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
473 (and (= month 9) (>= day 14)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
474 (setq day-of-year (- day-of-year 11)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
475 day-of-year))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
476
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
477 (defun math-absolute-from-date (year month day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
478 (if (eq year 0) (setq year -1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
479 (let ((yearm1 (math-sub year 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
480 (math-sub (math-add (math-day-number year month day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
481 (math-add (math-mul 365 yearm1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
482 (if (math-posp year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
483 (math-quotient yearm1 4)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
484 (math-sub 365
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
485 (math-quotient (math-sub 3 year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
486 4)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
487 (if (or (Math-lessp year 1753)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
488 (and (eq year 1752) (<= month 9)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
489 1
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
490 (let ((correction (math-mul (math-quotient yearm1 100) 3)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
491 (let ((res (math-idivmod correction 4)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
492 (math-add (if (= (cdr res) 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
493 -1
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
494 0)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
495 (car res))))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
496
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
497
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
498 ;;; It is safe to redefine these in your .emacs file to use a different
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
499 ;;; language.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
500
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
501 (defvar math-long-weekday-names '( "Sunday" "Monday" "Tuesday" "Wednesday"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
502 "Thursday" "Friday" "Saturday" ))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
503 (defvar math-short-weekday-names '( "Sun" "Mon" "Tue" "Wed"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
504 "Thu" "Fri" "Sat" ))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
505
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
506 (defvar math-long-month-names '( "January" "February" "March" "April"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
507 "May" "June" "July" "August"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
508 "September" "October" "November" "December" ))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
509 (defvar math-short-month-names '( "Jan" "Feb" "Mar" "Apr" "May" "Jun"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
510 "Jul" "Aug" "Sep" "Oct" "Nov" "Dec" ))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
511
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
512
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
513 (defvar math-format-date-cache nil)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
514
76569
a5ca6723c3b1 (math-std-daylight-savings)
Kim F. Storm <storm@cua.dk>
parents: 76554
diff changeset
515 ;; The variables math-fd-date, math-fd-dt, math-fd-year,
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
516 ;; math-fd-month, math-fd-day, math-fd-weekday, math-fd-hour,
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
517 ;; math-fd-minute, math-fd-second, math-fd-bc-flag are local
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
518 ;; to math-format-date, but are used by math-format-date-part,
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
519 ;; which is called by math-format-date.
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
520 (defvar math-fd-date)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
521 (defvar math-fd-dt)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
522 (defvar math-fd-year)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
523 (defvar math-fd-month)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
524 (defvar math-fd-day)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
525 (defvar math-fd-weekday)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
526 (defvar math-fd-hour)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
527 (defvar math-fd-minute)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
528 (defvar math-fd-second)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
529 (defvar math-fd-bc-flag)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
530
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
531 (defun math-format-date (math-fd-date)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
532 (if (eq (car-safe math-fd-date) 'date)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
533 (setq math-fd-date (nth 1 math-fd-date)))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
534 (let ((entry (list math-fd-date calc-internal-prec calc-date-format)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
535 (or (cdr (assoc entry math-format-date-cache))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
536 (let* ((math-fd-dt nil)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
537 (calc-group-digits nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
538 (calc-leading-zeros nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
539 (calc-number-radix 10)
106147
dbd3331d305f (math-format-date): Fix typo.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 106141
diff changeset
540 (calc-twos-complement-mode nil)
76569
a5ca6723c3b1 (math-std-daylight-savings)
Kim F. Storm <storm@cua.dk>
parents: 76554
diff changeset
541 math-fd-year math-fd-month math-fd-day math-fd-weekday
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
542 math-fd-hour math-fd-minute math-fd-second
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
543 (math-fd-bc-flag nil)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
544 (fmt (apply 'concat (mapcar 'math-format-date-part
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
545 calc-date-format))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
546 (setq math-format-date-cache (cons (cons entry fmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
547 math-format-date-cache))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
548 (and (setq math-fd-dt (nthcdr 10 math-format-date-cache))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
549 (setcdr math-fd-dt nil))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
550 fmt))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
551
81744
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
552 (defconst math-julian-date-beginning '(float 17214235 -1)
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
553 "The beginning of the Julian calendar,
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
554 as measured in the number of days before January 1 of the year 1AD.")
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
555
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
556 (defconst math-julian-date-beginning-int 1721424
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
557 "The beginning of the Julian calendar,
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
558 as measured in the integer number of days before January 1 of the year 1AD.")
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
559
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
560 (defun math-format-date-part (x)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
561 (cond ((stringp x)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
562 x)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
563 ((listp x)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
564 (if (math-integerp math-fd-date)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
565 ""
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
566 (apply 'concat (mapcar 'math-format-date-part x))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
567 ((eq x 'X)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
568 "")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
569 ((eq x 'N)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
570 (math-format-number math-fd-date))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
571 ((eq x 'n)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
572 (math-format-number (math-floor math-fd-date)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
573 ((eq x 'J)
81541
ddeb68a08730 (math-format-date-part,math-parse-standard-date,calcFunc-julian):
Jay Belanger <jay.p.belanger@gmail.com>
parents: 77465
diff changeset
574 (math-format-number
81744
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
575 (math-add math-fd-date math-julian-date-beginning)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
576 ((eq x 'j)
81541
ddeb68a08730 (math-format-date-part,math-parse-standard-date,calcFunc-julian):
Jay Belanger <jay.p.belanger@gmail.com>
parents: 77465
diff changeset
577 (math-format-number (math-add
ddeb68a08730 (math-format-date-part,math-parse-standard-date,calcFunc-julian):
Jay Belanger <jay.p.belanger@gmail.com>
parents: 77465
diff changeset
578 (math-floor math-fd-date)
81744
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
579 math-julian-date-beginning-int)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
580 ((eq x 'U)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
581 (math-format-number (nth 1 (math-date-parts math-fd-date 719164))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
582 ((progn
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
583 (or math-fd-dt
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
584 (progn
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
585 (setq math-fd-dt (math-date-to-dt math-fd-date)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
586 math-fd-year (car math-fd-dt)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
587 math-fd-month (nth 1 math-fd-dt)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
588 math-fd-day (nth 2 math-fd-dt)
76569
a5ca6723c3b1 (math-std-daylight-savings)
Kim F. Storm <storm@cua.dk>
parents: 76554
diff changeset
589 math-fd-weekday (math-mod
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
590 (math-add (math-floor math-fd-date) 6) 7)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
591 math-fd-hour (nth 3 math-fd-dt)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
592 math-fd-minute (nth 4 math-fd-dt)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
593 math-fd-second (nth 5 math-fd-dt))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
594 (and (memq 'b calc-date-format)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
595 (math-negp math-fd-year)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
596 (setq math-fd-year (math-neg math-fd-year)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
597 math-fd-bc-flag t))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
598 (memq x '(Y YY BY)))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
599 (if (and (integerp math-fd-year) (> math-fd-year 1940) (< math-fd-year 2040))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
600 (format (cond ((eq x 'YY) "%02d")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
601 ((eq x 'BYY) "%2d")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
602 (t "%d"))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
603 (% math-fd-year 100))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
604 (if (and (natnump math-fd-year) (< math-fd-year 100))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
605 (format "+%d" math-fd-year)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
606 (math-format-number math-fd-year))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
607 ((eq x 'YYY)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
608 (math-format-number math-fd-year))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
609 ((eq x 'YYYY)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
610 (if (and (natnump math-fd-year) (< math-fd-year 100))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
611 (format "+%d" math-fd-year)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
612 (math-format-number math-fd-year)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
613 ((eq x 'b) "")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
614 ((eq x 'aa)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
615 (and (not math-fd-bc-flag) "ad"))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
616 ((eq x 'AA)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
617 (and (not math-fd-bc-flag) "AD"))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
618 ((eq x 'aaa)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
619 (and (not math-fd-bc-flag) "ad "))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
620 ((eq x 'AAA)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
621 (and (not math-fd-bc-flag) "AD "))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
622 ((eq x 'aaaa)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
623 (and (not math-fd-bc-flag) "a.d."))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
624 ((eq x 'AAAA)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
625 (and (not math-fd-bc-flag) "A.D."))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
626 ((eq x 'bb)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
627 (and math-fd-bc-flag "bc"))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
628 ((eq x 'BB)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
629 (and math-fd-bc-flag "BC"))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
630 ((eq x 'bbb)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
631 (and math-fd-bc-flag " bc"))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
632 ((eq x 'BBB)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
633 (and math-fd-bc-flag " BC"))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
634 ((eq x 'bbbb)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
635 (and math-fd-bc-flag "b.c."))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
636 ((eq x 'BBBB)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
637 (and math-fd-bc-flag "B.C."))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
638 ((eq x 'M)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
639 (format "%d" math-fd-month))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
640 ((eq x 'MM)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
641 (format "%02d" math-fd-month))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
642 ((eq x 'BM)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
643 (format "%2d" math-fd-month))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
644 ((eq x 'mmm)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
645 (downcase (nth (1- math-fd-month) math-short-month-names)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
646 ((eq x 'Mmm)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
647 (nth (1- math-fd-month) math-short-month-names))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
648 ((eq x 'MMM)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
649 (upcase (nth (1- math-fd-month) math-short-month-names)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
650 ((eq x 'Mmmm)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
651 (nth (1- math-fd-month) math-long-month-names))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
652 ((eq x 'MMMM)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
653 (upcase (nth (1- math-fd-month) math-long-month-names)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
654 ((eq x 'D)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
655 (format "%d" math-fd-day))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
656 ((eq x 'DD)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
657 (format "%02d" math-fd-day))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
658 ((eq x 'BD)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
659 (format "%2d" math-fd-day))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
660 ((eq x 'W)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
661 (format "%d" math-fd-weekday))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
662 ((eq x 'www)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
663 (downcase (nth math-fd-weekday math-short-weekday-names)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
664 ((eq x 'Www)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
665 (nth math-fd-weekday math-short-weekday-names))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
666 ((eq x 'WWW)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
667 (upcase (nth math-fd-weekday math-short-weekday-names)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
668 ((eq x 'Wwww)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
669 (nth math-fd-weekday math-long-weekday-names))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
670 ((eq x 'WWWW)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
671 (upcase (nth math-fd-weekday math-long-weekday-names)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
672 ((eq x 'd)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
673 (format "%d" (math-day-number math-fd-year math-fd-month math-fd-day)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
674 ((eq x 'ddd)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
675 (format "%03d" (math-day-number math-fd-year math-fd-month math-fd-day)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
676 ((eq x 'bdd)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
677 (format "%3d" (math-day-number math-fd-year math-fd-month math-fd-day)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
678 ((eq x 'h)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
679 (and math-fd-hour (format "%d" math-fd-hour)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
680 ((eq x 'hh)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
681 (and math-fd-hour (format "%02d" math-fd-hour)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
682 ((eq x 'bh)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
683 (and math-fd-hour (format "%2d" math-fd-hour)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
684 ((eq x 'H)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
685 (and math-fd-hour (format "%d" (1+ (% (+ math-fd-hour 11) 12)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
686 ((eq x 'HH)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
687 (and math-fd-hour (format "%02d" (1+ (% (+ math-fd-hour 11) 12)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
688 ((eq x 'BH)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
689 (and math-fd-hour (format "%2d" (1+ (% (+ math-fd-hour 11) 12)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
690 ((eq x 'p)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
691 (and math-fd-hour (if (< math-fd-hour 12) "a" "p")))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
692 ((eq x 'P)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
693 (and math-fd-hour (if (< math-fd-hour 12) "A" "P")))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
694 ((eq x 'pp)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
695 (and math-fd-hour (if (< math-fd-hour 12) "am" "pm")))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
696 ((eq x 'PP)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
697 (and math-fd-hour (if (< math-fd-hour 12) "AM" "PM")))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
698 ((eq x 'pppp)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
699 (and math-fd-hour (if (< math-fd-hour 12) "a.m." "p.m.")))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
700 ((eq x 'PPPP)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
701 (and math-fd-hour (if (< math-fd-hour 12) "A.M." "P.M.")))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
702 ((eq x 'm)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
703 (and math-fd-minute (format "%d" math-fd-minute)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
704 ((eq x 'mm)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
705 (and math-fd-minute (format "%02d" math-fd-minute)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
706 ((eq x 'bm)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
707 (and math-fd-minute (format "%2d" math-fd-minute)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
708 ((eq x 'C)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
709 (and math-fd-second (not (math-zerop math-fd-second))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
710 ":"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
711 ((memq x '(s ss bs SS BS))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
712 (and math-fd-second
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
713 (not (and (memq x '(SS BS)) (math-zerop math-fd-second)))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
714 (if (integerp math-fd-second)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
715 (format (cond ((memq x '(ss SS)) "%02d")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
716 ((memq x '(bs BS)) "%2d")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
717 (t "%d"))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
718 math-fd-second)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
719 (concat (if (Math-lessp math-fd-second 10)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
720 (cond ((memq x '(ss SS)) "0")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
721 ((memq x '(bs BS)) " ")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
722 (t ""))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
723 "")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
724 (let ((calc-float-format
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
725 (list 'fix (min (- 12 calc-internal-prec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
726 0))))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
727 (math-format-number math-fd-second))))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
728
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
729 ;; The variable math-pd-str is local to math-parse-date and
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
730 ;; math-parse-standard-date, but is used by math-parse-date-word,
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
731 ;; which is called by math-parse-date and math-parse-standard-date.
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
732 (defvar math-pd-str)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
733
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
734 (defun math-parse-date (math-pd-str)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
735 (catch 'syntax
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
736 (or (math-parse-standard-date math-pd-str t)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
737 (math-parse-standard-date math-pd-str nil)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
738 (and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
739 (list 'date (math-read-number (math-match-substring math-pd-str 1))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
740 (let ((case-fold-search t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
741 (year nil) (month nil) (day nil) (weekday nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
742 (hour nil) (minute nil) (second nil) (bc-flag nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
743 (a nil) (b nil) (c nil) (bigyear nil) temp)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
744
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
745 ;; Extract the time, if any.
76554
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
746 (if (or (string-match "\\([0-9][0-9]?\\):\\([0-9][0-9]?\\)\\(:\\([0-9][0-9]?\\(\\.[0-9]+\\)?\\)\\)? *\\([ap]\\>\\|[ap]m\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)?" math-pd-str)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
747 (string-match "\\([0-9][0-9]?\\)\\(\\)\\(\\(\\(\\)\\)\\) *\\([ap]\\>\\|[ap]m\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)" math-pd-str))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
748 (let ((ampm (math-match-substring math-pd-str 6)))
62035
0e0c15279b4e (calc-time, calc-date-notation, math-this-year, math-parse-date)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 60908
diff changeset
749 (setq hour (string-to-number (math-match-substring math-pd-str 1))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
750 minute (math-match-substring math-pd-str 2)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
751 second (math-match-substring math-pd-str 4)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
752 math-pd-str (concat (substring math-pd-str 0 (match-beginning 0))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
753 (substring math-pd-str (match-end 0))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
754 (if (equal minute "")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
755 (setq minute 0)
62035
0e0c15279b4e (calc-time, calc-date-notation, math-this-year, math-parse-date)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 60908
diff changeset
756 (setq minute (string-to-number minute)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
757 (if (equal second "")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
758 (setq second 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
759 (setq second (math-read-number second)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
760 (if (equal ampm "")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
761 (if (> hour 23)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
762 (throw 'syntax "Hour value out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
763 (setq ampm (upcase (aref ampm 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
764 (if (memq ampm '(?N ?M))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
765 (if (and (= hour 12) (= minute 0) (eq second 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
766 (if (eq ampm ?M) (setq hour 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
767 (throw 'syntax
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
768 "Time must be 12:00:00 in this context"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
769 (if (or (= hour 0) (> hour 12))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
770 (throw 'syntax "Hour value out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
771 (if (eq (= ampm ?A) (= hour 12))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
772 (setq hour (% (+ hour 12) 24)))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
773
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
774 ;; Rewrite xx-yy-zz to xx/yy/zz to avoid seeing "-" as a minus sign.
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
775 (while (string-match "[0-9a-zA-Z]\\(-\\)[0-9a-zA-Z]" math-pd-str)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
776 (progn
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
777 (setq math-pd-str (copy-sequence math-pd-str))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
778 (aset math-pd-str (match-beginning 1) ?\/)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
779
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
780 ;; Extract obvious month or weekday names.
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
781 (if (string-match "[a-zA-Z]" math-pd-str)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
782 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
783 (setq month (math-parse-date-word math-long-month-names))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
784 (setq weekday (math-parse-date-word math-long-weekday-names))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
785 (or month (setq month
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
786 (math-parse-date-word math-short-month-names)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
787 (or weekday (math-parse-date-word math-short-weekday-names))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
788 (or hour
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
789 (if (setq temp (math-parse-date-word
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
790 '( "noon" "midnight" "mid" )))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
791 (setq hour (if (= temp 1) 12 0) minute 0 second 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
792 (or (math-parse-date-word '( "ad" "a.d." ))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
793 (if (math-parse-date-word '( "bc" "b.c." ))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
794 (setq bc-flag t)))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
795 (if (string-match "[a-zA-Z]+" math-pd-str)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
796 (throw 'syntax (format "Bad word in date: \"%s\""
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
797 (math-match-substring math-pd-str 0))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
798
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
799 ;; If there is a huge number other than the year, ignore it.
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
800 (while (and (string-match "[-+]?0*[1-9][0-9][0-9][0-9][0-9]+" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
801 (setq temp (concat (substring math-pd-str 0 (match-beginning 0))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
802 (substring math-pd-str (match-end 0))))
76569
a5ca6723c3b1 (math-std-daylight-savings)
Kim F. Storm <storm@cua.dk>
parents: 76554
diff changeset
803 (string-match
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
804 "[4-9][0-9]\\|[0-9][0-9][0-9]\\|[-+][0-9]+[^-]*\\'" temp))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
805 (setq math-pd-str temp))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
806
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
807 ;; If there is a number with a sign or a large number, it is a year.
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
808 (if (or (string-match "\\([-+][0-9]+\\)[^-]*\\'" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
809 (string-match "\\(0*[1-9][0-9][0-9]+\\)" math-pd-str))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
810 (setq year (math-match-substring math-pd-str 1)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
811 math-pd-str (concat (substring math-pd-str 0 (match-beginning 1))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
812 (substring math-pd-str (match-end 1)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
813 year (math-read-number year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
814 bigyear t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
815
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
816 ;; Collect remaining numbers.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
817 (setq temp 0)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
818 (while (string-match "[0-9]+" math-pd-str temp)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
819 (and c (throw 'syntax "Too many numbers in date"))
62035
0e0c15279b4e (calc-time, calc-date-notation, math-this-year, math-parse-date)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 60908
diff changeset
820 (setq c (string-to-number (math-match-substring math-pd-str 0)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
821 (or b (setq b c c nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
822 (or a (setq a b b nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
823 (setq temp (match-end 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
824
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
825 ;; Check that we have the right amount of information.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
826 (setq temp (+ (if year 1 0) (if month 1 0) (if day 1 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
827 (if a 1 0) (if b 1 0) (if c 1 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
828 (if (> temp 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
829 (throw 'syntax "Too many numbers in date")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
830 (if (or (< temp 2) (and year (= temp 2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
831 (throw 'syntax "Not enough numbers in date")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
832 (if (= temp 2) ; if year omitted, assume current year
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
833 (setq year (math-this-year)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
834
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
835 ;; A large number must be a year.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
836 (or year
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
837 (if (and a (or (> a 31) (< a 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
838 (setq year a a b b c c nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
839 (if (and b (or (> b 31) (< b 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
840 (setq year b b c c nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
841 (if (and c (or (> c 31) (< c 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
842 (setq year c c nil)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
843
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
844 ;; A medium-large number must be a day.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
845 (if year
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
846 (if (and a (> a 12))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
847 (setq day a a b b c c nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
848 (if (and b (> b 12))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
849 (setq day b b c c nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
850 (if (and c (> c 12))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
851 (setq day c c nil)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
852
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
853 ;; We may know enough to sort it out now.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
854 (if (and year day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
855 (or month (setq month a))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
856 (if (and year month)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
857 (setq day a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
858
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
859 ;; Interpret order of numbers as same as for display format.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
860 (setq temp calc-date-format)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
861 (while temp
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
862 (cond ((not (symbolp (car temp))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
863 ((memq (car temp) '(Y YY BY YYY YYYY))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
864 (or year (setq year a a b b c)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
865 ((memq (car temp) '(M MM BM mmm Mmm Mmmm MMM MMMM))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
866 (or month (setq month a a b b c)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
867 ((memq (car temp) '(D DD BD))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
868 (or day (setq day a a b b c))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
869 (setq temp (cdr temp)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
870
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
871 ;; If display format was not complete, assume American style.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
872 (or month (setq month a a b b c))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
873 (or day (setq day a a b b c))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
874 (or year (setq year a a b b c))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
875
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
876 (if bc-flag
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
877 (setq year (math-neg (math-abs year))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
878
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
879 (math-parse-date-validate year bigyear month day
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
880 hour minute second)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
881
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
882 (defun math-parse-date-validate (year bigyear month day hour minute second)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
883 (and (not bigyear) (natnump year) (< year 100)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
884 (setq year (+ year (if (< year 40) 2000 1900))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
885 (if (eq year 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
886 (throw 'syntax "Year value is out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
887 (if (or (< month 1) (> month 12))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
888 (throw 'syntax "Month value is out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
889 (if (or (< day 1) (> day (math-days-in-month year month)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
890 (throw 'syntax "Day value is out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
891 (and hour
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
892 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
893 (if (or (< hour 0) (> hour 23))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
894 (throw 'syntax "Hour value is out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
895 (if (or (< minute 0) (> minute 59))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
896 (throw 'syntax "Minute value is out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
897 (if (or (math-negp second) (not (Math-lessp second 60)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
898 (throw 'syntax "Seconds value is out of range"))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
899 (list 'date (math-dt-to-date (append (list year month day)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
900 (and hour (list hour minute second))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
901
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
902 (defun math-parse-date-word (names &optional front)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
903 (let ((n 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
904 (while (and names (not (string-match (if (equal (car names) "Sep")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
905 "Sept?"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
906 (regexp-quote (car names)))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
907 math-pd-str)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
908 (setq names (cdr names)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
909 n (1+ n)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
910 (and names
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
911 (or (not front) (= (match-beginning 0) 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
912 (progn
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
913 (setq math-pd-str (concat (substring math-pd-str 0 (match-beginning 0))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
914 (if front "" " ")
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
915 (substring math-pd-str (match-end 0))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
916 n))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
917
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
918 (defun math-parse-standard-date (math-pd-str with-time)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
919 (let ((case-fold-search t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
920 (okay t) num
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
921 (fmt calc-date-format) this next (gnext nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
922 (year nil) (month nil) (day nil) (bigyear nil) (yearday nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
923 (hour nil) (minute nil) (second nil) (bc-flag nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
924 (while (and fmt okay)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
925 (setq this (car fmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
926 fmt (setq fmt (or (cdr fmt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
927 (prog1
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
928 gnext
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
929 (setq gnext nil))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
930 next (car fmt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
931 (if (consp next) (setq next (car next)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
932 (or (cond ((listp this)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
933 (or (not with-time)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
934 (not this)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
935 (setq gnext fmt
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
936 fmt this)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
937 ((stringp this)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
938 (if (and (<= (length this) (length math-pd-str))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
939 (equal this
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
940 (substring math-pd-str 0 (length this))))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
941 (setq math-pd-str (substring math-pd-str (length this)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
942 ((eq this 'X)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
943 t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
944 ((memq this '(n N j J))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
945 (and (string-match "\\`[-+]?[0-9.]+\\([eE][-+]?[0-9]+\\)?" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
946 (setq num (math-match-substring math-pd-str 0)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
947 math-pd-str (substring math-pd-str (match-end 0))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
948 num (math-date-to-dt (math-read-number num))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
949 num (math-sub num
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
950 (if (memq this '(n N))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
951 0
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
952 (if (or (eq this 'j)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
953 (math-integerp num))
81744
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
954 math-julian-date-beginning-int
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
955 math-julian-date-beginning)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
956 hour (or (nth 3 num) hour)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
957 minute (or (nth 4 num) minute)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
958 second (or (nth 5 num) second)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
959 year (car num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
960 month (nth 1 num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
961 day (nth 2 num))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
962 ((eq this 'U)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
963 (and (string-match "\\`[-+]?[0-9]+" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
964 (setq num (math-match-substring math-pd-str 0)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
965 math-pd-str (substring math-pd-str (match-end 0))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
966 num (math-date-to-dt
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
967 (math-add 719164
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
968 (math-div (math-read-number num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
969 '(float 864 2))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
970 hour (nth 3 num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
971 minute (nth 4 num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
972 second (nth 5 num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
973 year (car num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
974 month (nth 1 num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
975 day (nth 2 num))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
976 ((memq this '(mmm Mmm MMM))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
977 (setq month (math-parse-date-word math-short-month-names t)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
978 ((memq this '(Mmmm MMMM))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
979 (setq month (math-parse-date-word math-long-month-names t)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
980 ((memq this '(www Www WWW))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
981 (math-parse-date-word math-short-weekday-names t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
982 ((memq this '(Wwww WWWW))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
983 (math-parse-date-word math-long-weekday-names t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
984 ((memq this '(p P))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
985 (if (string-match "\\`a" math-pd-str)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
986 (setq hour (if (= hour 12) 0 hour)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
987 math-pd-str (substring math-pd-str 1))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
988 (if (string-match "\\`p" math-pd-str)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
989 (setq hour (if (= hour 12) 12 (% (+ hour 12) 24))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
990 math-pd-str (substring math-pd-str 1)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
991 ((memq this '(pp PP pppp PPPP))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
992 (if (string-match "\\`am\\|a\\.m\\." math-pd-str)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
993 (setq hour (if (= hour 12) 0 hour)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
994 math-pd-str (substring math-pd-str (match-end 0)))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
995 (if (string-match "\\`pm\\|p\\.m\\." math-pd-str)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
996 (setq hour (if (= hour 12) 12 (% (+ hour 12) 24))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
997 math-pd-str (substring math-pd-str (match-end 0))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
998 ((memq this '(Y YY BY YYY YYYY))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
999 (and (if (memq next '(MM DD ddd hh HH mm ss SS))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1000 (if (memq this '(Y YY BYY))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1001 (string-match "\\` *[0-9][0-9]" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1002 (string-match "\\`[0-9][0-9][0-9][0-9]" math-pd-str))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1003 (string-match "\\`[-+]?[0-9]+" math-pd-str))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1004 (setq year (math-match-substring math-pd-str 0)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1005 bigyear (or (eq this 'YYY)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1006 (memq (aref math-pd-str 0) '(?\+ ?\-)))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1007 math-pd-str (substring math-pd-str (match-end 0))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1008 year (math-read-number year))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1009 ((eq this 'b)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1010 t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1011 ((memq this '(aa AA aaaa AAAA))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1012 (if (string-match "\\` *\\(ad\\|a\\.d\\.\\)" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1013 (setq math-pd-str (substring math-pd-str (match-end 0)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1014 ((memq this '(aaa AAA))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1015 (if (string-match "\\` *ad *" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1016 (setq math-pd-str (substring math-pd-str (match-end 0)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1017 ((memq this '(bb BB bbb BBB bbbb BBBB))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1018 (if (string-match "\\` *\\(bc\\|b\\.c\\.\\)" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1019 (setq math-pd-str (substring math-pd-str (match-end 0))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1020 bc-flag t)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1021 ((memq this '(s ss bs SS BS))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1022 (and (if (memq next '(YY YYYY MM DD hh HH mm))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1023 (string-match "\\` *[0-9][0-9]\\(\\.[0-9]+\\)?" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1024 (string-match "\\` *[0-9][0-9]?\\(\\.[0-9]+\\)?" math-pd-str))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1025 (setq second (math-match-substring math-pd-str 0)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1026 math-pd-str (substring math-pd-str (match-end 0))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1027 second (math-read-number second))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1028 ((eq this 'C)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1029 (if (string-match "\\`:[0-9][0-9]" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1030 (setq math-pd-str (substring math-pd-str 1))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1031 t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1032 ((or (not (if (and (memq this '(ddd MM DD hh HH mm))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1033 (memq next '(YY YYYY MM DD ddd
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1034 hh HH mm ss SS)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1035 (if (eq this 'ddd)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1036 (string-match "\\` *[0-9][0-9][0-9]" math-pd-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1037 (string-match "\\` *[0-9][0-9]" math-pd-str))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1038 (string-match "\\` *[0-9]+" math-pd-str)))
62035
0e0c15279b4e (calc-time, calc-date-notation, math-this-year, math-parse-date)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 60908
diff changeset
1039 (and (setq num (string-to-number
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1040 (math-match-substring math-pd-str 0))
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1041 math-pd-str (substring math-pd-str (match-end 0)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1042 nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1043 nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1044 ((eq this 'W)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1045 (and (>= num 0) (< num 7)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1046 ((memq this '(d ddd bdd))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1047 (setq yearday num))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1048 ((memq this '(M MM BM))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1049 (setq month num))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1050 ((memq this '(D DD BD))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1051 (setq day num))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1052 ((memq this '(h hh bh H HH BH))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1053 (setq hour num))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1054 ((memq this '(m mm bm))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1055 (setq minute num)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1056 (setq okay nil)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1057 (if yearday
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1058 (if (and month day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1059 (setq yearday nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1060 (setq month 1 day 1)))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1061 (if (and okay (equal math-pd-str ""))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1062 (and month day (or (not (or hour minute second))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1063 (and hour minute))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1064 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1065 (or year (setq year (math-this-year)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1066 (or second (setq second 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1067 (if bc-flag
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1068 (setq year (math-neg (math-abs year))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1069 (setq day (math-parse-date-validate year bigyear month day
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1070 hour minute second))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1071 (if yearday
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1072 (setq day (math-add day (1- yearday))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1073 day)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1074
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1075
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1076 (defun calcFunc-now (&optional zone)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1077 (let ((date (let ((calc-date-format nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1078 (math-parse-date (current-time-string)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1079 (if (consp date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1080 (if zone
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1081 (math-add date (math-div (math-sub (calcFunc-tzone nil date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1082 (calcFunc-tzone zone date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1083 '(float 864 2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1084 date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1085 (calc-record-why "*Unable to interpret current date from system")
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1086 (append (list 'calcFunc-now) (and zone (list zone))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1087
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1088 (defun calcFunc-year (date)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1089 (car (math-date-to-dt date)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1090
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1091 (defun calcFunc-month (date)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1092 (nth 1 (math-date-to-dt date)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1093
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1094 (defun calcFunc-day (date)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1095 (nth 2 (math-date-to-dt date)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1096
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1097 (defun calcFunc-weekday (date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1098 (if (eq (car-safe date) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1099 (setq date (nth 1 date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1100 (or (math-realp date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1101 (math-reject-arg date 'datep))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1102 (math-mod (math-add (math-floor date) 6) 7))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1103
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1104 (defun calcFunc-yearday (date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1105 (let ((dt (math-date-to-dt date)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1106 (math-day-number (car dt) (nth 1 dt) (nth 2 dt))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1107
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1108 (defun calcFunc-hour (date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1109 (if (eq (car-safe date) 'hms)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1110 (nth 1 date)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1111 (or (nth 3 (math-date-to-dt date)) 0)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1112
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1113 (defun calcFunc-minute (date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1114 (if (eq (car-safe date) 'hms)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1115 (nth 2 date)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1116 (or (nth 4 (math-date-to-dt date)) 0)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1117
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1118 (defun calcFunc-second (date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1119 (if (eq (car-safe date) 'hms)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1120 (nth 3 date)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1121 (or (nth 5 (math-date-to-dt date)) 0)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1122
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1123 (defun calcFunc-time (date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1124 (let ((dt (math-date-to-dt date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1125 (if (nth 3 dt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1126 (cons 'hms (nthcdr 3 dt))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1127 (list 'hms 0 0 0))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1128
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1129 (defun calcFunc-date (date &optional month day hour minute second)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1130 (and (math-messy-integerp month) (setq month (math-trunc month)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1131 (and month (not (integerp month)) (math-reject-arg month 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1132 (and (math-messy-integerp day) (setq day (math-trunc day)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1133 (and day (not (integerp day)) (math-reject-arg day 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1134 (if (and (eq (car-safe hour) 'hms) (not minute))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1135 (setq second (nth 3 hour)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1136 minute (nth 2 hour)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1137 hour (nth 1 hour)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1138 (and (math-messy-integerp hour) (setq hour (math-trunc hour)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1139 (and hour (not (integerp hour)) (math-reject-arg hour 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1140 (and (math-messy-integerp minute) (setq minute (math-trunc minute)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1141 (and minute (not (integerp minute)) (math-reject-arg minute 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1142 (and (math-messy-integerp second) (setq second (math-trunc second)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1143 (and second (not (math-realp second)) (math-reject-arg second 'realp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1144 (if month
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1145 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1146 (and (math-messy-integerp date) (setq date (math-trunc date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1147 (and date (not (math-integerp date)) (math-reject-arg date 'integerp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1148 (if day
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1149 (if hour
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1150 (list 'date (math-dt-to-date (list date month day hour
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1151 (or minute 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1152 (or second 0))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1153 (list 'date (math-dt-to-date (list date month day))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1154 (list 'date (math-dt-to-date (list (math-this-year) date month)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1155 (if (math-realp date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1156 (list 'date date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1157 (if (eq (car date) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1158 (nth 1 date)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1159 (math-reject-arg date 'datep)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1160
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1161 (defun calcFunc-julian (date &optional zone)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1162 (if (math-realp date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1163 (list 'date (if (math-integerp date)
81744
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
1164 (math-sub date math-julian-date-beginning-int)
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
1165 (setq date (math-sub date math-julian-date-beginning))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1166 (math-sub date (math-div (calcFunc-tzone zone date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1167 '(float 864 2)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1168 (if (eq (car date) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1169 (math-add (nth 1 date) (if (math-integerp (nth 1 date))
81744
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
1170 math-julian-date-beginning-int
f245856314bf (math-julian-date-beginning,math-julian-date-beginning-int) New constants.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 81562
diff changeset
1171 (math-add math-julian-date-beginning
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1172 (math-div (calcFunc-tzone zone date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1173 '(float 864 2)))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1174 (math-reject-arg date 'datep))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1175
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1176 (defun calcFunc-unixtime (date &optional zone)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1177 (if (math-realp date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1178 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1179 (setq date (math-add 719164 (math-div date '(float 864 2))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1180 (list 'date (math-sub date (math-div (calcFunc-tzone zone date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1181 '(float 864 2)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1182 (if (eq (car date) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1183 (math-add (nth 1 (math-date-parts (nth 1 date) 719164))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1184 (calcFunc-tzone zone date))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1185 (math-reject-arg date 'datep))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1186
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1187
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1188 ;;; Note: Longer names must appear before shorter names which are
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1189 ;;; substrings of them.
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1190 (defvar math-tzone-names
76569
a5ca6723c3b1 (math-std-daylight-savings)
Kim F. Storm <storm@cua.dk>
parents: 76554
diff changeset
1191 '(( "UTC" 0 0)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1192 ( "MEGT" -1 "MET" "METDST" ) ; Middle Europe
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1193 ( "METDST" -1 -1 ) ( "MET" -1 0 )
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1194 ( "MEGZ" -1 "MEZ" "MESZ" ) ( "MEZ" -1 0 ) ( "MESZ" -1 -1 )
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1195 ( "WEGT" 0 "WET" "WETDST" ) ; Western Europe
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1196 ( "WETDST" 0 -1 ) ( "WET" 0 0 )
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1197 ( "BGT" 0 "GMT" "BST" ) ( "GMT" 0 0 ) ( "BST" 0 -1 ) ; Britain
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1198 ( "NGT" (float 35 -1) "NST" "NDT" ) ; Newfoundland
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1199 ( "NST" (float 35 -1) 0 ) ( "NDT" (float 35 -1) -1 )
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1200 ( "AGT" 4 "AST" "ADT" ) ( "AST" 4 0 ) ( "ADT" 4 -1 ) ; Atlantic
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1201 ( "EGT" 5 "EST" "EDT" ) ( "EST" 5 0 ) ( "EDT" 5 -1 ) ; Eastern
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1202 ( "CGT" 6 "CST" "CDT" ) ( "CST" 6 0 ) ( "CDT" 6 -1 ) ; Central
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1203 ( "MGT" 7 "MST" "MDT" ) ( "MST" 7 0 ) ( "MDT" 7 -1 ) ; Mountain
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1204 ( "PGT" 8 "PST" "PDT" ) ( "PST" 8 0 ) ( "PDT" 8 -1 ) ; Pacific
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1205 ( "YGT" 9 "YST" "YDT" ) ( "YST" 9 0 ) ( "YDT" 9 -1 ) ; Yukon
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1206 )
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1207 "No doc yet. See calc manual for now. ")
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1208
82829
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1209 (defvar var-TimeZone nil)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1210
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1211 ;; From cal-dst
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1212 (defvar calendar-current-time-zone-cache)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1213
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1214 (defvar math-calendar-tzinfo
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1215 nil
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1216 "Information about the timezone, retrieved from the calendar.")
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1217
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1218 (defun math-get-calendar-tzinfo ()
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1219 "Get information about the timezone from the calendar.
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1220 The result should be a list of two items about the current time zone:
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1221 first, the number of seconds difference from GMT
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1222 second, the number of seconds offset for daylight savings."
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1223 (if math-calendar-tzinfo
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1224 math-calendar-tzinfo
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1225 (require 'cal-dst)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1226 (let ((tzinfo (progn
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1227 (calendar-current-time-zone)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1228 calendar-current-time-zone-cache)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1229 (setq math-calendar-tzinfo
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1230 (list (* 60 (abs (nth 0 tzinfo)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1231 (* 60 (nth 1 tzinfo)))))))
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1232
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1233 (defun calcFunc-tzone (&optional zone date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1234 (if zone
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1235 (cond ((math-realp zone)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1236 (math-round (math-mul zone 3600)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1237 ((eq (car zone) 'hms)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1238 (math-round (math-mul (math-from-hms zone 'deg) 3600)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1239 ((eq (car zone) '+)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1240 (math-add (calcFunc-tzone (nth 1 zone) date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1241 (calcFunc-tzone (nth 2 zone) date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1242 ((eq (car zone) '-)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1243 (math-sub (calcFunc-tzone (nth 1 zone) date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1244 (calcFunc-tzone (nth 2 zone) date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1245 ((eq (car zone) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1246 (let ((name (upcase (symbol-name (nth 1 zone))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1247 found)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1248 (if (setq found (assoc name math-tzone-names))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1249 (calcFunc-tzone (math-add (nth 1 found)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1250 (if (integerp (nth 2 found))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1251 (nth 2 found)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1252 (or
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1253 (math-daylight-savings-adjust
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1254 date (car found))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1255 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1256 date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1257 (if (equal name "LOCAL")
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1258 (calcFunc-tzone nil date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1259 (math-reject-arg zone "*Unrecognized time zone name")))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1260 (t (math-reject-arg zone "*Expected a time zone")))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1261 (if (calc-var-value 'var-TimeZone)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1262 (calcFunc-tzone (calc-var-value 'var-TimeZone) date)
82829
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1263 (let ((tzinfo (math-get-calendar-tzinfo)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1264 (+ (nth 0 tzinfo)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1265 (* (math-cal-daylight-savings-adjust date) (nth 1 tzinfo)))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1266
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1267 (defvar math-daylight-savings-hook 'math-std-daylight-savings)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1268
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1269 (defun math-daylight-savings-adjust (date zone &optional dt)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1270 (or date (setq date (nth 1 (calcFunc-now))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1271 (let (bump)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1272 (if (eq (car-safe date) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1273 (setq bump 0
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1274 date (nth 1 date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1275 (if (and date (math-realp date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1276 (let ((zadj (assoc zone math-tzone-names)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1277 (if zadj (setq bump -1
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1278 date (math-sub date (math-div (nth 1 zadj)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1279 '(float 24 0))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1280 (math-reject-arg date 'datep)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1281 (setq date (math-float date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1282 (or dt (setq dt (math-date-to-dt date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1283 (and math-daylight-savings-hook
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1284 (funcall math-daylight-savings-hook date dt zone bump))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1285
82829
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1286 ;;; Based on part of dst-adjust-time in cal-dst.el
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1287 ;;; For calcFunc-dst, when zone=nil
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1288 (defun math-cal-daylight-savings-adjust (date)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1289 "Return -1 if DATE is using daylight saving, 0 otherwise."
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1290 (require 'cal-dst)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1291 (unless date (setq date (calcFunc-now)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1292 (let* ((dt (math-date-to-dt date))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1293 (time (cond
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1294 ((nth 3 dt)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1295 (nth 3 dt))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1296 ((nth 4 dt)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1297 (+ (nth 3 dt) (/ (nth 4 dt) 60.0)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1298 (t
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1299 0)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1300 (rounded-abs-date
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1301 (+
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1302 (calendar-absolute-from-gregorian
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1303 (list (nth 1 dt) (nth 2 dt) (nth 0 dt)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1304 (/ (round (* 60 time)) 60.0 24.0))))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1305 (if (dst-in-effect rounded-abs-date)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1306 -1
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1307 0)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1308
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1309 (defun calcFunc-dsadj (date &optional zone)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1310 (if zone
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1311 (or (eq (car-safe zone) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1312 (math-reject-arg zone "*Time zone variable expected"))
82829
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1313 (setq zone (calc-var-value 'var-TimeZone)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1314 (if zone
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1315 (progn
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1316 (setq zone (and (eq (car-safe zone) 'var)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1317 (upcase (symbol-name (nth 1 zone)))))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1318 (let ((zadj (assoc zone math-tzone-names)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1319 (or zadj (math-reject-arg zone "*Unrecognized time zone name"))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1320 (if (integerp (nth 2 zadj))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1321 (nth 2 zadj)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1322 (math-daylight-savings-adjust date zone))))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1323 (math-cal-daylight-savings-adjust date)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1324
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1325 ;; (defun calcFunc-dsadj (date &optional zone)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1326 ;; (if zone
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1327 ;; (or (eq (car-safe zone) 'var)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1328 ;; (math-reject-arg zone "*Time zone variable expected"))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1329 ;; (setq zone (or (calc-var-value 'var-TimeZone)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1330 ;; (progn
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1331 ;; (calcFunc-tzone)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1332 ;; (calc-var-value 'var-TimeZone)))))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1333 ;; (setq zone (and (eq (car-safe zone) 'var)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1334 ;; (upcase (symbol-name (nth 1 zone)))))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1335 ;; (let ((zadj (assoc zone math-tzone-names)))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1336 ;; (or zadj (math-reject-arg zone "*Unrecognized time zone name"))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1337 ;; (if (integerp (nth 2 zadj))
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1338 ;; (nth 2 zadj)
ecf4a0390a7e (var-TimeZone): Make nil the default value.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 82140
diff changeset
1339 ;; (math-daylight-savings-adjust date zone))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1340
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1341 (defun calcFunc-tzconv (date z1 z2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1342 (if (math-realp date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1343 (nth 1 (calcFunc-tzconv (list 'date date) z1 z2))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1344 (calcFunc-unixtime (calcFunc-unixtime date z1) z2)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1345
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1346 (defun math-std-daylight-savings (date dt zone bump)
76475
321e7fa1c51d (math-std-daylight-savings): Switch to new North American rule.
Chong Yidong <cyd@stupidchicken.com>
parents: 75346
diff changeset
1347 "Standard North American daylight saving algorithm.
76554
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1348 Before 2007, this uses `math-std-daylight-savings-old', where
76569
a5ca6723c3b1 (math-std-daylight-savings)
Kim F. Storm <storm@cua.dk>
parents: 76554
diff changeset
1349 daylight saving began on the first Sunday of April at 2 a.m.,
76554
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1350 and ended on the last Sunday of October at 2 a.m.
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1351 As of 2007, this uses `math-std-daylight-savings-new', where
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1352 daylight saving begins on the second Sunday of March at 2 a.m.,
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1353 and ends on the first Sunday of November at 2 a.m."
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1354 (if (< (car dt) 2007)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1355 (math-std-daylight-savings-old date dt zone bump)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1356 (math-std-daylight-savings-new date dt zone bump)))
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1357
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1358 (defun math-std-daylight-savings-new (date dt zone bump)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1359 "Standard North American daylight saving algorithm as of 2007.
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1360 This implements the rules for the U.S. and Canada.
76475
321e7fa1c51d (math-std-daylight-savings): Switch to new North American rule.
Chong Yidong <cyd@stupidchicken.com>
parents: 75346
diff changeset
1361 Daylight saving begins on the second Sunday of March at 2 a.m.,
321e7fa1c51d (math-std-daylight-savings): Switch to new North American rule.
Chong Yidong <cyd@stupidchicken.com>
parents: 75346
diff changeset
1362 and ends on the first Sunday of November at 2 a.m."
321e7fa1c51d (math-std-daylight-savings): Switch to new North American rule.
Chong Yidong <cyd@stupidchicken.com>
parents: 75346
diff changeset
1363 (cond ((< (nth 1 dt) 3) 0)
321e7fa1c51d (math-std-daylight-savings): Switch to new North American rule.
Chong Yidong <cyd@stupidchicken.com>
parents: 75346
diff changeset
1364 ((= (nth 1 dt) 3)
321e7fa1c51d (math-std-daylight-savings): Switch to new North American rule.
Chong Yidong <cyd@stupidchicken.com>
parents: 75346
diff changeset
1365 (let ((sunday (math-prev-weekday-in-month date dt 14 0)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1366 (cond ((< (nth 2 dt) sunday) 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1367 ((= (nth 2 dt) sunday)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1368 (if (>= (nth 3 dt) (+ 3 bump)) -1 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1369 (t -1))))
76475
321e7fa1c51d (math-std-daylight-savings): Switch to new North American rule.
Chong Yidong <cyd@stupidchicken.com>
parents: 75346
diff changeset
1370 ((< (nth 1 dt) 11) -1)
321e7fa1c51d (math-std-daylight-savings): Switch to new North American rule.
Chong Yidong <cyd@stupidchicken.com>
parents: 75346
diff changeset
1371 ((= (nth 1 dt) 11)
321e7fa1c51d (math-std-daylight-savings): Switch to new North American rule.
Chong Yidong <cyd@stupidchicken.com>
parents: 75346
diff changeset
1372 (let ((sunday (math-prev-weekday-in-month date dt 7 0)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1373 (cond ((< (nth 2 dt) sunday) -1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1374 ((= (nth 2 dt) sunday)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1375 (if (>= (nth 3 dt) (+ 2 bump)) 0 -1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1376 (t 0))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1377 (t 0)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1378
76554
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1379 (defun math-std-daylight-savings-old (date dt zone bump)
76569
a5ca6723c3b1 (math-std-daylight-savings)
Kim F. Storm <storm@cua.dk>
parents: 76554
diff changeset
1380 "Standard North American daylight saving algorithm before 2007.
76554
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1381 This implements the rules for the U.S. and Canada.
76569
a5ca6723c3b1 (math-std-daylight-savings)
Kim F. Storm <storm@cua.dk>
parents: 76554
diff changeset
1382 Daylight saving begins on the first Sunday of April at 2 a.m.,
76554
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1383 and ends on the last Sunday of October at 2 a.m."
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1384 (cond ((< (nth 1 dt) 4) 0)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1385 ((= (nth 1 dt) 4)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1386 (let ((sunday (math-prev-weekday-in-month date dt 7 0)))
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1387 (cond ((< (nth 2 dt) sunday) 0)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1388 ((= (nth 2 dt) sunday)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1389 (if (>= (nth 3 dt) (+ 3 bump)) -1 0))
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1390 (t -1))))
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1391 ((< (nth 1 dt) 10) -1)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1392 ((= (nth 1 dt) 10)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1393 (let ((sunday (math-prev-weekday-in-month date dt 31 0)))
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1394 (cond ((< (nth 2 dt) sunday) -1)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1395 ((= (nth 2 dt) sunday)
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1396 (if (>= (nth 3 dt) (+ 2 bump)) 0 -1))
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1397 (t 0))))
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1398 (t 0)))
cabce7b4c4cc (math-parse-date): Fix a regular expression.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 76475
diff changeset
1399
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1400 ;;; Compute the day (1-31) of the WDAY (0-6) on or preceding the given
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1401 ;;; day of the given month.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1402 (defun math-prev-weekday-in-month (date dt day wday)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1403 (or day (setq day (nth 2 dt)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1404 (if (> day (math-days-in-month (car dt) (nth 1 dt)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1405 (setq day (math-days-in-month (car dt) (nth 1 dt))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1406 (let ((zeroth (math-sub (math-floor date) (nth 2 dt))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1407 (math-sub (nth 1 (calcFunc-newweek (math-add zeroth day))) zeroth)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1408
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1409 (defun calcFunc-pwday (date &optional day weekday)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1410 (if (eq (car-safe date) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1411 (setq date (nth 1 date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1412 (or (math-realp date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1413 (math-reject-arg date 'datep))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1414 (if (math-messy-integerp day) (setq day (math-trunc day)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1415 (or (integerp day) (math-reject-arg day 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1416 (if (= day 0) (setq day 31))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1417 (and (or (< day 7) (> day 31)) (math-reject-arg day 'range))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1418 (math-prev-weekday-in-month date (math-date-to-dt date) day (or weekday 0)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1419
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1420
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1421 (defun calcFunc-newweek (date &optional weekday)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1422 (if (eq (car-safe date) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1423 (setq date (nth 1 date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1424 (or (math-realp date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1425 (math-reject-arg date 'datep))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1426 (or weekday (setq weekday 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1427 (and (math-messy-integerp weekday) (setq weekday (math-trunc weekday)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1428 (or (integerp weekday) (math-reject-arg weekday 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1429 (and (or (< weekday 0) (> weekday 6)) (math-reject-arg weekday 'range))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1430 (setq date (math-floor date))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1431 (list 'date (math-sub date (calcFunc-weekday (math-sub date weekday)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1432
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1433 (defun calcFunc-newmonth (date &optional day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1434 (or day (setq day 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1435 (and (math-messy-integerp day) (setq day (math-trunc day)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1436 (or (integerp day) (math-reject-arg day 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1437 (and (or (< day 0) (> day 31)) (math-reject-arg day 'range))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1438 (let ((dt (math-date-to-dt date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1439 (if (or (= day 0) (> day (math-days-in-month (car dt) (nth 1 dt))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1440 (setq day (math-days-in-month (car dt) (nth 1 dt))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1441 (and (eq (car dt) 1752) (= (nth 1 dt) 9)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1442 (if (>= day 14) (setq day (- day 11))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1443 (list 'date (math-add (math-dt-to-date (list (car dt) (nth 1 dt) 1))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1444 (1- day)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1445
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1446 (defun calcFunc-newyear (date &optional day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1447 (or day (setq day 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1448 (and (math-messy-integerp day) (setq day (math-trunc day)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1449 (or (integerp day) (math-reject-arg day 'fixnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1450 (let ((dt (math-date-to-dt date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1451 (if (and (>= day 0) (<= day 366))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1452 (let ((max (if (eq (car dt) 1752) 355
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1453 (if (math-leap-year-p (car dt)) 366 365))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1454 (if (or (= day 0) (> day max)) (setq day max))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1455 (list 'date (math-add (math-dt-to-date (list (car dt) 1 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1456 (1- day))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1457 (if (and (>= day -12) (<= day -1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1458 (list 'date (math-dt-to-date (list (car dt) (- day) 1)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1459 (math-reject-arg day 'range)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1460
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1461 (defun calcFunc-incmonth (date &optional step)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1462 (or step (setq step 1))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1463 (and (math-messy-integerp step) (setq step (math-trunc step)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1464 (or (math-integerp step) (math-reject-arg step 'integerp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1465 (let* ((dt (math-date-to-dt date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1466 (year (car dt))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1467 (month (math-add (1- (nth 1 dt)) step))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1468 (extra (calcFunc-idiv month 12))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1469 (day (nth 2 dt)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1470 (setq month (1+ (math-sub month (math-mul extra 12)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1471 year (math-add year extra)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1472 day (min day (math-days-in-month year month)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1473 (and (math-posp (car dt)) (not (math-posp year))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1474 (setq year (math-sub year 1))) ; did we go past the year zero?
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1475 (and (math-negp (car dt)) (not (math-negp year))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1476 (setq year (math-add year 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1477 (list 'date (math-dt-to-date
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1478 (cons year (cons month (cons day (cdr (cdr (cdr dt))))))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1479
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1480 (defun calcFunc-incyear (date &optional step)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1481 (calcFunc-incmonth date (math-mul (or step 1) 12)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1482
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1483
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1484
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1485 (defun calcFunc-bsub (a b)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1486 (or (eq (car-safe a) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1487 (math-reject-arg a 'datep))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1488 (if (eq (car-safe b) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1489 (if (math-lessp (nth 1 a) (nth 1 b))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1490 (math-neg (calcFunc-bsub b a))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1491 (math-setup-holidays b)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1492 (let* ((da (math-to-business-day a))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1493 (db (math-to-business-day b)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1494 (math-add (math-sub (car da) (car db))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1495 (if (and (cdr db) (not (cdr da))) 1 0))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1496 (calcFunc-badd a (math-neg b))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1497
41271
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
1498 (defvar math-holidays-cache nil)
fcd507927105 Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents: 41047
diff changeset
1499 (defvar math-holidays-cache-tag t)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1500 (defun calcFunc-badd (a b)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1501 (if (eq (car-safe b) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1502 (if (eq (car-safe a) 'date)
60908
7b8e42efa46a * calc/calc-forms.el, calc/calc-sel: Replace `illegal' with
Werner LEMBERG <wl@gnu.org>
parents: 58654
diff changeset
1503 (math-reject-arg nil "*Invalid combination in date arithmetic")
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1504 (calcFunc-badd b a))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1505 (if (eq (car-safe a) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1506 (if (Math-realp b)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1507 (if (Math-zerop b)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1508 a
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1509 (let* ((d (math-to-business-day a))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1510 (bb (math-add (car d)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1511 (if (and (cdr d) (Math-posp b))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1512 (math-sub b 1) b))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1513 (or (math-from-business-day bb)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1514 (calcFunc-badd a b))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1515 (if (eq (car-safe b) 'hms)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1516 (let ((hours (nth 7 math-holidays-cache)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1517 (setq b (math-div (math-from-hms b 'deg) 24))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1518 (if hours
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1519 (setq b (math-div b (cdr hours))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1520 (calcFunc-badd a b))
60908
7b8e42efa46a * calc/calc-forms.el, calc/calc-sel: Replace `illegal' with
Werner LEMBERG <wl@gnu.org>
parents: 58654
diff changeset
1521 (math-reject-arg nil "*Invalid combination in date arithmetic")))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1522 (math-reject-arg a 'datep))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1523
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1524 (defun calcFunc-holiday (a)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1525 (if (cdr (math-to-business-day a)) 1 0))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1526
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1527 ;;; Compute the number of business days since Jan 1, 1 AD.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1528
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1529 (defun math-to-business-day (date &optional need-year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1530 (if (eq (car-safe date) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1531 (setq date (nth 1 date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1532 (or (Math-realp date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1533 (math-reject-arg date 'datep))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1534 (let* ((day (math-floor date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1535 (time (math-sub date day))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1536 (dt (math-date-to-dt day))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1537 (delta 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1538 (holiday nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1539 (or (not need-year) (eq (car dt) need-year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1540 (math-reject-arg (list 'date day) "*Generated holiday has wrong year"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1541 (math-setup-holidays date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1542 (let ((days (car math-holidays-cache)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1543 (while (and (setq days (cdr days)) (< (car days) day))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1544 (setq delta (1+ delta)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1545 (and days (= day (car days))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1546 (setq holiday t)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1547 (let* ((weekdays (nth 3 math-holidays-cache))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1548 (weeks (1- (/ (+ day 6) 7)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1549 (wkday (- day 1 (* weeks 7))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1550 (setq delta (+ delta (* weeks (length weekdays))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1551 (while (and weekdays (< (car weekdays) wkday))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1552 (setq weekdays (cdr weekdays)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1553 delta (1+ delta)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1554 (and weekdays (eq wkday (car weekdays))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1555 (setq holiday t)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1556 (let ((hours (nth 7 math-holidays-cache)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1557 (if hours
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1558 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1559 (setq time (math-div (math-sub time (car hours)) (cdr hours)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1560 (if (Math-lessp time 0) (setq time 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1561 (or (Math-lessp time 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1562 (setq time
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1563 (math-sub 1
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1564 (math-div 1 (math-mul 86400 (cdr hours)))))))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1565 (cons (math-add (math-sub day delta) time) holiday)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1566
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1567
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1568 ;;; Compute the date a certain number of business days since Jan 1, 1 AD.
42206
0f4506820432 Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 41271
diff changeset
1569 ;;; If this returns nil, holiday table was adjusted; redo calculation.
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1570
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1571 (defun math-from-business-day (num)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1572 (let* ((day (math-floor num))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1573 (time (math-sub num day)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1574 (or (integerp day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1575 (math-reject-arg nil "*Date is outside valid range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1576 (math-setup-holidays)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1577 (let ((days (nth 1 math-holidays-cache))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1578 (delta 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1579 (while (and (setq days (cdr days)) (< (car days) day))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1580 (setq delta (1+ delta)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1581 (setq day (+ day delta)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1582 (let* ((weekdays (nth 3 math-holidays-cache))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1583 (bweek (- 7 (length weekdays)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1584 (weeks (1- (/ (+ day (1- bweek)) bweek)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1585 (wkday (- day 1 (* weeks bweek)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1586 (w 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1587 (setq day (+ day (* weeks (length weekdays))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1588 (while (if (memq w weekdays)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1589 (setq day (1+ day))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1590 (> (setq wkday (1- wkday)) 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1591 (setq w (1+ w)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1592 (let ((hours (nth 7 math-holidays-cache)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1593 (if hours
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1594 (setq time (math-add (math-mul time (cdr hours)) (car hours)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1595 (and (not (math-setup-holidays day))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1596 (list 'date (math-add day time))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1597
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1598 ;; The variable math-sh-year is local to math-setup-holidays
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1599 ;; and math-setup-year-holiday, but is used by math-setup-add-holidays,
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1600 ;; which is called by math-setup-holidays and math-setup-year-holiday.
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1601 (defvar math-sh-year)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1602
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1603 (defun math-setup-holidays (&optional date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1604 (or (eq (calc-var-value 'var-Holidays) math-holidays-cache-tag)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1605 (let ((h (calc-var-value 'var-Holidays))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1606 (wdnames '( (sun . 0) (mon . 1) (tue . 2) (wed . 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1607 (thu . 4) (fri . 5) (sat . 6) ))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1608 (days nil) (weekdays nil) (exprs nil) (limit nil) (hours nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1609 (or (math-vectorp h)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1610 (math-reject-arg h "*Holidays variable must be a vector"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1611 (while (setq h (cdr h))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1612 (cond ((or (and (eq (car-safe (car h)) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1613 (integerp (nth 1 (car h))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1614 (and (eq (car-safe (car h)) 'intv)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1615 (eq (car-safe (nth 2 (car h))) 'date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1616 (eq (car-safe (car h)) 'vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1617 (setq days (cons (car h) days)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1618 ((and (eq (car-safe (car h)) 'var)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1619 (assq (nth 1 (car h)) wdnames))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1620 (setq weekdays (cons (cdr (assq (nth 1 (car h)) wdnames))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1621 weekdays)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1622 ((and (eq (car-safe (car h)) 'intv)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1623 (eq (car-safe (nth 2 (car h))) 'hms)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1624 (eq (car-safe (nth 3 (car h))) 'hms))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1625 (if hours
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1626 (math-reject-arg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1627 (car h) "*Only one hours interval allowed in Holidays"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1628 (setq hours (math-div (car h) '(hms 24 0 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1629 (if (or (Math-lessp (nth 2 hours) 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1630 (Math-lessp 1 (nth 3 hours)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1631 (math-reject-arg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1632 (car h) "*Hours interval out of range"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1633 (setq hours (cons (nth 2 hours)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1634 (math-sub (nth 3 hours) (nth 2 hours))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1635 (if (Math-zerop (cdr hours))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1636 (math-reject-arg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1637 (car h) "*Degenerate hours interval")))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1638 ((or (and (eq (car-safe (car h)) 'intv)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1639 (Math-integerp (nth 2 (car h)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1640 (Math-integerp (nth 3 (car h))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1641 (and (integerp (car h))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1642 (> (car h) 1900) (< (car h) 2100)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1643 (if limit
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1644 (math-reject-arg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1645 (car h) "*Only one limit allowed in Holidays"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1646 (setq limit (calcFunc-vint (car h) '(intv 3 1 2737)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1647 (if (equal limit '(vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1648 (math-reject-arg (car h) "*Limit is out of range")))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1649 ((or (math-expr-contains (car h) '(var y var-y))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1650 (math-expr-contains (car h) '(var m var-m)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1651 (setq exprs (cons (car h) exprs)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1652 (t (math-reject-arg
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1653 (car h) "*Holidays must contain a vector of holidays"))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1654 (if (= (length weekdays) 7)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1655 (math-reject-arg nil "*Too many weekend days"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1656 (setq math-holidays-cache (list (list -1) ; 0: days list
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1657 (list -1) ; 1: inverse-days list
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1658 nil ; 2: exprs
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1659 (sort weekdays '<)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1660 (or limit '(intv 3 1 2737))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1661 nil ; 5: (lo.hi) expanded years
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1662 (cons exprs days)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1663 hours) ; 7: business hours
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1664 math-holidays-cache-tag (calc-var-value 'var-Holidays))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1665 (if date
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1666 (let ((year (calcFunc-year date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1667 (limits (nth 5 math-holidays-cache))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1668 (done nil))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1669 (or (eq (calcFunc-in year (nth 4 math-holidays-cache)) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1670 (progn
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1671 (or (eq (car-safe date) 'date) (setq date (list 'date date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1672 (math-reject-arg date "*Date is outside valid range")))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1673 (unwind-protect
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1674 (let ((days (nth 6 math-holidays-cache)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1675 (if days
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1676 (let ((math-sh-year nil)) ; see below
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1677 (setcar (nthcdr 6 math-holidays-cache) nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1678 (math-setup-add-holidays (cons 'vec (cdr days)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1679 (setcar (nthcdr 2 math-holidays-cache) (car days))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1680 (cond ((not (nth 2 math-holidays-cache))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1681 (setq done t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1682 nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1683 ((not limits)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1684 (setcar (nthcdr 5 math-holidays-cache) (cons year year))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1685 (math-setup-year-holidays year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1686 (setq done t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1687 ((< year (car limits))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1688 (message "Computing holidays, %d .. %d"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1689 year (1- (car limits)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1690 (calc-set-command-flag 'clear-message)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1691 (while (< year (car limits))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1692 (setcar limits (1- (car limits)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1693 (math-setup-year-holidays (car limits)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1694 (setq done t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1695 ((> year (cdr limits))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1696 (message "Computing holidays, %d .. %d"
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1697 (1+ (cdr limits)) year)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1698 (calc-set-command-flag 'clear-message)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1699 (while (> year (cdr limits))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1700 (setcdr limits (1+ (cdr limits)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1701 (math-setup-year-holidays (cdr limits)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1702 (setq done t))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1703 (t
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1704 (setq done t)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1705 nil)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1706 (or done (setq math-holidays-cache-tag t))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1707
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1708 (defun math-setup-year-holidays (math-sh-year)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1709 (let ((exprs (nth 2 math-holidays-cache)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1710 (while exprs
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1711 (let* ((var-y math-sh-year)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1712 (var-m nil)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1713 (expr (math-evaluate-expr (car exprs))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1714 (if (math-expr-contains expr '(var m var-m))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1715 (let ((var-m 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1716 (while (<= (setq var-m (1+ var-m)) 12)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1717 (math-setup-add-holidays (math-evaluate-expr expr))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1718 (math-setup-add-holidays expr)))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1719 (setq exprs (cdr exprs)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1720
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1721 (defun math-setup-add-holidays (days) ; uses "math-sh-year"
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1722 (cond ((eq (car-safe days) 'vec)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1723 (while (setq days (cdr days))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1724 (math-setup-add-holidays (car days))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1725 ((eq (car-safe days) 'intv)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1726 (let ((day (math-ceiling (nth 2 days))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1727 (or (eq (calcFunc-in day days) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1728 (setq day (math-add day 1)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1729 (while (eq (calcFunc-in day days) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1730 (math-setup-add-holidays day)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1731 (setq day (math-add day 1)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1732 ((eq (car-safe days) 'date)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1733 (math-setup-add-holidays (nth 1 days)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1734 ((eq days 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1735 ((integerp days)
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1736 (let ((b (math-to-business-day days math-sh-year)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1737 (or (cdr b) ; don't register holidays twice!
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1738 (let ((prev (car math-holidays-cache))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1739 (iprev (nth 1 math-holidays-cache)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1740 (while (and (cdr prev) (< (nth 1 prev) days))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1741 (setq prev (cdr prev) iprev (cdr iprev)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1742 (setcdr prev (cons days (cdr prev)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1743 (setcdr iprev (cons (car b) (cdr iprev)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1744 (while (setq iprev (cdr iprev))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1745 (setcar iprev (1- (car iprev))))))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1746 ((Math-realp days)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1747 (math-reject-arg (list 'date days) "*Invalid holiday value"))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1748 (t
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1749 (math-reject-arg days "*Holiday formula failed to evaluate"))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1750
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1751
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1752
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1753
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1754 ;;;; Error forms.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1755
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1756 ;;; Build a standard deviation form. [X X X]
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1757 (defun math-make-sdev (x sigma)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1758 (if (memq (car-safe x) '(date mod sdev intv vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1759 (math-reject-arg x 'realp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1760 (if (memq (car-safe sigma) '(date mod sdev intv vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1761 (math-reject-arg sigma 'realp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1762 (if (or (Math-negp sigma) (memq (car-safe sigma) '(cplx polar)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1763 (setq sigma (math-abs sigma)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1764 (if (and (Math-zerop sigma) (Math-scalarp x))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1765 x
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1766 (list 'sdev x sigma)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1767 (defun calcFunc-sdev (x sigma)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1768 (math-make-sdev x sigma))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1769
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1770
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1771
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1772 ;;;; Modulo forms.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1773
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1774 (defun math-normalize-mod (a)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1775 (let ((n (math-normalize (nth 1 a)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1776 (m (math-normalize (nth 2 a))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1777 (if (and (math-anglep n) (math-anglep m) (math-posp m))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1778 (math-make-mod n m)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1779 (math-normalize (list 'calcFunc-makemod n m)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1780
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1781 ;;; Build a modulo form. [N R R]
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1782 (defun math-make-mod (n m)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1783 (setq calc-previous-modulo m)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1784 (and n
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1785 (cond ((not (Math-anglep m))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1786 (math-reject-arg m 'anglep))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1787 ((not (math-posp m))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1788 (math-reject-arg m 'posp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1789 ((Math-anglep n)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1790 (if (or (Math-negp n)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1791 (not (Math-lessp n m)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1792 (list 'mod (math-mod n m) m)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1793 (list 'mod n m)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1794 ((memq (car n) '(+ - / vec neg))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1795 (math-normalize
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1796 (cons (car n)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1797 (mapcar (function (lambda (x) (math-make-mod x m)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1798 (cdr n)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1799 ((and (eq (car n) '*) (Math-anglep (nth 1 n)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1800 (math-mul (math-make-mod (nth 1 n) m) (nth 2 n)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1801 ((memq (car n) '(* ^ var calcFunc-subscr))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1802 (math-mul (math-make-mod 1 m) n))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1803 (t (math-reject-arg n 'anglep)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1804 (defun calcFunc-makemod (n m)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1805 (math-make-mod n m))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1806
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1807
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1808
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1809 ;;;; Interval forms.
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1810
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1811 ;;; Build an interval form. [X S X X]
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1812 (defun math-make-intv (mask lo hi)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1813 (if (memq (car-safe lo) '(cplx polar mod sdev intv vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1814 (math-reject-arg lo 'realp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1815 (if (memq (car-safe hi) '(cplx polar mod sdev intv vec))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1816 (math-reject-arg hi 'realp))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1817 (or (eq (eq (car-safe lo) 'date) (eq (car-safe hi) 'date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1818 (math-reject-arg (if (eq (car-safe lo) 'date) hi lo) 'datep))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1819 (if (and (or (Math-realp lo) (eq (car lo) 'date))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1820 (or (Math-realp hi) (eq (car hi) 'date)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1821 (let ((cmp (math-compare lo hi)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1822 (if (= cmp 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1823 (if (= mask 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1824 lo
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1825 (list 'intv mask lo hi))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1826 (if (> cmp 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1827 (if (= mask 3)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1828 (list 'intv 2 lo lo)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1829 (list 'intv mask lo lo))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1830 (list 'intv mask lo hi))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1831 (list 'intv mask lo hi)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1832 (defun calcFunc-intv (mask lo hi)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1833 (if (math-messy-integerp mask) (setq mask (math-trunc mask)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1834 (or (natnump mask) (math-reject-arg mask 'fixnatnump))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1835 (or (<= mask 3) (math-reject-arg mask 'range))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1836 (math-make-intv mask lo hi))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1837
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1838 (defun math-sort-intv (mask lo hi)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1839 (if (Math-lessp hi lo)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1840 (math-make-intv (aref [0 2 1 3] mask) hi lo)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1841 (math-make-intv mask lo hi)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1842
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1843
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1844
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1845
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1846 (defun math-combine-intervals (a am b bm c cm d dm)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1847 (let (res)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1848 (if (= (setq res (math-compare a c)) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1849 (setq a c am cm)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1850 (if (= res 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1851 (setq am (or am cm))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1852 (if (= (setq res (math-compare b d)) -1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1853 (setq b d bm dm)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1854 (if (= res 0)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1855 (setq bm (or bm dm))))
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1856 (math-make-intv (+ (if am 2 0) (if bm 1 0)) a b)))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1857
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1858
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1859 (defun math-div-mod (a b m) ; [R R R R] (Returns nil if no solution)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1860 (and (Math-integerp a) (Math-integerp b) (Math-integerp m)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1861 (let ((u1 1) (u3 b) (v1 0) (v3 m))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1862 (while (not (eq v3 0)) ; See Knuth sec 4.5.2, exercise 15
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1863 (let* ((q (math-idivmod u3 v3))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1864 (t1 (math-sub u1 (math-mul v1 (car q)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1865 (setq u1 v1 u3 v3 v1 t1 v3 (cdr q))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1866 (let ((q (math-idivmod a u3)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1867 (and (eq (cdr q) 0)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1868 (math-mod (math-mul (car q) u1) m))))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1869
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1870 (defun math-mod-intv (a b)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1871 (let* ((q1 (math-floor (math-div (nth 2 a) b)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1872 (q2 (math-floor (math-div (nth 3 a) b)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1873 (m1 (math-sub (nth 2 a) (math-mul q1 b)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1874 (m2 (math-sub (nth 3 a) (math-mul q2 b))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1875 (cond ((equal q1 q2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1876 (math-sort-intv (nth 1 a) m1 m2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1877 ((and (math-equal-int (math-sub q2 q1) 1)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1878 (math-zerop m2)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1879 (memq (nth 1 a) '(0 2)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1880 (math-make-intv (nth 1 a) m1 b))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1881 (t
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1882 (math-make-intv 2 0 b)))))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1883
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1884 ;; The variables math-exp-str and math-exp-pos are local to
76569
a5ca6723c3b1 (math-std-daylight-savings)
Kim F. Storm <storm@cua.dk>
parents: 76554
diff changeset
1885 ;; math-read-exprs in math-aent.el, but are used by
58474
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1886 ;; math-read-angle-brackets, which is called (indirectly) by
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1887 ;; math-read-exprs.
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1888 (defvar math-exp-str)
142d1806f768 (math-fd-date, math-fd-dt, math-fd-year, math-fd-month)
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58133
diff changeset
1889 (defvar math-exp-pos)
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1890
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1891 (defun math-read-angle-brackets ()
58133
e40a74166300 (math-read-angle-bracket): Use declared variables math-exp-pos,
Jay Belanger <jay.p.belanger@gmail.com>
parents: 53868
diff changeset
1892 (let* ((last (or (math-check-for-commas t) (length math-exp-str)))
e40a74166300 (math-read-angle-bracket): Use declared variables math-exp-pos,
Jay Belanger <jay.p.belanger@gmail.com>
parents: 53868
diff changeset
1893 (str (substring math-exp-str math-exp-pos last))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1894 (res
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1895 (if (string-match "\\` *\\([a-zA-Z#][a-zA-Z0-9#]* *,? *\\)*:" str)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1896 (let ((str1 (substring str 0 (1- (match-end 0))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1897 (str2 (substring str (match-end 0)))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1898 (calc-hashes-used 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1899 (setq str1 (math-read-expr (concat "[" str1 "]")))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1900 (if (eq (car-safe str1) 'error)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1901 str1
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1902 (setq str2 (math-read-expr str2))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1903 (if (eq (car-safe str2) 'error)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1904 str2
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1905 (append '(calcFunc-lambda) (cdr str1) (list str2)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1906 (if (string-match "#" str)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1907 (let ((calc-hashes-used 0))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1908 (and (setq str (math-read-expr str))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1909 (if (eq (car-safe str) 'error)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1910 str
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1911 (append '(calcFunc-lambda)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1912 (calc-invent-args calc-hashes-used)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1913 (list str)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1914 (math-parse-date str)))))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1915 (if (stringp res)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1916 (throw 'syntax res))
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1917 (if (eq (car-safe res) 'error)
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1918 (throw 'syntax (nth 2 res)))
58133
e40a74166300 (math-read-angle-bracket): Use declared variables math-exp-pos,
Jay Belanger <jay.p.belanger@gmail.com>
parents: 53868
diff changeset
1919 (setq math-exp-pos (1+ last))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1920 (math-read-token)
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1921 res))
40785
2fb9d407ae73 Initial import of Calc 2.02f.
Eli Zaretskii <eliz@gnu.org>
parents:
diff changeset
1922
58654
bd70627265a0 Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58474
diff changeset
1923 (provide 'calc-forms)
bd70627265a0 Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents: 58474
diff changeset
1924
93975
1e3a407766b9 Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 87649
diff changeset
1925 ;; arch-tag: a3d8f33b-9508-4043-8060-d02b8c9c750c
41047
73f364fd8aaa Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents: 40785
diff changeset
1926 ;;; calc-forms.el ends here