41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
1 ;;; calc-incom.el --- complex data type input functions for Calc
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
2
|
|
62442
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2005 Free Software Foundation, Inc.
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
4
|
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
5 ;; Author: David Gillespie <daveg@synaptics.com>
|
58550
938592e66a8e
(calc-prev-char, calc-prev-prev-char, calc-digit-value): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
6 ;; Maintainer: Jay Belanger <belanger@truman.edu>
|
|
40785
|
7
|
|
|
8 ;; This file is part of GNU Emacs.
|
|
|
9
|
|
|
10 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
11 ;; but WITHOUT ANY WARRANTY. No author or distributor
|
|
|
12 ;; accepts responsibility to anyone for the consequences of using it
|
|
|
13 ;; or for whether it serves any particular purpose or works at all,
|
|
|
14 ;; unless he says so in writing. Refer to the GNU Emacs General Public
|
|
|
15 ;; License for full details.
|
|
|
16
|
|
|
17 ;; Everyone is granted permission to copy, modify and redistribute
|
|
|
18 ;; GNU Emacs, but only under the conditions described in the
|
|
|
19 ;; GNU Emacs General Public License. A copy of this license is
|
|
|
20 ;; supposed to have been given to you along with GNU Emacs so you
|
|
|
21 ;; can know your rights and responsibilities. It should be in a
|
|
|
22 ;; file named COPYING. Among other things, the copyright notice
|
|
|
23 ;; and this notice must be preserved on all copies.
|
|
|
24
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
25 ;;; Commentary:
|
|
40785
|
26
|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
diff
changeset
|
27 ;;; Code:
|
|
40785
|
28
|
|
|
29 ;; This file is autoloaded from calc-ext.el.
|
|
58659
|
30
|
|
40785
|
31 (require 'calc-ext)
|
|
|
32 (require 'calc-macs)
|
|
|
33
|
|
|
34 ;;; Incomplete forms.
|
|
|
35
|
|
|
36 (defun calc-begin-complex ()
|
|
|
37 (interactive)
|
|
|
38 (calc-wrapper
|
|
|
39 (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
|
|
|
40 (calc-alg-entry "(")
|
|
41047
|
41 (calc-push (list 'incomplete calc-complex-mode)))))
|
|
40785
|
42
|
|
|
43 (defun calc-end-complex ()
|
|
|
44 (interactive)
|
|
|
45 (calc-comma t)
|
|
|
46 (calc-wrapper
|
|
|
47 (let ((top (calc-top 1)))
|
|
|
48 (if (and (eq (car-safe top) 'incomplete)
|
|
|
49 (eq (nth 1 top) 'intv))
|
|
|
50 (progn
|
|
|
51 (if (< (length top) 4)
|
|
|
52 (setq top (append top '((neg (var inf var-inf))))))
|
|
|
53 (if (< (length top) 5)
|
|
|
54 (setq top (append top '((var inf var-inf)))))
|
|
|
55 (calc-enter-result 1 "..)" (cdr top)))
|
|
|
56 (if (not (and (eq (car-safe top) 'incomplete)
|
|
|
57 (memq (nth 1 top) '(cplx polar))))
|
|
|
58 (error "Not entering a complex number"))
|
|
|
59 (while (< (length top) 4)
|
|
|
60 (setq top (append top '(0))))
|
|
|
61 (if (not (and (math-realp (nth 2 top))
|
|
|
62 (math-anglep (nth 3 top))))
|
|
|
63 (error "Components must be real"))
|
|
41047
|
64 (calc-enter-result 1 "()" (cdr top))))))
|
|
40785
|
65
|
|
|
66 (defun calc-begin-vector ()
|
|
|
67 (interactive)
|
|
|
68 (calc-wrapper
|
|
|
69 (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
|
|
|
70 (calc-alg-entry "[")
|
|
41047
|
71 (calc-push '(incomplete vec)))))
|
|
40785
|
72
|
|
|
73 (defun calc-end-vector ()
|
|
|
74 (interactive)
|
|
|
75 (calc-comma t)
|
|
|
76 (calc-wrapper
|
|
|
77 (let ((top (calc-top 1)))
|
|
|
78 (if (and (eq (car-safe top) 'incomplete)
|
|
|
79 (eq (nth 1 top) 'intv))
|
|
|
80 (progn
|
|
|
81 (if (< (length top) 4)
|
|
|
82 (setq top (append top '((neg (var inf var-inf))))))
|
|
|
83 (if (< (length top) 5)
|
|
|
84 (setq top (append top '((var inf var-inf)))))
|
|
|
85 (setcar (cdr (cdr top)) (1+ (nth 2 top)))
|
|
|
86 (calc-enter-result 1 "..]" (cdr top)))
|
|
|
87 (if (not (and (eq (car-safe top) 'incomplete)
|
|
|
88 (eq (nth 1 top) 'vec)))
|
|
|
89 (error "Not entering a vector"))
|
|
41047
|
90 (calc-pop-push-record 1 "[]" (cdr top))))))
|
|
40785
|
91
|
|
|
92 (defun calc-comma (&optional allow-polar)
|
|
|
93 (interactive)
|
|
|
94 (calc-wrapper
|
|
|
95 (let ((num (calc-find-first-incomplete
|
|
|
96 (nthcdr calc-stack-top calc-stack) 1)))
|
|
|
97 (if (= num 0)
|
|
|
98 (error "Not entering a vector or complex number"))
|
|
|
99 (let* ((inc (calc-top num))
|
|
|
100 (stuff (calc-top-list (1- num)))
|
|
|
101 (new (append inc stuff)))
|
|
|
102 (if (and (null stuff)
|
|
|
103 (not allow-polar)
|
|
|
104 (or (eq (nth 1 inc) 'vec)
|
|
|
105 (< (length new) 4)))
|
|
|
106 (setq new (append new
|
|
|
107 (if (= (length new) 2)
|
|
|
108 '(0)
|
|
|
109 (nthcdr (1- (length new)) new)))))
|
|
|
110 (or allow-polar
|
|
|
111 (if (eq (nth 1 new) 'polar)
|
|
|
112 (setq new (append '(incomplete cplx) (cdr (cdr new))))
|
|
|
113 (if (eq (nth 1 new) 'intv)
|
|
|
114 (setq new (append '(incomplete cplx)
|
|
|
115 (cdr (cdr (cdr new))))))))
|
|
|
116 (if (and (memq (nth 1 new) '(cplx polar))
|
|
|
117 (> (length new) 4))
|
|
|
118 (error "Too many components in complex number"))
|
|
|
119 (if (and (eq (nth 1 new) 'intv)
|
|
|
120 (> (length new) 5))
|
|
|
121 (error "Too many components in interval form"))
|
|
41047
|
122 (calc-pop-push num new)))))
|
|
40785
|
123
|
|
|
124 (defun calc-semi ()
|
|
|
125 (interactive)
|
|
|
126 (calc-wrapper
|
|
|
127 (let ((num (calc-find-first-incomplete
|
|
|
128 (nthcdr calc-stack-top calc-stack) 1)))
|
|
|
129 (if (= num 0)
|
|
|
130 (error "Not entering a vector or complex number"))
|
|
|
131 (let ((inc (calc-top num))
|
|
|
132 (stuff (calc-top-list (1- num))))
|
|
|
133 (if (eq (nth 1 inc) 'cplx)
|
|
|
134 (setq inc (append '(incomplete polar) (cdr (cdr inc))))
|
|
|
135 (if (eq (nth 1 inc) 'intv)
|
|
|
136 (setq inc (append '(incomplete polar) (cdr (cdr (cdr inc)))))))
|
|
|
137 (cond ((eq (nth 1 inc) 'polar)
|
|
|
138 (let ((new (append inc stuff)))
|
|
|
139 (if (> (length new) 4)
|
|
|
140 (error "Too many components in complex number")
|
|
|
141 (if (= (length new) 2)
|
|
|
142 (setq new (append new '(1)))))
|
|
|
143 (calc-pop-push num new)))
|
|
|
144 ((null stuff)
|
|
|
145 (if (> (length inc) 2)
|
|
|
146 (if (math-vectorp (nth 2 inc))
|
|
|
147 (calc-comma)
|
|
|
148 (calc-pop-push 1
|
|
|
149 (list 'incomplete 'vec (cdr (cdr inc)))
|
|
|
150 (list 'incomplete 'vec)))))
|
|
|
151 ((math-vectorp (car stuff))
|
|
|
152 (calc-comma))
|
|
|
153 ((eq (car-safe (car-safe (nth (+ num calc-stack-top)
|
|
|
154 calc-stack))) 'incomplete)
|
|
|
155 (calc-end-vector)
|
|
|
156 (calc-comma)
|
|
|
157 (let ((calc-algebraic-mode nil)
|
|
|
158 (calc-incomplete-algebraic-mode nil))
|
|
|
159 (calc-begin-vector)))
|
|
|
160 ((or (= (length inc) 2)
|
|
|
161 (math-vectorp (nth 2 inc)))
|
|
|
162 (calc-pop-push num
|
|
|
163 (append inc (list (cons 'vec stuff)))
|
|
|
164 (list 'incomplete 'vec)))
|
|
|
165 (t
|
|
|
166 (calc-pop-push num
|
|
|
167 (list 'incomplete 'vec
|
|
|
168 (cons 'vec (append (cdr (cdr inc)) stuff)))
|
|
41047
|
169 (list 'incomplete 'vec))))))))
|
|
40785
|
170
|
58550
938592e66a8e
(calc-prev-char, calc-prev-prev-char, calc-digit-value): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
171 ;; The following variables are initially declared in calc.el,
|
938592e66a8e
(calc-prev-char, calc-prev-prev-char, calc-digit-value): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
172 ;; but are used by calc-digit-dots.
|
938592e66a8e
(calc-prev-char, calc-prev-prev-char, calc-digit-value): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
173 (defvar calc-prev-char)
|
938592e66a8e
(calc-prev-char, calc-prev-prev-char, calc-digit-value): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
174 (defvar calc-prev-prev-char)
|
938592e66a8e
(calc-prev-char, calc-prev-prev-char, calc-digit-value): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
175 (defvar calc-digit-value)
|
938592e66a8e
(calc-prev-char, calc-prev-prev-char, calc-digit-value): Declare them.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
176
|
|
40785
|
177 (defun calc-digit-dots ()
|
|
|
178 (if (eq calc-prev-char ?.)
|
|
|
179 (progn
|
|
|
180 (delete-backward-char 1)
|
|
|
181 (if (calc-minibuffer-contains ".*\\.\\'")
|
|
|
182 (delete-backward-char 1))
|
|
|
183 (setq calc-prev-char 'dots
|
|
|
184 last-command-char 32)
|
|
|
185 (if calc-prev-prev-char
|
|
|
186 (calcDigit-nondigit)
|
|
|
187 (setq calc-digit-value nil)
|
57691
8dc3dd828d67
(calc-digit-dots): Inhibit read-only before erasing minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
188 (let ((inhibit-read-only t))
|
8dc3dd828d67
(calc-digit-dots): Inhibit read-only before erasing minibuffer.
Jay Belanger <jay.p.belanger@gmail.com>
diff
changeset
|
189 (erase-buffer))
|
|
40785
|
190 (exit-minibuffer)))
|
|
|
191 ;; just ignore extra decimal point, anticipating ".."
|
|
41047
|
192 (delete-backward-char 1)))
|
|
40785
|
193
|
|
|
194 (defun calc-dots ()
|
|
|
195 (interactive)
|
|
|
196 (calc-wrapper
|
|
|
197 (let ((num (calc-find-first-incomplete
|
|
|
198 (nthcdr calc-stack-top calc-stack) 1)))
|
|
|
199 (if (= num 0)
|
|
|
200 (error "Not entering an interval form"))
|
|
|
201 (let* ((inc (calc-top num))
|
|
|
202 (stuff (calc-top-list (1- num)))
|
|
|
203 (new (append inc stuff)))
|
|
|
204 (if (not (eq (nth 1 new) 'intv))
|
|
|
205 (setq new (append '(incomplete intv)
|
|
|
206 (if (eq (nth 1 new) 'vec) '(2) '(0))
|
|
|
207 (cdr (cdr new)))))
|
|
|
208 (if (and (null stuff)
|
|
|
209 (= (length new) 3))
|
|
|
210 (setq new (append new '((neg (var inf var-inf))))))
|
|
|
211 (if (> (length new) 5)
|
|
|
212 (error "Too many components in interval form"))
|
|
41047
|
213 (calc-pop-push num new)))))
|
|
40785
|
214
|
|
|
215 (defun calc-find-first-incomplete (stack n)
|
|
|
216 (cond ((null stack)
|
|
|
217 0)
|
|
|
218 ((eq (car-safe (car-safe (car stack))) 'incomplete)
|
|
|
219 n)
|
|
|
220 (t
|
|
41047
|
221 (calc-find-first-incomplete (cdr stack) (1+ n)))))
|
|
40785
|
222
|
|
|
223 (defun calc-incomplete-error (a)
|
|
|
224 (cond ((memq (nth 1 a) '(cplx polar))
|
|
|
225 (error "Complex number is incomplete"))
|
|
|
226 ((eq (nth 1 a) 'vec)
|
|
|
227 (error "Vector is incomplete"))
|
|
|
228 ((eq (nth 1 a) 'intv)
|
|
|
229 (error "Interval form is incomplete"))
|
|
41047
|
230 (t (error "Object is incomplete"))))
|
|
40785
|
231
|
|
58659
|
232 (provide 'calc-incom)
|
|
|
233
|
|
52401
|
234 ;;; arch-tag: b8001270-4dc7-481b-a3e3-a952e19b390d
|
|
41047
|
235 ;;; calc-incom.el ends here
|
