1 ;;; calc-graph.el --- graph output functions for Calc
3 ;; Copyright (C) 1990-1993, 2001-2013 Free Software Foundation, Inc.
5 ;; Author: David Gillespie <daveg@synaptics.com>
6 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;; This file is autoloaded from calc-ext.el.
34 ;; The following three variables are customizable and defined in calc.el.
35 (defvar calc-gnuplot-name
)
36 (defvar calc-gnuplot-plot-command
)
37 (defvar calc-gnuplot-print-command
)
39 (defvar calc-gnuplot-tempfile
"calc")
41 (defvar calc-gnuplot-default-device
)
42 (defvar calc-gnuplot-default-output
)
43 (defvar calc-gnuplot-print-device
)
44 (defvar calc-gnuplot-print-output
)
45 (defvar calc-gnuplot-keep-outfile nil
)
46 (defvar calc-gnuplot-version nil
)
48 (defvar calc-gnuplot-display
(getenv "DISPLAY"))
49 (defvar calc-gnuplot-geometry
)
51 (defvar calc-graph-default-resolution
)
52 (defvar calc-graph-default-resolution-3d
)
53 (defvar calc-graph-default-precision
5)
55 (defvar calc-gnuplot-buffer nil
)
56 (defvar calc-gnuplot-input nil
)
58 (defvar calc-gnuplot-last-error-pos
1)
59 (defvar calc-graph-last-device nil
)
60 (defvar calc-graph-last-output nil
)
61 (defvar calc-graph-file-cache nil
)
62 (defvar calc-graph-var-cache nil
)
63 (defvar calc-graph-data-cache nil
)
64 (defvar calc-graph-data-cache-limit
10)
65 (defvar calc-graph-no-auto-view nil
)
66 (defvar calc-graph-no-wait nil
)
67 (defvar calc-gnuplot-trail-mark
)
69 (defun calc-graph-fast (many)
71 (let ((calc-graph-no-auto-view t
))
74 (calc-graph-plot nil
)))
76 (defun calc-graph-fast-3d (many)
78 (let ((calc-graph-no-auto-view t
))
80 (calc-graph-add-3d many
)
81 (calc-graph-plot nil
)))
83 (defun calc-graph-delete (all)
87 (with-current-buffer calc-gnuplot-input
88 (and (calc-graph-find-plot t all
)
90 (if (looking-at "s?plot")
92 (setq calc-graph-var-cache nil
)
93 (delete-region (point) (point-max)))
94 (delete-region (point) (1- (point-max)))))))
95 (calc-graph-view-commands)))
97 (defun calc-graph-find-plot (&optional before all
)
98 (goto-char (point-min))
99 (and (re-search-forward "^s?plot[ \t]+" nil t
)
101 (goto-char (point-max))
103 (not (search-backward "," nil t
))
108 (beginning-of-line)))
110 (re-search-forward ",[ \t]+")))
113 (defun calc-graph-add (many)
118 (calc-graph-add-curve (calc-graph-lookup (calc-top-n 2))
119 (calc-graph-lookup (calc-top-n 1))))
120 ((or (consp many
) (eq many
0))
121 (let ((xdata (calc-graph-lookup (calc-top-n 2)))
122 (ylist (calc-top-n 1)))
123 (or (eq (car-safe ylist
) 'vec
)
124 (error "Y argument must be a vector"))
125 (while (setq ylist
(cdr ylist
))
126 (calc-graph-add-curve xdata
(calc-graph-lookup (car ylist
))))))
127 ((> (setq many
(prefix-numeric-value many
)) 0)
128 (let ((xdata (calc-graph-lookup (calc-top-n (1+ many
)))))
130 (calc-graph-add-curve xdata
131 (calc-graph-lookup (calc-top-n many
)))
132 (setq many
(1- many
)))))
137 (setq pair
(calc-top-n many
))
138 (or (and (eq (car-safe pair
) 'vec
)
140 (error "Argument must be an [x,y] vector"))
141 (calc-graph-add-curve (calc-graph-lookup (nth 1 pair
))
142 (calc-graph-lookup (nth 2 pair
)))
143 (setq many
(1- many
))))))
144 (calc-graph-view-commands)))
146 (defun calc-graph-add-3d (many)
151 (calc-graph-add-curve (calc-graph-lookup (calc-top-n 3))
152 (calc-graph-lookup (calc-top-n 2))
153 (calc-graph-lookup (calc-top-n 1))))
154 ((or (consp many
) (eq many
0))
155 (let ((xdata (calc-graph-lookup (calc-top-n 3)))
156 (ydata (calc-graph-lookup (calc-top-n 2)))
157 (zlist (calc-top-n 1)))
158 (or (eq (car-safe zlist
) 'vec
)
159 (error "Z argument must be a vector"))
160 (while (setq zlist
(cdr zlist
))
161 (calc-graph-add-curve xdata ydata
162 (calc-graph-lookup (car zlist
))))))
163 ((> (setq many
(prefix-numeric-value many
)) 0)
164 (let ((xdata (calc-graph-lookup (calc-top-n (+ many
2))))
165 (ydata (calc-graph-lookup (calc-top-n (+ many
1)))))
167 (calc-graph-add-curve xdata ydata
168 (calc-graph-lookup (calc-top-n many
)))
169 (setq many
(1- many
)))))
174 (setq curve
(calc-top-n many
))
175 (or (and (eq (car-safe curve
) 'vec
)
176 (= (length curve
) 4))
177 (error "Argument must be an [x,y,z] vector"))
178 (calc-graph-add-curve (calc-graph-lookup (nth 1 curve
))
179 (calc-graph-lookup (nth 2 curve
))
180 (calc-graph-lookup (nth 3 curve
)))
181 (setq many
(1- many
))))))
182 (calc-graph-view-commands)))
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 (with-current-buffer calc-gnuplot-input
189 (goto-char (point-min))
190 (if (re-search-forward (if zdata
"^plot[ \t]" "^splot[ \t]")
192 (error "Can't mix 2d and 3d curves on one graph"))
193 (if (re-search-forward "^s?plot[ \t]" nil t
)
197 (goto-char (point-max))
198 (or (eq (preceding-char) ?
\n)
200 (insert (if zdata
"splot" "plot") " \n")
202 (insert "{" (symbol-name (nth 1 xdata
))
203 ":" (symbol-name (nth 1 ydata
)))
205 (insert ":" (symbol-name (nth 1 zdata
))))
207 "title \"" (symbol-name (nth 1 ydata
)) "\" "
209 (setq pstyle
(and (eq (car-safe pstyle
) 'vec
) (nth (1+ num
) pstyle
)))
210 (setq lstyle
(and (eq (car-safe lstyle
) 'vec
) (nth (1+ num
) lstyle
))))
211 (calc-graph-set-styles
212 (or (and (Math-num-integerp lstyle
) (math-trunc lstyle
))
214 (or (and (Math-num-integerp pstyle
) (math-trunc pstyle
))
215 (if (eq (car-safe (calc-var-value (nth 2 ydata
))) 'vec
)
217 (math-contains-sdev-p (eval (nth 2 ydata
))))))
219 (defun calc-graph-lookup (thing)
220 (if (and (eq (car-safe thing
) 'var
)
221 (calc-var-value (nth 2 thing
)))
223 (let ((found (assoc thing calc-graph-var-cache
)))
225 (let ((varname (concat "PlotData"
227 (1+ (length calc-graph-var-cache
)))))
229 (setq var
(list 'var
(intern varname
)
230 (intern (concat "var-" varname
)))
231 found
(cons thing var
)
232 calc-graph-var-cache
(cons found calc-graph-var-cache
))
233 (set (nth 2 var
) thing
)))
236 (defun calc-graph-juggle (arg)
239 (with-current-buffer calc-gnuplot-input
241 (let ((num (calc-graph-count-curves)))
244 (setq arg
(+ arg num
))))))
245 (while (>= (setq arg
(1- arg
)) 0)
246 (calc-graph-do-juggle))))
248 (defun calc-graph-count-curves ()
249 (with-current-buffer calc-gnuplot-input
250 (if (re-search-forward "^s?plot[ \t]" nil t
)
252 (goto-char (point-min))
253 (while (search-forward "," nil t
)
258 (defun calc-graph-do-juggle ()
260 (and (calc-graph-find-plot t t
)
263 (calc-graph-find-plot t nil
)
264 (or (eq base
(point))
265 (let ((str (buffer-substring (+ (point) 2) (1- (point-max)))))
266 (delete-region (point) (1- (point-max)))
267 (goto-char (+ base
5))
268 (insert str
", ")))))))
270 (defun calc-graph-print (flag)
272 (calc-graph-plot flag t
))
276 (defvar var-PlotRejects
)
278 ;; The following variables are local to calc-graph-plot, but are
279 ;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d,
280 ;; calc-graph-recompute-2d, calc-graph-compute-3d and
281 ;; calc-graph-format-data, which are called by calc-graph-plot.
282 (defvar calc-graph-yvalue
)
283 (defvar calc-graph-yvec
)
284 (defvar calc-graph-numsteps
)
285 (defvar calc-graph-numsteps3
)
286 (defvar calc-graph-xvalue
)
287 (defvar calc-graph-xvec
)
288 (defvar calc-graph-xname
)
289 (defvar calc-graph-yname
)
290 (defvar calc-graph-xstep
)
291 (defvar calc-graph-ycache
)
292 (defvar calc-graph-ycacheptr
)
293 (defvar calc-graph-refine
)
294 (defvar calc-graph-keep-file
)
295 (defvar calc-graph-xval
)
296 (defvar calc-graph-xlow
)
297 (defvar calc-graph-xhigh
)
298 (defvar calc-graph-yval
)
299 (defvar calc-graph-yp
)
300 (defvar calc-graph-xp
)
301 (defvar calc-graph-zp
)
302 (defvar calc-graph-yvector
)
303 (defvar calc-graph-resolution
)
304 (defvar calc-graph-y3value
)
305 (defvar calc-graph-y3name
)
306 (defvar calc-graph-y3step
)
307 (defvar calc-graph-zval
)
308 (defvar calc-graph-stepcount
)
309 (defvar calc-graph-is-splot
)
310 (defvar calc-graph-surprise-splot
)
311 (defvar calc-graph-blank
)
312 (defvar calc-graph-non-blank
)
313 (defvar calc-graph-curve-num
)
315 (defun calc-graph-plot (flag &optional printing
)
318 (let ((calcbuf (current-buffer))
319 (tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
322 (calc-graph-curve-num 0)
323 (calc-graph-refine (and flag
(> (prefix-numeric-value flag
) 0)))
324 (recompute (and flag
(< (prefix-numeric-value flag
) 0)))
325 (calc-graph-surprise-splot nil
)
327 cache-env calc-graph-is-splot device output calc-graph-resolution precision samples-pos
)
328 (add-hook 'kill-emacs-hook
'calc-graph-kill-hook
)
333 (set-buffer calc-gnuplot-input
)
334 (goto-char (point-min))
335 (setq calc-graph-is-splot
(re-search-forward "^splot[ \t]" nil t
))
336 (let ((str (buffer-string))
337 (ver calc-gnuplot-version
))
338 (set-buffer (get-buffer-create "*Gnuplot Temp*"))
340 (insert "# (Note: This is a temporary copy---do not edit!)\n")
342 (insert "set noarrow\nset nolabel\n"
343 "set autoscale xy\nset nologscale xy\n"
344 "set xlabel\nset ylabel\nset title\n"
345 "set noclip points\nset clip one\nset clip two\n"
346 "set format \"%g\"\nset tics\nset xtics\nset ytics\n"
347 "set style data linespoints\n"
348 "set nogrid\nset nokey\nset nopolar\n"))
350 (insert "set surface\nset nocontour\n"
351 "set " (if calc-graph-is-splot
"" "no") "parametric\n"
352 "set notime\nset border\nset ztics\nset zeroaxis\n"
353 "set view 60,30,1,1\nset offsets 0,0,0,0\n"))
354 (setq samples-pos
(point))
356 (goto-char (point-min))
357 (if calc-graph-is-splot
358 (if calc-graph-refine
359 (error "This option works only for 2d plots")
361 (let ((calc-gnuplot-input (current-buffer))
362 (calc-graph-no-auto-view t
))
364 (setq device calc-gnuplot-print-device
365 output calc-gnuplot-print-output
)
366 (setq device
(calc-graph-find-command "terminal")
367 output
(calc-graph-find-command "output"))
369 (setq device calc-gnuplot-default-device
))
371 (setq output
(car (read-from-string output
)))
372 (setq output calc-gnuplot-default-output
)))
373 (if (or (equal device
"") (equal device
"default"))
376 (printing "postscript")
377 ;; Check MS-Windows before X, in case they have
378 ;; $DISPLAY set for some reason (e.g., Cygwin or
380 ((string= calc-gnuplot-name
"pgnuplot")
382 ((or (eq window-system
'x
) (getenv "DISPLAY"))
384 ((>= calc-gnuplot-version
3)
387 (if (equal device
"dumb")
388 (setq device
(format "dumb %d %d"
389 (1- (frame-width)) (1- (frame-height)))))
390 (if (equal device
"big")
391 (setq device
(format "dumb %d %d"
392 (* 4 (- (frame-width) 3))
393 (* 4 (- (frame-height) 3)))))
395 (if (or (equal output
"auto")
396 (and (equal output
"tty") (setq tty-output t
)))
397 (setq tempoutfile
(calc-temp-file-name -
1)
399 (setq output
(eval output
)))
400 (or (equal device calc-graph-last-device
)
402 (setq calc-graph-last-device device
)
403 (calc-gnuplot-command "set terminal" device
)))
404 (or (equal output calc-graph-last-output
)
406 (setq calc-graph-last-output output
)
407 (calc-gnuplot-command "set output"
408 (if (equal output
"STDOUT")
410 (prin1-to-string output
)))))
411 (setq calc-graph-resolution
(calc-graph-find-command "samples"))
412 (if calc-graph-resolution
413 (setq calc-graph-resolution
(string-to-number calc-graph-resolution
))
414 (setq calc-graph-resolution
(if calc-graph-is-splot
415 calc-graph-default-resolution-3d
416 calc-graph-default-resolution
)))
417 (setq precision
(calc-graph-find-command "precision"))
419 (setq precision
(string-to-number precision
))
420 (setq precision calc-graph-default-precision
))
421 (calc-graph-set-command "terminal")
422 (calc-graph-set-command "output")
423 (calc-graph-set-command "samples")
424 (calc-graph-set-command "precision"))
425 (goto-char samples-pos
)
426 (insert "set samples " (int-to-string (max (if calc-graph-is-splot
20 200)
427 (+ 5 calc-graph-resolution
))) "\n")
428 (while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t
)
429 (delete-region (match-beginning 0) (match-end 0))
432 (while (memq (preceding-char) '(?\s ?
\t))
434 (if (eq (preceding-char) ?\
,)
436 (with-current-buffer calcbuf
437 (setq cache-env
(list calc-angle-mode
442 precision calc-graph-is-splot
))
443 (if (and (not recompute
)
444 (equal (cdr (car calc-graph-data-cache
)) cache-env
))
445 (while (> (length calc-graph-data-cache
)
446 calc-graph-data-cache-limit
)
447 (setcdr calc-graph-data-cache
448 (cdr (cdr calc-graph-data-cache
))))
449 (setq calc-graph-data-cache
(list (cons nil cache-env
)))))
450 (calc-graph-find-plot t t
)
451 (while (re-search-forward
452 (if calc-graph-is-splot
453 "{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}"
454 "{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}")
456 (setq calc-graph-curve-num
(1+ calc-graph-curve-num
))
457 (let* ((calc-graph-xname (buffer-substring (match-beginning 1) (match-end 1)))
458 (xvar (intern (concat "var-" calc-graph-xname
)))
459 (calc-graph-xvalue (math-evaluate-expr (calc-var-value xvar
)))
460 (calc-graph-y3name (and calc-graph-is-splot
461 (buffer-substring (match-beginning 2)
463 (y3var (and calc-graph-is-splot
(intern (concat "var-" calc-graph-y3name
))))
464 (calc-graph-y3value (and calc-graph-is-splot
(calc-var-value y3var
)))
465 (calc-graph-yname (buffer-substring (match-beginning 3) (match-end 3)))
466 (yvar (intern (concat "var-" calc-graph-yname
)))
467 (calc-graph-yvalue (calc-var-value yvar
))
469 (delete-region (match-beginning 0) (match-end 0))
470 (setq filename
(calc-temp-file-name calc-graph-curve-num
))
471 (with-current-buffer calcbuf
473 (calc-graph-xp calc-graph-xvalue
)
474 (calc-graph-yp calc-graph-yvalue
)
476 (calc-graph-xlow nil
) (calc-graph-xhigh nil
) (y3low nil
) (y3high nil
)
477 calc-graph-xvec calc-graph-xval calc-graph-xstep var-DUMMY
478 y3val calc-graph-y3step var-DUMMY2
(calc-graph-zval nil
)
479 calc-graph-yvec calc-graph-yval calc-graph-ycache calc-graph-ycacheptr calc-graph-yvector
480 calc-graph-numsteps calc-graph-numsteps3
481 (calc-graph-keep-file (and (not calc-graph-is-splot
) (file-exists-p filename
)))
482 (calc-graph-stepcount 0)
483 (calc-symbolic-mode nil
)
484 (calc-prefer-frac nil
)
485 (calc-internal-prec (max 3 precision
))
486 (calc-simplify-mode (and (not (memq calc-simplify-mode
490 (calc-graph-non-blank nil
)
491 (math-working-step 0)
492 (math-working-step-2 nil
))
494 (if calc-graph-is-splot
495 (calc-graph-compute-3d)
496 (calc-graph-compute-2d))
498 (goto-char (point-max))
499 (insert "\n" calc-graph-xname
)
500 (if calc-graph-is-splot
501 (insert ":" calc-graph-y3name
))
502 (insert ":" calc-graph-yname
"\n\n")
503 (setq tempbuftop
(point))
504 (let ((calc-group-digits nil
)
505 (calc-leading-zeros nil
)
506 (calc-number-radix 10)
507 (calc-twos-complement-mode nil
)
508 (entry (and (not calc-graph-is-splot
)
509 (list calc-graph-xp calc-graph-yp calc-graph-xhigh calc-graph-numsteps
))))
511 (nth 1 (nth (1+ calc-graph-curve-num
)
512 calc-graph-file-cache
)))
513 (setq calc-graph-keep-file nil
))
514 (setcar (cdr (nth (1+ calc-graph-curve-num
) calc-graph-file-cache
))
516 (or calc-graph-keep-file
517 (calc-graph-format-data)))
518 (or calc-graph-keep-file
520 (or calc-graph-non-blank
521 (error "No valid data points for %s:%s"
522 calc-graph-xname calc-graph-yname
))
523 (write-region tempbuftop
(point-max) filename
525 (insert (prin1-to-string filename
))))
526 (if calc-graph-surprise-splot
527 (setcdr cache-env nil
))
528 (if (= calc-graph-curve-num
0)
530 (calc-gnuplot-command "clear")
531 (calc-clear-command-flag 'clear-message
)
532 (message "No data to plot!"))
533 (setq calc-graph-data-cache-limit
(max calc-graph-curve-num
534 calc-graph-data-cache-limit
))
535 (let ((filename (calc-temp-file-name 0)))
536 (write-region (point-min) (point-max) filename nil
'quiet
)
537 (calc-gnuplot-command "load" (prin1-to-string filename
)))
538 (or (equal output
"STDOUT")
539 calc-gnuplot-keep-outfile
540 (progn ; need to close the output file before printing/plotting
541 (setq calc-graph-last-output
"STDOUT")
542 (calc-gnuplot-command "set output")))
543 (let ((command (if printing
544 calc-gnuplot-print-command
545 (or calc-gnuplot-plot-command
546 (and (string-match "^dumb" device
)
547 'calc-graph-show-dumb
)
549 'calc-graph-show-tty
)))))
551 (if (stringp command
)
552 (calc-gnuplot-command
555 calc-gnuplot-print-output
)))
556 (if (symbolp command
)
557 (funcall command output
)
558 (eval command
))))))))))
560 (defun calc-graph-compute-2d ()
561 (if (setq calc-graph-yvec
(eq (car-safe calc-graph-yvalue
) 'vec
))
562 (if (= (setq calc-graph-numsteps
(1- (length calc-graph-yvalue
))) 0)
563 (error "Can't plot an empty vector")
564 (if (setq calc-graph-xvec
(eq (car-safe calc-graph-xvalue
) 'vec
))
565 (or (= (1- (length calc-graph-xvalue
)) calc-graph-numsteps
)
566 (error "%s and %s have different lengths" calc-graph-xname calc-graph-yname
))
567 (if (and (eq (car-safe calc-graph-xvalue
) 'intv
)
568 (math-constp calc-graph-xvalue
))
569 (setq calc-graph-xstep
(math-div (math-sub (nth 3 calc-graph-xvalue
)
570 (nth 2 calc-graph-xvalue
))
571 (1- calc-graph-numsteps
))
572 calc-graph-xvalue
(nth 2 calc-graph-xvalue
))
573 (if (math-realp calc-graph-xvalue
)
574 (setq calc-graph-xstep
1)
575 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname
)))))
576 (or (math-realp calc-graph-yvalue
)
577 (let ((math-arglist nil
))
578 (setq calc-graph-yvalue
(math-evaluate-expr calc-graph-yvalue
))
579 (calc-default-formula-arglist calc-graph-yvalue
)
581 (error "%s does not contain any unassigned variables" calc-graph-yname
))
582 (and (cdr math-arglist
)
583 (error "%s contains more than one variable: %s"
584 calc-graph-yname math-arglist
))
585 (setq calc-graph-yvalue
(math-expr-subst calc-graph-yvalue
586 (math-build-var-name (car math-arglist
))
587 '(var DUMMY var-DUMMY
)))))
588 (setq calc-graph-ycache
(assoc calc-graph-yvalue calc-graph-data-cache
))
589 (delq calc-graph-ycache calc-graph-data-cache
)
590 (nconc calc-graph-data-cache
591 (list (or calc-graph-ycache
(setq calc-graph-ycache
(list calc-graph-yvalue
)))))
592 (if (and (not (setq calc-graph-xvec
(eq (car-safe calc-graph-xvalue
) 'vec
)))
593 calc-graph-refine
(cdr (cdr calc-graph-ycache
)))
594 (calc-graph-refine-2d)
595 (calc-graph-recompute-2d))))
597 (defun calc-graph-refine-2d ()
598 (setq calc-graph-keep-file nil
599 calc-graph-ycacheptr
(cdr calc-graph-ycache
))
600 (if (and (setq calc-graph-xval
(calc-graph-find-command "xrange"))
601 (string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'"
603 (let ((b2 (match-beginning 2))
605 (setq calc-graph-xlow
(math-read-number (substring calc-graph-xval
608 calc-graph-xhigh
(math-read-number (substring calc-graph-xval b2 e2
))))
610 (while (and (cdr calc-graph-ycacheptr
)
611 (Math-lessp (car (nth 1 calc-graph-ycacheptr
)) calc-graph-xlow
))
612 (setq calc-graph-ycacheptr
(cdr calc-graph-ycacheptr
)))))
613 (setq math-working-step-2
(1- (length calc-graph-ycacheptr
)))
614 (while (and (cdr calc-graph-ycacheptr
)
615 (or (not calc-graph-xhigh
)
616 (Math-lessp (car (car calc-graph-ycacheptr
)) calc-graph-xhigh
)))
617 (setq var-DUMMY
(math-div (math-add (car (car calc-graph-ycacheptr
))
618 (car (nth 1 calc-graph-ycacheptr
)))
620 math-working-step
(1+ math-working-step
)
621 calc-graph-yval
(math-evaluate-expr calc-graph-yvalue
))
622 (setcdr calc-graph-ycacheptr
(cons (cons var-DUMMY calc-graph-yval
)
623 (cdr calc-graph-ycacheptr
)))
624 (setq calc-graph-ycacheptr
(cdr (cdr calc-graph-ycacheptr
))))
625 (setq calc-graph-yp calc-graph-ycache
626 calc-graph-numsteps
1000000))
628 (defun calc-graph-recompute-2d ()
629 (setq calc-graph-ycacheptr calc-graph-ycache
)
631 (setq calc-graph-numsteps
(1- (length calc-graph-xvalue
))
632 calc-graph-yvector nil
)
633 (if (and (eq (car-safe calc-graph-xvalue
) 'intv
)
634 (math-constp calc-graph-xvalue
))
635 (setq calc-graph-numsteps calc-graph-resolution
637 calc-graph-xlow
(nth 2 calc-graph-xvalue
)
638 calc-graph-xhigh
(nth 3 calc-graph-xvalue
)
639 calc-graph-xstep
(math-div (math-sub calc-graph-xhigh calc-graph-xlow
)
640 (1- calc-graph-numsteps
))
641 calc-graph-xvalue
(nth 2 calc-graph-xvalue
))
642 (error "%s is not a suitable basis for %s"
643 calc-graph-xname calc-graph-yname
)))
644 (setq math-working-step-2 calc-graph-numsteps
)
645 (while (>= (setq calc-graph-numsteps
(1- calc-graph-numsteps
)) 0)
646 (setq math-working-step
(1+ math-working-step
))
649 (setq calc-graph-xp
(cdr calc-graph-xp
)
650 calc-graph-xval
(car calc-graph-xp
))
651 (and (not (eq calc-graph-ycacheptr calc-graph-ycache
))
652 (consp (car calc-graph-ycacheptr
))
653 (not (Math-lessp (car (car calc-graph-ycacheptr
)) calc-graph-xval
))
654 (setq calc-graph-ycacheptr calc-graph-ycache
)))
655 (if (= calc-graph-numsteps
0)
656 (setq calc-graph-xval calc-graph-xhigh
) ; avoid cumulative roundoff
657 (setq calc-graph-xval calc-graph-xvalue
658 calc-graph-xvalue
(math-add calc-graph-xvalue calc-graph-xstep
))))
659 (while (and (cdr calc-graph-ycacheptr
)
660 (Math-lessp (car (nth 1 calc-graph-ycacheptr
)) calc-graph-xval
))
661 (setq calc-graph-ycacheptr
(cdr calc-graph-ycacheptr
)))
662 (or (and (cdr calc-graph-ycacheptr
)
663 (Math-equal (car (nth 1 calc-graph-ycacheptr
)) calc-graph-xval
))
665 (setq calc-graph-keep-file nil
666 var-DUMMY calc-graph-xval
)
667 (setcdr calc-graph-ycacheptr
(cons (cons calc-graph-xval
(math-evaluate-expr calc-graph-yvalue
))
668 (cdr calc-graph-ycacheptr
)))))
669 (setq calc-graph-ycacheptr
(cdr calc-graph-ycacheptr
))
671 (setq calc-graph-yvector
(cons (cdr (car calc-graph-ycacheptr
)) calc-graph-yvector
))
672 (or calc-graph-yp
(setq calc-graph-yp calc-graph-ycacheptr
))))
674 (setq calc-graph-xp calc-graph-xvalue
676 calc-graph-yp
(cons 'vec
(nreverse calc-graph-yvector
))
677 calc-graph-numsteps
(1- (length calc-graph-xp
)))
678 (setq calc-graph-numsteps
1000000)))
680 (defun calc-graph-compute-3d ()
681 (if (setq calc-graph-yvec
(eq (car-safe calc-graph-yvalue
) 'vec
))
682 (if (math-matrixp calc-graph-yvalue
)
684 (setq calc-graph-numsteps
(1- (length calc-graph-yvalue
))
685 calc-graph-numsteps3
(1- (length (nth 1 calc-graph-yvalue
))))
686 (if (eq (car-safe calc-graph-xvalue
) 'vec
)
687 (or (= (1- (length calc-graph-xvalue
)) calc-graph-numsteps
)
688 (error "%s has wrong length" calc-graph-xname
))
689 (if (and (eq (car-safe calc-graph-xvalue
) 'intv
)
690 (math-constp calc-graph-xvalue
))
691 (setq calc-graph-xvalue
(calcFunc-index calc-graph-numsteps
692 (nth 2 calc-graph-xvalue
)
694 (math-sub (nth 3 calc-graph-xvalue
)
695 (nth 2 calc-graph-xvalue
))
696 (1- calc-graph-numsteps
))))
697 (if (math-realp calc-graph-xvalue
)
698 (setq calc-graph-xvalue
(calcFunc-index calc-graph-numsteps calc-graph-xvalue
1))
699 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname
))))
700 (if (eq (car-safe calc-graph-y3value
) 'vec
)
701 (or (= (1- (length calc-graph-y3value
)) calc-graph-numsteps3
)
702 (error "%s has wrong length" calc-graph-y3name
))
703 (if (and (eq (car-safe calc-graph-y3value
) 'intv
)
704 (math-constp calc-graph-y3value
))
705 (setq calc-graph-y3value
(calcFunc-index calc-graph-numsteps3
706 (nth 2 calc-graph-y3value
)
708 (math-sub (nth 3 calc-graph-y3value
)
709 (nth 2 calc-graph-y3value
))
710 (1- calc-graph-numsteps3
))))
711 (if (math-realp calc-graph-y3value
)
712 (setq calc-graph-y3value
(calcFunc-index calc-graph-numsteps3 calc-graph-y3value
1))
713 (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname
))))
714 (setq calc-graph-xp nil
718 (while (setq calc-graph-xvalue
(cdr calc-graph-xvalue
) calc-graph-yvalue
(cdr calc-graph-yvalue
))
719 (setq calc-graph-xp
(nconc calc-graph-xp
(make-list (1+ calc-graph-numsteps3
) (car calc-graph-xvalue
)))
720 calc-graph-yp
(nconc calc-graph-yp
(cons 0 (copy-sequence (cdr calc-graph-y3value
))))
721 calc-graph-zp
(nconc calc-graph-zp
(cons '(skip)
722 (copy-sequence (cdr (car calc-graph-yvalue
)))))))
723 (setq calc-graph-numsteps
(1- (* calc-graph-numsteps
724 (1+ calc-graph-numsteps3
)))))
725 (if (= (setq calc-graph-numsteps
(1- (length calc-graph-yvalue
))) 0)
726 (error "Can't plot an empty vector"))
727 (or (and (eq (car-safe calc-graph-xvalue
) 'vec
)
728 (= (1- (length calc-graph-xvalue
)) calc-graph-numsteps
))
729 (error "%s is not a suitable basis for %s" calc-graph-xname calc-graph-yname
))
730 (or (and (eq (car-safe calc-graph-y3value
) 'vec
)
731 (= (1- (length calc-graph-y3value
)) calc-graph-numsteps
))
732 (error "%s is not a suitable basis for %s" calc-graph-y3name calc-graph-yname
))
733 (setq calc-graph-xp calc-graph-xvalue
734 calc-graph-yp calc-graph-y3value
735 calc-graph-zp calc-graph-yvalue
737 (or (math-realp calc-graph-yvalue
)
738 (let ((math-arglist nil
))
739 (setq calc-graph-yvalue
(math-evaluate-expr calc-graph-yvalue
))
740 (calc-default-formula-arglist calc-graph-yvalue
)
741 (setq math-arglist
(sort math-arglist
'string-lessp
))
742 (or (cdr math-arglist
)
743 (error "%s does not contain enough unassigned variables" calc-graph-yname
))
744 (and (cdr (cdr math-arglist
))
745 (error "%s contains too many variables: %s" calc-graph-yname math-arglist
))
746 (setq calc-graph-yvalue
(math-multi-subst calc-graph-yvalue
747 (mapcar 'math-build-var-name
749 '((var DUMMY var-DUMMY
)
750 (var DUMMY2 var-DUMMY2
))))))
751 (if (setq calc-graph-xvec
(eq (car-safe calc-graph-xvalue
) 'vec
))
752 (setq calc-graph-numsteps
(1- (length calc-graph-xvalue
)))
753 (if (and (eq (car-safe calc-graph-xvalue
) 'intv
)
754 (math-constp calc-graph-xvalue
))
755 (setq calc-graph-numsteps calc-graph-resolution
756 calc-graph-xvalue
(calcFunc-index calc-graph-numsteps
757 (nth 2 calc-graph-xvalue
)
758 (math-div (math-sub (nth 3 calc-graph-xvalue
)
759 (nth 2 calc-graph-xvalue
))
760 (1- calc-graph-numsteps
))))
761 (error "%s is not a suitable basis for %s"
762 calc-graph-xname calc-graph-yname
)))
763 (if (eq (car-safe calc-graph-y3value
) 'vec
)
764 (setq calc-graph-numsteps3
(1- (length calc-graph-y3value
)))
765 (if (and (eq (car-safe calc-graph-y3value
) 'intv
)
766 (math-constp calc-graph-y3value
))
767 (setq calc-graph-numsteps3 calc-graph-resolution
768 calc-graph-y3value
(calcFunc-index calc-graph-numsteps3
769 (nth 2 calc-graph-y3value
)
770 (math-div (math-sub (nth 3 calc-graph-y3value
)
771 (nth 2 calc-graph-y3value
))
772 (1- calc-graph-numsteps3
))))
773 (error "%s is not a suitable basis for %s"
774 calc-graph-y3name calc-graph-yname
)))
775 (setq calc-graph-xp nil
779 (setq math-working-step
0)
780 (while (setq calc-graph-xvalue
(cdr calc-graph-xvalue
))
781 (setq calc-graph-xp
(nconc calc-graph-xp
(make-list (1+ calc-graph-numsteps3
) (car calc-graph-xvalue
)))
782 calc-graph-yp
(nconc calc-graph-yp
(cons 0 (copy-sequence (cdr calc-graph-y3value
))))
783 calc-graph-zp
(cons '(skip) calc-graph-zp
)
784 calc-graph-y3step calc-graph-y3value
785 var-DUMMY
(car calc-graph-xvalue
)
786 math-working-step-2
0
787 math-working-step
(1+ math-working-step
))
788 (while (setq calc-graph-y3step
(cdr calc-graph-y3step
))
789 (setq math-working-step-2
(1+ math-working-step-2
)
790 var-DUMMY2
(car calc-graph-y3step
)
791 calc-graph-zp
(cons (math-evaluate-expr calc-graph-yvalue
) calc-graph-zp
))))
792 (setq calc-graph-zp
(nreverse calc-graph-zp
)
793 calc-graph-numsteps
(1- (* calc-graph-numsteps
(1+ calc-graph-numsteps3
))))))
795 (defun calc-graph-format-data ()
796 (if (math-contains-sdev-p calc-graph-yp
)
797 (let ((yp calc-graph-yp
))
798 (setq calc-graph-yp
(cons 'vec
(mapcar 'math-get-value
(cdr yp
))))
799 (setq calc-graph-zp
(cons 'vec
(mapcar 'math-get-sdev
(cdr yp
))))))
800 (while (<= (setq calc-graph-stepcount
(1+ calc-graph-stepcount
)) calc-graph-numsteps
)
802 (setq calc-graph-xp
(cdr calc-graph-xp
)
803 calc-graph-xval
(car calc-graph-xp
)
804 calc-graph-yp
(cdr calc-graph-yp
)
805 calc-graph-yval
(car calc-graph-yp
)
806 calc-graph-zp
(cdr calc-graph-zp
)
807 calc-graph-zval
(car calc-graph-zp
))
809 (setq calc-graph-xval calc-graph-xvalue
810 calc-graph-xvalue
(math-add calc-graph-xvalue calc-graph-xstep
)
811 calc-graph-yp
(cdr calc-graph-yp
)
812 calc-graph-yval
(car calc-graph-yp
))
813 (setq calc-graph-xval
(car (car calc-graph-yp
))
814 calc-graph-yval
(cdr (car calc-graph-yp
))
815 calc-graph-yp
(cdr calc-graph-yp
))
816 (if (or (not calc-graph-yp
)
817 (and calc-graph-xhigh
(equal calc-graph-xval calc-graph-xhigh
)))
818 (setq calc-graph-numsteps
0))))
819 (if calc-graph-is-splot
820 (if (and (eq (car-safe calc-graph-zval
) 'calcFunc-xyz
)
821 (= (length calc-graph-zval
) 4))
822 (setq calc-graph-xval
(nth 1 calc-graph-zval
)
823 calc-graph-yval
(nth 2 calc-graph-zval
)
824 calc-graph-zval
(nth 3 calc-graph-zval
)))
825 (if (and (eq (car-safe calc-graph-yval
) 'calcFunc-xyz
)
826 (= (length calc-graph-yval
) 4))
828 (or calc-graph-surprise-splot
829 (with-current-buffer (get-buffer-create "*Gnuplot Temp*")
831 (goto-char (point-max))
832 (re-search-backward "^plot[ \t]")
833 (insert "set parametric\ns")
834 (setq calc-graph-surprise-splot t
))))
835 (setq calc-graph-xval
(nth 1 calc-graph-yval
)
836 calc-graph-zval
(nth 3 calc-graph-yval
)
837 calc-graph-yval
(nth 2 calc-graph-yval
)))
838 (if (and (eq (car-safe calc-graph-yval
) 'calcFunc-xy
)
839 (= (length calc-graph-yval
) 3))
840 (setq calc-graph-xval
(nth 1 calc-graph-yval
)
841 calc-graph-yval
(nth 2 calc-graph-yval
)))))
842 (if (and (Math-realp calc-graph-xval
)
843 (Math-realp calc-graph-yval
)
844 (or (not calc-graph-zval
) (Math-realp calc-graph-zval
)))
846 (setq calc-graph-blank nil
847 calc-graph-non-blank t
)
848 (if (Math-integerp calc-graph-xval
)
849 (insert (math-format-number calc-graph-xval
))
850 (if (eq (car calc-graph-xval
) 'frac
)
851 (setq calc-graph-xval
(math-float calc-graph-xval
)))
852 (insert (math-format-number (nth 1 calc-graph-xval
))
853 "e" (int-to-string (nth 2 calc-graph-xval
))))
855 (if (Math-integerp calc-graph-yval
)
856 (insert (math-format-number calc-graph-yval
))
857 (if (eq (car calc-graph-yval
) 'frac
)
858 (setq calc-graph-yval
(math-float calc-graph-yval
)))
859 (insert (math-format-number (nth 1 calc-graph-yval
))
860 "e" (int-to-string (nth 2 calc-graph-yval
))))
864 (if (Math-integerp calc-graph-zval
)
865 (insert (math-format-number calc-graph-zval
))
866 (if (eq (car calc-graph-zval
) 'frac
)
867 (setq calc-graph-zval
(math-float calc-graph-zval
)))
868 (insert (math-format-number (nth 1 calc-graph-zval
))
869 "e" (int-to-string (nth 2 calc-graph-zval
))))))
871 (and (not (equal calc-graph-zval
'(skip)))
872 (boundp 'var-PlotRejects
)
873 (eq (car-safe var-PlotRejects
) 'vec
)
874 (nconc var-PlotRejects
878 calc-graph-xval calc-graph-yval
)))
879 (calc-refresh-evaltos 'var-PlotRejects
))
883 (setq calc-graph-blank t
))))))
885 (defun calc-temp-file-name (num)
886 (while (<= (length calc-graph-file-cache
) (1+ num
))
887 (setq calc-graph-file-cache
(nconc calc-graph-file-cache
(list nil
))))
888 (car (or (nth (1+ num
) calc-graph-file-cache
)
889 (setcar (nthcdr (1+ num
) calc-graph-file-cache
)
890 (list (make-temp-file
891 (concat calc-gnuplot-tempfile
893 (char-to-string (- ?A num
))
894 (int-to-string num
))))
897 (defun calc-graph-delete-temps ()
898 (while calc-graph-file-cache
899 (and (car calc-graph-file-cache
)
900 (file-exists-p (car (car calc-graph-file-cache
)))
902 (delete-file (car (car calc-graph-file-cache
)))
904 (setq calc-graph-file-cache
(cdr calc-graph-file-cache
))))
906 (defun calc-graph-kill-hook ()
907 (calc-graph-delete-temps))
909 (defun calc-graph-show-tty (output)
910 "Default calc-gnuplot-plot-command for \"tty\" output mode.
911 This is useful for tek40xx and other graphics-terminal types."
912 (call-process-region 1 1 shell-file-name
913 nil calc-gnuplot-buffer nil
914 "-c" (format "cat %s >/dev/tty; rm %s" output output
)))
916 (defvar calc-dumb-map nil
917 "The keymap for the \"dumb\" terminal plot.")
919 (defun calc-graph-show-dumb (&optional output
)
920 "Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
921 This \"dumb\" driver will be present in Gnuplot 3.0."
923 (save-window-excursion
924 (switch-to-buffer calc-gnuplot-buffer
)
925 (delete-other-windows)
926 (goto-char calc-gnuplot-trail-mark
)
927 (or (search-forward "\f" nil t
)
929 (goto-char (point-max))
930 (re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T")
931 (if (looking-at "\f")
934 (if (eolp) (forward-line 1))
935 (or (calc-graph-find-command "time")
936 (calc-graph-find-command "title")
937 (calc-graph-find-command "ylabel")
939 (insert-before-markers (format "(%s)" (current-time-string)))
941 (set-window-start (selected-window) (point))
942 (goto-char (point-max)))
948 (setq calc-dumb-map
(make-sparse-keymap))
949 (define-key calc-dumb-map
"\n" 'scroll-up-command
)
950 (define-key calc-dumb-map
" " 'scroll-up-command
)
951 (define-key calc-dumb-map
"\177" 'scroll-down-command
)
952 (define-key calc-dumb-map
"<" 'scroll-left
)
953 (define-key calc-dumb-map
">" 'scroll-right
)
954 (define-key calc-dumb-map
"{" 'scroll-down-command
)
955 (define-key calc-dumb-map
"}" 'scroll-up-command
)
956 (define-key calc-dumb-map
"q" 'exit-recursive-edit
)
957 (define-key calc-dumb-map
"\C-c\C-c" 'exit-recursive-edit
)))
958 (use-local-map calc-dumb-map
)
959 (setq truncate-lines t
)
960 (message "Type `q' or `C-c C-c' to return to Calc")
962 (bury-buffer "*Gnuplot Trail*")))
964 (defun calc-graph-clear ()
966 (if calc-graph-last-device
967 (if (or (equal calc-graph-last-device
"x11")
968 (equal calc-graph-last-device
"X11"))
969 (calc-gnuplot-command "set output"
970 (if (equal calc-graph-last-output
"STDOUT")
972 (prin1-to-string calc-graph-last-output
)))
973 (calc-gnuplot-command "clear"))))
975 (defun calc-graph-title-x (title)
976 (interactive "sX axis title: ")
977 (calc-graph-set-command "xlabel" (if (not (equal title
""))
978 (prin1-to-string title
))))
980 (defun calc-graph-title-y (title)
981 (interactive "sY axis title: ")
982 (calc-graph-set-command "ylabel" (if (not (equal title
""))
983 (prin1-to-string title
))))
985 (defun calc-graph-title-z (title)
986 (interactive "sZ axis title: ")
987 (calc-graph-set-command "zlabel" (if (not (equal title
""))
988 (prin1-to-string title
))))
990 (defun calc-graph-range-x (range)
991 (interactive "sX axis range: ")
992 (calc-graph-set-range "xrange" range
))
994 (defun calc-graph-range-y (range)
995 (interactive "sY axis range: ")
996 (calc-graph-set-range "yrange" range
))
998 (defun calc-graph-range-z (range)
999 (interactive "sZ axis range: ")
1000 (calc-graph-set-range "zrange" range
))
1002 (defun calc-graph-set-range (cmd range
)
1003 (if (equal range
"$")
1005 (let ((val (calc-top-n 1)))
1006 (if (and (eq (car-safe val
) 'intv
) (math-constp val
))
1008 (math-format-number (math-float (nth 2 val
))) ":"
1009 (math-format-number (math-float (nth 3 val
)))))
1010 (if (and (eq (car-safe val
) 'vec
)
1013 (math-format-number (math-float (nth 1 val
))) ":"
1014 (math-format-number (math-float (nth 2 val
)))))
1015 (error "Range specification must be an interval or 2-vector")))
1016 (calc-pop-stack 1))))
1017 (if (string-match "\\[.+\\]" range
)
1018 (setq range
(substring range
1 -
1)))
1019 (if (and (not (string-match ":" range
))
1020 (or (string-match "," range
)
1021 (string-match " " range
)))
1022 (aset range
(match-beginning 0) ?\
:))
1023 (calc-graph-set-command cmd
(if (not (equal range
""))
1024 (concat "[" range
"]"))))
1026 (defun calc-graph-log-x (flag)
1028 (calc-graph-set-log flag
0 0))
1030 (defun calc-graph-log-y (flag)
1032 (calc-graph-set-log 0 flag
0))
1034 (defun calc-graph-log-z (flag)
1036 (calc-graph-set-log 0 0 flag
))
1038 (defun calc-graph-set-log (xflag yflag zflag
)
1039 (let* ((old (or (calc-graph-find-command "logscale") ""))
1040 (xold (string-match "x" old
))
1041 (yold (string-match "y" old
))
1042 (zold (string-match "z" old
))
1044 (setq str
(concat (if (if xflag
1045 (if (eq xflag
0) xold
1046 (> (prefix-numeric-value xflag
) 0))
1049 (if (eq yflag
0) yold
1050 (> (prefix-numeric-value yflag
) 0))
1053 (if (eq zflag
0) zold
1054 (> (prefix-numeric-value zflag
) 0))
1055 (not zold
)) "z" "")))
1056 (calc-graph-set-command "logscale" (if (not (equal str
"")) str
))))
1058 (defun calc-graph-line-style (style)
1060 (calc-graph-set-styles (and style
(prefix-numeric-value style
)) t
))
1062 (defun calc-graph-point-style (style)
1064 (calc-graph-set-styles t
(and style
(prefix-numeric-value style
))))
1066 (defun calc-graph-set-styles (lines points
&optional yerr
)
1068 (with-current-buffer calc-gnuplot-input
1069 (or (calc-graph-find-plot nil nil
)
1070 (error "No data points have been set!"))
1071 (let ((base (point))
1072 (mode nil
) (lstyle nil
) (pstyle nil
)
1073 start end lenbl penbl errform
)
1074 (re-search-forward "[,\n]")
1076 (setq end
(point) start end
)
1078 (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+with\\)")
1080 (setq start
(match-beginning 1))
1081 (goto-char (match-end 0))
1082 (if (looking-at "[ \t]+\\([a-z]+\\)")
1083 (setq mode
(buffer-substring (match-beginning 1)
1085 (if (looking-at "[ \ta-z]+\\([0-9]+\\)")
1086 (setq lstyle
(string-to-number
1087 (buffer-substring (match-beginning 1)
1089 (if (looking-at "[ \ta-z]+[0-9]+[ \t]+\\([0-9]+\\)")
1090 (setq pstyle
(string-to-number
1091 (buffer-substring (match-beginning 1)
1094 (setq lenbl
(or (equal mode
"lines")
1095 (equal mode
"linespoints"))
1096 penbl
(or (equal mode
"points")
1097 (equal mode
"linespoints")))
1101 lenbl
(>= lines
0)))
1102 (setq lenbl
(not lenbl
)))
1106 penbl
(>= points
0)))
1107 (setq penbl
(not penbl
))))
1108 (delete-region start end
)
1112 (math-contains-sdev-p
1116 (re-search-backward ":\\(.*\\)\\}")
1117 (match-string 1))))))
1120 (insert " with yerrorbars")
1127 (if penbl
"linespoints" "lines")
1128 (if penbl
"points" "dots"))))
1129 (if (and pstyle
(> pstyle
0))
1131 (if (and lstyle
(> lstyle
0)) (int-to-string lstyle
) "1")
1132 " " (int-to-string pstyle
))
1133 (if (and lstyle
(> lstyle
0))
1134 (insert " " (int-to-string lstyle
)))))))
1135 (calc-graph-view-commands))
1137 (defun calc-graph-zero-x (flag)
1139 (calc-graph-set-command "noxzeroaxis"
1141 (<= (prefix-numeric-value flag
) 0)
1142 (not (calc-graph-find-command "noxzeroaxis")))
1145 (defun calc-graph-zero-y (flag)
1147 (calc-graph-set-command "noyzeroaxis"
1149 (<= (prefix-numeric-value flag
) 0)
1150 (not (calc-graph-find-command "noyzeroaxis")))
1153 (defun calc-graph-name (name)
1154 (interactive "sTitle for current curve: ")
1156 (with-current-buffer calc-gnuplot-input
1157 (or (calc-graph-find-plot nil nil
)
1158 (error "No data points have been set!"))
1159 (let ((base (point))
1162 (re-search-forward "[,\n]\\|[ \t]+with")
1163 (setq end
(match-beginning 0))
1165 (if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+title\\)")
1167 (goto-char (match-beginning 1))
1168 (delete-region (point) end
))
1170 (insert " title " (prin1-to-string name
))))
1171 (calc-graph-view-commands))
1173 (defun calc-graph-hide (flag)
1176 (and (calc-graph-find-plot nil nil
)
1178 (or (looking-at "{")
1179 (error "Can't hide this curve (wrong format)"))
1181 (if (looking-at "*")
1182 (if (or (null flag
) (<= (prefix-numeric-value flag
) 0))
1184 (if (or (null flag
) (> (prefix-numeric-value flag
) 0))
1187 (defun calc-graph-header (title)
1188 (interactive "sTitle for entire graph: ")
1189 (calc-graph-set-command "title" (if (not (equal title
""))
1190 (prin1-to-string title
))))
1192 (defun calc-graph-border (flag)
1194 (calc-graph-set-command "noborder"
1196 (<= (prefix-numeric-value flag
) 0)
1197 (not (calc-graph-find-command "noborder")))
1200 (defun calc-graph-grid (flag)
1202 (calc-graph-set-command "grid" (and (if flag
1203 (> (prefix-numeric-value flag
) 0)
1204 (not (calc-graph-find-command "grid")))
1207 (defun calc-graph-key (flag)
1209 (calc-graph-set-command "key" (and (if flag
1210 (> (prefix-numeric-value flag
) 0)
1211 (not (calc-graph-find-command "key")))
1214 (defun calc-graph-num-points (res flag
)
1215 (interactive "sNumber of data points: \nP")
1217 (if (> (prefix-numeric-value flag
) 0)
1219 (message "Default resolution is %d"
1220 calc-graph-default-resolution
)
1221 (setq calc-graph-default-resolution
(string-to-number res
)))
1223 (message "Default 3D resolution is %d"
1224 calc-graph-default-resolution-3d
)
1225 (setq calc-graph-default-resolution-3d
(string-to-number res
))))
1226 (calc-graph-set-command "samples" (if (not (equal res
"")) res
))))
1228 (defun calc-graph-device (name flag
)
1229 (interactive "sDevice name: \nP")
1230 (if (equal name
"?")
1232 (calc-gnuplot-command "set terminal")
1233 (calc-graph-view-trail))
1235 (if (> (prefix-numeric-value flag
) 0)
1237 (message "Default GNUPLOT device is \"%s\""
1238 calc-gnuplot-default-device
)
1239 (setq calc-gnuplot-default-device name
))
1241 (message "GNUPLOT device for Print command is \"%s\""
1242 calc-gnuplot-print-device
)
1243 (setq calc-gnuplot-print-device name
)))
1244 (calc-graph-set-command "terminal" (if (not (equal name
""))
1247 (defun calc-graph-output (name flag
)
1248 (interactive "FOutput file name: \np")
1249 (cond ((string-match "\\<[aA][uU][tT][oO]$" name
)
1251 ((string-match "\\<[tT][tT][yY]$" name
)
1253 ((string-match "\\<[sS][tT][dD][oO][uU][tT]$" name
)
1254 (setq name
"STDOUT"))
1255 ((equal (file-name-nondirectory name
) "")
1257 (t (setq name
(expand-file-name name
))))
1259 (if (> (prefix-numeric-value flag
) 0)
1261 (message "Default GNUPLOT output file is \"%s\""
1262 calc-gnuplot-default-output
)
1263 (setq calc-gnuplot-default-output name
))
1265 (message "GNUPLOT output file for Print command is \"%s\""
1266 calc-gnuplot-print-output
)
1267 (setq calc-gnuplot-print-output name
)))
1268 (calc-graph-set-command "output" (if (not (equal name
""))
1269 (prin1-to-string name
)))))
1271 (defun calc-graph-display (name)
1272 (interactive "sX display name: ")
1274 (message "Current X display is \"%s\""
1275 (or calc-gnuplot-display
"<none>"))
1276 (setq calc-gnuplot-display name
)
1277 (if (calc-gnuplot-alive)
1278 (calc-gnuplot-command "exit"))))
1280 (defun calc-graph-geometry (name)
1281 (interactive "sX geometry spec (or \"default\"): ")
1283 (message "Current X geometry is \"%s\""
1284 (or calc-gnuplot-geometry
"default"))
1285 (setq calc-gnuplot-geometry
(and (not (equal name
"default")) name
))
1286 (if (calc-gnuplot-alive)
1287 (calc-gnuplot-command "exit"))))
1289 (defun calc-graph-find-command (cmd)
1291 (with-current-buffer calc-gnuplot-input
1292 (goto-char (point-min))
1293 (if (re-search-forward (concat "^set[ \t]+" cmd
"[ \t]*\\(.*\\)$") nil t
)
1294 (buffer-substring (match-beginning 1) (match-end 1)))))
1296 (defun calc-graph-set-command (cmd &rest args
)
1298 (with-current-buffer calc-gnuplot-input
1299 (goto-char (point-min))
1300 (if (re-search-forward (concat "^set[ \t]+" cmd
"[ \t\n]") nil t
)
1304 (let ((end (point)))
1306 (delete-region (point) (1+ end
))))
1307 (if (calc-graph-find-plot t t
)
1308 (if (eq (preceding-char) ?
\n)
1310 (goto-char (1- (point-max)))))
1311 (if (and args
(car args
))
1315 (insert "set " (mapconcat 'identity
(cons cmd args
) " ") "\n"))))
1316 (calc-graph-view-commands))
1318 (defun calc-graph-command (cmd)
1319 (interactive "sGNUPLOT command: ")
1322 (calc-graph-view-trail)
1323 (calc-gnuplot-command cmd
)
1324 (or (string= calc-gnuplot-name
"pgnuplot")
1326 (accept-process-output)
1327 (calc-graph-view-trail)))))
1329 (defun calc-graph-kill (&optional no-view
)
1331 (calc-graph-delete-temps)
1332 (if (calc-gnuplot-alive)
1334 (or no-view
(calc-graph-view-trail))
1335 (let ((calc-graph-no-wait t
))
1336 (calc-gnuplot-command "exit"))
1338 (if (process-status calc-gnuplot-process
)
1339 (delete-process calc-gnuplot-process
))
1340 (setq calc-gnuplot-process nil
))))
1342 (defun calc-graph-quit ()
1344 (if (get-buffer-window calc-gnuplot-input
)
1345 (calc-graph-view-commands t
))
1346 (if (get-buffer-window calc-gnuplot-buffer
)
1347 (calc-graph-view-trail t
))
1348 (calc-graph-kill t
))
1350 (defun calc-graph-view-commands (&optional no-need
)
1352 (or calc-graph-no-auto-view
(calc-graph-init-buffers))
1353 (calc-graph-view calc-gnuplot-input calc-gnuplot-buffer
(null no-need
)))
1355 (defun calc-graph-view-trail (&optional no-need
)
1357 (or calc-graph-no-auto-view
(calc-graph-init-buffers))
1358 (calc-graph-view calc-gnuplot-buffer calc-gnuplot-input
(null no-need
)))
1360 (defun calc-graph-view (buf other-buf need
)
1362 (or calc-graph-no-auto-view
1363 (if (setq win
(get-buffer-window buf
))
1365 (and (eq buf calc-gnuplot-buffer
)
1366 (with-current-buffer buf
1367 (not (pos-visible-in-window-p (point-max) win
))))
1370 (bury-buffer other-buf
)
1371 (let ((curwin (selected-window)))
1373 (switch-to-buffer nil
)
1374 (select-window curwin
))))
1375 (if (setq win
(get-buffer-window other-buf
))
1376 (set-window-buffer win buf
)
1377 (if (eq major-mode
'calc-mode
)
1379 (not (window-full-height-p)))
1380 (display-buffer buf
))
1381 (switch-to-buffer buf
)))))
1382 (with-current-buffer buf
1383 (if (and (eq buf calc-gnuplot-buffer
)
1384 (setq win
(get-buffer-window buf
))
1385 (not (pos-visible-in-window-p (point-max) win
)))
1387 (goto-char (point-max))
1388 (vertical-motion (- 6 (window-height win
)))
1389 (set-window-start win
(point))
1390 (goto-char (point-max)))))
1391 (or calc-graph-no-auto-view
(sit-for 0))))
1393 (defun calc-gnuplot-check-for-errors ()
1397 (set-buffer calc-gnuplot-buffer
)
1398 (goto-char calc-gnuplot-last-error-pos
))
1399 (re-search-forward "^[ \t]+\\^$" nil t
)
1400 (goto-char (point-max))
1401 (setq calc-gnuplot-last-error-pos
(point-max))))
1402 (calc-graph-view-trail)))
1404 (defun calc-gnuplot-command (&rest args
)
1406 (let ((cmd (concat (mapconcat 'identity args
" ") "\n")))
1407 (or (string= calc-gnuplot-name
"pgnuplot")
1408 (accept-process-output))
1409 (with-current-buffer calc-gnuplot-buffer
1410 (calc-gnuplot-check-for-errors)
1411 (goto-char (point-max))
1412 (setq calc-gnuplot-trail-mark
(point))
1413 (or (>= calc-gnuplot-version
3)
1415 (set-marker (process-mark calc-gnuplot-process
) (point))
1416 (process-send-string calc-gnuplot-process cmd
)
1417 (if (get-buffer-window calc-gnuplot-buffer
)
1418 (calc-graph-view-trail))
1419 (or (string= calc-gnuplot-name
"pgnuplot")
1420 (accept-process-output (and (not calc-graph-no-wait
)
1421 calc-gnuplot-process
)))
1422 (calc-gnuplot-check-for-errors)
1423 (if (get-buffer-window calc-gnuplot-buffer
)
1424 (calc-graph-view-trail)))))
1426 (defun calc-graph-init-buffers ()
1427 (or (and calc-gnuplot-buffer
1428 (buffer-name calc-gnuplot-buffer
))
1429 (setq calc-gnuplot-buffer
(get-buffer-create "*Gnuplot Trail*")))
1430 (or (and calc-gnuplot-input
1431 (buffer-name calc-gnuplot-input
))
1432 (setq calc-gnuplot-input
(get-buffer-create "*Gnuplot Commands*"))))
1434 (defun calc-graph-init ()
1435 (or (calc-gnuplot-alive)
1436 (let ((process-connection-type t
)
1438 (if calc-gnuplot-process
1440 (delete-process calc-gnuplot-process
)
1441 (setq calc-gnuplot-process nil
)))
1442 (calc-graph-init-buffers)
1443 (with-current-buffer calc-gnuplot-buffer
1444 (insert "\nStarting gnuplot...\n")
1445 (setq origin
(point)))
1446 (setq calc-graph-last-device nil
)
1447 (setq calc-graph-last-output nil
)
1448 (if (string= calc-gnuplot-name
"pgnuplot")
1449 (let ((version-str (shell-command-to-string "pgnuplot -V")))
1450 (if (string-match "gnuplot \\([0-9]+\\)\\." version-str
)
1451 (setq calc-gnuplot-version
(string-to-number
1452 (substring version-str
1455 (setq calc-gnuplot-version
1))))
1457 (let ((args (append (and calc-gnuplot-display
1458 (not (equal calc-gnuplot-display
1459 (getenv "DISPLAY")))
1460 (not (string= calc-gnuplot-name
"pgnuplot"))
1462 calc-gnuplot-display
))
1463 (and calc-gnuplot-geometry
1464 (not (string= calc-gnuplot-name
"pgnuplot"))
1466 calc-gnuplot-geometry
)))))
1467 (setq calc-gnuplot-process
1468 (apply 'start-process
1473 (set-process-query-on-exit-flag calc-gnuplot-process nil
))
1475 (error "Sorry, can't find \"%s\" on your system"
1476 calc-gnuplot-name
)))
1477 (with-current-buffer calc-gnuplot-buffer
1478 (while (and (not (string= calc-gnuplot-name
"pgnuplot"))
1479 (not (save-excursion
1481 (search-forward "gnuplot> " nil t
)))
1482 (memq (process-status calc-gnuplot-process
) '(run stop
)))
1483 (accept-process-output calc-gnuplot-process
))
1484 (or (memq (process-status calc-gnuplot-process
) '(run stop
))
1485 (error "Unable to start GNUPLOT process"))
1486 (if (not (string= calc-gnuplot-name
"pgnuplot"))
1490 "G N U P L O T.*\n.*version \\([0-9]+\\)\\." nil t
))
1491 (setq calc-gnuplot-version
1492 (string-to-number (buffer-substring
1495 (setq calc-gnuplot-version
1)))
1496 (goto-char (point-max)))))
1497 (with-current-buffer calc-gnuplot-input
1498 (if (= (buffer-size) 0)
1499 (insert "# Commands for running gnuplot\n\n\n")
1500 (or calc-graph-no-auto-view
1501 (eq (char-after (1- (point-max))) ?
\n)
1503 (goto-char (point-max))
1506 (provide 'calc-graph
)
1508 ;;; calc-graph.el ends here