daveg@csvax.caltech.edu (David Gillespie) (06/06/90)
Posting-number: Volume 13, Issue 37
Submitted-by: daveg@csvax.caltech.edu (David Gillespie)
Archive-name: gmcalc/part11
---- Cut Here and unpack ----
#!/bin/sh
# this is part 11 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file calc-ext.el continued
#
CurArch=11
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
exit 1; fi
( read Scheck
if test "$Scheck" != $CurArch
then echo "Please unpack part $Scheck next!"
exit 1;
else exit 0; fi
) < s2_seq_.tmp || exit 1
echo "x - Continuing file calc-ext.el"
sed 's/^X//' << 'SHAR_EOF' >> calc-ext.el
X exp)
X (t
X (intern (concat "var-" name))))))
X ((integerp exp)
X (if (or (<= exp -1000000) (>= exp 1000000))
X (list 'quote (math-normalize exp))
X exp))
X (t exp))
X)
X
X(defun math-define-cond (forms)
X (and forms
X (cons (math-define-list (car forms))
X (math-define-cond (cdr forms))))
X)
X
X(defun math-complicated-lhs (body)
X (and body
X (or (not (symbolp (car body)))
X (math-complicated-lhs (cdr (cdr body)))))
X)
X
X(defun math-define-setf-list (body)
X (and body
X (cons (math-define-setf (nth 0 body) (nth 1 body))
X (math-define-setf-list (cdr (cdr body)))))
X)
X
X(defun math-define-setf (place value)
X (setq place (math-define-exp place)
X value (math-define-exp value))
X (cond ((symbolp place)
X (list 'setq place value))
X ((eq (car-safe place) 'nth)
X (list 'setcar (list 'nthcdr (nth 1 place) (nth 2 place)) value))
X ((eq (car-safe place) 'elt)
X (list 'setcar (list 'nthcdr (nth 2 place) (nth 1 place)) value))
X ((eq (car-safe place) 'car)
X (list 'setcar (nth 1 place) value))
X ((eq (car-safe place) 'cdr)
X (list 'setcdr (nth 1 place) value))
X (t
X (error "Bad place form for setf: %s" place)))
X)
X
X(defun math-define-binop (op ident arg1 rest)
X (if rest
X (math-define-binop op ident
X (list op arg1 (car rest))
X (cdr rest))
X (or arg1 ident))
X)
X
X(defun math-define-let (vlist)
X (and vlist
X (cons (if (consp (car vlist))
X (cons (car (car vlist))
X (math-define-list (cdr (car vlist))))
X (car vlist))
X (math-define-let (cdr vlist))))
X)
X
X(defun math-define-let-env (vlist)
X (and vlist
X (cons (if (consp (car vlist))
X (car (car vlist))
X (car vlist))
X (math-define-let-env (cdr vlist))))
X)
X
X(defun math-define-lambda (exp exp-env)
X (nconc (list (nth 0 exp) ; 'lambda
X (nth 1 exp)) ; arg list
X (math-define-function-body (cdr (cdr exp))
X (append (nth 1 exp) exp-env)))
X)
X
X(defun math-define-elt (seq idx)
X (if idx
X (math-define-elt (list 'elt seq (car idx)) (cdr idx))
X seq)
X)
X
X
X
X;;; Useful programming macros.
X
X(defmacro math-while (head &rest body)
X (let ((body (cons 'while (cons head body))))
X (if (math-body-refers-to body 'math-break)
X (cons 'catch (cons '(quote math-break) (list body)))
X body))
X)
X(put 'math-while 'lisp-indent-hook 1)
X
X
X(defmacro math-for (head &rest body)
X (let ((body (if head
X (math-handle-for head body)
X (cons 'while (cons t body)))))
X (if (math-body-refers-to body 'math-break)
X (cons 'catch (cons '(quote math-break) (list body)))
X body))
X)
X(put 'math-for 'lisp-indent-hook 1)
X
X(defun math-handle-for (head body)
X (let* ((var (nth 0 (car head)))
X (init (nth 1 (car head)))
X (limit (nth 2 (car head)))
X (step (or (nth 3 (car head)) 1))
X (body (if (cdr head)
X (list (math-handle-for (cdr head) body))
X body))
X (all-ints (and (integerp init) (integerp limit) (integerp step)))
X (const-limit (or (integerp limit)
X (and (eq (car-safe limit) 'quote)
X (math-realp (nth 1 limit)))))
X (const-step (or (integerp step)
X (and (eq (car-safe step) 'quote)
X (math-realp (nth 1 step)))))
X (save-limit (if const-limit limit (make-symbol "<limit>")))
X (save-step (if const-step step (make-symbol "<step>"))))
X (cons 'let
X (cons (append (if const-limit nil (list (list save-limit limit)))
X (if const-step nil (list (list save-step step)))
X (list (list var init)))
X (list
X (cons 'while
X (cons (if all-ints
X (if (> step 0)
X (list '<= var save-limit)
X (list '>= var save-limit))
X (list 'not
X (if const-step
X (if (or (math-posp step)
X (math-posp
X (cdr-safe step)))
X (list 'math-lessp
X save-limit
X var)
X (list 'math-lessp
X var
X save-limit))
X (list 'if
X (list 'math-posp
X save-step)
X (list 'math-lessp
X save-limit
X var)
X (list 'math-lessp
X var
X save-limit)))))
X (append body
X (list (list 'setq
X var
X (list (if all-ints
X '+
X 'math-add)
X var
X save-step))))))))))
X)
X
X
X(defmacro math-foreach (head &rest body)
X (let ((body (math-handle-foreach head body)))
X (if (math-body-refers-to body 'math-break)
X (cons 'catch (cons '(quote math-break) (list body)))
X body))
X)
X(put 'math-foreach 'lisp-indent-hook 1)
X
X(defun math-handle-foreach (head body)
X (let ((var (nth 0 (car head)))
X (data (nth 1 (car head)))
X (body (if (cdr head)
X (list (math-handle-foreach (cdr head) body))
X body)))
X (cons 'let
X (cons (list (list var data))
X (list
X (cons 'while
X (cons var
X (append body
X (list (list 'setq
X var
X (list 'cdr var))))))))))
X)
X
X
X(defun math-body-refers-to (body thing)
X (or (equal body thing)
X (and (consp body)
X (or (math-body-refers-to (car body) thing)
X (math-body-refers-to (cdr body) thing))))
X)
X
X(defun math-break (&optional value)
X (throw 'math-break value)
X)
X
X(defun math-return (&optional value)
X (throw 'math-return value)
X)
X
X
X
X
X;;; Nontrivial number parsing.
X
X(defun math-read-number-fancy (s)
X
X (cond
X
X ;; Modulo forms
X ((string-match "^\\(.*\\) *mod *\\(.*\\)$" s)
X (let* ((n (math-match-substring s 1))
X (m (math-match-substring s 2))
X (n (math-read-number n))
X (m (math-read-number m)))
X (and n m (math-anglep n) (math-anglep m)
X (list 'mod n m))))
X
X ;; Error forms
X ((string-match "^\\(.*\\) *\\+/- *\\(.*\\)$" s)
X (let* ((x (math-match-substring s 1))
X (sigma (math-match-substring s 2))
X (x (math-read-number x))
X (sigma (math-read-number sigma)))
X (and x sigma (math-anglep x) (math-anglep sigma)
X (list 'sdev x sigma))))
X
X ;; Hours (or degrees)
X ((or (string-match "^\\([^#^]+\\)[@oOhH]\\(.*\\)$" s)
X (string-match "^\\([^#^]+\\)[dD][eE]?[gG]?\\(.*\\)$" s))
X (let* ((hours (math-match-substring s 1))
X (minsec (math-match-substring s 2))
X (hours (math-read-number hours))
X (minsec (if (> (length minsec) 0) (math-read-number minsec) 0)))
X (and hours minsec
X (math-num-integerp hours)
X (not (math-negp hours)) (not (math-negp minsec))
X (cond ((math-num-integerp minsec)
X (and (Math-lessp minsec 60)
X (list 'hms hours minsec 0)))
X ((and (eq (car-safe minsec) 'hms)
X (math-zerop (nth 1 minsec)))
X (math-add (list 'hms hours 0 0) minsec))
X (t nil)))))
X
X ;; Minutes
X ((string-match "^\\([^'#^]+\\)[mM']\\(.*\\)$" s)
X (let* ((minutes (math-match-substring s 1))
X (seconds (math-match-substring s 2))
X (minutes (math-read-number minutes))
X (seconds (if (> (length seconds) 0) (math-read-number seconds) 0)))
X (and minutes seconds
X (math-num-integerp minutes)
X (not (math-negp minutes)) (not (math-negp seconds))
X (cond ((math-realp seconds)
X (and (Math-lessp minutes 60)
X (list 'hms 0 minutes seconds)))
X ((and (eq (car-safe seconds) 'hms)
X (math-zerop (nth 1 seconds))
X (math-zerop (nth 2 seconds)))
X (math-add (list 'hms 0 minutes 0) seconds))
X (t nil)))))
X
X ;; Seconds
X ((string-match "^\\([^\"#^]+\\)[sS\"]$" s)
X (let ((seconds (math-read-number (math-match-substring s 1))))
X (and seconds (math-realp seconds)
X (not (math-negp seconds))
X (Math-lessp seconds 60)
X (list 'hms 0 0 seconds))))
X
X ;; Integer+fraction with explicit radix
X ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]\\)$" s)
X (let ((radix (string-to-int (math-match-substring s 1)))
X (int (math-match-substring s 3))
X (num (math-match-substring s 4))
X (den (math-match-substring s 5)))
X (let ((int (if (> (length int) 0) (math-read-radix int radix) 0))
X (num (if (> (length num) 0) (math-read-radix num radix) 1))
X (den (if (> (length num) 0) (math-read-radix den radix) 1)))
X (and int num den (not (math-zerop den))
X (list 'frac
X (math-add num (math-mul int den))
X den)))))
X
X ;; Fraction with explicit radix
X ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]*\\)[:/]\\([0-9a-zA-Z]*\\)$" s)
X (let ((radix (string-to-int (math-match-substring s 1)))
X (num (math-match-substring s 3))
X (den (math-match-substring s 4)))
X (let ((num (if (> (length num) 0) (math-read-radix num radix) 1))
X (den (if (> (length num) 0) (math-read-radix den radix) 1)))
X (and num den (not (math-zerop den)) (list 'frac num den)))))
X
X ;; Integer with explicit radix
X ((string-match "^\\([0-9]+\\)\\(#\\|\\^\\^\\)\\([0-9a-zA-Z]+\\)$" s)
X (math-read-radix (math-match-substring s 3)
X (string-to-int (math-match-substring s 1))))
X
X ;; C language hexadecimal notation
X ((and (eq calc-language 'c)
X (string-match "^0[xX]\\([0-9a-fA-F]+\\)$" s))
X (let ((digs (math-match-substring s 1)))
X (math-read-radix digs 16)))
X
X ;; Fraction using "/" instead of ":"
X ((string-match "^\\([0-9]+\\)/\\([0-9/]+\\)$" s)
X (math-read-number (concat (math-match-substring s 1) ":"
X (math-match-substring s 2))))
X
X ;; Syntax error!
X (t nil))
X)
X
X(defun math-read-radix (s r) ; [I X D]
X (catch 'gonzo
X (math-read-radix-loop (upcase s) (1- (length s)) r))
X)
X
X(defun math-read-radix-loop (s i r) ; [I X S D]
X (if (< i 0)
X 0
X (let ((dig (math-read-radix-digit (elt s i))))
X (if (and dig (< dig r))
X (math-add (math-mul (math-read-radix-loop s (1- i) r)
X r)
X dig)
X (throw 'gonzo nil))))
X)
X
X
X
X;;; Expression parsing.
X
X(defun math-read-expr (exp-str)
X (let ((exp-pos 0)
X (exp-old-pos 0)
X (exp-keep-spaces nil)
X exp-token exp-data)
X (while (setq exp-token (string-match "\\.\\." exp-str))
X (setq exp-str (concat (substring exp-str exp-token) "\\dots"
X (substring exp-str (+ exp-token 2)))))
X (math-read-token)
X (let ((val (catch 'syntax (math-read-expr-level 0))))
X (if (stringp val)
X (list 'error exp-old-pos val)
X (if (equal exp-token 'end)
X val
X (list 'error exp-old-pos "Syntax error")))))
X)
X
X(defun math-read-brackets (space-sep close)
X (and space-sep (setq space-sep (not (math-check-for-commas))))
X (math-read-token)
X (while (eq exp-token 'space)
X (math-read-token))
X (if (or (equal exp-data close)
X (eq exp-token 'end))
X (progn
X (math-read-token)
X '(vec))
X (let ((vals (let ((exp-keep-spaces space-sep))
X (math-read-vector))))
X (if (equal exp-data "\\dots")
X (progn
X (math-read-token)
X (setq vals (if (> (length vals) 2)
X (cons 'calcFunc-mul (cdr vals)) (nth 1 vals)))
X (let ((exp2 (math-read-expr-level 0)))
X (setq vals
X (list 'intv
X (if (equal exp-data ")") 2 3)
X vals
X exp2)))
X (if (not (or (equal exp-data close)
X (equal exp-data ")")
X (eq exp-token 'end)))
X (throw 'syntax "Expected `]'")))
X (if (equal exp-data ";")
X (let ((exp-keep-spaces space-sep))
X (setq vals (cons 'vec (math-read-matrix (list vals))))))
X (if (not (or (equal exp-data close)
X (eq exp-token 'end)))
X (throw 'syntax "Expected `]'")))
X (math-read-token)
X vals))
X)
X
X(defun math-check-for-commas ()
X (let ((count 0)
X (pos (1- exp-pos)))
X (while (and (>= count 0)
X (setq pos (string-match "[],[{}()]" exp-str (1+ pos)))
X (or (/= (aref exp-str pos) ?,) (> count 0)))
X (cond ((memq (aref exp-str pos) '(?\[ ?\{ ?\())
X (setq count (1+ count)))
X ((memq (aref exp-str pos) '(?\] ?\} ?\)))
X (setq count (1- count)))))
X (and pos (= (aref exp-str pos) ?,)))
X)
X
X(defun math-read-vector ()
X (let* ((val (list (math-read-expr-level 0)))
X (last val))
X (while (progn
X (while (eq exp-token 'space)
X (math-read-token))
X (and (not (eq exp-token 'end))
X (not (equal exp-data ";"))
X (not (equal exp-data close))
X (not (equal exp-data "\\dots"))))
X (if (equal exp-data ",")
X (math-read-token))
X (while (eq exp-token 'space)
X (math-read-token))
X (let ((rest (list (math-read-expr-level 0))))
X (setcdr last rest)
X (setq last rest)))
X (cons 'vec val))
X)
X
X(defun math-read-matrix (mat)
X (while (equal exp-data ";")
X (math-read-token)
X (while (eq exp-token 'space)
X (math-read-token))
X (setq mat (nconc mat (list (math-read-vector)))))
X mat
X)
X
X(defun math-read-string ()
X (let ((str (read-from-string (concat exp-data "\""))))
X (or (and (= (cdr str) (1+ (length exp-data)))
X (stringp (car str)))
X (throw 'syntax "Error in string constant"))
X (math-read-token)
X (append '(vec) (car str) nil))
X)
X
X
X
X
X
X;;; Nontrivial "flat" formatting.
X
X(defun math-format-flat-expr-fancy (a prec)
X (cond
X ((eq (car a) 'incomplete)
X (concat "'" (prin1-to-string a)))
X ((eq (car a) 'vec)
X (concat "[" (math-format-flat-vector (cdr a) ", "
X (if (cdr (cdr a)) 0 1000)) "]"))
X ((eq (car a) 'intv)
X (concat (if (memq (nth 1 a) '(0 1)) "(" "[")
X (math-format-flat-expr (nth 2 a) 1000)
X " .. "
X (math-format-flat-expr (nth 3 a) 1000)
X (if (memq (nth 1 a) '(0 2)) ")" "]")))
X ((eq (car a) 'var)
X (symbol-name (nth 1 a)))
X (t
X (let ((op (math-assq2 (car a) math-standard-opers)))
X (cond ((and op (= (length a) 3))
X (if (> prec (min (nth 2 op) (nth 3 op)))
X (concat "(" (math-format-flat-expr a 0) ")")
X (let ((lhs (math-format-flat-expr (nth 1 a) (nth 2 op)))
X (rhs (math-format-flat-expr (nth 2 a) (nth 3 op))))
X (setq op (car op))
X (if (equal op "^")
X (if (= (aref lhs 0) ?-)
X (setq lhs (concat "(" lhs ")")))
X (setq op (concat " " op " ")))
X (concat lhs op rhs))))
X ((eq (car a) 'neg)
X (concat "-" (math-format-flat-expr (nth 1 a) 1000)))
X (t
X (concat (math-remove-dashes
X (if (string-match "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'"
X (symbol-name (car a)))
X (math-match-substring (symbol-name (car a)) 1)
X (symbol-name (car a))))
X "("
X (math-format-flat-vector (cdr a) ", " 0)
X ")"))))))
X)
X
X(defun math-format-flat-vector (vec sep prec)
X (if vec
X (let ((buf (math-format-flat-expr (car vec) prec)))
X (while (setq vec (cdr vec))
X (setq buf (concat buf sep (math-format-flat-expr (car vec) prec))))
X buf)
X "")
X)
X
X(defun math-assq2 (v a)
X (cond ((null a) nil)
X ((eq v (nth 1 (car a))) (car a))
X (t (math-assq2 v (cdr a))))
X)
X
X
X(defun math-format-number-fancy (a)
X (cond
X ((eq (car a) 'cplx)
X (if (null calc-complex-format)
X (concat "(" (math-format-number (nth 1 a))
X ", " (math-format-number (nth 2 a)) ")")
X (if (math-zerop (nth 1 a))
X (concat (math-format-number (nth 2 a))
X (symbol-name calc-complex-format))
X (concat (math-format-number (nth 1 a))
X (if (math-negp (nth 2 a)) " - " " + ")
X (math-format-number (math-abs (nth 2 a)))
X (symbol-name calc-complex-format)))))
X ((eq (car a) 'polar)
X (concat "(" (math-format-number (nth 1 a))
X "; " (math-format-number (nth 2 a)) ")"))
X ((eq (car a) 'hms)
X (if (math-negp a)
X (concat "-" (math-format-number (math-neg a)))
X (let ((calc-number-radix 10)
X (calc-leading-zeros nil)
X (calc-group-digits nil))
X (format calc-hms-format
X (math-format-number (nth 1 a))
X (math-format-number (nth 2 a))
X (math-format-number (nth 3 a))))))
X (t (format "%s" a)))
X)
X
X(defun math-format-bignum-fancy (a) ; [X L]
X (let ((str (cond ((= calc-number-radix 10)
X (math-format-bignum-decimal a))
X ((= calc-number-radix 2)
X (math-format-bignum-binary a))
X ((= calc-number-radix 8)
X (math-format-bignum-octal a))
X ((= calc-number-radix 16)
X (math-format-bignum-hex a))
X (t (math-format-bignum-radix a)))))
X (if calc-leading-zeros
X (let* ((calc-internal-prec 6)
X (digs (math-compute-max-digits (math-abs calc-word-size)
X calc-number-radix))
X (len (length str)))
X (if (< len digs)
X (setq str (concat (make-string (- digs len) ?0) str)))))
X (if calc-group-digits
X (let ((i (length str))
X (g (if (integerp calc-group-digits)
X (math-abs calc-group-digits)
X (if (memq calc-number-radix '(2 16)) 4 3))))
X (while (> i g)
X (setq i (- i g)
X str (concat (substring str 0 i)
X calc-group-char
X (substring str i))))
X str))
X (if (and (/= calc-number-radix 10)
X math-radix-explicit-format)
X (if calc-radix-formatter
X (funcall calc-radix-formatter calc-number-radix str)
X (format "%d#%s" calc-number-radix str))
X str))
X)
X
X(defvar math-max-digits-cache nil)
X(defun math-compute-max-digits (w r)
X (let* ((pair (+ (* r 100000) w))
X (res (assq pair math-max-digits-cache)))
X (if res
X (cdr res)
X (let* ((calc-command-flags nil)
X (digs (math-ceiling (math-div w (math-real-log2 r)))))
X (setq math-max-digits-cache (cons (cons pair digs)
X math-max-digits-cache))
X digs)))
X)
X
X(defvar math-log2-cache (list '(2 . 1)
X '(4 . 2)
X '(8 . 3)
X '(10 . (float 332193 -5))
X '(16 . 4)
X '(32 . 5)))
X(defun math-real-log2 (x) ;;; calc-internal-prec must be 6
X (let ((res (assq x math-log2-cache)))
X (if res
X (cdr res)
X (let* ((calc-symbolic-mode nil)
X (log (math-log x 2)))
X (setq math-log2-cache (cons (cons x log) math-log2-cache))
X log)))
X)
X
X(defun math-group-float (str) ; [X X]
X (let* ((pt (or (string-match "[^0-9]" str) (length str)))
X (g (if (integerp calc-group-digits) (math-abs calc-group-digits) 3))
X (i pt))
X (if (and (integerp calc-group-digits) (< calc-group-digits 0))
X (while (< (setq i (+ (1+ i) g)) (length str))
X (setq str (concat (substring str 0 i)
X calc-group-char
X (substring str i)))))
X (setq i pt)
X (while (> i g)
X (setq i (- i g)
X str (concat (substring str 0 i)
X calc-group-char
X (substring str i))))
X str)
X)
X
X(defconst math-radix-digits ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
X "A" "B" "C" "D" "E" "F" "G" "H" "I" "J"
X "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T"
X "U" "V" "W" "X" "Y" "Z"])
X(defmacro math-format-radix-digit (a) ; [X D]
X (` (aref math-radix-digits (, a)))
X)
X
X(defun math-format-radix (a) ; [X S]
X (if (< a calc-number-radix)
X (if (< a 0)
X (concat "-" (math-format-radix (- a)))
X (math-format-radix-digit a))
X (let ((s ""))
X (while (> a 0)
X (setq s (concat (math-format-radix-digit (% a calc-number-radix)) s)
X a (/ a calc-number-radix)))
X s))
X)
X
X(defconst math-binary-digits ["000" "001" "010" "011"
X "100" "101" "110" "111"])
X(defun math-format-binary (a) ; [X S]
X (if (< a 8)
X (if (< a 0)
X (concat "-" (math-format-binary (- a)))
X (math-format-radix a))
X (let ((s ""))
X (while (> a 7)
X (setq s (concat (aref math-binary-digits (% a 8)) s)
X a (/ a 8)))
X (concat (math-format-radix a) s)))
X)
X
X(defun math-format-bignum-radix (a) ; [X L]
X (cond ((null a) "0")
X ((and (null (cdr a))
X (< (car a) calc-number-radix))
X (math-format-radix-digit (car a)))
X (t
X (let ((q (math-div-bignum-digit a calc-number-radix)))
X (concat (math-format-bignum-radix (math-norm-bignum (car q)))
X (math-format-radix-digit (cdr q))))))
X)
X
X(defun math-format-bignum-binary (a) ; [X L]
X (cond ((null a) "0")
X ((null (cdr a))
X (math-format-binary (car a)))
X (t
X (let ((q (math-div-bignum-digit a 512)))
X (concat (math-format-bignum-binary (math-norm-bignum (car q)))
X (aref math-binary-digits (/ (cdr q) 64))
X (aref math-binary-digits (% (/ (cdr q) 8) 8))
X (aref math-binary-digits (% (cdr q) 8))))))
X)
X
X(defun math-format-bignum-octal (a) ; [X L]
X (cond ((null a) "0")
X ((null (cdr a))
X (math-format-radix (car a)))
X (t
X (let ((q (math-div-bignum-digit a 512)))
X (concat (math-format-bignum-octal (math-norm-bignum (car q)))
X (math-format-radix-digit (/ (cdr q) 64))
X (math-format-radix-digit (% (/ (cdr q) 8) 8))
X (math-format-radix-digit (% (cdr q) 8))))))
X)
X
X(defun math-format-bignum-hex (a) ; [X L]
X (cond ((null a) "0")
X ((null (cdr a))
X (math-format-radix (car a)))
X (t
X (let ((q (math-div-bignum-digit a 256)))
X (concat (math-format-bignum-hex (math-norm-bignum (car q)))
X (math-format-radix-digit (/ (cdr q) 16))
X (math-format-radix-digit (% (cdr q) 16))))))
X)
X
X
X
X
X
X
X
X;;; A "composition" has one of the following forms:
X;;;
X;;; "string" A literal string
X;;;
X;;; (horiz C1 C2 ...) Horizontally abutted sub-compositions
X;;;
X;;; (break LEVEL) A potential line-break point
X;;;
X;;; (vleft N C1 C2 ...) Vertically stacked, left-justified sub-comps
X;;; (vcent N C1 C2 ...) Vertically stacked, centered sub-comps
X;;; (vright N C1 C2 ...) Vertically stacked, right-justified sub-comps
X;;; N specifies baseline of the stack, 0=top line.
X;;;
X;;; (supscr C1 C2) Composition C1 with superscript C2
X;;; (subscr C1 C2) Composition C1 with subscript C2
X;;; (rule) Horizontal line, full width of enclosing comp
X
X(defun math-compose-expr (a prec)
X (let ((math-compose-level (1+ math-compose-level)))
X (cond
X ((math-scalarp a)
X (if (and (eq (car-safe a) 'frac)
X (memq calc-language '(tex math)))
X (math-compose-expr (list '/ (nth 1 a) (nth 2 a)) prec)
X (math-format-number a)))
X ((not (consp a)) (concat "'" (prin1-to-string a)))
X ((eq (car a) 'vec)
X (let ((left-bracket (if calc-vector-brackets
X (substring calc-vector-brackets 0 1) ""))
X (right-bracket (if calc-vector-brackets
X (substring calc-vector-brackets 1 2) ""))
X (comma (or calc-vector-commas " "))
X (just (cond ((eq calc-matrix-just 'right) 'vright)
X ((eq calc-matrix-just 'center) 'vcent)
X (t 'vleft))))
X (if (and (math-matrixp a) (not (math-matrixp (nth 1 a)))
X (memq calc-language '(nil big)))
X (if (= (length a) 2)
X (list 'horiz
X (concat left-bracket left-bracket " ")
X (math-compose-vector (cdr (nth 1 a))
X (concat comma " "))
X (concat " " right-bracket right-bracket))
X (let* ((rows (1- (length a)))
X (cols (1- (length (nth 1 a))))
X (base (/ (1- rows) 2))
X (calc-language 'flat))
X (append '(horiz)
X (list (append '(vleft)
X (list base)
X (list (concat left-bracket
X " "
X left-bracket
X " "))
X (make-list (1- rows)
X (concat " "
X left-bracket
X " "))))
X (math-compose-matrix (cdr a) 1 cols base)
X (list (append '(vleft)
X (list base)
X (make-list (1- rows)
X (concat " "
X right-bracket
X comma))
X (list (concat " "
X right-bracket
X " "
X right-bracket)))))))
X (if (and calc-display-strings
X (math-vector-is-string a))
X (prin1-to-string (concat (cdr a)))
X (list 'horiz
X left-bracket
X (math-compose-vector (cdr a)
X (concat (or calc-vector-commas "") " "))
X right-bracket)))))
X ((eq (car a) 'incomplete)
X (if (cdr (cdr a))
X (cond ((eq (nth 1 a) 'vec)
X (list 'horiz "["
X (math-compose-vector (cdr (cdr a)) ", ")
X " ..."))
X ((eq (nth 1 a) 'cplx)
X (list 'horiz "("
X (math-compose-vector (cdr (cdr a)) ", ")
X ", ..."))
X ((eq (nth 1 a) 'polar)
X (list 'horiz "("
X (math-compose-vector (cdr (cdr a)) "; ")
X "; ..."))
X ((eq (nth 1 a) 'intv)
X (list 'horiz
X (if (memq (nth 2 a) '(0 1)) "(" "[")
X (math-compose-vector (cdr (cdr (cdr a))) " .. ")
X " .. ..."))
X (t (format "%s" a)))
X (cond ((eq (nth 1 a) 'vec) "[ ...")
X ((eq (nth 1 a) 'intv)
X (if (memq (nth 2 a) '(0 1)) "( ..." "[ ..."))
X (t "( ..."))))
X ((eq (car a) 'var)
X (let ((v (rassq (nth 2 a) math-expr-variable-mapping)))
X (if v
X (symbol-name (car v))
X (if (and (eq calc-language 'tex)
X calc-language-option
X (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'"
X (symbol-name (nth 1 a))))
X (format "\\hbox{%s}" (symbol-name (nth 1 a)))
X (symbol-name (nth 1 a))))))
X ((eq (car a) 'intv)
X (list 'horiz
X (if (memq (nth 1 a) '(0 1)) "(" "[")
X (math-compose-expr (nth 2 a) 0)
X (if (eq calc-language 'tex) " \\dots " " .. ")
X (math-compose-expr (nth 3 a) 0)
X (if (memq (nth 1 a) '(0 2)) ")" "]")))
X ((and (eq (car a) 'calcFunc-subscr)
X (memq calc-language '(c pascal fortran)))
X (list 'horiz
X (math-compose-expr (nth 1 a) 1000)
X (if (eq calc-language 'fortran) "(" "[")
X (math-compose-vector (cdr (cdr a)) ", ")
X (if (eq calc-language 'fortran) ")" "]")))
X ((and (eq (car a) 'calcFunc-subscr)
X (eq calc-language 'big))
X (let ((a1 (math-compose-expr (nth 1 a) 1000))
X (a2 (math-compose-expr (nth 2 a) 0)))
X (if (eq (car-safe a1) 'subscr)
X (list 'subscr
X (nth 1 a1)
X (list 'horiz
X (nth 2 a1)
X ", "
X a2))
X (list 'subscr a1 a2))))
X ((and (eq (car a) 'calcFunc-sqrt)
X (eq calc-language 'tex))
X (list 'horiz
X "\\sqrt{"
X (math-compose-expr (nth 1 a) 0)
X "}"))
X ((and (eq (car a) '^)
X (eq calc-language 'big))
X (list 'supscr
X (if (math-looks-negp (nth 1 a))
X (list 'horiz "(" (math-compose-expr (nth 1 a) 0) ")")
X (math-compose-expr (nth 1 a) 201))
X (let ((calc-language 'flat))
X (math-compose-expr (nth 2 a) 0))))
X ((and (eq (car a) '/)
X (eq calc-language 'big))
X (let ((a1 (math-compose-expr (nth 1 a) 0))
X (a2 (math-compose-expr (nth 2 a) 0)))
X (list 'vcent
X (math-comp-height a1)
X a1 '(rule) a2)))
X (t
X (let ((op (and (not (eq calc-language 'unform))
X (math-assq2 (car a) math-expr-opers))))
X (cond ((and op (= (length a) 3)
X (/= (nth 3 op) -1)
X (not (eq (car a) 'calcFunc-if)))
X (cond
X ((> prec (min (nth 2 op) (nth 3 op)))
X (if (and (eq calc-language 'tex)
X (not (math-tex-expr-is-flat a)))
X (if (eq (car-safe a) '/)
X (list 'horiz "{" (math-compose-expr a -1) "}")
X (list 'horiz "\\left( "
X (math-compose-expr a -1)
X " \\right)"))
X (list 'horiz "(" (math-compose-expr a 0) ")")))
X ((and (eq calc-language 'tex)
X (memq (car a) '(/ calcFunc-choose))
X (>= prec 0))
X (list 'horiz "{" (math-compose-expr a -1) "}"))
X (t
X (let ((lhs (math-compose-expr (nth 1 a) (nth 2 op)))
X (rhs (math-compose-expr (nth 2 a) (nth 3 op))))
X (and (equal (car op) "^")
X (= (math-comp-first-char lhs) ?-)
X (setq lhs (list 'horiz "(" lhs ")")))
X (and (eq calc-language 'tex)
X (or (equal (car op) "^") (equal (car op) "_"))
X (not (and (stringp rhs) (= (length rhs) 1)))
X (setq rhs (list 'horiz "{" rhs "}")))
X (or (and (eq (car a) '*)
X (or (null calc-language)
X (assoc "2x" math-expr-opers))
X (let ((prevt (math-prod-last-term (nth 1 a)))
X (nextt (math-prod-first-term (nth 2 a)))
X (prevc (math-comp-last-char lhs))
X (nextc (math-comp-first-char rhs)))
X (and prevc nextc
X (or (and (>= nextc ?a) (<= nextc ?z))
X (and (>= nextc ?A) (<= nextc ?Z))
X (and (>= nextc ?0) (<= nextc ?9))
X (memq nextc '(?. ?_ ?\( ?\[ ?\{ ?\\)))
X (not (and (eq (car-safe prevt) 'var)
X (equal nextc ?\()))
X (list 'horiz
X lhs
X (list 'break math-compose-level)
X " "
X rhs))))
X (list 'horiz
X lhs
X (list 'break math-compose-level)
X (if (or (equal (car op) "^")
X (equal (car op) "_")
X (equal (car op) "*"))
X (car op)
X (concat " " (car op) " "))
X rhs))))))
X ((and op (= (length a) 2) (= (nth 3 op) -1))
X (cond
X ((> prec (nth 2 op))
X (if (and (eq calc-language 'tex)
X (not (math-tex-expr-is-flat a)))
X (list 'horiz "\\left( "
X (math-compose-expr a -1)
X " \\right)")
X (list 'horiz "(" (math-compose-expr a 0) ")")))
X (t
X (let ((lhs (math-compose-expr (nth 1 a) (nth 2 op))))
X (list 'horiz
X lhs
X (if (or (> (length (car op)) 1)
X (not (math-comp-is-flat lhs)))
X (concat " " (car op))
X (car op)))))))
X ((and op (= (length a) 2) (= (nth 2 op) -1))
X (cond
X ((eq (nth 3 op) 0)
X (let ((lr (and (eq calc-language 'tex)
X (not (math-tex-expr-is-flat (nth 1 a))))))
X (list 'horiz
X (if lr "\\left" "")
X (if (string-match "\\`u\\([^a-zA-Z]\\)\\'" (car op))
X (substring (car op) 1)
X (car op))
X (if (or lr (> (length (car op)) 2)) " " "")
X (math-compose-expr (nth 1 a) -1)
X (if (or lr (> (length (car op)) 2)) " " "")
X (if lr "\\right" "")
X (car (nth 1 (memq op math-expr-opers))))))
X ((> prec (nth 3 op))
X (if (and (eq calc-language 'tex)
X (not (math-tex-expr-is-flat a)))
X (list 'horiz "\\left( "
X (math-compose-expr a -1)
X " \\right)")
X (list 'horiz "(" (math-compose-expr a 0) ")")))
X (t
X (let ((rhs (math-compose-expr (nth 1 a) (nth 3 op))))
X (list 'horiz
X (let ((ops (if (string-match "\\`u\\([^a-zA-Z]\\)\\'"
X (car op))
X (substring (car op) 1)
X (car op))))
X (if (or (> (length ops) 1)
X (not (math-comp-is-flat rhs)))
X (concat ops " ")
X ops))
X rhs)))))
X ((and op (= (length a) 4) (eq (car a) 'calcFunc-if))
X (list 'horiz
X (math-compose-expr (nth 1 a) (nth 2 op))
X " ? "
X (math-compose-expr (nth 2 a) 0)
X " : "
X (math-compose-expr (nth 3 a) (nth 3 op))))
X ((and (eq calc-language 'big)
X (setq op (get (car a) 'math-compose-big)))
X (funcall op a prec))
X (t
X (let* ((func (car a))
X (func2 (assq func '(( mod . calcFunc-makemod )
X ( sdev . calcFunc-sdev )
X ( + . calcFunc-add )
X ( - . calcFunc-sub )
X ( * . calcFunc-mul )
X ( / . calcFunc-div )
X ( % . calcFunc-mod )
X ( ^ . calcFunc-pow )
X ( neg . calcFunc-neg )
X ( | . calcFunc-vconcat ))))
X left right args)
X (if func2
X (setq func (cdr func2)))
X (if (setq func2 (rassq func math-expr-function-mapping))
X (setq func (car func2)))
X (setq func (math-remove-dashes
X (if (string-match
X "\\`calcFunc-\\([a-zA-Z0-9']+\\)\\'"
X (symbol-name func))
X (math-match-substring (symbol-name func) 1)
X (symbol-name func))))
X (if (and (eq calc-language 'tex)
X calc-language-option
X (string-match "\\`[a-zA-Z][a-zA-Z0-9]+\\'" func))
X (setq func (format "\\hbox{%s}" func)))
X (cond ((and (eq calc-language 'tex)
X (or (> (length a) 2)
X (not (math-tex-expr-is-flat (nth 1 a)))))
X (setq left "\\left( "
X right " \\right)"))
X ((and (eq calc-language 'tex)
X (eq (aref func 0) ?\\)
X (= (length a) 2)
X (or (Math-realp (nth 1 a))
X (memq (car (nth 1 a)) '(var *))))
X (setq left "{"
X right "}"))
X (t (setq left calc-function-open
X right calc-function-close)))
X (list 'horiz func left
X (math-compose-vector (cdr a) ", ")
X right))))))))
X)
X(setq math-compose-level 0)
X
X(defun math-prod-first-term (x)
X (if (eq (car-safe x) '*)
X (math-prod-first-term (nth 1 x))
X x)
X)
X
X(defun math-prod-last-term (x)
X (if (eq (car-safe x) '*)
X (math-prod-last-term (nth (1- (length x)) x))
X x)
X)
X
X(defun math-compose-vector (a sep)
X (if a
X (cons 'horiz
X (cons (math-compose-expr (car a) 0)
X (math-compose-vector-step (cdr a))))
X "")
X)
X
X(defun math-compose-vector-step (a)
X (and a
X (cons sep
X (cons (list 'break math-compose-level)
X (cons (math-compose-expr (car a) 0)
X (math-compose-vector-step (cdr a))))))
X)
X
X(defun math-compose-matrix (a col cols base)
X (math-compose-matrix-step a col)
X)
X
X(defun math-compose-matrix-step (a col)
X (if (= col cols)
X (list (cons just
X (cons base
X (mapcar (function (lambda (r)
X (math-compose-expr (nth col r) 0)))
X a))))
X (cons (cons just
X (cons base
X (mapcar (function
X (lambda (r) (list 'horiz
X (math-compose-expr (nth col r)
X 0)
X (concat comma " "))))
X a)))
X (math-compose-matrix-step a (1+ col))))
X)
X
X(defun math-vector-is-string (a)
X (and (cdr a)
X (progn
X (while (and (setq a (cdr a))
X (natnump (car a))
X (<= (car a) 255)))
X (null a)))
X)
X
X(defun math-tex-expr-is-flat (a)
X (or (Math-integerp a)
X (memq (car a) '(float var))
X (and (memq (car a) '(+ - *))
X (progn
X (while (and (setq a (cdr a))
X (math-tex-expr-is-flat (car a))))
X (null a))))
X)
X
X
X
X;;; Convert a composition to string form, with embedded \n's if necessary.
X
X(defun math-composition-to-string (c &optional width)
X (or width (setq width (calc-window-width)))
X (if calc-display-raw
X (math-comp-to-string-raw c 0)
X (if (math-comp-is-flat c)
X (math-comp-to-string-flat c width)
X (math-vert-comp-to-string
X (math-comp-simplify c width))))
X)
X
X(defun math-comp-is-flat (c) ; check if c's height is 1.
X (cond ((not (consp c)) t)
X ((eq (car c) 'break) t)
X ((eq (car c) 'horiz)
X (while (and (setq c (cdr c))
X (math-comp-is-flat (car c))))
X (null c))
X ((memq (car c) '(vleft vcent vright))
X (and (= (length c) 3)
X (= (nth 1 c) 0)
X (math-comp-is-flat (nth 2 c))))
X (t nil))
X)
X
X
X;;; Convert a one-line composition to a string.
X
X(defun math-comp-to-string-flat (c full-width)
X (let ((comp-buf "")
X (comp-word "")
X (comp-pos 0)
X (comp-wlen 0))
X (math-comp-to-string-flat-term c)
X (math-comp-to-string-flat-term '(break -1))
X comp-buf)
X)
X
X(defun math-comp-to-string-flat-term (c)
X (cond ((not (consp c))
X (setq comp-word (concat comp-word c)
X comp-wlen (+ comp-wlen (length c))))
X ((eq (car c) 'horiz)
X (while (setq c (cdr c))
X (math-comp-to-string-flat-term (car c))))
X ((eq (car c) 'break)
X (if (or (<= (+ comp-pos comp-wlen) full-width)
X (= (length comp-buf) 0)
X (not calc-line-breaking))
X (setq comp-buf (concat comp-buf comp-word)
X comp-pos (+ comp-pos comp-wlen))
X (if calc-line-numbering
X (setq comp-buf (concat comp-buf "\n " comp-word)
X comp-pos (+ comp-wlen 5))
X (setq comp-buf (concat comp-buf "\n " comp-word)
X comp-pos (1+ comp-wlen))))
X (setq comp-word ""
X comp-wlen 0))
X (t (math-comp-to-string-flat-term (nth 2 c))))
X)
X
X
X;;; Simplify a composition to a canonical form consisting of
X;;; (vleft n "string" "string" "string" ...)
X;;; where 0 <= n < number-of-strings.
X
X(defun math-comp-simplify (c full-width)
X (let ((comp-buf (list ""))
X (comp-base 0)
X (comp-height 1)
X (comp-hpos 0)
X (comp-vpos 0))
X (math-comp-simplify-term c)
X (cons 'vleft (cons comp-base comp-buf)))
X)
X
X(defun math-comp-add-string (s h v)
X (and (> (length s) 0)
X (let ((vv (+ v comp-base)))
X (if (< vv 0)
X (setq comp-buf (nconc (make-list (- vv) "") comp-buf)
X comp-base (- v)
X comp-height (- comp-height vv)
X vv 0)
X (if (>= vv comp-height)
X (setq comp-buf (nconc comp-buf
X (make-list (1+ (- vv comp-height)) ""))
X comp-height (1+ vv))))
X (let ((str (nthcdr vv comp-buf)))
X (setcar str (concat (car str)
X (make-string (- h (length (car str))) 32)
X s)))))
X)
X
X(defun math-comp-simplify-term (c)
X (cond ((stringp c)
X (math-comp-add-string c comp-hpos comp-vpos)
X (setq comp-hpos (+ comp-hpos (length c))))
X ((eq (car c) 'break)
X nil)
X ((eq (car c) 'horiz)
X (while (setq c (cdr c))
X (math-comp-simplify-term (car c))))
X ((memq (car c) '(vleft vcent vright))
X (let* ((comp-vpos (+ (- comp-vpos (nth 1 c))
X (1- (math-comp-ascent (nth 2 c)))))
X (widths (mapcar 'math-comp-width (cdr (cdr c))))
X (maxwid (apply 'max widths))
X (bias (cond ((eq (car c) 'vleft) 0)
X ((eq (car c) 'vcent) 1)
X (t 2))))
X (setq c (cdr c))
X (while (setq c (cdr c))
X (if (eq (car-safe (car c)) 'rule)
X (math-comp-add-string (make-string maxwid ?-)
X comp-hpos comp-vpos)
X (let ((comp-hpos (+ comp-hpos (/ (* bias (- maxwid
X (car widths)))
X 2))))
X (math-comp-simplify-term (car c))))
X (and (cdr c)
X (setq comp-vpos (+ comp-vpos
X (+ (math-comp-descent (car c))
X (math-comp-ascent (nth 1 c))))
X widths (cdr widths))))
X (setq comp-hpos (+ comp-hpos maxwid))))
X ((eq (car c) 'supscr)
X (math-comp-simplify-term (nth 1 c))
X (let* ((asc (math-comp-ascent (nth 1 c)))
X (desc (math-comp-descent (nth 2 c)))
X (comp-vpos (- comp-vpos (+ asc desc))))
X (math-comp-simplify-term (nth 2 c))))
X ((eq (car c) 'subscr)
X (math-comp-simplify-term (nth 1 c))
X (let* ((asc (math-comp-ascent (nth 2 c)))
X (desc (math-comp-descent (nth 1 c)))
X (comp-vpos (+ comp-vpos (+ asc desc))))
X (math-comp-simplify-term (nth 2 c)))))
X)
X
X
X;;; Measuring a composition.
X
X(defun math-comp-first-char (c)
X (cond ((stringp c)
X (and (> (length c) 0)
X (elt c 0)))
X ((memq (car c) '(horiz subscr supscr))
X (let (ch)
X (while (and (setq c (cdr c))
X (not (setq ch (math-comp-first-char (car c))))))
X ch)))
X)
X
X(defun math-comp-last-char (c)
X (cond ((stringp c)
X (and (> (length c) 0)
X (elt c (1- (length c)))))
X ((eq (car c) 'horiz)
X (let ((c (reverse (cdr c))) ch)
X (while (and c
X (not (setq ch (math-comp-last-char (car c)))))
X (setq c (cdr c)))
X ch)))
X)
X
X(defun math-comp-width (c)
X (cond ((not (consp c)) (length c))
X ((memq (car c) '(horiz subscr supscr))
X (let ((accum 0))
X (while (setq c (cdr c))
X (setq accum (+ accum (math-comp-width (car c)))))
X accum))
X ((memq (car c) '(vcent vleft vright))
X (setq c (cdr c))
X (let ((accum 0))
X (while (setq c (cdr c))
X (setq accum (max accum (math-comp-width (car c)))))
X accum))
X (t 0))
X)
X
X(defun math-comp-height (c)
X (if (stringp c)
X 1
X (+ (math-comp-ascent c) (math-comp-descent c)))
X)
X
X(defun math-comp-ascent (c)
X (cond ((not (consp c)) 1)
X ((eq (car c) 'horiz)
X (let ((accum 0))
X (while (setq c (cdr c))
X (setq accum (max accum (math-comp-ascent (car c)))))
X accum))
X ((memq (car c) '(vcent vleft vright))
X (if (> (nth 1 c) 0) (1+ (nth 1 c)) 1))
X ((eq (car c) 'supscr)
X (+ (math-comp-ascent (nth 1 c)) (math-comp-height (nth 2 c))))
X ((eq (car c) 'subscr)
X (math-comp-ascent (nth 1 c)))
X (t 1))
X)
X
X(defun math-comp-descent (c)
X (cond ((not (consp c)) 0)
X ((eq (car c) 'horiz)
X (let ((accum 0))
X (while (setq c (cdr c))
X (setq accum (max accum (math-comp-descent (car c)))))
X accum))
X ((memq (car c) '(vcent vleft vright))
X (let ((accum (- (nth 1 c))))
X (setq c (cdr c))
X (while (setq c (cdr c))
X (setq accum (+ accum (math-comp-height (car c)))))
X (max (1- accum) 0)))
X ((eq (car c) 'supscr)
X (math-comp-descent (nth 1 c)))
X ((eq (car c) 'subscr)
X (+ (math-comp-descent (nth 1 c)) (math-comp-height (nth 2 c))))
X (t 0))
X)
X
X
X;;; Convert a simplified composition into string form.
X
X(defun math-vert-comp-to-string (c)
X (if (stringp c)
X c
X (math-vert-comp-to-string-step (cdr (cdr c))))
X)
X
X(defun math-vert-comp-to-string-step (c)
X (if (cdr c)
X (concat (car c) "\n" (math-vert-comp-to-string-step (cdr c)))
X (car c))
X)
X
X
X;;; Convert a composition to a string in "raw" form (for debugging).
X
X(defun math-comp-to-string-raw (c indent)
X (cond ((not (consp c))
X (prin1-to-string c))
X (t
X (let ((next-indent (+ indent 2 (length (symbol-name (car c))))))
X (if (null (cdr c))
X (concat "(" (symbol-name (car c)) ")")
X (concat "("
X (symbol-name (car c))
X " "
X (math-comp-to-string-raw (nth 1 c) next-indent)
X (math-comp-to-string-raw-step (cdr (cdr c))
X next-indent)
X ")")))))
X)
X
X(defun math-comp-to-string-raw-step (cl indent)
X (if cl
X (concat "\n"
X (make-string indent 32)
X (math-comp-to-string-raw (car cl) indent)
X (math-comp-to-string-raw-step (cdr cl) indent))
X "")
X)
X
X
X
X
X
X
X;;;; End.
X
SHAR_EOF
echo "File calc-ext.el is complete"
chmod 0664 calc-ext.el || echo "restore of calc-ext.el fails"
set `wc -c calc-ext.el`;Sum=$1
if test "$Sum" != "460649"
then echo original size 460649, current size $Sum;fi
echo "x - extracting calc.texinfo (Text)"
sed 's/^X//' << 'SHAR_EOF' > calc.texinfo &&
X\input texinfo @c -*-texinfo-*-
X@comment %**start of header (This is for running Texinfo on a region.)
X@setfilename calc-info
X@settitle GNU Emacs Calc 1.01 Manual
X@setchapternewpage odd
X@comment %**end of header (This is for running Texinfo on a region.)
X
X@ifinfo
XThis file documents Calc, the GNU Emacs calculator.
X
XCopyright (C) 1990 Dave Gillespie
X
XPermission is granted to make and distribute verbatim copies of this
Xmanual provided the copyright notice and this permission notice are
Xpreserved on all copies.
X
X@ignore
XPermission is granted to process this file through TeX and print the
Xresults, provided the printed document carries copying permission notice
Xidentical to this one except for the removal of this paragraph (this
Xparagraph not being relevant to the printed manual).
X
X@end ignore
XPermission is granted to copy and distribute modified versions of this
Xmanual under the conditions for verbatim copying, provided also that the
Xsection entitled ``GNU General Public License'' is included exactly as
Xin the original, and provided that the entire resulting derived work is
Xdistributed under the terms of a permission notice identical to this one.
X
XPermission is granted to copy and distribute translations of this manual
Xinto another language, under the above conditions for modified versions,
Xexcept that the section entitled ``GNU General Public License'' may be
Xincluded in a translation approved by the author instead of in the
Xoriginal English.
X@end ifinfo
X
X@titlepage
X@sp 6
X@center @titlefont{Calc Manual}
X@sp 4
X@center GNU Emacs Calc Version 1.01
X@sp 1
X@center May 1990
X@sp 5
X@center Dave Gillespie
X@page
X
X@vskip 0pt plus 1filll
XCopyright @copyright{} 1990 Dave Gillespie
X
XPermission is granted to make and distribute verbatim copies of
Xthis manual provided the copyright notice and this permission notice
Xare preserved on all copies.
X
X@ignore
XPermission is granted to process this file through TeX and print the
Xresults, provided the printed document carries copying permission notice
Xidentical to this one except for the removal of this paragraph (this
Xparagraph not being relevant to the printed manual).
X
X@end ignore
XPermission is granted to copy and distribute modified versions of this
Xmanual under the conditions for verbatim copying, provided also that the
Xsection entitled ``GNU General Public License'' is included exactly as
Xin the original, and provided that the entire resulting derived work is
Xdistributed under the terms of a permission notice identical to this one.
X
XPermission is granted to copy and distribute translations of this manual
Xinto another language, under the above conditions for modified versions,
Xexcept that the section entitled ``GNU General Public License'' may be
Xincluded in a translation approved by the author instead of in the
Xoriginal English.
X@end titlepage
X
X@ifinfo
X@node Top, Introduction,, (dir)
X@ichapter The GNU Emacs Calculator
X
X@dfn{Calc} is an advanced desk calculator and mathematical tool that runs
Xas part of the GNU Emacs environment.
X
XThis manual is divided into two major parts, the Tutorial and the
XReference. The Tutorial introduces all the major aspects of Calculator
Xuse in an easy, hands-on way. The remainder of the manual is a
Xcomplete reference on the features of the Calculator.
X
X@end ifinfo
X@menu
X* Copying:: How you can copy and share Calc.
X
X* Quick Overview:: If you're in a hurry to use Calc.
X* Tutorial:: A step-by-step introduction for beginners.
X
X* Introduction:: A full introduction to Calc.
X* Data Types:: Types of objects manipulated by Calc.
X* Stack and Trail:: Manipulating the stack and trail buffers.
X* Mode Settings:: Adjusting display format and other modes.
X* Arithmetic:: Basic arithmetic functions.
X* Scientific Functions:: Trancendentals and other scientific functions.
X* Binary Functions:: Bitwise operations on integers.
X* Matrix Functions:: Operations on vectors and matrices.
X* Algebra:: Manipulating expressions algebraically.
X* Units:: Operations on numbers with units.
X* Store and Recall:: Storing and recalling variables.
X* Kill and Yank:: Moving data into and out of Calc.
X* Programming:: Calc as a programmable calculator.
X
X* Installation:: Installing Calc as a part of GNU Emacs.
X* Reporting Bugs:: How to report bugs and make suggestions.
X
X* Key Index:: The standard Calc key sequences.
X* Command Index:: The interactive Calc commands.
X* Function Index:: Functions (in algebraic formulas).
X* Concept Index:: General concepts.
X* Lisp Function Index:: Internal Lisp math functions.
X* Lisp Variable Index:: Internal Lisp variables used by Calc.
X@end menu
X
X@node Copying, Quick Overview, Top, Top
X@unnumbered GNU GENERAL PUBLIC LICENSE
X@center Version 1, February 1989
X
X@display
XCopyright @copyright{} 1989 Free Software Foundation, Inc.
X675 Mass Ave, Cambridge, MA 02139, USA
X
XEveryone is permitted to copy and distribute verbatim copies
Xof this license document, but changing it is not allowed.
X@end display
X
X@unnumberedsec Preamble
X
X The license agreements of most software companies try to keep users
Xat the mercy of those companies. By contrast, our General Public
XLicense is intended to guarantee your freedom to share and change free
Xsoftware---to make sure the software is free for all its users. The
XGeneral Public License applies to the Free Software Foundation's
Xsoftware and to any other program whose authors commit to using it.
XYou can use it for your programs, too.
X
X When we speak of free software, we are referring to freedom, not
Xprice. Specifically, the General Public License is designed to make
Xsure that you have the freedom to give away or sell copies of free
Xsoftware, that you receive source code or can get it if you want it,
Xthat you can change the software or use pieces of it in new free
Xprograms; and that you know you can do these things.
X
X To protect your rights, we need to make restrictions that forbid
Xanyone to deny you these rights or to ask you to surrender the rights.
XThese restrictions translate to certain responsibilities for you if you
Xdistribute copies of the software, or if you modify it.
X
X For example, if you distribute copies of a such a program, whether
Xgratis or for a fee, you must give the recipients all the rights that
Xyou have. You must make sure that they, too, receive or can get the
Xsource code. And you must tell them their rights.
X
X We protect your rights with two steps: (1) copyright the software, and
X(2) offer you this license which gives you legal permission to copy,
Xdistribute and/or modify the software.
X
X Also, for each author's protection and ours, we want to make certain
Xthat everyone understands that there is no warranty for this free
Xsoftware. If the software is modified by someone else and passed on, we
Xwant its recipients to know that what they have is not the original, so
Xthat any problems introduced by others will not reflect on the original
Xauthors' reputations.
X
X The precise terms and conditions for copying, distribution and
Xmodification follow.
X
X@iftex
X@unnumberedsec TERMS AND CONDITIONS
X@end iftex
X@ifinfo
X@center TERMS AND CONDITIONS
X@end ifinfo
X
X@enumerate
X@item
XThis License Agreement applies to any program or other work which
Xcontains a notice placed by the copyright holder saying it may be
Xdistributed under the terms of this General Public License. The
X``Program'', below, refers to any such program or work, and a ``work based
Xon the Program'' means either the Program or any work containing the
XProgram or a portion of it, either verbatim or with modifications. Each
Xlicensee is addressed as ``you''.
X
X@item
XYou may copy and distribute verbatim copies of the Program's source
Xcode as you receive it, in any medium, provided that you conspicuously and
Xappropriately publish on each copy an appropriate copyright notice and
Xdisclaimer of warranty; keep intact all the notices that refer to this
XGeneral Public License and to the absence of any warranty; and give any
Xother recipients of the Program a copy of this General Public License
Xalong with the Program. You may charge a fee for the physical act of
Xtransferring a copy.
X
X@item
XYou may modify your copy or copies of the Program or any portion of
Xit, and copy and distribute such modifications under the terms of Paragraph
X1 above, provided that you also do the following:
X
X@itemize @bullet
X@item
Xcause the modified files to carry prominent notices stating that
Xyou changed the files and the date of any change; and
X
X@item
Xcause the whole of any work that you distribute or publish, that
Xin whole or in part contains the Program or any part thereof, either
Xwith or without modifications, to be licensed at no charge to all
Xthird parties under the terms of this General Public License (except
Xthat you may choose to grant warranty protection to some or all
Xthird parties, at your option).
X
X@item
XIf the modified program normally reads commands interactively when
Xrun, you must cause it, when started running for such interactive use
Xin the simplest and most usual way, to print or display an
Xannouncement including an appropriate copyright notice and a notice
Xthat there is no warranty (or else, saying that you provide a
Xwarranty) and that users may redistribute the program under these
Xconditions, and telling the user how to view a copy of this General
XPublic License.
X
X@item
XYou may charge a fee for the physical act of transferring a
Xcopy, and you may at your option offer warranty protection in
Xexchange for a fee.
X@end itemize
X
XMere aggregation of another independent work with the Program (or its
Xderivative) on a volume of a storage or distribution medium does not bring
Xthe other work under the scope of these terms.
X
X@item
XYou may copy and distribute the Program (or a portion or derivative of
Xit, under Paragraph 2) in object code or executable form under the terms of
XParagraphs 1 and 2 above provided that you also do one of the following:
X
X@itemize @bullet
X@item
Xaccompany it with the complete corresponding machine-readable
Xsource code, which must be distributed under the terms of
XParagraphs 1 and 2 above; or,
X
X@item
Xaccompany it with a written offer, valid for at least three
Xyears, to give any third party free (except for a nominal charge
Xfor the cost of distribution) a complete machine-readable copy of the
Xcorresponding source code, to be distributed under the terms of
XParagraphs 1 and 2 above; or,
X
X@item
Xaccompany it with the information you received as to where the
Xcorresponding source code may be obtained. (This alternative is
Xallowed only for noncommercial distribution and only if you
Xreceived the program in object code or executable form alone.)
X@end itemize
X
XSource code for a work means the preferred form of the work for making
Xmodifications to it. For an executable file, complete source code means
Xall the source code for all modules it contains; but, as a special
Xexception, it need not include source code for modules which are standard
Xlibraries that accompany the operating system on which the executable
Xfile runs, or for standard header files or definitions files that
Xaccompany that operating system.
X
X@item
XYou may not copy, modify, sublicense, distribute or transfer the
XProgram except as expressly provided under this General Public License.
XAny attempt otherwise to copy, modify, sublicense, distribute or transfer
Xthe Program is void, and will automatically terminate your rights to use
Xthe Program under this License. However, parties who have received
Xcopies, or rights to use copies, from you under this General Public
XLicense will not have their licenses terminated so long as such parties
Xremain in full compliance.
X
X@item
XBy copying, distributing or modifying the Program (or any work based
Xon the Program) you indicate your acceptance of this license to do so,
Xand all its terms and conditions.
X
X@item
XEach time you redistribute the Program (or any work based on the
XProgram), the recipient automatically receives a license from the original
Xlicensor to copy, distribute or modify the Program subject to these
Xterms and conditions. You may not impose any further restrictions on the
Xrecipients' exercise of the rights granted herein.
X
X@item
XThe Free Software Foundation may publish revised and/or new versions
Xof the General Public License from time to time. Such new versions will
Xbe similar in spirit to the present version, but may differ in detail to
Xaddress new problems or concerns.
X
XEach version is given a distinguishing version number. If the Program
Xspecifies a version number of the license which applies to it and ``any
Xlater version'', you have the option of following the terms and conditions
Xeither of that version or of any later version published by the Free
XSoftware Foundation. If the Program does not specify a version number of
Xthe license, you may choose any version ever published by the Free Software
XFoundation.
X
X@item
XIf you wish to incorporate parts of the Program into other free
Xprograms whose distribution conditions are different, write to the author
Xto ask for permission. For software which is copyrighted by the Free
XSoftware Foundation, write to the Free Software Foundation; we sometimes
Xmake exceptions for this. Our decision will be guided by the two goals
Xof preserving the free status of all derivatives of our free software and
Xof promoting the sharing and reuse of software generally.
X
X@iftex
X@heading NO WARRANTY
X@end iftex
X@ifinfo
X@center NO WARRANTY
X@end ifinfo
X
X@item
XBECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
XFOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
XOTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
XPROVIDE THE PROGRAM ``AS IS'' WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
XOR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
XMERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
XTO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
XPROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
XREPAIR OR CORRECTION.
X
X@item
XIN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL
XANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
XREDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
XINCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES
XARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT
XLIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES
XSUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE
XWITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN
XADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
X@end enumerate
X
X@node Introduction, Data Types, Quick Overview, Top
X@chapter Introduction
X
X@dfn{Calc} is an advanced calculator and mathematical tool that runs as
Xpart of the GNU Emacs environment. Very roughly based on the HP-28/48
Xseries of calculators, its many features include:
X
X@itemize @bullet
X@item
XChoice of algebraic or RPN style entry of calculations.
X@item
XArbitrary precision integers and floating-point numbers.
X@item
XArithmetic on rational numbers, complex numbers (rectangular and polar),
Xerror forms with standard deviations, open and closed intervals, vectors
Xand matrices, quantities with units, and simple algebraic expressions.
X@item
XMathematical operations such as logarithms and trig functions.
X@item
XProgrammer's features (bitwise operations, non-decimal integers).
X@item
XNumber theoretical features such as prime factorization and arithmetic
Xmodulo M for any M.
X@item
XAlgebraic manipulation features, including symbolic calculus.
X@item
XKill and yank to and from regular editing buffers.
X@item
XEasy programming using keyboard macros, algebraic formulas,
Xalgebraic rewrite rules, or Lisp code.
X@end itemize
X
XCalc tries to include a little something for everyone; as a result it is
Xlarge and might be intimidating to the first-time user. If you plan to
Xuse Calc only as a traditional desk calculator, all you really need to
Xread is the ``Quick Overview'' section of this manual and possibly a few
Xof the other introductory sections. As you become more comfortable with
Xthe program you can learn its additional features. In terms of efficiency,
Xscope and depth, Calc cannot replace a powerful tool like Mathematica (tm).
XBut Calc has the advantages of convenience, portability, and availability
Xof the source code. And, of course, it's free!
X
X@pindex calc
X@pindex calc-mode
X@cindex Starting the Calculator
X@cindex Running the Calculator
XTo start the Calculator, type @kbd{M-x calc}. By default this creates
Xa pair of small windows, @samp{*Calculator*} and @samp{*Calc Trail*}.
XThe former displays the contents of the Calculator stack and is manipulated
Xexclusively through Calc commands. It is possible (though not usually
Xnecessary) to create several Calc Mode buffers each of which has an
Xindependent stack, undo list, and mode settings. There is exactly one
XCalc Trail buffer; it records a list of the results of all calculations
SHAR_EOF
echo "End of part 11"
echo "File calc.texinfo is continued in part 12"
echo "12" > s2_seq_.tmp
exit 0