1 ;;; guile-scheme.el --- Guile Scheme editing mode
3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
5 ;; GNU Emacs is free software; you can redistribute it and/or modify
6 ;; it under the terms of the GNU General Public License as published by
7 ;; the Free Software Foundation; either version 2, or (at your option)
10 ;; GNU Emacs is distributed in the hope that it will be useful,
11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;; GNU General Public License for more details.
15 ;; You should have received a copy of the GNU General Public License
16 ;; along with GNU Emacs; see the file COPYING. If not, write to the
17 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
18 ;; Boston, MA 02111-1307, USA.
22 ;; Put the following lines in your ~/.emacs:
24 ;; (require 'guile-scheme)
25 ;; (setq initial-major-mode 'scheme-interaction-mode)
32 (defgroup guile-scheme nil
33 "Editing Guile-Scheme code"
36 (defvar guile-scheme-syntax-keywords
37 '((begin 0) (if 1) (cond 0) (case 1) (do 2)
38 quote syntax lambda and or else delay receive use-modules
39 (match 1) (match-lambda 0) (match-lambda* 0)
40 (let scheme-let-indent
) (let* 1) (letrec 1) (and-let* 1)
41 (let-syntax 1) (letrec-syntax 1) (syntax-rules 1) (syntax-case 2)))
43 (defvar guile-scheme-special-procedures
44 '((catch 1) (lazy-catch 1) (stack-catch 1)
45 map for-each
(dynamic-wind 3)))
47 ;; set indent functions
48 (dolist (x (append guile-scheme-syntax-keywords
49 guile-scheme-special-procedures
))
51 (put (car x
) 'scheme-indent-function
(cadr x
))))
53 (defconst guile-scheme-font-lock-keywords
56 (list (concat "(\\(define\\*?\\("
58 "\\(\\|-public\\|-method\\|-generic\\)\\|"
59 ;; Macro names, as variable names.
60 "\\(-syntax\\|-macro\\)\\|"
63 ;; Any whitespace and declared object.
64 "\\s *(?\\(\\sw+\\)?")
65 '(1 font-lock-keyword-face
)
66 '(5 (cond ((match-beginning 3) font-lock-function-name-face
)
67 ((match-beginning 4) font-lock-variable-name-face
)
68 (t font-lock-type-face
)) nil t
))
72 (prin1-to-string (if (consp e
) (car e
) e
)))
73 (append guile-scheme-syntax-keywords
74 guile-scheme-special-procedures
)) 'words
))
75 '(1 font-lock-keyword-face
))
76 '("<\\sw+>" . font-lock-type-face
)
77 '("\\<:\\sw+\\>" . font-lock-builtin-face
)
79 "Expressions to highlight in Guile Scheme mode.")
86 (defvar guile-scheme-mode-map nil
87 "Keymap for Guile Scheme mode.
88 All commands in `lisp-mode-shared-map' are inherited by this map.")
90 (unless guile-scheme-mode-map
91 (let ((map (make-sparse-keymap "Guile-Scheme")))
92 (setq guile-scheme-mode-map map
)
93 (set-keymap-parent map lisp-mode-shared-map
)
94 (define-key map
[menu-bar
] (make-sparse-keymap))
95 (define-key map
[menu-bar guile-scheme
] (cons "Guile-Scheme" map
))
96 (define-key map
[uncomment-region
]
97 '("Uncomment Out Region" .
(lambda (beg end
)
99 (comment-region beg end
'(4)))))
100 (define-key map
[comment-region
] '("Comment Out Region" . comment-region
))
101 (define-key map
[indent-region
] '("Indent Region" . indent-region
))
102 (define-key map
[indent-line
] '("Indent Line" . lisp-indent-line
))
103 (define-key map
"\e\C-i" 'guile-scheme-complete-symbol
)
104 (define-key map
"\e\C-x" 'guile-scheme-eval-define
)
105 (define-key map
"\C-x\C-e" 'guile-scheme-eval-last-sexp
)
106 (define-key map
"\C-c\C-b" 'guile-scheme-eval-buffer
)
107 (define-key map
"\C-c\C-r" 'guile-scheme-eval-region
)
108 (define-key map
"\C-c:" 'guile-scheme-eval-expression
)
109 (define-key map
"\C-c\C-a" 'guile-scheme-apropos
)
110 (define-key map
"\C-c\C-d" 'guile-scheme-describe
)
112 (put 'comment-region
'menu-enable
'mark-active
)
113 (put 'uncomment-region
'menu-enable
'mark-active
)
114 (put 'indent-region
'menu-enable
'mark-active
)))
116 (defcustom guile-scheme-mode-hook nil
117 "Normal hook run when entering `guile-scheme-mode'."
119 :group
'guile-scheme
)
122 (defun guile-scheme-mode ()
123 "Major mode for editing Guile Scheme code.
124 Editing commands are similar to those of `scheme-mode'.
127 Entry to this mode calls the value of `scheme-mode-hook'
128 if that value is non-nil."
130 (kill-all-local-variables)
131 (setq mode-name
"Guile Scheme")
132 (setq major-mode
'guile-scheme-mode
)
133 (use-local-map guile-scheme-mode-map
)
134 (scheme-mode-variables)
135 (setq mode-line-process
136 '(:eval
(if (processp guile-scheme-adapter
)
137 (format " [%s]" guile-scheme-command
)
139 (setq font-lock-defaults
140 '((guile-scheme-font-lock-keywords)
141 nil t
(("+-*/.<>=!?$%_&~^:@" .
"w")) beginning-of-defun
142 (font-lock-mark-block-function . mark-defun
)))
143 (run-hooks 'guile-scheme-mode-hook
))
147 ;;; Scheme interaction mode
150 (defvar scheme-interaction-mode-map
()
151 "Keymap for Scheme Interaction mode.
152 All commands in `guile-scheme-mode-map' are inherited by this map.")
154 (unless scheme-interaction-mode-map
155 (let ((map (make-sparse-keymap)))
156 (setq scheme-interaction-mode-map map
)
157 (set-keymap-parent map guile-scheme-mode-map
)
158 (define-key map
"\C-j" 'guile-scheme-eval-print-last-sexp
)
161 (defvar scheme-interaction-mode-hook nil
162 "Normal hook run when entering `scheme-interaction-mode'.")
164 (defun scheme-interaction-mode ()
165 "Major mode for evaluating Scheme expressions with Guile.
167 \\{scheme-interaction-mode-map}"
170 (use-local-map scheme-interaction-mode-map
)
171 (setq major-mode
'scheme-interaction-mode
)
172 (setq mode-name
"Scheme Interaction")
173 (run-hooks 'scheme-interaction-mode-hook
))
177 ;;; Guile Scheme adapter
180 (defvar guile-scheme-command
"guile")
181 (defvar guile-scheme-adapter nil
)
183 (defun guile-scheme-adapter ()
184 (if (and (processp guile-scheme-adapter
)
185 (eq (process-status guile-scheme-adapter
) 'run
))
187 (setq guile-scheme-adapter
188 (guile:make-adapter guile-scheme-command
'emacs-scheme-channel
))))
190 (defun guile-scheme-set-module ()
191 "Set the current module based on buffer contents.
192 If there is a (define-module ...) form, evaluate it.
193 Otherwise, choose module (guile-user)."
196 (if (re-search-backward "^(define-module " nil t
)
197 (let ((start (match-beginning 0)))
200 (buffer-substring-no-properties start
(point)))
201 "(define-module (emacs-user))")
202 (guile-scheme-adapter))))
204 (defun guile-scheme-eval-string (string)
205 (guile-scheme-set-module)
206 (guile:eval string
(guile-scheme-adapter)))
208 (defun guile-scheme-display-result (value flag
)
209 (if (string= value
"#<unspecified>")
213 (message "%s" value
)))
217 ;;; Interactive commands
220 (defun guile-scheme-eval-expression (string)
221 "Evaluate the expression in STRING and show value in echo area."
222 (interactive "SGuile Scheme Eval: ")
223 (guile-scheme-display-result (guile-scheme-eval-string string
) nil
))
225 (defun guile-scheme-eval-region (start end
)
226 "Evaluate the region as Guile Scheme code."
228 (guile-scheme-eval-expression (buffer-substring-no-properties start end
)))
230 (defun guile-scheme-eval-buffer ()
231 "Evaluate the current buffer as Guile Scheme code."
233 (guile-scheme-eval-expression (buffer-string)))
235 (defun guile-scheme-eval-last-sexp (arg)
236 "Evaluate sexp before point; show value in echo area.
237 With argument, print output into current buffer."
239 (guile-scheme-display-result
240 (guile-scheme-eval-string
241 (buffer-substring-no-properties
242 (point) (save-excursion (backward-sexp) (point)))) arg
))
244 (defun guile-scheme-eval-print-last-sexp ()
245 "Evaluate sexp before point; print value into current buffer."
248 (guile-scheme-eval-last-sexp t
)
251 (defun guile-scheme-eval-define ()
253 (guile-scheme-eval-region (save-excursion (end-of-defun) (point))
254 (save-excursion (beginning-of-defun) (point))))
256 (defun guile-scheme-load-file (file)
257 "Load a Guile Scheme file."
258 (interactive "fGuile Scheme load file: ")
259 (guile-scheme-eval-string (format "(load %s)" (expand-file-name file
)))
262 (defun guile-scheme-complete-symbol ()
264 (unless (boundp 'guile-emacs-complete-alist
)
265 (guile-import guile-emacs-complete-alist
))
267 (start (save-excursion (skip-syntax-backward "w_") (point)))
268 (pattern (buffer-substring-no-properties start end
))
269 (alist (guile-emacs-complete-alist pattern
)))
271 (let ((completion (try-completion pattern alist
)))
272 (cond ((eq completion t
))
274 (message "Can't find completion for \"%s\"" pattern
)
276 ((not (string= pattern completion
))
277 (delete-region start end
)
280 (message "Making completion list...")
281 (with-output-to-temp-buffer "*Completions*"
282 (display-completion-list alist
))
283 (message "Making completion list...done"))))))
285 ;; (define-command (guile-scheme-apropos regexp)
286 ;; (interactive "sGuile-Scheme apropos (regexp): ")
287 ;; (guile-scheme-set-module)
288 ;; (let ((old #^guile-scheme-output-buffer))
290 ;; (lambda () (set! #^guile-scheme-output-buffer #f))
292 ;; (with-output-to-temp-buffer "*Help*"
294 ;; (apropos regexp))))
295 ;; (lambda () (set! #^guile-scheme-output-buffer old)))))
297 ;; (define (guile-scheme-input-symbol prompt)
298 ;; (let* ((symbol (thing-at-point 'symbol))
299 ;; (table (map (lambda (sym) (list (symbol->string sym)))
300 ;; (apropos-list "")))
301 ;; (default (if (assoc symbol table)
302 ;; (string-append " (default " symbol ")")
304 ;; (string->symbol (completing-read (string-append prompt default ": ")
305 ;; table #f #t #f #f symbol))))
307 ;; (define-command (guile-scheme-describe symbol)
308 ;; "Display the value and documentation of SYMBOL."
309 ;; (interactive (list (guile-scheme-input-symbol "Describe Guile-Scheme variable")))
310 ;; (guile-scheme-set-module)
311 ;; (let ((old #^guile-scheme-output-buffer))
313 ;; (lambda () (set! #^guile-scheme-output-buffer #f))
315 ;; (begin-with-output-to-temp-buffer "*Help*"
316 ;; (describe symbol)))
317 ;; (lambda () (set! #^guile-scheme-output-buffer old)))))
319 ;; (define-command (guile-scheme-find-definition symbol)
320 ;; (interactive (list (guile-scheme-input-symbol "Guile-Scheme find definition")))
321 ;; (guile-scheme-set-module)
326 ;;; Turn on guile-scheme-mode for .scm files by default.
329 (setq auto-mode-alist
330 (cons '("\\.scm\\'" . guile-scheme-mode
) auto-mode-alist
))
332 (provide 'guile-scheme
)
334 ;;; guile-scheme.el ends here