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