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