HCoop / bpt / emacs.git / blob
? search:


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