File: cmuscheme48.el

package info (click to toggle)
scsh 0.5.1-2
  • links: PTS
  • area: non-free
  • in suites: potato, slink
  • size: 6,540 kB
  • ctags: 8,656
  • sloc: lisp: 39,346; ansic: 13,466; sh: 1,669; makefile: 624
file content (116 lines) | stat: -rw-r--r-- 4,092 bytes parent folder | download | duplicates (11)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
;;; cmuscheme48.el -- Scheme process in a buffer.  Adapted from cmuscheme.el.

(provide 'cmuscheme48)
(require 'cmuscheme)

;;;###autoload
(defvar scsh-program-name "scsh"
  "The program name and arguments to be invoked for the `run-scsh'
command.")

;;;###autoload
(defun run-scsh (arg)
  "Run inferiour `scsh'.  See the documentation to `run-scheme' after
`cmuscheme' has been `require'd."
  (interactive (list (if current-prefix-arg
			 (read-string "Run Scsh: " scsh-program-name)
		       scsh-program-name)))
  (run-scheme scsh-program-name))

;; For `scsh':
(put 'with-cwd 'scheme-indent-function 1)

(define-key scheme-mode-map "\M-\C-x" 'scheme48-send-definition);gnu convention
(define-key scheme-mode-map "\C-x\C-e" 'scheme48-send-last-sexp);gnu convention
(define-key scheme-mode-map "\C-ce"    'scheme48-send-definition)
(define-key scheme-mode-map "\C-c\C-e" 'scheme48-send-definition-and-go)
(define-key scheme-mode-map "\C-cr"    'scheme48-send-region)
(define-key scheme-mode-map "\C-c\C-r" 'scheme48-send-region-and-go)
(define-key scheme-mode-map "\C-cl"    'scheme48-load-file)

(defun scheme48-send-region (start end)
  "Send the current region to the inferior Scheme process."
  (interactive "r")
  (comint-send-string (scheme-proc)
		      (concat ",from-file "
			      (enough-scheme-file-name
			       (buffer-file-name (current-buffer)))
			      "\n"))
  (comint-send-region (scheme-proc) start end)
  (comint-send-string (scheme-proc) " ,end\n"))

; This assumes that when you load things into Scheme 48, you type
; names of files in your home directory using the syntax "~/".
; Similarly for current directory.  Maybe we ought to send multiple
; file names to Scheme and let it look at all of them.

(defun enough-scheme-file-name (file)
  (let* ((scheme-dir
	  (save-excursion
	    (set-buffer scheme-buffer)
	    (expand-file-name default-directory)))
	 (len (length scheme-dir)))
    (if (and (> (length file) len)
	     (string-equal scheme-dir (substring file 0 len)))
	(substring file len)
	(if *scheme48-home-directory-kludge*
	    (let* ((home-dir (expand-file-name "~/"))
		   (len (length home-dir)))
	      (if (and (> (length file) len)
		       (string-equal home-dir (substring file 0 len)))
		  (concat "~/" (substring file len))
		  file))
	    file))))

(defvar *scheme48-home-directory-kludge* t)

(defun scheme48-send-definition (losep)
  "Send the current definition to the inferior Scheme48 process."
  (interactive "P")
  (save-excursion
   (end-of-defun)
   (let ((end (point)))
     (beginning-of-defun)
     (if losep
	 (let ((loser "/tmp/s48lose.tmp"))
	   (write-region (point) end loser)
	   (scheme48-load-file loser))
	 (scheme48-send-region (point) end)))))

(defun scheme48-send-last-sexp ()
  "Send the previous sexp to the inferior Scheme process."
  (interactive)
  (scheme48-send-region (save-excursion (backward-sexp) (point)) (point)))

(defun scheme48-send-region-and-go (start end)
  "Send the current region to the inferior Scheme48 process,
and switch to the process buffer."
  (interactive "r")
  (scheme48-send-region start end)
  (switch-to-scheme t))

(defun scheme48-send-definition-and-go (losep)
  "Send the current definition to the inferior Scheme48,
and switch to the process buffer."
  (interactive "P")
  (scheme48-send-definition losep)
  (switch-to-scheme t))

(defun scheme48-load-file (file-name)
  "Load a Scheme file into the inferior Scheme48 process."
  (interactive (comint-get-source "Load Scheme48 file: "
				  scheme-prev-l/c-dir/file
				  scheme-source-modes t)) ; T because LOAD 
                                                          ; needs an exact name
  (comint-check-source file-name) ; Check to see if buffer needs saved.
  (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
				       (file-name-nondirectory file-name)))
  (comint-send-string (scheme-proc)
		      (concat ",load "
			      (enough-scheme-file-name file-name)
			      "\n")))


; For Pertti Kellom\"aki's debugger.
; Cf. misc/psd-s48.scm.
(defvar psd-using-slib nil "Scheme 48, not SLIB.")