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