home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / S.shar / S.el < prev   
Encoding:
Text File  |  1990-07-22  |  14.0 KB  |  390 lines
  1. ;;; S mode for GNU Emacs    Mon Apr 24 17:23:18 CDT 1989
  2. ;;; Copyright (C) 1989        Doug Bates and Ed Kademan
  3. ;;;                 bates@stat.wisc.edu
  4. ;;;                kademan@stat.wisc.edu
  5. ;;; This program is free software;  you can redistribute it and/or modify
  6. ;;; it under the terms of the GNU General Public License as published by
  7. ;;; the Free Software Foundation; either version 1, or (at your option) any
  8. ;;; later version.
  9. ;;;
  10. ;;; This program is distributed in the hope that it will be useful, but
  11. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13. ;;; General Public License for more details.
  14. ;;;
  15. ;;; You should have received a copy of the GNU General Public License along
  16. ;;; with this program; if not, write to the Free Software Foundation, Inc.,
  17. ;;; 675 Mass Ave, Cambridge, MA 02139, USA.
  18. ;;; 
  19. ;;; This package includes an S mode for editing S data and functions, and
  20. ;;; an inferior S mode so that you can run S in a buffer.  It is built on
  21. ;;; top of comint (the general command interpreter mode written by Olin
  22. ;;; Shivers), and so comint.el (or comint.elc) should be either loaded or
  23. ;;; in your load path when you invoke it.  You might want to put something
  24. ;;; like the following in your .emacs file:
  25. ;;;     (autoload 'S "~/elisp/S" "" t)
  26. ;;; where "~/elisp/S.el" is the path name of this file.  That way, all you
  27. ;;; will have to do to get S running is to type "M-x S" from within emacs.
  28. ;;;
  29. ;;; Aside from the general features offered by comint such as command
  30. ;;; history editing and job control, inferior S mode allows you to dump and
  31. ;;; load S objects into and from external files, and to display help on
  32. ;;; functions.  It also provides name completion while you do these.  For
  33. ;;; more detailed information see the documentation strings for S,
  34. ;;; inferior-S-mode, S-mode, and comint-mode.  There are also many
  35. ;;; variables and hooks available for customizing (see below).
  36. ;;;
  37. ;;; Bugs:
  38. ;;;     Inferior S mode doesn't do a very good job of offering defaults
  39. ;;; when it prompts for names and it is often not wise to accept them even
  40. ;;; when they look right.
  41. ;;;     S mode for editing S source is basically just fundamental mode with
  42. ;;; a few extra key bindings.  It could be a lot fancier.
  43.  
  44. (require 'comint)
  45. (provide 'S)
  46.  
  47. ;;; Inferior S mode
  48. ;;;======================================================================
  49. ;;;
  50.  
  51. (defvar inferior-S-program "S"
  52.   "*Program name for invoking an inferior S.")
  53.  
  54. (defvar explicit-S-args nil
  55.   "*String of arguments passed to the S process on startup if the name of
  56. the S program is `S'.")
  57.  
  58. (defvar inferior-S-prompt "^\\(\\+\\|[^>]*>\\) *"
  59.   "*The regular expression inferior S mode uses for recognizing prompts")
  60.  
  61. (defvar S-scratch-file nil
  62.   "*The name of the scratch source file that receives dumped objects.")
  63.  
  64. (defvar S-scratch-directory "/tmp"
  65.   "*The directory inferior S puts the scratch source files into.")
  66.  
  67. (defvar S-source-modes '(S-mode)
  68.   "*A list of modes used to determine if a buffer contains S source code.
  69. If a file is loaded into a buffer that is in one of these major modes, it
  70. is considered an S source file.  The function S-load-file uses this to
  71. determine defaults.")
  72.  
  73. (defvar inferior-S-load-command "source(\"%s\")\n"
  74.   "*Format-string for building the S command to load a file.
  75. This format string should use %s to substitute a file name
  76. and should result in an S expression that will command the inferior S
  77. to load that file.")
  78.  
  79. (defvar inferior-S-dump-command "dump(\"%s\",file=\"%s\")\n"
  80.   "*Format-string for building the S command to dump an object into a file.
  81. This format string should use %s to substitute an object and a file name.")
  82.  
  83. (defvar inferior-S-help-command "help(\"%s\")\n"
  84.   "*Format-string for building the S command to ask for help on an object.
  85. This format string should use %s to substitute an object name.")
  86.  
  87. (defvar inferior-S-search-list-command "attach()\n"
  88.   "*S command that prints out the search list---the directory paths that S
  89. uses when it searches for objects")
  90.  
  91. (defvar S-directory nil
  92.   "The directory S is running from.  Set by the S function and not by the
  93. user.")
  94.  
  95. (defvar S-prev-load-dir/file nil
  96.   "This symbol saves the (directory . file) pair used in the last
  97. S-load-file command.  Used for determining the default in the next one.")
  98.  
  99. (defvar inferior-S-mode-map nil)
  100. (if inferior-S-mode-map
  101.     nil
  102.   (setq inferior-S-mode-map (full-copy-sparse-keymap comint-mode-map))
  103.   (define-key inferior-S-mode-map "\C-cl" 'S-load-file)
  104.   (define-key inferior-S-mode-map "\C-cd" 'S-dump-object-into-scratch)
  105.   (define-key inferior-S-mode-map "\C-ch" 'S-display-help-on-object))
  106.  
  107. (defvar inferior-S-mode-hook '()
  108.   "Hook for customizing inferior S mode")
  109.  
  110. (defun S ()
  111.   "Run an inferior S process, input and output via buffer *S*.
  112. If there is a process already running in *S*, just switch to that buffer.
  113. Takes the program name from the variable inferior-S-program.
  114. The S program name is used to make a symbol name such as `explicit-S-args'.
  115. If that symbol is a variable its value is used as a string of arguments
  116. when invoking S.
  117. \(Type \\[describe-mode] in the process buffer for a list of commands.)"
  118.   (interactive)
  119.   (if (not (comint-check-proc "*S*"))
  120.       (let* ((symbol-string
  121.           (concat "explicit-" inferior-S-program "-args"))
  122.          (switches-symbol (intern-soft symbol-string))
  123.          (switches
  124.           (if (and switches-symbol (boundp switches-symbol))
  125.           (symbol-value switches-symbol)))
  126.          (tbuffer (generate-new-buffer "getting S-directory"))
  127.          sprocess)
  128.     (set-buffer
  129.      (if switches
  130.          (make-comint "S" inferior-S-program nil switches)
  131.        (make-comint "S" inferior-S-program nil)))
  132.     (inferior-S-mode)
  133.     (setq sprocess (get-process "S"))
  134.     ;; Make sure S has started.
  135.     (while (progn
  136.          (accept-process-output sprocess)
  137.          (goto-char (point-max))
  138.          (beginning-of-line)
  139.          (not (looking-at inferior-S-prompt))))
  140.     (goto-char (point-max))
  141.     ;; Now get S-directory.
  142.     (command-to-S "!pwd\n" tbuffer)
  143.     (set-buffer tbuffer)
  144.     (setq S-directory (buffer-substring (point-min) (- (point-max) 1)))
  145.     (kill-buffer tbuffer)))
  146.   (switch-to-buffer "*S*"))
  147.  
  148. (defun inferior-S-mode () 
  149.   "Major mode for interacting with an inferior S process.  
  150. Runs an S interactive job as a subprocess of Emacs, with I/O through an
  151. Emacs buffer.  Variable inferior-S-program controls which S
  152. is run.
  153.  
  154. \\{inferior-S-mode-map}
  155.  
  156. Do not type \\[S-dump-object-into-scratch] or \\[S-display-help-on-object]
  157. when you are in the middle of delivering a multi-line command to S and S is
  158. prompting you with its secondary prompt. It's ok to do this if S hasn't
  159. seen the initial lines yet---that is, if you ended those lines with
  160. something other than a \"send input\" command (usually bound to RETURN).
  161.  
  162. Customization: Entry to this mode runs the hooks on comint-mode-hook and
  163. inferior-S-mode-hook (in that order).
  164.  
  165. You can send text to the inferior S process from other buffers containing
  166. S source.
  167.     switch-to-S switches the current buffer to the S process buffer.
  168.     S-eval-buffer sends the current buffer to the S process.
  169.     S-eval-region sends the current region to the S process.
  170.  
  171.     S-eval-buffer-and-go, and S-eval-region-and-go
  172.     switch to the S process buffer after sending their text.
  173.  
  174. Commands:
  175. Return after the end of the process' output sends the text from the 
  176.     end of process to point.
  177. Return before the end of the process' output copies the sexp ending at point
  178.     to the end of the process' output, and sends it.
  179. Delete converts tabs to spaces as it moves back.
  180. C-M-q does Tab on each line starting within following expression.
  181. Paragraphs are separated only by blank lines.  Crosshatches start comments.
  182. If you accidentally suspend your process, use \\[comint-continue-subjob]
  183. to continue it."
  184.   (interactive)
  185.   (comint-mode)
  186.   (setq comint-prompt-regexp inferior-S-prompt)
  187.   (setq major-mode 'inferior-S-mode)
  188.   (setq mode-name "Inferior S")
  189.   (setq mode-line-process '(": %s"))
  190.   (use-local-map inferior-S-mode-map)
  191.   (run-hooks 'inferior-S-mode-hook))
  192.  
  193. (defun S-dump-object-into-scratch (object)
  194.   "Dump the S object into a file (and buffer) for editing."
  195.   (interactive (find-S-object "Object to edit: "))
  196.   (let* ((filename (concat S-scratch-directory
  197.                "/"
  198.                (or S-scratch-file (make-temp-name "scr."))))
  199.      (complete-dump-command (format inferior-S-dump-command
  200.                     object filename))
  201.      old-scratch-buffer)
  202.     (command-to-S complete-dump-command)
  203.     (if (setq old-scratch-buffer (get-file-buffer filename))
  204.     (kill-buffer old-scratch-buffer)) ;make sure we start fresh
  205.     (find-file-other-window filename)
  206.     (S-mode)
  207.     (setq S-prev-load-dir/file
  208.       (cons (file-name-directory filename)
  209.         (file-name-nondirectory filename)))))
  210.  
  211. (defun find-S-object (p-string)
  212.   (let* ((default (find-S-object-default))
  213.      (prompt-string (if default
  214.                 (format "%s(default %s) " p-string default)
  215.               p-string))
  216.      (S-object-list (get-S-object-list (get-S-search-list)))
  217.      (spec (completing-read prompt-string S-object-list)))
  218.     (list (or spec default))))
  219.  
  220. (defun find-S-object-default ()
  221.   (save-excursion
  222.     (while (looking-at "\\sw\\|\\s.")
  223.       (forward-char 1))
  224.     (if (re-search-backward "\\sw\\|\\s." nil t)
  225.     (progn (forward-char 1)
  226.            (buffer-substring (point)
  227.                  (progn (forward-sexp -1)
  228.                     (while (looking-at "\\s'")
  229.                       (forward-char 1))
  230.                     (point))))
  231.       nil)))
  232.  
  233. (defun get-S-search-list ()
  234.   "Get the list of directories that S searches when it looks for objects."
  235.   (let ((tbuffer (generate-new-buffer "search-list"))
  236.     S-search-list
  237.     dir)
  238.     (buffer-flush-undo tbuffer)
  239.     (set-buffer tbuffer)
  240.     (command-to-S inferior-S-search-list-command tbuffer)
  241.     (goto-char (point-max))
  242.     (while (re-search-backward "\"\\([^\"]*\\)\"" nil t)
  243.       (setq dir (buffer-substring (match-beginning 1) (match-end 1)))
  244.       (setq dir
  245.         (cond ((string-match "^\\." dir)
  246.            (concat S-directory (substring dir 1)))
  247.           ((string-match "^[^/]" dir)
  248.            (concat S-directory "/" dir))
  249.           (t
  250.            dir)))
  251.       (setq S-search-list (cons dir S-search-list)))
  252.     (kill-buffer tbuffer)
  253.     (symbol-value 'S-search-list)))
  254.  
  255. (defun get-S-object-list (s-list)
  256.   "Return the alist of current S object names (suitable for use with
  257. completing-read).  S-LIST is the search list of directories for S."
  258.   (if (null s-list)
  259.       nil
  260.     (append (mapcar (function list)(directory-files (car s-list)))
  261.         (get-S-object-list (cdr s-list)))))
  262.  
  263. (defun command-to-S (com &optional buf)
  264.   "Send the S process a COMMAND and delete the output from the S process
  265. buffer.  If an optional second argument BUFFER exists save the output
  266. there. (BUFFER cannot be the S process buffer.)"
  267.   (let* ((cbuffer (current-buffer))
  268.      (sprocess (get-process "S"))
  269.      (sbuffer (process-buffer sprocess))
  270.      place-holder
  271.      last)
  272.     (set-buffer sbuffer)
  273.     (setq place-holder (point-marker))
  274.     (kill-region (process-mark sprocess) (point-max))
  275.     (setq last (point-max))
  276.     (process-send-string sprocess com)
  277.     (while (progn
  278.          (accept-process-output sprocess)
  279.          (goto-char (point-max))
  280.          (beginning-of-line)
  281.          (or (= (point-max) last)
  282.          (not (looking-at inferior-S-prompt)))))
  283.     (if buf
  284.     (append-to-buffer buf last (point)))
  285.     (delete-region last (point-max))
  286.     (yank)                ;possible command in process
  287.     (goto-char (marker-position place-holder))
  288.     (set-buffer cbuffer)))
  289.  
  290. (defun S-display-help-on-object (object)
  291.   "Display the help page for OBJECT in the *Help* buffer."
  292.   (interactive (find-S-object "Help on: "))
  293.   (let (tbuffer)
  294.     (pop-to-buffer "*Help*")
  295.     (setq tbuffer (current-buffer))
  296.     (delete-region (point-min) (point-max))
  297.     (command-to-S (format inferior-S-help-command object) tbuffer)
  298.     (goto-char (point-min))))
  299.  
  300. (defun S-load-file (filename)
  301.   "Load an S source file into an inferior S process."
  302.   (interactive (comint-get-source "Load S file: "
  303.                   S-prev-load-dir/file
  304.                   S-source-modes
  305.                   nil))
  306.   (comint-check-source filename)
  307.   (setq S-prev-load-dir/file
  308.     (cons (file-name-directory filename)
  309.           (file-name-nondirectory filename)))
  310.   (process-send-string "S" (format inferior-S-load-command
  311.                    filename))
  312.   (switch-to-S t))
  313.  
  314. ;;; S mode
  315. ;;;======================================================================
  316. ;;;
  317.  
  318. (defvar S-mode-map nil)
  319. (if S-mode-map
  320.     nil
  321.   (setq S-mode-map (make-sparse-keymap))
  322.   (define-key S-mode-map "\C-cr"    'S-eval-region)
  323.   (define-key S-mode-map "\C-c\C-r" 'S-eval-region-and-go)
  324.   (define-key S-mode-map "\C-cb"    'S-eval-buffer)
  325.   (define-key S-mode-map "\C-c\C-b" 'S-eval-buffer-and-go)
  326.   (define-key S-mode-map "\C-cz"    'switch-to-S)
  327.   (define-key S-mode-map "\C-cl"    'S-load-file))
  328.  
  329. (defvar S-mode-hook '()
  330.   "Hook for customizing S mode.")
  331.  
  332. (defun S-mode ()
  333.   "Major mode for editing S source.
  334.  
  335. \\{S-mode-map}
  336.  
  337. Customization: Entry to this mode runs the hooks in S-mode-hook.
  338.  
  339. You can send text to the inferior S process from other buffers containing
  340. S source.
  341.     switch-to-S switches the current buffer to the S process buffer.
  342.     S-eval-buffer sends the current buffer to the S process.
  343.     S-eval-region sends the current region to the S process.
  344.  
  345.     S-eval-buffer-and-go, and S-eval-region-and-go
  346.     switch to the S process buffer after sending their text."
  347.   (interactive)
  348.   (setq major-mode 'S-mode)
  349.   (setq mode-name "S")
  350.   (use-local-map S-mode-map)
  351.   (run-hooks 'S-mode-hook))
  352.  
  353. (defun S-eval-region (start end)
  354.   "Send the current region to the inferior S process."
  355.   (interactive "r")
  356.   (process-send-region "S" start end)
  357.   (process-send-string "S" "\n"))
  358.  
  359. (defun S-eval-region-and-go (start end)
  360.   "Send the current region to the inferior S and switch to the process
  361. buffer."
  362.   (interactive "r")
  363.   (S-eval-region start end)
  364.   (switch-to-S t))
  365.  
  366. (defun S-eval-buffer ()
  367.   "Send the current buffer to the inferior S process."
  368.   (interactive)
  369.   (S-eval-region (point-min) (point-max)))
  370.  
  371. (defun S-eval-buffer-and-go ()
  372.   "Send the current buffer to the inferior S and switch to the process
  373. buffer."
  374.   (interactive)
  375.   (S-eval-buffer)
  376.   (switch-to-S t))
  377.  
  378. (defun switch-to-S (eob-p)
  379.   "Switch to the inferior S process buffer.
  380. With argument, positions cursor at end of buffer."
  381.   (interactive "P")
  382.   (cond ((comint-check-proc "*S*")
  383.      (pop-to-buffer "*S*")
  384.      (cond (eob-p
  385.         (push-mark)
  386.         (goto-char (point-max)))))
  387.     (t
  388.      (message "No inferior S process")
  389.      (ding))))
  390.