Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume24/gnucalc/part17

Text File | 1991-10-29 | 55.2 KB | 1,779 lines

Newsgroups: comp.sources.misc
From: [e-mail] (David Gillespie)
Subject:  v24i065:  gnucalc - GNU Emacs Calculator, v2.00, Part17/56
Message-ID: <[e-mail]>
X-Md4-Signature: 59d8d4f7efa51197627b2983be2f9fa6
Date: Tue, 29 Oct 1991 23:03:48 GMT
Approved: [e-mail]

Submitted-by: [e-mail] (David Gillespie)
Posting-number: Volume 24, Issue 65
Archive-name: gnucalc/part17
Environment: Emacs
Supersedes: gmcalc: Volume 13, Issue 27-45

---- Cut Here and unpack ----
#!/bin/sh
# do not concatenate these parts, unpack them in order with /bin/sh
# file calc-funcs.el continued
#
if test ! -r _shar_seq_.tmp; then
    echo 'Please unpack part 1 first!'
    exit 1
fi
(read Scheck
 if test "$Scheck" != 17; then
    echo Please unpack part "$Scheck" next!
    exit 1
 else
    exit 0
 fi
) < _shar_seq_.tmp || exit 1
if test ! -f _shar_wnt_.tmp; then
    echo 'x - still skipping calc-funcs.el'
