1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

Import Mikael's Emacs interface code (guileint-1.5.2) into Guile CVS.

This commit is contained in:
Neil Jerram 2003-08-20 19:00:44 +00:00
parent 2388d9af3e
commit db24983896
15 changed files with 3263 additions and 0 deletions

View file

@ -1,3 +1,9 @@
2003-08-20 Neil Jerram <neil@ossau.uklinux.net>
* guileint: New subdirectory.
* README: Mention it.
2001-11-19 Thien-Thi Nguyen <ttn@giblet.glug.org> 2001-11-19 Thien-Thi Nguyen <ttn@giblet.glug.org>
* README: Use less forking for indexing command. * README: Use less forking for indexing command.

View file

@ -9,5 +9,6 @@ patch.el --- mail/apply a patch
ppexpand.el --- temporarily expanding macros in a pretty way. ppexpand.el --- temporarily expanding macros in a pretty way.
update-changelog.el --- stitch rcs2log output to ChangeLog update-changelog.el --- stitch rcs2log output to ChangeLog
guileint --- directory containing experimental Emacs interface for Guile
Generated using: for f in *.el ; do sed -e 's/^....//g' -e '1q' $f ; done Generated using: for f in *.el ; do sed -e 's/^....//g' -e '1q' $f ; done

235
emacs/guileint/ChangeLog Normal file
View file

