Commits

steveb  committed 37fc0b7

add cmuscheme48.el, maintainer is now Karl Hegbloom

  • Participants
  • Parent commits c72ed46

Comments (0)

Files changed (4)

+1998-04-11  SL Baur  <steve@altair.xemacs.org>
+
+	* cmuscheme48.el: New file.
+
 1998-01-24  SL Baur  <steve@altair.xemacs.org>
 
 	* Makefile (VERSION): Updated to package standard 1.0.
 # the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 # Boston, MA 02111-1307, USA.
 
-VERSION = 1.02
+VERSION = 1.03
 AUTHOR_VERSION =
-MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
+MAINTAINER = Karl M. Hegbloom <karlheg@bittersweet.inetarena.com>
 PACKAGE = scheme
 PKG_TYPE = regular
 REQUIRES = xemacs-base
 CATEGORY = prog
 
-ELCS = scheme.elc xscheme.elc cmuscheme.elc
+ELCS = scheme.elc xscheme.elc cmuscheme.elc cmuscheme48.elc
 
 include ../../XEmacs.rules
 

File cmuscheme48.el

+;;; 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))
+
+(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.")

File package-info.in

    filename FILENAME
    md5sum MD5SUM
    size SIZE
-   provides (scheme xscheme cmuscheme)
+   provides (scheme xscheme cmuscheme cmuscheme48)
    requires (REQUIRES)
    type regular
 ))