1 ;;; guile-scheme.el --- Guile Scheme editing mode
3 ;; Copyright (C) 2001, 2006 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., 51 Franklin Street, Fifth Floor,
18 ;; Boston, MA 02110-1301, 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 (cond ((boundp 'lisp-mode-shared-map)
94 (set-keymap-parent map lisp-mode-shared-map))
95 ((boundp 'shared-lisp-mode-map)
96 (set-keymap-parent map shared-lisp-mode-map)))
97 (define-key map [menu-bar] (make-sparse-keymap))
98 (define-key map [menu-bar guile-scheme] (cons "Guile-Scheme" map))
99 (define-key map [uncomment-region]
100 '("Uncomment Out Region" . (lambda (beg end)
102 (comment-region beg end '(4)))))
103 (define-key map [comment-region] '("Comment Out Region" . comment-region))
104 (define-key map [indent-region] '("Indent Region" . indent-region))
105 (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
106 (define-key map "\e\C-i" 'guile-scheme-complete-symbol)
107 (define-key map "\e\C-x" 'guile-scheme-eval-define)
108 (define-key map "\C-x\C-e" 'guile-scheme-eval-last-sexp)
109 (define-key map "\C-c\C-b" 'guile-scheme-eval-buffer)
110 (define-key map "\C-c\C-r" 'guile-scheme-eval-region)
111 (define-key map "\C-c:" 'guile-scheme-eval-expression)
112 (define-key map "\C-c\C-a" 'guile-scheme-apropos)
113 (define-key map "\C-c\C-d" 'guile-scheme-describe)
114 (define-key map "\C-c\C-k" 'guile-scheme-kill-process)
116 (put 'comment-region 'menu-enable 'mark-active)
117 (put 'uncomment-region 'menu-enable 'mark-active)
118 (put 'indent-region 'menu-enable 'mark-active)))
120 (defcustom guile-scheme-mode-hook nil
121 "Normal hook run when entering `guile-scheme-mode'."
123 :group 'guile-scheme)
126 (defun guile-scheme-mode ()
127 "Major mode for editing Guile Scheme code.
128 Editing commands are similar to those of `scheme-mode'.
131 Entry to this mode calls the value of `scheme-mode-hook'
132 if that value is non-nil."
134 (kill-all-local-variables)
135 (setq mode-name "Guile Scheme")
136 (setq major-mode 'guile-scheme-mode)
137 (use-local-map guile-scheme-mode-map)
138 (scheme-mode-variables)
139 (setq mode-line-process
140 '(:eval (if (processp guile-scheme-adapter)
141 (format " [%s]" guile-scheme-command)
143 (setq font-lock-defaults
144 '((guile-scheme-font-lock-keywords)
145 nil t (("+-*/.<>=!?$%_&~^:@" . "w")) beginning-of-defun
146 (font-lock-mark-block-function . mark-defun)))
147 (run-hooks 'guile-scheme-mode-hook))
151 ;;; Scheme interaction mode
154 (defvar scheme-interaction-mode-map ()
155 "Keymap for Scheme Interaction mode.
156 All commands in `guile-scheme-mode-map' are inherited by this map.")
158 (unless scheme-interaction-mode-map
159 (let ((map (make-sparse-keymap)))
160 (setq scheme-interaction-mode-map map)
161 (set-keymap-parent map guile-scheme-mode-map)
162 (define-key map "\C-j" 'guile-scheme-eval-print-last-sexp)
165 (defvar scheme-interaction-mode-hook nil
166 "Normal hook run when entering `scheme-interaction-mode'.")
168 (defun scheme-interaction-mode ()
169 "Major mode for evaluating Scheme expressions with Guile.
171 \\{scheme-interaction-mode-map}"
174 (use-local-map scheme-interaction-mode-map)
175 (setq major-mode 'scheme-interaction-mode)
176 (setq mode-name "Scheme Interaction")
177 (run-hooks 'scheme-interaction-mode-hook))
181 ;;; Guile Scheme adapter
184 (defvar guile-scheme-command "guile")
185 (defvar guile-scheme-adapter nil)
186 (defvar guile-scheme-module nil)
188 (defun guile-scheme-adapter ()
189 (if (and (processp guile-scheme-adapter)
190 (eq (process-status guile-scheme-adapter) 'run))
192 (setq guile-scheme-module nil)
193 (setq guile-scheme-adapter
194 (guile:make-adapter guile-scheme-command 'emacs-scheme-channel))))
196 (defun guile-scheme-set-module ()
197 "Set the current module based on buffer contents.
198 If there is a (define-module ...) form, evaluate it.
199 Otherwise, choose module (guile-user)."
201 (let ((module (if (re-search-backward "^(define-module " nil t)
202 (let ((start (match-beginning 0)))
205 (buffer-substring-no-properties start (point)))
206 "(define-module (emacs-user))")))
207 (unless (string= guile-scheme-module module)
208 (prog1 (guile:eval module (guile-scheme-adapter))
209 (setq guile-scheme-module module))))))
211 (defun guile-scheme-eval-string (string)
212 (guile-scheme-set-module)
213 (guile:eval string (guile-scheme-adapter)))
215 (defun guile-scheme-display-result (value flag)
216 (if (string= value "#<unspecified>")
220 (message "%s" value)))
224 ;;; Interactive commands
227 (defun guile-scheme-eval-expression (string)
228 "Evaluate the expression in STRING and show value in echo area."
229 (interactive "SGuile Scheme Eval: ")
230 (guile-scheme-display-result (guile-scheme-eval-string string) nil))
232 (defun guile-scheme-eval-region (start end)
233 "Evaluate the region as Guile Scheme code."
235 (guile-scheme-eval-expression (buffer-substring-no-properties start end)))
237 (defun guile-scheme-eval-buffer ()
238 "Evaluate the current buffer as Guile Scheme code."
240 (guile-scheme-eval-expression (buffer-string)))
242 (defun guile-scheme-eval-last-sexp (arg)
243 "Evaluate sexp before point; show value in echo area.
244 With argument, print output into current buffer."
246 (guile-scheme-display-result
247 (guile-scheme-eval-string
248 (buffer-substring-no-properties
249 (point) (save-excursion (backward-sexp) (point)))) arg))
251 (defun guile-scheme-eval-print-last-sexp ()
252 "Evaluate sexp before point; print value into current buffer."
254 (let ((start (point)))
255 (guile-scheme-eval-last-sexp t)
257 (save-excursion (goto-char start) (insert "\n"))))
259 (defun guile-scheme-eval-define ()
261 (guile-scheme-eval-region (save-excursion (end-of-defun) (point))
262 (save-excursion (beginning-of-defun) (point))))
264 (defun guile-scheme-load-file (file)
265 "Load a Guile Scheme file."
266 (interactive "fGuile Scheme load file: ")
267 (guile-scheme-eval-string (format "(load %s)" (expand-file-name file)))
270 (guile-import guile-emacs-complete-alist)
272 (defun guile-scheme-complete-symbol ()
275 (start (save-excursion (skip-syntax-backward "w_") (point)))
276 (pattern (buffer-substring-no-properties start end))
277 (alist (guile-emacs-complete-alist pattern)))
279 (let ((completion (try-completion pattern alist)))
280 (cond ((eq completion t))
282 (message "Can't find completion for \"%s\"" pattern)
284 ((not (string= pattern completion))
285 (delete-region start end)
288 (message "Making completion list...")
289 (with-output-to-temp-buffer "*Completions*"
290 (display-completion-list alist))
291 (message "Making completion list...done"))))))
293 (guile-import guile-emacs-apropos)
295 (defun guile-scheme-apropos (regexp)
296 (interactive "sGuile Scheme apropos (regexp): ")
297 (guile-scheme-set-module)
298 (with-output-to-temp-buffer "*Help*"
299 (princ (guile-emacs-apropos regexp))))
301 (guile-import guile-emacs-describe)
303 (defun guile-scheme-describe (symbol)
304 (interactive (list (guile-scheme-input-symbol "Describe Guile variable")))
305 (guile-scheme-set-module)
306 (with-output-to-temp-buffer "*Help*"
307 (princ (guile-emacs-describe symbol))))
309 (defun guile-scheme-kill-process ()
311 (if guile-scheme-adapter
312 (guile-process-kill guile-scheme-adapter))
313 (setq guile-scheme-adapter nil))
317 ;;; Internal functions
320 (guile-import apropos-internal guile-apropos-internal)
322 (defvar guile-scheme-complete-table (make-vector 151 nil))
324 (defun guile-scheme-input-symbol (prompt)
327 (intern (symbol-name sym) guile-scheme-complete-table)))
328 (guile-apropos-internal ""))
329 (let* ((str (thing-at-point 'symbol))
330 (default (if (intern-soft str guile-scheme-complete-table)
331 (concat " (default " str ")")
333 (intern (completing-read (concat prompt default ": ")
334 guile-scheme-complete-table nil t nil nil str))))
338 ;;; Turn on guile-scheme-mode for .scm files by default.
341 (setq auto-mode-alist
342 (cons '("\\.scm\\'" . guile-scheme-mode) auto-mode-alist))
344 (provide 'guile-scheme)
346 ;;; guile-scheme.el ends here