@ -0,0 +1,235 @@
2003-08-20 Neil Jerram <neil@ossau.uklinux.net>
Import of Mikael's guileint-1.5.2.tgz into Guile CVS ...
* defmenu.el, fcreate.el, guile-init.el, guile.el, guileint.el,
inda-scheme.el: Imported unchanged.
* cmuscheme.el.diff, comint.el.diff, scheme.el.diff,
xscheme.el.diff: Created by diffing Mikael's versions against the
nearest revisions I could find in Emacs CVS, so as to show the
changes made.
* README.mdj: Renamed from Mikael's `README'.
* README: New.
1999-08-23 Mikael Djurfeldt <mdj@thalamus.nada.kth.se>
* guile.el (guile-frame-eval): Made interactive.
(guile-error-map): Added guile-frame-eval under "e".
1999-03-17 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-file-readable-p, guile-find-file-noselect): New
functions. Sets buffer to scheme-buffer before doing there
action.
(guile-display-scheme-sexp): Use the above functions.
1999-03-16 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-buffer-file-name): Version of buffer-file-name
which uses file-truename;
Use guile-buffer-file-name throughout.
1999-03-15 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guileint.el: Add conditional in order not to load the interface
multiple times.
* guile.el (scheme-virtual-file-list-find): New function. Finds
an finfo entry using a file name. Uses `file-truename';
Replaced all assoc calls with scheme-vertual-file-list-find
everywhere.
(guile-real-safe-backward-sexp): New function. Can skip backwards
over special scheme hash-syntax.
(guile-send-input): Use `guile-real-safe-backward-sexp'.
1999-03-01 Mikael Djurfeldt <mdj@barbara.nada.kth.se>
* inda-scheme.el (scheme-electric-open-paren),
guile.el (guile-indent-or-complete): Use indent-for-tab-command
instead of scheme-indent-line.
* scheme.el: Merge changes from Emacs-20.3.
1998-06-18 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-send-region): Bugfix: Calculate new value for
start if overlays have been skipped.
(guile-send-overlay): Send define-module overlay to define the
module before sending any other overlay belonging to that module.
(guile-reparse-buffer): Detect define-module expressions.
1998-06-14 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-select-stackframe): Increment line number.
1998-06-10 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el: Removed calls to the former debugging function `cb'.
1998-05-21 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el: Added nil nil t arguments in calls to make-overlay in
order to make the overlays rear-sticky. (This is an adaption to
Emacs-20.)
1997-10-22 Mikael Djurfeldt <mdj@nada.kth.se>
* guile.el (guile-stack-frame-map): Need to be fset in Emacs-20.
Wed Oct 1 22:02:19 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* inda-scheme.el (inda-inferior-initializations): Disable
font-lock-mode in inferior-scheme buffers. (For some strange
reason, the inda-read-only-overlay modification hook gets called
when a character is inserted after the prompt if font-lock mode
has been activated.)
Fri Aug 29 01:34:34 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-display-name): Bugfix: filler -->
guile-define-filler.
(guile-send-overlay): Bugfix: Don't print "DEFINED" if start /=
overlay-start.
Added (require 'cl).
(guile-insert-before-prompt): Use guile-last-output-end
Wed Aug 27 17:24:28 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-complete-symbol): Bugfix: Don't do anything if
word is nil.
(guile-backtrace-in-source-window): New customization option.
(guile-display-error): Don't place backtrace in source window if
guile-backtrace-in-source-window is nil.
(guile-prep-backtrace): Set syntax-table to
scheme-mode-syntax-table.
Tue Aug 26 00:01:01 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-insert-before-prompt): Move the recenter code
here.
(guile-display-name): Use guile-insert-before-prompt.
Mon Aug 25 22:46:23 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-display-name): Recenter display if prompt
started at the beginning of the buffer, so that the first text
inserted before prompt will be visible.
Mon Aug 25 19:36:50 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el: New variable: guile-frame-overlay.
(guile-inferior-initialize): Initialize guile-frame-overlay to
nil.
(guile-place-frame-overlay, guile-turn-off-frame-overlay,
guile-unselect-stackframe): New functions.
(guile-unselect-stackframe): Turn off overlay and set
guile-selected-frame to nil.
(guile-stack-frame): New overlay category.
(guile-selected-frame): defun --> defvar
(guile-exit-debug): Turn off frame overlay.
(guile-prep-backtrace): Call `guile-unselect-stackframe'.
(guile-turn-off-sexp-overlay, guile-turn-off-frame-overlay): Check
(car args) before applying `delete-overlay'.
(guile-error-map): Bind S-mouse-2 to guile-frame-eval-at-click.
* inda-scheme.el (inda-scheme-mode-initializations): Bind
S-mouse-2 to guile-frame-eval-at-click; Bind M-TAB to
guile-complete-symbol.
* guile.el (guile-complete-symbol): Made a command.
(guile-frame-eval-at-click, guile-frame-eval): New functions.
Enables clicking on expressions in the source buffer to show their
values.
(guile-complete-symbol, guile-list-completions): Bugfix: Use
`buffer-name' instead of `current-buffer' in order to obtain the
buffer name.
(guile-select-frame): Always set guile-selected-frame.
Mon Aug 25 16:21:18 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-eval): Must wait for scheme-ready-p so that the
filter functions don't get called.
(guile-describe-variable): Put `guile-force-splittable' around
call to `with-output-to-temp-buffer' so that documentation can be
displayed also in *scheme* window even if it is dedicated.
Sun Aug 24 22:19:16 1997 Mikael Djurfeldt <mdj@kenneth>
* *** Transferred code to guile-emacs. ***
* inda-scheme.el (inda-inferior-initializations): Removed
assignment to scheme-pop-to-buffer.
Thu Aug 21 01:47:31 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-eval-result, guile-receive-result, guile-eval):
guile-eval-result now contains the printed representation as a
string instead of an elisp object.
(guile-eval-output): New variable.
(guile-receive-result): Set guile-eval-output to
guile-unallowed-output.
(guile-define-startcol, guile-define-filler,
guile-define-fillcol): New variables. Buffer-local.
(guile-define-header-emitted-p): New variable.
(scheme-send-region): Print result of last sent overlay or show
message "Defined." if definitions have been made.
(guile-insert-before-prompt): Don't use guile-pre-prompt-marker.
(guile-pre-prompt-marker): New name: guile-define-name-marker.
(guile-send-region): Moved printing of defined names to
guile-display-name.
(guile-send-overlay): New parameters; Zeros guile-eval-output;
Adapted to new format of %%emacs-load; Can now send sub-parts of
an overlay; Use guile-display-name.
(guile-display-name): New function.
(guile-receive-result): Reset guile-unallowed-output after having
stored its value in guile-eval-output.
Sat Aug 16 02:53:00 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-display-error): Limit height of *Scheme Error*
window to half of guile-backtrace-max-height.
Thu Jul 24 18:41:56 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* guile.el (guile-normal-edit): Don't set
scheme-buffer-modified-p. This will be done by
guile-scheme-buffer-modified next time the buffer is modified.
(guile-scheme-buffer-modified): New function.
(guile-inferior-initialize): Make first-change-hook buffer-local,
add guile-scheme-modified; Pass t for initialp to
guile-enhanced-edit if the scheme-buffer seems untouched.
* guile.el (guile-normal-edit): Unlink overlays and buffer.
* inda-scheme.el (inda-send-definition, inda-mark-sexp): Make it
possible to send expressions to scheme just by clicking on them.
* guileint.el: Removed statements that doesn't have anything to do
with the Guile interface per se (transient-mark-mode, iso-syntax
etc)
Wed Jul 23 19:11:15 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* inda-scheme.el: Changed inda menu --> interpret.
Thu Jul 17 10:43:58 1997 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* inda96.el (devel-binary): Changed to unstable.
* guile.el (guile-display-buffers): Check for window system before
deleting windows on buffer1.
(guile-get-create-error-window): Treat non-window system
differently.
(scheme-send-region): Don't check for (scheme-ready-p) here. This
is checked in guile-send-region.
(guile-send-region): Check for (scheme-ready-p) here instead.
Go to end-of-buffer before determining proper place for "DEFINED
%s (".
Tue Oct 15 16:56:18 1996 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* Start of revision history for misc elisp files.

0
emacs/guileint/README Normal file
View file

View file

View file

View file

94
emacs/guileint/defmenu.el Normal file
View file

@ -0,0 +1,94 @@
;;; @(#) defmenu.el -- A GNU Emacs extension which helps building menus
;;; @(#) $Keywords: X, menu $
;; Copyright (C) 1995 Mikael Djurfeldt
;; LCD Archive Entry:
;; defmenu|djurfeldt@nada.kth.se|
;; A GNU Emacs extension which helps building menus|
;; $Date: 2003-08-20 19:00:44 $|$Revision: 1.1 $|~/misc/defmenu.el.Z|
;; Author: Mikael Djurfeldt <djurfeldt@nada.kth.se>
;; Version: 1.0
;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 2 of the License, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;; for more details.
;;
;; You should have received a copy of the GNU General Public License along
;; with GNU Emacs. If you did not, write to the Free Software Foundation,
;; Inc., 675 Mass Ave., Cambridge, MA 02139, USA.
;;; Commentary:
;;
;; Requirements:
;;
;; Usage:
;;
;; Bugs:
;;
;;
(defun define-menu (keymap key name entries)
"Define a menu in KEYMAP on fake function key KEY with label NAME.
Every entry in the list ENTRIES defines a menu item and looks like this:
(LABEL DEFINITION [ENABLE-EXP])
LABEL is a string which will appear in the menu.
DEFINITION is either a symbol, in which case it will be used both as
fake function key and binding, or a pair, where the car is the fake
function key and the cdr is the binding.
The optional ENABLE-EXP is an expression which will be evaluated every
time the menu is displayed. If it returns nil the menu item will
be disabled.
You can get a separator by including nil in the ENTRIES list."
(define-key keymap
(vector 'menu-bar key)
(cons name (make-menu name entries))))
(defun make-menu (name entries)
"Make a menu with label NAME.
Every entry in the list ENTRIES defines a menu item and looks like this:
(LABEL DEFINITION [ENABLE-EXP])
LABEL is a string which will appear in the menu.
DEFINITION is either a symbol, in which case it will be used both as
fake function key and binding, or a pair, where the car is the fake
function key and the cdr is the binding.
The optional ENABLE-EXP is an expression which will be evaluated every
time the menu is displayed. If it returns nil the menu item will
be disabled.
You can get a separator by including nil in the ENTRIES list."
(let ((menu (make-sparse-keymap name))
(entries (reverse entries)))
(while entries
(let ((entry (car entries)))
(if (null entry)
(define-key menu (vector (defmenu-gensym "separator")) '("--"))
(if (symbolp (nth 1 entry))
(define-key menu (vector (nth 1 entry))
(cons (car entry) (nth 1 entry)))
(define-key menu (vector (car (nth 1 entry)))
(cons (car entry) (cdr (nth 1 entry)))))
(if (not (null (nthcdr 2 entry)))
(put (nth 1 entry) 'menu-enable (nth 2 entry)))))
(setq entries (cdr entries)))
menu))
(defun defmenu-gensym (prefix)
(let ((counter (intern (concat "defmenu-" prefix "count"))))
(if (boundp counter) (set counter (1+ (symbol-value counter)))
(set counter 0))
(intern (concat prefix (int-to-string (symbol-value counter))))))
(provide 'defmenu)

View file

View file

@ -0,0 +1,152 @@
;;; @(#) guile-init.el --
;;; @(#) $Keywords: $
;; Copyright (C) 1995 Mikael Djurfeldt
;; LCD Archive Entry:
;; guile-init|djurfeldt@nada.kth.se|
;; A GNU Emacs extension which |
;; $Date: 2003-08-20 19:00:44 $|$Revision: 1.1 $|~/misc/<package>.el.Z|
;; Author: Mikael Djurfeldt <djurfeldt@nada.kth.se>
;; Version: 1.0
;; This program is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the Free
;; Software Foundation; either version 2 of the License, or (at your option)
;; any later version.
;;
;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
;; for more details.
;;
;; You should have received a copy of the GNU General Public License along
;; with GNU Emacs. If you did not, write to the Free Software Foundation,
;; Inc., 675 Mass Ave., Cambridge, MA 02139, USA.
;;; Commentary:
;;
;; Requirements:
;;
;; Usage:
;;
;; Bugs:
;;
;;
(defvar guile-init-load-hook nil
"*Hook run when file is loaded")
(require 'guile)
;;; Misc. interactivity
;;;
;;;
(defun inda-barf-at-modifications (&rest args)
(or inhibit-read-only
(error "Attempt to modify read-only text")))
(defun inda-boldify-previous-character ()
;; Must check this so that we don't point outside buffer...
(if (> (point) (point-min))
(let ((inhibit-read-only t))
(put-text-property (1- (point)) (point) 'face 'bold))))
(defun inda-make-input-memory (string)
;; If input consists of many lines, the read-only overlay will
;; cover the previous line, so we have to disable the protection.
(let ((inhibit-read-only t))
;(setq n (1+ n)
; l (append l (list (list n 'input-filter string))))
(if (marker-position guile-last-output-end)
(add-text-properties guile-last-output-end (1- (point))
'(input-memory t rear-nonsticky t mouse-face highlight)))))
(defun inda-reset-guile-last-output (string)
;(setq n (1+ n)
; l (append l (list (list n 'output-filter string))))
(if (not scheme-ready-p)
(set-marker guile-last-output-end nil)))
(define-key inferior-scheme-mode-map [mouse-2] 'inda-mouse-yank-at-click)
(define-key inferior-scheme-mode-map [S-mouse-2] 'inda-mouse-yank-at-click)
;; Should rather be implemented with advice.
(defun inda-mouse-yank-at-click (click arg)
"Insert the last stretch of killed text at the position clicked on.
Also move point to one end of the text thus inserted (normally the end).
Prefix arguments are interpreted as with \\[yank].
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
(interactive "e\nP")
(if (get-char-property (posn-point (event-start click)) 'input-memory)
(if (memq 'shift (event-modifiers (car click)))
(inda-insert-input-memory click)
(inda-insert-input-memory-and-send click))
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))
(setq this-command 'yank)
(yank arg)))
(defun inda-insert-input-memory (event)
(interactive "e")
(let* ((pos (posn-point (event-start event)))
(beg (previous-single-property-change (1+ pos) 'mouse-face))
(end (next-single-property-change pos 'mouse-face)))
(goto-char (point-max))
(let ((input-start (point)))
(comint-kill-input)
(insert (buffer-substring beg end))
(add-text-properties input-start (point)
'(mouse-face nil
rear-nonsticky nil
input-memory nil)))))
(defun inda-insert-input-memory-and-send (event)
(interactive "e")
(inda-insert-input-memory event)
(guile-send-input))
(defun inda-boldify (string)
(put-text-property comint-last-input-start (point) 'face 'bold))
(defun inda-extend-read-only-overlay (string)
(if guile-input-sent-p
(let ((inhibit-read-only t))
(move-overlay inda-read-only-overlay (point-min) (point)))))
;;; Misc. utilities
;;;
(defun scheme-send-buffer ()
"Send the current buffer to the inferior Scheme process."
(interactive)
(let (begin end)
(save-excursion
(goto-char (point-max))
(setq end (point))
(goto-char (point-min))
(setq begin (point)))
(scheme-send-region begin end)))
(defun indent-buffer ()
"Indent entire buffer."
(interactive)
(save-excursion
(end-of-buffer)
(let ((end (point)))
(beginning-of-buffer)
(indent-region (point) end nil))))
(defun indent-defun ()
"Indent lisp definition."
(interactive)
(save-excursion
(end-of-defun)
(let ((end (point)))
(beginning-of-defun)
(indent-region (point) end nil))))
(provide 'guile-init)
(run-hooks 'guile-init-load-hook)

2457
emacs/guileint/guile.el Normal file

File diff suppressed because it is too large Load diff

117
emacs/guileint/guileint.el Normal file
View file

@ -0,0 +1,117 @@
;;; NAME: guileint.el
;;; SYNOPSIS: A Guile/Emacs interface prototype
;;; VERSION: 1.5
;;; LAST CHANGE: 2002-10-19
;;; CREATED: 1997-07-17
;;; AUTHOR: Mikael Djurfeldt <djurfeldt@nada.kth.se>
;;; COPYRIGHT: (C) 1997, 2002 Mikael Djurfeldt
;;;
;;; Verbatim copies of this file may be freely redistributed.
;;;
;;; Modified versions of this file may be redistributed provided that this
;;; notice remains unchanged, the file contains prominent notice of
;;; author and time of modifications, and redistribution of the file
;;; is not further restricted in any way.
;;;
;;; This file is distributed `as is', without warranties of any kind.
;;;
;;; REQUIREMENTS:
;;;
;;; USAGE:
;;;
;;; BUGS:
;;;
;;;
;;; Setup load-path
(if (featurep 'guileint)
nil
(require 'cl-19 "cl")
(defconst guileint-init-file "guileint")
(defvar guileint-emacs-dir nil)
(let ((pathlist (getenv "EMACSSITELOAD")))
(if (and pathlist
(string-match (concat "\\(\\(/[^:/]+\\)*\\)/?"
guileint-init-file
"\\(\.elc?\\)?\\(:\\|\\'\\)")
pathlist))
(setq guileint-emacs-dir (match-string 1 pathlist))))
(defvar guileint-default-load-path load-path)
(setq load-path
(append (list
guileint-emacs-dir
)
guileint-default-load-path
'(
)))
(setq scheme-program-name
(let ((v (getenv "SCHEME_PROGRAM_NAME")))
(or v
(concat "guile"
(and window-system " --emacs")))))
;;; Select buffers to pop up as separate windows
(if window-system
(progn
(defvar default-special-display-buffer-names
special-display-buffer-names)
(setq special-display-buffer-names
(union default-special-display-buffer-names '("*scheme*")))
(setq same-window-buffer-names
(delete "*scheme*" same-window-buffer-names))
(setq special-display-frame-alist
'((height . 24) (width . 80) (unsplittable . t)))
))
;;; Do things to support lisp-hacking better
(if (equal (substring emacs-version 0 2) "19")
;; Emacs version 19 specific initializations
(progn
(copy-face 'default 'paren)
(condition-case err
(make-face-bold 'paren)
(error))
(setq show-paren-face 'paren)
(require 'paren)
;; The old parenthesis matcher has the advantage of displaying
;; non-visible matching parenthesis in the minibuffer.
;; Since paren.el adds (setq blink-paren-function nil) to the
;; window-setup-hook it's necessary to put this setq there
;; also.
(add-hook 'window-setup-hook (function restore-blink-paren) t)
(setq blink-matching-delay 0.5)
))
(defun restore-blink-paren ()
(interactive)
(setq blink-matching-paren-on-screen t)
(set-face-underline-p 'paren t))
;;; Menus
;;;
(require 'defmenu)
;(setq menu-bar-final-items
; '(completion inout signals scheme help-menu))
(setq menu-bar-final-items
'(interpret scheme help-menu))
;; The global menu
;;
(define-menu global-map 'interpret "Interpret"
'(("Guile" run-scheme (not (comint-check-proc "*scheme*")))
("Switch to *scheme*" guile-switch-to-scheme
(comint-check-proc "*scheme*"))))
(load "inda-scheme")
(provide 'guileint)
)

View file

@ -0,0 +1,201 @@
;;; NAME: inda-scheme.el
;;; SYNOPSIS: Customizations of the scheme modes for
;;; the INDA course at NADA/KTH
;;; VERSION: 1.0
;;; LAST CHANGE: 950827
;;; CREATED: 950827
;;; AUTHOR: Mikael Djurfeldt <djurfeldt@nada.kth.se>
;;; COPYRIGHT: (C) Mikael Djurfeldt 1995
;;;
;;; Verbatim copies of this file may be freely redistributed.
;;;
;;; Modified versions of this file may be redistributed provided that this
;;; notice remains unchanged, the file contains prominent notice of
;;; author and time of modifications, and redistribution of the file
;;; is not further restricted in any way.
;;;
;;; This file is distributed `as is', without warranties of any kind.
;;;
;;; REQUIREMENTS:
;;;
;;; USAGE:
;;;
;;; BUGS:
;;;
;;;
(require 'guile-init)
;;; Customizations of the scheme modes
(defun inda-scheme-mode-initializations ()
(define-key scheme-mode-map "\r" 'newline-and-indent)
;(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition-and-go)
(define-key scheme-mode-map [S-mouse-2] 'guile-frame-eval-at-click)
(define-key scheme-mode-map [triple-mouse-1] 'inda-mark-sexp) ;*fixme*
(define-key scheme-mode-map "\C-c\C-b" 'scheme-send-buffer)
(define-key scheme-mode-map "(" 'scheme-electric-open-paren)
(define-key scheme-mode-map "[" 'scheme-electric-open-paren)
(define-key scheme-mode-map ")" 'scheme-close-paren)
(define-key scheme-mode-map "]" 'scheme-close-paren)
(define-key scheme-mode-map "\M-?" 'guile-list-completions)
(define-key scheme-mode-map "\C-cd" 'guile-describe-variable)
(define-key scheme-mode-map "\M-\t" 'guile-complete-symbol)
(put 'procedure->macro 'scheme-indent-function 0)
(put 'procedure->memoizing-macro 'scheme-indent-function 0)
(put 'bind 'scheme-indent-function 1)
(put 'letrec* 'scheme-indent-function 1)
(put 'syntax-rules 'scheme-indent-function 1)
(put 'syntax-case 'scheme-indent-function 2)
(put 'define-syntax 'scheme-indent-function 1)
(put 'with-syntax 'scheme-indent-function 1))
(add-hook 'scheme-mode-hook (function inda-scheme-mode-initializations))
(defun scheme-electric-open-paren ()
(interactive)
(insert last-input-char)
(let ((old-point (point)))
(indent-for-tab-command)
(if (not (eq (char-after (1- (point))) last-input-char))
(goto-char old-point))))
(defun scheme-close-paren ()
(interactive)
(insert last-input-char)
(if (guile-enhancedp)
(guile-repair-overlays))
(if blink-paren-function
(funcall blink-paren-function)))
(defun inda-send-definition (click)
"Position point and send definition to the inferior Scheme process."
(interactive "e")
(mouse-set-point click)
(sit-for 0)
(scheme-send-definition))
(defun inda-mark-sexp ()
(interactive)
(beginning-of-defun)
(mark-sexp))
(defvar inda-read-only-overlay nil)
(defun inda-inferior-initializations ()
(setq guile-kill-buffer-on-death t)
;; The following seems already to be done in comint-mode...
;;(add-hook 'pre-command-hook (function comint-preinput-scroll-to-bottom))
(setq comint-scroll-to-bottom-on-input 'this)
(setq comint-scroll-to-bottom-on-output nil)
;; Some key bindings.
(define-key inferior-scheme-mode-map "\C-a" 'comint-bol)
(define-key inferior-scheme-mode-map [C-a] 'comint-bol)
(define-key inferior-scheme-mode-map "\C-c\C-a" 'beginning-of-line)
(define-key inferior-scheme-mode-map [C-c C-a] 'beginning-of-line)
(define-key inferior-scheme-mode-map "\r" 'guile-send-input)
(define-key inferior-scheme-mode-map "\t" 'guile-indent-or-complete)
(define-key inferior-scheme-mode-map "\M-?" 'guile-list-completions)
(define-key inferior-scheme-mode-map "\C-cd" 'guile-describe-variable)
(define-key inferior-scheme-mode-map [C-c d] 'guile-describe-variable)
;; Create the read-only overlay.
(make-local-variable 'inda-read-only-overlay)
(cond ((not (overlayp inda-read-only-overlay))
(setq inda-read-only-overlay (make-overlay 1 (point)))
(overlay-put inda-read-only-overlay 'modification-hooks
'(inda-barf-at-modifications))))
;; Disable font-lock
(make-local-variable 'font-lock-fontify-region-function)
(setq font-lock-fontify-region-function 'ignore)
;; We don't want all comint modes to have these values
(add-hook 'comint-input-filter-functions
(function inda-make-input-memory) 'append 'local)
(add-hook 'comint-input-filter-functions
(function inda-extend-read-only-overlay) 'append 'local)
(add-hook 'comint-output-filter-functions
(function inda-extend-read-only-overlay) 'append 'local)
(add-hook 'comint-output-filter-functions
(function inda-reset-guile-last-output) 'append 'local)
;; This is a bit kludgy...
(add-hook 'scheme-enter-input-wait-hook (function inda-boldify-previous-character))
)
;; No message about reason when process dies
(setq guile-insert-reason nil)
(add-hook 'inferior-scheme-mode-hook
(function inda-inferior-initializations)
'append)
(require 'defmenu)
;; Scheme mode menu
;;
(fset 'scheme-advanced-menu
(make-menu
"Advanced"
'(
("Sync with scheme" guile-sync-with-scheme
(and (> guile-n-enhanced-buffers 0)
(not (guile-synchronizedp))
scheme-ready-p))
("Re-eval buffer" guile-reread-buffer (and (guile-attachedp)
scheme-ready-p))
()
("Enhanced edit" guile-enhanced-edit (not (guile-enhancedp)))
("Normal edit" guile-normal-edit (and (guile-enhancedp)
(not (guile-attachedp))))
()
("Eval definition" scheme-send-definition (comint-check-proc "*scheme*"))
("Eval region" scheme-send-region (comint-check-proc "*scheme*"))
("Eval buffer" scheme-send-buffer (comint-check-proc "*scheme*"))
)))
(define-menu scheme-mode-map 'scheme "Scheme"
'(
("Eval definition" scheme-send-definition (comint-check-proc "*scheme*"))
("Eval region" scheme-send-region (comint-check-proc "*scheme*"))
("Eval buffer" scheme-send-buffer (comint-check-proc "*scheme*"))
("Eval all changes" guile-send-changes (comint-check-proc "*scheme*"))
()
("Indent buffer" indent-buffer)
("Indent region" indent-region)
("Indent definition" indent-defun)
()
("Enhanced edit" guile-enhanced-edit (not (guile-enhancedp)))
("Normal edit" guile-normal-edit (and (guile-enhancedp)
(not (guile-attachedp))))
()
("Attach buffer" guile-attach-buffer (and (comint-check-proc "*scheme*")
scheme-ready-p
(not (guile-attachedp))))
("Detach buffer" guile-detach-buffer (guile-attachedp))
()
("Re-init buffer" guile-reread-buffer (and (guile-attachedp)
scheme-ready-p))
("Find bad expressions" guile-check-all (> guile-n-enhanced-buffers 0))
))
;(define-key scheme-mode-map [menu-bar interpret] 'undefined)
;; Inferior scheme menu
;;
(define-menu inferior-scheme-mode-map 'scheme "Scheme"
'(("Start scheme" run-scheme (not (comint-check-proc "*scheme*")))
("Restart scheme" guile-restart-scheme (comint-check-proc "*scheme*"))
("Exit scheme" guile-exit-scheme (comint-check-proc "*scheme*"))
()
("Load file..." guile-load-file
(and (comint-check-proc "*scheme*")
scheme-ready-p))
("Eval all changes" guile-send-changes (comint-check-proc "*scheme*"))
("Find bad expressions" guile-check-all (comint-check-proc "*scheme*"))
()
("Clear transcript" guile-clear-transcript (comint-check-proc "*scheme*"))))
(define-key inferior-scheme-mode-map [menu-bar interpret] 'undefined)

View file

View file