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