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