Mercurial > emacs
view lisp/calc/calc-graph.el @ 89943:4c90ffeb71c5
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-15
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-218
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-220
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-221
Restore deleted tagline in etc/TUTORIAL.ru
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-222
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-228
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-229
Remove TeX output files from the archive
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-230
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-247
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-248
src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-249
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-256
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-258
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-263
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-264
Update from CVS: lispref/display.texi: emacs -> Emacs.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-265
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-274
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-275
Update from CVS: man/makefile.w32-in: Revert last change
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-276
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-295
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-296
Allow restarting an existing debugger session that's exited
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-297
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-299
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-300
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-327
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-328
Update from CVS: src/.gdbinit (xsymbol): Fix last change.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-329
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-344
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-345
Tweak source regexps so that building in place won't cause problems
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-346
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-351
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-352
Update from CVS: lisp/flymake.el: New file.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-353
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-361
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-362
Support " [...]" style defaults in minibuffer-electric-default-mode
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363
(read-number): Use canonical format for default in prompt.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-364
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-367
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368
Improve display-supports-face-attributes-p on non-ttys
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369
Rewrite face-differs-from-default-p
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-370
Move `display-supports-face-attributes-p' entirely into C code
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-371
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372
Simplify face-differs-from-default-p; don't consider :stipple.
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-373
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-374
(tty_supports_face_attributes_p): Ensure attributes differ from default
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-375
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-376
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-377
(Fdisplay_supports_face_attributes_p): Work around bootstrapping problem
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-378
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-380
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-381
Face merging cleanups
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-382
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-384
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-385
src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-386
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-395
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-396
Tweak arch tagging to make build/install-in-place less annoying
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-397
Work around vc-arch problems when building eshell
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-398
Tweak permissions
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-399
Tweak directory permissions
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-400
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-401
More build-in-place tweaking of arch tagging
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-402
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-403
Yet more build-in-place tweaking of arch tagging
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-404
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-409
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-410
Make sure image types are initialized for lookup too
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-411
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-416
Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Mon, 28 Jun 2004 07:56:49 +0000 |
parents | 68c22ea6027c |
children | 0b158db81c28 |
line wrap: on
line source
;;; 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> ;; Maintainers: D. Goel <deego@gnufans.org> ;; 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) '(?\s ?\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")))))) ;;; arch-tag: e4b06a52-c386-4d54-a2bb-7c0a0ef533c2 ;;; calc-graph.el ends here