mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-24 10:38:38 +00:00
Code Issues Releases Activity
fad78d58de
emacs/lisp/calc/calc-graph.el
Colin Walters 2c37c14bd0 (calc-gnuplot-tempfile): Don't expand against 
`temporary-file-directory'; we now do that in `calc-graph-file-cache'.
(calc-temp-file-name): Use `make-temp-file'.
2002-03-01 01:18:37 +00:00

1440 lines
46 KiB
EmacsLisp
Raw Blame History

;;; calc-graph.el --- graph output functions for Calc
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Colin Walters <walters@debian.org>
;; This file is part of GNU Emacs.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
;;; Commentary:
;;; Code:
;; This file is autoloaded from calc-ext.el.
(require 'calc-ext)
(require 'calc-macs)
(defun calc-Need-calc-graph () nil)
;;; Graphics
;;; Note that some of the following initial values also occur in calc.el.
(defvar calc-gnuplot-tempfile "calc")
(defvar calc-gnuplot-default-device "default")
(defvar calc-gnuplot-default-output "STDOUT")
(defvar calc-gnuplot-print-device "postscript")
(defvar calc-gnuplot-print-output "auto")
(defvar calc-gnuplot-keep-outfile nil)
(defvar calc-gnuplot-version nil)
(defvar calc-gnuplot-display (getenv "DISPLAY"))
(defvar calc-gnuplot-geometry nil)
(defvar calc-graph-default-resolution 15)
(defvar calc-graph-default-resolution-3d 5)
(defvar calc-graph-default-precision 5)
(defvar calc-gnuplot-buffer nil)
(defvar calc-gnuplot-input nil)
(defvar calc-gnuplot-last-error-pos 1)
(defvar calc-graph-last-device nil)
(defvar calc-graph-last-output nil)
(defvar calc-graph-file-cache nil)
(defvar calc-graph-var-cache nil)
(defvar calc-graph-data-cache nil)
(defvar calc-graph-data-cache-limit 10)
(defvar calc-graph-no-auto-view nil)
(defvar calc-graph-no-wait nil)
(defun calc-graph-fast (many)
(interactive "P")
(let ((calc-graph-no-auto-view t))
(calc-graph-delete t)
(calc-graph-add many)
(calc-graph-plot nil)))
(defun calc-graph-fast-3d (many)
(interactive "P")
(let ((calc-graph-no-auto-view t))
(calc-graph-delete t)
(calc-graph-add-3d many)
(calc-graph-plot nil)))
(defun calc-graph-delete (all)
(interactive "P")
(calc-wrapper
(calc-graph-init)
(save-excursion
(set-buffer calc-gnuplot-input)
(and (calc-graph-find-plot t all)
(progn
(if (looking-at "s?plot")
(progn
(setq calc-graph-var-cache nil)
(delete-region (point) (point-max)))
(delete-region (point) (1- (point-max)))))))
(calc-graph-view-commands)))
(defun calc-graph-find-plot (&optional before all)
(goto-char (point-min))
(and (re-search-forward "^s?plot[ \t]+" nil t)
(let ((beg (point)))
(goto-char (point-max))
(if (or all
(not (search-backward "," nil t))
(< (point) beg))
(progn
(goto-char beg)
(if before
(beginning-of-line)))
(or before
(re-search-forward ",[ \t]+")))
t)))
(defun calc-graph-add (many)
(interactive "P")
(calc-wrapper
(calc-graph-init)
(cond ((null many)
(calc-graph-add-curve (calc-graph-lookup (calc-top-n 2))
(calc-graph-lookup (calc-top-n 1))))
((or (consp many) (eq many 0))
(let ((xdata (calc-graph-lookup (calc-top-n 2)))
(ylist (calc-top-n 1)))
(or (eq (car-safe ylist) 'vec)
(error "Y argument must be a vector"))
(while (setq ylist (cdr ylist))
(calc-graph-add-curve xdata (calc-graph-lookup (car ylist))))))
((> (setq many (prefix-numeric-value many)) 0)
(let ((xdata (calc-graph-lookup (calc-top-n (1+ many)))))
(while (> many 0)
(calc-graph-add-curve xdata
(calc-graph-lookup (calc-top-n many)))
(setq many (1- many)))))
(t
(let (pair)
(setq many (- many))
(while (> many 0)
(setq pair (calc-top-n many))
(or (and (eq (car-safe pair) 'vec)
(= (length pair) 3))
(error "Argument must be an [x,y] vector"))
(calc-graph-add-curve (calc-graph-lookup (nth 1 pair))
(calc-graph-lookup (nth 2 pair)))
(setq many (1- many))))))
(calc-graph-view-commands)))
(defun calc-graph-add-3d (many)
(interactive "P")
(calc-wrapper
(calc-graph-init)
(cond ((null many)
(calc-graph-add-curve (calc-graph-lookup (calc-top-n 3))
(calc-graph-lookup (calc-top-n 2))
(calc-graph-lookup (calc-top-n 1))))
((or (consp many) (eq many 0))
(let ((xdata (calc-graph-lookup (calc-top-n 3)))
(ydata (calc-graph-lookup (calc-top-n 2)))
(zlist (calc-top-n 1)))
(or (eq (car-safe zlist) 'vec)
(error "Z argument must be a vector"))
(while (setq zlist (cdr zlist))
(calc-graph-add-curve xdata ydata
(calc-graph-lookup (car zlist))))))
((> (setq many (prefix-numeric-value many)) 0)
(let ((xdata (calc-graph-lookup (calc-top-n (+ many 2))))
(ydata (calc-graph-lookup (calc-top-n (+ many 1)))))
(while (> many 0)
(calc-graph-add-curve xdata ydata
(calc-graph-lookup (calc-top-n many)))
(setq many (1- many)))))
(t
(let (curve)
(setq many (- many))
(while (> many 0)
(setq curve (calc-top-n many))
(or (and (eq (car-safe curve) 'vec)
(= (length curve) 4))
(error "Argument must be an [x,y,z] vector"))
(calc-graph-add-curve (calc-graph-lookup (nth 1 curve))
(calc-graph-lookup (nth 2 curve))
(calc-graph-lookup (nth 3 curve)))
(setq many (1- many))))))
(calc-graph-view-commands)))
(defun calc-graph-add-curve (xdata ydata &optional zdata)
(let ((num (calc-graph-count-curves))
(pstyle (calc-var-value 'var-PointStyles))
(lstyle (calc-var-value 'var-LineStyles)))
(save-excursion
(set-buffer calc-gnuplot-input)
(goto-char (point-min))
(if (re-search-forward (if zdata "^plot[ \t]" "^splot[ \t]")
nil t)
(error "Can't mix 2d and 3d curves on one graph"))
(if (re-search-forward "^s?plot[ \t]" nil t)
(progn
(end-of-line)
(insert ", "))
(goto-char (point-max))
(or (eq (preceding-char) ?\n)
(insert "\n"))
(insert (if zdata "splot" "plot") " \n")
(forward-char -1))
(insert "{" (symbol-name (nth 1 xdata))
":" (symbol-name (nth 1 ydata)))
(if zdata
(insert ":" (symbol-name (nth 1 zdata))))
(insert "} "
"title \"" (symbol-name (nth 1 ydata)) "\" "
"with dots")
(setq pstyle (and (eq (car-safe pstyle) 'vec) (nth (1+ num) pstyle)))
(setq lstyle (and (eq (car-safe lstyle) 'vec) (nth (1+ num) lstyle)))
(calc-graph-set-styles
(or (and (Math-num-integerp lstyle) (math-trunc lstyle))
0)
(or (and (Math-num-integerp pstyle) (math-trunc pstyle))
(if (eq (car-safe (calc-var-value (nth 2 ydata))) 'vec)
0 -1))))))
(defun calc-graph-lookup (thing)
(if (and (eq (car-safe thing) 'var)
(calc-var-value (nth 2 thing)))
thing
(let ((found (assoc thing calc-graph-var-cache)))
(or found
(progn
(setq varname (concat "PlotData"
(int-to-string
(1+ (length calc-graph-var-cache))))
var (list 'var (intern varname)
(intern (concat "var-" varname)))
found (cons thing var)
calc-graph-var-cache (cons found calc-graph-var-cache))
(set (nth 2 var) thing)))
(cdr found))))
(defun calc-graph-juggle (arg)
(interactive "p")
(calc-graph-init)
(save-excursion
(set-buffer calc-gnuplot-input)
(if (< arg 0)
(let ((num (calc-graph-count-curves)))
(if (> num 0)
(while (< arg 0)
(setq arg (+ arg num))))))
(while (>= (setq arg (1- arg)) 0)
(calc-graph-do-juggle))))
(defun calc-graph-count-curves ()
(save-excursion
(set-buffer calc-gnuplot-input)
(if (re-search-forward "^s?plot[ \t]" nil t)
(let ((num 1))
(goto-char (point-min))
(while (search-forward "," nil t)
(setq num (1+ num)))
num)
0)))
(defun calc-graph-do-juggle ()
(let (base)
(and (calc-graph-find-plot t t)
(progn
(setq base (point))
(calc-graph-find-plot t nil)
(or (eq base (point))
(let ((str (buffer-substring (+ (point) 2) (1- (point-max)))))
(delete-region (point) (1- (point-max)))
(goto-char (+ base 5))
(insert str ", ")))))))
(defun calc-graph-print (flag)
(interactive "P")
(calc-graph-plot flag t))
(defun calc-graph-plot (flag &optional printing)
(interactive "P")
(calc-slow-wrapper
(let ((calcbuf (current-buffer))
(tempbuf (get-buffer-create "*Gnuplot Temp-2*"))
(tempbuftop 1)
(tempoutfile nil)
(curve-num 0)
(refine (and flag (> (prefix-numeric-value flag) 0)))
(recompute (and flag (< (prefix-numeric-value flag) 0)))
(surprise-splot nil)
(tty-output nil)
cache-env is-splot device output resolution precision samples-pos)
(or (boundp 'calc-graph-prev-kill-hook)
(if calc-emacs-type-19
(progn
(setq calc-graph-prev-kill-hook nil)
(add-hook 'kill-emacs-hook 'calc-graph-kill-hook))
(setq calc-graph-prev-kill-hook kill-emacs-hook)
(setq kill-emacs-hook 'calc-graph-kill-hook)))
(save-excursion
(calc-graph-init)
(set-buffer tempbuf)
(erase-buffer)
(set-buffer calc-gnuplot-input)
(goto-char (point-min))
(setq is-splot (re-search-forward "^splot[ \t]" nil t))
(let ((str (buffer-string))
(ver calc-gnuplot-version))
(set-buffer (get-buffer-create "*Gnuplot Temp*"))
(erase-buffer)
(insert "# (Note: This is a temporary copy---do not edit!)\n")
(if (>= ver 2)
(insert "set noarrow\nset nolabel\n"
"set autoscale xy\nset nologscale xy\n"
"set xlabel\nset ylabel\nset title\n"
"set noclip points\nset clip one\nset clip two\n"
"set format \"%g\"\nset tics\nset xtics\nset ytics\n"
"set data style linespoints\n"
"set nogrid\nset nokey\nset nopolar\n"))
(if (>= ver 3)
(insert "set surface\nset nocontour\n"
"set " (if is-splot "" "no") "parametric\n"
"set notime\nset border\nset ztics\nset zeroaxis\n"
"set view 60,30,1,1\nset offsets 0,0,0,0\n"))
(setq samples-pos (point))
(insert "\n\n" str))
(goto-char (point-min))
(if is-splot
(if refine
(error "This option works only for 2d plots")
(setq recompute t)))
(let ((calc-gnuplot-input (current-buffer))
(calc-graph-no-auto-view t))
(if printing
(setq device calc-gnuplot-print-device
output calc-gnuplot-print-output)
(setq device (calc-graph-find-command "terminal")
output (calc-graph-find-command "output"))
(or device
(setq device calc-gnuplot-default-device))
(if output
(setq output (car (read-from-string output)))
(setq output calc-gnuplot-default-output)))
(if (or (equal device "") (equal device "default"))
(setq device (if printing
"postscript"
(if (or (eq window-system 'x) (getenv "DISPLAY"))
"x11"
(if (>= calc-gnuplot-version 3)
"dumb" "postscript")))))
(if (equal device "dumb")
(setq device (format "dumb %d %d"
(1- (frame-width)) (1- (frame-height)))))
(if (equal device "big")
(setq device (format "dumb %d %d"
(* 4 (- (frame-width) 3))
(* 4 (- (frame-height) 3)))))
(if (stringp output)
(if (or (equal output "auto")
(and (equal output "tty") (setq tty-output t)))
(setq tempoutfile (calc-temp-file-name -1)
output tempoutfile))
(setq output (eval output)))
(or (equal device calc-graph-last-device)
(progn
(setq calc-graph-last-device device)
(calc-gnuplot-command "set terminal" device)))
(or (equal output calc-graph-last-output)
(progn
(setq calc-graph-last-output output)
(calc-gnuplot-command "set output"
(if (equal output "STDOUT")
""
(prin1-to-string output)))))
(setq resolution (calc-graph-find-command "samples"))
(if resolution
(setq resolution (string-to-int resolution))
(setq resolution (if is-splot
calc-graph-default-resolution-3d
calc-graph-default-resolution)))
(setq precision (calc-graph-find-command "precision"))
(if precision
(setq precision (string-to-int precision))
(setq precision calc-graph-default-precision))
(calc-graph-set-command "terminal")
(calc-graph-set-command "output")
(calc-graph-set-command "samples")
(calc-graph-set-command "precision"))
(goto-char samples-pos)
(insert "set samples " (int-to-string (max (if is-splot 20 200)
(+ 5 resolution))) "\n")
(while (re-search-forward "{\\*[^}]+}[^,\n]*" nil t)
(delete-region (match-beginning 0) (match-end 0))
(if (looking-at ",")
(delete-char 1)
(while (memq (preceding-char) '(?\ ?\t))
(forward-char -1))
(if (eq (preceding-char) ?\,)
(delete-backward-char 1))))
(save-excursion
(set-buffer calcbuf)
(setq cache-env (list calc-angle-mode
calc-complex-mode
calc-simplify-mode
calc-infinite-mode
calc-word-size
precision is-splot))
(if (and (not recompute)
(equal (cdr (car calc-graph-data-cache)) cache-env))
(while (> (length calc-graph-data-cache)
calc-graph-data-cache-limit)
(setcdr calc-graph-data-cache
(cdr (cdr calc-graph-data-cache))))
(setq calc-graph-data-cache (list (cons nil cache-env)))))
(calc-graph-find-plot t t)
(while (re-search-forward
(if is-splot
"{\\([^{}:\n]+\\):\\([^{}:\n]+\\):\\([^{}:\n]+\\)}"
"{\\([^{}:\n]+\\)\\(:\\)\\([^{}:\n]+\\)}")
nil t)
(setq curve-num (1+ curve-num))
(let* ((xname (buffer-substring (match-beginning 1) (match-end 1)))
(xvar (intern (concat "var-" xname)))
(xvalue (math-evaluate-expr (calc-var-value xvar)))
(y3name (and is-splot
(buffer-substring (match-beginning 2)
(match-end 2))))
(y3var (and is-splot (intern (concat "var-" y3name))))
(y3value (and is-splot (calc-var-value y3var)))
(yname (buffer-substring (match-beginning 3) (match-end 3)))
(yvar (intern (concat "var-" yname)))
(yvalue (calc-var-value yvar))
filename)
(delete-region (match-beginning 0) (match-end 0))
(setq filename (calc-temp-file-name curve-num))
(save-excursion
(set-buffer calcbuf)
(let (tempbuftop
(xp xvalue)
(yp yvalue)
(zp nil)
(xlow nil) (xhigh nil) (y3low nil) (y3high nil)
xvec xval xstep var-DUMMY
y3vec y3val y3step var-DUMMY2 (zval nil)
yvec yval ycache ycacheptr yvector
numsteps numsteps3
(keep-file (and (not is-splot) (file-exists-p filename)))
(stepcount 0)
(calc-symbolic-mode nil)
(calc-prefer-frac nil)
(calc-internal-prec (max 3 precision))
(calc-simplify-mode (and (not (memq calc-simplify-mode
'(none num)))
calc-simplify-mode))
(blank t)
(non-blank nil)
(math-working-step 0)
(math-working-step-2 nil))
(save-excursion
(if is-splot
(calc-graph-compute-3d)
(calc-graph-compute-2d))
(set-buffer tempbuf)
(goto-char (point-max))
(insert "\n" xname)
(if is-splot
(insert ":" y3name))
(insert ":" yname "\n\n")
(setq tempbuftop (point))
(let ((calc-group-digits nil)
(calc-leading-zeros nil)
(calc-number-radix 10)
(entry (and (not is-splot)
(list xp yp xhigh numsteps))))
(or (equal entry
(nth 1 (nth (1+ curve-num)
calc-graph-file-cache)))
(setq keep-file nil))
(setcar (cdr (nth (1+ curve-num) calc-graph-file-cache))
entry)
(or keep-file
(calc-graph-format-data)))
(or keep-file
(progn
(or non-blank
(error "No valid data points for %s:%s"
xname yname))
(write-region tempbuftop (point-max) filename
nil 'quiet))))))
(insert (prin1-to-string filename))))
(if surprise-splot
(setcdr cache-env nil))
(if (= curve-num 0)
(progn
(calc-gnuplot-command "clear")
(calc-clear-command-flag 'clear-message)
(message "No data to plot!"))
(setq calc-graph-data-cache-limit (max curve-num
calc-graph-data-cache-limit)
filename (calc-temp-file-name 0))
(write-region (point-min) (point-max) filename nil 'quiet)
(calc-gnuplot-command "load" (prin1-to-string filename))
(or (equal output "STDOUT")
calc-gnuplot-keep-outfile
(progn ; need to close the output file before printing/plotting
(setq calc-graph-last-output "STDOUT")
(calc-gnuplot-command "set output")))
(let ((command (if printing
calc-gnuplot-print-command
(or calc-gnuplot-plot-command
(and (string-match "^dumb" device)
'calc-graph-show-dumb)
(and tty-output
'calc-graph-show-tty)))))
(if command
(if (stringp command)
(calc-gnuplot-command
"!" (format command
(or tempoutfile
calc-gnuplot-print-output)))
(if (symbolp command)
(funcall command output)
(eval command))))))))))
(defun calc-graph-compute-2d ()
(if (setq yvec (eq (car-safe yvalue) 'vec))
(if (= (setq numsteps (1- (length yvalue))) 0)
(error "Can't plot an empty vector")
(if (setq xvec (eq (car-safe xvalue) 'vec))
(or (= (1- (length xvalue)) numsteps)
(error "%s and %s have different lengths" xname yname))
(if (and (eq (car-safe xvalue) 'intv)
(math-constp xvalue))
(setq xstep (math-div (math-sub (nth 3 xvalue)
(nth 2 xvalue))
(1- numsteps))
xvalue (nth 2 xvalue))
(if (math-realp xvalue)
(setq xstep 1)
(error "%s is not a suitable basis for %s" xname yname)))))
(or (math-realp yvalue)
(let ((arglist nil))
(setq yvalue (math-evaluate-expr yvalue))
(calc-default-formula-arglist yvalue)
(or arglist
(error "%s does not contain any unassigned variables" yname))
(and (cdr arglist)
(error "%s contains more than one variable: %s"
yname arglist))
(setq yvalue (math-expr-subst yvalue
(math-build-var-name (car arglist))
'(var DUMMY var-DUMMY)))))
(setq ycache (assoc yvalue calc-graph-data-cache))
(delq ycache calc-graph-data-cache)
(nconc calc-graph-data-cache
(list (or ycache (setq ycache (list yvalue)))))
(if (and (not (setq xvec (eq (car-safe xvalue) 'vec)))
refine (cdr (cdr ycache)))
(calc-graph-refine-2d)
(calc-graph-recompute-2d))))
(defun calc-graph-refine-2d ()
(setq keep-file nil
ycacheptr (cdr ycache))
(if (and (setq xval (calc-graph-find-command "xrange"))
(string-match "\\`\\[\\([0-9.eE+-]*\\):\\([0-9.eE+-]*\\)\\]\\'"
xval))
(let ((b2 (match-beginning 2))
(e2 (match-end 2)))
(setq xlow (math-read-number (substring xval
(match-beginning 1)
(match-end 1)))
xhigh (math-read-number (substring xval b2 e2))))
(if xlow
(while (and (cdr ycacheptr)
(Math-lessp (car (nth 1 ycacheptr)) xlow))
(setq ycacheptr (cdr ycacheptr)))))
(setq math-working-step-2 (1- (length ycacheptr)))
(while (and (cdr ycacheptr)
(or (not xhigh)
(Math-lessp (car (car ycacheptr)) xhigh)))
(setq var-DUMMY (math-div (math-add (car (car ycacheptr))
(car (nth 1 ycacheptr)))
2)
math-working-step (1+ math-working-step)
yval (math-evaluate-expr yvalue))
(setcdr ycacheptr (cons (cons var-DUMMY yval)
(cdr ycacheptr)))
(setq ycacheptr (cdr (cdr ycacheptr))))
(setq yp ycache
numsteps 1000000))
(defun calc-graph-recompute-2d ()
(setq ycacheptr ycache)
(if xvec
(setq numsteps (1- (length xvalue))
yvector nil)
(if (and (eq (car-safe xvalue) 'intv)
(math-constp xvalue))
(setq numsteps resolution
yp nil
xlow (nth 2 xvalue)
xhigh (nth 3 xvalue)
xstep (math-div (math-sub xhigh xlow)
(1- numsteps))
xvalue (nth 2 xvalue))
(error "%s is not a suitable basis for %s"
xname yname)))
(setq math-working-step-2 numsteps)
(while (>= (setq numsteps (1- numsteps)) 0)
(setq math-working-step (1+ math-working-step))
(if xvec
(progn
(setq xp (cdr xp)
xval (car xp))
(and (not (eq ycacheptr ycache))
(consp (car ycacheptr))
(not (Math-lessp (car (car ycacheptr)) xval))
(setq ycacheptr ycache)))
(if (= numsteps 0)
(setq xval xhigh) ; avoid cumulative roundoff
(setq xval xvalue
xvalue (math-add xvalue xstep))))
(while (and (cdr ycacheptr)
(Math-lessp (car (nth 1 ycacheptr)) xval))
(setq ycacheptr (cdr ycacheptr)))
(or (and (cdr ycacheptr)
(Math-equal (car (nth 1 ycacheptr)) xval))
(progn
(setq keep-file nil
var-DUMMY xval)
(setcdr ycacheptr (cons (cons xval (math-evaluate-expr yvalue))
(cdr ycacheptr)))))
(setq ycacheptr (cdr ycacheptr))
(if xvec
(setq yvector (cons (cdr (car ycacheptr)) yvector))
(or yp (setq yp ycacheptr))))
(if xvec
(setq xp xvalue
yvec t
yp (cons 'vec (nreverse yvector))
numsteps (1- (length xp)))
(setq numsteps 1000000)))
(defun calc-graph-compute-3d ()
(if (setq yvec (eq (car-safe yvalue) 'vec))
(if (math-matrixp yvalue)
(progn
(setq numsteps (1- (length yvalue))
numsteps3 (1- (length (nth 1 yvalue))))
(if (eq (car-safe xvalue) 'vec)
(or (= (1- (length xvalue)) numsteps)
(error "%s has wrong length" xname))
(if (and (eq (car-safe xvalue) 'intv)
(math-constp xvalue))
(setq xvalue (calcFunc-index numsteps
(nth 2 xvalue)
(math-div
(math-sub (nth 3 xvalue)
(nth 2 xvalue))
(1- numsteps))))
(if (math-realp xvalue)
(setq xvalue (calcFunc-index numsteps xvalue 1))
(error "%s is not a suitable basis for %s" xname yname))))
(if (eq (car-safe y3value) 'vec)
(or (= (1- (length y3value)) numsteps3)
(error "%s has wrong length" y3name))
(if (and (eq (car-safe y3value) 'intv)
(math-constp y3value))
(setq y3value (calcFunc-index numsteps3
(nth 2 y3value)
(math-div
(math-sub (nth 3 y3value)
(nth 2 y3value))
(1- numsteps3))))
(if (math-realp y3value)
(setq y3value (calcFunc-index numsteps3 y3value 1))
(error "%s is not a suitable basis for %s" y3name yname))))
(setq xp nil
yp nil
zp nil
xvec t)
(while (setq xvalue (cdr xvalue) yvalue (cdr yvalue))
(setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue)))
yp (nconc yp (cons 0 (copy-sequence (cdr y3value))))
zp (nconc zp (cons '(skip)
(copy-sequence (cdr (car yvalue)))))))
(setq numsteps (1- (* numsteps (1+ numsteps3)))))
(if (= (setq numsteps (1- (length yvalue))) 0)
(error "Can't plot an empty vector"))
(or (and (eq (car-safe xvalue) 'vec)
(= (1- (length xvalue)) numsteps))
(error "%s is not a suitable basis for %s" xname yname))
(or (and (eq (car-safe y3value) 'vec)
(= (1- (length y3value)) numsteps))
(error "%s is not a suitable basis for %s" y3name yname))
(setq xp xvalue
yp y3value
zp yvalue
xvec t))
(or (math-realp yvalue)
(let ((arglist nil))
(setq yvalue (math-evaluate-expr yvalue))
(calc-default-formula-arglist yvalue)
(setq arglist (sort arglist 'string-lessp))
(or (cdr arglist)
(error "%s does not contain enough unassigned variables" yname))
(and (cdr (cdr arglist))
(error "%s contains too many variables: %s" yname arglist))
(setq yvalue (math-multi-subst yvalue
(mapcar 'math-build-var-name
arglist)
'((var DUMMY var-DUMMY)
(var DUMMY2 var-DUMMY2))))))
(if (setq xvec (eq (car-safe xvalue) 'vec))
(setq numsteps (1- (length xvalue)))
(if (and (eq (car-safe xvalue) 'intv)
(math-constp xvalue))
(setq numsteps resolution
xvalue (calcFunc-index numsteps
(nth 2 xvalue)
(math-div (math-sub (nth 3 xvalue)
(nth 2 xvalue))
(1- numsteps))))
(error "%s is not a suitable basis for %s"
xname yname)))
(if (setq y3vec (eq (car-safe y3value) 'vec))
(setq numsteps3 (1- (length y3value)))
(if (and (eq (car-safe y3value) 'intv)
(math-constp y3value))
(setq numsteps3 resolution
y3value (calcFunc-index numsteps3
(nth 2 y3value)
(math-div (math-sub (nth 3 y3value)
(nth 2 y3value))
(1- numsteps3))))
(error "%s is not a suitable basis for %s"
y3name yname)))
(setq xp nil
yp nil
zp nil
xvec t)
(setq math-working-step 0)
(while (setq xvalue (cdr xvalue))
(setq xp (nconc xp (make-list (1+ numsteps3) (car xvalue)))
yp (nconc yp (cons 0 (copy-sequence (cdr y3value))))
zp (cons '(skip) zp)
y3step y3value
var-DUMMY (car xvalue)
math-working-step-2 0
math-working-step (1+ math-working-step))
(while (setq y3step (cdr y3step))
(setq math-working-step-2 (1+ math-working-step-2)
var-DUMMY2 (car y3step)
zp (cons (math-evaluate-expr yvalue) zp))))
(setq zp (nreverse zp)
numsteps (1- (* numsteps (1+ numsteps3))))))
(defun calc-graph-format-data ()
(while (<= (setq stepcount (1+ stepcount)) numsteps)
(if xvec
(setq xp (cdr xp)
xval (car xp)
yp (cdr yp)
yval (car yp)
zp (cdr zp)
zval (car zp))
(if yvec
(setq xval xvalue
xvalue (math-add xvalue xstep)
yp (cdr yp)
yval (car yp))
(setq xval (car (car yp))
yval (cdr (car yp))
yp (cdr yp))
(if (or (not yp)
(and xhigh (equal xval xhigh)))
(setq numsteps 0))))
(if is-splot
(if (and (eq (car-safe zval) 'calcFunc-xyz)
(= (length zval) 4))
(setq xval (nth 1 zval)
yval (nth 2 zval)
zval (nth 3 zval)))
(if (and (eq (car-safe yval) 'calcFunc-xyz)
(= (length yval) 4))
(progn
(or surprise-splot
(save-excursion
(set-buffer (get-buffer-create "*Gnuplot Temp*"))
(save-excursion
(goto-char (point-max))
(re-search-backward "^plot[ \t]")
(insert "set parametric\ns")
(setq surprise-splot t))))
(setq xval (nth 1 yval)
zval (nth 3 yval)
yval (nth 2 yval)))
(if (and (eq (car-safe yval) 'calcFunc-xy)
(= (length yval) 3))
(setq xval (nth 1 yval)
yval (nth 2 yval)))))
(if (and (Math-realp xval)
(Math-realp yval)
(or (not zval) (Math-realp zval)))
(progn
(setq blank nil
non-blank t)
(if (Math-integerp xval)
(insert (math-format-number xval))
(if (eq (car xval) 'frac)
(setq xval (math-float xval)))
(insert (math-format-number (nth 1 xval))
"e" (int-to-string (nth 2 xval))))
(insert " ")
(if (Math-integerp yval)
(insert (math-format-number yval))
(if (eq (car yval) 'frac)
(setq yval (math-float yval)))
(insert (math-format-number (nth 1 yval))
"e" (int-to-string (nth 2 yval))))
(if zval
(progn
(insert " ")
(if (Math-integerp zval)
(insert (math-format-number zval))
(if (eq (car zval) 'frac)
(setq zval (math-float zval)))
(insert (math-format-number (nth 1 zval))
"e" (int-to-string (nth 2 zval))))))
(insert "\n"))
(and (not (equal zval '(skip)))
(boundp 'var-PlotRejects)
(eq (car-safe var-PlotRejects) 'vec)
(nconc var-PlotRejects
(list (list 'vec
curve-num
stepcount
xval yval)))
(calc-refresh-evaltos 'var-PlotRejects))
(or blank
(progn
(insert "\n")
(setq blank t))))))
(defun calc-temp-file-name (num)
(while (<= (length calc-graph-file-cache) (1+ num))
(setq calc-graph-file-cache (nconc calc-graph-file-cache (list nil))))
(car (or (nth (1+ num) calc-graph-file-cache)
(setcar (nthcdr (1+ num) calc-graph-file-cache)
(list (make-temp-file
(concat calc-gnuplot-tempfile
(if (<= num 0)
(char-to-string (- ?A num))
(int-to-string num))))
nil)))))
(defun calc-graph-delete-temps ()
(while calc-graph-file-cache
(and (car calc-graph-file-cache)
(file-exists-p (car (car calc-graph-file-cache)))
(condition-case err
(delete-file (car (car calc-graph-file-cache)))
(error nil)))
(setq calc-graph-file-cache (cdr calc-graph-file-cache))))
(defun calc-graph-kill-hook ()
(calc-graph-delete-temps)
(if calc-graph-prev-kill-hook
(funcall calc-graph-prev-kill-hook)))
(defun calc-graph-show-tty (output)
"Default calc-gnuplot-plot-command for \"tty\" output mode.
This is useful for tek40xx and other graphics-terminal types."
(call-process-region 1 1 shell-file-name
nil calc-gnuplot-buffer nil
"-c" (format "cat %s >/dev/tty; rm %s" output output)))
(defun calc-graph-show-dumb (&optional output)
"Default calc-gnuplot-plot-command for Pinard's \"dumb\" terminal type.
This \"dumb\" driver will be present in Gnuplot 3.0."
(interactive)
(save-window-excursion
(switch-to-buffer calc-gnuplot-buffer)
(delete-other-windows)
(goto-char calc-gnuplot-trail-mark)
(or (search-forward "\f" nil t)
(sleep-for 1))
(goto-char (point-max))
(re-search-backward "\f\\|^[ \t]+\\^$\\|G N U P L O T")
(setq found-pt (point))
(if (looking-at "\f")
(progn
(forward-char 1)
(if (eolp) (forward-line 1))
(or (calc-graph-find-command "time")
(calc-graph-find-command "title")
(calc-graph-find-command "ylabel")
(let ((pt (point)))
(insert-before-markers (format "(%s)" (current-time-string)))
(goto-char pt)))
(set-window-start (selected-window) (point))
(goto-char (point-max)))
(end-of-line)
(backward-char 1)
(recenter '(4)))
(or (boundp 'calc-dumb-map)
(progn
(setq calc-dumb-map (make-sparse-keymap))
(define-key calc-dumb-map "\n" 'scroll-up)
(define-key calc-dumb-map " " 'scroll-up)
(define-key calc-dumb-map "\177" 'scroll-down)
(define-key calc-dumb-map "<" 'scroll-left)
(define-key calc-dumb-map ">" 'scroll-right)
(define-key calc-dumb-map "{" 'scroll-down)
(define-key calc-dumb-map "}" 'scroll-up)
(define-key calc-dumb-map "q" 'exit-recursive-edit)
(define-key calc-dumb-map "\C-c\C-c" 'exit-recursive-edit)))
(use-local-map calc-dumb-map)
(setq truncate-lines t)
(message "Type `q'%s to return to Calc"
(if (eq (lookup-key (current-global-map) "\e#") 'calc-dispatch)
" or `M-# M-#'" ""))
(recursive-edit)
(bury-buffer "*Gnuplot Trail*")))
(defun calc-graph-clear ()
(interactive)
(if calc-graph-last-device
(if (or (equal calc-graph-last-device "x11")
(equal calc-graph-last-device "X11"))
(calc-gnuplot-command "set output"
(if (equal calc-graph-last-output "STDOUT")
""
(prin1-to-string calc-graph-last-output)))
(calc-gnuplot-command "clear"))))
(defun calc-graph-title-x (title)
(interactive "sX axis title: ")
(calc-graph-set-command "xlabel" (if (not (equal title ""))
(prin1-to-string title))))
(defun calc-graph-title-y (title)
(interactive "sY axis title: ")
(calc-graph-set-command "ylabel" (if (not (equal title ""))
(prin1-to-string title))))
(defun calc-graph-title-z (title)
(interactive "sZ axis title: ")
(calc-graph-set-command "zlabel" (if (not (equal title ""))
(prin1-to-string title))))
(defun calc-graph-range-x (range)
(interactive "sX axis range: ")
(calc-graph-set-range "xrange" range))
(defun calc-graph-range-y (range)
(interactive "sY axis range: ")
(calc-graph-set-range "yrange" range))
(defun calc-graph-range-z (range)
(interactive "sZ axis range: ")
(calc-graph-set-range "zrange" range))
(defun calc-graph-set-range (cmd range)
(if (equal range "$")
(calc-wrapper
(let ((val (calc-top-n 1)))
(if (and (eq (car-safe val) 'intv) (math-constp val))
(setq range (concat
(math-format-number (math-float (nth 2 val))) ":"
(math-format-number (math-float (nth 3 val)))))
(if (and (eq (car-safe val) 'vec)
(= (length val) 3))
(setq range (concat
(math-format-number (math-float (nth 1 val))) ":"
(math-format-number (math-float (nth 2 val)))))
(error "Range specification must be an interval or 2-vector")))
(calc-pop-stack 1))))
(if (string-match "\\[.+\\]" range)
(setq range (substring range 1 -1)))
(if (and (not (string-match ":" range))
(or (string-match "," range)
(string-match " " range)))
(aset range (match-beginning 0) ?\:))
(calc-graph-set-command cmd (if (not (equal range ""))
(concat "[" range "]"))))
(defun calc-graph-log-x (flag)
(interactive "P")
(calc-graph-set-log flag 0 0))
(defun calc-graph-log-y (flag)
(interactive "P")
(calc-graph-set-log 0 flag 0))
(defun calc-graph-log-z (flag)
(interactive "P")
(calc-graph-set-log 0 0 flag))
(defun calc-graph-set-log (xflag yflag zflag)
(let* ((old (or (calc-graph-find-command "logscale") ""))
(xold (string-match "x" old))
(yold (string-match "y" old))
(zold (string-match "z" old))
str)
(setq str (concat (if (if xflag
(if (eq xflag 0) xold
(> (prefix-numeric-value xflag) 0))
(not xold)) "x" "")
(if (if yflag
(if (eq yflag 0) yold
(> (prefix-numeric-value yflag) 0))
(not yold)) "y" "")
(if (if zflag
(if (eq zflag 0) zold
(> (prefix-numeric-value zflag) 0))
(not zold)) "z" "")))
(calc-graph-set-command "logscale" (if (not (equal str "")) str))))
(defun calc-graph-line-style (style)
(interactive "P")
(calc-graph-set-styles (and style (prefix-numeric-value style)) t))
(defun calc-graph-point-style (style)
(interactive "P")
(calc-graph-set-styles t (and style (prefix-numeric-value style))))
(defun calc-graph-set-styles (lines points)
(calc-graph-init)
(save-excursion
(set-buffer calc-gnuplot-input)
(or (calc-graph-find-plot nil nil)
(error "No data points have been set!"))
(let ((base (point))
(mode nil) (lstyle nil) (pstyle nil)
start end lenbl penbl)
(re-search-forward "[,\n]")
(forward-char -1)
(setq end (point) start end)
(goto-char base)
(if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+with\\)")
(progn
(setq start (match-beginning 1))
(goto-char (match-end 0))
(if (looking-at "[ \t]+\\([a-z]+\\)")
(setq mode (buffer-substring (match-beginning 1)
(match-end 1))))
(if (looking-at "[ \ta-z]+\\([0-9]+\\)")
(setq lstyle (string-to-int
(buffer-substring (match-beginning 1)
(match-end 1)))))
(if (looking-at "[ \ta-z]+[0-9]+[ \t]+\\([0-9]+\\)")
(setq pstyle (string-to-int
(buffer-substring (match-beginning 1)
(match-end 1)))))))
(setq lenbl (or (equal mode "lines") (equal mode "linespoints"))
penbl (or (equal mode "points") (equal mode "linespoints")))
(if lines
(or (eq lines t)
(setq lstyle lines
lenbl (>= lines 0)))
(setq lenbl (not lenbl)))
(if points
(or (eq points t)
(setq pstyle points
penbl (>= points 0)))
(setq penbl (not penbl)))
(delete-region start end)
(goto-char start)
(insert " with "
(if lenbl
(if penbl "linespoints" "lines")
(if penbl "points" "dots")))
(if (and pstyle (> pstyle 0))
(insert " " (if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
" " (int-to-string pstyle))
(if (and lstyle (> lstyle 0))
(insert " " (int-to-string lstyle))))))
(calc-graph-view-commands))
(defun calc-graph-zero-x (flag)
(interactive "P")
(calc-graph-set-command "noxzeroaxis"
(and (if flag
(<= (prefix-numeric-value flag) 0)
(not (calc-graph-find-command "noxzeroaxis")))
" ")))
(defun calc-graph-zero-y (flag)
(interactive "P")
(calc-graph-set-command "noyzeroaxis"
(and (if flag
(<= (prefix-numeric-value flag) 0)
(not (calc-graph-find-command "noyzeroaxis")))
" ")))
(defun calc-graph-name (name)
(interactive "sTitle for current curve: ")
(calc-graph-init)
(save-excursion
(set-buffer calc-gnuplot-input)
(or (calc-graph-find-plot nil nil)
(error "No data points have been set!"))
(let ((base (point))
start)
(re-search-forward "[,\n]\\|[ \t]+with")
(setq end (match-beginning 0))
(goto-char base)
(if (looking-at "[^,\n]*[^,\n \t]\\([ \t]+title\\)")
(progn
(goto-char (match-beginning 1))
(delete-region (point) end))
(goto-char end))
(insert " title " (prin1-to-string name))))
(calc-graph-view-commands))
(defun calc-graph-hide (flag)
(interactive "P")
(calc-graph-init)
(and (calc-graph-find-plot nil nil)
(progn
(or (looking-at "{")
(error "Can't hide this curve (wrong format)"))
(forward-char 1)
(if (looking-at "*")
(if (or (null flag) (<= (prefix-numeric-value flag) 0))
(delete-char 1))
(if (or (null flag) (> (prefix-numeric-value flag) 0))
(insert "*"))))))
(defun calc-graph-header (title)
(interactive "sTitle for entire graph: ")
(calc-graph-set-command "title" (if (not (equal title ""))
(prin1-to-string title))))
(defun calc-graph-border (flag)
(interactive "P")
(calc-graph-set-command "noborder"
(and (if flag
(<= (prefix-numeric-value flag) 0)
(not (calc-graph-find-command "noborder")))
" ")))
(defun calc-graph-grid (flag)
(interactive "P")
(calc-graph-set-command "grid" (and (if flag
(> (prefix-numeric-value flag) 0)
(not (calc-graph-find-command "grid")))
" ")))
(defun calc-graph-key (flag)
(interactive "P")
(calc-graph-set-command "key" (and (if flag
(> (prefix-numeric-value flag) 0)
(not (calc-graph-find-command "key")))
" ")))
(defun calc-graph-num-points (res flag)
(interactive "sNumber of data points: \nP")
(if flag
(if (> (prefix-numeric-value flag) 0)
(if (equal res "")
(message "Default resolution is %d"
calc-graph-default-resolution)
(setq calc-graph-default-resolution (string-to-int res)))
(if (equal res "")
(message "Default 3D resolution is %d"
calc-graph-default-resolution-3d)
(setq calc-graph-default-resolution-3d (string-to-int res))))
(calc-graph-set-command "samples" (if (not (equal res "")) res))))
(defun calc-graph-device (name flag)
(interactive "sDevice name: \nP")
(if (equal name "?")
(progn
(calc-gnuplot-command "set terminal")
(calc-graph-view-trail))
(if flag
(if (> (prefix-numeric-value flag) 0)
(if (equal name "")
(message "Default GNUPLOT device is \"%s\""
calc-gnuplot-default-device)
(setq calc-gnuplot-default-device name))
(if (equal name "")
(message "GNUPLOT device for Print command is \"%s\""
calc-gnuplot-print-device)
(setq calc-gnuplot-print-device name)))
(calc-graph-set-command "terminal" (if (not (equal name ""))
name)))))
(defun calc-graph-output (name flag)
(interactive "FOutput file name: \np")
(cond ((string-match "\\<[aA][uU][tT][oO]$" name)
(setq name "auto"))
((string-match "\\<[tT][tT][yY]$" name)
(setq name "tty"))
((string-match "\\<[sS][tT][dD][oO][uU][tT]$" name)
(setq name "STDOUT"))
((equal (file-name-nondirectory name) "")
(setq name ""))
(t (setq name (expand-file-name name))))
(if flag
(if (> (prefix-numeric-value flag) 0)
(if (equal name "")
(message "Default GNUPLOT output file is \"%s\""
calc-gnuplot-default-output)
(setq calc-gnuplot-default-output name))
(if (equal name "")
(message "GNUPLOT output file for Print command is \"%s\""
calc-gnuplot-print-output)
(setq calc-gnuplot-print-output name)))
(calc-graph-set-command "output" (if (not (equal name ""))
(prin1-to-string name)))))
(defun calc-graph-display (name)
(interactive "sX display name: ")
(if (equal name "")
(message "Current X display is \"%s\""
(or calc-gnuplot-display "<none>"))
(setq calc-gnuplot-display name)
(if (calc-gnuplot-alive)
(calc-gnuplot-command "exit"))))
(defun calc-graph-geometry (name)
(interactive "sX geometry spec (or \"default\"): ")
(if (equal name "")
(message "Current X geometry is \"%s\""
(or calc-gnuplot-geometry "default"))
(setq calc-gnuplot-geometry (and (not (equal name "default")) name))
(if (calc-gnuplot-alive)
(calc-gnuplot-command "exit"))))
(defun calc-graph-find-command (cmd)
(calc-graph-init)
(save-excursion
(set-buffer calc-gnuplot-input)
(goto-char (point-min))
(if (re-search-forward (concat "^set[ \t]+" cmd "[ \t]*\\(.*\\)$") nil t)
(buffer-substring (match-beginning 1) (match-end 1)))))
(defun calc-graph-set-command (cmd &rest args)
(calc-graph-init)
(save-excursion
(set-buffer calc-gnuplot-input)
(goto-char (point-min))
(if (re-search-forward (concat "^set[ \t]+" cmd "[ \t\n]") nil t)
(progn
(forward-char -1)
(end-of-line)
(let ((end (point)))
(beginning-of-line)
(delete-region (point) (1+ end))))
(if (calc-graph-find-plot t t)
(if (eq (preceding-char) ?\n)
(forward-char -1))
(goto-char (1- (point-max)))))
(if (and args (car args))
(progn
(or (bolp)
(insert "\n"))
(insert "set " (mapconcat 'identity (cons cmd args) " ") "\n"))))
(calc-graph-view-commands))
(defun calc-graph-command (cmd)
(interactive "sGNUPLOT command: ")
(calc-wrapper
(calc-graph-init)
(calc-graph-view-trail)
(calc-gnuplot-command cmd)
(accept-process-output)
(calc-graph-view-trail)))
(defun calc-graph-kill (&optional no-view)
(interactive)
(calc-graph-delete-temps)
(if (calc-gnuplot-alive)
(calc-wrapper
(or no-view (calc-graph-view-trail))
(let ((calc-graph-no-wait t))
(calc-gnuplot-command "exit"))
(sit-for 1)
(if (process-status calc-gnuplot-process)
(delete-process calc-gnuplot-process))
(setq calc-gnuplot-process nil))))
(defun calc-graph-quit ()
(interactive)
(if (get-buffer-window calc-gnuplot-input)
(calc-graph-view-commands t))
(if (get-buffer-window calc-gnuplot-buffer)
(calc-graph-view-trail t))
(calc-graph-kill t))
(defun calc-graph-view-commands (&optional no-need)
(interactive "p")
(or calc-graph-no-auto-view (calc-graph-init-buffers))
(calc-graph-view calc-gnuplot-input calc-gnuplot-buffer (null no-need)))
(defun calc-graph-view-trail (&optional no-need)
(interactive "p")
(or calc-graph-no-auto-view (calc-graph-init-buffers))
(calc-graph-view calc-gnuplot-buffer calc-gnuplot-input (null no-need)))
(defun calc-graph-view (buf other-buf need)
(let (win)
(or calc-graph-no-auto-view
(if (setq win (get-buffer-window buf))
(or need
(and (eq buf calc-gnuplot-buffer)
(save-excursion
(set-buffer buf)
(not (pos-visible-in-window-p (point-max) win))))
(progn
(bury-buffer buf)
(bury-buffer other-buf)
(let ((curwin (selected-window)))
(select-window win)
(switch-to-buffer nil)
(select-window curwin))))
(if (setq win (get-buffer-window other-buf))
(set-window-buffer win buf)
(if (eq major-mode 'calc-mode)
(if (or need
(< (window-height) (1- (frame-height))))
(display-buffer buf))
(switch-to-buffer buf)))))
(save-excursion
(set-buffer buf)
(if (and (eq buf calc-gnuplot-buffer)
(setq win (get-buffer-window buf))
(not (pos-visible-in-window-p (point-max) win)))
(progn
(goto-char (point-max))
(vertical-motion (- 6 (window-height win)))
(set-window-start win (point))
(goto-char (point-max)))))
(or calc-graph-no-auto-view (sit-for 0))))
(defun calc-gnuplot-check-for-errors ()
(if (save-excursion
(prog2
(progn
(set-buffer calc-gnuplot-buffer)
(goto-char calc-gnuplot-last-error-pos))
(re-search-forward "^[ \t]+\\^$" nil t)
(goto-char (point-max))
(setq calc-gnuplot-last-error-pos (point-max))))
(calc-graph-view-trail)))
(defun calc-gnuplot-command (&rest args)
(calc-graph-init)
(let ((cmd (concat (mapconcat 'identity args " ") "\n")))
(accept-process-output)
(save-excursion
(set-buffer calc-gnuplot-buffer)
(calc-gnuplot-check-for-errors)
(goto-char (point-max))
(setq calc-gnuplot-trail-mark (point))
(or (>= calc-gnuplot-version 3)
(insert cmd))
(set-marker (process-mark calc-gnuplot-process) (point))
(process-send-string calc-gnuplot-process cmd)
(if (get-buffer-window calc-gnuplot-buffer)
(calc-graph-view-trail))
(accept-process-output (and (not calc-graph-no-wait)
calc-gnuplot-process))
(calc-gnuplot-check-for-errors)
(if (get-buffer-window calc-gnuplot-buffer)
(calc-graph-view-trail)))))
(defun calc-graph-init-buffers ()
(or (and calc-gnuplot-buffer
(buffer-name calc-gnuplot-buffer))
(setq calc-gnuplot-buffer (get-buffer-create "*Gnuplot Trail*")))
(or (and calc-gnuplot-input
(buffer-name calc-gnuplot-input))
(setq calc-gnuplot-input (get-buffer-create "*Gnuplot Commands*"))))
(defun calc-graph-init ()
(or (calc-gnuplot-alive)
(let ((process-connection-type t)
origin)
(if calc-gnuplot-process
(progn
(delete-process calc-gnuplot-process)
(setq calc-gnuplot-process nil)))
(calc-graph-init-buffers)
(save-excursion
(set-buffer calc-gnuplot-buffer)
(insert "\nStarting gnuplot...\n")
(setq origin (point)))
(setq calc-graph-last-device nil)
(setq calc-graph-last-output nil)
(condition-case err
(let ((args (append (and calc-gnuplot-display
(not (equal calc-gnuplot-display
(getenv "DISPLAY")))
(list "-display"
calc-gnuplot-display))
(and calc-gnuplot-geometry
(list "-geometry"
calc-gnuplot-geometry)))))
(setq calc-gnuplot-process
(apply 'start-process
"gnuplot"
calc-gnuplot-buffer
calc-gnuplot-name
args))
(process-kill-without-query calc-gnuplot-process))
(file-error
(error "Sorry, can't find \"%s\" on your system"
calc-gnuplot-name)))
(save-excursion
(set-buffer calc-gnuplot-buffer)
(while (and (not (save-excursion
(goto-char origin)
(search-forward "gnuplot> " nil t)))
(memq (process-status calc-gnuplot-process) '(run stop)))
(accept-process-output calc-gnuplot-process))
(or (memq (process-status calc-gnuplot-process) '(run stop))
(error "Unable to start GNUPLOT process"))
(if (save-excursion
(goto-char origin)
(re-search-forward
"G N U P L O T.*\n.*version \\([0-9]+\\)\\." nil t))
(setq calc-gnuplot-version (string-to-int (buffer-substring
(match-beginning 1)
(match-end 1))))
(setq calc-gnuplot-version 1))
(goto-char (point-max)))))
(save-excursion
(set-buffer calc-gnuplot-input)
(if (= (buffer-size) 0)
(insert "# Commands for running gnuplot\n\n\n")
(or calc-graph-no-auto-view
(eq (char-after (1- (point-max))) ?\n)
(progn
(goto-char (point-max))
(insert "\n"))))))
;;; calc-graph.el ends here
Reference in New Issue View Git Blame Copy Permalink