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