PageRenderTime 12ms CodeModel.GetById 1ms app.highlight 8ms RepoModel.GetById 0ms app.codeStats 1ms

/extras/inferior-arc.el

http://github.com/alimoeeny/arc
Emacs Lisp | 378 lines | 251 code | 58 blank | 69 comment | 18 complexity | 44cc54d90c1dcaf99cc252712fa085ce MD5 | raw file
  1;;; inferior-arc.el --- Arc process in a buffer. Adapted from cmuscheme.el
  2
  3;; Copyright (C) 1988, 1994, 1997, 2001, 2002, 2003, 2004,
  4;;   2005, 2006, 2007, 2008 Free Software Foundation, Inc.
  5
  6;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
  7;; Keywords: processes, lisp, arc
  8
  9;; Adapted for Arc by Sami Samhuri <sami.samhuri@gmail.com>
 10
 11;; This file is NOT part of GNU Emacs.
 12
 13;; This code is free software; you can redistribute it and/or modify
 14;; it under the terms of the GNU General Public License as published by
 15;; the Free Software Foundation; either version 2, or (at your option)
 16;; any later version.
 17
 18;; inferior-arc.el is distributed in the hope that it will be useful,
 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 21;; GNU General Public License for more details.
 22
 23;; You should have received a copy of the GNU General Public License
 24;; along with inferior-arc.el; see the file COPYING.  If not, write to the
 25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
 26;; Boston, MA 02110-1301, USA.
 27
 28;;; Commentary:
 29
 30;;    This is a customization of comint-mode (see comint.el)
 31;;
 32;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
 33;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al..
 34;; 8/88
 35;;
 36;; Please send me bug reports, bug fixes, and extensions, so that I can
 37;; merge them into the master source.
 38;;
 39;; The changelog is at the end of this file.
 40;;
 41;;; CHANGE LOG
 42;;; ===========================================================================
 43;;; 8/88 Olin
 44;;; Created.
 45;;;
 46;;; 2/15/89 Olin
 47;;; Removed -emacs flag from process invocation. It's only useful for
 48;;; cscheme, and makes cscheme assume it's running under xscheme.el,
 49;;; which messes things up royally. A bug.
 50;;;
 51;;; 5/22/90 Olin
 52;;; - Upgraded to use comint-send-string and comint-send-region.
 53;;; - run-scheme now offers to let you edit the command line if
 54;;;   you invoke it with a prefix-arg. M-x scheme is redundant, and
 55;;;   has been removed.
 56;;; - Explicit references to process "scheme" have been replaced with
 57;;;   (scheme-proc). This allows better handling of multiple process bufs.
 58;;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
 59;;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist
 60;;;   and friends, but interested hackers might find a useful application
 61;;;   of this facility.
 62;;;
 63;;; 3/12/90 Olin
 64;;; - scheme-load-file and scheme-compile-file no longer switch-to-scheme.
 65;;;   Tale suggested this.
 66;;;
 67;;; 2/08/08 sjs
 68;;; - Adapted for Arc (basically s/scheme/arc/g)
 69
 70;;; Code:
 71
 72(require 'arc)
 73(require 'comint)
 74
 75
 76(defgroup arc nil
 77  "Run an Arc process in a buffer."
 78  :group 'arc)
 79
 80;;; INFERIOR ARC MODE STUFF
 81;;;============================================================================
 82
 83(defcustom inferior-arc-mode-hook nil
 84  "*Hook for customizing inferior-arc mode."
 85  :type 'hook
 86  :group 'arc)
 87
 88(defvar inferior-arc-mode-map
 89  (let ((m (make-sparse-keymap)))
 90    (define-key m "\M-\C-x" 'arc-send-definition) ;gnu convention
 91    (define-key m "\C-x\C-e" 'arc-send-last-sexp)
 92    (define-key m "\C-c\C-l" 'arc-load-file)
 93    m))
 94
 95(defvar arc-program-name "arc --no-rl"
 96  "The name of the program used to run Arc.")
 97
 98;; Install the process communication commands in the arc-mode keymap.
 99(define-key arc-mode-map "\M-\C-x" 'arc-send-definition);gnu convention
100(define-key arc-mode-map "\C-x\C-e" 'arc-send-last-sexp);gnu convention
101(define-key arc-mode-map "\C-c\C-e" 'arc-send-definition)
102(define-key arc-mode-map "\C-c\M-e" 'arc-send-definition-and-go)
103(define-key arc-mode-map "\C-c\C-r" 'arc-send-region)
104(define-key arc-mode-map "\C-c\M-r" 'arc-send-region-and-go)
105(define-key arc-mode-map "\C-c\C-x" 'arc-expand-current-form)
106(define-key arc-mode-map "\C-c\C-z" 'switch-to-arc)
107(define-key arc-mode-map "\C-c\C-l" 'arc-load-file)
108
109(let ((map (lookup-key arc-mode-map [menu-bar arc])))
110  (define-key map [separator-eval] '("--"))
111  (define-key map [load-file]
112    '("Load Arc File" . arc-load-file))
113  (define-key map [switch]
114    '("Switch to Arc" . switch-to-arc))
115  (define-key map [exp-form]
116    '("Expand current form" . arc-expand-current-form))
117  (define-key map [send-def-go]
118    '("Evaluate Last Definition & Go" . arc-send-definition-and-go))
119  (define-key map [send-def]
120    '("Evaluate Last Definition" . arc-send-definition))
121  (define-key map [send-region-go]
122    '("Evaluate Region & Go" . arc-send-region-and-go))
123  (define-key map [send-region]
124    '("Evaluate Region" . arc-send-region))
125  (define-key map [send-sexp]
126    '("Evaluate Last S-expression" . arc-send-last-sexp))
127  )
128
129(defvar arc-buffer)
130
131(define-derived-mode inferior-arc-mode comint-mode "Inferior Arc"
132  "Major mode for interacting with an inferior Arc process.
133
134The following commands are available:
135\\{inferior-arc-mode-map}
136
137An Arc process can be fired up with M-x run-arc.
138
139Customization: Entry to this mode runs the hooks on comint-mode-hook and
140inferior-arc-mode-hook (in that order).
141
142You can send text to the inferior Arc process from other buffers containing
143Arc source.
144    switch-to-arc switches the current buffer to the Arc process buffer.
145    arc-send-definition sends the current definition to the Arc process.
146    arc-send-region sends the current region to the Arc process.
147
148    arc-send-definition-and-go and arc-send-region-and-go
149        switch to the Arc process buffer after sending their text.
150For information on running multiple processes in multiple buffers, see
151documentation for variable arc-buffer.
152
153Commands:
154Return after the end of the process' output sends the text from the
155    end of process to point.
156Return before the end of the process' output copies the sexp ending at point
157    to the end of the process' output, and sends it.
158Delete converts tabs to spaces as it moves back.
159Tab indents for Arc; with argument, shifts rest
160    of expression rigidly with the current line.
161C-M-q does Tab on each line starting within following expression.
162Paragraphs are separated only by blank lines.  Semicolons start comments.
163If you accidentally suspend your process, use \\[comint-continue-subjob]
164to continue it."
165  ;; Customize in inferior-arc-mode-hook
166  (arc-mode-variables)
167  (set (make-local-variable 'comint-prompt-regexp) "^[^>\n]*>+ *")
168  (set (make-local-variable 'comint-input-filter) (function arc-input-filter))
169  (set (make-local-variable 'comint-get-old-input) (function arc-get-old-input))
170  (setq mode-line-process '(":%s")))
171
172(defcustom inferior-arc-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
173  "*Input matching this regexp are not saved on the history list.
174Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters."
175  :type 'regexp
176  :group 'arc)
177
178(defun arc-input-filter (str)
179  "Don't save anything matching `inferior-arc-filter-regexp'."
180  (not (string-match inferior-arc-filter-regexp str)))
181
182(defun arc-get-old-input ()
183  "Snarf the sexp ending at point."
184  (save-excursion
185    (let ((end (point)))
186      (backward-sexp)
187      (buffer-substring (point) end))))
188
189;;;###autoload
190(defun run-arc (cmd)
191  "Run an inferior Arc process, input and output via buffer `*arc*'.
192If there is a process already running in `*arc*', switch to that buffer.
193With argument, allows you to edit the command line (default is value
194of `arc-program-name').
195Runs the hook `inferior-arc-mode-hook' \(after the `comint-mode-hook'
196is run).
197\(Type \\[describe-mode] in the process buffer for a list of commands.)"
198
199  (interactive (list (if current-prefix-arg
200                         (read-string "Run Arc: " arc-program-name)
201                         arc-program-name)))
202  (when (not (comint-check-proc "*arc*"))
203    (let ((cmdlist (split-string cmd)))
204      (set-buffer (apply 'make-comint "arc" (car cmdlist)
205                         nil (cdr cmdlist)))
206      (inferior-arc-mode)))
207  (setq arc-program-name cmd)
208  (setq arc-buffer "*arc*")
209  (pop-to-buffer "*arc*"))
210;;;###autoload (add-hook 'same-window-buffer-names "*arc*")
211
212(defun arc-send-region (start end)
213  "Send the current region to the inferior Arc process."
214  (interactive "r")
215  (comint-send-region (arc-proc) start end)
216  (comint-send-string (arc-proc) "\n"))
217
218(defun arc-send-definition ()
219  "Send the current definition to the inferior Arc process."
220  (interactive)
221  (save-excursion
222   (end-of-defun)
223   (let ((end (point)))
224     (beginning-of-defun)
225     (arc-send-region (point) end))))
226
227(defun arc-send-last-sexp ()
228  "Send the previous sexp to the inferior Arc process."
229  (interactive)
230  (arc-send-region (save-excursion (backward-sexp) (point)) (point)))
231
232(defun arc-expand-current-form ()
233  "Macro-expand the form at point in the inferior Arc process."
234  (interactive)
235  (let ((current-form (arc-form-at-point)))
236    (if current-form
237        (progn
238          (comint-send-string (arc-proc)
239                              (format "(macex1 '%s)" current-form))
240          (comint-send-string (arc-proc) "\n"))
241      (error "Not at a form"))))
242
243(defun arc-form-at-point ()
244  (let ((next-sexp (thing-at-point 'sexp)))
245    (if (and next-sexp (string-equal (substring next-sexp 0 1) "("))
246        next-sexp
247      (save-excursion
248        (backward-up-list)
249        (arc-form-at-point)))))
250
251(defun switch-to-arc (eob-p)
252  "Switch to the arc process buffer.
253With argument, position cursor at end of buffer."
254  (interactive "P")
255  (if (or (and arc-buffer (get-buffer arc-buffer))
256          (arc-interactively-start-process))
257      (pop-to-buffer arc-buffer)
258    (error "No current process buffer.  See variable `arc-buffer'"))
259  (when eob-p
260    (push-mark)
261    (goto-char (point-max))))
262
263(defun arc-send-region-and-go (start end)
264  "Send the current region to the inferior Arc process.
265Then switch to the process buffer."
266  (interactive "r")
267  (arc-send-region start end)
268  (switch-to-arc t))
269
270(defun arc-send-definition-and-go ()
271  "Send the current definition to the inferior Arc.
272Then switch to the process buffer."
273  (interactive)
274  (arc-send-definition)
275  (switch-to-arc t))
276
277(defcustom arc-source-modes '(arc-mode)
278  "*Used to determine if a buffer contains Arc source code.
279If it's loaded into a buffer that is in one of these major modes,
280it's considered a arc source file by `arc-load-file'.  Used by
281these commands to determine defaults."
282  :type '(repeat function)
283  :group 'arc)
284
285(defvar arc-prev-load-dir/file nil
286  "Caches the last (directory . file) pair.
287Caches the last pair used in the last `arc-load-file' command.
288Used for determining the default in the next one.")
289
290(defun arc-load-file (file-name)
291  "Load a Arc file FILE-NAME into the inferior Arc process."
292  (interactive (comint-get-source "Load Arc file: " arc-prev-load-dir/file
293                                  arc-source-modes t)) ; t because `load'
294                                                       ; needs an exact name
295  (comint-check-source file-name) ; Check to see if buffer needs saved.
296  (setq arc-prev-l/c-dir/file (cons (file-name-directory    file-name)
297                                       (file-name-nondirectory file-name)))
298  (comint-send-string (arc-proc) (concat "(load \""
299                                            file-name
300                                            "\"\)\n")))
301
302
303(defvar arc-buffer nil "*The current arc process buffer.
304
305MULTIPLE PROCESS SUPPORT
306===========================================================================
307inferior-arc.el supports, in a fairly simple fashion, running multiple Arc
308processes.  To run multiple Arc processes, you start the first up with
309\\[run-arc].  It will be in a buffer named *arc*.  Rename this buffer
310with \\[rename-buffer].  You may now start up a new process with another
311\\[run-arc].  It will be in a new buffer, named *arc*.  You can
312switch between the different process buffers with \\[switch-to-buffer].
313
314Commands that send text from source buffers to Arc processes -- like
315`arc-send-definition' -- have to choose a process to send to, when you
316have more than one Arc process around.  This is determined by the
317global variable `arc-buffer'.  Suppose you have three inferior Arcs
318running:
319    Buffer      Process
320    foo         arc
321    bar         arc<2>
322    *arc*    arc<3>
323If you do a \\[arc-send-definition-and-go] command on some Arc source
324code, what process do you send it to?
325
326- If you're in a process buffer (foo, bar, or *arc*),
327  you send it to that process.
328- If you're in some other buffer (e.g., a source file), you
329  send it to the process attached to buffer `arc-buffer'.
330This process selection is performed by function `arc-proc'.
331
332Whenever \\[run-arc] fires up a new process, it resets `arc-buffer'
333to be the new process's buffer.  If you only run one process, this will
334do the right thing.  If you run multiple processes, you can change
335`arc-buffer' to another process buffer with \\[set-variable].
336
337More sophisticated approaches are, of course, possible.  If you find yourself
338needing to switch back and forth between multiple processes frequently,
339you may wish to consider ilisp.el, a larger, more sophisticated package
340for running inferior Lisp and Arc processes.  The approach taken here is
341for a minimal, simple implementation.  Feel free to extend it.")
342
343(defun arc-proc ()
344  "Return the current Arc process, starting one if necessary.
345See variable `arc-buffer'."
346  (unless (and arc-buffer
347               (get-buffer arc-buffer)
348               (comint-check-proc arc-buffer))
349    (arc-interactively-start-process))
350  (or (arc-get-process)
351      (error "No current process.  See variable `arc-buffer'")))
352
353(defun arc-get-process ()
354  "Return the current Arc process or nil if none is running."
355  (get-buffer-process (if (eq major-mode 'inferior-arc-mode)
356                          (current-buffer)
357                        arc-buffer)))
358
359(defun arc-interactively-start-process (&optional cmd)
360  "Start an inferior Arc process.  Return the process started.
361Since this command is run implicitly, always ask the user for the
362command to run."
363  (save-window-excursion
364    (run-arc (read-string "Run Arc: " arc-program-name))))
365
366;;; Do the user's customization...
367
368(defcustom inferior-arc-load-hook nil
369  "This hook is run when inferior-arc is loaded in.
370This is a good place to put keybindings."
371  :type 'hook
372  :group 'arc)
373
374(run-hooks 'inferior-arc-load-hook)
375
376(provide 'inferior-arc)
377
378;;; inferior-arc.el ends here