/usr/share/emacs/site-lisp/cmuscheme48.el is in scsh-common-0.6 0.6.7-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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.")
|