-;;; scheme.el --- Scheme (and DSSSL) editing mode.
+;;; scheme.el --- Scheme (and DSSSL) editing mode
-;; Copyright (C) 1986, 87, 88, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1986, 87, 88, 97, 1998 Free Software Foundation, Inc.
;; Author: Bill Rozas <jinx@martigny.ai.mit.edu>
-;; Maintainer: FSF
+;; Adapted-by: Dave Love <d.love@dl.ac.uk>
;; Keywords: languages, lisp
;; This file is part of GNU Emacs.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-;; Originally adapted from Lisp mode by Bill Rozas, jinx@prep with a
-;; comment that the code should be merged back. Merging done by
-;; d.love@dl.ac.uk when DSSSL features added.
-
;;; Commentary:
;; The major mode for editing Scheme-type Lisp code, very similar to
;; the `cmuscheme' package and also the implementation-specific
;; `xscheme' package.
+;; Here's a recipe to generate a TAGS file for DSSSL, by the way:
+;; etags --lang=scheme --regex='/[ \t]*(\(mode\|element\)[ \t
+;; ]+\([^ \t(
+;; ]+\)/\2/' --regex='/[ \t]*(element[ \t
+;; ]*([^)]+[ \t
+;; ]+\([^)]+\)[ \t
+;; ]*)/\1/' --regex='/(declare[^ \t
+;; ]*[ \t
+;; ]+\([^ \t
+;; ]+\)/\1/' "$@"
+
;;; Code:
\f
(require 'lisp-mode)
-(defvar scheme-mode-syntax-table nil "")
-(if (not scheme-mode-syntax-table)
- (let ((i 0))
- (setq scheme-mode-syntax-table (make-syntax-table))
- (set-syntax-table 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")
-
- ;; Special characters
- (modify-syntax-entry ?, "_ p")
- (modify-syntax-entry ?@ "_ p")
- (modify-syntax-entry ?# "_ p14")
- (modify-syntax-entry ?\\ "\\ ")))
+(defvar scheme-mode-syntax-table
+ (let ((st (make-syntax-table))
+ (i 0))
+
+ ;; Default is atom-constituent.
+ (while (< i 256)
+ (modify-syntax-entry i "_ " st)
+ (setq i (1+ i)))
+
+ ;; Word components.
+ (setq i ?0)
+ (while (<= i ?9)
+ (modify-syntax-entry i "w " st)
+ (setq i (1+ i)))
+ (setq i ?A)
+ (while (<= i ?Z)
+ (modify-syntax-entry i "w " st)
+ (setq i (1+ i)))
+ (setq i ?a)
+ (while (<= i ?z)
+ (modify-syntax-entry i "w " st)
+ (setq i (1+ i)))
+
+ ;; Whitespace
+ (modify-syntax-entry ?\t " " st)
+ (modify-syntax-entry ?\n "> " st)
+ (modify-syntax-entry ?\f " " st)
+ (modify-syntax-entry ?\r " " st)
+ (modify-syntax-entry ? " " st)
+
+ ;; These characters are delimiters but otherwise undefined.
+ ;; Brackets and braces balance for editing convenience.
+ (modify-syntax-entry ?\[ "(] " st)
+ (modify-syntax-entry ?\] ")[ " st)
+ (modify-syntax-entry ?{ "(} " st)
+ (modify-syntax-entry ?} "){ " st)
+ (modify-syntax-entry ?\| " 23" st)
+
+ ;; Other atom delimiters
+ (modify-syntax-entry ?\( "() " st)
+ (modify-syntax-entry ?\) ")( " st)
+ (modify-syntax-entry ?\; "< " st)
+ (modify-syntax-entry ?\" "\" " st)
+ (modify-syntax-entry ?' "' " st)
+ (modify-syntax-entry ?` "' " st)
+
+ ;; Special characters
+ (modify-syntax-entry ?, "' " st)
+ (modify-syntax-entry ?@ "' " st)
+ (modify-syntax-entry ?# "' 14" st)
+ (modify-syntax-entry ?\\ "\\ " st)
+ st))
\f
-(defvar scheme-mode-abbrev-table nil "")
+(defvar scheme-mode-abbrev-table nil)
(define-abbrev-table 'scheme-mode-abbrev-table ())
(defvar scheme-imenu-generic-expression
- '((nil
- "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 4)
- (" Types"
- "^(define-class\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 1)
- (" Macros"
- "^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 2))
+ '((nil
+ "^(define\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)*\\s-+(?\\(\\sw+\\)" 4)
+ ("Types"
+ "^(define-class\\s-+(?\\(\\sw+\\)" 1)
+ ("Macros"
+ "^(\\(defmacro\\|define-macro\\|define-syntax\\)\\s-+(?\\(\\sw+\\)" 2))
"Imenu generic expression for Scheme mode. See `imenu-generic-expression'.")
(defun scheme-mode-variables ()
(make-local-variable 'lisp-indent-function)
(set lisp-indent-function 'scheme-indent-function)
(setq mode-line-process '("" scheme-mode-line-process))
- (make-local-variable 'imenu-generic-expression)
- (setq imenu-generic-expression scheme-imenu-generic-expression))
+ (set (make-local-variable 'imenu-case-fold-search) t)
+ (setq imenu-generic-expression scheme-imenu-generic-expression)
+ (set (make-local-variable 'imenu-syntax-alist)
+ '(("+-*/.<>=?!$%_&~^:" . "w")))
+ (make-local-variable 'font-lock-defaults)
+ (setq font-lock-defaults
+ '((scheme-font-lock-keywords
+ scheme-font-lock-keywords-1 scheme-font-lock-keywords-2)
+ nil t (("+-*/.<>=!?$%_&~^:#" . "w")) beginning-of-defun
+ (font-lock-mark-block-function . mark-defun)
+ (font-lock-syntactic-face-function . lisp-font-lock-syntactic-face-function))))
(defvar scheme-mode-line-process "")
(defvar scheme-mode-map nil
"Keymap for Scheme mode.
-All commands in `shared-lisp-mode-map' are inherited by this map.")
+All commands in `lisp-mode-shared-map' are inherited by this map.")
-(if scheme-mode-map
- ()
+(unless scheme-mode-map
(let ((map (make-sparse-keymap "Scheme")))
- (setq scheme-mode-map
- (nconc (make-sparse-keymap) shared-lisp-mode-map))
- (define-key scheme-mode-map "\e\t" 'lisp-complete-symbol)
+ (setq scheme-mode-map (make-sparse-keymap))
+ (set-keymap-parent scheme-mode-map lisp-mode-shared-map)
(define-key scheme-mode-map [menu-bar] (make-sparse-keymap))
(define-key scheme-mode-map [menu-bar scheme]
(cons "Scheme" map))
(define-key map [run-scheme] '("Run Inferior Scheme" . run-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)))
;; Used by cmuscheme
;;;###autoload
(defun scheme-mode ()
"Major mode for editing Scheme code.
-Editing commands are similar to those of lisp-mode.
+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-\". For more information
-see the documentation for xscheme-interaction-mode.
+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
+Entry to this mode calls the value of `scheme-mode-hook'
if that value is non-nil."
(interactive)
(kill-all-local-variables)
"<!DOCTYPE style-sheet PUBLIC \"-//James Clark//DTD DSSSL Style Sheet//EN\">
"
"*An SGML declaration for the DSSSL file.
-This will be inserted into an empty buffer in dsssl-mode if it is
-defined as a string. It is typically James Clark's style-sheet
+If it is defined as a string this will be inserted into an empty buffer
+which is in `dsssl-mode'. It is typically James Clark's style-sheet
doctype, as required for Jade."
+ :type '(choice (string :tag "Specified string")
+ (const :tag "None" :value nil))
+ :group 'scheme)
+
+(defcustom scheme-mode-hook nil
+ "Normal hook run when entering `scheme-mode'.
+See `run-hooks'."
+ :type 'hook
+ :group 'scheme)
+
+(defcustom dsssl-mode-hook nil
+ "Normal hook run when entering `dsssl-mode'.
+See `run-hooks'."
+ :type 'hook
+ :group 'scheme)
+
+;; This is shared by cmuscheme and xscheme.
+(defcustom scheme-program-name "scheme"
+ "*Program invoked by the `run-scheme' command."
+ :type 'string
:group 'scheme)
(defvar dsssl-imenu-generic-expression
;; not sure it's the best way to organize it; perhaps one type
;; should be at the first level, though you don't see this anyhow if
;; it gets split up.
- '((" Defines"
- "^(define\\s-+(?\\(\\(\\sw\\|\\s_\\)+\\)" 1)
- (" Modes"
- "^\\s-*(mode\\s-+\\(\\(\\sw\\|\\s-\\|\\s_\\)+\\)" 1)
- (" Elements"
+ '(("Defines"
+ "^(define\\s-+(?\\(\\sw+\\)" 1)
+ ("Modes"
+ "^\\s-*(mode\\s-+\\(\\(\\sw\\|\\s-\\)+\\)" 1)
+ ("Elements"
;; (element foo ...) or (element (foo bar ...) ...)
;; Fixme: Perhaps it should do `root'.
- "^\\s-*(element\\s-+(?\\(\\(\\sw\\|\\s-\\|\\s_\\)+\\))?" 1)
- (" Declarations"
- "^(declare\\(-\\sw+\\)+\\>\\s-+\\(\\(\\sw\\|\\s_\\)+\\)" 2))
+ "^\\s-*(element\\s-+(?\\(\\(\\sw\\|\\s-\\)+\\))?" 1)
+ ("Declarations"
+ "^(declare\\(-\\sw+\\)+\\>\\s-+\\(\\sw+\\)" 2))
"Imenu generic expression for DSSSL mode. See `imenu-generic-expression'.")
+(defconst scheme-font-lock-keywords-1
+ (eval-when-compile
+ (list
+ ;;
+ ;; Declarations. Hannes Haug <hannes.haug@student.uni-tuebingen.de> says
+ ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS.
+ (list (concat "(\\(define\\*?\\("
+ ;; Function names.
+ "\\(\\|-public\\|-method\\|-generic\\(-procedure\\)?\\)\\|"
+ ;; Macro names, as variable names. A bit dubious, this.
+ "\\(-syntax\\|-macro\\)\\|"
+ ;; Class names.
+ "-class"
+ ;; Guile modules.
+ "\\|-module"
+ "\\)\\)\\>"
+ ;; Any whitespace and declared object.
+ "[ \t]*(?"
+ "\\(\\sw+\\)?")
+ '(1 font-lock-keyword-face)
+ '(6 (cond ((match-beginning 3) font-lock-function-name-face)
+ ((match-beginning 5) font-lock-variable-name-face)
+ (t font-lock-type-face))
+ nil t))
+ ))
+ "Subdued expressions to highlight in Scheme modes.")
+
+(defconst scheme-font-lock-keywords-2
+ (append scheme-font-lock-keywords-1
+ (eval-when-compile
+ (list
+ ;;
+ ;; Control structures.
+ (cons
+ (concat
+ "(" (regexp-opt
+ '("begin" "call-with-current-continuation" "call/cc"
+ "call-with-input-file" "call-with-output-file" "case" "cond"
+ "do" "else" "for-each" "if" "lambda"
+ "let" "let*" "let-syntax" "letrec" "letrec-syntax"
+ ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants:
+ "and" "or" "delay" "force"
+ ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother:
+ ;;"quasiquote" "quote" "unquote" "unquote-splicing"
+ "map" "syntax" "syntax-rules") t)
+ "\\>") 1)
+ ;;
+ ;; David Fox <fox@graphics.cs.nyu.edu> for SOS/STklos class specifiers.
+ '("\\<<\\sw+>\\>" . font-lock-type-face)
+ ;;
+ ;; Scheme `:' and `#:' keywords as builtins.
+ '("\\<#?:\\sw+\\>" . font-lock-builtin-face)
+ )))
+ "Gaudy expressions to highlight in Scheme modes.")
+
+(defvar scheme-font-lock-keywords scheme-font-lock-keywords-1
+ "Default expressions to highlight in Scheme modes.")
+
;;;###autoload
(defun dsssl-mode ()
"Major mode for editing DSSSL code.
-Editing commands are similar to those of lisp-mode.
+Editing commands are similar to those of `lisp-mode'.
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 dsssl-mode-hook
-if that value is non-nil and inserts the value of
-`dsssl-sgml-declaration' if that variable's value is a string."
+Entering this mode runs the hooks `scheme-mode-hook' and then
+`dsssl-mode-hook' and inserts the value of `dsssl-sgml-declaration' if
+that variable's value is a string."
(interactive)
(kill-all-local-variables)
(use-local-map scheme-mode-map)
(scheme-mode-initialize)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(dsssl-font-lock-keywords
- nil t (("+-*/.<>=!?$%_&~^:" . "w"))
- beginning-of-defun
- (font-lock-comment-start-regexp . ";")
- (font-lock-mark-block-function . mark-defun)))
(make-local-variable 'page-delimiter)
(setq page-delimiter "^;;;" ; ^L not valid SGML char
major-mode 'dsssl-mode
(stringp dsssl-sgml-declaration)
(not buffer-read-only)
(insert dsssl-sgml-declaration))
- (run-hooks 'scheme-mode-hook)
- (run-hooks 'dsssl-mode-hook)
(scheme-mode-variables)
- (setq imenu-generic-expression dsssl-imenu-generic-expression))
+ (setq font-lock-defaults '(dsssl-font-lock-keywords
+ nil t (("+-*/.<>=?$%_&~^:" . "w"))
+ beginning-of-defun
+ (font-lock-mark-block-function . mark-defun)))
+ (set (make-local-variable 'imenu-case-fold-search) nil)
+ (setq imenu-generic-expression dsssl-imenu-generic-expression)
+ (set (make-local-variable 'imenu-syntax-alist)
+ '(("+-*/.<>=?$%_&~^:" . "w")))
+ (run-hooks 'scheme-mode-hook)
+ (run-hooks 'dsssl-mode-hook))
;; Extra syntax for DSSSL. This isn't separated from Scheme, but
;; shouldn't cause much trouble in scheme-mode.
'("(\\(element\\)\\>[ ]*(\\(\\S)+\\))"
(1 font-lock-keyword-face)
(2 font-lock-type-face))
- '("\\<\\sw+:\\>" . font-lock-reference-face) ; trailing `:' c.f. scheme
+ '("\\<\\sw+:\\>" . font-lock-constant-face) ; trailing `:' c.f. scheme
;; SGML markup (from sgml-mode) :
'("<\\([!?][-a-z0-9]+\\)" 1 font-lock-keyword-face)
'("<\\(/?[-a-z0-9]+\\)" 1 font-lock-function-name-face)))
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
(if (and (elt state 2)
(not (looking-at "\\sw\\|\\s_")))
- ;; car of form doesn't seem to be a a symbol
+ ;; car of form doesn't seem to be a symbol
(progn
(if (not (> (save-excursion (forward-line 1) (point))
calculate-lisp-indent-last-sexp))
(not (string-equal (substring string 0 1) "(")))
(defun next-sexp-as-string ()
- ;; Assumes that protected by a save-excursion
+ ;; Assumes that it is protected by a save-excursion
(forward-sexp 1)
(let ((the-end (point)))
(backward-sexp 1)
(put 'let 'scheme-indent-function 'scheme-let-indent)
(put 'let* 'scheme-indent-function 1)
(put 'letrec 'scheme-indent-function 1)
-(put 'sequence 'scheme-indent-function 0)
+(put 'sequence 'scheme-indent-function 0) ; SICP, not r4rs
+(put 'let-syntax 'scheme-indent-function 1)
+(put 'letrec-syntax 'scheme-indent-function 1)
+(put 'syntax-rules 'scheme-indent-function 1)
+(put 'syntax-case 'scheme-indent-function 2) ; not r5rs
(put 'call-with-input-file 'scheme-indent-function 1)
(put 'with-input-from-file 'scheme-indent-function 1)
(put 'call-with-output-file 'scheme-indent-function 1)
(put 'with-output-to-file 'scheme-indent-function 1)
(put 'with-output-to-port 'scheme-indent-function 1)
+(put 'call-with-values 'scheme-indent-function 1) ; r5rs?
+(put 'dynamic-wind 'scheme-indent-function 3) ; r5rs?
\f
;;;; MIT Scheme specific indentation.
(progn
(put 'fluid-let 'scheme-indent-function 1)
(put 'in-package 'scheme-indent-function 1)
- (put 'let-syntax 'scheme-indent-function 1)
(put 'local-declare 'scheme-indent-function 1)
(put 'macro 'scheme-indent-function 1)
(put 'make-environment 'scheme-indent-function 0)
(provide 'scheme)
+;;; arch-tag: a8f06bc1-ad11-42d2-9e36-ce651df37a90
;;; scheme.el ends here