else
echo 'x - continuing file calc-funcs.el'
sed 's/^X//' << 'SHAR_EOF' >> 'calc-funcs.el' &&
X               by byp))
X           by)))))
)
X
(defun math-besY0 (x)
X  (cond ((Math-lessp (math-abs-approx x) '(float 8 0))
X     (let ((y (math-sqr x)))
X       (math-add
X        (math-div (math-poly-eval y
X                      '((float (bigpos 733 622 284 2) -7)
X                    (float (bigneg 757 792 632 8) -5)
X                    (float (bigpos 129 988 087 1) -2)
X                    (float (bigneg 036 598 123 5) -1)
X                    (float (bigpos 065 834 062 7) 0)
X                    (float (bigneg 389 821 957 2) 0)))
X              (math-poly-eval y
X                      '((float 1 0)
X                    (float (bigpos 244 030 261 2) -7)
X                    (float (bigpos 647 472 474) -4)
X                    (float (bigpos 438 466 189 7) -3)
X                    (float (bigpos 648 499 452 7) -1)
X                    (float (bigpos 269 544 076 40) 0))))
X        (math-mul '(float (bigpos 772 619 636) -9)
X              (math-mul (math-besJ0 x) (math-ln-raw x))))))
X    ((math-negp (calcFunc-re x))
X     (math-add (math-besJ0 (math-neg x) t)
X           (math-mul '(cplx 0 2)
X                 (math-besJ0 (math-neg x)))))
X    (t
X     (math-besJ0 x t)))
)
X
(defun math-besY1 (x)
X  (cond ((Math-lessp (math-abs-approx x) '(float 8 0))
X     (let ((y (math-sqr x)))
X       (math-add
X        (math-mul
X         x
X         (math-div (math-poly-eval y
X                       '((float (bigpos 935 937 511 8) -6)
X                     (float (bigneg 726 922 237 4) -3)
X                     (float (bigpos 551 264 349 7) -1)
X                     (float (bigneg 139 438 153 5) 1)
X                     (float (bigpos 439 527 127) 4)
X                     (float (bigneg 943 604 900 4) 3)))
X               (math-poly-eval y
X                       '((float 1 0)
X                     (float (bigpos 885 632 549 3) -7)
X                     (float (bigpos 605 042 102) -3)
X                     (float (bigpos 002 904 245 2) -2)
X                     (float (bigpos 367 650 733 3) 0)
X                     (float (bigpos 664 419 244 4) 2)
X                     (float (bigpos 057 958 249) 5)))))
X        (math-mul '(float (bigpos 772 619 636) -9)
X              (math-sub (math-mul (math-besJ1 x) (math-ln-raw x))
X                (math-div 1 x))))))
X    ((math-negp (calcFunc-re x))
X     (math-neg
X      (math-add (math-besJ1 (math-neg x) t)
X            (math-mul '(cplx 0 2)
X                  (math-besJ1 (math-neg x))))))
X    (t
X     (math-besJ1 x t)))
)
X
(defun math-poly-eval (x coefs)
X  (let ((accum (car coefs)))
X    (while (setq coefs (cdr coefs))
X      (setq accum (math-add (car coefs) (math-mul accum x))))
X    accum)
)
X
X
;;;; Bernoulli and Euler polynomials and numbers.
X
(defun calcFunc-bern (n &optional x)
X  (if (and x (not (math-zerop x)))
X      (if (and calc-symbolic-mode (math-floatp x))
X      (math-inexact-result)
X    (math-build-polynomial-expr (math-bernoulli-coefs n) x))
X    (or (math-num-natnump n) (math-reject-arg n 'natnump))
X    (if (consp n)
X    (progn
X      (math-inexact-result)
X      (math-float (math-bernoulli-number (math-trunc n))))
X      (math-bernoulli-number n)))
)
X
(defun calcFunc-euler (n &optional x)
X  (or (math-num-natnump n) (math-reject-arg n 'natnump))
X  (if x
X      (let* ((n1 (math-add n 1))
X         (coefs (math-bernoulli-coefs n1))
X         (fac (math-div (math-pow 2 n1) n1))
X         (k -1)
X         (x1 (math-div (math-add x 1) 2))
X         (x2 (math-div x 2)))
X    (if (math-numberp x)
X        (if (and calc-symbolic-mode (math-floatp x))
X        (math-inexact-result)
X          (math-mul fac
X            (math-sub (math-build-polynomial-expr coefs x1)
X                  (math-build-polynomial-expr coefs x2))))
X      (calcFunc-collect
X       (math-reduce-vec
X        'math-add
X        (cons 'vec
X          (mapcar (function
X               (lambda (c)
X                 (setq k (1+ k))
X                 (math-mul (math-mul fac c)
X                       (math-sub (math-pow x1 k)
X                         (math-pow x2 k)))))
X              coefs)))
X       x)))
X    (math-mul (math-pow 2 n)
X          (if (consp n)
X          (progn
X            (math-inexact-result)
X            (calcFunc-euler n '(float 5 -1)))
X        (calcFunc-euler n '(frac 1 2)))))
)
X
(defun math-bernoulli-coefs (n)
X  (let* ((coefs (list (calcFunc-bern n)))
X     (nn (math-trunc n))
X     (k nn)
X     (term nn)
X     coef
X     (calc-prefer-frac (or (integerp n) calc-prefer-frac)))
X    (while (>= (setq k (1- k)) 0)
X      (setq term (math-div term (- nn k))
X        coef (math-mul term (math-bernoulli-number k))
X        coefs (cons (if (consp n) (math-float coef) coef) coefs)
X        term (math-mul term k)))
X    (nreverse coefs))
)
X
(defun math-bernoulli-number (n)
X  (if (= (% n 2) 1)
X      (if (= n 1)
X      '(frac -1 2)
X    0)
X    (setq n (/ n 2))
X    (while (>= n math-bernoulli-cache-size)
X      (let* ((sum 0)
X         (nk 1)     ; nk = n-k+1
X         (fact 1)   ; fact = (n-k+1)!
X         ofact
X         (p math-bernoulli-b-cache)
X         (calc-prefer-frac t))
X    (math-working "bernoulli B" (* 2 math-bernoulli-cache-size))
X    (while p
X      (setq nk (+ nk 2)
X        ofact fact
X        fact (math-mul fact (* nk (1- nk)))
X        sum (math-add sum (math-div (car p) fact))
X        p (cdr p)))
X    (setq ofact (math-mul ofact (1- nk))
X          sum (math-sub (math-div '(frac 1 2) ofact) sum)
X          math-bernoulli-b-cache (cons sum math-bernoulli-b-cache)
X          math-bernoulli-B-cache (cons (math-mul sum ofact)
X                       math-bernoulli-B-cache)
X          math-bernoulli-cache-size (1+ math-bernoulli-cache-size))))
X    (nth (- math-bernoulli-cache-size n 1) math-bernoulli-B-cache))
)
X
;;;   Bn = n! bn
;;;   bn = - sum_k=0^n-1 bk / (n-k+1)!
X
;;; A faster method would be to use "tangent numbers", c.f., Concrete
;;; Mathematics pg. 273.
X
(setq math-bernoulli-b-cache '( (frac -174611
X                      (bigpos 0 200 291 698 662 857 802))
X                (frac 43867 (bigpos 0 944 170 217 94 109 5))
X                (frac -3617 (bigpos 0 880 842 622 670 10))
X                (frac 1 (bigpos 600 249 724 74))
X                (frac -691 (bigpos 0 368 674 307 1))
X                (frac 1 (bigpos 160 900 47))
X                (frac -1 (bigpos 600 209 1))
X                (frac 1 30240) (frac -1 720)
X                (frac 1 12) 1 ))
X
(setq math-bernoulli-B-cache '( (frac -174611 330) (frac 43867 798)
X                (frac -3617 510) (frac 7 6) (frac -691 2730)
X                (frac 5 66) (frac -1 30) (frac 1 42)
X                (frac -1 30) (frac 1 6) 1 ))
X
(setq math-bernoulli-cache-size 11)
X
X
X
;;; Probability distributions.
X
;;; Binomial.
(defun calcFunc-utpb (x n p)
X  (if math-expand-formulas
X      (math-normalize (list 'calcFunc-betaI p x (list '+ (list '- n x) 1)))
X    (calcFunc-betaI p x (math-add (math-sub n x) 1)))
)
(put 'calcFunc-utpb 'math-expandable t)
X
(defun calcFunc-ltpb (x n p)
X  (math-sub 1 (calcFunc-utpb x n p))
)
(put 'calcFunc-ltpb 'math-expandable t)
X
;;; Chi-square.
(defun calcFunc-utpc (chisq v)
X  (if math-expand-formulas
X      (math-normalize (list 'calcFunc-gammaQ (list '/ v 2) (list '/ chisq 2)))
X    (calcFunc-gammaQ (math-div v 2) (math-div chisq 2)))
)
(put 'calcFunc-utpc 'math-expandable t)
X
(defun calcFunc-ltpc (chisq v)
X  (if math-expand-formulas
X      (math-normalize (list 'calcFunc-gammaP (list '/ v 2) (list '/ chisq 2)))
X    (calcFunc-gammaP (math-div v 2) (math-div chisq 2)))
)
(put 'calcFunc-ltpc 'math-expandable t)
X
;;; F-distribution.
(defun calcFunc-utpf (f v1 v2)
X  (if math-expand-formulas
X      (math-normalize (list 'calcFunc-betaI
X                (list '/ v2 (list '+ v2 (list '* v1 f)))
X                (list '/ v2 2)
X                (list '/ v1 2)))
X    (calcFunc-betaI (math-div v2 (math-add v2 (math-mul v1 f)))
X            (math-div v2 2)
X            (math-div v1 2)))
)
(put 'calcFunc-utpf 'math-expandable t)
X
(defun calcFunc-ltpf (f v1 v2)
X  (math-sub 1 (calcFunc-utpf f v1 v2))
)
(put 'calcFunc-ltpf 'math-expandable t)
X
;;; Normal.
(defun calcFunc-utpn (x mean sdev)
X  (if math-expand-formulas
X      (math-normalize
X       (list '/
X         (list '+ 1
X           (list 'calcFunc-erf
X             (list '/ (list '- mean x)
X                   (list '* sdev (list 'calcFunc-sqrt 2)))))
X         2))
X    (math-mul (math-add '(float 1 0)
X            (calcFunc-erf
X             (math-div (math-sub mean x)
X                   (math-mul sdev (math-sqrt-2)))))
X          '(float 5 -1)))
)
(put 'calcFunc-utpn 'math-expandable t)
X
(defun calcFunc-ltpn (x mean sdev)
X  (if math-expand-formulas
X      (math-normalize
X       (list '/
X         (list '+ 1
X           (list 'calcFunc-erf
X             (list '/ (list '- x mean)
X                   (list '* sdev (list 'calcFunc-sqrt 2)))))
X         2))
X    (math-mul (math-add '(float 1 0)
X            (calcFunc-erf
X             (math-div (math-sub x mean)
X                   (math-mul sdev (math-sqrt-2)))))
X          '(float 5 -1)))
)
(put 'calcFunc-ltpn 'math-expandable t)
X
;;; Poisson.
(defun calcFunc-utpp (n x)
X  (if math-expand-formulas
X      (math-normalize (list 'calcFunc-gammaP x n))
X    (calcFunc-gammaP x n))
)
(put 'calcFunc-utpp 'math-expandable t)
X
(defun calcFunc-ltpp (n x)
X  (if math-expand-formulas
X      (math-normalize (list 'calcFunc-gammaQ x n))
X    (calcFunc-gammaQ x n))
)
(put 'calcFunc-ltpp 'math-expandable t)
X
;;; Student's t.  (As defined in Abramowitz & Stegun and Numerical Recipes.)
(defun calcFunc-utpt (tt v)
X  (if math-expand-formulas
X      (math-normalize (list 'calcFunc-betaI
X                (list '/ v (list '+ v (list '^ tt 2)))
X                (list '/ v 2)
X                '(float 5 -1)))
X    (calcFunc-betaI (math-div v (math-add v (math-sqr tt)))
X            (math-div v 2)
X            '(float 5 -1)))
)
(put 'calcFunc-utpt 'math-expandable t)
X
(defun calcFunc-ltpt (tt v)
X  (math-sub 1 (calcFunc-utpt tt v))
)
(put 'calcFunc-ltpt 'math-expandable t)
X
X
X
X
SHAR_EOF
echo 'File calc-funcs.el is complete' &&
chmod 0644 calc-funcs.el ||
echo 'restore of calc-funcs.el failed'
Wc_c="`wc -c < 'calc-funcs.el'`"
test 30406 -eq "$Wc_c" ||
    echo 'calc-funcs.el: original size 30406, current size' "$Wc_c"
rm -f _shar_wnt_.tmp
fi
# ============= calc-graph.el ==============
if test -f 'calc-graph.el' -a X"$1" != X"-c"; then
    echo 'x - skipping calc-graph.el (File already exists)'
    rm -f _shar_wnt_.tmp
else
> _shar_wnt_.tmp
echo 'x - extracting calc-graph.el (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'calc-graph.el' &&
;; Calculator for GNU Emacs, part II [calc-graph.el]
;; Copyright (C) 1990, 1991 Free Software Foundation, Inc.
;; Written by Dave Gillespie, [e-mail].
X
;; This file is part of GNU Emacs.
X
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY.  No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing.  Refer to the GNU Emacs General Public
;; License for full details.
X
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License.   A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities.  It should be in a
;; file named COPYING.  Among other things, the copyright notice
;; and this notice must be preserved on all copies.
X
X
X
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
X
(require 'calc-macs)
X
(defun calc-Need-calc-graph () nil)
X
X
;;; Graphics
X
;;; Note that some of the following initial values also occur in calc.el.
(defvar calc-gnuplot-tempfile "/tmp/calc")
X
(defvar calc-gnuplot-default-device "default")
(defvar calc-gnuplot-default-output "STDOUT")
(defvar calc-gnuplot-print-device "postscript")
(defvar calc-gnuplot-print-output "auto")
(defvar calc-gnuplot-keep-outfile nil)
(defvar calc-gnuplot-version nil)
X
(defvar calc-gnuplot-display (getenv "DISPLAY"))
(defvar calc-gnuplot-geometry nil)
X
(defvar calc-graph-default-resolution 15)
(defvar calc-graph-default-resolution-3d 5)
(defvar calc-graph-default-precision 5)
X
(defvar calc-gnuplot-buffer nil)
(defvar calc-gnuplot-input nil)
X
(defvar calc-gnuplot-last-error-pos 1)
(defvar calc-graph-last-device nil)
(defvar calc-graph-last-output nil)
(defvar calc-graph-file-cache nil)
(defvar calc-graph-var-cache nil)
(defvar calc-graph-data-cache nil)
(defvar calc-graph-data-cache-limit 10)
X
(defun calc-graph-fast (many)
X  (interactive "P")
X  (let ((calc-graph-no-auto-view t))
X    (calc-graph-delete t)
X    (calc-graph-add many)
X    (calc-graph-plot nil))
)
X
(defun calc-graph-fast-3d (many)
X  (interactive "P")
X  (let ((calc-graph-no-auto-view t))
X    (calc-graph-delete t)
X    (calc-graph-add-3d many)
X    (calc-graph-plot nil))
)
X
(defun calc-graph-delete (all)
X  (interactive "P")
X  (calc-wrapper
X   (calc-graph-init)
X   (save-excursion
X     (set-buffer calc-gnuplot-input)
X     (and (calc-graph-find-plot t all)
X      (progn
X        (if (looking-at "s?plot")
X        (progn
X          (setq calc-graph-var-cache nil)
X          (delete-region (point) (point-max)))
X          (delete-region (point) (1- (point-max)))))))
X   (calc-graph-view-commands))
)
X
(defun calc-graph-find-plot (&optional before all)
X  (goto-char (point-min))
X  (and (re-search-forward "^s?plot[ \t]+" nil t)
X       (let ((beg (point)))
X     (goto-char (point-max))
X     (if (or all
X         (not (search-backward "," nil t))
X         (< (point) beg))
X         (progn
X           (goto-char beg)
X           (if before
X           (beginning-of-line)))
X       (or before
X           (re-search-forward ",[ \t]+")))
X     t))
)
X
(defun calc-graph-add (many)
X  (interactive "P")
X  (calc-wrapper
X   (calc-graph-init)
X   (cond ((null many)
X      (calc-graph-add-curve (calc-graph-lookup (calc-top-n 2))
X                (calc-graph-lookup (calc-top-n 1))))
X     ((or (consp many) (eq many 0))
X      (let ((xdata (calc-graph-lookup (calc-top-n 2)))
X        (ylist (calc-top-n 1)))
X        (or (eq (car-safe ylist) 'vec)
X        (error "Y argument must be a vector"))
X        (while (setq ylist (cdr ylist))
X          (calc-graph-add-curve xdata (calc-graph-lookup (car ylist))))))
X     ((> (setq many (prefix-numeric-value many)) 0)
X      (let ((xdata (calc-graph-lookup (calc-top-n (1+ many)))))
X        (while (> many 0)
X          (calc-graph-add-curve xdata
X                    (calc-graph-lookup (calc-top-n many)))
X          (setq many (1- many)))))
X     (t
X      (let (pair)
X        (setq many (- many))
X        (while (> many 0)
X          (setq pair (calc-top-n many))
X          (or (and (eq (car-safe pair) 'vec)
X               (= (length pair) 3))
X          (error "Argument must be an [x,y] vector"))
X          (calc-graph-add-curve (calc-graph-lookup (nth 1 pair))
X                    (calc-graph-lookup (nth 2 pair)))
X          (setq many (1- many))))))
X   (calc-graph-view-commands))
)
X
(defun calc-graph-add-3d (many)
X  (interactive "P")
X  (calc-wrapper
X   (calc-graph-init)
X   (cond ((null many)
X      (calc-graph-add-curve (calc-graph-lookup (calc-top-n 3))
X                (calc-graph-lookup (calc-top-n 2))
X                (calc-graph-lookup (calc-top-n 1))))
X     ((or (consp many) (eq many 0))
X      (let ((xdata (calc-graph-lookup (calc-top-n 3)))
X        (ydata (calc-graph-lookup (calc-top-n 2)))
X        (zlist (calc-top-n 1)))
X        (or (eq (car-safe zlist) 'vec)
X        (error "Z argument must be a vector"))
X        (while (setq zlist (cdr zlist))
X          (calc-graph-add-curve xdata ydata
X                    (calc-graph-lookup (car zlist))))))
X     ((> (setq many (prefix-numeric-value many)) 0)
X      (let ((xdata (calc-graph-lookup (calc-top-n (+ many 2))))
X        (ydata (calc-graph-lookup (calc-top-n (+ many 1)))))
X        (while (> many 0)
X          (calc-graph-add-curve xdata ydata
X                    (calc-graph-lookup (calc-top-n many)))
X          (setq many (1- many)))))
X     (t
X      (let (curve)
X        (setq many (- many))
X        (while (> many 0)
X          (setq curve (calc-top-n many))
X          (or (and (eq (car-safe curve) 'vec)
X               (= (length curve) 4))
X          (error "Argument must be an [x,y,z] vector"))
X          (calc-graph-add-curve (calc-graph-lookup (nth 1 curve))
X                    (calc-graph-lookup (nth 2 curve))
X                    (calc-graph-lookup (nth 3 curve)))
X          (setq many (1- many))))))
X   (calc-graph-view-commands))
)
X
(defun calc-graph-add-curve (xdata ydata &optional zdata)
X  (let ((num (calc-graph-count-curves))
X    (pstyle (calc-var-value 'var-PointStyles))
X    (lstyle (calc-var-value 'var-LineStyles)))
X    (save-excursion
X      (set-buffer calc-gnuplot-input)
X      (goto-char (point-min))
X      (if (re-search-forward (if zdata "^plot[ \t]" "^splot[ \t]")
X                 nil t)
X      (error "Can't mix 2d and 3d curves on one graph"))
X      (if (re-search-forward "^s?plot[ \t]" nil t)
X      (progn
X        (end-of-line)
X        (insert ", "))
X    (goto-char (point-max))
X    (or (eq (preceding-char) ?\n)
X        (insert "\n"))
X    (insert (if zdata "splot" "plot") " \n")
X    (forward-char -1))
X      (insert "{" (symbol-name (nth 1 xdata))
X          ":" (symbol-name (nth 1 ydata)))
X      (if zdata
X      (insert ":" (symbol-name (nth 1 zdata))))
X      (insert "} "
X          "title \"" (symbol-name (nth 1 ydata)) "\" "
X          "with dots")
X      (setq pstyle (and (eq (car-safe pstyle) 'vec) (nth (1+ num) pstyle)))
X      (setq lstyle (and (eq (car-safe lstyle) 'vec) (nth (1+ num) lstyle)))
X      (calc-graph-set-styles
X       (or (and (Math-num-integerp lstyle) (math-trunc lstyle))
X       0)
X       (or (and (Math-num-integerp pstyle) (math-trunc pstyle))
X       (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
X           0 -1)))))
)
X
(defun calc-graph-lookup (thing)
X  (if (and (eq (car-safe thing) 'var)
X       (calc-var-value (nth 2 thing)))
X      thing
X    (let ((found (assoc thing calc-graph-var-cache)))
X      (or found
X      (progn
X        (setq varname (concat "PlotData"
X                  (int-to-string
X                   (1+ (length calc-graph-var-cache))))
X          var (list 'var (intern varname)
X                (intern (concat "var-" varname)))
X          found (cons thing var)
X          calc-graph-var-cache (cons found calc-graph-var-cache))
X        (set (nth 2 var) thing)))
X      (cdr found)))
)
X
(defun calc-graph-juggle (arg)
X  (interactive "p")
X  (calc-graph-init)
X  (save-excursion
X    (set-buffer calc-gnuplot-input)
X    (if (< arg 0)
X    (let ((num (calc-graph-count-curves)))
X      (if (> num 0)
X          (while (< arg 0)
X        (setq arg (+ arg num))))))
X    (while (>= (setq arg (1- arg)) 0)
X      (calc-graph-do-juggle)))
)
X
(defun calc-graph-count-curves ()
X  (save-excursion
X    (set-buffer calc-gnuplot-input)
X    (if (re-search-forward "^s?plot[ \t]" nil t)
X    (let ((num 1))
X      (goto-char (point-min))
X      (while (search-forward "," nil t)
X        (setq num (1+ num)))
X      num)
X      0))
)
X
(defun calc-graph-do-juggle ()
X  (let (base)
X    (and (calc-graph-find-plot t t)
X     (progn
X       (setq base (point))
X       (calc-graph-find-plot t nil)
X       (or (eq base (point))
X           (let ((str (buffer-substring (+ (point) 2) (1- (point-max)))))
X         (delete-region (point) (1- (point-max)))
X         (goto-char (+ base 5))
X         (insert str ", "))))))
)
X
(defun calc-graph-print (flag)
X  (interactive "P")
X  (calc-graph-plot flag t)
)
X
(defun calc-graph-plot (flag &optional printing)
X  (interactive "P")
X  (calc-slow-wrapper
X   (let ((calcbuf (current-buffer))
X     (tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
X     (tempbuftop 1)
X     (tempoutfile nil)
X     (curve-num 0)
X     (refine (and flag (> (prefix-numeric-value flag) 0)))
X     (recompute (and flag (< (prefix-numeric-value flag) 0)))
X     (surprise-splot nil)
X     (tty-output nil)
X     cache-env is-splot device output resolution precision samples-pos)
X     (or (boundp 'calc-graph-prev-kill-hook)
X     (progn
X       (setq calc-graph-prev-kill-hook kill-emacs-hook)
X       (setq kill-emacs-hook 'calc-graph-kill-hook)))
X     (save-excursion
X       (calc-graph-init)
X       (set-buffer tempbuf)
X       (erase-buffer)
X       (set-buffer calc-gnuplot-input)
X       (goto-char (point-min))
X       (setq is-splot (re-search-forward "^splot[ \t]" nil t))
X       (let ((str (buffer-string))
X         (ver calc-gnuplot-version))
X     (set-buffer (get-buffer-create "*Gnuplot Temp*"))
X     (erase-buffer)
X     (insert "# (Note: This is a temporary copy---do not edit!)\n")
X     (if (>= ver 2)
X         (insert "set noarrow\nset nolabel\n"
X             "set autoscale xy\nset nologscale xy\n"
X             "set xlabel\nset ylabel\nset title\n"
X             "set noclip points\nset clip one\nset clip two\n"
X             "set format \"%g\"\nset tics\nset xtics\nset ytics\n"
X             "set data style linespoints\n"
X             "set nogrid\nset nokey\nset nopolar\n"))
X     (if (>= ver 3)
X         (insert "set surface\nset nocontour\n"
X             "set " (if is-splot "" "no") "parametric\n"
X             "set notime\nset border\nset ztics\nset zeroaxis\n"
X             "set view 60,30,1,1\nset offsets 0,0,0,0\n"))
X     (setq samples-pos (point))
X     (insert "\n\n" str))
X       (goto-char (point-min))
X       (if is-splot
X       (if refine
X           (error "This option works only for 2d plots")
X         (setq recompute t)))
X       (let ((calc-gnuplot-input (current-buffer))
X         (calc-graph-no-auto-view t))
X     (if printing
X         (setq device calc-gnuplot-print-device
X           output calc-gnuplot-print-output)
X       (setq device (calc-graph-find-command "terminal")
X         output (calc-graph-find-command "output"))
X       (or device
X           (setq device calc-gnuplot-default-device))
X       (if output
X           (setq output (car (read-from-string output)))
X         (setq output calc-gnuplot-default-output)))
X     (if (or (equal device "") (equal device "default"))
X         (setq device (if printing
X                  "postscript"
X                (if (or (eq window-system 'x) (getenv "DISPLAY"))
X                "x11"
X                  (if (>= calc-gnuplot-version 3)
X                  "dumb" "postscript")))))
X     (if (equal device "dumb")
X         (setq device (format "dumb %d %d"
X                  (1- (screen-width)) (1- (screen-height)))))
X     (if (equal device "big")
X         (setq device (format "dumb %d %d"
X                  (* 4 (- (screen-width) 3))
X                  (* 4 (- (screen-height) 3)))))
X     (if (stringp output)
X         (if (or (equal output "auto")
X             (and (equal output "tty") (setq tty-output t)))
X         (setq tempoutfile (calc-temp-file-name -1)
X               output tempoutfile))
X       (setq output (eval output)))
X     (or (equal device calc-graph-last-device)
X         (progn
X           (setq calc-graph-last-device device)
X           (calc-gnuplot-command "set terminal" device)))
X     (or (equal output calc-graph-last-output)
X         (progn
X           (setq calc-graph-last-output output)
X           (calc-gnuplot-command "set output"
X                     (if (equal output "STDOUT")
X                     ""
X                       (prin1-to-string output)))))
X     (setq resolution (calc-graph-find-command "samples"))
X     (if resolution
X         (setq resolution (string-to-int resolution))
X       (setq resolution (if is-splot
X                calc-graph-default-resolution-3d
X                  calc-graph-default-resolution)))
X     (setq precision (calc-graph-find-command "precision"))
X     (if precision
X         (setq precision (string-to-int precision))
X       (setq precision calc-graph-default-precision))
X     (calc-graph-set-command "terminal")
X     (calc-graph-set-command "output")
X     (calc-graph-set-command "samples")
X     (calc-graph-set-command "precision"))
X       (goto-char samples-pos)
X       (insert "set samples " (int-to-string (max (if is-splot 20 200)
X                          (+ 5 resolution))) "\n")
X       (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t)
X     (delete-region (match-beginning 0) (match-end 0))
X     (if (looking-at ",")
X         (delete-char 1)
X       (while (memq (preceding-char) '(?\ ?\t))
X         (forward-char -1))
X       (if (eq (preceding-char) ?\,)
X           (delete-backward-char 1))))
X       (save-excursion
X     (set-buffer calcbuf)
X     (setq cache-env (list calc-angle-mode
X                   calc-complex-mode
X                   calc-simplify-mode
X                   calc-infinite-mode
X                   calc-word-size
X                   precision is-splot))
X     (if (and (not recompute)
X          (equal (cdr (car calc-graph-data-cache)) cache-env))
X         (while (> (length calc-graph-data-cache)
X               calc-graph-data-cache-limit)
X           (setcdr calc-graph-data-cache
X               (cdr (cdr calc-graph-data-cache))))
X       (setq calc-graph-data-cache (list (cons nil cache-env)))))
X       (calc-graph-find-plot t t)
X       (while (re-search-forward
X           (if is-splot
X           "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}"
X         "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}")
X           nil t)
X     (setq curve-num (1+ curve-num))
X     (let* ((xname (buffer-substring (match-beginning 1) (match-end 1)))
X        (xvar (intern (concat "var-" xname)))
X        (xvalue (math-evaluate-expr (calc-var-value xvar)))
X        (y3name (and is-splot
X                 (buffer-substring (match-beginning 2)
X                           (match-end 2))))
X        (y3var (and is-splot (intern (concat "var-" y3name))))
X        (y3value (and is-splot (calc-var-value y3var)))
X        (yname (buffer-substring (match-beginning 3) (match-end 3)))
X        (yvar (intern (concat "var-" yname)))
X        (yvalue (calc-var-value yvar))
X        filename)
X       (delete-region (match-beginning 0) (match-end 0))
X       (setq filename (calc-temp-file-name curve-num))
X       (save-excursion
X         (set-buffer calcbuf)
X         (let (tempbuftop
X           (xp xvalue)
X           (yp yvalue)
X           (zp nil)
X           (xlow nil) (xhigh nil) (y3low nil) (y3high nil)
X           xvec xval xstep var-DUMMY
X           y3vec y3val y3step var-DUMMY2 (zval nil)
X           yvec yval ycache ycacheptr yvector
X           numsteps numsteps3
X           (keep-file (and (not is-splot) (file-exists-p filename)))
X           (stepcount 0)
X           (calc-symbolic-mode nil)
X           (calc-prefer-frac nil)
X           (calc-internal-prec (max 3 precision))
X           (calc-simplify-mode (and (not (memq calc-simplify-mode
X                               '(none num)))
X                        calc-simplify-mode))
X           (blank t)
X           (non-blank nil)
X           (math-working-step 0)
X           (math-working-step-2 nil))
X           (save-excursion
X         (if is-splot
X             (calc-graph-compute-3d)
X           (calc-graph-compute-2d))
X         (set-buffer tempbuf)
X         (goto-char (point-max))
X         (insert "\n" xname)
X         (if is-splot
X             (insert ":" y3name))
X         (insert ":" yname "\n\n")
X         (setq tempbuftop (point))
X         (let ((calc-group-digits nil)
X               (calc-leading-zeros nil)
X               (calc-number-radix 10)
X               (entry (and (not is-splot)
X                   (list xp yp xhigh numsteps))))
X           (or (equal entry
X                  (nth 1 (nth (1+ curve-num)
X                      calc-graph-file-cache)))
X               (setq keep-file nil))
X           (setcar (cdr (nth (1+ curve-num) calc-graph-file-cache))
X               entry)
X           (or keep-file
X               (calc-graph-format-data)))
X         (or keep-file
X             (progn
X               (or non-blank
X               (error "No valid data points for %s:%s"
X                  xname yname))
X               (write-region tempbuftop (point-max) filename
X                     nil 'quiet))))))
X       (insert (prin1-to-string filename))))
X       (if surprise-splot
X       (setcdr cache-env nil))
X       (if (= curve-num 0)
X       (progn
X         (calc-gnuplot-command "clear")
X         (calc-clear-command-flag 'clear-message)
X         (message "No data to plot!"))
X     (setq calc-graph-data-cache-limit (max curve-num
X                        calc-graph-data-cache-limit)
X           filename (calc-temp-file-name 0))
X     (write-region (point-min) (point-max) filename nil 'quiet)
X     (calc-gnuplot-command "load" (prin1-to-string filename))
X     (or (equal output "STDOUT")
X         calc-gnuplot-keep-outfile
X         (progn   ; need to close the output file before printing/plotting
X           (setq calc-graph-last-output "STDOUT")
X           (calc-gnuplot-command "set output")))
X     (let ((command (if printing
X                calc-gnuplot-print-command
X              (or calc-gnuplot-plot-command
X                  (and (string-match "^dumb" device)
X                   'calc-graph-show-dumb)
X                  (and tty-output
X                   'calc-graph-show-tty)))))
X       (if command
X           (if (stringp command)
X           (calc-gnuplot-command
X            "!" (format command
X                (or tempoutfile
X                    calc-gnuplot-print-output)))
X         (if (symbolp command)
X             (funcall command output)
X           (eval command)))))))))
)
X
(defun calc-graph-compute-2d ()
X  (if (setq yvec (eq (car-safe yvalue) 'vec))
X      (if (= (setq numsteps (1- (length yvalue))) 0)
X      (error "Can't plot an empty vector")
X    (if (setq xvec (eq (car-safe xvalue) 'vec))
X        (or (= (1- (length xvalue)) numsteps)
X        (error "%s and %s have different lengths" xname yname))
X      (if (and (eq (car-safe xvalue) 'intv)
X           (math-constp xvalue))
X          (setq xstep (math-div (math-sub (nth 3 xvalue)
X                          (nth 2 xvalue))
X                    (1- numsteps))
X            xvalue (nth 2 xvalue))
X        (if (math-realp xvalue)
X        (setq xstep 1)
X          (error "%s is not a suitable basis for %s" xname yname)))))
X    (or (math-realp yvalue)
X    (let ((arglist nil))
X      (setq yvalue (math-evaluate-expr yvalue))
X      (calc-default-formula-arglist yvalue)
X      (or arglist
X          (error "%s does not contain any unassigned variables" yname))
X      (and (cdr arglist)
X           (error "%s contains more than one variable: %s"
X              yname arglist))
X      (setq yvalue (math-expr-subst yvalue
X                    (math-build-var-name (car arglist))
X                    '(var DUMMY var-DUMMY)))))
X    (setq ycache (assoc yvalue calc-graph-data-cache))
X    (delq ycache calc-graph-data-cache)
X    (nconc calc-graph-data-cache
X       (list (or ycache (setq ycache (list yvalue)))))
X    (if (and (not (setq xvec (eq (car-safe xvalue) 'vec)))
X         refine (cdr (cdr ycache)))
X    (calc-graph-refine-2d)
X      (calc-graph-recompute-2d)))
)
X
(defun calc-graph-refine-2d ()
X  (setq keep-file nil
X    ycacheptr (cdr ycache))
X  (if (and (setq xval (calc-graph-find-command "xrange"))
X       (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'"
X             xval))
X      (let ((b2 (match-beginning 2))
X        (e2 (match-end 2)))
X    (setq xlow (math-read-number (substring xval
X                        (match-beginning 1)
X                        (match-end 1)))
X          xhigh (math-read-number (substring xval b2 e2))))
X    (if xlow
X    (while (and (cdr ycacheptr)
X            (Math-lessp (car (nth 1 ycacheptr)) xlow))
X      (setq ycacheptr (cdr ycacheptr)))))
X  (setq math-working-step-2 (1- (length ycacheptr)))
X  (while (and (cdr ycacheptr)
X          (or (not xhigh)
X          (Math-lessp (car (car ycacheptr)) xhigh)))
X    (setq var-DUMMY (math-div (math-add (car (car ycacheptr))
X                    (car (nth 1 ycacheptr)))
X                  2)
X      math-working-step (1+ math-working-step)
X      yval (math-evaluate-expr yvalue))
X    (setcdr ycacheptr (cons (cons var-DUMMY yval)
X                (cdr ycacheptr)))
X    (setq ycacheptr (cdr (cdr ycacheptr))))
X  (setq yp ycache
X    numsteps 1000000)
)
X
(defun calc-graph-recompute-2d ()
X  (setq ycacheptr ycache)
X  (if xvec
X      (setq numsteps (1- (length xvalue))
X        yvector nil)
X    (if (and (eq (car-safe xvalue) 'intv)
X         (math-constp xvalue))
X    (setq numsteps resolution
X          yp nil
X          xlow (nth 2 xvalue)
X          xhigh (nth 3 xvalue)
X          xstep (math-div (math-sub xhigh xlow)
X                  (1- numsteps))
X          xvalue (nth 2 xvalue))
X      (error "%s is not a suitable basis for %s"
X         xname yname)))
X  (setq math-working-step-2 numsteps)
X  (while (>= (setq numsteps (1- numsteps)) 0)
X    (setq math-working-step (1+ math-working-step))
X    (if xvec
X    (progn
X      (setq xp (cdr xp)
X        xval (car xp))
X      (and (not (eq ycacheptr ycache))
X           (consp (car ycacheptr))
X           (not (Math-lessp (car (car ycacheptr)) xval))
X           (setq ycacheptr ycache)))
X      (if (= numsteps 0)
X      (setq xval xhigh)   ; avoid cumulative roundoff
X    (setq xval xvalue
X          xvalue (math-add xvalue xstep))))
X    (while (and (cdr ycacheptr)
X        (Math-lessp (car (nth 1 ycacheptr)) xval))
X      (setq ycacheptr (cdr ycacheptr)))
X    (or (and (cdr ycacheptr)
X         (Math-equal (car (nth 1 ycacheptr)) xval))
X    (progn
X      (setq keep-file nil
X        var-DUMMY xval)
X      (setcdr ycacheptr (cons (cons xval (math-evaluate-expr yvalue))
X                  (cdr ycacheptr)))))
X    (setq ycacheptr (cdr ycacheptr))
X    (if xvec
X    (setq yvector (cons (cdr (car ycacheptr)) yvector))
X      (or yp (setq yp ycacheptr))))
X  (if xvec
X      (setq xp xvalue
X        yvec t
X        yp (cons 'vec (nreverse yvector))
X        numsteps (1- (length xp)))
X    (setq numsteps 1000000))
)
X
(defun calc-graph-compute-3d ()
X  (if (setq yvec (eq (car-safe yvalue) 'vec))
X      (if (math-matrixp yvalue)
X      (progn
X        (setq numsteps (1- (length yvalue))
X          numsteps3 (1- (length (nth 1 yvalue))))
X        (if (eq (car-safe xvalue) 'vec)
X        (or (= (1- (length xvalue)) numsteps)
X            (error "%s has wrong length" xname))
X          (if (and (eq (car-safe xvalue) 'intv)
X               (math-constp xvalue))
X          (setq xvalue (calcFunc-index numsteps
X                           (nth 2 xvalue)
X                           (math-div
X                        (math-sub (nth 3 xvalue)
X                              (nth 2 xvalue))
X                        (1- numsteps))))
X        (if (math-realp xvalue)
X            (setq xvalue (calcFunc-index numsteps xvalue 1))
X          (error "%s is not a suitable basis for %s" xname yname))))
X        (if (eq (car-safe y3value) 'vec)
X        (or (= (1- (length y3value)) numsteps3)
X            (error "%s has wrong length" y3name))
X          (if (and (eq (car-safe y3value) 'intv)
X               (math-constp y3value))
X          (setq y3value (calcFunc-index numsteps3
X                        (nth 2 y3value)
X                        (math-div
X                         (math-sub (nth 3 y3value)
X                               (nth 2 y3value))
X                         (1- numsteps3))))
X        (if (math-realp y3value)
X            (setq y3value (calcFunc-index numsteps3 y3value 1))
X          (error "%s is not a suitable basis for %s" y3name yname))))
X        (setq xp nil
X          yp nil
X          zp nil
X          xvec t)
X        (while (setq xvalue (cdr xvalue) yvalue (cdr yvalue))
X          (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue)))
X            yp (nconc yp (cons 0 (copy-sequence (cdr y3value))))
X            zp (nconc zp (cons '(skip)
X                       (copy-sequence (cdr (car yvalue)))))))
X        (setq numsteps (1- (* numsteps (1+ numsteps3)))))
X    (if (= (setq numsteps (1- (length yvalue))) 0)
X        (error "Can't plot an empty vector"))
X    (or (and (eq (car-safe xvalue) 'vec)
X         (= (1- (length xvalue)) numsteps))
X        (error "%s is not a suitable basis for %s" xname yname))
X    (or (and (eq (car-safe y3value) 'vec)
X         (= (1- (length y3value)) numsteps))
X        (error "%s is not a suitable basis for %s" y3name yname))
X    (setq xp xvalue
X          yp y3value
X          zp yvalue
X          xvec t))
X    (or (math-realp yvalue)
X    (let ((arglist nil))
X      (setq yvalue (math-evaluate-expr yvalue))
X      (calc-default-formula-arglist yvalue)
X      (setq arglist (sort arglist 'string-lessp))
X      (or (cdr arglist)
X          (error "%s does not contain enough unassigned variables" yname))
X      (and (cdr (cdr arglist))
X           (error "%s contains too many variables: %s" yname arglist))
X      (setq yvalue (math-multi-subst yvalue
X                     (mapcar 'math-build-var-name
X                         arglist)
X                     '((var DUMMY var-DUMMY)
X                       (var DUMMY2 var-DUMMY2))))))
X    (if (setq xvec (eq (car-safe xvalue) 'vec))
X    (setq numsteps (1- (length xvalue)))
X      (if (and (eq (car-safe xvalue) 'intv)
X           (math-constp xvalue))
X      (setq numsteps resolution
X        xvalue (calcFunc-index numsteps
X                       (nth 2 xvalue)
X                       (math-div (math-sub (nth 3 xvalue)
X                               (nth 2 xvalue))
X                         (1- numsteps))))
X    (error "%s is not a suitable basis for %s"
X           xname yname)))
X    (if (setq y3vec (eq (car-safe y3value) 'vec))
X    (setq numsteps3 (1- (length y3value)))
X      (if (and (eq (car-safe y3value) 'intv)
X           (math-constp y3value))
X      (setq numsteps3 resolution
X        y3value (calcFunc-index numsteps3
X                    (nth 2 y3value)
X                    (math-div (math-sub (nth 3 y3value)
X                                (nth 2 y3value))
X                          (1- numsteps3))))
X    (error "%s is not a suitable basis for %s"
X           y3name yname)))
X    (setq xp nil
X      yp nil
X      zp nil
X      xvec t)
X    (setq math-working-step 0)
X    (while (setq xvalue (cdr xvalue))
X      (setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue)))
X        yp (nconc yp (cons 0 (copy-sequence (cdr y3value))))
X        zp (cons '(skip) zp)
X        y3step y3value
X        var-DUMMY (car xvalue)
X        math-working-step-2 0
X        math-working-step (1+ math-working-step))
X      (while (setq y3step (cdr y3step))
X    (setq math-working-step-2 (1+ math-working-step-2)
X          var-DUMMY2 (car y3step)
X          zp (cons (math-evaluate-expr yvalue) zp))))
X    (setq zp (nreverse zp)
X      numsteps (1- (* numsteps (1+ numsteps3)))))
)
X
(defun calc-graph-format-data ()
X  (while (<= (setq stepcount (1+ stepcount)) numsteps)
X    (if xvec
X    (setq xp (cdr xp)
X          xval (car xp)
X          yp (cdr yp)
X          yval (car yp)
X          zp (cdr zp)
X          zval (car zp))
X      (if yvec
X      (setq xval xvalue
X        xvalue (math-add xvalue xstep)
X        yp (cdr yp)
X        yval (car yp))
X    (setq xval (car (car yp))
X          yval (cdr (car yp))
X          yp (cdr yp))
X    (if (or (not yp)
X        (and xhigh (equal xval xhigh)))
X        (setq numsteps 0))))
X    (if is-splot
X    (if (and (eq (car-safe zval) 'calcFunc-xyz)
X         (= (length zval) 4))
X        (setq xval (nth 1 zval)
X          yval (nth 2 zval)
X          zval (nth 3 zval)))
X      (if (and (eq (car-safe yval) 'calcFunc-xyz)
X           (= (length yval) 4))
X      (progn
X        (or surprise-splot
X        (save-excursion
X          (set-buffer (get-buffer-create "*Gnuplot Temp*"))
X          (save-excursion
X            (goto-char (point-max))
X            (re-search-backward "^plot[ \t]")
X            (insert "set parametric\ns")
X            (setq surprise-splot t))))
X        (setq xval (nth 1 yval)
X          zval (nth 3 yval)
X          yval (nth 2 yval)))
X    (if (and (eq (car-safe yval) 'calcFunc-xy)
X         (= (length yval) 3))
X        (setq xval (nth 1 yval)
X          yval (nth 2 yval)))))
X    (if (and (Math-realp xval)
X         (Math-realp yval)
X         (or (not zval) (Math-realp zval)))
X    (progn
X      (setq blank nil
X        non-blank t)
X      (if (Math-integerp xval)
X          (insert (math-format-number xval))
X        (if (eq (car xval) 'frac)
X        (setq xval (math-float xval)))
X        (insert (math-format-number (nth 1 xval))
X            "e" (int-to-string (nth 2 xval))))
X      (insert " ")
X      (if (Math-integerp yval)
X          (insert (math-format-number yval))
X        (if (eq (car yval) 'frac)
X        (setq yval (math-float yval)))
X        (insert (math-format-number (nth 1 yval))
X            "e" (int-to-string (nth 2 yval))))
X      (if zval
X          (progn
X        (insert " ")
X        (if (Math-integerp zval)
X            (insert (math-format-number zval))
X          (if (eq (car zval) 'frac)
X              (setq zval (math-float zval)))
X          (insert (math-format-number (nth 1 zval))
X              "e" (int-to-string (nth 2 zval))))))
X      (insert "\n"))
X      (and (not (equal zval '(skip)))
X       (boundp 'var-PlotRejects)
X       (eq (car-safe var-PlotRejects) 'vec)
X       (nconc var-PlotRejects
X          (list (list 'vec
X                  curve-num
X                  stepcount
X                  xval yval)))
X       (calc-refresh-evaltos 'var-PlotRejects))
X      (or blank
X      (progn
X        (insert "\n")
X        (setq blank t)))))
)
X
(defun calc-temp-file-name (num)
X  (while (<= (length calc-graph-file-cache) (1+ num))
X    (setq calc-graph-file-cache (nconc calc-graph-file-cache (list nil))))
X  (car (or (nth (1+ num) calc-graph-file-cache)
X       (setcar (nthcdr (1+ num) calc-graph-file-cache)
X           (list (make-temp-name
X              (concat calc-gnuplot-tempfile
X                  (if (<= num 0)
X                      (char-to-string (- ?A num))
X                    (int-to-string num))))
X             nil))))
)
X
(defun calc-graph-delete-temps ()
X  (while calc-graph-file-cache
X    (and (car calc-graph-file-cache)
X     (file-exists-p (car (car calc-graph-file-cache)))
X     (condition-case err
X         (delete-file (car (car calc-graph-file-cache)))
X       (error nil)))
X    (setq calc-graph-file-cache (cdr calc-graph-file-cache)))
)
X
(defun calc-graph-kill-hook ()
X  (calc-graph-delete-temps)
X  (if calc-graph-prev-kill-hook
X      (funcall calc-graph-prev-kill-hook))
)
X
(defun calc-graph-show-tty (output)
X  "Default calc-gnuplot-plot-command for \"tty\" output mode.
This is useful for tek40xx and other graphics-terminal types."
X  (call-process-region 1 1 shell-file-name
X               nil calc-gnuplot-buffer nil
X               "-c" (format "cat %s >/dev/tty; rm %s" output output))
)
X
(defun calc-graph-show-dumb (&optional output)
X  "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
This \"dumb\" driver will be present in Gnuplot 3.0."
X  (interactive)
X  (save-window-excursion
X    (switch-to-buffer calc-gnuplot-buffer)
X    (delete-other-windows)
X    (goto-char calc-gnuplot-trail-mark)
X    (or (search-forward "\f" nil t)
X    (sleep-for 1))
X    (goto-char (point-max))
X    (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T")
X    (setq found-pt (point))
X    (if (looking-at "\f")
X    (progn
X      (forward-char 1)
X      (if (eolp) (forward-line 1))
X      (or (calc-graph-find-command "time")
X          (calc-graph-find-command "title")
X          (calc-graph-find-command "ylabel")
X          (let ((pt (point)))
X        (insert-before-markers (format "(%s)" (current-time-string)))
X        (goto-char pt)))
X      (set-window-start (selected-window) (point))
X      (goto-char (point-max)))
X      (end-of-line)
X      (backward-char 1)
X      (recenter '(4)))
X    (or (boundp 'calc-dumb-map)
X    (progn
X      (setq calc-dumb-map (make-sparse-keymap))
X      (define-key calc-dumb-map "\n" 'scroll-up)
X      (define-key calc-dumb-map " " 'scroll-up)
X      (define-key calc-dumb-map "\177" 'scroll-down)
X      (define-key calc-dumb-map "<" 'scroll-left)
X      (define-key calc-dumb-map ">" 'scroll-right)
X      (define-key calc-dumb-map "{" 'scroll-down)
X      (define-key calc-dumb-map "}" 'scroll-up)
X      (define-key calc-dumb-map "q" 'exit-recursive-edit)
X      (define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit)))
X    (use-local-map calc-dumb-map)
X    (setq truncate-lines t)
X    (message "Type `q'%s to return to Calc."
X         (if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch)
X            " or `M-# M-#'" ""))
X    (recursive-edit)
X    (bury-buffer "*Gnuplot Trail*"))
)
X
(defun calc-graph-clear ()
X  (interactive)
X  (if calc-graph-last-device
X      (if (or (equal calc-graph-last-device "x11")
X          (equal calc-graph-last-device "X11"))
X      (calc-gnuplot-command "set output"
X                (if (equal calc-graph-last-output "STDOUT")
X                    ""
X                  (prin1-to-string calc-graph-last-output)))
X    (calc-gnuplot-command "clear")))
)
X
(defun calc-graph-title-x (title)
X  (interactive "sX axis title: ")
X  (calc-graph-set-command "xlabel" (if (not (equal title ""))
X                       (prin1-to-string title)))
)
X
(defun calc-graph-title-y (title)
X  (interactive "sY axis title: ")
X  (calc-graph-set-command "ylabel" (if (not (equal title ""))
X                       (prin1-to-string title)))
)
X
(defun calc-graph-title-z (title)
X  (interactive "sZ axis title: ")
X  (calc-graph-set-command "zlabel" (if (not (equal title ""))
X                       (prin1-to-string title)))
)
X
(defun calc-graph-range-x (range)
X  (interactive "sX axis range: ")
X  (calc-graph-set-range "xrange" range)
)
X
(defun calc-graph-range-y (range)
X  (interactive "sY axis range: ")
X  (calc-graph-set-range "yrange" range)
)
X
(defun calc-graph-range-z (range)
X  (interactive "sZ axis range: ")
X  (calc-graph-set-range "zrange" range)
)
X
(defun calc-graph-set-range (cmd range)
X  (if (equal range "$")
X      (calc-wrapper
X       (let ((val (calc-top-n 1)))
X     (if (and (eq (car-safe val) 'intv) (math-constp val))
X         (setq range (concat
X              (math-format-number (math-float (nth 2 val))) ":"
X              (math-format-number (math-float (nth 3 val)))))
X       (if (and (eq (car-safe val) 'vec)
X            (= (length val) 3))
X           (setq range (concat
X                (math-format-number (math-float (nth 1 val))) ":"
X                (math-format-number (math-float (nth 2 val)))))
X         (error "Range specification must be an interval or 2-vector")))
X     (calc-pop-stack 1))))
X  (if (string-match "\\[.+\\]" range)
X      (setq range (substring range 1 -1)))
X  (if (and (not (string-match ":" range))
X       (or (string-match "," range)
X           (string-match " " range)))
X      (aset range (match-beginning 0) ?\:))
X  (calc-graph-set-command cmd (if (not (equal range ""))
X                  (concat "[" range "]")))
)
X
(defun calc-graph-log-x (flag)
X  (interactive "P")
X  (calc-graph-set-log flag 0 0)
)
X
(defun calc-graph-log-y (flag)
X  (interactive "P")
X  (calc-graph-set-log 0 flag 0)
)
X
(defun calc-graph-log-z (flag)
X  (interactive "P")
X  (calc-graph-set-log 0 0 flag)
)
X
(defun calc-graph-set-log (xflag yflag zflag)
X  (let* ((old (or (calc-graph-find-command "logscale") ""))
X     (xold (string-match "x" old))
X     (yold (string-match "y" old))
X     (zold (string-match "z" old))
X     str)
X    (setq str (concat (if (if xflag
X                  (if (eq xflag 0) xold
X                (> (prefix-numeric-value xflag) 0))
X                (not xold)) "x" "")
X              (if (if yflag
X                  (if (eq yflag 0) yold
X                (> (prefix-numeric-value yflag) 0))
X                (not yold)) "y" "")
X              (if (if zflag
X                  (if (eq zflag 0) zold
X                (> (prefix-numeric-value zflag) 0))
X                (not zold)) "z" "")))
X    (calc-graph-set-command "logscale" (if (not (equal str "")) str)))
)
X
(defun calc-graph-line-style (style)
X  (interactive "P")
X  (calc-graph-set-styles (and style (prefix-numeric-value style)) t)
)
X
(defun calc-graph-point-style (style)
X  (interactive "P")
X  (calc-graph-set-styles t (and style (prefix-numeric-value style)))
)
X
(defun calc-graph-set-styles (lines points)
X  (calc-graph-init)
X  (save-excursion
X    (set-buffer calc-gnuplot-input)
X    (or (calc-graph-find-plot nil nil)
X    (error "No data points have been set!"))
X    (let ((base (point))
X      (mode nil) (lstyle nil) (pstyle nil)
X      start end lenbl penbl)
X      (re-search-forward "[,\n]")
X      (forward-char -1)
X      (setq end (point) start end)
X      (goto-char base)
X      (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+with\\)")
X      (progn
X        (setq start (match-beginning 1))
X        (goto-char (match-end 0))
X        (if (looking-at "[ \t]+\\([a-z]+\\)")
X        (setq mode (buffer-substring (match-beginning 1)
X                         (match-end 1))))
X        (if (looking-at "[ \ta-z]+\\([0-9]+\\)")
X        (setq lstyle (string-to-int
X                  (buffer-substring (match-beginning 1)
X                        (match-end 1)))))
X        (if (looking-at "[ \ta-z]+[0-9]+[ \t]+\\([0-9]+\\)")
X        (setq pstyle (string-to-int
X                  (buffer-substring (match-beginning 1)
X                        (match-end 1)))))))
X      (setq lenbl (or (equal mode "lines") (equal mode "linespoints"))
X        penbl (or (equal mode "points") (equal mode "linespoints")))
X      (if lines
X      (or (eq lines t)
X          (setq lstyle lines
X            lenbl (>= lines 0)))
X    (setq lenbl (not lenbl)))
X      (if points
X      (or (eq points t)
X          (setq pstyle points
X            penbl (>= points 0)))
X    (setq penbl (not penbl)))
X      (delete-region start end)
X      (goto-char start)
X      (insert " with "
X          (if lenbl
X          (if penbl "linespoints" "lines")
X        (if penbl "points" "dots")))
X      (if (and pstyle (> pstyle 0))
X      (insert " " (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
X          " " (int-to-string pstyle))
X    (if (and lstyle (> lstyle 0))
X        (insert " " (int-to-string lstyle))))))
X  (calc-graph-view-commands)
)
X
(defun calc-graph-zero-x (flag)
X  (interactive "P")
X  (calc-graph-set-command "noxzeroaxis"
X              (and (if flag
X                   (<= (prefix-numeric-value flag) 0)
X                 (not (calc-graph-find-command "noxzeroaxis")))
X                   " "))
)
X
(defun calc-graph-zero-y (flag)
X  (interactive "P")
X  (calc-graph-set-command "noyzeroaxis"
X              (and (if flag
X                   (<= (prefix-numeric-value flag) 0)
X                 (not (calc-graph-find-command "noyzeroaxis")))
X                   " "))
)
X
(defun calc-graph-name (name)
X  (interactive "sTitle for current curve: ")
X  (calc-graph-init)
X  (save-excursion
X    (set-buffer calc-gnuplot-input)
X    (or (calc-graph-find-plot nil nil)
X    (error "No data points have been set!"))
X    (let ((base (point))
X      start)
X      (re-search-forward "[,\n]\\|[ \t]+with")
X      (setq end (match-beginning 0))
X      (goto-char base)
X      (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+title\\)")
X      (progn
X        (goto-char (match-beginning 1))
X        (delete-region (point) end))
X    (goto-char end))
X      (insert " title " (prin1-to-string name))))
X  (calc-graph-view-commands)
)
X
(defun calc-graph-hide (flag)
X  (interactive "P")
X  (calc-graph-init)
X  (and (calc-graph-find-plot nil nil)
X       (progn
X     (or (looking-at "{")
X         (error "Can't hide this curve (wrong format)"))
X     (forward-char 1)
X     (if (looking-at "*")
X         (if (or (null flag) (<= (prefix-numeric-value flag) 0))
X         (delete-char 1))
X       (if (or (null flag) (> (prefix-numeric-value flag) 0))
X           (insert "*")))))
)
X
(defun calc-graph-header (title)
X  (interactive "sTitle for entire graph: ")
X  (calc-graph-set-command "title" (if (not (equal title ""))
X                      (prin1-to-string title)))
)
X
(defun calc-graph-border (flag)
X  (interactive "P")
X  (calc-graph-set-command "noborder"
X              (and (if flag
X                   (<= (prefix-numeric-value flag) 0)
X                 (not (calc-graph-find-command "noborder")))
X                   " "))
)
X
(defun calc-graph-grid (flag)
X  (interactive "P")
X  (calc-graph-set-command "grid" (and (if flag
X                      (> (prefix-numeric-value flag) 0)
X                    (not (calc-graph-find-command "grid")))
X                      " "))
)
X
(defun calc-graph-key (flag)
X  (interactive "P")
X  (calc-graph-set-command "key" (and (if flag
X                     (> (prefix-numeric-value flag) 0)
X                       (not (calc-graph-find-command "key")))
X                     " "))
)
X
(defun calc-graph-num-points (res flag)
X  (interactive "sNumber of data points: \nP")
X  (if flag
X      (if (> (prefix-numeric-value flag) 0)
X      (if (equal res "")
X          (message "Default resolution is %d."
X               calc-graph-default-resolution)
X        (setq calc-graph-default-resolution (string-to-int res)))
X    (if (equal res "")
X        (message "Default 3D resolution is %d."
X             calc-graph-default-resolution-3d)
X      (setq calc-graph-default-resolution-3d (string-to-int res))))
X    (calc-graph-set-command "samples" (if (not (equal res "")) res)))
)
X
(defun calc-graph-device (name flag)
X  (interactive "sDevice name: \nP")
X  (if (equal name "?")
X      (progn
X    (calc-gnuplot-command "set terminal")
X    (calc-graph-view-trail))
X    (if flag
X    (if (> (prefix-numeric-value flag) 0)
X        (if (equal name "")
X        (message "Default GNUPLOT device is \"%s\"."
X             calc-gnuplot-default-device)
X          (setq calc-gnuplot-default-device name))
X      (if (equal name "")
X          (message "GNUPLOT device for Print command is \"%s\"."
X               calc-gnuplot-print-device)
X        (setq calc-gnuplot-print-device name)))
X      (calc-graph-set-command "terminal" (if (not (equal name ""))
X                         name))))
)
X
(defun calc-graph-output (name flag)
X  (interactive "sOutput file name: \nP")
X  (if flag
X      (if (> (prefix-numeric-value flag) 0)
X      (if (equal name "")
X          (message "Default GNUPLOT output file is \"%s\"."
X               calc-gnuplot-default-output)
X        (if (string-match "^[sS][tT][dD][oO][uU][tT]$" name)
X        (setq name "STDOUT"))
X        (setq calc-gnuplot-default-output name))
X    (if (equal name "")
X        (message "GNUPLOT output file for Print command is \"%s\"."
X             calc-gnuplot-print-output)
X      (setq calc-gnuplot-print-output name)))
X    (calc-graph-set-command "output" (if (not (equal name ""))
X                     (prin1-to-string name))))
)
X
(defun calc-graph-display (name)
X  (interactive "sX display name: ")
X  (if (equal name "")
X      (message "Current X display is \"%s\"."
X           (or calc-gnuplot-display "<none>"))
X    (setq calc-gnuplot-display name)
X    (if (calc-gnuplot-alive)
X    (calc-gnuplot-command "exit")))
)
X
(defun calc-graph-geometry (name)
X  (interactive "sX geometry spec (or \"default\"): ")
X  (if (equal name "")
X      (message "Current X geometry is \"%s\"."
X           (or calc-gnuplot-geometry "default"))
X    (setq calc-gnuplot-geometry (and (not (equal name "default")) name))
X    (if (calc-gnuplot-alive)
X    (calc-gnuplot-command "exit")))
)
X
(defun calc-graph-find-command (cmd)
X  (calc-graph-init)
X  (save-excursion
X    (set-buffer calc-gnuplot-input)
X    (goto-char (point-min))
X    (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t)
X    (buffer-substring (match-beginning 1) (match-end 1))))
)
X
(defun calc-graph-set-command (cmd &rest args)
X  (calc-graph-init)
X  (save-excursion
X    (set-buffer calc-gnuplot-input)
X    (goto-char (point-min))
X    (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t\n]") nil t)
X    (progn
X      (forward-char -1)
X      (end-of-line)
X      (let ((end (point)))
X        (beginning-of-line)
X        (delete-region (point) (1+ end))))
X      (if (calc-graph-find-plot t t)
X      (if (eq (preceding-char) ?\n)
X          (forward-char -1))
X    (goto-char (1- (point-max)))))
X    (if (and args (car args))
X    (progn
X      (or (bolp)
X          (insert "\n"))
X      (insert "set " (mapconcat 'identity (cons cmd args) " ") "\n"))))
X  (calc-graph-view-commands)
)
X
(defun calc-graph-command (cmd)
X  (interactive "sGNUPLOT command: ")
X  (calc-wrapper
X   (calc-graph-init)
X   (calc-graph-view-trail)
X   (calc-gnuplot-command cmd)
X   (accept-process-output)
X   (calc-graph-view-trail))
)
X
(defun calc-graph-kill (&optional no-view)
X  (interactive)
X  (calc-graph-delete-temps)
X  (if (calc-gnuplot-alive)
X      (calc-wrapper
X       (or no-view (calc-graph-view-trail))
X       (let ((calc-graph-no-wait t))
X     (calc-gnuplot-command "exit"))
X       (sit-for 1)
X       (if (process-status calc-gnuplot-process)
X       (delete-process calc-gnuplot-process))
X       (setq calc-gnuplot-process nil)))
)
X
(defun calc-graph-quit ()
X  (interactive)
X  (if (get-buffer-window calc-gnuplot-input)
X      (calc-graph-view-commands t))
X  (if (get-buffer-window calc-gnuplot-buffer)
X      (calc-graph-view-trail t))
X  (calc-graph-kill t)
)
X
(defun calc-graph-view-commands (&optional no-need)
X  (interactive "p")
X  (or calc-graph-no-auto-view (calc-graph-init-buffers))
X  (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need))
)
X
(defun calc-graph-view-trail (&optional no-need)
X  (interactive "p")
X  (or calc-graph-no-auto-view (calc-graph-init-buffers))
X  (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need))
)
X
(defun calc-graph-view (buf other-buf need)
X  (let (win)
X    (or calc-graph-no-auto-view
X    (if (setq win (get-buffer-window buf))
X        (or need
X        (and (eq buf calc-gnuplot-buffer)
X             (save-excursion
X               (set-buffer buf)
X               (not (pos-visible-in-window-p (point-max) win))))
X        (progn
X          (bury-buffer buf)
X          (bury-buffer other-buf)
X          (let ((curwin (selected-window)))
X            (select-window win)
X            (switch-to-buffer nil)
X            (select-window curwin))))
X      (if (setq win (get-buffer-window other-buf))
X          (set-window-buffer win buf)
X        (if (eq major-mode 'calc-mode)
X        (if (or need
X            (< (window-height) (1- (screen-height))))
X            (display-buffer buf))
X          (switch-to-buffer buf)))))
X    (save-excursion
X      (set-buffer buf)
X      (if (and (eq buf calc-gnuplot-buffer)
X           (setq win (get-buffer-window buf))
X           (not (pos-visible-in-window-p (point-max) win)))
X      (progn
X        (goto-char (point-max))
X        (vertical-motion (- 6 (window-height win)))
X        (set-window-start win (point))
X        (goto-char (point-max)))))
X    (or calc-graph-no-auto-view (sit-for 0)))
)
(setq calc-graph-no-auto-view nil)
X
(defun calc-gnuplot-check-for-errors ()
X  (if (save-excursion
X    (prog2
X     (progn
X       (set-buffer calc-gnuplot-buffer)
X       (goto-char calc-gnuplot-last-error-pos))
X     (re-search-forward "^[ \t]+\\^$" nil t)
X     (goto-char (point-max))
X     (setq calc-gnuplot-last-error-pos (point-max))))
X      (calc-graph-view-trail))
)
X
(defun calc-gnuplot-command (&rest args)
X  (calc-graph-init)
X  (let ((cmd (concat (mapconcat 'identity args " ") "\n")))
X    (accept-process-output)
X    (save-excursion
X      (set-buffer calc-gnuplot-buffer)
X      (calc-gnuplot-check-for-errors)
X      (goto-char (point-max))
X      (setq calc-gnuplot-trail-mark (point))
SHAR_EOF
true || echo 'restore of calc-graph.el failed'
fi
echo 'End of  part 17'
echo 'File calc-graph.el is continued in part 18'
echo 18 > _shar_seq_.tmp
exit 0
exit 0 # Just in case...
--
Kent Landfield                   INTERNET: [e-mail]
Sterling Software, IMD           UUCP:     uunet!sparky!kent
Phone:    [phone]         FAX:      [phone]
Please send comp.sources.misc-related mail to [e-mail].