code.delx.au - gnu-emacs/blob - lisp/calc/calc-graph.el

   1 ;;; calc-graph.el --- graph output functions for Calc
   2
   3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
   4
   5 ;; Author: David Gillespie <daveg@synaptics.com>
   6 ;; Maintainer: Jay Belanger <belanger@truman.edu>
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY.  No author or distributor
  12 ;; accepts responsibility to anyone for the consequences of using it
  13 ;; or for whether it serves any particular purpose or works at all,
  14 ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  15 ;; License for full details.
  16
  17 ;; Everyone is granted permission to copy, modify and redistribute
  18 ;; GNU Emacs, but only under the conditions described in the
  19 ;; GNU Emacs General Public License.   A copy of this license is
  20 ;; supposed to have been given to you along with GNU Emacs so you
  21 ;; can know your rights and responsibilities.  It should be in a
  22 ;; file named COPYING.  Among other things, the copyright notice
  23 ;; and this notice must be preserved on all copies.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 ;; This file is autoloaded from calc-ext.el.
  30
  31 (require 'calc-ext)
  32 (require 'calc-macs)
  33
  34 ;;; Graphics
  35
  36 (defvar calc-gnuplot-name "gnuplot"
  37   "*Name of GNUPLOT program, for calc-graph features.")
  38
  39 (defvar calc-gnuplot-plot-command nil
  40   "*Name of command for displaying GNUPLOT output; %s = file name to print.")
  41
  42 (defvar calc-gnuplot-print-command "lp %s"
  43   "*Name of command for printing GNUPLOT output; %s = file name to print.")
  44
  45 (defvar calc-gnuplot-tempfile "calc")
  46
  47 (defvar calc-gnuplot-default-device)
  48 (defvar calc-gnuplot-default-output)
  49 (defvar calc-gnuplot-print-device)
  50 (defvar calc-gnuplot-print-output)
  51 (defvar calc-gnuplot-keep-outfile nil)
  52 (defvar calc-gnuplot-version nil)
  53
  54 (defvar calc-gnuplot-display (getenv "DISPLAY"))
  55 (defvar calc-gnuplot-geometry)
  56
  57 (defvar calc-graph-default-resolution)
  58 (defvar calc-graph-default-resolution-3d)
  59 (defvar calc-graph-default-precision 5)
  60
  61 (defvar calc-gnuplot-buffer nil)
  62 (defvar calc-gnuplot-input nil)
  63
  64 (defvar calc-gnuplot-last-error-pos 1)
  65 (defvar calc-graph-last-device nil)
  66 (defvar calc-graph-last-output nil)
  67 (defvar calc-graph-file-cache nil)
  68 (defvar calc-graph-var-cache nil)
  69 (defvar calc-graph-data-cache nil)
  70 (defvar calc-graph-data-cache-limit 10)
  71 (defvar calc-graph-no-auto-view nil)
  72 (defvar calc-graph-no-wait nil)
  73 (defvar calc-gnuplot-trail-mark)
  74
  75 (defun calc-graph-fast (many)
  76   (interactive "P")
  77   (let ((calc-graph-no-auto-view t))
  78     (calc-graph-delete t)
  79     (calc-graph-add many)
  80     (calc-graph-plot nil)))
  81
  82 (defun calc-graph-fast-3d (many)
  83   (interactive "P")
  84   (let ((calc-graph-no-auto-view t))
  85     (calc-graph-delete t)
  86     (calc-graph-add-3d many)
  87     (calc-graph-plot nil)))
  88
  89 (defun calc-graph-delete (all)
  90   (interactive "P")
  91   (calc-wrapper
  92    (calc-graph-init)
  93    (save-excursion
  94      (set-buffer calc-gnuplot-input)
  95      (and (calc-graph-find-plot t all)
  96           (progn
  97             (if (looking-at "s?plot")
  98                 (progn
  99                   (setq calc-graph-var-cache nil)
 100                   (delete-region (point) (point-max)))
 101               (delete-region (point) (1- (point-max)))))))
 102    (calc-graph-view-commands)))
 103
 104 (defun calc-graph-find-plot (&optional before all)
 105   (goto-char (point-min))
 106   (and (re-search-forward "^s?plot[ \t]+" nil t)
 107        (let ((beg (point)))
 108          (goto-char (point-max))
 109          (if (or all
 110                  (not (search-backward "," nil t))
 111                  (< (point) beg))
 112              (progn
 113                (goto-char beg)
 114                (if before
 115                    (beginning-of-line)))
 116            (or before
 117                (re-search-forward ",[ \t]+")))
 118          t)))
 119
 120 (defun calc-graph-add (many)
 121   (interactive "P")
 122   (calc-wrapper
 123    (calc-graph-init)
 124    (cond ((null many)
 125           (calc-graph-add-curve (calc-graph-lookup (calc-top-n 2))
 126                                 (calc-graph-lookup (calc-top-n 1))))
 127          ((or (consp many) (eq many 0))
 128           (let ((xdata (calc-graph-lookup (calc-top-n 2)))
 129                 (ylist (calc-top-n 1)))
 130             (or (eq (car-safe ylist) 'vec)
 131                 (error "Y argument must be a vector"))
 132             (while (setq ylist (cdr ylist))
 133               (calc-graph-add-curve xdata (calc-graph-lookup (car ylist))))))
 134          ((> (setq many (prefix-numeric-value many)) 0)
 135           (let ((xdata (calc-graph-lookup (calc-top-n (1+ many)))))
 136             (while (> many 0)
 137               (calc-graph-add-curve xdata
 138                                     (calc-graph-lookup (calc-top-n many)))
 139               (setq many (1- many)))))
 140          (t
 141           (let (pair)
 142             (setq many (- many))
 143             (while (> many 0)
 144               (setq pair (calc-top-n many))
 145               (or (and (eq (car-safe pair) 'vec)
 146                        (= (length pair) 3))
 147                   (error "Argument must be an [x,y] vector"))
 148               (calc-graph-add-curve (calc-graph-lookup (nth 1 pair))
 149                                     (calc-graph-lookup (nth 2 pair)))
 150               (setq many (1- many))))))
 151    (calc-graph-view-commands)))
 152
 153 (defun calc-graph-add-3d (many)
 154   (interactive "P")
 155   (calc-wrapper
 156    (calc-graph-init)
 157    (cond ((null many)
 158           (calc-graph-add-curve (calc-graph-lookup (calc-top-n 3))
 159                                 (calc-graph-lookup (calc-top-n 2))
 160                                 (calc-graph-lookup (calc-top-n 1))))
 161          ((or (consp many) (eq many 0))
 162           (let ((xdata (calc-graph-lookup (calc-top-n 3)))
 163                 (ydata (calc-graph-lookup (calc-top-n 2)))
 164                 (zlist (calc-top-n 1)))
 165             (or (eq (car-safe zlist) 'vec)
 166                 (error "Z argument must be a vector"))
 167             (while (setq zlist (cdr zlist))
 168               (calc-graph-add-curve xdata ydata
 169                                     (calc-graph-lookup (car zlist))))))
 170          ((> (setq many (prefix-numeric-value many)) 0)
 171           (let ((xdata (calc-graph-lookup (calc-top-n (+ many 2))))
 172                 (ydata (calc-graph-lookup (calc-top-n (+ many 1)))))
 173             (while (> many 0)
 174               (calc-graph-add-curve xdata ydata
 175                                     (calc-graph-lookup (calc-top-n many)))
 176               (setq many (1- many)))))
 177          (t
 178           (let (curve)
 179             (setq many (- many))
 180             (while (> many 0)
 181               (setq curve (calc-top-n many))
 182               (or (and (eq (car-safe curve) 'vec)
 183                        (= (length curve) 4))
 184                   (error "Argument must be an [x,y,z] vector"))
 185               (calc-graph-add-curve (calc-graph-lookup (nth 1 curve))
 186                                     (calc-graph-lookup (nth 2 curve))
 187                                     (calc-graph-lookup (nth 3 curve)))
 188               (setq many (1- many))))))
 189    (calc-graph-view-commands)))
 190
 191 (defun calc-graph-add-curve (xdata ydata &optional zdata)
 192   (let ((num (calc-graph-count-curves))
 193         (pstyle (calc-var-value 'var-PointStyles))
 194         (lstyle (calc-var-value 'var-LineStyles)))
 195     (save-excursion
 196       (set-buffer calc-gnuplot-input)
 197       (goto-char (point-min))
 198       (if (re-search-forward (if zdata "^plot[ \t]" "^splot[ \t]")
 199                              nil t)
 200           (error "Can't mix 2d and 3d curves on one graph"))
 201       (if (re-search-forward "^s?plot[ \t]" nil t)
 202           (progn
 203             (end-of-line)
 204             (insert ", "))
 205         (goto-char (point-max))
 206         (or (eq (preceding-char) ?\n)
 207             (insert "\n"))
 208         (insert (if zdata "splot" "plot") " \n")
 209         (forward-char -1))
 210       (insert "{" (symbol-name (nth 1 xdata))
 211               ":" (symbol-name (nth 1 ydata)))
 212       (if zdata
 213           (insert ":" (symbol-name (nth 1 zdata))))
 214       (insert "} "
 215               "title \"" (symbol-name (nth 1 ydata)) "\" "
 216               "with dots")
 217       (setq pstyle (and (eq (car-safe pstyle) 'vec) (nth (1+ num) pstyle)))
 218       (setq lstyle (and (eq (car-safe lstyle) 'vec) (nth (1+ num) lstyle))))
 219     (calc-graph-set-styles
 220      (or (and (Math-num-integerp lstyle) (math-trunc lstyle))
 221          0)
 222      (or (and (Math-num-integerp pstyle) (math-trunc pstyle))
 223          (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
 224              0 -1)))))
 225
 226 (defun calc-graph-lookup (thing)
 227   (if (and (eq (car-safe thing) 'var)
 228            (calc-var-value (nth 2 thing)))
 229       thing
 230     (let ((found (assoc thing calc-graph-var-cache)))
 231       (or found
 232           (let ((varname (concat "PlotData"
 233                                  (int-to-string
 234                                   (1+ (length calc-graph-var-cache))))))
 235             (setq var (list 'var (intern varname)
 236                             (intern (concat "var-" varname)))
 237                   found (cons thing var)
 238                   calc-graph-var-cache (cons found calc-graph-var-cache))
 239             (set (nth 2 var) thing)))
 240       (cdr found))))
 241
 242 (defun calc-graph-juggle (arg)
 243   (interactive "p")
 244   (calc-graph-init)
 245   (save-excursion
 246     (set-buffer calc-gnuplot-input)
 247     (if (< arg 0)
 248         (let ((num (calc-graph-count-curves)))
 249           (if (> num 0)
 250               (while (< arg 0)
 251                 (setq arg (+ arg num))))))
 252     (while (>= (setq arg (1- arg)) 0)
 253       (calc-graph-do-juggle))))
 254
 255 (defun calc-graph-count-curves ()
 256   (save-excursion
 257     (set-buffer calc-gnuplot-input)
 258     (if (re-search-forward "^s?plot[ \t]" nil t)
 259         (let ((num 1))
 260           (goto-char (point-min))
 261           (while (search-forward "," nil t)
 262             (setq num (1+ num)))
 263           num)
 264       0)))
 265
 266 (defun calc-graph-do-juggle ()
 267   (let (base)
 268     (and (calc-graph-find-plot t t)
 269          (progn
 270            (setq base (point))
 271            (calc-graph-find-plot t nil)
 272            (or (eq base (point))
 273                (let ((str (buffer-substring (+ (point) 2) (1- (point-max)))))
 274                  (delete-region (point) (1- (point-max)))
 275                  (goto-char (+ base 5))
 276                  (insert str ", ")))))))
 277
 278 (defun calc-graph-print (flag)
 279   (interactive "P")
 280   (calc-graph-plot flag t))
 281
 282 (defvar var-DUMMY)
 283 (defvar var-DUMMY2)
 284 (defvar var-PlotRejects)
 285
 286 ;; The following variables are local to calc-graph-plot, but are
 287 ;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d,
 288 ;; calc-graph-recompute-2d, calc-graph-compute-3d and
 289 ;; calc-graph-format-data, which are called by calc-graph-plot.
 290 (defvar calc-graph-yvalue)
 291 (defvar calc-graph-yvec)
 292 (defvar calc-graph-numsteps)
 293 (defvar calc-graph-numsteps3)
 294 (defvar calc-graph-xvalue)
 295 (defvar calc-graph-xvec)
 296 (defvar calc-graph-xname)
 297 (defvar calc-graph-yname)
 298 (defvar calc-graph-xstep)
 299 (defvar calc-graph-ycache)
 300 (defvar calc-graph-ycacheptr)
 301 (defvar calc-graph-refine)
 302 (defvar calc-graph-keep-file)
 303 (defvar calc-graph-xval)
 304 (defvar calc-graph-xlow)
 305 (defvar calc-graph-xhigh)
 306 (defvar calc-graph-yval)
 307 (defvar calc-graph-yp)
 308 (defvar calc-graph-xp)
 309 (defvar calc-graph-zp)
 310 (defvar calc-graph-yvector)
 311 (defvar calc-graph-resolution)
 312 (defvar calc-graph-y3value)
 313 (defvar calc-graph-y3name)
 314 (defvar calc-graph-y3step)
 315 (defvar calc-graph-zval)
 316 (defvar calc-graph-stepcount)
 317 (defvar calc-graph-is-splot)
 318 (defvar calc-graph-surprise-splot)
 319 (defvar calc-graph-blank)
 320 (defvar calc-graph-non-blank)
 321 (defvar calc-graph-curve-num)
 322
 323 (defun calc-graph-plot (flag &optional printing)
 324   (interactive "P")
 325   (calc-slow-wrapper
 326    (let ((calcbuf (current-buffer))
 327          (tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
 328          (tempbuftop 1)
 329          (tempoutfile nil)
 330          (calc-graph-curve-num 0)
 331          (calc-graph-refine (and flag (> (prefix-numeric-value flag) 0)))
 332          (recompute (and flag (< (prefix-numeric-value flag) 0)))
 333          (calc-graph-surprise-splot nil)
 334          (tty-output nil)
 335          cache-env calc-graph-is-splot device output calc-graph-resolution precision samples-pos)
 336      (add-hook 'kill-emacs-hook 'calc-graph-kill-hook)
 337      (save-excursion
 338        (calc-graph-init)
 339        (set-buffer tempbuf)
 340        (erase-buffer)
 341        (set-buffer calc-gnuplot-input)
 342        (goto-char (point-min))
 343        (setq calc-graph-is-splot (re-search-forward "^splot[ \t]" nil t))
 344        (let ((str (buffer-string))
 345              (ver calc-gnuplot-version))
 346          (set-buffer (get-buffer-create "*Gnuplot Temp*"))
 347          (erase-buffer)
 348          (insert "# (Note: This is a temporary copy---do not edit!)\n")
 349          (if (>= ver 2)
 350              (insert "set noarrow\nset nolabel\n"
 351                      "set autoscale xy\nset nologscale xy\n"
 352                      "set xlabel\nset ylabel\nset title\n"
 353                      "set noclip points\nset clip one\nset clip two\n"
 354                      "set format \"%g\"\nset tics\nset xtics\nset ytics\n"
 355                      "set data style linespoints\n"
 356                      "set nogrid\nset nokey\nset nopolar\n"))
 357          (if (>= ver 3)
 358              (insert "set surface\nset nocontour\n"
 359                      "set " (if calc-graph-is-splot "" "no") "parametric\n"
 360                      "set notime\nset border\nset ztics\nset zeroaxis\n"
 361                      "set view 60,30,1,1\nset offsets 0,0,0,0\n"))
 362          (setq samples-pos (point))
 363          (insert "\n\n" str))
 364        (goto-char (point-min))
 365        (if calc-graph-is-splot
 366            (if calc-graph-refine
 367                (error "This option works only for 2d plots")
 368              (setq recompute t)))
 369        (let ((calc-gnuplot-input (current-buffer))
 370              (calc-graph-no-auto-view t))
 371          (if printing
 372              (setq device calc-gnuplot-print-device
 373                    output calc-gnuplot-print-output)
 374            (setq device (calc-graph-find-command "terminal")
 375                  output (calc-graph-find-command "output"))
 376            (or device
 377                (setq device calc-gnuplot-default-device))
 378            (if output
 379                (setq output (car (read-from-string output)))
 380              (setq output calc-gnuplot-default-output)))
 381          (if (or (equal device "") (equal device "default"))
 382              (setq device (if printing
 383                               "postscript"
 384                             (if (or (eq window-system 'x) (getenv "DISPLAY"))
 385                                 "x11"
 386                               (if (>= calc-gnuplot-version 3)
 387                                   "dumb" "postscript")))))
 388          (if (equal device "dumb")
 389              (setq device (format "dumb %d %d"
 390                                   (1- (frame-width)) (1- (frame-height)))))
 391          (if (equal device "big")
 392              (setq device (format "dumb %d %d"
 393                                   (* 4 (- (frame-width) 3))
 394                                   (* 4 (- (frame-height) 3)))))
 395          (if (stringp output)
 396              (if (or (equal output "auto")
 397                      (and (equal output "tty") (setq tty-output t)))
 398                  (setq tempoutfile (calc-temp-file-name -1)
 399                        output tempoutfile))
 400            (setq output (eval output)))
 401          (or (equal device calc-graph-last-device)
 402              (progn
 403                (setq calc-graph-last-device device)
 404                (calc-gnuplot-command "set terminal" device)))
 405          (or (equal output calc-graph-last-output)
 406              (progn
 407                (setq calc-graph-last-output output)
 408                (calc-gnuplot-command "set output"
 409                                      (if (equal output "STDOUT")
 410                                          ""
 411                                        (prin1-to-string output)))))
 412          (setq calc-graph-resolution (calc-graph-find-command "samples"))
 413          (if calc-graph-resolution
 414              (setq calc-graph-resolution (string-to-int calc-graph-resolution))
 415            (setq calc-graph-resolution (if calc-graph-is-splot
 416                                 calc-graph-default-resolution-3d
 417                               calc-graph-default-resolution)))
 418          (setq precision (calc-graph-find-command "precision"))
 419          (if precision
 420              (setq precision (string-to-int precision))
 421            (setq precision calc-graph-default-precision))
 422          (calc-graph-set-command "terminal")
 423          (calc-graph-set-command "output")
 424          (calc-graph-set-command "samples")
 425          (calc-graph-set-command "precision"))
 426        (goto-char samples-pos)
 427        (insert "set samples " (int-to-string (max (if calc-graph-is-splot 20 200)
 428                                                   (+ 5 calc-graph-resolution))) "\n")
 429        (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t)
 430          (delete-region (match-beginning 0) (match-end 0))
 431          (if (looking-at ",")
 432              (delete-char 1)
 433            (while (memq (preceding-char) '(?\s ?\t))
 434              (forward-char -1))
 435            (if (eq (preceding-char) ?\,)
 436                (delete-backward-char 1))))
 437        (save-excursion
 438          (set-buffer calcbuf)
 439          (setq cache-env (list calc-angle-mode
 440                                calc-complex-mode
 441                                calc-simplify-mode
 442                                calc-infinite-mode
 443                                calc-word-size
 444                                precision calc-graph-is-splot))
 445          (if (and (not recompute)
 446                   (equal (cdr (car calc-graph-data-cache)) cache-env))
 447              (while (> (length calc-graph-data-cache)
 448                        calc-graph-data-cache-limit)
 449                (setcdr calc-graph-data-cache
 450                        (cdr (cdr calc-graph-data-cache))))
 451            (setq calc-graph-data-cache (list (cons nil cache-env)))))
 452        (calc-graph-find-plot t t)
 453        (while (re-search-forward
 454                (if calc-graph-is-splot
 455                    "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}"
 456                  "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}")
 457                nil t)
 458          (setq calc-graph-curve-num (1+ calc-graph-curve-num))
 459          (let* ((calc-graph-xname (buffer-substring (match-beginning 1) (match-end 1)))
 460                 (xvar (intern (concat "var-" calc-graph-xname)))
 461                 (calc-graph-xvalue (math-evaluate-expr (calc-var-value xvar)))
 462                 (calc-graph-y3name (and calc-graph-is-splot
 463                              (buffer-substring (match-beginning 2)
 464                                                (match-end 2))))
 465                 (y3var (and calc-graph-is-splot (intern (concat "var-" calc-graph-y3name))))
 466                 (calc-graph-y3value (and calc-graph-is-splot (calc-var-value y3var)))
 467                 (calc-graph-yname (buffer-substring (match-beginning 3) (match-end 3)))
 468                 (yvar (intern (concat "var-" calc-graph-yname)))
 469                 (calc-graph-yvalue (calc-var-value yvar))
 470                 filename)
 471            (delete-region (match-beginning 0) (match-end 0))
 472            (setq filename (calc-temp-file-name calc-graph-curve-num))
 473            (save-excursion
 474              (set-buffer calcbuf)
 475              (let (tempbuftop
 476                    (calc-graph-xp calc-graph-xvalue)
 477                    (calc-graph-yp calc-graph-yvalue)
 478                    (calc-graph-zp nil)
 479                    (calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil)
 480                    calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY
 481                    y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil)
 482                    calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector
 483                    calc-graph-numsteps calc-graph-numsteps3
 484                    (calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename)))
 485                    (calc-graph-stepcount 0)
 486                    (calc-symbolic-mode nil)
 487                    (calc-prefer-frac nil)
 488                    (calc-internal-prec (max 3 precision))
 489                    (calc-simplify-mode (and (not (memq calc-simplify-mode
 490                                                        '(none num)))
 491                                             calc-simplify-mode))
 492                    (calc-graph-blank t)
 493                    (calc-graph-non-blank nil)
 494                    (math-working-step 0)
 495                    (math-working-step-2 nil))
 496                (save-excursion
 497                  (if calc-graph-is-splot
 498                      (calc-graph-compute-3d)
 499                    (calc-graph-compute-2d))
 500                  (set-buffer tempbuf)
 501                  (goto-char (point-max))
 502                  (insert "\n" calc-graph-xname)
 503                  (if calc-graph-is-splot
 504                      (insert ":" calc-graph-y3name))
 505                  (insert ":" calc-graph-yname "\n\n")
 506                  (setq tempbuftop (point))
 507                  (let ((calc-group-digits nil)
 508                        (calc-leading-zeros nil)
 509                        (calc-number-radix 10)
 510                        (entry (and (not calc-graph-is-splot)
 511                                    (list calc-graph-xp calc-graph-yp calc-graph-xhigh calc-graph-numsteps))))
 512                    (or (equal entry
 513                               (nth 1 (nth (1+ calc-graph-curve-num)
 514                                           calc-graph-file-cache)))
 515                        (setq calc-graph-keep-file nil))
 516                    (setcar (cdr (nth (1+ calc-graph-curve-num) calc-graph-file-cache))
 517                            entry)
 518                    (or calc-graph-keep-file
 519                        (calc-graph-format-data)))
 520                  (or calc-graph-keep-file
 521                      (progn
 522                        (or calc-graph-non-blank
 523                            (error "No valid data points for %s:%s"
 524                                   calc-graph-xname calc-graph-yname))
 525                        (write-region tempbuftop (point-max) filename
 526                                      nil 'quiet))))))
 527            (insert (prin1-to-string filename))))
 528        (if calc-graph-surprise-splot
 529            (setcdr cache-env nil))
 530        (if (= calc-graph-curve-num 0)
 531            (progn
 532              (calc-gnuplot-command "clear")
 533              (calc-clear-command-flag 'clear-message)
 534              (message "No data to plot!"))
 535          (setq calc-graph-data-cache-limit (max calc-graph-curve-num
 536                                                 calc-graph-data-cache-limit)
 537                filename (calc-temp-file-name 0))
 538          (write-region (point-min) (point-max) filename nil 'quiet)
 539          (calc-gnuplot-command "load" (prin1-to-string filename))
 540          (or (equal output "STDOUT")
 541              calc-gnuplot-keep-outfile
 542              (progn   ; need to close the output file before printing/plotting
 543                (setq calc-graph-last-output "STDOUT")
 544                (calc-gnuplot-command "set output")))
 545          (let ((command (if printing
 546                             calc-gnuplot-print-command
 547                           (or calc-gnuplot-plot-command
 548                               (and (string-match "^dumb" device)
 549                                    'calc-graph-show-dumb)
 550                               (and tty-output
 551                                    'calc-graph-show-tty)))))
 552            (if command
 553                (if (stringp command)
 554                    (calc-gnuplot-command
 555                     "!" (format command
 556                                 (or tempoutfile
 557                                     calc-gnuplot-print-output)))
 558                  (if (symbolp command)
 559                      (funcall command output)
 560                    (eval command))))))))))
 561
 562 (defun calc-graph-compute-2d ()
 563   (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
 564       (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0)
 565           (error "Can't plot an empty vector")
 566         (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))
 567             (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)
 568                 (error "%s and %s have different lengths" calc-graph-xname calc-graph-yname))
 569           (if (and (eq (car-safe calc-graph-xvalue) 'intv)
 570                    (math-constp calc-graph-xvalue))
 571               (setq calc-graph-xstep (math-div (math-sub (nth 3 calc-graph-xvalue)
 572                                               (nth 2 calc-graph-xvalue))
 573                                     (1- calc-graph-numsteps))
 574                     calc-graph-xvalue (nth 2 calc-graph-xvalue))
 575             (if (math-realp calc-graph-xvalue)
 576                 (setq calc-graph-xstep 1)
 577               (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname)))))
 578     (or (math-realp calc-graph-yvalue)
 579         (let ((arglist nil))
 580           (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
 581           (calc-default-formula-arglist calc-graph-yvalue)
 582           (or arglist
 583               (error "%s does not contain any unassigned variables" calc-graph-yname))
 584           (and (cdr arglist)
 585                (error "%s contains more than one variable: %s"
 586                       calc-graph-yname arglist))
 587           (setq calc-graph-yvalue (math-expr-subst calc-graph-yvalue
 588                                         (math-build-var-name (car arglist))
 589                                         '(var DUMMY var-DUMMY)))))
 590     (setq calc-graph-ycache (assoc calc-graph-yvalue calc-graph-data-cache))
 591     (delq calc-graph-ycache calc-graph-data-cache)
 592     (nconc calc-graph-data-cache
 593            (list (or calc-graph-ycache (setq calc-graph-ycache (list calc-graph-yvalue)))))
 594     (if (and (not (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec)))
 595              calc-graph-refine (cdr (cdr calc-graph-ycache)))
 596         (calc-graph-refine-2d)
 597       (calc-graph-recompute-2d))))
 598
 599 (defun calc-graph-refine-2d ()
 600   (setq calc-graph-keep-file nil
 601         calc-graph-ycacheptr (cdr calc-graph-ycache))
 602   (if (and (setq calc-graph-xval (calc-graph-find-command "xrange"))
 603            (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'"
 604                          calc-graph-xval))
 605       (let ((b2 (match-beginning 2))
 606             (e2 (match-end 2)))
 607         (setq calc-graph-xlow (math-read-number (substring calc-graph-xval
 608                                                 (match-beginning 1)
 609                                                 (match-end 1)))
 610               calc-graph-xhigh (math-read-number (substring calc-graph-xval b2 e2))))
 611     (if calc-graph-xlow
 612         (while (and (cdr calc-graph-ycacheptr)
 613                     (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xlow))
 614           (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)))))
 615   (setq math-working-step-2 (1- (length calc-graph-ycacheptr)))
 616   (while (and (cdr calc-graph-ycacheptr)
 617               (or (not calc-graph-xhigh)
 618                   (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xhigh)))
 619     (setq var-DUMMY (math-div (math-add (car (car calc-graph-ycacheptr))
 620                                         (car (nth 1 calc-graph-ycacheptr)))
 621                               2)
 622           math-working-step (1+ math-working-step)
 623           calc-graph-yval (math-evaluate-expr calc-graph-yvalue))
 624     (setcdr calc-graph-ycacheptr (cons (cons var-DUMMY calc-graph-yval)
 625                             (cdr calc-graph-ycacheptr)))
 626     (setq calc-graph-ycacheptr (cdr (cdr calc-graph-ycacheptr))))
 627   (setq calc-graph-yp calc-graph-ycache
 628         calc-graph-numsteps 1000000))
 629
 630 (defun calc-graph-recompute-2d ()
 631   (setq calc-graph-ycacheptr calc-graph-ycache)
 632   (if calc-graph-xvec
 633       (setq calc-graph-numsteps (1- (length calc-graph-xvalue))
 634             calc-graph-yvector nil)
 635     (if (and (eq (car-safe calc-graph-xvalue) 'intv)
 636              (math-constp calc-graph-xvalue))
 637         (setq calc-graph-numsteps calc-graph-resolution
 638               calc-graph-yp nil
 639               calc-graph-xlow (nth 2 calc-graph-xvalue)
 640               calc-graph-xhigh (nth 3 calc-graph-xvalue)
 641               calc-graph-xstep (math-div (math-sub calc-graph-xhigh calc-graph-xlow)
 642                               (1- calc-graph-numsteps))
 643               calc-graph-xvalue (nth 2 calc-graph-xvalue))
 644       (error "%s is not a suitable basis for %s"
 645              calc-graph-xname calc-graph-yname)))
 646   (setq math-working-step-2 calc-graph-numsteps)
 647   (while (>= (setq calc-graph-numsteps (1- calc-graph-numsteps)) 0)
 648     (setq math-working-step (1+ math-working-step))
 649     (if calc-graph-xvec
 650         (progn
 651           (setq calc-graph-xp (cdr calc-graph-xp)
 652                 calc-graph-xval (car calc-graph-xp))
 653           (and (not (eq calc-graph-ycacheptr calc-graph-ycache))
 654                (consp (car calc-graph-ycacheptr))
 655                (not (Math-lessp (car (car calc-graph-ycacheptr)) calc-graph-xval))
 656                (setq calc-graph-ycacheptr calc-graph-ycache)))
 657       (if (= calc-graph-numsteps 0)
 658           (setq calc-graph-xval calc-graph-xhigh)   ; avoid cumulative roundoff
 659         (setq calc-graph-xval calc-graph-xvalue
 660               calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep))))
 661     (while (and (cdr calc-graph-ycacheptr)
 662                 (Math-lessp (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval))
 663       (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr)))
 664     (or (and (cdr calc-graph-ycacheptr)
 665              (Math-equal (car (nth 1 calc-graph-ycacheptr)) calc-graph-xval))
 666         (progn
 667           (setq calc-graph-keep-file nil
 668                 var-DUMMY calc-graph-xval)
 669           (setcdr calc-graph-ycacheptr (cons (cons calc-graph-xval (math-evaluate-expr calc-graph-yvalue))
 670                                   (cdr calc-graph-ycacheptr)))))
 671     (setq calc-graph-ycacheptr (cdr calc-graph-ycacheptr))
 672     (if calc-graph-xvec
 673         (setq calc-graph-yvector (cons (cdr (car calc-graph-ycacheptr)) calc-graph-yvector))
 674       (or calc-graph-yp (setq calc-graph-yp calc-graph-ycacheptr))))
 675   (if calc-graph-xvec
 676       (setq calc-graph-xp calc-graph-xvalue
 677             calc-graph-yvec t
 678             calc-graph-yp (cons 'vec (nreverse calc-graph-yvector))
 679             calc-graph-numsteps (1- (length calc-graph-xp)))
 680     (setq calc-graph-numsteps 1000000)))
 681
 682 (defun calc-graph-compute-3d ()
 683   (if (setq calc-graph-yvec (eq (car-safe calc-graph-yvalue) 'vec))
 684       (if (math-matrixp calc-graph-yvalue)
 685           (progn
 686             (setq calc-graph-numsteps (1- (length calc-graph-yvalue))
 687                   calc-graph-numsteps3 (1- (length (nth 1 calc-graph-yvalue))))
 688             (if (eq (car-safe calc-graph-xvalue) 'vec)
 689                 (or (= (1- (length calc-graph-xvalue)) calc-graph-numsteps)
 690                     (error "%s has wrong length" calc-graph-xname))
 691               (if (and (eq (car-safe calc-graph-xvalue) 'intv)
 692                        (math-constp calc-graph-xvalue))
 693                   (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps
 694                                                (nth 2 calc-graph-xvalue)
 695                                                (math-div
 696                                                 (math-sub (nth 3 calc-graph-xvalue)
 697                                                           (nth 2 calc-graph-xvalue))
 698                                                 (1- calc-graph-numsteps))))
 699                 (if (math-realp calc-graph-xvalue)
 700                     (setq calc-graph-xvalue (calcFunc-index calc-graph-numsteps calc-graph-xvalue 1))
 701                   (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))))
 702             (if (eq (car-safe calc-graph-y3value) 'vec)
 703                 (or (= (1- (length calc-graph-y3value)) calc-graph-numsteps3)
 704                     (error "%s has wrong length" calc-graph-y3name))
 705               (if (and (eq (car-safe calc-graph-y3value) 'intv)
 706                        (math-constp calc-graph-y3value))
 707                   (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3
 708                                                 (nth 2 calc-graph-y3value)
 709                                                 (math-div
 710                                                  (math-sub (nth 3 calc-graph-y3value)
 711                                                            (nth 2 calc-graph-y3value))
 712                                                  (1- calc-graph-numsteps3))))
 713                 (if (math-realp calc-graph-y3value)
 714                     (setq calc-graph-y3value (calcFunc-index calc-graph-numsteps3 calc-graph-y3value 1))
 715                   (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname))))
 716             (setq calc-graph-xp nil
 717                   calc-graph-yp nil
 718                   calc-graph-zp nil
 719                   calc-graph-xvec t)
 720             (while (setq calc-graph-xvalue (cdr calc-graph-xvalue) calc-graph-yvalue (cdr calc-graph-yvalue))
 721               (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue)))
 722                     calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value))))
 723                     calc-graph-zp (nconc calc-graph-zp (cons '(skip)
 724                                        (copy-sequence (cdr (car calc-graph-yvalue)))))))
 725             (setq calc-graph-numsteps (1- (* calc-graph-numsteps
 726                                              (1+ calc-graph-numsteps3)))))
 727         (if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0)
 728             (error "Can't plot an empty vector"))
 729         (or (and (eq (car-safe calc-graph-xvalue) 'vec)
 730                  (= (1- (length calc-graph-xvalue)) calc-graph-numsteps))
 731             (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname))
 732         (or (and (eq (car-safe calc-graph-y3value) 'vec)
 733                  (= (1- (length calc-graph-y3value)) calc-graph-numsteps))
 734             (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname))
 735         (setq calc-graph-xp calc-graph-xvalue
 736               calc-graph-yp calc-graph-y3value
 737               calc-graph-zp calc-graph-yvalue
 738               calc-graph-xvec t))
 739     (or (math-realp calc-graph-yvalue)
 740         (let ((arglist nil))
 741           (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
 742           (calc-default-formula-arglist calc-graph-yvalue)
 743           (setq arglist (sort arglist 'string-lessp))
 744           (or (cdr arglist)
 745               (error "%s does not contain enough unassigned variables" calc-graph-yname))
 746           (and (cdr (cdr arglist))
 747                (error "%s contains too many variables: %s" calc-graph-yname arglist))
 748           (setq calc-graph-yvalue (math-multi-subst calc-graph-yvalue
 749                                          (mapcar 'math-build-var-name
 750                                                  arglist)
 751                                          '((var DUMMY var-DUMMY)
 752                                            (var DUMMY2 var-DUMMY2))))))
 753     (if (setq calc-graph-xvec (eq (car-safe calc-graph-xvalue) 'vec))
 754         (setq calc-graph-numsteps (1- (length calc-graph-xvalue)))
 755       (if (and (eq (car-safe calc-graph-xvalue) 'intv)
 756                (math-constp calc-graph-xvalue))
 757           (setq calc-graph-numsteps calc-graph-resolution
 758                 calc-graph-xvalue (calcFunc-index calc-graph-numsteps
 759                                        (nth 2 calc-graph-xvalue)
 760                                        (math-div (math-sub (nth 3 calc-graph-xvalue)
 761                                                            (nth 2 calc-graph-xvalue))
 762                                                  (1- calc-graph-numsteps))))
 763         (error "%s is not a suitable basis for %s"
 764                calc-graph-xname calc-graph-yname)))
 765     (if (eq (car-safe calc-graph-y3value) 'vec)
 766         (setq calc-graph-numsteps3 (1- (length calc-graph-y3value)))
 767       (if (and (eq (car-safe calc-graph-y3value) 'intv)
 768                (math-constp calc-graph-y3value))
 769           (setq calc-graph-numsteps3 calc-graph-resolution
 770                 calc-graph-y3value (calcFunc-index calc-graph-numsteps3
 771                                         (nth 2 calc-graph-y3value)
 772                                         (math-div (math-sub (nth 3 calc-graph-y3value)
 773                                                             (nth 2 calc-graph-y3value))
 774                                                   (1- calc-graph-numsteps3))))
 775         (error "%s is not a suitable basis for %s"
 776                calc-graph-y3name calc-graph-yname)))
 777     (setq calc-graph-xp nil
 778           calc-graph-yp nil
 779           calc-graph-zp nil
 780           calc-graph-xvec t)
 781     (setq math-working-step 0)
 782     (while (setq calc-graph-xvalue (cdr calc-graph-xvalue))
 783       (setq calc-graph-xp (nconc calc-graph-xp (make-list (1+ calc-graph-numsteps3) (car calc-graph-xvalue)))
 784             calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value))))
 785             calc-graph-zp (cons '(skip) calc-graph-zp)
 786             calc-graph-y3step calc-graph-y3value
 787             var-DUMMY (car calc-graph-xvalue)
 788             math-working-step-2 0
 789             math-working-step (1+ math-working-step))
 790       (while (setq calc-graph-y3step (cdr calc-graph-y3step))
 791         (setq math-working-step-2 (1+ math-working-step-2)
 792               var-DUMMY2 (car calc-graph-y3step)
 793               calc-graph-zp (cons (math-evaluate-expr calc-graph-yvalue) calc-graph-zp))))
 794     (setq calc-graph-zp (nreverse calc-graph-zp)
 795           calc-graph-numsteps (1- (* calc-graph-numsteps (1+ calc-graph-numsteps3))))))
 796
 797 (defun calc-graph-format-data ()
 798   (while (<= (setq calc-graph-stepcount (1+ calc-graph-stepcount)) calc-graph-numsteps)
 799     (if calc-graph-xvec
 800         (setq calc-graph-xp (cdr calc-graph-xp)
 801               calc-graph-xval (car calc-graph-xp)
 802               calc-graph-yp (cdr calc-graph-yp)
 803               calc-graph-yval (car calc-graph-yp)
 804               calc-graph-zp (cdr calc-graph-zp)
 805               calc-graph-zval (car calc-graph-zp))
 806       (if calc-graph-yvec
 807           (setq calc-graph-xval calc-graph-xvalue
 808                 calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep)
 809                 calc-graph-yp (cdr calc-graph-yp)
 810                 calc-graph-yval (car calc-graph-yp))
 811         (setq calc-graph-xval (car (car calc-graph-yp))
 812               calc-graph-yval (cdr (car calc-graph-yp))
 813               calc-graph-yp (cdr calc-graph-yp))
 814         (if (or (not calc-graph-yp)
 815                 (and calc-graph-xhigh (equal calc-graph-xval calc-graph-xhigh)))
 816             (setq calc-graph-numsteps 0))))
 817     (if calc-graph-is-splot
 818         (if (and (eq (car-safe calc-graph-zval) 'calcFunc-xyz)
 819                  (= (length calc-graph-zval) 4))
 820             (setq calc-graph-xval (nth 1 calc-graph-zval)
 821                   calc-graph-yval (nth 2 calc-graph-zval)
 822                   calc-graph-zval (nth 3 calc-graph-zval)))
 823       (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xyz)
 824                (= (length calc-graph-yval) 4))
 825           (progn
 826             (or calc-graph-surprise-splot
 827                 (save-excursion
 828                   (set-buffer (get-buffer-create "*Gnuplot Temp*"))
 829                   (save-excursion
 830                     (goto-char (point-max))
 831                     (re-search-backward "^plot[ \t]")
 832                     (insert "set parametric\ns")
 833                     (setq calc-graph-surprise-splot t))))
 834             (setq calc-graph-xval (nth 1 calc-graph-yval)
 835                   calc-graph-zval (nth 3 calc-graph-yval)
 836                   calc-graph-yval (nth 2 calc-graph-yval)))
 837         (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xy)
 838                  (= (length calc-graph-yval) 3))
 839             (setq calc-graph-xval (nth 1 calc-graph-yval)
 840                   calc-graph-yval (nth 2 calc-graph-yval)))))
 841     (if (and (Math-realp calc-graph-xval)
 842              (Math-realp calc-graph-yval)
 843              (or (not calc-graph-zval) (Math-realp calc-graph-zval)))
 844         (progn
 845           (setq calc-graph-blank nil
 846                 calc-graph-non-blank t)
 847           (if (Math-integerp calc-graph-xval)
 848               (insert (math-format-number calc-graph-xval))
 849             (if (eq (car calc-graph-xval) 'frac)
 850                 (setq calc-graph-xval (math-float calc-graph-xval)))
 851             (insert (math-format-number (nth 1 calc-graph-xval))
 852                     "e" (int-to-string (nth 2 calc-graph-xval))))
 853           (insert " ")
 854           (if (Math-integerp calc-graph-yval)
 855               (insert (math-format-number calc-graph-yval))
 856             (if (eq (car calc-graph-yval) 'frac)
 857                 (setq calc-graph-yval (math-float calc-graph-yval)))
 858             (insert (math-format-number (nth 1 calc-graph-yval))
 859                     "e" (int-to-string (nth 2 calc-graph-yval))))
 860           (if calc-graph-zval
 861               (progn
 862                 (insert " ")
 863                 (if (Math-integerp calc-graph-zval)
 864                     (insert (math-format-number calc-graph-zval))
 865                   (if (eq (car calc-graph-zval) 'frac)
 866                       (setq calc-graph-zval (math-float calc-graph-zval)))
 867                   (insert (math-format-number (nth 1 calc-graph-zval))
 868                           "e" (int-to-string (nth 2 calc-graph-zval))))))
 869           (insert "\n"))
 870       (and (not (equal calc-graph-zval '(skip)))
 871            (eq (car-safe var-PlotRejects) 'vec)
 872            (nconc var-PlotRejects
 873                   (list (list 'vec
 874                               calc-graph-curve-num
 875                               calc-graph-stepcount
 876                               calc-graph-xval calc-graph-yval)))
 877            (calc-refresh-evaltos 'var-PlotRejects))
 878       (or calc-graph-blank
 879           (progn
 880             (insert "\n")
 881             (setq calc-graph-blank t))))))
 882
 883 (defun calc-temp-file-name (num)
 884   (while (<= (length calc-graph-file-cache) (1+ num))
 885     (setq calc-graph-file-cache (nconc calc-graph-file-cache (list nil))))
 886   (car (or (nth (1+ num) calc-graph-file-cache)
 887            (setcar (nthcdr (1+ num) calc-graph-file-cache)
 888                    (list (make-temp-file
 889                           (concat calc-gnuplot-tempfile
 890                                   (if (<= num 0)
 891                                       (char-to-string (- ?A num))
 892                                     (int-to-string num))))
 893                          nil)))))
 894
 895 (defun calc-graph-delete-temps ()
 896   (while calc-graph-file-cache
 897     (and (car calc-graph-file-cache)
 898          (file-exists-p (car (car calc-graph-file-cache)))
 899          (condition-case err
 900              (delete-file (car (car calc-graph-file-cache)))
 901            (error nil)))
 902     (setq calc-graph-file-cache (cdr calc-graph-file-cache))))
 903
 904 (defun calc-graph-kill-hook ()
 905   (calc-graph-delete-temps))
 906
 907 (defun calc-graph-show-tty (output)
 908   "Default calc-gnuplot-plot-command for \"tty\" output mode.
 909 This is useful for tek40xx and other graphics-terminal types."
 910   (call-process-region 1 1 shell-file-name
 911                        nil calc-gnuplot-buffer nil
 912                        "-c" (format "cat %s >/dev/tty; rm %s" output output)))
 913
 914 (defvar calc-dumb-map nil
 915   "The keymap for the \"dumb\" terminal plot.")
 916
 917 (defun calc-graph-show-dumb (&optional output)
 918   "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
 919 This \"dumb\" driver will be present in Gnuplot 3.0."
 920   (interactive)
 921   (save-window-excursion
 922     (switch-to-buffer calc-gnuplot-buffer)
 923     (delete-other-windows)
 924     (goto-char calc-gnuplot-trail-mark)
 925     (or (search-forward "\f" nil t)
 926         (sleep-for 1))
 927     (goto-char (point-max))
 928     (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T")
 929     (if (looking-at "\f")
 930         (progn
 931           (forward-char 1)
 932           (if (eolp) (forward-line 1))
 933           (or (calc-graph-find-command "time")
 934               (calc-graph-find-command "title")
 935               (calc-graph-find-command "ylabel")
 936               (let ((pt (point)))
 937                 (insert-before-markers (format "(%s)" (current-time-string)))
 938                 (goto-char pt)))
 939           (set-window-start (selected-window) (point))
 940           (goto-char (point-max)))
 941       (end-of-line)
 942       (backward-char 1)
 943       (recenter '(4)))
 944     (or calc-dumb-map
 945         (progn
 946           (setq calc-dumb-map (make-sparse-keymap))
 947           (define-key calc-dumb-map "\n" 'scroll-up)
 948           (define-key calc-dumb-map " " 'scroll-up)
 949           (define-key calc-dumb-map "\177" 'scroll-down)
 950           (define-key calc-dumb-map "<" 'scroll-left)
 951           (define-key calc-dumb-map ">" 'scroll-right)
 952           (define-key calc-dumb-map "{" 'scroll-down)
 953           (define-key calc-dumb-map "}" 'scroll-up)
 954           (define-key calc-dumb-map "q" 'exit-recursive-edit)
 955           (define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit)))
 956     (use-local-map calc-dumb-map)
 957     (setq truncate-lines t)
 958     (message "Type `q'%s to return to Calc"
 959              (if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch)
 960                     " or `M-# M-#'" ""))
 961     (recursive-edit)
 962     (bury-buffer "*Gnuplot Trail*")))
 963
 964 (defun calc-graph-clear ()
 965   (interactive)
 966   (if calc-graph-last-device
 967       (if (or (equal calc-graph-last-device "x11")
 968               (equal calc-graph-last-device "X11"))
 969           (calc-gnuplot-command "set output"
 970                                 (if (equal calc-graph-last-output "STDOUT")
 971                                     ""
 972                                   (prin1-to-string calc-graph-last-output)))
 973         (calc-gnuplot-command "clear"))))
 974
 975 (defun calc-graph-title-x (title)
 976   (interactive "sX axis title: ")
 977   (calc-graph-set-command "xlabel" (if (not (equal title ""))
 978                                        (prin1-to-string title))))
 979
 980 (defun calc-graph-title-y (title)
 981   (interactive "sY axis title: ")
 982   (calc-graph-set-command "ylabel" (if (not (equal title ""))
 983                                        (prin1-to-string title))))
 984
 985 (defun calc-graph-title-z (title)
 986   (interactive "sZ axis title: ")
 987   (calc-graph-set-command "zlabel" (if (not (equal title ""))
 988                                        (prin1-to-string title))))
 989
 990 (defun calc-graph-range-x (range)
 991   (interactive "sX axis range: ")
 992   (calc-graph-set-range "xrange" range))
 993
 994 (defun calc-graph-range-y (range)
 995   (interactive "sY axis range: ")
 996   (calc-graph-set-range "yrange" range))
 997
 998 (defun calc-graph-range-z (range)
 999   (interactive "sZ axis range: ")
1000   (calc-graph-set-range "zrange" range))
1001
1002 (defun calc-graph-set-range (cmd range)
1003   (if (equal range "$")
1004       (calc-wrapper
1005        (let ((val (calc-top-n 1)))
1006          (if (and (eq (car-safe val) 'intv) (math-constp val))
1007              (setq range (concat
1008                           (math-format-number (math-float (nth 2 val))) ":"
1009                           (math-format-number (math-float (nth 3 val)))))
1010            (if (and (eq (car-safe val) 'vec)
1011                     (= (length val) 3))
1012                (setq range (concat
1013                             (math-format-number (math-float (nth 1 val))) ":"
1014                             (math-format-number (math-float (nth 2 val)))))
1015              (error "Range specification must be an interval or 2-vector")))
1016          (calc-pop-stack 1))))
1017   (if (string-match "\\[.+\\]" range)
1018       (setq range (substring range 1 -1)))
1019   (if (and (not (string-match ":" range))
1020            (or (string-match "," range)
1021                (string-match " " range)))
1022       (aset range (match-beginning 0) ?\:))
1023   (calc-graph-set-command cmd (if (not (equal range ""))
1024                                   (concat "[" range "]"))))
1025
1026 (defun calc-graph-log-x (flag)
1027   (interactive "P")
1028   (calc-graph-set-log flag 0 0))
1029
1030 (defun calc-graph-log-y (flag)
1031   (interactive "P")
1032   (calc-graph-set-log 0 flag 0))
1033
1034 (defun calc-graph-log-z (flag)
1035   (interactive "P")
1036   (calc-graph-set-log 0 0 flag))
1037
1038 (defun calc-graph-set-log (xflag yflag zflag)
1039   (let* ((old (or (calc-graph-find-command "logscale") ""))
1040          (xold (string-match "x" old))
1041          (yold (string-match "y" old))
1042          (zold (string-match "z" old))
1043          str)
1044     (setq str (concat (if (if xflag
1045                               (if (eq xflag 0) xold
1046                                 (> (prefix-numeric-value xflag) 0))
1047                             (not xold)) "x" "")
1048                       (if (if yflag
1049                               (if (eq yflag 0) yold
1050                                 (> (prefix-numeric-value yflag) 0))
1051                             (not yold)) "y" "")
1052                       (if (if zflag
1053                               (if (eq zflag 0) zold
1054                                 (> (prefix-numeric-value zflag) 0))
1055                             (not zold)) "z" "")))
1056     (calc-graph-set-command "logscale" (if (not (equal str "")) str))))
1057
1058 (defun calc-graph-line-style (style)
1059   (interactive "P")
1060   (calc-graph-set-styles (and style (prefix-numeric-value style)) t))
1061
1062 (defun calc-graph-point-style (style)
1063   (interactive "P")
1064   (calc-graph-set-styles t (and style (prefix-numeric-value style))))
1065
1066 (defun calc-graph-set-styles (lines points)
1067   (calc-graph-init)
1068   (save-excursion
1069     (set-buffer calc-gnuplot-input)
1070     (or (calc-graph-find-plot nil nil)
1071         (error "No data points have been set!"))
1072     (let ((base (point))
1073           (mode nil) (lstyle nil) (pstyle nil)
1074           start end lenbl penbl)
1075       (re-search-forward "[,\n]")
1076       (forward-char -1)
1077       (setq end (point) start end)
1078       (goto-char base)
1079       (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+with\\)")
1080           (progn
1081             (setq start (match-beginning 1))
1082             (goto-char (match-end 0))
1083             (if (looking-at "[ \t]+\\([a-z]+\\)")
1084                 (setq mode (buffer-substring (match-beginning 1)
1085                                              (match-end 1))))
1086             (if (looking-at "[ \ta-z]+\\([0-9]+\\)")
1087                 (setq lstyle (string-to-int
1088                               (buffer-substring (match-beginning 1)
1089                                                 (match-end 1)))))
1090             (if (looking-at "[ \ta-z]+[0-9]+[ \t]+\\([0-9]+\\)")
1091                 (setq pstyle (string-to-int
1092                               (buffer-substring (match-beginning 1)
1093                                                 (match-end 1)))))))
1094       (setq lenbl (or (equal mode "lines") (equal mode "linespoints"))
1095             penbl (or (equal mode "points") (equal mode "linespoints")))
1096       (if lines
1097           (or (eq lines t)
1098               (setq lstyle lines
1099                     lenbl (>= lines 0)))
1100         (setq lenbl (not lenbl)))
1101       (if points
1102           (or (eq points t)
1103               (setq pstyle points
1104                     penbl (>= points 0)))
1105         (setq penbl (not penbl)))
1106       (delete-region start end)
1107       (goto-char start)
1108       (insert " with "
1109               (if lenbl
1110                   (if penbl "linespoints" "lines")
1111                 (if penbl "points" "dots")))
1112       (if (and pstyle (> pstyle 0))
1113           (insert " " (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
1114                   " " (int-to-string pstyle))
1115         (if (and lstyle (> lstyle 0))
1116             (insert " " (int-to-string lstyle))))))
1117   (calc-graph-view-commands))
1118
1119 (defun calc-graph-zero-x (flag)
1120   (interactive "P")
1121   (calc-graph-set-command "noxzeroaxis"
1122                           (and (if flag
1123                                    (<= (prefix-numeric-value flag) 0)
1124                                  (not (calc-graph-find-command "noxzeroaxis")))
1125                                " ")))
1126
1127 (defun calc-graph-zero-y (flag)
1128   (interactive "P")
1129   (calc-graph-set-command "noyzeroaxis"
1130                           (and (if flag
1131                                    (<= (prefix-numeric-value flag) 0)
1132                                  (not (calc-graph-find-command "noyzeroaxis")))
1133                                " ")))
1134
1135 (defun calc-graph-name (name)
1136   (interactive "sTitle for current curve: ")
1137   (calc-graph-init)
1138   (save-excursion
1139     (set-buffer calc-gnuplot-input)
1140     (or (calc-graph-find-plot nil nil)
1141         (error "No data points have been set!"))
1142     (let ((base (point))
1143           start
1144           end)
1145       (re-search-forward "[,\n]\\|[ \t]+with")
1146       (setq end (match-beginning 0))
1147       (goto-char base)
1148       (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+title\\)")
1149           (progn
1150             (goto-char (match-beginning 1))
1151             (delete-region (point) end))
1152         (goto-char end))
1153       (insert " title " (prin1-to-string name))))
1154   (calc-graph-view-commands))
1155
1156 (defun calc-graph-hide (flag)
1157   (interactive "P")
1158   (calc-graph-init)
1159   (and (calc-graph-find-plot nil nil)
1160        (progn
1161          (or (looking-at "{")
1162              (error "Can't hide this curve (wrong format)"))
1163          (forward-char 1)
1164          (if (looking-at "*")
1165              (if (or (null flag) (<= (prefix-numeric-value flag) 0))
1166                  (delete-char 1))
1167            (if (or (null flag) (> (prefix-numeric-value flag) 0))
1168                (insert "*"))))))
1169
1170 (defun calc-graph-header (title)
1171   (interactive "sTitle for entire graph: ")
1172   (calc-graph-set-command "title" (if (not (equal title ""))
1173                                       (prin1-to-string title))))
1174
1175 (defun calc-graph-border (flag)
1176   (interactive "P")
1177   (calc-graph-set-command "noborder"
1178                           (and (if flag
1179                                    (<= (prefix-numeric-value flag) 0)
1180                                  (not (calc-graph-find-command "noborder")))
1181                                " ")))
1182
1183 (defun calc-graph-grid (flag)
1184   (interactive "P")
1185   (calc-graph-set-command "grid" (and (if flag
1186                                           (> (prefix-numeric-value flag) 0)
1187                                         (not (calc-graph-find-command "grid")))
1188                                       " ")))
1189
1190 (defun calc-graph-key (flag)
1191   (interactive "P")
1192   (calc-graph-set-command "key" (and (if flag
1193                                          (> (prefix-numeric-value flag) 0)
1194                                        (not (calc-graph-find-command "key")))
1195                                      " ")))
1196
1197 (defun calc-graph-num-points (res flag)
1198   (interactive "sNumber of data points: \nP")
1199   (if flag
1200       (if (> (prefix-numeric-value flag) 0)
1201           (if (equal res "")
1202               (message "Default resolution is %d"
1203                        calc-graph-default-resolution)
1204             (setq calc-graph-default-resolution (string-to-int res)))
1205         (if (equal res "")
1206             (message "Default 3D resolution is %d"
1207                      calc-graph-default-resolution-3d)
1208           (setq calc-graph-default-resolution-3d (string-to-int res))))
1209     (calc-graph-set-command "samples" (if (not (equal res "")) res))))
1210
1211 (defun calc-graph-device (name flag)
1212   (interactive "sDevice name: \nP")
1213   (if (equal name "?")
1214       (progn
1215         (calc-gnuplot-command "set terminal")
1216         (calc-graph-view-trail))
1217     (if flag
1218         (if (> (prefix-numeric-value flag) 0)
1219             (if (equal name "")
1220                 (message "Default GNUPLOT device is \"%s\""
1221                          calc-gnuplot-default-device)
1222               (setq calc-gnuplot-default-device name))
1223           (if (equal name "")
1224               (message "GNUPLOT device for Print command is \"%s\""
1225                        calc-gnuplot-print-device)
1226             (setq calc-gnuplot-print-device name)))
1227       (calc-graph-set-command "terminal" (if (not (equal name ""))
1228                                              name)))))
1229
1230 (defun calc-graph-output (name flag)
1231   (interactive "FOutput file name: \np")
1232   (cond ((string-match "\\<[aA][uU][tT][oO]$" name)
1233          (setq name "auto"))
1234         ((string-match "\\<[tT][tT][yY]$" name)
1235          (setq name "tty"))
1236         ((string-match "\\<[sS][tT][dD][oO][uU][tT]$" name)
1237          (setq name "STDOUT"))
1238         ((equal (file-name-nondirectory name) "")
1239          (setq name ""))
1240         (t (setq name (expand-file-name name))))
1241   (if flag
1242       (if (> (prefix-numeric-value flag) 0)
1243           (if (equal name "")
1244               (message "Default GNUPLOT output file is \"%s\""
1245                        calc-gnuplot-default-output)
1246             (setq calc-gnuplot-default-output name))
1247         (if (equal name "")
1248             (message "GNUPLOT output file for Print command is \"%s\""
1249                      calc-gnuplot-print-output)
1250           (setq calc-gnuplot-print-output name)))
1251     (calc-graph-set-command "output" (if (not (equal name ""))
1252                                          (prin1-to-string name)))))
1253
1254 (defun calc-graph-display (name)
1255   (interactive "sX display name: ")
1256   (if (equal name "")
1257       (message "Current X display is \"%s\""
1258                (or calc-gnuplot-display "<none>"))
1259     (setq calc-gnuplot-display name)
1260     (if (calc-gnuplot-alive)
1261         (calc-gnuplot-command "exit"))))
1262
1263 (defun calc-graph-geometry (name)
1264   (interactive "sX geometry spec (or \"default\"): ")
1265   (if (equal name "")
1266       (message "Current X geometry is \"%s\""
1267                (or calc-gnuplot-geometry "default"))
1268     (setq calc-gnuplot-geometry (and (not (equal name "default")) name))
1269     (if (calc-gnuplot-alive)
1270         (calc-gnuplot-command "exit"))))
1271
1272 (defun calc-graph-find-command (cmd)
1273   (calc-graph-init)
1274   (save-excursion
1275     (set-buffer calc-gnuplot-input)
1276     (goto-char (point-min))
1277     (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t)
1278         (buffer-substring (match-beginning 1) (match-end 1)))))
1279
1280 (defun calc-graph-set-command (cmd &rest args)
1281   (calc-graph-init)
1282   (save-excursion
1283     (set-buffer calc-gnuplot-input)
1284     (goto-char (point-min))
1285     (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t\n]") nil t)
1286         (progn
1287           (forward-char -1)
1288           (end-of-line)
1289           (let ((end (point)))
1290             (beginning-of-line)
1291             (delete-region (point) (1+ end))))
1292       (if (calc-graph-find-plot t t)
1293           (if (eq (preceding-char) ?\n)
1294               (forward-char -1))
1295         (goto-char (1- (point-max)))))
1296     (if (and args (car args))
1297         (progn
1298           (or (bolp)
1299               (insert "\n"))
1300           (insert "set " (mapconcat 'identity (cons cmd args) " ") "\n"))))
1301   (calc-graph-view-commands))
1302
1303 (defun calc-graph-command (cmd)
1304   (interactive "sGNUPLOT command: ")
1305   (calc-wrapper
1306    (calc-graph-init)
1307    (calc-graph-view-trail)
1308    (calc-gnuplot-command cmd)
1309    (accept-process-output)
1310    (calc-graph-view-trail)))
1311
1312 (defun calc-graph-kill (&optional no-view)
1313   (interactive)
1314   (calc-graph-delete-temps)
1315   (if (calc-gnuplot-alive)
1316       (calc-wrapper
1317        (or no-view (calc-graph-view-trail))
1318        (let ((calc-graph-no-wait t))
1319          (calc-gnuplot-command "exit"))
1320        (sit-for 1)
1321        (if (process-status calc-gnuplot-process)
1322            (delete-process calc-gnuplot-process))
1323        (setq calc-gnuplot-process nil))))
1324
1325 (defun calc-graph-quit ()
1326   (interactive)
1327   (if (get-buffer-window calc-gnuplot-input)
1328       (calc-graph-view-commands t))
1329   (if (get-buffer-window calc-gnuplot-buffer)
1330       (calc-graph-view-trail t))
1331   (calc-graph-kill t))
1332
1333 (defun calc-graph-view-commands (&optional no-need)
1334   (interactive "p")
1335   (or calc-graph-no-auto-view (calc-graph-init-buffers))
1336   (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need)))
1337
1338 (defun calc-graph-view-trail (&optional no-need)
1339   (interactive "p")
1340   (or calc-graph-no-auto-view (calc-graph-init-buffers))
1341   (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need)))
1342
1343 (defun calc-graph-view (buf other-buf need)
1344   (let (win)
1345     (or calc-graph-no-auto-view
1346         (if (setq win (get-buffer-window buf))
1347             (or need
1348                 (and (eq buf calc-gnuplot-buffer)
1349                      (save-excursion
1350                        (set-buffer buf)
1351                        (not (pos-visible-in-window-p (point-max) win))))
1352                 (progn
1353                   (bury-buffer buf)
1354                   (bury-buffer other-buf)
1355                   (let ((curwin (selected-window)))
1356                     (select-window win)
1357                     (switch-to-buffer nil)
1358                     (select-window curwin))))
1359           (if (setq win (get-buffer-window other-buf))
1360               (set-window-buffer win buf)
1361             (if (eq major-mode 'calc-mode)
1362                 (if (or need
1363                         (< (window-height) (1- (frame-height))))
1364                     (display-buffer buf))
1365               (switch-to-buffer buf)))))
1366     (save-excursion
1367       (set-buffer buf)
1368       (if (and (eq buf calc-gnuplot-buffer)
1369                (setq win (get-buffer-window buf))
1370                (not (pos-visible-in-window-p (point-max) win)))
1371           (progn
1372             (goto-char (point-max))
1373             (vertical-motion (- 6 (window-height win)))
1374             (set-window-start win (point))
1375             (goto-char (point-max)))))
1376     (or calc-graph-no-auto-view (sit-for 0))))
1377
1378 (defun calc-gnuplot-check-for-errors ()
1379   (if (save-excursion
1380         (prog2
1381          (progn
1382            (set-buffer calc-gnuplot-buffer)
1383            (goto-char calc-gnuplot-last-error-pos))
1384          (re-search-forward "^[ \t]+\\^$" nil t)
1385          (goto-char (point-max))
1386          (setq calc-gnuplot-last-error-pos (point-max))))
1387       (calc-graph-view-trail)))
1388
1389 (defun calc-gnuplot-command (&rest args)
1390   (calc-graph-init)
1391   (let ((cmd (concat (mapconcat 'identity args " ") "\n")))
1392     (accept-process-output)
1393     (save-excursion
1394       (set-buffer calc-gnuplot-buffer)
1395       (calc-gnuplot-check-for-errors)
1396       (goto-char (point-max))
1397       (setq calc-gnuplot-trail-mark (point))
1398       (or (>= calc-gnuplot-version 3)
1399           (insert cmd))
1400       (set-marker (process-mark calc-gnuplot-process) (point))
1401       (process-send-string calc-gnuplot-process cmd)
1402       (if (get-buffer-window calc-gnuplot-buffer)
1403           (calc-graph-view-trail))
1404       (accept-process-output (and (not calc-graph-no-wait)
1405                                   calc-gnuplot-process))
1406       (calc-gnuplot-check-for-errors)
1407       (if (get-buffer-window calc-gnuplot-buffer)
1408           (calc-graph-view-trail)))))
1409
1410 (defun calc-graph-init-buffers ()
1411   (or (and calc-gnuplot-buffer
1412            (buffer-name calc-gnuplot-buffer))
1413       (setq calc-gnuplot-buffer (get-buffer-create "*Gnuplot Trail*")))
1414   (or (and calc-gnuplot-input
1415            (buffer-name calc-gnuplot-input))
1416       (setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*"))))
1417
1418 (defun calc-graph-init ()
1419   (or (calc-gnuplot-alive)
1420       (let ((process-connection-type t)
1421             origin)
1422         (if calc-gnuplot-process
1423             (progn
1424               (delete-process calc-gnuplot-process)
1425               (setq calc-gnuplot-process nil)))
1426         (calc-graph-init-buffers)
1427         (save-excursion
1428           (set-buffer calc-gnuplot-buffer)
1429           (insert "\nStarting gnuplot...\n")
1430           (setq origin (point)))
1431         (setq calc-graph-last-device nil)
1432         (setq calc-graph-last-output nil)
1433         (condition-case err
1434             (let ((args (append (and calc-gnuplot-display
1435                                      (not (equal calc-gnuplot-display
1436                                                  (getenv "DISPLAY")))
1437                                      (list "-display"
1438                                            calc-gnuplot-display))
1439                                 (and calc-gnuplot-geometry
1440                                      (list "-geometry"
1441                                            calc-gnuplot-geometry)))))
1442               (setq calc-gnuplot-process
1443                     (apply 'start-process
1444                            "gnuplot"
1445                            calc-gnuplot-buffer
1446                            calc-gnuplot-name
1447                            args))
1448               (set-process-query-on-exit-flag calc-gnuplot-process nil))
1449           (file-error
1450            (error "Sorry, can't find \"%s\" on your system"
1451                   calc-gnuplot-name)))
1452         (save-excursion
1453           (set-buffer calc-gnuplot-buffer)
1454           (while (and (not (save-excursion
1455                              (goto-char origin)
1456                              (search-forward "gnuplot> " nil t)))
1457                       (memq (process-status calc-gnuplot-process) '(run stop)))
1458             (accept-process-output calc-gnuplot-process))
1459           (or (memq (process-status calc-gnuplot-process) '(run stop))
1460               (error "Unable to start GNUPLOT process"))
1461           (if (save-excursion
1462                 (goto-char origin)
1463                 (re-search-forward
1464                  "G N U P L O T.*\n.*version \\([0-9]+\\)\\." nil t))
1465               (setq calc-gnuplot-version (string-to-int (buffer-substring
1466                                                          (match-beginning 1)
1467                                                          (match-end 1))))
1468             (setq calc-gnuplot-version 1))
1469           (goto-char (point-max)))))
1470   (save-excursion
1471     (set-buffer calc-gnuplot-input)
1472     (if (= (buffer-size) 0)
1473         (insert "# Commands for running gnuplot\n\n\n")
1474       (or calc-graph-no-auto-view
1475           (eq (char-after (1- (point-max))) ?\n)
1476           (progn
1477             (goto-char (point-max))
1478             (insert "\n"))))))
1479
1480 (provide 'calc-graph)
1481
1482 ;;; arch-tag: e4b06a52-c386-4d54-a2bb-7c0a0ef533c2
1483 ;;; calc-graph.el ends here