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, or (at your option)
  14 ;; 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; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 ;; This file is autoloaded from calc-ext.el.
  31
  32 (require 'calc-ext)
  33 (require 'calc-macs)
  34
  35 ;;; Graphics
  36
  37 ;; The following three variables are customizable and defined in calc.el.
  38 (defvar calc-gnuplot-name)
  39 (defvar calc-gnuplot-plot-command)
  40 (defvar calc-gnuplot-print-command)
  41
  42 (defvar calc-gnuplot-tempfile "calc")
  43
  44 (defvar calc-gnuplot-default-device)
  45 (defvar calc-gnuplot-default-output)
  46 (defvar calc-gnuplot-print-device)
  47 (defvar calc-gnuplot-print-output)
  48 (defvar calc-gnuplot-keep-outfile nil)
  49 (defvar calc-gnuplot-version nil)
  50
  51 (defvar calc-gnuplot-display (getenv "DISPLAY"))
  52 (defvar calc-gnuplot-geometry)
  53
  54 (defvar calc-graph-default-resolution)
  55 (defvar calc-graph-default-resolution-3d)
  56 (defvar calc-graph-default-precision 5)
  57
  58 (defvar calc-gnuplot-buffer nil)
  59 (defvar calc-gnuplot-input nil)
  60
  61 (defvar calc-gnuplot-last-error-pos 1)
  62 (defvar calc-graph-last-device nil)
  63 (defvar calc-graph-last-output nil)
  64 (defvar calc-graph-file-cache nil)
  65 (defvar calc-graph-var-cache nil)
  66 (defvar calc-graph-data-cache nil)
  67 (defvar calc-graph-data-cache-limit 10)
  68 (defvar calc-graph-no-auto-view nil)
  69 (defvar calc-graph-no-wait nil)
  70 (defvar calc-gnuplot-trail-mark)
  71
  72 (defun calc-graph-fast (many)
  73   (interactive "P")
  74   (let ((calc-graph-no-auto-view t))
  75     (calc-graph-delete t)
  76     (calc-graph-add many)
  77     (calc-graph-plot nil)))
  78
  79 (defun calc-graph-fast-3d (many)
  80   (interactive "P")
  81   (let ((calc-graph-no-auto-view t))
  82     (calc-graph-delete t)
  83     (calc-graph-add-3d many)
  84     (calc-graph-plot nil)))
  85
  86 (defun calc-graph-delete (all)
  87   (interactive "P")
  88   (calc-wrapper
  89    (calc-graph-init)
  90    (save-excursion
  91      (set-buffer calc-gnuplot-input)
  92      (and (calc-graph-find-plot t all)
  93           (progn
  94             (if (looking-at "s?plot")
  95                 (progn
  96                   (setq calc-graph-var-cache nil)
  97                   (delete-region (point) (point-max)))
  98               (delete-region (point) (1- (point-max)))))))
  99    (calc-graph-view-commands)))
 100
 101 (defun calc-graph-find-plot (&optional before all)
 102   (goto-char (point-min))
 103   (and (re-search-forward "^s?plot[ \t]+" nil t)
 104        (let ((beg (point)))
 105          (goto-char (point-max))
 106          (if (or all
 107                  (not (search-backward "," nil t))
 108                  (< (point) beg))
 109              (progn
 110                (goto-char beg)
 111                (if before
 112                    (beginning-of-line)))
 113            (or before
 114                (re-search-forward ",[ \t]+")))
 115          t)))
 116
 117 (defun calc-graph-add (many)
 118   (interactive "P")
 119   (calc-wrapper
 120    (calc-graph-init)
 121    (cond ((null many)
 122           (calc-graph-add-curve (calc-graph-lookup (calc-top-n 2))
 123                                 (calc-graph-lookup (calc-top-n 1))))
 124          ((or (consp many) (eq many 0))
 125           (let ((xdata (calc-graph-lookup (calc-top-n 2)))
 126                 (ylist (calc-top-n 1)))
 127             (or (eq (car-safe ylist) 'vec)
 128                 (error "Y argument must be a vector"))
 129             (while (setq ylist (cdr ylist))
 130               (calc-graph-add-curve xdata (calc-graph-lookup (car ylist))))))
 131          ((> (setq many (prefix-numeric-value many)) 0)
 132           (let ((xdata (calc-graph-lookup (calc-top-n (1+ many)))))
 133             (while (> many 0)
 134               (calc-graph-add-curve xdata
 135                                     (calc-graph-lookup (calc-top-n many)))
 136               (setq many (1- many)))))
 137          (t
 138           (let (pair)
 139             (setq many (- many))
 140             (while (> many 0)
 141               (setq pair (calc-top-n many))
 142               (or (and (eq (car-safe pair) 'vec)
 143                        (= (length pair) 3))
 144                   (error "Argument must be an [x,y] vector"))
 145               (calc-graph-add-curve (calc-graph-lookup (nth 1 pair))
 146                                     (calc-graph-lookup (nth 2 pair)))
 147               (setq many (1- many))))))
 148    (calc-graph-view-commands)))
 149
 150 (defun calc-graph-add-3d (many)
 151   (interactive "P")
 152   (calc-wrapper
 153    (calc-graph-init)
 154    (cond ((null many)
 155           (calc-graph-add-curve (calc-graph-lookup (calc-top-n 3))
 156                                 (calc-graph-lookup (calc-top-n 2))
 157                                 (calc-graph-lookup (calc-top-n 1))))
 158          ((or (consp many) (eq many 0))
 159           (let ((xdata (calc-graph-lookup (calc-top-n 3)))
 160                 (ydata (calc-graph-lookup (calc-top-n 2)))
 161                 (zlist (calc-top-n 1)))
 162             (or (eq (car-safe zlist) 'vec)
 163                 (error "Z argument must be a vector"))
 164             (while (setq zlist (cdr zlist))
 165               (calc-graph-add-curve xdata ydata
 166                                     (calc-graph-lookup (car zlist))))))
 167          ((> (setq many (prefix-numeric-value many)) 0)
 168           (let ((xdata (calc-graph-lookup (calc-top-n (+ many 2))))
 169                 (ydata (calc-graph-lookup (calc-top-n (+ many 1)))))
 170             (while (> many 0)
 171               (calc-graph-add-curve xdata ydata
 172                                     (calc-graph-lookup (calc-top-n many)))
 173               (setq many (1- many)))))
 174          (t
 175           (let (curve)
 176             (setq many (- many))
 177             (while (> many 0)
 178               (setq curve (calc-top-n many))
 179               (or (and (eq (car-safe curve) 'vec)
 180                        (= (length curve) 4))
 181                   (error "Argument must be an [x,y,z] vector"))
 182               (calc-graph-add-curve (calc-graph-lookup (nth 1 curve))
 183                                     (calc-graph-lookup (nth 2 curve))
 184                                     (calc-graph-lookup (nth 3 curve)))
 185               (setq many (1- many))))))
 186    (calc-graph-view-commands)))
 187
 188 (defun calc-graph-add-curve (xdata ydata &optional zdata)
 189   (let ((num (calc-graph-count-curves))
 190         (pstyle (calc-var-value 'var-PointStyles))
 191         (lstyle (calc-var-value 'var-LineStyles)))
 192     (save-excursion
 193       (set-buffer calc-gnuplot-input)
 194       (goto-char (point-min))
 195       (if (re-search-forward (if zdata "^plot[ \t]" "^splot[ \t]")
 196                              nil t)
 197           (error "Can't mix 2d and 3d curves on one graph"))
 198       (if (re-search-forward "^s?plot[ \t]" nil t)
 199           (progn
 200             (end-of-line)
 201             (insert ", "))
 202         (goto-char (point-max))
 203         (or (eq (preceding-char) ?\n)
 204             (insert "\n"))
 205         (insert (if zdata "splot" "plot") " \n")
 206         (forward-char -1))
 207       (insert "{" (symbol-name (nth 1 xdata))
 208               ":" (symbol-name (nth 1 ydata)))
 209       (if zdata
 210           (insert ":" (symbol-name (nth 1 zdata))))
 211       (insert "} "
 212               "title \"" (symbol-name (nth 1 ydata)) "\" "
 213               "with dots")
 214       (setq pstyle (and (eq (car-safe pstyle) 'vec) (nth (1+ num) pstyle)))
 215       (setq lstyle (and (eq (car-safe lstyle) 'vec) (nth (1+ num) lstyle))))
 216     (calc-graph-set-styles
 217      (or (and (Math-num-integerp lstyle) (math-trunc lstyle))
 218          0)
 219      (or (and (Math-num-integerp pstyle) (math-trunc pstyle))
 220          (if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
 221              0 -1)))))
 222
 223 (defun calc-graph-lookup (thing)
 224   (if (and (eq (car-safe thing) 'var)
 225            (calc-var-value (nth 2 thing)))
 226       thing
 227     (let ((found (assoc thing calc-graph-var-cache)))
 228       (or found
 229           (let ((varname (concat "PlotData"
 230                                  (int-to-string
 231                                   (1+ (length calc-graph-var-cache))))))
 232             (setq var (list 'var (intern varname)
 233                             (intern (concat "var-" varname)))
 234                   found (cons thing var)
 235                   calc-graph-var-cache (cons found calc-graph-var-cache))
 236             (set (nth 2 var) thing)))
 237       (cdr found))))
 238
 239 (defun calc-graph-juggle (arg)
 240   (interactive "p")
 241   (calc-graph-init)
 242   (save-excursion
 243     (set-buffer calc-gnuplot-input)
 244     (if (< arg 0)
 245         (let ((num (calc-graph-count-curves)))
 246           (if (> num 0)
 247               (while (< arg 0)
 248                 (setq arg (+ arg num))))))
 249     (while (>= (setq arg (1- arg)) 0)
 250       (calc-graph-do-juggle))))
 251
 252 (defun calc-graph-count-curves ()
 253   (save-excursion
 254     (set-buffer calc-gnuplot-input)
 255     (if (re-search-forward "^s?plot[ \t]" nil t)
 256         (let ((num 1))
 257           (goto-char (point-min))
 258           (while (search-forward "," nil t)
 259             (setq num (1+ num)))
 260           num)
 261       0)))
 262
 263 (defun calc-graph-do-juggle ()
 264   (let (base)
 265     (and (calc-graph-find-plot t t)
 266          (progn
 267            (setq base (point))
 268            (calc-graph-find-plot t nil)
 269            (or (eq base (point))
 270                (let ((str (buffer-substring (+ (point) 2) (1- (point-max)))))
 271                  (delete-region (point) (1- (point-max)))
 272                  (goto-char (+ base 5))
 273                  (insert str ", ")))))))
 274
 275 (defun calc-graph-print (flag)
 276   (interactive "P")
 277   (calc-graph-plot flag t))
 278
 279 (defvar var-DUMMY)
 280 (defvar var-DUMMY2)
 281 (defvar var-PlotRejects)
 282
 283 ;; The following variables are local to calc-graph-plot, but are
 284 ;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d,
 285 ;; calc-graph-recompute-2d, calc-graph-compute-3d and
 286 ;; calc-graph-format-data, which are called by calc-graph-plot.
 287 (defvar calc-graph-yvalue)
 288 (defvar calc-graph-yvec)
 289 (defvar calc-graph-numsteps)
 290 (defvar calc-graph-numsteps3)
 291 (defvar calc-graph-xvalue)
 292 (defvar calc-graph-xvec)
 293 (defvar calc-graph-xname)
 294 (defvar calc-graph-yname)
 295 (defvar calc-graph-xstep)
 296 (defvar calc-graph-ycache)
 297 (defvar calc-graph-ycacheptr)
 298 (defvar calc-graph-refine)
 299 (defvar calc-graph-keep-file)
 300 (defvar calc-graph-xval)
 301 (defvar calc-graph-xlow)
 302 (defvar calc-graph-xhigh)
 303 (defvar calc-graph-yval)
 304 (defvar calc-graph-yp)
 305 (defvar calc-graph-xp)
 306 (defvar calc-graph-zp)
 307 (defvar calc-graph-yvector)
 308 (defvar calc-graph-resolution)
 309 (defvar calc-graph-y3value)
 310 (defvar calc-graph-y3name)
 311 (defvar calc-graph-y3step)
 312 (defvar calc-graph-zval)
 313 (defvar calc-graph-stepcount)
 314 (defvar calc-graph-is-splot)
 315 (defvar calc-graph-surprise-splot)
 316 (defvar calc-graph-blank)
 317 (defvar calc-graph-non-blank)
 318 (defvar calc-graph-curve-num)
 319
 320 (defun calc-graph-plot (flag &optional printing)
 321   (interactive "P")
 322   (calc-slow-wrapper
 323    (let ((calcbuf (current-buffer))
 324          (tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
 325          (tempbuftop 1)
 326          (tempoutfile nil)
 327          (calc-graph-curve-num 0)
 328          (calc-graph-refine (and flag (> (prefix-numeric-value flag) 0)))
 329          (recompute (and flag (< (prefix-numeric-value flag) 0)))
 330          (calc-graph-surprise-splot nil)
 331          (tty-output nil)
 332          cache-env calc-graph-is-splot device output calc-graph-resolution precision samples-pos)
 333      (add-hook 'kill-emacs-hook 'calc-graph-kill-hook)
 334      (save-excursion
 335        (calc-graph-init)
 336        (set-buffer tempbuf)
 337        (erase-buffer)
 338        (set-buffer calc-gnuplot-input)
 339        (goto-char (point-min))
 340        (setq calc-graph-is-splot (re-search-forward "^splot[ \t]" nil t))
 341        (let ((str (buffer-string))
 342              (ver calc-gnuplot-version))
 343          (set-buffer (get-buffer-create "*Gnuplot Temp*"))
 344          (erase-buffer)
 345          (insert "# (Note: This is a temporary copy---do not edit!)\n")
 346          (if (>= ver 2)
 347              (insert "set noarrow\nset nolabel\n"
 348                      "set autoscale xy\nset nologscale xy\n"
 349                      "set xlabel\nset ylabel\nset title\n"
 350                      "set noclip points\nset clip one\nset clip two\n"
 351                      "set format \"%g\"\nset tics\nset xtics\nset ytics\n"
 352                      "set data style linespoints\n"
 353                      "set nogrid\nset nokey\nset nopolar\n"))
 354          (if (>= ver 3)
 355              (insert "set surface\nset nocontour\n"
 356                      "set " (if calc-graph-is-splot "" "no") "parametric\n"
 357                      "set notime\nset border\nset ztics\nset zeroaxis\n"
 358                      "set view 60,30,1,1\nset offsets 0,0,0,0\n"))
 359          (setq samples-pos (point))
 360          (insert "\n\n" str))
 361        (goto-char (point-min))
 362        (if calc-graph-is-splot
 363            (if calc-graph-refine
 364                (error "This option works only for 2d plots")
 365              (setq recompute t)))
 366        (let ((calc-gnuplot-input (current-buffer))
 367              (calc-graph-no-auto-view t))
 368          (if printing
 369              (setq device calc-gnuplot-print-device
 370                    output calc-gnuplot-print-output)
 371            (setq device (calc-graph-find-command "terminal")
 372                  output (calc-graph-find-command "output"))
 373            (or device
 374                (setq device calc-gnuplot-default-device))
 375            (if output
 376                (setq output (car (read-from-string output)))
 377              (setq output calc-gnuplot-default-output)))
 378          (if (or (equal device "") (equal device "default"))
 379              (setq device (if printing
 380                               "postscript"
 381                             (if (or (eq window-system 'x) (getenv "DISPLAY"))
 382                                 "x11"
 383                               (if (>= calc-gnuplot-version 3)
 384                                   "dumb" "postscript")))))
 385          (if (equal device "dumb")
 386              (setq device (format "dumb %d %d"
 387                                   (1- (frame-width)) (1- (frame-height)))))
 388          (if (equal device "big")
 389              (setq device (format "dumb %d %d"
 390                                   (* 4 (- (frame-width) 3))
 391                                   (* 4 (- (frame-height) 3)))))
 392          (if (stringp output)
 393              (if (or (equal output "auto")
 394                      (and (equal output "tty") (setq tty-output t)))
 395                  (setq tempoutfile (calc-temp-file-name -1)
 396                        output tempoutfile))
 397            (setq output (eval output)))
 398          (or (equal device calc-graph-last-device)
 399              (progn
 400                (setq calc-graph-last-device device)
 401                (calc-gnuplot-command "set terminal" device)))
 402          (or (equal output calc-graph-last-output)
 403              (progn
 404                (setq calc-graph-last-output output)
 405                (calc-gnuplot-command "set output"
 406                                      (if (equal output "STDOUT")
 407                                          ""
 408                                        (prin1-to-string output)))))
 409          (setq calc-graph-resolution (calc-graph-find-command "samples"))
 410          (if calc-graph-resolution
 411              (setq calc-graph-resolution (string-to-number calc-graph-resolution))
 412            (setq calc-graph-resolution (if calc-graph-is-splot
 413                                 calc-graph-default-resolution-3d
 414                               calc-graph-default-resolution)))
 415          (setq precision (calc-graph-find-command "precision"))
 416          (if precision
 417              (setq precision (string-to-number precision))
 418            (setq precision calc-graph-default-precision))
 419          (calc-graph-set-command "terminal")
 420          (calc-graph-set-command "output")
 421          (calc-graph-set-command "samples")
 422          (calc-graph-set-command "precision"))
 423        (goto-char samples-pos)
 424        (insert "set samples " (int-to-string (max (if calc-graph-is-splot 20 200)
 425                                                   (+ 5 calc-graph-resolution))) "\n")
 426        (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t)
 427          (delete-region (match-beginning 0) (match-end 0))
 428          (if (looking-at ",")
 429              (delete-char 1)
 430            (while (memq (preceding-char) '(?\s ?\t))
 431              (forward-char -1))
 432            (if (eq (preceding-char) ?\,)
 433                (delete-backward-char 1))))
 434        (save-excursion
 435          (set-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            (save-excursion
 471              (set-buffer calcbuf)
 472              (let (tempbuftop
 473                    (calc-graph-xp calc-graph-xvalue)
 474                    (calc-graph-yp calc-graph-yvalue)
 475                    (calc-graph-zp nil)
 476                    (calc-graph-xlow nil) (calc-graph-xhigh nil) (y3low nil) (y3high nil)
 477                    calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY
 478                    y3val calc-graph-y3step var-DUMMY2 (calc-graph-zval nil)
 479                    calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector
 480                    calc-graph-numsteps calc-graph-numsteps3
 481                    (calc-graph-keep-file (and (not calc-graph-is-splot) (file-exists-p filename)))
 482                    (calc-graph-stepcount 0)
 483                    (calc-symbolic-mode nil)
 484                    (calc-prefer-frac nil)
 485                    (calc-internal-prec (max 3 precision))
 486                    (calc-simplify-mode (and (not (memq calc-simplify-mode
 487                                                        '(none num)))
 488                                             calc-simplify-mode))
 489                    (calc-graph-blank t)
 490                    (calc-graph-non-blank nil)
 491                    (math-working-step 0)
 492                    (math-working-step-2 nil))
 493                (save-excursion
 494                  (if calc-graph-is-splot
 495                      (calc-graph-compute-3d)
 496                    (calc-graph-compute-2d))
 497                  (set-buffer tempbuf)
 498                  (goto-char (point-max))
 499                  (insert "\n" calc-graph-xname)
 500                  (if calc-graph-is-splot
 501                      (insert ":" calc-graph-y3name))
 502                  (insert ":" calc-graph-yname "\n\n")
 503                  (setq tempbuftop (point))
 504                  (let ((calc-group-digits nil)
 505                        (calc-leading-zeros nil)
 506                        (calc-number-radix 10)
 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                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 ((arglist nil))
 577           (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
 578           (calc-default-formula-arglist calc-graph-yvalue)
 579           (or arglist
 580               (error "%s does not contain any unassigned variables" calc-graph-yname))
 581           (and (cdr arglist)
 582                (error "%s contains more than one variable: %s"
 583                       calc-graph-yname arglist))
 584           (setq calc-graph-yvalue (math-expr-subst calc-graph-yvalue
 585                                         (math-build-var-name (car 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 ((arglist nil))
 738           (setq calc-graph-yvalue (math-evaluate-expr calc-graph-yvalue))
 739           (calc-default-formula-arglist calc-graph-yvalue)
 740           (setq arglist (sort arglist 'string-lessp))
 741           (or (cdr arglist)
 742               (error "%s does not contain enough unassigned variables" calc-graph-yname))
 743           (and (cdr (cdr arglist))
 744                (error "%s contains too many variables: %s" calc-graph-yname arglist))
 745           (setq calc-graph-yvalue (math-multi-subst calc-graph-yvalue
 746                                          (mapcar 'math-build-var-name
 747                                                  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   (while (<= (setq calc-graph-stepcount (1+ calc-graph-stepcount)) calc-graph-numsteps)
 796     (if calc-graph-xvec
 797         (setq calc-graph-xp (cdr calc-graph-xp)
 798               calc-graph-xval (car calc-graph-xp)
 799               calc-graph-yp (cdr calc-graph-yp)
 800               calc-graph-yval (car calc-graph-yp)
 801               calc-graph-zp (cdr calc-graph-zp)
 802               calc-graph-zval (car calc-graph-zp))
 803       (if calc-graph-yvec
 804           (setq calc-graph-xval calc-graph-xvalue
 805                 calc-graph-xvalue (math-add calc-graph-xvalue calc-graph-xstep)
 806                 calc-graph-yp (cdr calc-graph-yp)
 807                 calc-graph-yval (car calc-graph-yp))
 808         (setq calc-graph-xval (car (car calc-graph-yp))
 809               calc-graph-yval (cdr (car calc-graph-yp))
 810               calc-graph-yp (cdr calc-graph-yp))
 811         (if (or (not calc-graph-yp)
 812                 (and calc-graph-xhigh (equal calc-graph-xval calc-graph-xhigh)))
 813             (setq calc-graph-numsteps 0))))
 814     (if calc-graph-is-splot
 815         (if (and (eq (car-safe calc-graph-zval) 'calcFunc-xyz)
 816                  (= (length calc-graph-zval) 4))
 817             (setq calc-graph-xval (nth 1 calc-graph-zval)
 818                   calc-graph-yval (nth 2 calc-graph-zval)
 819                   calc-graph-zval (nth 3 calc-graph-zval)))
 820       (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xyz)
 821                (= (length calc-graph-yval) 4))
 822           (progn
 823             (or calc-graph-surprise-splot
 824                 (save-excursion
 825                   (set-buffer (get-buffer-create "*Gnuplot Temp*"))
 826                   (save-excursion
 827                     (goto-char (point-max))
 828                     (re-search-backward "^plot[ \t]")
 829                     (insert "set parametric\ns")
 830                     (setq calc-graph-surprise-splot t))))
 831             (setq calc-graph-xval (nth 1 calc-graph-yval)
 832                   calc-graph-zval (nth 3 calc-graph-yval)
 833                   calc-graph-yval (nth 2 calc-graph-yval)))
 834         (if (and (eq (car-safe calc-graph-yval) 'calcFunc-xy)
 835                  (= (length calc-graph-yval) 3))
 836             (setq calc-graph-xval (nth 1 calc-graph-yval)
 837                   calc-graph-yval (nth 2 calc-graph-yval)))))
 838     (if (and (Math-realp calc-graph-xval)
 839              (Math-realp calc-graph-yval)
 840              (or (not calc-graph-zval) (Math-realp calc-graph-zval)))
 841         (progn
 842           (setq calc-graph-blank nil
 843                 calc-graph-non-blank t)
 844           (if (Math-integerp calc-graph-xval)
 845               (insert (math-format-number calc-graph-xval))
 846             (if (eq (car calc-graph-xval) 'frac)
 847                 (setq calc-graph-xval (math-float calc-graph-xval)))
 848             (insert (math-format-number (nth 1 calc-graph-xval))
 849                     "e" (int-to-string (nth 2 calc-graph-xval))))
 850           (insert " ")
 851           (if (Math-integerp calc-graph-yval)
 852               (insert (math-format-number calc-graph-yval))
 853             (if (eq (car calc-graph-yval) 'frac)
 854                 (setq calc-graph-yval (math-float calc-graph-yval)))
 855             (insert (math-format-number (nth 1 calc-graph-yval))
 856                     "e" (int-to-string (nth 2 calc-graph-yval))))
 857           (if calc-graph-zval
 858               (progn
 859                 (insert " ")
 860                 (if (Math-integerp calc-graph-zval)
 861                     (insert (math-format-number calc-graph-zval))
 862                   (if (eq (car calc-graph-zval) 'frac)
 863                       (setq calc-graph-zval (math-float calc-graph-zval)))
 864                   (insert (math-format-number (nth 1 calc-graph-zval))
 865                           "e" (int-to-string (nth 2 calc-graph-zval))))))
 866           (insert "\n"))
 867       (and (not (equal calc-graph-zval '(skip)))
 868            (boundp 'var-PlotRejects)
 869            (eq (car-safe var-PlotRejects) 'vec)
 870            (nconc var-PlotRejects
 871                   (list (list 'vec
 872                               calc-graph-curve-num
 873                               calc-graph-stepcount
 874                               calc-graph-xval calc-graph-yval)))
 875            (calc-refresh-evaltos 'var-PlotRejects))
 876       (or calc-graph-blank
 877           (progn
 878             (insert "\n")
 879             (setq calc-graph-blank t))))))
 880
 881 (defun calc-temp-file-name (num)
 882   (while (<= (length calc-graph-file-cache) (1+ num))
 883     (setq calc-graph-file-cache (nconc calc-graph-file-cache (list nil))))
 884   (car (or (nth (1+ num) calc-graph-file-cache)
 885            (setcar (nthcdr (1+ num) calc-graph-file-cache)
 886                    (list (make-temp-file
 887                           (concat calc-gnuplot-tempfile
 888                                   (if (<= num 0)
 889                                       (char-to-string (- ?A num))
 890                                     (int-to-string num))))
 891                          nil)))))
 892
 893 (defun calc-graph-delete-temps ()
 894   (while calc-graph-file-cache
 895     (and (car calc-graph-file-cache)
 896          (file-exists-p (car (car calc-graph-file-cache)))
 897          (condition-case err
 898              (delete-file (car (car calc-graph-file-cache)))
 899            (error nil)))
 900     (setq calc-graph-file-cache (cdr calc-graph-file-cache))))
 901
 902 (defun calc-graph-kill-hook ()
 903   (calc-graph-delete-temps))
 904
 905 (defun calc-graph-show-tty (output)
 906   "Default calc-gnuplot-plot-command for \"tty\" output mode.
 907 This is useful for tek40xx and other graphics-terminal types."
 908   (call-process-region 1 1 shell-file-name
 909                        nil calc-gnuplot-buffer nil
 910                        "-c" (format "cat %s >/dev/tty; rm %s" output output)))
 911
 912 (defvar calc-dumb-map nil
 913   "The keymap for the \"dumb\" terminal plot.")
 914
 915 (defun calc-graph-show-dumb (&optional output)
 916   "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
 917 This \"dumb\" driver will be present in Gnuplot 3.0."
 918   (interactive)
 919   (save-window-excursion
 920     (switch-to-buffer calc-gnuplot-buffer)
 921     (delete-other-windows)
 922     (goto-char calc-gnuplot-trail-mark)
 923     (or (search-forward "\f" nil t)
 924         (sleep-for 1))
 925     (goto-char (point-max))
 926     (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T")
 927     (if (looking-at "\f")
 928         (progn
 929           (forward-char 1)
 930           (if (eolp) (forward-line 1))
 931           (or (calc-graph-find-command "time")
 932               (calc-graph-find-command "title")
 933               (calc-graph-find-command "ylabel")
 934               (let ((pt (point)))
 935                 (insert-before-markers (format "(%s)" (current-time-string)))
 936                 (goto-char pt)))
 937           (set-window-start (selected-window) (point))
 938           (goto-char (point-max)))
 939       (end-of-line)
 940       (backward-char 1)
 941       (recenter '(4)))
 942     (or calc-dumb-map
 943         (progn
 944           (setq calc-dumb-map (make-sparse-keymap))
 945           (define-key calc-dumb-map "\n" 'scroll-up)
 946           (define-key calc-dumb-map " " 'scroll-up)
 947           (define-key calc-dumb-map "\177" 'scroll-down)
 948           (define-key calc-dumb-map "<" 'scroll-left)
 949           (define-key calc-dumb-map ">" 'scroll-right)
 950           (define-key calc-dumb-map "{" 'scroll-down)
 951           (define-key calc-dumb-map "}" 'scroll-up)
 952           (define-key calc-dumb-map "q" 'exit-recursive-edit)
 953           (define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit)))
 954     (use-local-map calc-dumb-map)
 955     (setq truncate-lines t)
 956     (message "Type `q' or `C-c C-c' to return to Calc")
 957     (recursive-edit)
 958     (bury-buffer "*Gnuplot Trail*")))
 959
 960 (defun calc-graph-clear ()
 961   (interactive)
 962   (if calc-graph-last-device
 963       (if (or (equal calc-graph-last-device "x11")
 964               (equal calc-graph-last-device "X11"))
 965           (calc-gnuplot-command "set output"
 966                                 (if (equal calc-graph-last-output "STDOUT")
 967                                     ""
 968                                   (prin1-to-string calc-graph-last-output)))
 969         (calc-gnuplot-command "clear"))))
 970
 971 (defun calc-graph-title-x (title)
 972   (interactive "sX axis title: ")
 973   (calc-graph-set-command "xlabel" (if (not (equal title ""))
 974                                        (prin1-to-string title))))
 975
 976 (defun calc-graph-title-y (title)
 977   (interactive "sY axis title: ")
 978   (calc-graph-set-command "ylabel" (if (not (equal title ""))
 979                                        (prin1-to-string title))))
 980
 981 (defun calc-graph-title-z (title)
 982   (interactive "sZ axis title: ")
 983   (calc-graph-set-command "zlabel" (if (not (equal title ""))
 984                                        (prin1-to-string title))))
 985
 986 (defun calc-graph-range-x (range)
 987   (interactive "sX axis range: ")
 988   (calc-graph-set-range "xrange" range))
 989
 990 (defun calc-graph-range-y (range)
 991   (interactive "sY axis range: ")
 992   (calc-graph-set-range "yrange" range))
 993
 994 (defun calc-graph-range-z (range)
 995   (interactive "sZ axis range: ")
 996   (calc-graph-set-range "zrange" range))
 997
 998 (defun calc-graph-set-range (cmd range)
 999   (if (equal range "$")
1000       (calc-wrapper
1001        (let ((val (calc-top-n 1)))
1002          (if (and (eq (car-safe val) 'intv) (math-constp val))
1003              (setq range (concat
1004                           (math-format-number (math-float (nth 2 val))) ":"
1005                           (math-format-number (math-float (nth 3 val)))))
1006            (if (and (eq (car-safe val) 'vec)
1007                     (= (length val) 3))
1008                (setq range (concat
1009                             (math-format-number (math-float (nth 1 val))) ":"
1010                             (math-format-number (math-float (nth 2 val)))))
1011              (error "Range specification must be an interval or 2-vector")))
1012          (calc-pop-stack 1))))
1013   (if (string-match "\\[.+\\]" range)
1014       (setq range (substring range 1 -1)))
1015   (if (and (not (string-match ":" range))
1016            (or (string-match "," range)
1017                (string-match " " range)))
1018       (aset range (match-beginning 0) ?\:))
1019   (calc-graph-set-command cmd (if (not (equal range ""))
1020                                   (concat "[" range "]"))))
1021
1022 (defun calc-graph-log-x (flag)
1023   (interactive "P")
1024   (calc-graph-set-log flag 0 0))
1025
1026 (defun calc-graph-log-y (flag)
1027   (interactive "P")
1028   (calc-graph-set-log 0 flag 0))
1029
1030 (defun calc-graph-log-z (flag)
1031   (interactive "P")
1032   (calc-graph-set-log 0 0 flag))
1033
1034 (defun calc-graph-set-log (xflag yflag zflag)
1035   (let* ((old (or (calc-graph-find-command "logscale") ""))
1036          (xold (string-match "x" old))
1037          (yold (string-match "y" old))
1038          (zold (string-match "z" old))
1039          str)
1040     (setq str (concat (if (if xflag
1041                               (if (eq xflag 0) xold
1042                                 (> (prefix-numeric-value xflag) 0))
1043                             (not xold)) "x" "")
1044                       (if (if yflag
1045                               (if (eq yflag 0) yold
1046                                 (> (prefix-numeric-value yflag) 0))
1047                             (not yold)) "y" "")
1048                       (if (if zflag
1049                               (if (eq zflag 0) zold
1050                                 (> (prefix-numeric-value zflag) 0))
1051                             (not zold)) "z" "")))
1052     (calc-graph-set-command "logscale" (if (not (equal str "")) str))))
1053
1054 (defun calc-graph-line-style (style)
1055   (interactive "P")
1056   (calc-graph-set-styles (and style (prefix-numeric-value style)) t))
1057
1058 (defun calc-graph-point-style (style)
1059   (interactive "P")
1060   (calc-graph-set-styles t (and style (prefix-numeric-value style))))
1061
1062 (defun calc-graph-set-styles (lines points)
1063   (calc-graph-init)
1064   (save-excursion
1065     (set-buffer calc-gnuplot-input)
1066     (or (calc-graph-find-plot nil nil)
1067         (error "No data points have been set!"))
1068     (let ((base (point))
1069           (mode nil) (lstyle nil) (pstyle nil)
1070           start end lenbl penbl)
1071       (re-search-forward "[,\n]")
1072       (forward-char -1)
1073       (setq end (point) start end)
1074       (goto-char base)
1075       (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+with\\)")
1076           (progn
1077             (setq start (match-beginning 1))
1078             (goto-char (match-end 0))
1079             (if (looking-at "[ \t]+\\([a-z]+\\)")
1080                 (setq mode (buffer-substring (match-beginning 1)
1081                                              (match-end 1))))
1082             (if (looking-at "[ \ta-z]+\\([0-9]+\\)")
1083                 (setq lstyle (string-to-number
1084                               (buffer-substring (match-beginning 1)
1085                                                 (match-end 1)))))
1086             (if (looking-at "[ \ta-z]+[0-9]+[ \t]+\\([0-9]+\\)")
1087                 (setq pstyle (string-to-number
1088                               (buffer-substring (match-beginning 1)
1089                                                 (match-end 1)))))))
1090       (setq lenbl (or (equal mode "lines") (equal mode "linespoints"))
1091             penbl (or (equal mode "points") (equal mode "linespoints")))
1092       (if lines
1093           (or (eq lines t)
1094               (setq lstyle lines
1095                     lenbl (>= lines 0)))
1096         (setq lenbl (not lenbl)))
1097       (if points
1098           (or (eq points t)
1099               (setq pstyle points
1100                     penbl (>= points 0)))
1101         (setq penbl (not penbl)))
1102       (delete-region start end)
1103       (goto-char start)
1104       (insert " with "
1105               (if lenbl
1106                   (if penbl "linespoints" "lines")
1107                 (if penbl "points" "dots")))
1108       (if (and pstyle (> pstyle 0))
1109           (insert " " (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
1110                   " " (int-to-string pstyle))
1111         (if (and lstyle (> lstyle 0))
1112             (insert " " (int-to-string lstyle))))))
1113   (calc-graph-view-commands))
1114
1115 (defun calc-graph-zero-x (flag)
1116   (interactive "P")
1117   (calc-graph-set-command "noxzeroaxis"
1118                           (and (if flag
1119                                    (<= (prefix-numeric-value flag) 0)
1120                                  (not (calc-graph-find-command "noxzeroaxis")))
1121                                " ")))
1122
1123 (defun calc-graph-zero-y (flag)
1124   (interactive "P")
1125   (calc-graph-set-command "noyzeroaxis"
1126                           (and (if flag
1127                                    (<= (prefix-numeric-value flag) 0)
1128                                  (not (calc-graph-find-command "noyzeroaxis")))
1129                                " ")))
1130
1131 (defun calc-graph-name (name)
1132   (interactive "sTitle for current curve: ")
1133   (calc-graph-init)
1134   (save-excursion
1135     (set-buffer calc-gnuplot-input)
1136     (or (calc-graph-find-plot nil nil)
1137         (error "No data points have been set!"))
1138     (let ((base (point))
1139           start
1140           end)
1141       (re-search-forward "[,\n]\\|[ \t]+with")
1142       (setq end (match-beginning 0))
1143       (goto-char base)
1144       (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+title\\)")
1145           (progn
1146             (goto-char (match-beginning 1))
1147             (delete-region (point) end))
1148         (goto-char end))
1149       (insert " title " (prin1-to-string name))))
1150   (calc-graph-view-commands))
1151
1152 (defun calc-graph-hide (flag)
1153   (interactive "P")
1154   (calc-graph-init)
1155   (and (calc-graph-find-plot nil nil)
1156        (progn
1157          (or (looking-at "{")
1158              (error "Can't hide this curve (wrong format)"))
1159          (forward-char 1)
1160          (if (looking-at "*")
1161              (if (or (null flag) (<= (prefix-numeric-value flag) 0))
1162                  (delete-char 1))
1163            (if (or (null flag) (> (prefix-numeric-value flag) 0))
1164                (insert "*"))))))
1165
1166 (defun calc-graph-header (title)
1167   (interactive "sTitle for entire graph: ")
1168   (calc-graph-set-command "title" (if (not (equal title ""))
1169                                       (prin1-to-string title))))
1170
1171 (defun calc-graph-border (flag)
1172   (interactive "P")
1173   (calc-graph-set-command "noborder"
1174                           (and (if flag
1175                                    (<= (prefix-numeric-value flag) 0)
1176                                  (not (calc-graph-find-command "noborder")))
1177                                " ")))
1178
1179 (defun calc-graph-grid (flag)
1180   (interactive "P")
1181   (calc-graph-set-command "grid" (and (if flag
1182                                           (> (prefix-numeric-value flag) 0)
1183                                         (not (calc-graph-find-command "grid")))
1184                                       " ")))
1185
1186 (defun calc-graph-key (flag)
1187   (interactive "P")
1188   (calc-graph-set-command "key" (and (if flag
1189                                          (> (prefix-numeric-value flag) 0)
1190                                        (not (calc-graph-find-command "key")))
1191                                      " ")))
1192
1193 (defun calc-graph-num-points (res flag)
1194   (interactive "sNumber of data points: \nP")
1195   (if flag
1196       (if (> (prefix-numeric-value flag) 0)
1197           (if (equal res "")
1198               (message "Default resolution is %d"
1199                        calc-graph-default-resolution)
1200             (setq calc-graph-default-resolution (string-to-number res)))
1201         (if (equal res "")
1202             (message "Default 3D resolution is %d"
1203                      calc-graph-default-resolution-3d)
1204           (setq calc-graph-default-resolution-3d (string-to-number res))))
1205     (calc-graph-set-command "samples" (if (not (equal res "")) res))))
1206
1207 (defun calc-graph-device (name flag)
1208   (interactive "sDevice name: \nP")
1209   (if (equal name "?")
1210       (progn
1211         (calc-gnuplot-command "set terminal")
1212         (calc-graph-view-trail))
1213     (if flag
1214         (if (> (prefix-numeric-value flag) 0)
1215             (if (equal name "")
1216                 (message "Default GNUPLOT device is \"%s\""
1217                          calc-gnuplot-default-device)
1218               (setq calc-gnuplot-default-device name))
1219           (if (equal name "")
1220               (message "GNUPLOT device for Print command is \"%s\""
1221                        calc-gnuplot-print-device)
1222             (setq calc-gnuplot-print-device name)))
1223       (calc-graph-set-command "terminal" (if (not (equal name ""))
1224                                              name)))))
1225
1226 (defun calc-graph-output (name flag)
1227   (interactive "FOutput file name: \np")
1228   (cond ((string-match "\\<[aA][uU][tT][oO]$" name)
1229          (setq name "auto"))
1230         ((string-match "\\<[tT][tT][yY]$" name)
1231          (setq name "tty"))
1232         ((string-match "\\<[sS][tT][dD][oO][uU][tT]$" name)
1233          (setq name "STDOUT"))
1234         ((equal (file-name-nondirectory name) "")
1235          (setq name ""))
1236         (t (setq name (expand-file-name name))))
1237   (if flag
1238       (if (> (prefix-numeric-value flag) 0)
1239           (if (equal name "")
1240               (message "Default GNUPLOT output file is \"%s\""
1241                        calc-gnuplot-default-output)
1242             (setq calc-gnuplot-default-output name))
1243         (if (equal name "")
1244             (message "GNUPLOT output file for Print command is \"%s\""
1245                      calc-gnuplot-print-output)
1246           (setq calc-gnuplot-print-output name)))
1247     (calc-graph-set-command "output" (if (not (equal name ""))
1248                                          (prin1-to-string name)))))
1249
1250 (defun calc-graph-display (name)
1251   (interactive "sX display name: ")
1252   (if (equal name "")
1253       (message "Current X display is \"%s\""
1254                (or calc-gnuplot-display "<none>"))
1255     (setq calc-gnuplot-display name)
1256     (if (calc-gnuplot-alive)
1257         (calc-gnuplot-command "exit"))))
1258
1259 (defun calc-graph-geometry (name)
1260   (interactive "sX geometry spec (or \"default\"): ")
1261   (if (equal name "")
1262       (message "Current X geometry is \"%s\""
1263                (or calc-gnuplot-geometry "default"))
1264     (setq calc-gnuplot-geometry (and (not (equal name "default")) name))
1265     (if (calc-gnuplot-alive)
1266         (calc-gnuplot-command "exit"))))
1267
1268 (defun calc-graph-find-command (cmd)
1269   (calc-graph-init)
1270   (save-excursion
1271     (set-buffer calc-gnuplot-input)
1272     (goto-char (point-min))
1273     (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t)
1274         (buffer-substring (match-beginning 1) (match-end 1)))))
1275
1276 (defun calc-graph-set-command (cmd &rest args)
1277   (calc-graph-init)
1278   (save-excursion
1279     (set-buffer calc-gnuplot-input)
1280     (goto-char (point-min))
1281     (if (re-search-forward (concat "^set[ \t]+" cmd "[ \t\n]") nil t)
1282         (progn
1283           (forward-char -1)
1284           (end-of-line)
1285           (let ((end (point)))
1286             (beginning-of-line)
1287             (delete-region (point) (1+ end))))
1288       (if (calc-graph-find-plot t t)
1289           (if (eq (preceding-char) ?\n)
1290               (forward-char -1))
1291         (goto-char (1- (point-max)))))
1292     (if (and args (car args))
1293         (progn
1294           (or (bolp)
1295               (insert "\n"))
1296           (insert "set " (mapconcat 'identity (cons cmd args) " ") "\n"))))
1297   (calc-graph-view-commands))
1298
1299 (defun calc-graph-command (cmd)
1300   (interactive "sGNUPLOT command: ")
1301   (calc-wrapper
1302    (calc-graph-init)
1303    (calc-graph-view-trail)
1304    (calc-gnuplot-command cmd)
1305    (accept-process-output)
1306    (calc-graph-view-trail)))
1307
1308 (defun calc-graph-kill (&optional no-view)
1309   (interactive)
1310   (calc-graph-delete-temps)
1311   (if (calc-gnuplot-alive)
1312       (calc-wrapper
1313        (or no-view (calc-graph-view-trail))
1314        (let ((calc-graph-no-wait t))
1315          (calc-gnuplot-command "exit"))
1316        (sit-for 1)
1317        (if (process-status calc-gnuplot-process)
1318            (delete-process calc-gnuplot-process))
1319        (setq calc-gnuplot-process nil))))
1320
1321 (defun calc-graph-quit ()
1322   (interactive)
1323   (if (get-buffer-window calc-gnuplot-input)
1324       (calc-graph-view-commands t))
1325   (if (get-buffer-window calc-gnuplot-buffer)
1326       (calc-graph-view-trail t))
1327   (calc-graph-kill t))
1328
1329 (defun calc-graph-view-commands (&optional no-need)
1330   (interactive "p")
1331   (or calc-graph-no-auto-view (calc-graph-init-buffers))
1332   (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need)))
1333
1334 (defun calc-graph-view-trail (&optional no-need)
1335   (interactive "p")
1336   (or calc-graph-no-auto-view (calc-graph-init-buffers))
1337   (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need)))
1338
1339 (defun calc-graph-view (buf other-buf need)
1340   (let (win)
1341     (or calc-graph-no-auto-view
1342         (if (setq win (get-buffer-window buf))
1343             (or need
1344                 (and (eq buf calc-gnuplot-buffer)
1345                      (save-excursion
1346                        (set-buffer buf)
1347                        (not (pos-visible-in-window-p (point-max) win))))
1348                 (progn
1349                   (bury-buffer buf)
1350                   (bury-buffer other-buf)
1351                   (let ((curwin (selected-window)))
1352                     (select-window win)
1353                     (switch-to-buffer nil)
1354                     (select-window curwin))))
1355           (if (setq win (get-buffer-window other-buf))
1356               (set-window-buffer win buf)
1357             (if (eq major-mode 'calc-mode)
1358                 (if (or need
1359                         (< (window-height) (1- (frame-height))))
1360                     (display-buffer buf))
1361               (switch-to-buffer buf)))))
1362     (save-excursion
1363       (set-buffer buf)
1364       (if (and (eq buf calc-gnuplot-buffer)
1365                (setq win (get-buffer-window buf))
1366                (not (pos-visible-in-window-p (point-max) win)))
1367           (progn
1368             (goto-char (point-max))
1369             (vertical-motion (- 6 (window-height win)))
1370             (set-window-start win (point))
1371             (goto-char (point-max)))))
1372     (or calc-graph-no-auto-view (sit-for 0))))
1373
1374 (defun calc-gnuplot-check-for-errors ()
1375   (if (save-excursion
1376         (prog2
1377          (progn
1378            (set-buffer calc-gnuplot-buffer)
1379            (goto-char calc-gnuplot-last-error-pos))
1380          (re-search-forward "^[ \t]+\\^$" nil t)
1381          (goto-char (point-max))
1382          (setq calc-gnuplot-last-error-pos (point-max))))
1383       (calc-graph-view-trail)))
1384
1385 (defun calc-gnuplot-command (&rest args)
1386   (calc-graph-init)
1387   (let ((cmd (concat (mapconcat 'identity args " ") "\n")))
1388     (accept-process-output)
1389     (save-excursion
1390       (set-buffer calc-gnuplot-buffer)
1391       (calc-gnuplot-check-for-errors)
1392       (goto-char (point-max))
1393       (setq calc-gnuplot-trail-mark (point))
1394       (or (>= calc-gnuplot-version 3)
1395           (insert cmd))
1396       (set-marker (process-mark calc-gnuplot-process) (point))
1397       (process-send-string calc-gnuplot-process cmd)
1398       (if (get-buffer-window calc-gnuplot-buffer)
1399           (calc-graph-view-trail))
1400       (accept-process-output (and (not calc-graph-no-wait)
1401                                   calc-gnuplot-process))
1402       (calc-gnuplot-check-for-errors)
1403       (if (get-buffer-window calc-gnuplot-buffer)
1404           (calc-graph-view-trail)))))
1405
1406 (defun calc-graph-init-buffers ()
1407   (or (and calc-gnuplot-buffer
1408            (buffer-name calc-gnuplot-buffer))
1409       (setq calc-gnuplot-buffer (get-buffer-create "*Gnuplot Trail*")))
1410   (or (and calc-gnuplot-input
1411            (buffer-name calc-gnuplot-input))
1412       (setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*"))))
1413
1414 (defun calc-graph-init ()
1415   (or (calc-gnuplot-alive)
1416       (let ((process-connection-type t)
1417             origin)
1418         (if calc-gnuplot-process
1419             (progn
1420               (delete-process calc-gnuplot-process)
1421               (setq calc-gnuplot-process nil)))
1422         (calc-graph-init-buffers)
1423         (save-excursion
1424           (set-buffer calc-gnuplot-buffer)
1425           (insert "\nStarting gnuplot...\n")
1426           (setq origin (point)))
1427         (setq calc-graph-last-device nil)
1428         (setq calc-graph-last-output nil)
1429         (condition-case err
1430             (let ((args (append (and calc-gnuplot-display
1431                                      (not (equal calc-gnuplot-display
1432                                                  (getenv "DISPLAY")))
1433                                      (list "-display"
1434                                            calc-gnuplot-display))
1435                                 (and calc-gnuplot-geometry
1436                                      (list "-geometry"
1437                                            calc-gnuplot-geometry)))))
1438               (setq calc-gnuplot-process
1439                     (apply 'start-process
1440                            "gnuplot"
1441                            calc-gnuplot-buffer
1442                            calc-gnuplot-name
1443                            args))
1444               (set-process-query-on-exit-flag calc-gnuplot-process nil))
1445           (file-error
1446            (error "Sorry, can't find \"%s\" on your system"
1447                   calc-gnuplot-name)))
1448         (save-excursion
1449           (set-buffer calc-gnuplot-buffer)
1450           (while (and (not (save-excursion
1451                              (goto-char origin)
1452                              (search-forward "gnuplot> " nil t)))
1453                       (memq (process-status calc-gnuplot-process) '(run stop)))
1454             (accept-process-output calc-gnuplot-process))
1455           (or (memq (process-status calc-gnuplot-process) '(run stop))
1456               (error "Unable to start GNUPLOT process"))
1457           (if (save-excursion
1458                 (goto-char origin)
1459                 (re-search-forward
1460                  "G N U P L O T.*\n.*version \\([0-9]+\\)\\." nil t))
1461               (setq calc-gnuplot-version (string-to-number (buffer-substring
1462                                                          (match-beginning 1)
1463                                                          (match-end 1))))
1464             (setq calc-gnuplot-version 1))
1465           (goto-char (point-max)))))
1466   (save-excursion
1467     (set-buffer calc-gnuplot-input)
1468     (if (= (buffer-size) 0)
1469         (insert "# Commands for running gnuplot\n\n\n")
1470       (or calc-graph-no-auto-view
1471           (eq (char-after (1- (point-max))) ?\n)
1472           (progn
1473             (goto-char (point-max))
1474             (insert "\n"))))))
1475
1476 (provide 'calc-graph)
1477
1478 ;;; arch-tag: e4b06a52-c386-4d54-a2bb-7c0a0ef533c2
1479 ;;; calc-graph.el ends here