/[emacs]/emacs/lisp/cmuscheme.el
ViewVC logotype

Diff of /emacs/lisp/cmuscheme.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.37 by lute, Mon Jul 4 23:08:52 2005 UTC revision 1.38 by eliz, Sat Aug 6 07:37:45 2005 UTC
# Line 127  Line 127 
127  (define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)  (define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)
128  (define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)  (define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)
129  (define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)  (define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)
130    (define-key scheme-mode-map "\C-c\C-t" 'scheme-trace-procedure)
131    (define-key scheme-mode-map "\C-c\C-x" 'scheme-expand-current-form)
132  (define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)  (define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)
133  (define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)  (define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)
134  (define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"  (define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"
# Line 143  Line 145 
145      '("Compile Definition & Go" . scheme-compile-definition-and-go))      '("Compile Definition & Go" . scheme-compile-definition-and-go))
146    (define-key map [com-def]    (define-key map [com-def]
147      '("Compile Definition" . scheme-compile-definition))      '("Compile Definition" . scheme-compile-definition))
148      (define-key map [exp-form]
149        '("Expand current form" . scheme-expand-current-form))
150      (define-key map [trace-proc]
151        '("Trace procedure" . scheme-trace-procedure))
152    (define-key map [send-def-go]    (define-key map [send-def-go]
153      '("Evaluate Last Definition & Go" . scheme-send-definition-and-go))      '("Evaluate Last Definition & Go" . scheme-send-definition-and-go))
154    (define-key map [send-def]    (define-key map [send-def]
# Line 153  Line 159 
159      '("Evaluate Region" . scheme-send-region))      '("Evaluate Region" . scheme-send-region))
160    (define-key map [send-sexp]    (define-key map [send-sexp]
161      '("Evaluate Last S-expression" . scheme-send-last-sexp))      '("Evaluate Last S-expression" . scheme-send-last-sexp))
162  )    )
163    
164  (defvar scheme-buffer)  (defvar scheme-buffer)
165    
# Line 233  Defaults to a regexp ignoring all inputs Line 239  Defaults to a regexp ignoring all inputs
239    
240  ;;;###autoload  ;;;###autoload
241  (defun run-scheme (cmd)  (defun run-scheme (cmd)
242    "Run an inferior Scheme process, input and output via buffer *scheme*.    "Run an inferior Scheme process, input and output via buffer `*scheme*'.
243  If there is a process already running in `*scheme*', switch to that buffer.  If there is a process already running in `*scheme*', switch to that buffer.
244  With argument, allows you to edit the command line (default is value  With argument, allows you to edit the command line (default is value
245  of `scheme-program-name').  Runs the hooks `inferior-scheme-mode-hook'  of `scheme-program-name').
246  \(after the `comint-mode-hook' is run).  If a file `~/.emacs_SCHEMENAME' exists, it is given as initial input.
247    Note that this may lose due to a timing error if the Scheme processor
248    discards input when it starts up.
249    Runs the hook `inferior-scheme-mode-hook' \(after the `comint-mode-hook'
250    is run).
251  \(Type \\[describe-mode] in the process buffer for a list of commands.)"  \(Type \\[describe-mode] in the process buffer for a list of commands.)"
252    
253    (interactive (list (if current-prefix-arg    (interactive (list (if current-prefix-arg
# Line 246  of `scheme-program-name').  Runs the hoo Line 256  of `scheme-program-name').  Runs the hoo
256    (if (not (comint-check-proc "*scheme*"))    (if (not (comint-check-proc "*scheme*"))
257        (let ((cmdlist (scheme-args-to-list cmd)))        (let ((cmdlist (scheme-args-to-list cmd)))
258          (set-buffer (apply 'make-comint "scheme" (car cmdlist)          (set-buffer (apply 'make-comint "scheme" (car cmdlist)
259                             nil (cdr cmdlist)))                             (scheme-start-file (car cmdlist)) (cdr cmdlist)))
260          (inferior-scheme-mode)))          (inferior-scheme-mode)))
261    (setq scheme-program-name cmd)    (setq scheme-program-name cmd)
262    (setq scheme-buffer "*scheme*")    (setq scheme-buffer "*scheme*")
263    (pop-to-buffer "*scheme*"))    (pop-to-buffer "*scheme*"))
264  ;;;###autoload (add-hook 'same-window-buffer-names "*scheme*")  ;;;###autoload (add-hook 'same-window-buffer-names "*scheme*")
265    
266    (defun scheme-start-file (prog)
267      "Return the name of the start file corresponding to PROG.
268    Search in the directories \"~\" and \"~/.emacs.d\", in this
269    order.  Return nil if no start file found."
270      (let* ((name (concat ".emacs_" (file-name-nondirectory prog)))
271             (start-file (concat "~/" name)))
272        (if (file-exists-p start-file)
273            start-file
274          (let ((start-file (concat user-emacs-directory name)))
275            (and (file-exists-p start-file) start-file)))))
276    
277  (defun scheme-send-region (start end)  (defun scheme-send-region (start end)
278    "Send the current region to the inferior Scheme process."    "Send the current region to the inferior Scheme process."
279    (interactive "r")    (interactive "r")
# Line 296  of `scheme-program-name').  Runs the hoo Line 317  of `scheme-program-name').  Runs the hoo
317       (beginning-of-defun)       (beginning-of-defun)
318       (scheme-compile-region (point) end))))       (scheme-compile-region (point) end))))
319    
320    (defcustom scheme-trace-command "(trace %s)"
321      "*Template for issuing commands to trace a Scheme procedure.
322    Some Scheme implementations might require more elaborate commands here.
323    For PLT-Scheme, e.g., one should use
324    
325       (setq scheme-trace-command \"(begin (require (lib \\\"trace.ss\\\")) (trace %s))\")
326    
327    For Scheme 48 and Scsh use \",trace %s\"."
328      :type 'string
329      :group 'cmuscheme)
330    
331    (defcustom scheme-untrace-command "(untrace %s)"
332      "*Template for switching off tracing of a Scheme procedure.
333    Scheme 48 and Scsh users should set this variable to \",untrace %s\"."
334    
335      :type 'string
336      :group 'cmuscheme)
337    
338    (defun scheme-trace-procedure (proc &optional untrace)
339      "Trace procedure PROC in the inferior Scheme process.
340    With a prefix argument switch off tracing of procedure PROC."
341      (interactive
342       (list (let ((current (symbol-at-point))
343                   (action (if current-prefix-arg "Untrace" "Trace")))
344               (if current
345                   (read-string (format "%s procedure [%s]: " action current) nil nil (symbol-name current))
346                 (read-string (format "%s procedure: " action))))
347             current-prefix-arg))
348      (when (= (length proc) 0)
349        (error "Invalid procedure name"))
350      (comint-send-string (scheme-proc)
351                          (format
352                           (if untrace scheme-untrace-command scheme-trace-command)
353                           proc))
354      (comint-send-string (scheme-proc) "\n"))
355    
356    (defcustom scheme-macro-expand-command "(expand %s)"
357      "*Template for macro-expanding a Scheme form.
358    For Scheme 48 and Scsh use \",expand %s\"."
359      :type 'string
360      :group 'cmuscheme)
361    
362    (defun scheme-expand-current-form ()
363      "Macro-expand the form at point in the inferior Scheme process."
364      (interactive)
365      (let ((current-form (scheme-form-at-point)))
366        (if current-form
367            (progn
368              (comint-send-string (scheme-proc)
369                                  (format
370                                   scheme-macro-expand-command
371                                   current-form))
372              (comint-send-string (scheme-proc) "\n"))      
373          (error "Not at a form"))))
374    
375    (defun scheme-form-at-point ()
376      (let ((next-sexp (thing-at-point 'sexp)))
377        (if (and next-sexp (string-equal (substring next-sexp 0 1) "("))
378            next-sexp
379          (save-excursion
380            (backward-up-list)
381            (scheme-form-at-point)))))
382    
383  (defun switch-to-scheme (eob-p)  (defun switch-to-scheme (eob-p)
384    "Switch to the scheme process buffer.    "Switch to the scheme process buffer.
385  With argument, position cursor at end of buffer."  With argument, position cursor at end of buffer."
386    (interactive "P")    (interactive "P")
387    (if (get-buffer scheme-buffer)    (if (or (and scheme-buffer (get-buffer scheme-buffer))
388              (scheme-interactively-start-process))
389        (pop-to-buffer scheme-buffer)        (pop-to-buffer scheme-buffer)
390        (error "No current process buffer.  See variable `scheme-buffer'"))      (error "No current process buffer.  See variable `scheme-buffer'"))
391    (cond (eob-p    (when eob-p
392           (push-mark)      (push-mark)
393           (goto-char (point-max)))))      (goto-char (point-max))))
394    
395  (defun scheme-send-region-and-go (start end)  (defun scheme-send-region-and-go (start end)
396    "Send the current region to the inferior Scheme process.    "Send the current region to the inferior Scheme process.
# Line 417  for running inferior Lisp and Scheme pro Line 502  for running inferior Lisp and Scheme pro
502  for a minimal, simple implementation.  Feel free to extend it.")  for a minimal, simple implementation.  Feel free to extend it.")
503    
504  (defun scheme-proc ()  (defun scheme-proc ()
505    "Return the current scheme process.  See variable `scheme-buffer'."    "Return the current Scheme process, starting one if necessary.
506    (let ((proc (get-buffer-process (if (eq major-mode 'inferior-scheme-mode)  See variable `scheme-buffer'."
507                                        (current-buffer)    (unless (and scheme-buffer
508                                        scheme-buffer))))                 (get-buffer scheme-buffer)
509      (or proc                 (comint-check-proc scheme-buffer))
510          (error "No current process.  See variable `scheme-buffer'"))))      (scheme-interactively-start-process))
511      (or (scheme-get-process)
512          (error "No current process.  See variable `scheme-buffer'")))
513    
514    (defun scheme-get-process ()
515      "Return the current Scheme process or nil if none is running."
516      (get-buffer-process (if (eq major-mode 'inferior-scheme-mode)
517                              (current-buffer)
518                            scheme-buffer)))
519    
520    (defun scheme-interactively-start-process (&optional cmd)
521      "Start an inferior Scheme process.  Return the process started.
522    Since this command is run implicitly, always ask the user for the
523    command to run."
524      (save-window-excursion
525        (run-scheme (read-string "Run Scheme: " scheme-program-name))))
526    
527  ;;; Do the user's customisation...  ;;; Do the user's customisation...
528    

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.38

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26