cgit.sxemacs.org Git - packages/blob - xemacs-packages/calc/calc-graph.el

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