1;;; calc-incom.el --- complex data type input functions for Calc
2
3;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
4;;   2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Author: David Gillespie <daveg@synaptics.com>
7;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;;; Code:
29
30;; This file is autoloaded from calc-ext.el.
31
32(require 'calc-ext)
33(require 'calc-macs)
34
35;;; Incomplete forms.
36
37(defun calc-begin-complex ()
38  (interactive)
39  (calc-wrapper
40   (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
41       (calc-alg-entry "(")
42     (calc-push (list 'incomplete calc-complex-mode)))))
43
44(defun calc-end-complex ()
45  (interactive)
46  (calc-comma t)
47  (calc-wrapper
48   (let ((top (calc-top 1)))
49     (if (and (eq (car-safe top) 'incomplete)
50	      (eq (nth 1 top) 'intv))
51	 (progn
52	   (if (< (length top) 4)
53	       (setq top (append top '((neg (var inf var-inf))))))
54	   (if (< (length top) 5)
55	       (setq top (append top '((var inf var-inf)))))
56	   (calc-enter-result 1 "..)" (cdr top)))
57       (if (not (and (eq (car-safe top) 'incomplete)
58		     (memq (nth 1 top) '(cplx polar))))
59	   (error "Not entering a complex number"))
60       (while (< (length top) 4)
61	 (setq top (append top '(0))))
62       (if (not (and (math-realp (nth 2 top))
63		     (math-anglep (nth 3 top))))
64	   (error "Components must be real"))
65       (calc-enter-result 1 "()" (cdr top))))))
66
67(defun calc-begin-vector ()
68  (interactive)
69  (calc-wrapper
70   (if (or calc-algebraic-mode calc-incomplete-algebraic-mode)
71       (calc-alg-entry "[")
72     (calc-push '(incomplete vec)))))
73
74(defun calc-end-vector ()
75  (interactive)
76  (calc-comma t)
77  (calc-wrapper
78   (let ((top (calc-top 1)))
79     (if (and (eq (car-safe top) 'incomplete)
80	      (eq (nth 1 top) 'intv))
81	 (progn
82	   (if (< (length top) 4)
83	       (setq top (append top '((neg (var inf var-inf))))))
84	   (if (< (length top) 5)
85	       (setq top (append top '((var inf var-inf)))))
86	   (setcar (cdr (cdr top)) (1+ (nth 2 top)))
87	   (calc-enter-result 1 "..]" (cdr top)))
88       (if (not (and (eq (car-safe top) 'incomplete)
89		     (eq (nth 1 top) 'vec)))
90	   (error "Not entering a vector"))
91       (calc-pop-push-record 1 "[]" (cdr top))))))
92
93(defun calc-comma (&optional allow-polar)
94  (interactive)
95  (calc-wrapper
96   (let ((num (calc-find-first-incomplete
97	       (nthcdr calc-stack-top calc-stack) 1)))
98     (if (= num 0)
99	 (error "Not entering a vector or complex number"))
100     (let* ((inc (calc-top num))
101	    (stuff (calc-top-list (1- num)))
102	    (new (append inc stuff)))
103       (if (and (null stuff)
104		(not allow-polar)
105		(or (eq (nth 1 inc) 'vec)
106		    (< (length new) 4)))
107	   (setq new (append new
108			     (if (= (length new) 2)
109				 '(0)
110			       (nthcdr (1- (length new)) new)))))
111       (or allow-polar
112	   (if (eq (nth 1 new) 'polar)
113	       (setq new (append '(incomplete cplx) (cdr (cdr new))))
114	     (if (eq (nth 1 new) 'intv)
115		 (setq new (append '(incomplete cplx)
116				   (cdr (cdr (cdr new))))))))
117       (if (and (memq (nth 1 new) '(cplx polar))
118		(> (length new) 4))
119	   (error "Too many components in complex number"))
120       (if (and (eq (nth 1 new) 'intv)
121		(> (length new) 5))
122	   (error "Too many components in interval form"))
123       (calc-pop-push num new)))))
124
125(defun calc-semi ()
126  (interactive)
127  (calc-wrapper
128   (let ((num (calc-find-first-incomplete
129	       (nthcdr calc-stack-top calc-stack) 1)))
130     (if (= num 0)
131	 (error "Not entering a vector or complex number"))
132     (let ((inc (calc-top num))
133	   (stuff (calc-top-list (1- num))))
134       (if (eq (nth 1 inc) 'cplx)
135	   (setq inc (append '(incomplete polar) (cdr (cdr inc))))
136	 (if (eq (nth 1 inc) 'intv)
137	     (setq inc (append '(incomplete polar) (cdr (cdr (cdr inc)))))))
138       (cond ((eq (nth 1 inc) 'polar)
139	      (let ((new (append inc stuff)))
140		(if (> (length new) 4)
141		    (error "Too many components in complex number")
142		  (if (= (length new) 2)
143		      (setq new (append new '(1)))))
144		(calc-pop-push num new)))
145	     ((null stuff)
146	      (if (> (length inc) 2)
147		  (if (math-vectorp (nth 2 inc))
148		      (calc-comma)
149		    (calc-pop-push 1
150				   (list 'incomplete 'vec (cdr (cdr inc)))
151				   (list 'incomplete 'vec)))))
152	     ((math-vectorp (car stuff))
153	      (calc-comma))
154	     ((eq (car-safe (car-safe (nth (+ num calc-stack-top)
155					   calc-stack))) 'incomplete)
156	      (calc-end-vector)
157	      (calc-comma)
158	      (let ((calc-algebraic-mode nil)
159		    (calc-incomplete-algebraic-mode nil))
160		(calc-begin-vector)))
161	     ((or (= (length inc) 2)
162		  (math-vectorp (nth 2 inc)))
163	      (calc-pop-push num
164			     (append inc (list (cons 'vec stuff)))
165			     (list 'incomplete 'vec)))
166	     (t
167	      (calc-pop-push num
168			     (list 'incomplete 'vec
169				   (cons 'vec (append (cdr (cdr inc)) stuff)))
170			     (list 'incomplete 'vec))))))))
171
172;; The following variables are initially declared in calc.el,
173;; but are used by calc-digit-dots.
174(defvar calc-prev-char)
175(defvar calc-prev-prev-char)
176(defvar calc-digit-value)
177
178(defun calc-digit-dots ()
179  (if (eq calc-prev-char ?.)
180      (progn
181	(delete-backward-char 1)
182	(if (calc-minibuffer-contains ".*\\.\\'")
183	    (delete-backward-char 1))
184	(setq calc-prev-char 'dots
185	      last-command-char 32)
186	(if calc-prev-prev-char
187	    (calcDigit-nondigit)
188	  (setq calc-digit-value nil)
189          (let ((inhibit-read-only t))
190            (erase-buffer))
191	  (exit-minibuffer)))
192    ;; just ignore extra decimal point, anticipating ".."
193    (delete-backward-char 1)))
194
195(defun calc-dots ()
196  (interactive)
197  (calc-wrapper
198   (let ((num (calc-find-first-incomplete
199	       (nthcdr calc-stack-top calc-stack) 1)))
200     (if (= num 0)
201	 (error "Not entering an interval form"))
202     (let* ((inc (calc-top num))
203	    (stuff (calc-top-list (1- num)))
204	    (new (append inc stuff)))
205       (if (not (eq (nth 1 new) 'intv))
206	   (setq new (append '(incomplete intv)
207			     (if (eq (nth 1 new) 'vec) '(2) '(0))
208			     (cdr (cdr new)))))
209       (if (and (null stuff)
210		(= (length new) 3))
211	   (setq new (append new '((neg (var inf var-inf))))))
212       (if (> (length new) 5)
213	   (error "Too many components in interval form"))
214       (calc-pop-push num new)))))
215
216(defun calc-find-first-incomplete (stack n)
217  (cond ((null stack)
218	 0)
219	((eq (car-safe (car-safe (car stack))) 'incomplete)
220	 n)
221	(t
222	 (calc-find-first-incomplete (cdr stack) (1+ n)))))
223
224(defun calc-incomplete-error (a)
225  (cond ((memq (nth 1 a) '(cplx polar))
226	 (error "Complex number is incomplete"))
227	((eq (nth 1 a) 'vec)
228	 (error "Vector is incomplete"))
229	((eq (nth 1 a) 'intv)
230	 (error "Interval form is incomplete"))
231	(t (error "Object is incomplete"))))
232
233(provide 'calc-incom)
234
235;;; arch-tag: b8001270-4dc7-481b-a3e3-a952e19b390d
236;;; calc-incom.el ends here
237