-;;; guile-scheme.el --- Guile Scheme editing mode.
-
-;; Copyright (C) 2001 Keisuke Nishida <kxn30@po.cwru.edu>
-
-;; GNU Emacs 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, or (at your option)
-;; any later version.
-
-;; GNU Emacs 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; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Code:
-
-(require 'scheme)
-
-(defgroup guile-scheme nil
- "Editing Guile-Scheme code"
- :group 'lisp)
-
-(defvar guile-scheme-syntax-keywords
- '((begin 0) (if 1) (cond 0) (case 1) (do 2) (try 1)
- quote syntax lambda and or else delay receive
- (match 1) (match-lambda 0) (match-lambda* 0)
- (let scheme-let-indent) (let* 1) (letrec 1) (and-let* 1)
- (let-syntax 1) (letrec-syntax 1) (syntax-rules 1) (syntax-case 2)))
-
-(defvar guile-scheme-special-procedures
- '((catch 1) (lazy-catch 1) (stack-catch 1)
- map for-each (dynamic-wind 3)))
-
-(dolist (x (append guile-scheme-syntax-keywords
- guile-scheme-special-procedures))
- (when (consp x)
- (put (car x) 'scheme-indent-function (cadr x))))
-
-;; This is shared by cmuscheme and xscheme.
-(defcustom guile-scheme-program-name "guile"
- "*Program invoked by the `run-scheme' command."
- :type 'string
- :group 'guile-scheme)
-
-(defconst guile-scheme-font-lock-keywords
- (eval-when-compile
- (list
- (list (concat "(\\(define\\*?\\("
- ;; Function names.
- "\\(\\|-public\\|-method\\|-generic\\)\\|"
- ;; Macro names, as variable names. A bit dubious, this.
- "\\(-syntax\\|-macro\\)\\|"
- ;; Others
- "-\\sw+\\)\\)\\>"
- ;; Any whitespace and declared object.
- "\\s *(?\\(\\sw+\\)?")
- '(1 font-lock-keyword-face)
- '(5 (cond ((match-beginning 3) font-lock-function-name-face)
- ((match-beginning 4) font-lock-variable-name-face)
- (t font-lock-type-face)) nil t))
- (list (concat
- "(" (regexp-opt
- (mapcar (lambda (e)
- (prin1-to-string (if (consp e) (car e) e)))
- (append guile-scheme-syntax-keywords
- guile-scheme-special-procedures)) 'words))
- '(1 font-lock-keyword-face))
- '("<\\sw+>" . font-lock-type-face)
- '("\\<:\\sw+\\>" . font-lock-builtin-face)
- ))
- "Expressions to highlight in Guile-Scheme modes.")
-
-(defvar guile-scheme-mode-syntax-table nil)
-(unless guile-scheme-mode-syntax-table
- (let ((i 0))
- (setq guile-scheme-mode-syntax-table (make-syntax-table))
- (set-syntax-table guile-scheme-mode-syntax-table)
-
- ;; Default is atom-constituent.
- (while (< i 256)
- (modify-syntax-entry i "_ ")
- (setq i (1+ i)))
-
- ;; Word components.
- (setq i ?0)
- (while (<= i ?9)
- (modify-syntax-entry i "w ")
- (setq i (1+ i)))
- (setq i ?A)
- (while (<= i ?Z)
- (modify-syntax-entry i "w ")
- (setq i (1+ i)))
- (setq i ?a)
- (while (<= i ?z)
- (modify-syntax-entry i "w ")
- (setq i (1+ i)))
-
- ;; Whitespace
- (modify-syntax-entry ?\t " ")
- (modify-syntax-entry ?\n "> ")
- (modify-syntax-entry ?\f " ")
- (modify-syntax-entry ?\r " ")
- (modify-syntax-entry ? " ")
-
- ;; These characters are delimiters but otherwise undefined.
- ;; Brackets and braces balance for editing convenience.
- (modify-syntax-entry ?\[ "(] ")
- (modify-syntax-entry ?\] ")[ ")
- (modify-syntax-entry ?{ "(} ")
- (modify-syntax-entry ?} "){ ")
- (modify-syntax-entry ?\| " 23")
-
- ;; Other atom delimiters
- (modify-syntax-entry ?\( "() ")
- (modify-syntax-entry ?\) ")( ")
- (modify-syntax-entry ?\; "< ")
- (modify-syntax-entry ?\" "\" ")
- (modify-syntax-entry ?' " p")
- (modify-syntax-entry ?` " p")
- (modify-syntax-entry ?. " p")
-
- ;; Special characters
- (modify-syntax-entry ?, "_ p")
- (modify-syntax-entry ?# "_ p14")
- (modify-syntax-entry ?\\ "\\ ")))
-
-(defvar guile-scheme-mode-line-process "")
-
-(defvar guile-scheme-mode-map nil
- "Keymap for Guile Scheme mode.
-All commands in `lisp-mode-shared-map' are inherited by this map.")
-
-(unless guile-scheme-mode-map
- (let ((map (make-sparse-keymap "Guile-Scheme")))
- (setq guile-scheme-mode-map (make-sparse-keymap))
- (set-keymap-parent guile-scheme-mode-map lisp-mode-shared-map)
- (define-key guile-scheme-mode-map [menu-bar] (make-sparse-keymap))
- (define-key guile-scheme-mode-map [menu-bar guile-scheme]
- (cons "Guile Scheme" map))
- (define-key map [run-guile-scheme]
- '("Run Inferior Guile-Scheme" . run-guile-scheme))
- (define-key map [uncomment-region]
- '("Uncomment Out Region" . (lambda (beg end)
- (interactive "r")
- (comment-region beg end '(4)))))
- (define-key map [comment-region] '("Comment Out Region" . comment-region))
- (define-key map [indent-region] '("Indent Region" . indent-region))
- (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
- (put 'comment-region 'menu-enable 'mark-active)
- (put 'uncomment-region 'menu-enable 'mark-active)
- (put 'indent-region 'menu-enable 'mark-active)))
-
-(defcustom guile-scheme-mode-hook nil
- "Normal hook run when entering `guile-scheme-mode'.
-See `run-hooks'."
- :type 'hook
- :group 'guile-scheme)
-
-\f
-;;;
-;;; Guile Scheme mode
-;;;
-
-;;;###autoload
-(defun guile-scheme-mode ()
- "Major mode for editing Guile-Scheme code.
-Editing commands are similar to those of `lisp-mode'.
-
-In addition, if an inferior Scheme process is running, some additional
-commands will be defined, for evaluating expressions and controlling
-the interpreter, and the state of the process will be displayed in the
-modeline of all Scheme buffers. The names of commands that interact
-with the Scheme process start with \"xscheme-\" if you use the MIT
-Scheme-specific `xscheme' package; for more information see the
-documentation for `xscheme-interaction-mode'. Use \\[run-scheme] to
-start an inferior Scheme using the more general `cmuscheme' package.
-
-Commands:
-Delete converts tabs to spaces as it moves back.
-Blank lines separate paragraphs. Semicolons start comments.
-\\{scheme-mode-map}
-Entry to this mode calls the value of `scheme-mode-hook'
-if that value is non-nil."
- (interactive)
- (kill-all-local-variables)
- (setq mode-name "Guile Scheme")
- (setq major-mode 'guile-scheme-mode)
- (use-local-map guile-scheme-mode-map)
- (guile-scheme-mode-variables)
- (run-hooks 'guile-scheme-mode-hook))
-
-(defun guile-scheme-mode-variables ()
- (set-syntax-table guile-scheme-mode-syntax-table)
- (setq local-abbrev-table scheme-mode-abbrev-table)
- (make-local-variable 'paragraph-start)
- (setq paragraph-start (concat "$\\|" page-delimiter))
- (make-local-variable 'paragraph-separate)
- (setq paragraph-separate paragraph-start)
- (make-local-variable 'paragraph-ignore-fill-prefix)
- (setq paragraph-ignore-fill-prefix t)
- (make-local-variable 'fill-paragraph-function)
- (setq fill-paragraph-function 'lisp-fill-paragraph)
- ;; Adaptive fill mode gets in the way of auto-fill,
- ;; and should make no difference for explicit fill
- ;; because lisp-fill-paragraph should do the job.
- (make-local-variable 'adaptive-fill-mode)
- (setq adaptive-fill-mode nil)
- (make-local-variable 'normal-auto-fill-function)
- (setq normal-auto-fill-function 'lisp-mode-auto-fill)
- (make-local-variable 'indent-line-function)
- (setq indent-line-function 'lisp-indent-line)
- (make-local-variable 'parse-sexp-ignore-comments)
- (setq parse-sexp-ignore-comments t)
- (make-local-variable 'outline-regexp)
- (setq outline-regexp ";;; \\|(....")
- (make-local-variable 'comment-start)
- (setq comment-start ";")
- (make-local-variable 'comment-start-skip)
- ;; Look within the line for a ; following an even number of backslashes
- ;; after either a non-backslash or the line beginning.
- (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
- (make-local-variable 'comment-column)
- (setq comment-column 40)
- (make-local-variable 'comment-indent-function)
- (setq comment-indent-function 'lisp-comment-indent)
- (make-local-variable 'parse-sexp-ignore-comments)
- (setq parse-sexp-ignore-comments t)
- (make-local-variable 'lisp-indent-function)
- (set lisp-indent-function 'scheme-indent-function)
- (setq mode-line-process '("" guile-scheme-mode-line-process))
- (set (make-local-variable 'imenu-case-fold-search) t)
- (set (make-local-variable 'imenu-syntax-alist)
- '(("+-*/.<>=?!$%_&~^:" . "w")))
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults
- '((guile-scheme-font-lock-keywords)
- nil t (("+-*/.<>=!?$%_&~^:@" . "w")) beginning-of-defun
- (font-lock-mark-block-function . mark-defun))))
-
-(provide 'guile-scheme)
-
-;;; guile-scheme.el ends here
+;;; guile-scheme.el --- Guile Scheme editing mode
+
+;; Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+;;;; 02111-1307 USA
+
+;;; Commentary:
+
+;; Put the following lines in your ~/.emacs:
+;;
+;; (require 'guile-scheme)
+;; (setq initial-major-mode 'scheme-interaction-mode)
+
+;;; Code:
+
+(require 'guile)
+(require 'scheme)
+
+(defgroup guile-scheme nil
+ "Editing Guile-Scheme code"
+ :group 'lisp)
+
+(defvar guile-scheme-syntax-keywords
+ '((begin 0) (if 1) (cond 0) (case 1) (do 2)
+ quote syntax lambda and or else delay receive use-modules
+ (match 1) (match-lambda 0) (match-lambda* 0)
+ (let scheme-let-indent) (let* 1) (letrec 1) (and-let* 1)
+ (let-syntax 1) (letrec-syntax 1) (syntax-rules 1) (syntax-case 2)))
+
+(defvar guile-scheme-special-procedures
+ '((catch 1) (lazy-catch 1) (stack-catch 1)
+ map for-each (dynamic-wind 3)))
+
+;; set indent functions
+(dolist (x (append guile-scheme-syntax-keywords
+ guile-scheme-special-procedures))
+ (when (consp x)
+ (put (car x) 'scheme-indent-function (cadr x))))
+
+(defconst guile-scheme-font-lock-keywords
+ (eval-when-compile
+ (list
+ (list (concat "(\\(define\\*?\\("
+ ;; Function names.
+ "\\(\\|-public\\|-method\\|-generic\\)\\|"
+ ;; Macro names, as variable names.
+ "\\(-syntax\\|-macro\\)\\|"
+ ;; Others
+ "-\\sw+\\)\\)\\>"
+ ;; Any whitespace and declared object.
+ "\\s *(?\\(\\sw+\\)?")
+ '(1 font-lock-keyword-face)
+ '(5 (cond ((match-beginning 3) font-lock-function-name-face)
+ ((match-beginning 4) font-lock-variable-name-face)
+ (t font-lock-type-face)) nil t))
+ (list (concat
+ "(" (regexp-opt
+ (mapcar (lambda (e)
+ (prin1-to-string (if (consp e) (car e) e)))
+ (append guile-scheme-syntax-keywords
+ guile-scheme-special-procedures)) 'words))
+ '(1 font-lock-keyword-face))
+ '("<\\sw+>" . font-lock-type-face)
+ '("\\<:\\sw+\\>" . font-lock-builtin-face)
+ ))
+ "Expressions to highlight in Guile Scheme mode.")
+
+\f
+;;;
+;;; Guile Scheme mode
+;;;
+
+(defvar guile-scheme-mode-map nil
+ "Keymap for Guile Scheme mode.
+All commands in `lisp-mode-shared-map' are inherited by this map.")
+
+(unless guile-scheme-mode-map
+ (let ((map (make-sparse-keymap "Guile-Scheme")))
+ (setq guile-scheme-mode-map map)
+ (cond ((boundp 'lisp-mode-shared-map)
+ (set-keymap-parent map lisp-mode-shared-map))
+ ((boundp 'shared-lisp-mode-map)
+ (set-keymap-parent map shared-lisp-mode-map)))
+ (define-key map [menu-bar] (make-sparse-keymap))
+ (define-key map [menu-bar guile-scheme] (cons "Guile-Scheme" map))
+ (define-key map [uncomment-region]
+ '("Uncomment Out Region" . (lambda (beg end)
+ (interactive "r")
+ (comment-region beg end '(4)))))
+ (define-key map [comment-region] '("Comment Out Region" . comment-region))
+ (define-key map [indent-region] '("Indent Region" . indent-region))
+ (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
+ (define-key map "\e\C-i" 'guile-scheme-complete-symbol)
+ (define-key map "\e\C-x" 'guile-scheme-eval-define)
+ (define-key map "\C-x\C-e" 'guile-scheme-eval-last-sexp)
+ (define-key map "\C-c\C-b" 'guile-scheme-eval-buffer)
+ (define-key map "\C-c\C-r" 'guile-scheme-eval-region)
+ (define-key map "\C-c:" 'guile-scheme-eval-expression)
+ (define-key map "\C-c\C-a" 'guile-scheme-apropos)
+ (define-key map "\C-c\C-d" 'guile-scheme-describe)
+ (define-key map "\C-c\C-k" 'guile-scheme-kill-process)
+
+ (put 'comment-region 'menu-enable 'mark-active)
+ (put 'uncomment-region 'menu-enable 'mark-active)
+ (put 'indent-region 'menu-enable 'mark-active)))
+
+(defcustom guile-scheme-mode-hook nil
+ "Normal hook run when entering `guile-scheme-mode'."
+ :type 'hook
+ :group 'guile-scheme)
+
+;;;###autoload
+(defun guile-scheme-mode ()
+ "Major mode for editing Guile Scheme code.
+Editing commands are similar to those of `scheme-mode'.
+
+\\{scheme-mode-map}
+Entry to this mode calls the value of `scheme-mode-hook'
+if that value is non-nil."
+ (interactive)
+ (kill-all-local-variables)
+ (setq mode-name "Guile Scheme")
+ (setq major-mode 'guile-scheme-mode)
+ (use-local-map guile-scheme-mode-map)
+ (scheme-mode-variables)
+ (setq mode-line-process
+ '(:eval (if (processp guile-scheme-adapter)
+ (format " [%s]" guile-scheme-command)
+ "")))
+ (setq font-lock-defaults
+ '((guile-scheme-font-lock-keywords)
+ nil t (("+-*/.<>=!?$%_&~^:@" . "w")) beginning-of-defun
+ (font-lock-mark-block-function . mark-defun)))
+ (run-hooks 'guile-scheme-mode-hook))
+
+\f
+;;;
+;;; Scheme interaction mode
+;;;
+
+(defvar scheme-interaction-mode-map ()
+ "Keymap for Scheme Interaction mode.
+All commands in `guile-scheme-mode-map' are inherited by this map.")
+
+(unless scheme-interaction-mode-map
+ (let ((map (make-sparse-keymap)))
+ (setq scheme-interaction-mode-map map)
+ (set-keymap-parent map guile-scheme-mode-map)
+ (define-key map "\C-j" 'guile-scheme-eval-print-last-sexp)
+ ))
+
+(defvar scheme-interaction-mode-hook nil
+ "Normal hook run when entering `scheme-interaction-mode'.")
+
+(defun scheme-interaction-mode ()
+ "Major mode for evaluating Scheme expressions with Guile.
+
+\\{scheme-interaction-mode-map}"
+ (interactive)
+ (guile-scheme-mode)
+ (use-local-map scheme-interaction-mode-map)
+ (setq major-mode 'scheme-interaction-mode)
+ (setq mode-name "Scheme Interaction")
+ (run-hooks 'scheme-interaction-mode-hook))
+
+\f
+;;;
+;;; Guile Scheme adapter
+;;;
+
+(defvar guile-scheme-command "guile")
+(defvar guile-scheme-adapter nil)
+(defvar guile-scheme-module nil)
+
+(defun guile-scheme-adapter ()
+ (if (and (processp guile-scheme-adapter)
+ (eq (process-status guile-scheme-adapter) 'run))
+ guile-scheme-adapter
+ (setq guile-scheme-module nil)
+ (setq guile-scheme-adapter
+ (guile:make-adapter guile-scheme-command 'emacs-scheme-channel))))
+
+(defun guile-scheme-set-module ()
+ "Set the current module based on buffer contents.
+If there is a (define-module ...) form, evaluate it.
+Otherwise, choose module (guile-user)."
+ (save-excursion
+ (let ((module (if (re-search-backward "^(define-module " nil t)
+ (let ((start (match-beginning 0)))
+ (goto-char start)
+ (forward-sexp)
+ (buffer-substring-no-properties start (point)))
+ "(define-module (emacs-user))")))
+ (unless (string= guile-scheme-module module)
+ (prog1 (guile:eval module (guile-scheme-adapter))
+ (setq guile-scheme-module module))))))
+
+(defun guile-scheme-eval-string (string)
+ (guile-scheme-set-module)
+ (guile:eval string (guile-scheme-adapter)))
+
+(defun guile-scheme-display-result (value flag)
+ (if (string= value "#<unspecified>")
+ (setq value "done"))
+ (if flag
+ (insert value)
+ (message "%s" value)))
+
+\f
+;;;
+;;; Interactive commands
+;;;
+
+(defun guile-scheme-eval-expression (string)
+ "Evaluate the expression in STRING and show value in echo area."
+ (interactive "SGuile Scheme Eval: ")
+ (guile-scheme-display-result (guile-scheme-eval-string string) nil))
+
+(defun guile-scheme-eval-region (start end)
+ "Evaluate the region as Guile Scheme code."
+ (interactive "r")
+ (guile-scheme-eval-expression (buffer-substring-no-properties start end)))
+
+(defun guile-scheme-eval-buffer ()
+ "Evaluate the current buffer as Guile Scheme code."
+ (interactive)
+ (guile-scheme-eval-expression (buffer-string)))
+
+(defun guile-scheme-eval-last-sexp (arg)
+ "Evaluate sexp before point; show value in echo area.
+With argument, print output into current buffer."
+ (interactive "P")
+ (guile-scheme-display-result
+ (guile-scheme-eval-string
+ (buffer-substring-no-properties
+ (point) (save-excursion (backward-sexp) (point)))) arg))
+
+(defun guile-scheme-eval-print-last-sexp ()
+ "Evaluate sexp before point; print value into current buffer."
+ (interactive)
+ (let ((start (point)))
+ (guile-scheme-eval-last-sexp t)
+ (insert "\n")
+ (save-excursion (goto-char start) (insert "\n"))))
+
+(defun guile-scheme-eval-define ()
+ (interactive)
+ (guile-scheme-eval-region (save-excursion (end-of-defun) (point))
+ (save-excursion (beginning-of-defun) (point))))
+
+(defun guile-scheme-load-file (file)
+ "Load a Guile Scheme file."
+ (interactive "fGuile Scheme load file: ")
+ (guile-scheme-eval-string (format "(load %s)" (expand-file-name file)))
+ (message "done"))
+
+(guile-import guile-emacs-complete-alist)
+
+(defun guile-scheme-complete-symbol ()
+ (interactive)
+ (let* ((end (point))
+ (start (save-excursion (skip-syntax-backward "w_") (point)))
+ (pattern (buffer-substring-no-properties start end))
+ (alist (guile-emacs-complete-alist pattern)))
+ (goto-char end)
+ (let ((completion (try-completion pattern alist)))
+ (cond ((eq completion t))
+ ((not completion)
+ (message "Can't find completion for \"%s\"" pattern)
+ (ding))
+ ((not (string= pattern completion))
+ (delete-region start end)
+ (insert completion))
+ (t
+ (message "Making completion list...")
+ (with-output-to-temp-buffer "*Completions*"
+ (display-completion-list alist))
+ (message "Making completion list...done"))))))
+
+(guile-import guile-emacs-apropos)
+
+(defun guile-scheme-apropos (regexp)
+ (interactive "sGuile Scheme apropos (regexp): ")
+ (guile-scheme-set-module)
+ (with-output-to-temp-buffer "*Help*"
+ (princ (guile-emacs-apropos regexp))))
+
+(guile-import guile-emacs-describe)
+
+(defun guile-scheme-describe (symbol)
+ (interactive (list (guile-scheme-input-symbol "Describe Guile variable")))
+ (guile-scheme-set-module)
+ (with-output-to-temp-buffer "*Help*"
+ (princ (guile-emacs-describe symbol))))
+
+(defun guile-scheme-kill-process ()
+ (interactive)
+ (if guile-scheme-adapter
+ (guile-process-kill guile-scheme-adapter))
+ (setq guile-scheme-adapter nil))
+
+\f
+;;;
+;;; Internal functions
+;;;
+
+(guile-import apropos-internal guile-apropos-internal)
+
+(defvar guile-scheme-complete-table (make-vector 151 nil))
+
+(defun guile-scheme-input-symbol (prompt)
+ (mapc (lambda (sym)
+ (if (symbolp sym)
+ (intern (symbol-name sym) guile-scheme-complete-table)))
+ (guile-apropos-internal ""))
+ (let* ((str (thing-at-point 'symbol))
+ (default (if (intern-soft str guile-scheme-complete-table)
+ (concat " (default " str ")")
+ "")))
+ (intern (completing-read (concat prompt default ": ")
+ guile-scheme-complete-table nil t nil nil str))))
+
+\f
+;;;
+;;; Turn on guile-scheme-mode for .scm files by default.
+;;;
+
+(setq auto-mode-alist
+ (cons '("\\.scm\\'" . guile-scheme-mode) auto-mode-alist))
+
+(provide 'guile-scheme)
+
+;;; guile-scheme.el ends here
HCoop / bpt / guile.git / blobdiff