home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / octa21eb.zip / octave / lisp / octave.el < prev    next >
Lisp/Scheme  |  1999-05-13  |  12KB  |  344 lines
  1. ;;; octave-cmd.el --- specialized comint.el for running the Octave.
  2.  
  3. ;; Copyright (C) 1996 - 1997 Klaus Gebhardt
  4.  
  5. ;; This file is part of Octave for OS/2.
  6.  
  7. ;; Octave is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 2, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; Octave is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with Octave; see the file COPYING.  If not, write to
  19. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;;; Code:
  22.  
  23. (require 'shell)
  24. (require 'comint)
  25. (require 'octave-info)
  26.  
  27. ;; Constants used in all Octave-mode buffers.
  28.  
  29. (defvar octave-prog-filename "octave")
  30. (defvar octave-temp-string nil)
  31.  
  32. (defvar octave-shell-prompt-regexp "^octave:[0-9]*> *")
  33. (defvar octave-edit-regexp "\\(ans = \\)\\(.*.[mM]\\)$")
  34. (defvar octave-info-regexp
  35.   "\\(\\*\\*\\* Starting Emacs info browser (\\)\\(.*\\)): \\(.*\\)\\( \\*\\*\\*$\\)")
  36.  
  37. (if window-system
  38.     (progn
  39.       (require 'hilit19)
  40.       (hilit-set-mode-patterns
  41.        '(octave-shell-mode)
  42.        (append
  43.     '(("^warning.*$" nil comment))
  44.     '(("^error.*$" nil comment))
  45.     '(("^parse error.*$" nil comment))
  46.     '(("^>>>.*$" nil comment))
  47.     '(("^octave:[0-9]*>" nil define))
  48.     '(("^ans =" nil keyword))
  49.     '(("^ Columns .* through .*$" nil keyword))
  50.     '(("^ Columns .* and .*$" nil keyword))
  51.     '(("^Process octave finished$" nil comment))))))
  52.  
  53. (defvar octave-shell-mode-map nil)
  54. (setq octave-shell-mode-map nil)
  55. (cond ((not octave-shell-mode-map)
  56.        (setq octave-shell-mode-map
  57.          (nconc (make-sparse-keymap) shell-mode-map))
  58.        (define-key octave-shell-mode-map
  59.      [menu-bar octave] 
  60.      (cons "Octave" (make-sparse-keymap "Octave")))
  61.        (define-key octave-shell-mode-map
  62.      [menu-bar octave octave-help]
  63.      '("Help" . octave-help))
  64.        (define-key octave-shell-mode-map
  65.      [menu-bar octave octave-quit]
  66.      '("Quit" . octave-quit))
  67.        (define-key octave-shell-mode-map
  68.      [menu-bar octave octave-start]
  69.      '("Restart" . octave))
  70.        (define-key octave-shell-mode-map
  71.      [menu-bar octave octave-plotting]
  72.      (cons "Plotting" (make-sparse-keymap "Plotting")))
  73.        (define-key octave-shell-mode-map
  74.      [menu-bar octave octave-plotting octave-purgetemp]
  75.      '("Purge Tempfiles" . octave-purgetemp))
  76.        (define-key octave-shell-mode-map
  77.      [menu-bar octave octave-plotting octave-subwindow]
  78.      '("MultiPlot Subwindow" . octave-subwindow))
  79.        (define-key octave-shell-mode-map
  80.      [menu-bar octave octave-plotting octave-closemultiplot]
  81.      '("Close MultiPlot" . octave-closemultiplot))
  82.        (define-key octave-shell-mode-map
  83.      [menu-bar octave octave-plotting octave-multiplot]
  84.      '("MultiPlot" . octave-multiplot))
  85.        (define-key octave-shell-mode-map
  86.      [menu-bar octave octave-plotting octave-closeplot]
  87.      '("Close Plot" . octave-closeplot))
  88.        (define-key octave-shell-mode-map
  89.      [menu-bar octave octave-plotting octave-replot]
  90.      '("Replot" . octave-replot))
  91.        (define-key octave-shell-mode-map
  92.      [menu-bar octave octave-plotting octave-plotting-set]
  93.      (cons "Set" (make-sparse-keymap "Set")))
  94.        (define-key octave-shell-mode-map
  95.      [menu-bar octave octave-plotting octave-plotting-set octave-zlabel]
  96.      '("Zlabel" . octave-zlabel))
  97.        (define-key octave-shell-mode-map
  98.      [menu-bar octave octave-plotting octave-plotting-set octave-ylabel]
  99.      '("Ylabel" . octave-ylabel))
  100.        (define-key octave-shell-mode-map
  101.      [menu-bar octave octave-plotting octave-plotting-set octave-xlabel]
  102.      '("Xlabel" . octave-xlabel))
  103.        (define-key octave-shell-mode-map
  104.      [menu-bar octave octave-plotting octave-plotting-set octave-title]
  105.      '("Title" . octave-title))
  106.        (define-key octave-shell-mode-map
  107.      [menu-bar octave octave-plotting octave-plotting-set octave-term]
  108.      '("Terminal" . octave-term))
  109.        (define-key octave-shell-mode-map
  110.      [menu-bar octave octave-plotting octave-plotting-set octave-output]
  111.      '("Output" . octave-output))
  112.        (define-key octave-shell-mode-map
  113.      [menu-bar octave octave-plotting octave-sombrero]
  114.      '("Sombrero" . octave-sombrero))
  115.        (define-key octave-shell-mode-map
  116.      [menu-bar octave octave-system]
  117.      (cons "System" (make-sparse-keymap "System")))
  118.        (define-key octave-shell-mode-map
  119.      [menu-bar octave octave-system octave-computer]
  120.      '("Computer" . octave-computer))
  121.        (define-key octave-shell-mode-map
  122.      [menu-bar octave octave-system octave-warranty]
  123.      '("Warranty" . octave-warranty))
  124.        (define-key octave-shell-mode-map
  125.      [menu-bar octave octave-system octave-dir]
  126.      '("Directory" . octave-dir))
  127.        (define-key octave-shell-mode-map
  128.      [menu-bar octave octave-system octave-edit-script]
  129.      '("Edit Scriptfile" . octave-edit-script))))
  130.  
  131. (defun octave-send-string (string)
  132.   (let ((proc (get-buffer-process (current-buffer))))
  133.     (if (not proc)
  134.     (error "Current buffer has no process")
  135.       (comint-send-string proc string))))
  136.  
  137. (defun octave-read-from-process (proc output)
  138.   (setq octave-temp-string (format "%s%s" octave-temp-string output)))
  139.  
  140. (defun octave-ask (string)
  141.   (let ((proc (get-buffer-process (current-buffer))))
  142.     (if (not proc)
  143.     (progn
  144.       (error "Current buffer has no process")
  145.       (setq octave-temp-string ""))
  146.       (progn
  147.     (setq octave-temp-string "")
  148.     (set-process-filter proc 'octave-read-from-process)
  149.     (process-send-string proc "add_to_command_number(-1); ")
  150.     (process-send-string proc string)
  151.     (process-send-string proc "\n")
  152.     (while (not (string-match octave-shell-prompt-regexp
  153.                   octave-temp-string 0))
  154.       (accept-process-output proc))
  155.     (set-process-filter proc 'octave-output-filter)))))
  156.  
  157. (defun octave-output-filter (process string)
  158.   (let ((oprocbuf (process-buffer process)))
  159.     (if (and oprocbuf (buffer-name oprocbuf))
  160.     (let ((obuf (current-buffer))
  161.           (opoint nil) (obeg nil) (oend nil))
  162.  
  163.       (setq octave-temp-string nil)
  164.       (while (string-match octave-info-regexp string 0)
  165.         (setq octave-temp-string
  166.           (cons (substring string (match-beginning 2) (match-end 2))
  167.             octave-temp-string))
  168.         (setq octave-temp-string
  169.           (cons (substring string (match-beginning 3) (match-end 3))
  170.             octave-temp-string))
  171.         (setq string (format
  172.               "%s%s"
  173.               (substring string 0 (match-beginning 1))
  174.               (substring string (+ (match-end 4) 1) nil))))
  175.  
  176.       (set-buffer oprocbuf)
  177.       (setq opoint (point))
  178.       (setq obeg (point-min))
  179.       (setq oend (point-max))
  180.       (let ((buffer-read-only nil)
  181.         (nchars (length string))
  182.         (ostart nil))
  183.         (widen)
  184.         (goto-char (process-mark process))
  185.         (setq ostart (point))
  186.         (if (<= (point) opoint)
  187.         (setq opoint (+ opoint nchars)))
  188.         (if (< (point) obeg)
  189.         (setq obeg (+ obeg nchars)))
  190.         (if (<= (point) oend)
  191.         (setq oend (+ oend nchars)))
  192.         (insert-before-markers string)
  193.         (if (= (window-start (selected-window)) (point))
  194.         (set-window-start (selected-window)
  195.                   (- (point) (length string))))
  196.         (if (and comint-last-input-end
  197.              (marker-buffer comint-last-input-end)
  198.              (= (point) comint-last-input-end))
  199.         (set-marker comint-last-input-end
  200.                 (- comint-last-input-end nchars)))
  201.         (set-marker comint-last-output-start ostart)
  202.         (set-marker (process-mark process) (point))
  203.         (force-mode-line-update)
  204.  
  205.       (narrow-to-region obeg oend)
  206.       (goto-char opoint))
  207.       (run-hook-with-args 'comint-output-filter-functions string)
  208.  
  209.       (if (not (equal octave-temp-string nil))
  210.           (progn
  211.         (switch-to-buffer-other-window "*octave-info*")
  212.         (octave-info (nreverse octave-temp-string))
  213.         (switch-to-buffer-other-window "*octave*")))
  214.  
  215.       (set-buffer obuf)))))
  216.  
  217. (defun my-comint-output-filter (string)
  218.   (comint-postoutput-scroll-to-bottom string)
  219.   (if window-system (hilit-rehighlight-buffer-quietly)))
  220.  
  221. (defun octave-zlabel (str)
  222.   (interactive "sZlabel: ")
  223.   (octave-send-string (format "gset zlabel \"%s\"\n" str)))
  224.  
  225. (defun octave-ylabel (str)
  226.   (interactive "sYlabel: ")
  227.   (octave-send-string (format "gset ylabel \"%s\"\n" str)))
  228.  
  229. (defun octave-xlabel (str)
  230.   (interactive "sXlabel: ")
  231.   (octave-send-string (format "gset xlabel \"%s\"\n" str)))
  232.  
  233. (defun octave-title (str)
  234.   (interactive "sTitle: ")
  235.   (octave-send-string (format "gset title \"%s\"\n" str)))
  236.  
  237. (defun octave-term (str)
  238.   (interactive "sTerminal: ")
  239.   (octave-send-string (format "gset term %s\n" str)))
  240.  
  241. (defun octave-output (str)
  242.   (interactive "sOutput: ")
  243.   (if (equal str "")
  244.       (octave-send-string (format "gset output\n"))
  245.     (octave-send-string (format "gset output \"%s\"\n" str))))
  246.  
  247. (defun octave-sombrero (num)
  248.   (interactive "nResolution: ")
  249.   (octave-send-string
  250.    (format "sombrero (%d)\n" num)))
  251.  
  252. (defun octave-edit-script (script)
  253.   (interactive "sScriptfile: ")
  254.   (octave-ask (format "file_in_path(LOADPATH, \'%s.m\')" script))
  255.   (if (string-match octave-edit-regexp octave-temp-string 0)
  256.       (find-file-other-window
  257.        (substring octave-temp-string (match-beginning 2) (match-end 2)))))
  258.  
  259. (defun octave-computer ()
  260.   (interactive)
  261.   (octave-send-string "computer\n"))
  262.  
  263. (defun octave-warranty ()
  264.   (interactive)
  265.   (octave-send-string "warranty\n"))
  266.  
  267. (defun octave-dir ()
  268.   (interactive)
  269.   (octave-send-string "ls -l\n"))
  270.  
  271. (defun octave-replot ()
  272.   (interactive)
  273.   (octave-send-string "replot\n"))
  274.  
  275. (defun octave-purgetemp ()
  276.   (interactive)
  277.   (octave-send-string "purge_tmp_files\n"))
  278.  
  279. (defun octave-closeplot ()
  280.   (interactive)
  281.   (octave-send-string "closeplot\n"))
  282.  
  283. (defun octave-subwindow (xn yn)
  284.   (interactive "nxn: \nnyn: ")
  285.   (octave-send-string (format "subwindow (%d, %d)\n" xn yn)))
  286.  
  287. (defun octave-closemultiplot ()
  288.   (interactive)
  289.   (octave-send-string "multiplot (0, 0)\n"))
  290.  
  291. (defun octave-multiplot (xn yn)
  292.   (interactive "nxn: \nnyn: ")
  293.   (octave-send-string (format "multiplot (%d, %d)\n" xn yn)))
  294.  
  295. (defun octave-quit ()
  296.   (interactive)
  297.   (octave-send-string "quit\n"))
  298.  
  299. (defun octave-help (index)
  300.   (interactive "sIndex: ")
  301.   (octave-send-string (format "help -i %s\n" index)))
  302.  
  303. (defun octave-shell-mode ()
  304.   (interactive)
  305.   (shell-mode)
  306.   (setq major-mode 'octave-shell-mode)
  307.   (setq mode-name "Octave")
  308.   (use-local-map octave-shell-mode-map)
  309.   (make-local-variable 'comint-prompt-regexp)
  310.   (setq comint-prompt-regexp octave-shell-prompt-regexp)
  311.   (make-local-variable 'comint-input-ring-file-name)
  312.   (setq comint-input-ring-file-name "~/.octave_hist")
  313.   (make-local-variable 'comint-process-echoes)
  314.   (setq comint-process-echoes nil)
  315.   (make-local-variable 'comint-scroll-to-bottom-on-input)
  316.   (setq comint-scroll-to-bottom-on-input nil)
  317.   (make-local-variable 'comint-scroll-to-bottom-on-output)
  318.   (setq comint-scroll-to-bottom-on-output t)
  319.   (make-local-variable 'comint-input-ignoredups)
  320.   (setq comint-input-ignoredups nil)
  321.   (make-local-variable 'comint-output-filter-functions)
  322.   (setq comint-output-filter-functions 'my-comint-output-filter)
  323.   (run-hooks 'octave-shell-mode-hook))
  324.  
  325. (defun octave ()
  326.   "Run Octave 1.1.1 with I/O through buffer *octave*.
  327. See shell for details."
  328.   (interactive)
  329.   (cond ((not (comint-check-proc "*octave*"))
  330.      (let* ((prog octave-prog-filename)
  331.         (name (file-name-nondirectory prog))
  332.         (startfile (concat "~/.emacs_" name)))
  333.        (set-buffer (apply 'make-comint "octave" prog
  334.                   (if (file-exists-p startfile) startfile)
  335.                   '("-I")))
  336.        (octave-shell-mode)
  337.        (set-process-filter (get-buffer-process "*octave*")
  338.                    'octave-output-filter))))
  339.   (switch-to-buffer "*octave*"))
  340.  
  341. (provide 'octave)
  342.  
  343. ;;; octave-cmd.el ends here
  344.