From 5df2b4cc171fa8857e821f525ab8abef1843fcbe Mon Sep 17 00:00:00 2001
From: Christian Cunningham <cc@localhost>
Date: Tue, 4 Jun 2024 18:28:19 -0700
Subject: Add Guile Interaction

---
 extras/guile-interaction.el | 99 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 99 insertions(+)
 create mode 100644 extras/guile-interaction.el

(limited to 'extras/guile-interaction.el')

diff --git a/extras/guile-interaction.el b/extras/guile-interaction.el
new file mode 100644
index 0000000..5cad6d0
--- /dev/null
+++ b/extras/guile-interaction.el
@@ -0,0 +1,99 @@
+;;;
+;;; $Id: guile-interface.el,v 1.11 1997/06/19 22:10:56 mcmanr Exp $
+;;;
+
+(defun guile-send-header-forms ()
+  "go to the top of the buffer and examine top level 
+forms.  send header forms to the inferior scheme process.
+header forms are forms involving the guile module system
+and forms to load code from slib.  quit searching when
+a non-header form is encountered."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (forward-list 1)
+    (forward-list -1)
+    (while (or (looking-at "(define-module")
+	       (looking-at "(set-current-module")
+	       (looking-at "(use-modules")
+	       (looking-at "(require"))
+      (lisp-eval-defun)
+      (forward-list 2)
+      (forward-list -1))))
+
+(defun guile-send-definition ()
+  "Sends header forms, then the currrent definition,
+to the inferior scheme process,"
+  (interactive)
+  (guile-send-header-forms)
+  (lisp-eval-defun))
+
+(defun guile-send-region ()
+  "Sends header forms, then the current region to the 
+inferior scheme process.  also send a silly form on the
+end to make sure that the reader is not hanging waiting
+on white space."
+  (interactive)
+  (let ((buf (current-buffer)))
+    (guile-send-header-forms)
+    (lisp-eval-region (point) (mark))
+    (comint-send-string 
+     (get-process "inferior-lisp") 
+     "(quote done-sending-region)\n")))
+
+(defun guile-run-lisp ()
+  "wrapper around run-lisp from inf-lisp.el, that does some
+snazzy buffer switching."
+  (interactive "")
+  (if (not (eq (process-status "inferior-lisp") 'run))
+      (let ((start-buf (current-buffer)))
+	(run-lisp inferior-lisp-program)
+	(switch-to-buffer start-buf))
+    (let ((start-buf (current-buffer))
+	  (lisp-buf (get-buffer "*inferior-lisp*")))
+      (switch-to-buffer-other-window lisp-buf)
+      (goto-char (point-max))
+      (switch-to-buffer-other-window start-buf))))
+
+(defun guile-procedure-documentation ()
+  "get the inferior lisp process to print the doc string
+of the procedure whose name is under point.  this involves
+first setting the current module."
+  (interactive)
+  (guile-run-lisp)
+  (guile-send-header-forms)
+  (save-excursion
+    (let ((process (get-process "inferior-lisp")))
+      (backward-sexp)
+      (set-mark (point))
+      (forward-sexp 1)
+      (let ((str (buffer-substring (point) (mark))))
+	(comint-send-string 
+	 process 
+	 (concat
+	  "(begin "
+	  "  (newline)"
+	  "  (display " str ")"
+	  "  (newline)"
+	  "  (procedure-documentation " str "))\n"))))))
+
+;;;
+;;; scheme mode customization
+;;;
+(setq inferior-lisp-program "/usr/local/bin/guile")
+
+
+(defvar menu-bar-my-scheme-menu (make-sparse-keymap "Scheme"))
+(define-key menu-bar-my-scheme-menu [my-scheme-run-scheme]
+  '("Run Scheme" . guile-run-lisp))
+
+(defun my-scheme-mode-hook ()
+  (turn-on-font-lock)
+  (define-key scheme-mode-map (read-kbd-macro "C-c r") 'guile-send-region)
+  (define-key scheme-mode-map (read-kbd-macro "C-c e") 'guile-send-definition)
+  (define-key scheme-mode-map (read-kbd-macro "C-c d") 'guile-procedure-documentation)
+  (define-key scheme-mode-map (read-kbd-macro "C-c x") 'guile-run-lisp))
+
+(add-hook 'scheme-mode-hook 'my-scheme-mode-hook)
+
+(provide 'guile-interaction)
-- 
cgit v1.2.1