1 ;;; calc-incom.el --- complex data type input functions for Calc
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Jay Belanger <belanger@truman.edu>
8 ;; This file is part of GNU Emacs.
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.
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.
29 ;; This file is autoloaded from calc-ext.el.
34 (defun calc-Need-calc-incom () nil)
39 (defun calc-begin-complex ()
42 (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
44 (calc-push (list 'incomplete calc-complex-mode)))))
46 (defun calc-end-complex ()
50 (let ((top (calc-top 1)))
51 (if (and (eq (car-safe top) 'incomplete)
52 (eq (nth 1 top) 'intv))
54 (if (< (length top) 4)
55 (setq top (append top '((neg (var inf var-inf))))))
56 (if (< (length top) 5)
57 (setq top (append top '((var inf var-inf)))))
58 (calc-enter-result 1 "..)" (cdr top)))
59 (if (not (and (eq (car-safe top) 'incomplete)
60 (memq (nth 1 top) '(cplx polar))))
61 (error "Not entering a complex number"))
62 (while (< (length top) 4)
63 (setq top (append top '(0))))
64 (if (not (and (math-realp (nth 2 top))
65 (math-anglep (nth 3 top))))
66 (error "Components must be real"))
67 (calc-enter-result 1 "()" (cdr top))))))
69 (defun calc-begin-vector ()
72 (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
74 (calc-push '(incomplete vec)))))
76 (defun calc-end-vector ()
80 (let ((top (calc-top 1)))
81 (if (and (eq (car-safe top) 'incomplete)
82 (eq (nth 1 top) 'intv))
84 (if (< (length top) 4)
85 (setq top (append top '((neg (var inf var-inf))))))
86 (if (< (length top) 5)
87 (setq top (append top '((var inf var-inf)))))
88 (setcar (cdr (cdr top)) (1+ (nth 2 top)))
89 (calc-enter-result 1 "..]" (cdr top)))
90 (if (not (and (eq (car-safe top) 'incomplete)
91 (eq (nth 1 top) 'vec)))
92 (error "Not entering a vector"))
93 (calc-pop-push-record 1 "[]" (cdr top))))))
95 (defun calc-comma (&optional allow-polar)
98 (let ((num (calc-find-first-incomplete
99 (nthcdr calc-stack-top calc-stack) 1)))
101 (error "Not entering a vector or complex number"))
102 (let* ((inc (calc-top num))
103 (stuff (calc-top-list (1- num)))
104 (new (append inc stuff)))
105 (if (and (null stuff)
107 (or (eq (nth 1 inc) 'vec)
109 (setq new (append new
110 (if (= (length new) 2)
112 (nthcdr (1- (length new)) new)))))
114 (if (eq (nth 1 new) 'polar)
115 (setq new (append '(incomplete cplx) (cdr (cdr new))))
116 (if (eq (nth 1 new) 'intv)
117 (setq new (append '(incomplete cplx)
118 (cdr (cdr (cdr new))))))))
119 (if (and (memq (nth 1 new) '(cplx polar))
121 (error "Too many components in complex number"))
122 (if (and (eq (nth 1 new) 'intv)
124 (error "Too many components in interval form"))
125 (calc-pop-push num new)))))
130 (let ((num (calc-find-first-incomplete
131 (nthcdr calc-stack-top calc-stack) 1)))
133 (error "Not entering a vector or complex number"))
134 (let ((inc (calc-top num))
135 (stuff (calc-top-list (1- num))))
136 (if (eq (nth 1 inc) 'cplx)
137 (setq inc (append '(incomplete polar) (cdr (cdr inc))))
138 (if (eq (nth 1 inc) 'intv)
139 (setq inc (append '(incomplete polar) (cdr (cdr (cdr inc)))))))
140 (cond ((eq (nth 1 inc) 'polar)
141 (let ((new (append inc stuff)))
142 (if (> (length new) 4)
143 (error "Too many components in complex number")
144 (if (= (length new) 2)
145 (setq new (append new '(1)))))
146 (calc-pop-push num new)))
148 (if (> (length inc) 2)
149 (if (math-vectorp (nth 2 inc))
152 (list 'incomplete 'vec (cdr (cdr inc)))
153 (list 'incomplete 'vec)))))
154 ((math-vectorp (car stuff))
156 ((eq (car-safe (car-safe (nth (+ num calc-stack-top)
157 calc-stack))) 'incomplete)
160 (let ((calc-algebraic-mode nil)
161 (calc-incomplete-algebraic-mode nil))
162 (calc-begin-vector)))
163 ((or (= (length inc) 2)
164 (math-vectorp (nth 2 inc)))
166 (append inc (list (cons 'vec stuff)))
167 (list 'incomplete 'vec)))
170 (list 'incomplete 'vec
171 (cons 'vec (append (cdr (cdr inc)) stuff)))
172 (list 'incomplete 'vec))))))))
174 ;; The following variables are initially declared in calc.el,
175 ;; but are used by calc-digit-dots.
176 (defvar calc-prev-char)
177 (defvar calc-prev-prev-char)
178 (defvar calc-digit-value)
180 (defun calc-digit-dots ()
181 (if (eq calc-prev-char ?.)
183 (delete-backward-char 1)
184 (if (calc-minibuffer-contains ".*\\.\\'")
185 (delete-backward-char 1))
186 (setq calc-prev-char 'dots
187 last-command-char 32)
188 (if calc-prev-prev-char
190 (setq calc-digit-value nil)
191 (let ((inhibit-read-only t))
194 ;; just ignore extra decimal point, anticipating ".."
195 (delete-backward-char 1)))
200 (let ((num (calc-find-first-incomplete
201 (nthcdr calc-stack-top calc-stack) 1)))
203 (error "Not entering an interval form"))
204 (let* ((inc (calc-top num))
205 (stuff (calc-top-list (1- num)))
206 (new (append inc stuff)))
207 (if (not (eq (nth 1 new) 'intv))
208 (setq new (append '(incomplete intv)
209 (if (eq (nth 1 new) 'vec) '(2) '(0))
211 (if (and (null stuff)
213 (setq new (append new '((neg (var inf var-inf))))))
214 (if (> (length new) 5)
215 (error "Too many components in interval form"))
216 (calc-pop-push num new)))))
218 (defun calc-find-first-incomplete (stack n)
221 ((eq (car-safe (car-safe (car stack))) 'incomplete)
224 (calc-find-first-incomplete (cdr stack) (1+ n)))))
226 (defun calc-incomplete-error (a)
227 (cond ((memq (nth 1 a) '(cplx polar))
228 (error "Complex number is incomplete"))
230 (error "Vector is incomplete"))
231 ((eq (nth 1 a) 'intv)
232 (error "Interval form is incomplete"))
233 (t (error "Object is incomplete"))))
235 ;;; arch-tag: b8001270-4dc7-481b-a3e3-a952e19b390d
236 ;;; calc-incom.el ends here