lisp/calc/calc-graph.el

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