lisp/calc/calc-incom.el

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